fillReadBuffer, fillReadBufferWithoutBlocking,
readRawBuffer, readRawBufferPtr,
writeRawBuffer, writeRawBufferPtr,
+
+#ifndef mingw32_TARGET_OS
unlockFile,
-
+#endif
+
ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
stdin, stdout, stderr,
- IOMode(..), openFile, openBinaryFile, openFd, fdToHandle,
- hFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
+ IOMode(..), openFile, openBinaryFile, openTempFile, openBinaryTempFile, openFd, fdToHandle,
+ hFileSize, hSetFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
hFlush, hDuplicate, hDuplicateTo,
hClose, hClose_help,
import Foreign.C
import System.IO.Error
import System.Posix.Internals
+import System.FilePath
import GHC.Real
ReadWriteMode -> rw_flags
AppendMode -> append_flags
- truncate | WriteMode <- mode = True
- | otherwise = False
-
binary_flags
| binary = o_BINARY
| otherwise = 0
throwErrnoIfMinus1Retry "openFile"
(c_open f (fromIntegral oflags) 0o666)
- openFd fd Nothing False filepath mode binary truncate
+ openFd fd Nothing False filepath mode binary
`catchException` \e -> do c_close (fromIntegral fd); throw e
-- NB. don't forget to close the FD if openFd fails, otherwise
-- this FD leaks.
-- (so we don't need to worry about removing the newly created file
-- in the event of an error).
+-- | The function creates a temporary file in ReadWrite mode.
+-- The created file isn\'t deleted automatically, so you need to delete it manually.
+openTempFile :: FilePath -- ^ Directory in which to create the file
+ -> String -- ^ File name template. If the template is \"foo.ext\" then
+ -- the create file will be \"fooXXX.ext\" where XXX is some
+ -- random number.
+ -> IO (FilePath, Handle)
+openTempFile tmp_dir template = openTempFile' "openTempFile" tmp_dir template dEFAULT_OPEN_IN_BINARY_MODE
+
+-- | Like 'openTempFile', but opens the file in binary mode. See 'openBinaryFile' for more comments.
+openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle)
+openBinaryTempFile tmp_dir template = openTempFile' "openBinaryTempFile" tmp_dir template True
+
+openTempFile' :: String -> FilePath -> String -> Bool -> IO (FilePath, Handle)
+openTempFile' loc tmp_dir template binary = do
+ pid <- c_getpid
+ findTempName pid
+ where
+ (prefix,suffix) = break (=='.') template
+
+ oflags1 = rw_flags .|. o_EXCL
+
+ binary_flags
+ | binary = o_BINARY
+ | otherwise = 0
+
+ oflags = oflags1 .|. binary_flags
+
+ findTempName x = do
+ fd <- withCString filepath $ \ f ->
+ c_open f oflags 0o666
+ if fd < 0
+ then do
+ errno <- getErrno
+ if errno == eEXIST
+ then findTempName (x+1)
+ else ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
+ else do
+ h <- openFd (fromIntegral fd) Nothing False filepath ReadWriteMode True
+ `catchException` \e -> do c_close (fromIntegral fd); throw e
+ return (filepath, h)
+ where
+ filename = prefix ++ show x ++ suffix
+ filepath = tmp_dir `joinFileName` filename
+
std_flags = o_NONBLOCK .|. o_NOCTTY
output_flags = std_flags .|. o_CREAT
read_flags = std_flags .|. o_RDONLY
-write_flags = output_flags .|. o_WRONLY
+write_flags = output_flags .|. o_WRONLY .|. o_TRUNC
rw_flags = output_flags .|. o_RDWR
append_flags = write_flags .|. o_APPEND
-- ---------------------------------------------------------------------------
-- openFd
-openFd :: FD -> Maybe FDType -> Bool -> FilePath -> IOMode -> Bool -> Bool -> IO Handle
-openFd fd mb_fd_type is_socket filepath mode binary truncate = do
+openFd :: FD -> Maybe FDType -> Bool -> FilePath -> IOMode -> Bool -> IO Handle
+openFd fd mb_fd_type is_socket filepath mode binary = do
-- turn on non-blocking mode
setNonBlockingFD fd
-- regular files need to be locked
RegularFile -> do
+#ifndef mingw32_TARGET_OS
r <- lockFile (fromIntegral fd) (fromBool write) 1{-exclusive-}
when (r == -1) $
ioException (IOError Nothing ResourceBusy "openFile"
"file is locked" Nothing)
-
- -- truncate the file if necessary
- when truncate (fileTruncate filepath)
-
+#endif
mkFileHandle fd is_socket filepath ha_type binary
fdToHandle fd = do
mode <- fdGetMode fd
let fd_str = "<file descriptor: " ++ show fd ++ ">"
- openFd fd Nothing False{-XXX!-} fd_str mode True{-bin mode-} False{-no truncate-}
+ openFd fd Nothing False{-XXX!-} fd_str mode True{-bin mode-}
+
+#ifndef mingw32_TARGET_OS
foreign import ccall unsafe "lockFile"
lockFile :: CInt -> CInt -> CInt -> IO CInt
foreign import ccall unsafe "unlockFile"
unlockFile :: CInt -> IO CInt
+#endif
mkStdHandle :: FD -> FilePath -> HandleType -> IORef Buffer -> BufferMode
-> IO Handle
-- free the spare buffers
writeIORef (haBuffers handle_) BufferListNil
+#ifndef mingw32_TARGET_OS
-- unlock it
unlockFile c_fd
-
+#endif
+
-- we must set the fd to -1, because the finalizer is going
-- to run eventually and try to close/unlock it.
return (handle_{ haFD = -1,
})
-----------------------------------------------------------------------------
--- Detecting the size of a file
+-- Detecting and changing the size of a file
-- | For a handle @hdl@ which attached to a physical file,
-- 'hFileSize' @hdl@ returns the size of that file in 8-bit bytes.
else ioException (IOError Nothing InappropriateType "hFileSize"
"not a regular file" Nothing)
+
+-- | 'hSetFileSize' @hdl@ @size@ truncates the physical file with handle @hdl@ to @size@ bytes.
+
+hSetFileSize :: Handle -> Integer -> IO ()
+hSetFileSize handle size =
+ withHandle_ "hSetFileSize" handle $ \ handle_ -> do
+ case haType handle_ of
+ ClosedHandle -> ioe_closedHandle
+ SemiClosedHandle -> ioe_closedHandle
+ _ -> do flushWriteBufferOnly handle_
+ throwErrnoIf (/=0) "hSetFileSize"
+ (c_ftruncate (fromIntegral (haFD handle_)) (fromIntegral size))
+ return ()
+
-- ---------------------------------------------------------------------------
-- Detecting the End of Input
hDuplicate :: Handle -> IO Handle
hDuplicate h@(FileHandle path m) = do
new_h_ <- withHandle' "hDuplicate" h m (dupHandle_ Nothing)
- new_m <- newMVar new_h_
- return (FileHandle path new_m)
+ newFileHandle path (handleFinalizer path) new_h_
hDuplicate h@(DuplexHandle path r w) = do
new_w_ <- withHandle' "hDuplicate" h w (dupHandle_ Nothing)
new_w <- newMVar new_w_
new_r_ <- withHandle' "hDuplicate" h r (dupHandle_ (Just new_w))
new_r <- newMVar new_r_
+ addMVarFinalizer new_w (handleFinalizer path new_w)
return (DuplexHandle path new_r new_w)
dupHandle_ other_side h_ = do
projects / ghc-base.git / blobdiff