summaryrefslogtreecommitdiff
path: root/Utility/Tmp.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Utility/Tmp.hs')
-rw-r--r--Utility/Tmp.hs124
1 files changed, 124 insertions, 0 deletions
diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs
new file mode 100644
index 0000000..7610f6c
--- /dev/null
+++ b/Utility/Tmp.hs
@@ -0,0 +1,124 @@
+{- Temporary files and directories.
+ -
+ - Copyright 2010-2013 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.Tmp where
+
+import System.IO
+import System.Directory
+import Control.Monad.IfElse
+import System.FilePath
+import Control.Monad.IO.Class
+#ifndef mingw32_HOST_OS
+import System.Posix.Temp (mkdtemp)
+#endif
+
+import Utility.Exception
+import Utility.FileSystemEncoding
+import Utility.PosixFiles
+
+type Template = String
+
+{- Runs an action like writeFile, writing to a temp file first and
+ - then moving it into place. The temp file is stored in the same
+ - directory as the final file to avoid cross-device renames. -}
+viaTmp :: (MonadMask m, MonadIO m) => (FilePath -> String -> m ()) -> FilePath -> String -> m ()
+viaTmp a file content = bracketIO setup cleanup use
+ where
+ (dir, base) = splitFileName file
+ template = base ++ ".tmp"
+ setup = do
+ createDirectoryIfMissing True dir
+ openTempFile dir template
+ cleanup (tmpfile, h) = do
+ _ <- tryIO $ hClose h
+ tryIO $ removeFile tmpfile
+ use (tmpfile, h) = do
+ liftIO $ hClose h
+ a tmpfile content
+ liftIO $ rename tmpfile file
+
+{- Runs an action with a tmp file located in the system's tmp directory
+ - (or in "." if there is none) then removes the file. -}
+withTmpFile :: (MonadIO m, MonadMask m) => Template -> (FilePath -> Handle -> m a) -> m a
+withTmpFile template a = do
+ tmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory
+ withTmpFileIn tmpdir template a
+
+{- Runs an action with a tmp file located in the specified directory,
+ - then removes the file. -}
+withTmpFileIn :: (MonadIO m, MonadMask m) => FilePath -> Template -> (FilePath -> Handle -> m a) -> m a
+withTmpFileIn tmpdir template a = bracket create remove use
+ where
+ create = liftIO $ openTempFile tmpdir template
+ remove (name, h) = liftIO $ do
+ hClose h
+ 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.
+ -
+ - This generates a template that is never too long.
+ - (Well, it allocates 20 characters for use in making a unique temp file,
+ - anyway, which is enough for the current implementation and any
+ - likely implementation.)
+ -}
+relatedTemplate :: FilePath -> FilePath
+relatedTemplate f
+ | len > 20 = truncateFilePath (len - 20) f
+ | otherwise = f
+ where
+ len = length f