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
3437import Foreign
3538import Foreign.C
3639import Data.Maybe ( fromMaybe )
3740
41+ import System.Posix.Env ( clearEnv )
3842import qualified Data.ByteString as B
3943import qualified Data.ByteString.Char8 as BC
4044import 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
125142putEnv :: 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
129156foreign import ccall unsafe " putenv"
130157 c_putenv :: CString -> IO CInt
0 commit comments