Skip to content

Commit 5fd5305

Browse files
hasufellBodigrim
authored andcommitted
Synchronize ByteString and String modules
And fix free-bug in 'putEnv'. Fixes #68
1 parent f123254 commit 5fd5305

File tree

1 file changed

+32
-5
lines changed

1 file changed

+32
-5
lines changed

System/Posix/Env/ByteString.hsc

Lines changed: 32 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
{-# LANGUAGE CApiFFI #-}
2-
{-# LANGUAGE Safe #-}
2+
{-# LANGUAGE Trustworthy #-}
33

44
-----------------------------------------------------------------------------
55
-- |
@@ -21,23 +21,28 @@ module System.Posix.Env.ByteString (
2121
, getEnvDefault
2222
, getEnvironmentPrim
2323
, getEnvironment
24+
, setEnvironment
2425
, putEnv
2526
, setEnv
26-
, unsetEnv
27+
, unsetEnv
28+
, clearEnv
2729

2830
-- * Program arguments
2931
, getArgs
3032
) where
3133

3234
#include "HsUnix.h"
3335

36+
import Control.Monad
3437
import Foreign
3538
import Foreign.C
3639
import Data.Maybe ( fromMaybe )
3740

41+
import System.Posix.Env ( clearEnv )
3842
import qualified Data.ByteString as B
3943
import qualified Data.ByteString.Char8 as BC
4044
import Data.ByteString (ByteString)
45+
import Data.ByteString.Internal (ByteString (PS), memcpy)
4146

4247
-- |'getEnv' looks up a variable in the environment.
4348

@@ -96,6 +101,18 @@ getEnvironment = do
96101
| BC.head y == '=' = (x,B.tail y)
97102
| otherwise = error $ "getEnvironment: insane variable " ++ BC.unpack x
98103

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+
99116
-- |The 'unsetEnv' function deletes all instances of the variable name
100117
-- from the environment.
101118

@@ -116,15 +133,25 @@ foreign import capi unsafe "HsUnix.h unsetenv"
116133
c_unsetenv :: CString -> IO ()
117134
# endif
118135
#else
119-
unsetEnv name = putEnv (name ++ "=")
136+
unsetEnv name = putEnv (BC.snoc name '=')
120137
#endif
121138

122139
-- |'putEnv' function takes an argument of the form @name=value@
123140
-- and is equivalent to @setEnv(key,value,True{-overwrite-})@.
124141

125142
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))
128155

129156
foreign import ccall unsafe "putenv"
130157
c_putenv :: CString -> IO CInt

0 commit comments

Comments
 (0)