1
1
{-# LANGUAGE CApiFFI #-}
2
- {-# LANGUAGE Safe #-}
2
+ {-# LANGUAGE Trustworthy #-}
3
3
4
4
-----------------------------------------------------------------------------
5
5
-- |
@@ -21,23 +21,28 @@ module System.Posix.Env.ByteString (
21
21
, getEnvDefault
22
22
, getEnvironmentPrim
23
23
, getEnvironment
24
+ , setEnvironment
24
25
, putEnv
25
26
, setEnv
26
- , unsetEnv
27
+ , unsetEnv
28
+ , clearEnv
27
29
28
30
-- * Program arguments
29
31
, getArgs
30
32
) where
31
33
32
34
#include "HsUnix.h"
33
35
36
+ import Control.Monad
34
37
import Foreign
35
38
import Foreign.C
36
39
import Data.Maybe ( fromMaybe )
37
40
41
+ import System.Posix.Env ( clearEnv )
38
42
import qualified Data.ByteString as B
39
43
import qualified Data.ByteString.Char8 as BC
40
44
import Data.ByteString (ByteString )
45
+ import Data.ByteString.Internal (ByteString (PS ), memcpy )
41
46
42
47
-- | 'getEnv' looks up a variable in the environment.
43
48
@@ -96,6 +101,18 @@ getEnvironment = do
96
101
| BC. head y == ' =' = (x,B. tail y)
97
102
| otherwise = error $ " getEnvironment: insane variable " ++ BC. unpack x
98
103
104
+ -- | 'setEnvironment' resets the entire environment to the given list of
105
+ -- @(key,value)@ pairs.
106
+ --
107
+ -- @since 2.8.0.0
108
+ setEnvironment ::
109
+ [(ByteString ,ByteString )] {- ^ @[(key,value)]@ -} ->
110
+ IO ()
111
+ setEnvironment env = do
112
+ clearEnv
113
+ forM_ env $ \ (key,value) ->
114
+ setEnv key value True {- overwrite-}
115
+
99
116
-- | The 'unsetEnv' function deletes all instances of the variable name
100
117
-- from the environment.
101
118
@@ -116,15 +133,25 @@ foreign import capi unsafe "HsUnix.h unsetenv"
116
133
c_unsetenv :: CString -> IO ()
117
134
# endif
118
135
#else
119
- unsetEnv name = putEnv (name ++ " = " )
136
+ unsetEnv name = putEnv (BC. snoc name ' = ' )
120
137
#endif
121
138
122
139
-- | 'putEnv' function takes an argument of the form @name=value@
123
140
-- and is equivalent to @setEnv(key,value,True{-overwrite-})@.
124
141
125
142
putEnv :: ByteString {- ^ "key=value" -} -> IO ()
126
- putEnv keyvalue = B. useAsCString keyvalue $ \ s ->
127
- throwErrnoIfMinus1_ " putenv" (c_putenv s)
143
+ putEnv (PS fp o l) = withForeignPtr fp $ \ p -> do
144
+ -- https://pubs.opengroup.org/onlinepubs/009696899/functions/putenv.html
145
+ --
146
+ -- "the string pointed to by string shall become part of the environment,
147
+ -- so altering the string shall change the environment. The space used by
148
+ -- string is no longer used once a new string which defines name is passed to putenv()."
149
+ --
150
+ -- hence we must not free the buffer
151
+ buf <- mallocBytes (l+ 1 )
152
+ memcpy buf (p `plusPtr` o) l
153
+ pokeByteOff buf l (0 :: Word8 )
154
+ throwErrnoIfMinus1_ " putenv" (c_putenv (castPtr buf))
128
155
129
156
foreign import ccall unsafe " putenv"
130
157
c_putenv :: CString -> IO CInt
0 commit comments