-- | Open a file and make an 'FD' for it. Truncates the file to zero
-- size when the `IOMode` is `WriteMode`. Puts the file descriptor
-- into non-blocking mode on Unix systems.
-openFile :: FilePath -> IOMode -> IO (FD,IODeviceType)
-openFile filepath iomode =
+openFile :: FilePath -> IOMode -> Bool -> IO (FD,IODeviceType)
+openFile filepath iomode non_blocking =
withFilePath filepath $ \ f ->
let
binary_flags = 0
#endif
- oflags = oflags1 .|. binary_flags
+ oflags2 = oflags1 .|. binary_flags
+
+ oflags | non_blocking = oflags2 .|. nonblock_flags
+ | otherwise = oflags2
in do
-- the old implementation had a complicated series of three opens,
-- always returns EISDIR if the file is a directory and was opened
-- for writing, so I think we're ok with a single open() here...
fd <- throwErrnoIfMinus1Retry "openFile"
- (c_open f oflags 0o666)
+ (if non_blocking then c_open f oflags 0o666
+ else c_safe_open f oflags 0o666)
(fD,fd_type) <- mkFD fd iomode Nothing{-no stat-}
False{-not a socket-}
- True{-is non-blocking-}
+ non_blocking
`catchAny` \e -> do _ <- c_close fd
throwIO e
return (fD,fd_type)
std_flags, output_flags, read_flags, write_flags, rw_flags,
- append_flags :: CInt
-std_flags = o_NONBLOCK .|. o_NOCTTY
+ append_flags, nonblock_flags :: CInt
+std_flags = o_NOCTTY
output_flags = std_flags .|. o_CREAT
read_flags = std_flags .|. o_RDONLY
write_flags = output_flags .|. o_WRONLY
rw_flags = output_flags .|. o_RDWR
append_flags = write_flags .|. o_APPEND
+nonblock_flags = o_NONBLOCK
-- | Make a 'FD' from an existing file descriptor. Fails if the FD
module GHC.IO.Handle.FD (
stdin, stdout, stderr,
- openFile, openBinaryFile,
+ openFile, openBinaryFile, openFileBlocking,
mkHandleFromFD, fdToHandle, fdToHandle',
isEOF
) where
openFile :: FilePath -> IOMode -> IO Handle
openFile fp im =
catchException
- (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE)
+ (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE True)
+ (\e -> ioError (addFilePathToIOError "openFile" fp e))
+
+-- | Like 'openFile', but opens the file in ordinary blocking mode.
+-- This can be useful for opening a FIFO for reading: if we open in
+-- non-blocking mode then the open will fail if there are no writers,
+-- whereas a blocking open will block until a writer appears.
+openFileBlocking :: FilePath -> IOMode -> IO Handle
+openFileBlocking fp im =
+ catchException
+ (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE False)
(\e -> ioError (addFilePathToIOError "openFile" fp e))
-- | Like 'openFile', but open the file in binary mode.
openBinaryFile :: FilePath -> IOMode -> IO Handle
openBinaryFile fp m =
catchException
- (openFile' fp m True)
+ (openFile' fp m True True)
(\e -> ioError (addFilePathToIOError "openBinaryFile" fp e))
-openFile' :: String -> IOMode -> Bool -> IO Handle
-openFile' filepath iomode binary = do
+openFile' :: String -> IOMode -> Bool -> Bool -> IO Handle
+openFile' filepath iomode binary non_blocking = do
-- first open the file to get an FD
- (fd, fd_type) <- FD.openFile filepath iomode
+ (fd, fd_type) <- FD.openFile filepath iomode non_blocking
let mb_codec = if binary then Nothing else Just localeEncoding
-- then use it to make a Handle
- mkHandleFromFD fd fd_type filepath iomode True{-non-blocking-} mb_codec
+ mkHandleFromFD fd fd_type filepath iomode
+ False {- do not *set* non-blocking mode -}
+ mb_codec
`onException` IODevice.close fd
-- NB. don't forget to close the FD if mkHandleFromFD fails, otherwise
-- this FD leaks.
mkHandleFromFD
:: FD
-> IODeviceType
- -> FilePath -- a string describing this file descriptor (e.g. the filename)
+ -> FilePath -- a string describing this file descriptor (e.g. the filename)
-> IOMode
- -> Bool -- non_blocking (*sets* non-blocking mode on the FD)
+ -> Bool -- *set* non-blocking mode on the FD
-> Maybe TextEncoding
-> IO Handle