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
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
#if __GLASGOW_HASKELL__ >= 709
{-# LANGUAGE Safe #-}
#else
{-# LANGUAGE Trustworthy #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module : System.Posix.Env
-- Copyright : (c) The University of Glasgow 2002
-- License : BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer : libraries@haskell.org
-- Stability : provisional
-- Portability : non-portable (requires POSIX)
--
-- POSIX environment support
--
-----------------------------------------------------------------------------
module System.Posix.Env (
getEnv
, getEnvDefault
, getEnvironmentPrim
, getEnvironment
, setEnvironment
, putEnv
, setEnv
, unsetEnv
, clearEnv
) where
#include "HsUnix.h"
import Foreign.C.Error (throwErrnoIfMinus1_)
import Foreign.C.Types
import Foreign.C.String
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable
import Control.Monad
import Data.Maybe (fromMaybe)
import System.Posix.Internals
#if !MIN_VERSION_base(4,7,0)
-- needed for backported local 'newFilePath' binding in 'putEnv'
import GHC.IO.Encoding (getFileSystemEncoding)
import qualified GHC.Foreign as GHC (newCString)
#endif
-- |'getEnv' looks up a variable in the environment.
getEnv :: String -> IO (Maybe String)
getEnv name = do
litstring <- withFilePath name c_getenv
if litstring /= nullPtr
then liftM Just $ peekFilePath litstring
else return Nothing
-- |'getEnvDefault' is a wrapper around 'getEnv' where the
-- programmer can specify a fallback if the variable is not found
-- in the environment.
getEnvDefault :: String -> String -> IO String
getEnvDefault name fallback = liftM (fromMaybe fallback) (getEnv name)
foreign import ccall unsafe "getenv"
c_getenv :: CString -> IO CString
getEnvironmentPrim :: IO [String]
getEnvironmentPrim = do
c_environ <- getCEnviron
-- environ can be NULL
if c_environ == nullPtr
then return []
else do
arr <- peekArray0 nullPtr c_environ
mapM peekFilePath arr
getCEnviron :: IO (Ptr CString)
#if darwin_HOST_OS
-- You should not access _environ directly on Darwin in a bundle/shared library.
-- See #2458 and http://developer.apple.com/library/mac/#documentation/Darwin/Reference/ManPages/man7/environ.7.html
getCEnviron = nsGetEnviron >>= peek
foreign import ccall unsafe "_NSGetEnviron"
nsGetEnviron :: IO (Ptr (Ptr CString))
#else
getCEnviron = peek c_environ_p
foreign import ccall unsafe "&environ"
c_environ_p :: Ptr (Ptr CString)
#endif
-- |'getEnvironment' retrieves the entire environment as a
-- list of @(key,value)@ pairs.
getEnvironment :: IO [(String,String)]
getEnvironment = do
env <- getEnvironmentPrim
return $ map (dropEq.(break ((==) '='))) env
where
dropEq (x,'=':ys) = (x,ys)
dropEq (x,_) = error $ "getEnvironment: insane variable " ++ x
-- |'setEnvironment' resets the entire environment to the given list of
-- @(key,value)@ pairs.
setEnvironment :: [(String,String)] -> IO ()
setEnvironment env = do
clearEnv
forM_ env $ \(key,value) ->
setEnv key value True {-overwrite-}
-- |The 'unsetEnv' function deletes all instances of the variable name
-- from the environment.
unsetEnv :: String -> IO ()
#ifdef HAVE_UNSETENV
unsetEnv name = withFilePath name $ \ s ->
throwErrnoIfMinus1_ "unsetenv" (c_unsetenv s)
foreign import ccall unsafe "__hsunix_unsetenv"
c_unsetenv :: CString -> IO CInt
#else
unsetEnv name = putEnv (name ++ "=")
#endif
-- |'putEnv' function takes an argument of the form @name=value@
-- and is equivalent to @setEnv(key,value,True{-overwrite-})@.
putEnv :: String -> IO ()
putEnv keyvalue = do s <- newFilePath keyvalue
-- Do not free `s` after calling putenv.
-- According to SUSv2, the string passed to putenv
-- becomes part of the environment. #7342
throwErrnoIfMinus1_ "putenv" (c_putenv s)
#if !MIN_VERSION_base(4,7,0)
where
newFilePath :: FilePath -> IO CString
newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp
#endif
foreign import ccall unsafe "putenv"
c_putenv :: CString -> IO CInt
{- |The 'setEnv' function inserts or resets the environment variable name in
the current environment list. If the variable @name@ does not exist in the
list, it is inserted with the given value. If the variable does exist,
the argument @overwrite@ is tested; if @overwrite@ is @False@, the variable is
not reset, otherwise it is reset to the given value.
-}
setEnv :: String -> String -> Bool {-overwrite-} -> IO ()
#ifdef HAVE_SETENV
setEnv key value ovrwrt = do
withFilePath key $ \ keyP ->
withFilePath value $ \ valueP ->
throwErrnoIfMinus1_ "setenv" $
c_setenv keyP valueP (fromIntegral (fromEnum ovrwrt))
foreign import ccall unsafe "setenv"
c_setenv :: CString -> CString -> CInt -> IO CInt
#else
setEnv key value True = putEnv (key++"="++value)
setEnv key value False = do
res <- getEnv key
case res of
Just _ -> return ()
Nothing -> putEnv (key++"="++value)
#endif
-- |The 'clearEnv' function clears the environment of all name-value pairs.
clearEnv :: IO ()
#if HAVE_CLEARENV
clearEnv = void c_clearenv
foreign import ccall unsafe "clearenv"
c_clearenv :: IO Int
#else
-- Fallback to 'environ[0] = NULL'.
clearEnv = do
c_environ <- getCEnviron
unless (c_environ == nullPtr) $
poke c_environ nullPtr
#endif
|
