148 lines
4.9 KiB
Haskell
148 lines
4.9 KiB
Haskell
{- This is a subset of the functions provided by file-io.
|
|
-
|
|
- All functions have been modified to set the close-on-exec
|
|
- flag to True.
|
|
-
|
|
- Also, functions that return a Handle (for a non-binary file)
|
|
- have been modified to use the locale encoding, working around
|
|
- this bug: https://github.com/haskell/file-io/issues/45
|
|
-
|
|
- Copyright 2025 Joey Hess <id@joeyh.name>
|
|
- Copyright 2024 Julian Ospald
|
|
-
|
|
- License: BSD-3-clause
|
|
-}
|
|
|
|
{-# OPTIONS_GHC -fno-warn-tabs #-}
|
|
{-# LANGUAGE CPP #-}
|
|
{-# LANGUAGE NoImplicitPrelude #-}
|
|
|
|
module Utility.FileIO.CloseOnExec
|
|
(
|
|
#ifdef WITH_OSPATH
|
|
withFile,
|
|
withFile',
|
|
openFile,
|
|
withBinaryFile,
|
|
openBinaryFile,
|
|
readFile,
|
|
readFile',
|
|
writeFile,
|
|
writeFile',
|
|
appendFile,
|
|
appendFile',
|
|
openTempFile,
|
|
#endif
|
|
) where
|
|
|
|
#ifdef WITH_OSPATH
|
|
|
|
import System.File.OsPath.Internal (withOpenFile', augmentError)
|
|
import qualified System.File.OsPath.Internal as I
|
|
import System.IO (IO, Handle, IOMode(..), hSetEncoding)
|
|
import GHC.IO.Encoding (getLocaleEncoding)
|
|
import System.OsPath (OsPath, OsString)
|
|
import Prelude (Bool(..), pure, either, (.), (>>=), ($))
|
|
import Control.Exception
|
|
import qualified Data.ByteString as BS
|
|
import qualified Data.ByteString.Lazy as BSL
|
|
#ifndef mingw32_HOST_OS
|
|
import System.Posix.IO
|
|
import Utility.Process
|
|
#endif
|
|
|
|
closeOnExec :: Bool
|
|
closeOnExec = True
|
|
|
|
withFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r
|
|
withFile osfp iomode act = (augmentError "withFile" osfp
|
|
$ withOpenFileEncoding osfp iomode False False closeOnExec (try . act) True)
|
|
>>= either ioError pure
|
|
|
|
withFile' :: OsPath -> IOMode -> (Handle -> IO r) -> IO r
|
|
withFile' osfp iomode act = (augmentError "withFile'" osfp
|
|
$ withOpenFileEncoding osfp iomode False False closeOnExec (try . act) False)
|
|
>>= either ioError pure
|
|
|
|
openFile :: OsPath -> IOMode -> IO Handle
|
|
openFile osfp iomode = augmentError "openFile" osfp $
|
|
withOpenFileEncoding osfp iomode False False closeOnExec pure False
|
|
|
|
withBinaryFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r
|
|
withBinaryFile osfp iomode act = (augmentError "withBinaryFile" osfp
|
|
$ withOpenFile' osfp iomode True False closeOnExec (try . act) True)
|
|
>>= either ioError pure
|
|
|
|
openBinaryFile :: OsPath -> IOMode -> IO Handle
|
|
openBinaryFile osfp iomode = augmentError "openBinaryFile" osfp $
|
|
withOpenFile' osfp iomode True False closeOnExec pure False
|
|
|
|
readFile :: OsPath -> IO BSL.ByteString
|
|
readFile fp = withFileNoEncoding' fp ReadMode BSL.hGetContents
|
|
|
|
readFile'
|
|
:: OsPath -> IO BS.ByteString
|
|
readFile' fp = withFileNoEncoding fp ReadMode BS.hGetContents
|
|
|
|
writeFile :: OsPath -> BSL.ByteString -> IO ()
|
|
writeFile fp contents = withFileNoEncoding fp WriteMode (`BSL.hPut` contents)
|
|
|
|
writeFile'
|
|
:: OsPath -> BS.ByteString -> IO ()
|
|
writeFile' fp contents = withFileNoEncoding fp WriteMode (`BS.hPut` contents)
|
|
|
|
appendFile :: OsPath -> BSL.ByteString -> IO ()
|
|
appendFile fp contents = withFileNoEncoding fp AppendMode (`BSL.hPut` contents)
|
|
|
|
appendFile'
|
|
:: OsPath -> BS.ByteString -> IO ()
|
|
appendFile' fp contents = withFileNoEncoding fp AppendMode (`BS.hPut` contents)
|
|
|
|
{- Re-implementing openTempFile is difficult due to the current
|
|
- structure of file-io. See this issue for discussion about improving
|
|
- that: https://github.com/haskell/file-io/issues/44
|
|
- So, instead this uses noCreateProcessWhile.
|
|
- -}
|
|
openTempFile :: OsPath -> OsString -> IO (OsPath, Handle)
|
|
openTempFile tmp_dir template = do
|
|
#ifdef mingw32_HOST_OS
|
|
(p, h) <- I.openTempFile tmp_dir template
|
|
getLocaleEncoding >>= hSetEncoding h
|
|
pure (p, h)
|
|
#else
|
|
noCreateProcessWhile $ do
|
|
(p, h) <- I.openTempFile tmp_dir template
|
|
fd <- handleToFd h
|
|
setFdOption fd CloseOnExec True
|
|
h' <- fdToHandle fd
|
|
getLocaleEncoding >>= hSetEncoding h'
|
|
pure (p, h')
|
|
#endif
|
|
|
|
{- Wrapper around withOpenFile' that sets the locale encoding on the
|
|
- Handle. -}
|
|
withOpenFileEncoding :: OsPath -> IOMode -> Bool -> Bool -> Bool -> (Handle -> IO r) -> Bool -> IO r
|
|
withOpenFileEncoding fp iomode binary existing cloExec action close_finally =
|
|
withOpenFile' fp iomode binary existing cloExec action' close_finally
|
|
where
|
|
action' h = do
|
|
getLocaleEncoding >>= hSetEncoding h
|
|
action h
|
|
|
|
{- Variant of withFile above that does not have the overhead of setting the
|
|
- locale encoding. Faster to use when the Handle is not used in a way that
|
|
- needs any encoding. -}
|
|
withFileNoEncoding :: OsPath -> IOMode -> (Handle -> IO r) -> IO r
|
|
withFileNoEncoding osfp iomode act = (augmentError "withFile" osfp
|
|
$ withOpenFile' osfp iomode False False closeOnExec (try . act) True)
|
|
>>= either ioError pure
|
|
|
|
{- Variant of withFile' above that does not have the overhead of setting the
|
|
- locale encoding. Faster to use when the Handle is not used in a way that
|
|
- needs any encoding. -}
|
|
withFileNoEncoding' :: OsPath -> IOMode -> (Handle -> IO r) -> IO r
|
|
withFileNoEncoding' osfp iomode act = (augmentError "withFile'" osfp
|
|
$ withOpenFile' osfp iomode False False closeOnExec (try . act) False)
|
|
>>= either ioError pure
|
|
|
|
#endif
|