module System.MkTemp (
mktemp,
mkstemp,
mkstemps,
mkdtemp,
) where
import Data.List ( )
import Data.Char ( chr, ord, isDigit )
import Control.Monad ( liftM )
import Control.Exception ( handleJust )
import System.FilePath ( splitFileName, (</>) )
import System.Directory ( doesDirectoryExist, doesFileExist, createDirectory )
import System.IO
#ifndef __MINGW32__
import System.IO.Error ( mkIOError, alreadyExistsErrorType,
isAlreadyExistsError )
#else
import System.IO.Error ( isAlreadyExistsError, isAlreadyInUseError, isPermissionError )
#endif
#ifndef __MINGW32__
import qualified System.Posix.Internals ( c_getpid )
#endif
#ifdef HAVE_ARC4RANDOM
import GHC.Base hiding ( ord, chr )
import GHC.Int
#else
import System.Random ( getStdRandom, Random(randomR) )
#endif
mkstemps :: FilePath -> Int -> IO (Maybe (FilePath,Handle))
mkstemp :: FilePath -> IO (Maybe (FilePath,Handle))
mktemp :: FilePath -> IO (Maybe FilePath)
mkdtemp :: FilePath -> IO (Maybe FilePath)
mkstemps path slen = gettemp path True False slen
mkstemp path = gettemp path True False 0
mktemp path = do v <- gettemp path False False 0
return $ case v of Just (path',_) -> Just path'; _ -> Nothing
mkdtemp path = do v <- gettemp path False True 0
return $ case v of Just (path',_) -> Just path'; _ -> Nothing
gettemp :: FilePath -> Bool -> Bool -> Int -> IO (Maybe (FilePath, Handle))
gettemp [] _ _ _ = return Nothing
gettemp _ True True _ = return Nothing
gettemp path doopen domkdir slen = do
let (pref,tmpl,suff) = let (r,s) = splitAt (length path slen) path
(d,f) = splitFileName r
(p,t) = break (== 'X') f
in (d </> p,t,s)
if null pref && null tmpl then return Nothing else do {
;pid <- liftM show $ getProcessID
;let (rest, xs) = merge tmpl pid
;as <- randomise rest
;let tmpl' = as ++ xs
path' = pref ++ tmpl' ++ suff
;dir_ok <- if doopen || domkdir
then let d = reverse $ dropWhile (/= '/') $ reverse path'
in doesDirectoryExist d
else return True
;if not dir_ok then return Nothing else do {
;let fn p
| doopen = handleJust isInUse (\_ -> return Nothing) $
do h <- open0600 p ; return $ Just h
| domkdir = handleJust alreadyExists (\_ -> return Nothing) $
do mkdir0700 p ; return $ Just undefined
| otherwise = do b <- doesFileExist p
return $ if b then Nothing else Just undefined
;let tryIt p t i =
do v <- fn p
case v of Just h -> return $ Just (p,h)
Nothing -> let (i',t') = tweak i t
in if null t'
then return Nothing
else tryIt (pref++t'++suff) t' i'
;tryIt path' tmpl' 0
}}
merge :: String -> String -> (String,String)
merge t [] = (t ,[])
merge [] _ = ([] ,[])
merge (_:ts) (p:ps) = (ts',p:ps')
where (ts',ps') = merge ts ps
randomise :: String -> IO String
randomise [] = return []
randomise ('X':xs) = do p <- getRandom ()
let c = chr $! if p < 26
then p + (ord 'A')
else (p 26) + (ord 'a')
xs' <- randomise xs
return (c : xs')
randomise s = return s
tweak :: Int -> String -> (Int,String)
tweak i s
| i > length s 1 = (i,[])
| s !! i == 'Z' = if i == length s 1
then (i,[])
else let s' = splice (i+1) 'a'
in tweak (i+1) s'
| otherwise = let c = s !! i in case () of {_
| isDigit c -> (i, splice i 'a' )
| c == 'z' -> (i, splice i 'A' )
| otherwise -> let c' = chr $ (ord c) + 1 in (i,splice i c')
}
where
splice j c = let (a,b) = splitAt j s in a ++ [c] ++ tail b
alreadyExists :: IOError -> Maybe IOError
alreadyExists ioe
| isAlreadyExistsError ioe = Just ioe
| otherwise = Nothing
isInUse :: IOError -> Maybe ()
#ifndef __MINGW32__
isInUse ioe
| isAlreadyExistsError ioe = Just ()
| otherwise = Nothing
#else
isInUse ioe
| isAlreadyInUseError ioe = Just ()
| isPermissionError ioe = Just ()
| isAlreadyExistsError ioe = Just ()
| otherwise = Nothing
isInUse _ = Nothing
#endif
open0600 :: FilePath -> IO Handle
open0600 f = do
b <- doesFileExist f
if b then ioError err
else openFile f ReadWriteMode
where
err = mkIOError alreadyExistsErrorType "op0600" Nothing (Just f)
mkdir0700 :: FilePath -> IO ()
mkdir0700 dir = createDirectory dir
#ifdef __MINGW32__
foreign import ccall unsafe "_getpid" getProcessID' :: IO Int
getProcessID :: IO Int
getProcessID = liftM abs getProcessID'
#else
getProcessID :: IO Int
#ifdef CYGWIN
getProcessID = System.Posix.Internals.c_getpid >>= return . abs . fromIntegral
#else
getProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral
#endif
#endif
getRandom :: () -> IO Int
#ifndef HAVE_ARC4RANDOM
getRandom _ = getStdRandom (randomR (0,51))
#else
getRandom _ = do
(I32# i) <- c_arc4random
return (I# (word2Int# ((int2Word# i `and#` int2Word# 0xffff#)
`remWord#` int2Word# 52#)))
foreign import ccall unsafe "stdlib.h arc4random" c_arc4random :: IO Int32
#endif