From 9df8a6eb9405dde4464d27133c04f5ee539a85de Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 2 Jan 2020 12:34:10 -0400
Subject: merge from git-annex and relicense accordingly

Merge git library and utility from git-annex. The former is now relicensed
AGPL, so git-repair as a whole becomes AGPL.

For simplicity, I am relicensing the remainder of the code in git-repair
AGPL as well, per the header changes in this commit. While that code is
also technically available under the GPL license, as it's been released
under that license before, changes going forward will be only released by
me under the AGPL.
---
 Utility/Tmp.hs | 61 +++++++++-------------------------------------------------
 1 file changed, 9 insertions(+), 52 deletions(-)

(limited to 'Utility/Tmp.hs')

diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs
index 7255c14..6ee592b 100644
--- a/Utility/Tmp.hs
+++ b/Utility/Tmp.hs
@@ -1,4 +1,4 @@
-{- Temporary files and directories.
+{- Temporary files.
  -
  - Copyright 2010-2013 Joey Hess <id@joeyh.name>
  -
@@ -8,17 +8,19 @@
 {-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
-module Utility.Tmp where
+module Utility.Tmp (
+	Template,
+	viaTmp,
+	withTmpFile,
+	withTmpFileIn,
+	relatedTemplate,
+) where
 
 import System.IO
-import Control.Monad.IfElse
 import System.FilePath
 import System.Directory
 import Control.Monad.IO.Class
 import System.PosixCompat.Files
-#ifndef mingw32_HOST_OS
-import System.Posix.Temp (mkdtemp)
-#endif
 
 import Utility.Exception
 import Utility.FileSystemEncoding
@@ -32,7 +34,7 @@ viaTmp :: (MonadMask m, MonadIO m) => (FilePath -> v -> m ()) -> FilePath -> v -
 viaTmp a file content = bracketIO setup cleanup use
   where
 	(dir, base) = splitFileName file
-	template = base ++ ".tmp"
+	template = relatedTemplate (base ++ ".tmp")
 	setup = do
 		createDirectoryIfMissing True dir
 		openTempFile dir template
@@ -62,51 +64,6 @@ withTmpFileIn tmpdir template a = bracket create remove use
 		catchBoolIO (removeFile name >> return True)
 	use (name, h) = a name h
 
-{- Runs an action with a tmp directory located within the system's tmp
- - directory (or within "." if there is none), then removes the tmp
- - directory and all its contents. -}
-withTmpDir :: (MonadMask m, MonadIO m) => Template -> (FilePath -> m a) -> m a
-withTmpDir template a = do
-	topleveltmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory
-#ifndef mingw32_HOST_OS
-	-- Use mkdtemp to create a temp directory securely in /tmp.
-	bracket
-		(liftIO $ mkdtemp $ topleveltmpdir </> template)
-		removeTmpDir
-		a
-#else
-	withTmpDirIn topleveltmpdir template a
-#endif
-
-{- Runs an action with a tmp directory located within a specified directory,
- - then removes the tmp directory and all its contents. -}
-withTmpDirIn :: (MonadMask m, MonadIO m) => FilePath -> Template -> (FilePath -> m a) -> m a
-withTmpDirIn tmpdir template = bracketIO create removeTmpDir
-  where
-	create = do
-		createDirectoryIfMissing True tmpdir
-		makenewdir (tmpdir </> template) (0 :: Int)
-	makenewdir t n = do
-		let dir = t ++ "." ++ show n
-		catchIOErrorType AlreadyExists (const $ makenewdir t $ n + 1) $ do
-			createDirectory dir
-			return dir
-
-{- Deletes the entire contents of the the temporary directory, if it
- - exists. -}
-removeTmpDir :: MonadIO m => FilePath -> m ()
-removeTmpDir tmpdir = liftIO $ whenM (doesDirectoryExist tmpdir) $ do
-#if mingw32_HOST_OS
-	-- Windows will often refuse to delete a file
-	-- after a process has just written to it and exited.
-	-- Because it's crap, presumably. So, ignore failure
-	-- to delete the temp directory.
-	_ <- tryIO $ removeDirectoryRecursive tmpdir
-	return ()
-#else
-	removeDirectoryRecursive tmpdir
-#endif
-
 {- It's not safe to use a FilePath of an existing file as the template
  - for openTempFile, because if the FilePath is really long, the tmpfile
  - will be longer, and may exceed the maximum filename length.
-- 
cgit v1.2.3