1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
{- 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
|
