Replace `__hsunix_unsetenv` wrapper with CApiFFI
[packages/unix.git] / System / Posix / Env.hsc
1 {-# LANGUAGE CApiFFI #-}
2 #if __GLASGOW_HASKELL__ >= 709
3 {-# LANGUAGE Safe #-}
4 #else
5 {-# LANGUAGE Trustworthy #-}
6 #endif
7 -----------------------------------------------------------------------------
8 -- |
9 -- Module      :  System.Posix.Env
10 -- Copyright   :  (c) The University of Glasgow 2002
11 -- License     :  BSD-style (see the file libraries/base/LICENSE)
12 --
13 -- Maintainer  :  libraries@haskell.org
14 -- Stability   :  provisional
15 -- Portability :  non-portable (requires POSIX)
16 --
17 -- POSIX environment support
18 --
19 -----------------------------------------------------------------------------
20
21 module System.Posix.Env (
22       getEnv
23     , getEnvDefault
24     , getEnvironmentPrim
25     , getEnvironment
26     , setEnvironment
27     , putEnv
28     , setEnv
29     , unsetEnv
30     , clearEnv
31 ) where
32
33 #include "HsUnix.h"
34
35 import Foreign.C.Error (throwErrnoIfMinus1_)
36 import Foreign.C.Types
37 import Foreign.C.String
38 import Foreign.Marshal.Array
39 import Foreign.Ptr
40 import Foreign.Storable
41 import Control.Monad
42 import Data.Maybe (fromMaybe)
43 import System.Posix.Internals
44
45 #if !MIN_VERSION_base(4,7,0)
46 -- needed for backported local 'newFilePath' binding in 'putEnv'
47 import GHC.IO.Encoding (getFileSystemEncoding)
48 import qualified GHC.Foreign as GHC (newCString)
49 #endif
50
51 -- |'getEnv' looks up a variable in the environment.
52
53 getEnv :: String -> IO (Maybe String)
54 getEnv name = do
55   litstring <- withFilePath name c_getenv
56   if litstring /= nullPtr
57      then liftM Just $ peekFilePath litstring
58      else return Nothing
59
60 -- |'getEnvDefault' is a wrapper around 'getEnv' where the
61 -- programmer can specify a fallback if the variable is not found
62 -- in the environment.
63
64 getEnvDefault :: String -> String -> IO String
65 getEnvDefault name fallback = liftM (fromMaybe fallback) (getEnv name)
66
67 foreign import ccall unsafe "getenv"
68    c_getenv :: CString -> IO CString
69
70 getEnvironmentPrim :: IO [String]
71 getEnvironmentPrim = do
72   c_environ <- getCEnviron
73   -- environ can be NULL
74   if c_environ == nullPtr
75     then return []
76     else do
77       arr <- peekArray0 nullPtr c_environ
78       mapM peekFilePath arr
79
80 getCEnviron :: IO (Ptr CString)
81
82 #if darwin_HOST_OS
83 -- You should not access _environ directly on Darwin in a bundle/shared library.
84 -- See #2458 and http://developer.apple.com/library/mac/#documentation/Darwin/Reference/ManPages/man7/environ.7.html
85 getCEnviron = nsGetEnviron >>= peek
86
87 foreign import ccall unsafe "_NSGetEnviron"
88    nsGetEnviron :: IO (Ptr (Ptr CString))
89 #else
90 getCEnviron = peek c_environ_p
91
92 foreign import ccall unsafe "&environ"
93    c_environ_p :: Ptr (Ptr CString)
94 #endif
95
96 -- |'getEnvironment' retrieves the entire environment as a
97 -- list of @(key,value)@ pairs.
98
99 getEnvironment :: IO [(String,String)]
100 getEnvironment = do
101   env <- getEnvironmentPrim
102   return $ map (dropEq.(break ((==) '='))) env
103  where
104    dropEq (x,'=':ys) = (x,ys)
105    dropEq (x,_)      = error $ "getEnvironment: insane variable " ++ x
106
107 -- |'setEnvironment' resets the entire environment to the given list of
108 -- @(key,value)@ pairs.
109
110 setEnvironment :: [(String,String)] -> IO ()
111 setEnvironment env = do
112   clearEnv
113   forM_ env $ \(key,value) ->
114     setEnv key value True {-overwrite-}
115
116 -- |The 'unsetEnv' function deletes all instances of the variable name
117 -- from the environment.
118
119 unsetEnv :: String -> IO ()
120 #if HAVE_UNSETENV
121 # if !UNSETENV_RETURNS_VOID
122 unsetEnv name = withFilePath name $ \ s ->
123   throwErrnoIfMinus1_ "unsetenv" (c_unsetenv s)
124
125 -- POSIX.1-2001 compliant unsetenv(3)
126 foreign import capi unsafe "HsUnix.h unsetenv"
127    c_unsetenv :: CString -> IO CInt
128 # else
129 unsetEnv name = withFilePath name c_unsetenv
130
131 -- pre-POSIX unsetenv(3) returning @void@
132 foreign import capi unsafe "HsUnix.h unsetenv"
133    c_unsetenv :: CString -> IO ()
134 # endif
135 #else
136 unsetEnv name = putEnv (name ++ "=")
137 #endif
138
139 -- |'putEnv' function takes an argument of the form @name=value@
140 -- and is equivalent to @setEnv(key,value,True{-overwrite-})@.
141
142 putEnv :: String -> IO ()
143 putEnv keyvalue = do s <- newFilePath keyvalue
144                      -- Do not free `s` after calling putenv.
145                      -- According to SUSv2, the string passed to putenv
146                      -- becomes part of the environment. #7342
147                      throwErrnoIfMinus1_ "putenv" (c_putenv s)
148 #if !MIN_VERSION_base(4,7,0)
149     where
150       newFilePath :: FilePath -> IO CString
151       newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp
152 #endif
153
154 foreign import ccall unsafe "putenv"
155    c_putenv :: CString -> IO CInt
156
157 {- |The 'setEnv' function inserts or resets the environment variable name in
158      the current environment list.  If the variable @name@ does not exist in the
159      list, it is inserted with the given value.  If the variable does exist,
160      the argument @overwrite@ is tested; if @overwrite@ is @False@, the variable is
161      not reset, otherwise it is reset to the given value.
162 -}
163
164 setEnv :: String -> String -> Bool {-overwrite-} -> IO ()
165 #ifdef HAVE_SETENV
166 setEnv key value ovrwrt = do
167   withFilePath key $ \ keyP ->
168     withFilePath value $ \ valueP ->
169       throwErrnoIfMinus1_ "setenv" $
170         c_setenv keyP valueP (fromIntegral (fromEnum ovrwrt))
171
172 foreign import ccall unsafe "setenv"
173    c_setenv :: CString -> CString -> CInt -> IO CInt
174 #else
175 setEnv key value True = putEnv (key++"="++value)
176 setEnv key value False = do
177   res <- getEnv key
178   case res of
179     Just _  -> return ()
180     Nothing -> putEnv (key++"="++value)
181 #endif
182
183 -- |The 'clearEnv' function clears the environment of all name-value pairs.
184 clearEnv :: IO ()
185 #if HAVE_CLEARENV
186 clearEnv = void c_clearenv
187
188 foreign import ccall unsafe "clearenv"
189   c_clearenv :: IO Int
190 #else
191 -- Fallback to 'environ[0] = NULL'.
192 clearEnv = do
193   c_environ <- getCEnviron
194   unless (c_environ == nullPtr) $
195     poke c_environ nullPtr
196 #endif