3e9807bc03Works around this bug https://github.com/haskell/file-io/issues/45 The fix is in Utility.FileIO.CloseOnExec because all use of file-io is already wrapped through that module. Although perhaps that ought to be refactored at this point. I'd hope that file-io will eventually fix this bug, and also provide CloseOnExec variants of its functions. That would allow depending on the fixed version, and removing this ugly code. Note that, functions like readFile that don't care about the encoding due to reading/writing a ByteString were kept optimally fast by not setting the encoding. This avoids an IORef read and write per open. Sponsored-by: Graham Spencer
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 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
|
|
$ withOpenFileEncoding osfp iomode True False closeOnExec (try . act) True)
|
|
>>= either ioError pure
|
|
|
|
openBinaryFile :: OsPath -> IOMode -> IO Handle
|
|
openBinaryFile osfp iomode = augmentError "openBinaryFile" osfp $
|
|
withOpenFileEncoding 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
|