wrath/shaniqua-plugins
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Remove posix dependency in MkTemmp

Browse Source
This commit is contained in:
Don Stewart 2005-04-25 03:48:00 +00:00
parent 571c56fcb9
commit 527562849d
1 changed files with 45 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

102
src/plugins/Plugins/MkTemp.hs
View File

@ -1,6 +1,8 @@
{-# OPTIONS -cpp -fffi -fglasgow-exts #-} {-# OPTIONS -cpp -fffi -fglasgow-exts #-}
--
-- glaexts for I# ops
-- --
-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons -- Copyright (c) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons
-- --
-- This library is free software; you can redistribute it and/or -- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public -- modify it under the terms of the GNU Lesser General Public
@ -21,52 +23,45 @@
-- --
-- A Haskell reimplementation of the C mktemp/mkstemp/mkstemps library -- A Haskell reimplementation of the C mktemp/mkstemp/mkstemps library
-- based on the algorithms in: -- based on the algorithms in:
-- "$ OpenBSD: mktemp.c,v 1.17 2003/06/02 20:18:37 millert Exp $" -- > $ OpenBSD: mktemp.c,v 1.17 2003/06/02 20:18:37 millert Exp $
-- which are available under the BSD license. -- which are available under the BSD license.
-- --
module Plugins.MkTemp ( module Plugins.MkTemp (
mktemp, -- :: FilePath -> FilePath mktemp, -- :: FilePath -> IO Maybe FilePath
mkstemp, -- :: FilePath -> (FilePath, Handle) mkstemp, -- :: FilePath -> IO Maybe (FilePath, Handle)
mkstemps, -- :: FilePath -> Int -> (FilePath,Handle) mkstemps, -- :: FilePath -> Int -> IO Maybe (FilePath,Handle)
mkdtemp, -- :: FilePath -> FilePath mkdtemp, -- :: FilePath -> IO Maybe FilePath
) where ) where
#include "config.h"
import Data.List import Data.List
import Data.Char import Data.Char ( chr, ord, isDigit )
import Control.Monad ( liftM ) import Control.Monad ( liftM )
import Control.Exception ( handleJust ) import Control.Exception ( handleJust )
import System.Directory ( doesDirectoryExist, doesFileExist, createDirectory )
#if __GLASGOW_HASKELL__ < 604 import System.IO
import System.IO ( isAlreadyExistsError, Handle )
#else
import System.IO ( Handle )
import System.IO.Error ( isAlreadyExistsError ) import System.IO.Error ( isAlreadyExistsError )
#endif
import System.Directory ( doesDirectoryExist, doesFileExist ) import GHC.IOBase ( IOException(IOError),
Exception(IOException),
IOErrorType(AlreadyExists) )
import GHC.IOBase ( Exception(IOException) )
-- Fix this.
#ifndef __MINGW32__ #ifndef __MINGW32__
import System.Posix.IO
import System.Posix.Files
import qualified System.Posix.Directory ( createDirectory )
import qualified System.Posix.Internals ( c_getpid ) import qualified System.Posix.Internals ( c_getpid )
#endif #endif
#ifndef HAVE_ARC4RANDOM #ifdef HAVE_ARC4RANDOM
import System.Random ( getStdRandom, Random(randomR) ) import GHC.Base hiding ( ord, chr )
#else
import GHC.Base
import GHC.Int import GHC.Int
#else
import System.Random ( getStdRandom, Random(randomR) )
#endif #endif
-- --------------------------------------------------------------------- ------------------------------------------------------------------------
mkstemps :: FilePath -> Int -> IO (Maybe (FilePath,Handle)) mkstemps :: FilePath -> Int -> IO (Maybe (FilePath,Handle))
mkstemp :: FilePath -> IO (Maybe (FilePath,Handle)) mkstemp :: FilePath -> IO (Maybe (FilePath,Handle))
@ -83,7 +78,7 @@ mktemp path = do v <- gettemp path False False 0
mkdtemp path = do v <- gettemp path False True 0 mkdtemp path = do v <- gettemp path False True 0
return $ case v of Just (path',_) -> Just path'; _ -> Nothing return $ case v of Just (path',_) -> Just path'; _ -> Nothing
-- --------------------------------------------------------------------- ------------------------------------------------------------------------
gettemp :: FilePath -> Bool -> Bool -> Int -> IO (Maybe (FilePath, Handle)) gettemp :: FilePath -> Bool -> Bool -> Int -> IO (Maybe (FilePath, Handle))
@ -188,11 +183,13 @@ tweak i s
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
alreadyExists :: Exception -> Maybe Exception
alreadyExists e@(IOException ioe) alreadyExists e@(IOException ioe)
| isAlreadyExistsError ioe = Just e | isAlreadyExistsError ioe = Just e
| otherwise = Nothing | otherwise = Nothing
alreadyExists _ = Nothing alreadyExists _ = Nothing
isInUse :: Exception -> Maybe ()
#ifndef __MINGW32__ #ifndef __MINGW32__
isInUse (IOException ioe) isInUse (IOException ioe)
| isAlreadyExistsError ioe = Just () | isAlreadyExistsError ioe = Just ()
@ -210,51 +207,43 @@ isInUse _ = Nothing
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
-- Create a file mode 0600 if possible -- Create a file mode 0600 if possible
-- --
-- N.B. race condition between testing existence and opening
-- But we can live with that to avoid a posix dependency, right?
--
open0600 :: FilePath -> IO Handle open0600 :: FilePath -> IO Handle
open0600 f = do
b <- doesFileExist f
if b then ioError err -- race
else openFile f ReadWriteMode
where
err = IOError Nothing AlreadyExists "open0600" "already exists" Nothing
#ifndef __MINGW32__ {-
-- open(path, O_CREAT|O_EXCL|O_RDWR, 0600) -- open(path, O_CREAT|O_EXCL|O_RDWR, 0600)
--
open0600 f = do open0600 f = do
openFd f ReadWrite (Just o600) excl >>= fdToHandle openFd f ReadWrite (Just o600) excl >>= fdToHandle
where where
o600 = ownerReadMode `unionFileModes` ownerWriteMode o600 = ownerReadMode `unionFileModes` ownerWriteMode
excl = defaultFileFlags { exclusive = True } excl = defaultFileFlags { exclusive = True }
#else -}
-- N.B. race condition between testing existence and opening
open0600 f = do
b <- doesFileExist f
if b then ioException err -- race
else openFile f ReadWriteMode
where
err = IOError Nothing AlreadyExists "open0600" "already exists" Nothing
#endif
-- --
-- create a directory mode 0700 if possible -- create a directory mode 0700 if possible
-- --
mkdir0700 :: FilePath -> IO () mkdir0700 :: FilePath -> IO ()
mkdir0700 dir = mkdir0700 dir = createDirectory dir
#ifndef __MINGW32__ {-
System.Posix.Directory.createDirectory dir ownerModes System.Posix.Directory.createDirectory dir ownerModes
#else -}
createDirectory dir
#endif
-- ---------------------------------------------------------------------
-- | getProcessId, stolen from GHC -- | getProcessId, stolen from GHC
--
#ifdef __MINGW32__ #ifdef __MINGW32__
foreign import ccall unsafe "_getpid" getProcessID :: IO Int foreign import ccall unsafe "_getpid" getProcessID :: IO Int
#elif __GLASGOW_HASKELL__ > 504
getProcessID :: IO Int
getProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral
#else #else
getProcessID :: IO Int getProcessID :: IO Int
getProcessID = Posix.getProcessID getProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral
#endif #endif
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
@ -266,16 +255,15 @@ getRandom :: () -> IO Int
getRandom _ = getStdRandom (randomR (0,51)) getRandom _ = getStdRandom (randomR (0,51))
#else #else
-- --
--
-- OpenBSD: "The arc4random() function provides a high quality 32-bit -- OpenBSD: "The arc4random() function provides a high quality 32-bit
-- pseudo-random number very quickly. arc4random() seeds itself on a -- pseudo-random number very quickly. arc4random() seeds itself on a
-- regular basis from the kernel strong random number subsystem -- regular basis from the kernel strong random number subsystem
-- described in random(4)." Also, it is a bit faster than getStdRandom -- described in random(4)." Also, it is a bit faster than getStdRandom
-- --
getRandom _ = do getRandom _ = do
(I32# i) <- c_arc4random (I32# i) <- c_arc4random
return (I# (word2Int# return (I# (word2Int# ((int2Word# i `and#` int2Word# 0xffff#)
((int2Word# i `and#` int2Word# 0xffff#) `remWord#` int2Word# 52#))) `remWord#` int2Word# 52#)))
foreign import ccall unsafe "arc4random" c_arc4random :: IO Int32 foreign import ccall unsafe "stdlib.h arc4random" c_arc4random :: IO Int32
#endif #endif