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