diff --git a/plugins.cabal b/plugins.cabal --- a/plugins.cabal +++ b/plugins.cabal @@ -1,12 +1,16 @@ name: plugins -version: 1.5.1.2 +version: 1.5.1.3 homepage: http://code.haskell.org/~dons/code/hs-plugins synopsis: Dynamic linking for Haskell and C objects description: Dynamic linking and runtime evaluation of Haskell, and C, including dependency chasing and package resolution. . - Described in the paper: - /Plugging Haskell In/, + Described in the papers: + + * /Plugging Haskell In/, + * /Dynamic Applications from the Ground Up/, + * /Dynamic Extension of Typed Functional Languages/. + category: System license: BSD3 License-file: LICENSE @@ -25,7 +29,6 @@ System.Eval, System.Eval.Haskell, System.Eval.Utils, - System.MkTemp, System.Plugins, System.Plugins.Consts, System.Plugins.Env, diff --git a/src/System/MkTemp.hs b/src/System/MkTemp.hs deleted file mode 100644 --- a/src/System/MkTemp.hs +++ /dev/null @@ -1,274 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE MagicHash #-} --- --- Copyright (c) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons --- --- This library is free software; you can redistribute it and/or --- modify it under the terms of the GNU Lesser General Public --- License as published by the Free Software Foundation; either --- version 2.1 of the License, or (at your option) any later version. --- --- This library is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --- Lesser General Public License for more details. --- --- You should have received a copy of the GNU Lesser General Public --- License along with this library; if not, write to the Free Software --- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 --- USA --- - --- --- A Haskell reimplementation of the C mktemp/mkstemp/mkstemps library --- based on the algorithms in: --- > $ OpenBSD: mktemp.c,v 1.17 2003/06/02 20:18:37 millert Exp $ --- which are available under the BSD license. --- - -module System.MkTemp ( - - mktemp, -- :: FilePath -> IO Maybe FilePath - mkstemp, -- :: FilePath -> IO Maybe (FilePath, Handle) - mkstemps, -- :: FilePath -> Int -> IO Maybe (FilePath,Handle) - mkdtemp, -- :: FilePath -> IO Maybe FilePath - - ) 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 - -- - -- firstly, break up the path and extract the template - -- - 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) - -- - -- an error if there is only a suffix, it seems - -- - if null pref && null tmpl then return Nothing else do { - -- - -- replace end of template with process id, and rest with randomness - -- - ;pid <- liftM show $ getProcessID - ;let (rest, xs) = merge tmpl pid - ;as <- randomise rest - ;let tmpl' = as ++ xs - path' = pref ++ tmpl' ++ suff - -- - -- just check if we can get at the directory we might need - -- - ;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 { - -- - -- We need a function for looking for appropriate temp files - -- - ;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 - - -- - -- now, try to create the tmp file, permute if we can't - -- once we've tried all permutations, give up - -- - ;let tryIt p t i = - do v <- fn p - case v of Just h -> return $ Just (p,h) -- it worked - Nothing -> let (i',t') = tweak i t - in if null t' - then return Nothing -- no more - else tryIt (pref++t'++suff) t' i' - ;tryIt path' tmpl' 0 - - }} - --- --- Replace X's with pid digits. Complete rewrite --- -merge :: String -> String -> (String,String) -merge t [] = (t ,[]) -merge [] _ = ([] ,[]) -merge (_:ts) (p:ps) = (ts',p:ps') - where (ts',ps') = merge ts ps - --- --- And replace remaining X's with random chars --- randomR is pretty slow, oh well. --- -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 - --- --- "tricky little algorithm for backward compatibility" --- could do with a Haskellish rewrite --- -tweak :: Int -> String -> (Int,String) -tweak i s - | i > length s - 1 = (i,[]) -- no more - | s !! i == 'Z' = if i == length s - 1 - then (i,[]) -- no more - else let s' = splice (i+1) 'a' - in tweak (i+1) s' -- loop - | 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 () -- we throw this - | otherwise = Nothing -isInUse _ = Nothing -#endif - --- --------------------------------------------------------------------- --- 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 f = do - b <- doesFileExist f - if b then ioError err -- race - else openFile f ReadWriteMode - where - err = mkIOError alreadyExistsErrorType "op0600" Nothing (Just f) - -{- --- open(path, O_CREAT|O_EXCL|O_RDWR, 0600) --- -open0600 f = do - openFd f ReadWrite (Just o600) excl >>= fdToHandle - where - o600 = ownerReadMode `unionFileModes` ownerWriteMode - excl = defaultFileFlags { exclusive = True } --} - --- --- create a directory mode 0700 if possible --- -mkdir0700 :: FilePath -> IO () -mkdir0700 dir = createDirectory dir -{- - System.Posix.Directory.createDirectory dir ownerModes --} - --- | getProcessId, stolen from GHC /main\/SysTools.lhs/ --- -#ifdef __MINGW32__ --- relies on Int == Int32 on Windows -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 - --- --------------------------------------------------------------------- --- | Use a variety of random functions, if you like. --- -getRandom :: () -> IO Int - -#ifndef HAVE_ARC4RANDOM -getRandom _ = getStdRandom (randomR (0,51)) -#else --- --- OpenBSD: "The arc4random() function provides a high quality 32-bit --- pseudo-random number very quickly. arc4random() seeds itself on a --- regular basis from the kernel strong random number subsystem --- described in random(4)." Also, it is a bit faster than getStdRandom --- -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 diff --git a/src/System/Plugins/Utils.hs b/src/System/Plugins/Utils.hs --- a/src/System/Plugins/Utils.hs +++ b/src/System/Plugins/Utils.hs @@ -61,7 +61,7 @@ import System.Plugins.Env ( isLoaded ) import System.Plugins.Consts ( objSuf, hiSuf, tmpDir ) -import qualified System.MkTemp ( mkstemps ) +-- import qualified System.MkTemp ( mkstemps ) import Data.Char import Data.List @@ -94,11 +94,11 @@ -- mkstemps(3). -- -mkstemps :: String -> Int -> IO (String,Handle) -mkstemps path slen = do - m_v <- System.MkTemp.mkstemps path slen - case m_v of Nothing -> error "mkstemps : couldn't create temp file" - Just v' -> return v' +-- mkstemps :: String -> Int -> IO (String,Handle) +-- mkstemps path slen = do +-- m_v <- System.MkTemp.mkstemps path slen +-- case m_v of Nothing -> error "mkstemps : couldn't create temp file" +-- Just v' -> return v' {- @@ -124,7 +124,9 @@ mkTempIn :: String -> IO (String, Handle) mkTempIn tmpd = do - (tmpf,hdl) <- mkstemps (tmpd++"/MXXXXXXXXX.hs") 3 + -- XXX (tmpf,hdl) <- mkstemps (tmpd++"/MXXXXXXXXX.hs") 3 + + (tmpf, hdl) <- openTempFile tmpd "MXXXXX.hs" let modname = mkModid $ dropSuffix tmpf if and $ map (\c -> isAlphaNum c && c /= '_') modname then return (tmpf,hdl)