Replace `__hsunix_unsetenv` wrapper with CApiFFI
[packages/unix.git] / System / Posix / Env / ByteString.hsc
1 {-# LANGUAGE CApiFFI #-}
2 {-# LANGUAGE Trustworthy #-}
3 #if __GLASGOW_HASKELL__ >= 709
4 {-# OPTIONS_GHC -fno-warn-trustworthy-safe #-}
5 #endif
6
7 -----------------------------------------------------------------------------
8 -- |
9 -- Module      :  System.Posix.Env.ByteString
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.ByteString (
22        -- * Environment Variables
23         getEnv
24         , getEnvDefault
25         , getEnvironmentPrim
26         , getEnvironment
27         , putEnv
28         , setEnv
29        , unsetEnv
30
31        -- * Program arguments
32        , getArgs
33 ) where
34
35 #include "HsUnix.h"
36
37 import Foreign
38 import Foreign.C
39 import Control.Monad    ( liftM )
40 import Data.Maybe       ( fromMaybe )
41
42 import qualified Data.ByteString as B
43 import qualified Data.ByteString.Char8 as BC
44 import Data.ByteString (ByteString)
45
46 -- |'getEnv' looks up a variable in the environment.
47
48 getEnv :: ByteString -> IO (Maybe ByteString)
49 getEnv name = do
50   litstring <- B.useAsCString name c_getenv
51   if litstring /= nullPtr
52      then liftM Just $ B.packCString litstring
53      else return Nothing
54
55 -- |'getEnvDefault' is a wrapper around 'getEnv' where the
56 -- programmer can specify a fallback if the variable is not found
57 -- in the environment.
58
59 getEnvDefault :: ByteString -> ByteString -> IO ByteString
60 getEnvDefault name fallback = liftM (fromMaybe fallback) (getEnv name)
61
62 foreign import ccall unsafe "getenv"
63    c_getenv :: CString -> IO CString
64
65 getEnvironmentPrim :: IO [ByteString]
66 getEnvironmentPrim = do
67   c_environ <- getCEnviron
68   arr <- peekArray0 nullPtr c_environ
69   mapM B.packCString arr
70
71 getCEnviron :: IO (Ptr CString)
72 #if darwin_HOST_OS
73 -- You should not access _environ directly on Darwin in a bundle/shared library.
74 -- See #2458 and http://developer.apple.com/library/mac/#documentation/Darwin/Reference/ManPages/man7/environ.7.html
75 getCEnviron = nsGetEnviron >>= peek
76
77 foreign import ccall unsafe "_NSGetEnviron"
78    nsGetEnviron :: IO (Ptr (Ptr CString))
79 #else
80 getCEnviron = peek c_environ_p
81
82 foreign import ccall unsafe "&environ"
83    c_environ_p :: Ptr (Ptr CString)
84 #endif
85
86 -- |'getEnvironment' retrieves the entire environment as a
87 -- list of @(key,value)@ pairs.
88
89 getEnvironment :: IO [(ByteString,ByteString)]
90 getEnvironment = do
91   env <- getEnvironmentPrim
92   return $ map (dropEq.(BC.break ((==) '='))) env
93  where
94    dropEq (x,y)
95       | BC.head y == '=' = (x,B.tail y)
96       | otherwise       = error $ "getEnvironment: insane variable " ++ BC.unpack x
97
98 -- |The 'unsetEnv' function deletes all instances of the variable name
99 -- from the environment.
100
101 unsetEnv :: ByteString -> IO ()
102 #if HAVE_UNSETENV
103 # if !UNSETENV_RETURNS_VOID
104 unsetEnv name = B.useAsCString name $ \ s ->
105   throwErrnoIfMinus1_ "unsetenv" (c_unsetenv s)
106
107 -- POSIX.1-2001 compliant unsetenv(3)
108 foreign import capi unsafe "HsUnix.h unsetenv"
109    c_unsetenv :: CString -> IO CInt
110 # else
111 unsetEnv name = B.useAsCString name c_unsetenv
112
113 -- pre-POSIX unsetenv(3) returning @void@
114 foreign import capi unsafe "HsUnix.h unsetenv"
115    c_unsetenv :: CString -> IO ()
116 # endif
117 #else
118 unsetEnv name = putEnv (name ++ "=")
119 #endif
120
121 -- |'putEnv' function takes an argument of the form @name=value@
122 -- and is equivalent to @setEnv(key,value,True{-overwrite-})@.
123
124 putEnv :: ByteString -> IO ()
125 putEnv keyvalue = B.useAsCString keyvalue $ \s ->
126   throwErrnoIfMinus1_ "putenv" (c_putenv s)
127
128 foreign import ccall unsafe "putenv"
129    c_putenv :: CString -> IO CInt
130
131 {- |The 'setEnv' function inserts or resets the environment variable name in
132      the current environment list.  If the variable @name@ does not exist in the
133      list, it is inserted with the given value.  If the variable does exist,
134      the argument @overwrite@ is tested; if @overwrite@ is @False@, the variable is
135      not reset, otherwise it is reset to the given value.
136 -}
137
138 setEnv :: ByteString -> ByteString -> Bool {-overwrite-} -> IO ()
139 #ifdef HAVE_SETENV
140 setEnv key value ovrwrt = do
141   B.useAsCString key $ \ keyP ->
142     B.useAsCString value $ \ valueP ->
143       throwErrnoIfMinus1_ "setenv" $
144         c_setenv keyP valueP (fromIntegral (fromEnum ovrwrt))
145
146 foreign import ccall unsafe "setenv"
147    c_setenv :: CString -> CString -> CInt -> IO CInt
148 #else
149 setEnv key value True = putEnv (key++"="++value)
150 setEnv key value False = do
151   res <- getEnv key
152   case res of
153     Just _  -> return ()
154     Nothing -> putEnv (key++"="++value)
155 #endif
156
157 -- | Computation 'getArgs' returns a list of the program's command
158 -- line arguments (not including the program name), as 'ByteString's.
159 --
160 -- Unlike 'System.Environment.getArgs', this function does no Unicode
161 -- decoding of the arguments; you get the exact bytes that were passed
162 -- to the program by the OS.  To interpret the arguments as text, some
163 -- Unicode decoding should be applied.
164 --
165 getArgs :: IO [ByteString]
166 getArgs =
167   alloca $ \ p_argc ->
168   alloca $ \ p_argv -> do
169    getProgArgv p_argc p_argv
170    p    <- fromIntegral `liftM` peek p_argc
171    argv <- peek p_argv
172    peekArray (p - 1) (advancePtr argv 1) >>= mapM B.packCString
173
174 foreign import ccall unsafe "getProgArgv"
175   getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()