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
|
{-# LANGUAGE ForeignFunctionInterface #-}
-----------------------------------------------------------------------------
-- |
-- 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
, putEnv
, setEnv
, unsetEnv
) where
#include "HsUnix.h"
import Foreign.C.Error ( throwErrnoIfMinus1_ )
import Foreign.C.Types ( CInt )
import Foreign.C.String
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable
import Control.Monad ( liftM )
import Data.Maybe ( fromMaybe )
-- |'getEnv' looks up a variable in the environment.
getEnv :: String -> IO (Maybe String)
getEnv name = do
litstring <- withCString name c_getenv
if litstring /= nullPtr
then liftM Just $ peekCString 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 <- peek c_environ_p
arr <- peekArray0 nullPtr c_environ
mapM peekCString arr
foreign import ccall unsafe "&environ"
c_environ_p :: Ptr (Ptr CString)
-- |'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
-- |The 'unsetEnv' function deletes all instances of the variable name
-- from the environment.
unsetEnv :: String -> IO ()
#ifdef HAVE_UNSETENV
unsetEnv name = withCString name c_unsetenv
foreign import ccall unsafe "unsetenv"
c_unsetenv :: CString -> IO ()
#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 = withCString keyvalue $ \s ->
throwErrnoIfMinus1_ "putenv" (c_putenv s)
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
withCString key $ \ keyP ->
withCString 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
|
