fix bugs and added mkdtemp
[packages/unix.git] / System / Posix / Temp / ByteString.hsc
1 {-# LANGUAGE ForeignFunctionInterface #-}
2 #if __GLASGOW_HASKELL__ >= 701
3 {-# LANGUAGE Trustworthy #-}
4 #endif
5 -----------------------------------------------------------------------------
6 -- |
7 -- Module      :  System.Posix.Temp.ByteString
8 -- Copyright   :  (c) Volker Stolz <vs@foldr.org>
9 -- License     :  BSD-style (see the file libraries/base/LICENSE)
10 --
11 -- Maintainer  :  vs@foldr.org
12 -- Stability   :  provisional
13 -- Portability :  non-portable (requires POSIX)
14 --
15 -- POSIX environment support
16 --
17 -----------------------------------------------------------------------------
18
19 module System.Posix.Temp.ByteString (
20
21     mkstemp
22   , mkdtemp
23
24 {- Not ported (yet?):
25     tmpfile: can we handle FILE*?
26     tmpnam: ISO C, should go in base?
27     tempname: dito
28 -}
29
30 ) where
31
32 #include "HsUnix.h"
33
34 import System.IO        (
35      Handle,
36      openFile,
37      IOMode(..) )
38 import System.Posix.IO
39 import System.Posix.Types
40 import System.Posix.Directory (createDirectory)
41
42 import Foreign.C hiding (
43      throwErrnoPath,
44      throwErrnoPathIf,
45      throwErrnoPathIf_,
46      throwErrnoPathIfNull,
47      throwErrnoPathIfMinus1,
48      throwErrnoPathIfMinus1_ )
49
50 import System.Posix.ByteString.FilePath
51
52 import Data.ByteString (ByteString)
53 import qualified Data.ByteString as B
54 import qualified Data.ByteString.Char8 as BC
55
56
57 -- |'mkstemp' - make a unique filename and open it for
58 -- reading\/writing (only safe on GHC & Hugs).
59 -- The returned 'RawFilePath' is the (possibly relative) path of
60 -- the created file, which is padded with 6 random characters.
61 mkstemp :: ByteString -> IO (RawFilePath, Handle)
62 mkstemp template' = do
63   let template = template' `B.append` (BC.pack "XXXXXX")
64 #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
65   withFilePath template $ \ ptr -> do
66     fd <- throwErrnoIfMinus1 "mkstemp" (c_mkstemp ptr)
67     name <- peekFilePath ptr
68     h <- fdToHandle (Fd fd)
69     return (name, h)
70 #else
71   name <- mktemp template
72   h <- openFile (BC.unpack name) ReadWriteMode
73   return (name, h)
74 #endif
75
76 -- |'mkdtemp' - make a unique directory (only safe on GHC & Hugs).
77 -- The returned 'FilePath' is the path of the created directory,
78 -- which is padded with 6 random characters.
79 mkdtemp :: ByteString -> IO RawFilePath
80 mkdtemp template' = do
81   let template = template' `B.append` (BC.pack "XXXXXX")
82 #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
83   withFilePath template $ \ ptr -> do
84     throwErrnoIfNull "mkdtemp" (c_mkdtemp ptr)
85     name <- peekFilePath ptr
86     return name
87 #else
88   name <- mktemp template
89   h <- createDirectory (BC.unpack name) (toEnum 0o700)
90   return name
91 #endif
92
93 #if !defined(__GLASGOW_HASKELL__) && !defined(__HUGS__)
94 -- |'mktemp' - make a unique file name
95 -- It is required that the template have six trailing \'X\'s.
96 -- This function should be considered deprecated
97 mktemp :: ByteString -> IO RawFilePath
98 mktemp template = do
99   withFilePath template $ \ ptr -> do
100     ptr <- throwErrnoIfNull "mktemp" (c_mktemp ptr)
101     peekFilePath ptr
102
103 foreign import ccall unsafe "mktemp"
104   c_mktemp :: CString -> IO CString
105 #endif
106
107 foreign import ccall unsafe "HsUnix.h __hscore_mkstemp"
108   c_mkstemp :: CString -> IO CInt
109
110 foreign import ccall unsafe "HsUnix.h __hscore_mkdtemp"
111   c_mkdtemp :: CString -> IO CString