124 lines
4.1 KiB
Haskell
124 lines
4.1 KiB
Haskell
{- 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 Control.Monad.IfElse
|
|
import System.FilePath
|
|
import System.Directory
|
|
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
|