{- 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 - 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