From bf46721dbf4c905d03e2dd39640980ea9736c6dd Mon Sep 17 00:00:00 2001 From: Deian Stefan Date: Thu, 5 Jan 2012 23:28:51 -0800 Subject: System.Posix.Temp compliance --- System/Posix/Temp.hsc | 28 ++++++++++++++++++++-------- System/Posix/Temp/ByteString.hsc | 29 +++++++++++++++++++++-------- cbits/HsUnix.c | 13 ++++++++++--- configure.ac | 3 +++ include/HsUnix.h | 6 ++++++ 5 files changed, 60 insertions(+), 19 deletions(-) diff --git a/System/Posix/Temp.hsc b/System/Posix/Temp.hsc index 8ab789c..b40e513 100644 --- a/System/Posix/Temp.hsc +++ b/System/Posix/Temp.hsc @@ -6,9 +6,10 @@ -- | -- Module : System.Posix.Temp -- Copyright : (c) Volker Stolz +-- Deian Stefan -- License : BSD-style (see the file libraries/base/LICENSE) -- --- Maintainer : libraries@haskell.org +-- Maintainer : libraries@haskell.org, vs@foldr.org, deian@cs.stanford.edu -- Stability : provisional -- Portability : non-portable (requires POSIX) -- @@ -22,6 +23,7 @@ module System.Posix.Temp ( #include "HsUnix.h" +import Control.Exception (throwIO) import System.IO import System.Posix.IO import System.Posix.Types @@ -70,6 +72,10 @@ mkstemp template' = do #endif #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) +foreign import ccall unsafe "HsUnix.h __hscore_mkstemp" + c_mkstemp :: CString -> IO CInt +#endif + -- |'mkstemps' - make a unique filename with a given prefix and suffix -- and open it for reading\/writing (only safe on GHC & Hugs). -- The returned 'FilePath' is the (possibly relative) path of @@ -77,6 +83,7 @@ mkstemp template' = do -- the prefix and suffix. mkstemps :: String -> String -> IO (FilePath, Handle) mkstemps prefix suffix = do +#if HAVE_MKSTEMPS let template = prefix ++ "XXXXXX" ++ suffix lenOfsuf :: CInt lenOfsuf = fromIntegral $ length suffix @@ -85,7 +92,11 @@ mkstemps prefix suffix = do name <- peekFilePath ptr h <- fdToHandle (Fd fd) return (name, h) +#else + throwIO . userError $ "mkstemps: System does not have a mkstemp C function." +#endif +#if HAVE_MKSTEMPS foreign import ccall unsafe "HsUnix.h __hscore_mkstemps" c_mkstemps :: CString -> CInt -> IO CInt #endif @@ -99,7 +110,7 @@ foreign import ccall unsafe "HsUnix.h __hscore_mkstemps" mkdtemp :: String -> IO FilePath mkdtemp template' = do let template = template' ++ "XXXXXX" -#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) +#if HAVE_MKDTEMP withFilePath template $ \ ptr -> do _ <- throwErrnoIfNull "mkdtemp" (c_mkdtemp ptr) name <- peekFilePath ptr @@ -108,7 +119,14 @@ mkdtemp template' = do name <- mktemp template h <- createDirectory name (toEnum 0o700) return name +#endif + +#if HAVE_MKDTEMP +foreign import ccall unsafe "HsUnix.h __hscore_mkdtemp" + c_mkdtemp :: CString -> IO CString +#endif +#if (!defined(__GLASGOW_HASKELL__) && !defined(__HUGS__)) || !HAVE_MKDTEMP -- | Make a unique file name It is required that the template have six trailing -- \'X\'s. This function should be considered deprecated. {-# WARNING mktemp "This function is unsafe; use mkstemp instead" #-} @@ -122,9 +140,3 @@ foreign import ccall unsafe "mktemp" c_mktemp :: CString -> IO CString #endif -foreign import ccall unsafe "HsUnix.h __hscore_mkstemp" - c_mkstemp :: CString -> IO CInt - -foreign import ccall unsafe "HsUnix.h __hscore_mkdtemp" - c_mkdtemp :: CString -> IO CString - diff --git a/System/Posix/Temp/ByteString.hsc b/System/Posix/Temp/ByteString.hsc index 02aca28..f2dd880 100644 --- a/System/Posix/Temp/ByteString.hsc +++ b/System/Posix/Temp/ByteString.hsc @@ -6,9 +6,10 @@ -- | -- Module : System.Posix.Temp.ByteString -- Copyright : (c) Volker Stolz +-- Deian Stefan -- License : BSD-style (see the file libraries/base/LICENSE) -- --- Maintainer : libraries@haskell.org +-- Maintainer : libraries@haskell.org, vs@foldr.org, deian@cs.stanford.edu -- Stability : provisional -- Portability : non-portable (requires POSIX) -- @@ -22,6 +23,8 @@ module System.Posix.Temp.ByteString ( #include "HsUnix.h" +import Control.Exception (throwIO) + import System.IO import System.Posix.IO import System.Posix.Types @@ -61,6 +64,10 @@ mkstemp template' = do #endif #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) +foreign import ccall unsafe "HsUnix.h __hscore_mkstemp" + c_mkstemp :: CString -> IO CInt +#endif + -- |'mkstemps' - make a unique filename with a given prefix and suffix -- and open it for reading\/writing (only safe on GHC & Hugs). -- The returned 'RawFilePath' is the (possibly relative) path of @@ -68,6 +75,7 @@ mkstemp template' = do -- the prefix and suffix. mkstemps :: ByteString -> ByteString -> IO (RawFilePath, Handle) mkstemps prefix suffix = do +#if HAVE_MKSTEMPS let template = prefix `B.append` (BC.pack "XXXXXX") `B.append` suffix lenOfsuf :: CInt lenOfsuf = fromIntegral $ B.length suffix @@ -76,7 +84,11 @@ mkstemps prefix suffix = do name <- peekFilePath ptr h <- fdToHandle (Fd fd) return (name, h) +#else + throwIO . userError $ "mkstemps: System does not have a mkstemp C function." +#endif +#if HAVE_MKSTEMPS foreign import ccall unsafe "HsUnix.h __hscore_mkstemps" c_mkstemps :: CString -> CInt -> IO CInt #endif @@ -90,7 +102,7 @@ foreign import ccall unsafe "HsUnix.h __hscore_mkstemps" mkdtemp :: ByteString -> IO RawFilePath mkdtemp template' = do let template = template' `B.append` (BC.pack "XXXXXX") -#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) +#if HAVE_MKDTEMP withFilePath template $ \ ptr -> do _ <- throwErrnoIfNull "mkdtemp" (c_mkdtemp ptr) name <- peekFilePath ptr @@ -99,7 +111,14 @@ mkdtemp template' = do name <- mktemp template h <- createDirectory (BC.unpack name) (toEnum 0o700) return name +#endif +#if HAVE_MKDTEMP +foreign import ccall unsafe "HsUnix.h __hscore_mkdtemp" + c_mkdtemp :: CString -> IO CString +#endif + +#if (!defined(__GLASGOW_HASKELL__) && !defined(__HUGS__)) || !HAVE_MKDTEMP -- | Make a unique file name It is required that the template have six trailing -- \'X\'s. This function should be considered deprecated. {-# WARNING mktemp "This function is unsafe; use mkstemp instead" #-} @@ -113,9 +132,3 @@ foreign import ccall unsafe "mktemp" c_mktemp :: CString -> IO CString #endif -foreign import ccall unsafe "HsUnix.h __hscore_mkstemp" - c_mkstemp :: CString -> IO CInt - -foreign import ccall unsafe "HsUnix.h __hscore_mkdtemp" - c_mkdtemp :: CString -> IO CString - diff --git a/cbits/HsUnix.c b/cbits/HsUnix.c index bb3a3c7..dd4b4f6 100644 --- a/cbits/HsUnix.c +++ b/cbits/HsUnix.c @@ -132,14 +132,21 @@ int __hsunix_push_module(int fd, const char *module) int __hscore_mkstemp(char *filetemplate) { return (mkstemp(filetemplate)); } -char *__hscore_mkdtemp(char *filetemplate) { - return (mkdtemp(filetemplate)); -} +#endif + +#if HAVE_MKSTEMPS int __hscore_mkstemps(char *filetemplate, int suffixlen) { return (mkstemps(filetemplate, suffixlen)); } #endif +#if HAVE_MKDTEMP +char *__hscore_mkdtemp(char *filetemplate) { + return (mkdtemp(filetemplate)); +} +#endif + + #if !defined(__MINGW32__) && !defined(irix_HOST_OS) int __hscore_getrlimit(int resource, struct rlimit *rlim) { return (getrlimit(resource, rlim)); diff --git a/configure.ac b/configure.ac index 1b65cf4..775af6c 100644 --- a/configure.ac +++ b/configure.ac @@ -34,6 +34,9 @@ AC_CHECK_FUNCS([ptsname]) AC_CHECK_FUNCS([setitimer]) AC_CHECK_FUNCS([readdir_r]) +# Additional temp functions +AC_CHECK_FUNCS([mkstemps mkdtemp]) + # Avoid adding rt if absent or unneeded AC_CHECK_LIB(rt, shm_open, [EXTRA_LIBS="$EXTRA_LIBS rt" CFLAGS="$CFLAGS -lrt"]) diff --git a/include/HsUnix.h b/include/HsUnix.h index 7cee73a..6a4d764 100644 --- a/include/HsUnix.h +++ b/include/HsUnix.h @@ -175,7 +175,13 @@ int __hsunix_push_module(int fd, const char *module); #if !defined(__MINGW32__) int __hscore_mkstemp(char *filetemplate); +#endif + +#if HAVE_MKSTEMPS int __hscore_mkstemps(char *filetemplate, int suffixlen); +#endif + +#if HAVE_MKDTEMP char *__hscore_mkdtemp(char *filetemplate); #endif -- cgit v1.2.3