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