fd8b643b26d8f991f2fd8b4af80734171a9e9981
[packages/unix.git] / System / Posix / IO.hsc
1 {-# LANGUAGE ForeignFunctionInterface #-}
2 {-# OPTIONS_GHC -fno-warn-unused-imports #-}
3 -----------------------------------------------------------------------------
4 -- |
5 -- Module      :  System.Posix.IO
6 -- Copyright   :  (c) The University of Glasgow 2002
7 -- License     :  BSD-style (see the file libraries/base/LICENSE)
8 -- 
9 -- Maintainer  :  libraries@haskell.org
10 -- Stability   :  provisional
11 -- Portability :  non-portable (requires POSIX)
12 --
13 -- POSIX IO support.  These types and functions correspond to the unix
14 -- functions open(2), close(2), etc.  For more portable functions
15 -- which are more like fopen(3) and friends from stdio.h, see
16 -- "System.IO".
17 --
18 -----------------------------------------------------------------------------
19
20 module System.Posix.IO (
21     -- * Input \/ Output
22
23     -- ** Standard file descriptors
24     stdInput, stdOutput, stdError,
25
26     -- ** Opening and closing files
27     OpenMode(..),
28     OpenFileFlags(..), defaultFileFlags,
29     openFd, createFile,
30     closeFd,
31
32     -- ** Reading\/writing data
33     -- |Programmers using the 'fdRead' and 'fdWrite' API should be aware that
34     -- EAGAIN exceptions may occur for non-blocking IO!
35
36     fdRead, fdWrite,
37
38     -- ** Seeking
39     fdSeek,
40
41     -- ** File options
42     FdOption(..),
43     queryFdOption,
44     setFdOption,
45
46     -- ** Locking
47     FileLock,
48     LockRequest(..),
49     getLock,  setLock,
50     waitToSetLock,
51
52     -- ** Pipes
53     createPipe,
54
55     -- ** Duplicating file descriptors
56     dup, dupTo,
57
58     -- ** Converting file descriptors to\/from Handles
59     handleToFd,
60     fdToHandle,  
61
62   ) where
63
64 import System.IO
65 import System.IO.Error
66 import System.Posix.Types
67 import System.Posix.Error
68 import System.Posix.Internals
69
70 import Foreign
71 import Foreign.C
72 import Data.Bits
73
74 #ifdef __GLASGOW_HASKELL__
75 import GHC.IOBase
76 import GHC.Handle hiding (fdToHandle)
77 import qualified GHC.Handle
78 #endif
79
80 #ifdef __HUGS__
81 import Hugs.Prelude (IOException(..), IOErrorType(..))
82 import qualified Hugs.IO (handleToFd, openFd)
83 #endif
84
85 #include "HsUnix.h"
86
87 -- -----------------------------------------------------------------------------
88 -- Pipes
89 -- |The 'createPipe' function creates a pair of connected file
90 -- descriptors. The first component is the fd to read from, the second
91 -- is the write end.  Although pipes may be bidirectional, this
92 -- behaviour is not portable and programmers should use two separate
93 -- pipes for this purpose.  May throw an exception if this is an
94 -- invalid descriptor.
95
96 createPipe :: IO (Fd, Fd)
97 createPipe =
98   allocaArray 2 $ \p_fd -> do
99     throwErrnoIfMinus1_ "createPipe" (c_pipe p_fd)
100     rfd <- peekElemOff p_fd 0
101     wfd <- peekElemOff p_fd 1
102     return (Fd rfd, Fd wfd)
103
104 -- -----------------------------------------------------------------------------
105 -- Duplicating file descriptors
106
107 -- | May throw an exception if this is an invalid descriptor.
108 dup :: Fd -> IO Fd
109 dup (Fd fd) = do r <- throwErrnoIfMinus1 "dup" (c_dup fd); return (Fd r)
110
111 -- | May throw an exception if this is an invalid descriptor.
112 dupTo :: Fd -> Fd -> IO Fd
113 dupTo (Fd fd1) (Fd fd2) = do
114   r <- throwErrnoIfMinus1 "dupTo" (c_dup2 fd1 fd2)
115   return (Fd r)
116
117 -- -----------------------------------------------------------------------------
118 -- Opening and closing files
119
120 stdInput, stdOutput, stdError :: Fd
121 stdInput   = Fd (#const STDIN_FILENO)
122 stdOutput  = Fd (#const STDOUT_FILENO)
123 stdError   = Fd (#const STDERR_FILENO)
124
125 data OpenMode = ReadOnly | WriteOnly | ReadWrite
126
127 -- |Correspond to some of the int flags from C's fcntl.h.
128 data OpenFileFlags =
129  OpenFileFlags {
130     append    :: Bool, -- ^ O_APPEND
131     exclusive :: Bool, -- ^ O_EXCL
132     noctty    :: Bool, -- ^ O_NOCTTY
133     nonBlock  :: Bool, -- ^ O_NONBLOCK
134     trunc     :: Bool  -- ^ O_TRUNC
135  }
136
137
138 -- |Default values for the 'OpenFileFlags' type. False for each of
139 -- append, exclusive, noctty, nonBlock, and trunc.
140 defaultFileFlags :: OpenFileFlags
141 defaultFileFlags =
142  OpenFileFlags {
143     append    = False,
144     exclusive = False,
145     noctty    = False,
146     nonBlock  = False,
147     trunc     = False
148   }
149
150
151 -- |Open and optionally create this file.  See 'System.Posix.Files'
152 -- for information on how to use the 'FileMode' type.
153 openFd :: FilePath
154        -> OpenMode
155        -> Maybe FileMode -- ^Just x => creates the file with the given modes, Nothing => the file must exist.
156        -> OpenFileFlags
157        -> IO Fd
158 openFd name how maybe_mode (OpenFileFlags appendFlag exclusiveFlag nocttyFlag
159                                 nonBlockFlag truncateFlag) = do
160    withCString name $ \s -> do
161     fd <- throwErrnoPathIfMinus1 "openFd" name (c_open s all_flags mode_w)
162     return (Fd fd)
163   where
164     all_flags  = creat .|. flags .|. open_mode
165
166     flags =
167        (if appendFlag    then (#const O_APPEND)   else 0) .|.
168        (if exclusiveFlag then (#const O_EXCL)     else 0) .|.
169        (if nocttyFlag    then (#const O_NOCTTY)   else 0) .|.
170        (if nonBlockFlag  then (#const O_NONBLOCK) else 0) .|.
171        (if truncateFlag  then (#const O_TRUNC)    else 0)
172
173     (creat, mode_w) = case maybe_mode of 
174                         Nothing -> (0,0)
175                         Just x  -> ((#const O_CREAT), x)
176
177     open_mode = case how of
178                    ReadOnly  -> (#const O_RDONLY)
179                    WriteOnly -> (#const O_WRONLY)
180                    ReadWrite -> (#const O_RDWR)
181
182 -- |Create and open this file in WriteOnly mode.  A special case of
183 -- 'openFd'.  See 'System.Posix.Files' for information on how to use
184 -- the 'FileMode' type.
185
186 createFile :: FilePath -> FileMode -> IO Fd
187 createFile name mode
188   = openFd name WriteOnly (Just mode) defaultFileFlags{ trunc=True } 
189
190 -- |Close this file descriptor.  May throw an exception if this is an
191 -- invalid descriptor.
192
193 closeFd :: Fd -> IO ()
194 closeFd (Fd fd) = throwErrnoIfMinus1_ "closeFd" (c_close fd)
195
196 -- -----------------------------------------------------------------------------
197 -- Converting file descriptors to/from Handles
198
199 -- | Extracts the 'Fd' from a 'Handle'.  This function has the side effect
200 -- of closing the 'Handle' and flushing its write buffer, if necessary.
201 handleToFd :: Handle -> IO Fd
202
203 -- | Converts an 'Fd' into a 'Handle' that can be used with the
204 -- standard Haskell IO library (see "System.IO").  
205 --
206 -- GHC only: this function has the side effect of putting the 'Fd'
207 -- into non-blocking mode (@O_NONBLOCK@) due to the way the standard
208 -- IO library implements multithreaded I\/O.
209 --
210 fdToHandle :: Fd -> IO Handle
211
212 #ifdef __GLASGOW_HASKELL__
213 handleToFd h = withHandle "handleToFd" h $ \ h_ -> do
214   -- converting a Handle into an Fd effectively means
215   -- letting go of the Handle; it is put into a closed
216   -- state as a result. 
217   let fd = haFD h_
218   flushWriteBufferOnly h_
219   unlockFile (fromIntegral fd)
220     -- setting the Handle's fd to (-1) as well as its 'type'
221     -- to closed, is enough to disable the finalizer that
222     -- eventually is run on the Handle.
223   return (h_{haFD= (-1),haType=ClosedHandle}, Fd (fromIntegral fd))
224
225 fdToHandle fd = GHC.Handle.fdToHandle (fromIntegral fd)
226 #endif
227
228 #ifdef __HUGS__
229 handleToFd h = do
230   fd <- Hugs.IO.handleToFd h
231   return (fromIntegral fd)
232
233 fdToHandle fd = do
234   mode <- fdGetMode (fromIntegral fd)
235   Hugs.IO.openFd (fromIntegral fd) False mode True
236 #endif
237
238 -- -----------------------------------------------------------------------------
239 -- Fd options
240
241 data FdOption = AppendOnWrite     -- ^O_APPEND
242               | CloseOnExec       -- ^FD_CLOEXEC
243               | NonBlockingRead   -- ^O_NONBLOCK
244               | SynchronousWrites -- ^O_SYNC
245
246 fdOption2Int :: FdOption -> CInt
247 fdOption2Int CloseOnExec       = (#const FD_CLOEXEC)
248 fdOption2Int AppendOnWrite     = (#const O_APPEND)
249 fdOption2Int NonBlockingRead   = (#const O_NONBLOCK)
250 fdOption2Int SynchronousWrites = (#const O_SYNC)
251
252 -- | May throw an exception if this is an invalid descriptor.
253 queryFdOption :: Fd -> FdOption -> IO Bool
254 queryFdOption (Fd fd) opt = do
255   r <- throwErrnoIfMinus1 "queryFdOption" (c_fcntl_read fd flag)
256   return ((r .&. fdOption2Int opt) /= 0)
257  where
258   flag    = case opt of
259               CloseOnExec       -> (#const F_GETFD)
260               _                 -> (#const F_GETFL)
261
262 -- | May throw an exception if this is an invalid descriptor.
263 setFdOption :: Fd -> FdOption -> Bool -> IO ()
264 setFdOption (Fd fd) opt val = do
265   r <- throwErrnoIfMinus1 "setFdOption" (c_fcntl_read fd getflag)
266   let r' | val       = r .|. opt_val
267          | otherwise = r .&. (complement opt_val)
268   throwErrnoIfMinus1_ "setFdOption"
269                       (c_fcntl_write fd setflag (fromIntegral r'))
270  where
271   (getflag,setflag)= case opt of
272               CloseOnExec       -> ((#const F_GETFD),(#const F_SETFD)) 
273               _                 -> ((#const F_GETFL),(#const F_SETFL))
274   opt_val = fdOption2Int opt
275
276 -- -----------------------------------------------------------------------------
277 -- Seeking 
278
279 mode2Int :: SeekMode -> CInt
280 mode2Int AbsoluteSeek = (#const SEEK_SET)
281 mode2Int RelativeSeek = (#const SEEK_CUR)
282 mode2Int SeekFromEnd  = (#const SEEK_END)
283
284 -- | May throw an exception if this is an invalid descriptor.
285 fdSeek :: Fd -> SeekMode -> FileOffset -> IO FileOffset
286 fdSeek (Fd fd) mode off =
287   throwErrnoIfMinus1 "fdSeek" (c_lseek fd off (mode2Int mode))
288
289 -- -----------------------------------------------------------------------------
290 -- Locking
291
292 data LockRequest = ReadLock
293                  | WriteLock
294                  | Unlock
295
296 type FileLock = (LockRequest, SeekMode, FileOffset, FileOffset)
297
298 -- | May throw an exception if this is an invalid descriptor.
299 getLock :: Fd -> FileLock -> IO (Maybe (ProcessID, FileLock))
300 getLock (Fd fd) lock =
301   allocaLock lock $ \p_flock -> do
302     throwErrnoIfMinus1_ "getLock" (c_fcntl_lock fd (#const F_GETLK) p_flock)
303     result <- bytes2ProcessIDAndLock p_flock
304     return (maybeResult result)
305   where
306     maybeResult (_, (Unlock, _, _, _)) = Nothing
307     maybeResult x = Just x
308
309 allocaLock :: FileLock -> (Ptr CFLock -> IO a) -> IO a
310 allocaLock (lockreq, mode, start, len) io = 
311   allocaBytes (#const sizeof(struct flock)) $ \p -> do
312     (#poke struct flock, l_type)   p (lockReq2Int lockreq :: CShort)
313     (#poke struct flock, l_whence) p (fromIntegral (mode2Int mode) :: CShort)
314     (#poke struct flock, l_start)  p start
315     (#poke struct flock, l_len)    p len
316     io p
317
318 lockReq2Int :: LockRequest -> CShort
319 lockReq2Int ReadLock  = (#const F_RDLCK)
320 lockReq2Int WriteLock = (#const F_WRLCK)
321 lockReq2Int Unlock    = (#const F_UNLCK)
322
323 bytes2ProcessIDAndLock :: Ptr CFLock -> IO (ProcessID, FileLock)
324 bytes2ProcessIDAndLock p = do
325   req   <- (#peek struct flock, l_type)   p
326   mode  <- (#peek struct flock, l_whence) p
327   start <- (#peek struct flock, l_start)  p
328   len   <- (#peek struct flock, l_len)    p
329   pid   <- (#peek struct flock, l_pid)    p
330   return (pid, (int2req req, int2mode mode, start, len))
331  where
332   int2req :: CShort -> LockRequest
333   int2req (#const F_RDLCK) = ReadLock
334   int2req (#const F_WRLCK) = WriteLock
335   int2req (#const F_UNLCK) = Unlock
336   int2req _ = error $ "int2req: bad argument"
337
338   int2mode :: CShort -> SeekMode
339   int2mode (#const SEEK_SET) = AbsoluteSeek
340   int2mode (#const SEEK_CUR) = RelativeSeek
341   int2mode (#const SEEK_END) = SeekFromEnd
342   int2mode _ = error $ "int2mode: bad argument"
343
344 -- | May throw an exception if this is an invalid descriptor.
345 setLock :: Fd -> FileLock -> IO ()
346 setLock (Fd fd) lock = do
347   allocaLock lock $ \p_flock ->
348     throwErrnoIfMinus1_ "setLock" (c_fcntl_lock fd (#const F_SETLK) p_flock)
349
350 -- | May throw an exception if this is an invalid descriptor.
351 waitToSetLock :: Fd -> FileLock -> IO ()
352 waitToSetLock (Fd fd) lock = do
353   allocaLock lock $ \p_flock ->
354     throwErrnoIfMinus1_ "waitToSetLock" 
355         (c_fcntl_lock fd (#const F_SETLKW) p_flock)
356
357 -- -----------------------------------------------------------------------------
358 -- fd{Read,Write}
359
360 -- | May throw an exception if this is an invalid descriptor.
361 fdRead :: Fd
362        -> ByteCount -- ^How many bytes to read
363        -> IO (String, ByteCount) -- ^The bytes read, how many bytes were read.
364 fdRead _fd 0 = return ("", 0)
365 fdRead (Fd fd) nbytes = do
366     allocaBytes (fromIntegral nbytes) $ \ bytes -> do
367     rc    <-  throwErrnoIfMinus1Retry "fdRead" (c_read fd bytes nbytes)
368     case fromIntegral rc of
369       0 -> ioError (ioeSetErrorString (mkIOError EOF "fdRead" Nothing Nothing) "EOF")
370       n -> do
371        s <- peekCStringLen (bytes, fromIntegral n)
372        return (s, n)
373
374 -- | May throw an exception if this is an invalid descriptor.
375 fdWrite :: Fd -> String -> IO ByteCount
376 fdWrite (Fd fd) str = withCStringLen str $ \ (strPtr,len) -> do
377     rc <- throwErrnoIfMinus1Retry "fdWrite" (c_write fd strPtr (fromIntegral len))
378     return (fromIntegral rc)