1{-# LANGUAGE Safe #-}
2{-# LANGUAGE CPP #-}
3
4-----------------------------------------------------------------------------
5-- |
6-- Module      :  System.Environment
7-- Copyright   :  (c) The University of Glasgow 2001
8-- License     :  BSD-style (see the file libraries/base/LICENSE)
9--
10-- Maintainer  :  libraries@haskell.org
11-- Stability   :  provisional
12-- Portability :  portable
13--
14-- Miscellaneous information about the system environment.
15--
16-----------------------------------------------------------------------------
17
18module System.Environment
19    (
20      getArgs,
21      getProgName,
22      getExecutablePath,
23      getEnv,
24      lookupEnv,
25      setEnv,
26      unsetEnv,
27      withArgs,
28      withProgName,
29      getEnvironment,
30  ) where
31
32import Foreign
33import Foreign.C
34import System.IO.Error (mkIOError)
35import Control.Exception.Base (bracket_, throwIO)
36#if defined(mingw32_HOST_OS)
37import Control.Exception.Base (bracket)
38#endif
39-- import GHC.IO
40import GHC.IO.Exception
41import qualified GHC.Foreign as GHC
42import Control.Monad
43#if defined(mingw32_HOST_OS)
44import GHC.IO.Encoding (argvEncoding)
45import GHC.Windows
46#else
47import GHC.IO.Encoding (getFileSystemEncoding, argvEncoding)
48import System.Posix.Internals (withFilePath)
49#endif
50
51import System.Environment.ExecutablePath
52
53#if defined(mingw32_HOST_OS)
54# if defined(i386_HOST_ARCH)
55#  define WINDOWS_CCONV stdcall
56# elif defined(x86_64_HOST_ARCH)
57#  define WINDOWS_CCONV ccall
58# else
59#  error Unknown mingw32 arch
60# endif
61#endif
62
63#include "HsBaseConfig.h"
64
65-- ---------------------------------------------------------------------------
66-- getArgs, getProgName, getEnv
67
68-- | Computation 'getArgs' returns a list of the program's command
69-- line arguments (not including the program name).
70getArgs :: IO [String]
71getArgs =
72  alloca $ \ p_argc ->
73  alloca $ \ p_argv -> do
74   getProgArgv p_argc p_argv
75   p    <- fromIntegral `liftM` peek p_argc
76   argv <- peek p_argv
77   enc <- argvEncoding
78   peekArray (p - 1) (advancePtr argv 1) >>= mapM (GHC.peekCString enc)
79
80
81foreign import ccall unsafe "getProgArgv"
82  getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
83
84{-|
85Computation 'getProgName' returns the name of the program as it was
86invoked.
87
88However, this is hard-to-impossible to implement on some non-Unix
89OSes, so instead, for maximum portability, we just return the leafname
90of the program as invoked. Even then there are some differences
91between platforms: on Windows, for example, a program invoked as foo
92is probably really @FOO.EXE@, and that is what 'getProgName' will return.
93-}
94getProgName :: IO String
95-- Ignore the arguments to hs_init on Windows for the sake of Unicode compat
96getProgName =
97  alloca $ \ p_argc ->
98  alloca $ \ p_argv -> do
99     getProgArgv p_argc p_argv
100     argv <- peek p_argv
101     unpackProgName argv
102
103unpackProgName  :: Ptr (Ptr CChar) -> IO String   -- argv[0]
104unpackProgName argv = do
105  enc <- argvEncoding
106  s <- peekElemOff argv 0 >>= GHC.peekCString enc
107  return (basename s)
108
109basename :: FilePath -> FilePath
110basename f = go f f
111 where
112  go acc [] = acc
113  go acc (x:xs)
114    | isPathSeparator x = go xs xs
115    | otherwise         = go acc xs
116
117  isPathSeparator :: Char -> Bool
118  isPathSeparator '/'  = True
119#if defined(mingw32_HOST_OS)
120  isPathSeparator '\\' = True
121#endif
122  isPathSeparator _    = False
123
124
125-- | Computation 'getEnv' @var@ returns the value
126-- of the environment variable @var@. For the inverse, the
127-- `System.Environment.setEnv` function can be used.
128--
129-- This computation may fail with:
130--
131--  * 'System.IO.Error.isDoesNotExistError' if the environment variable
132--    does not exist.
133
134getEnv :: String -> IO String
135getEnv name = lookupEnv name >>= maybe handleError return
136  where
137#if defined(mingw32_HOST_OS)
138    handleError = do
139        err <- c_GetLastError
140        if err == eRROR_ENVVAR_NOT_FOUND
141            then ioe_missingEnvVar name
142            else throwGetLastError "getEnv"
143
144eRROR_ENVVAR_NOT_FOUND :: DWORD
145eRROR_ENVVAR_NOT_FOUND = 203
146
147foreign import WINDOWS_CCONV unsafe "windows.h GetLastError"
148  c_GetLastError:: IO DWORD
149
150#else
151    handleError = ioe_missingEnvVar name
152#endif
153
154-- | Return the value of the environment variable @var@, or @Nothing@ if
155-- there is no such value.
156--
157-- For POSIX users, this is equivalent to 'System.Posix.Env.getEnv'.
158--
159-- @since 4.6.0.0
160lookupEnv :: String -> IO (Maybe String)
161#if defined(mingw32_HOST_OS)
162lookupEnv name = withCWString name $ \s -> try_size s 256
163  where
164    try_size s size = allocaArray (fromIntegral size) $ \p_value -> do
165      res <- c_GetEnvironmentVariable s p_value size
166      case res of
167        0 -> return Nothing
168        _ | res > size -> try_size s res -- Rare: size increased between calls to GetEnvironmentVariable
169          | otherwise  -> peekCWString p_value >>= return . Just
170
171foreign import WINDOWS_CCONV unsafe "windows.h GetEnvironmentVariableW"
172  c_GetEnvironmentVariable :: LPWSTR -> LPWSTR -> DWORD -> IO DWORD
173#else
174lookupEnv name =
175    withCString name $ \s -> do
176      litstring <- c_getenv s
177      if litstring /= nullPtr
178        then do enc <- getFileSystemEncoding
179                result <- GHC.peekCString enc litstring
180                return $ Just result
181        else return Nothing
182
183foreign import ccall unsafe "getenv"
184   c_getenv :: CString -> IO (Ptr CChar)
185#endif
186
187ioe_missingEnvVar :: String -> IO a
188ioe_missingEnvVar name = ioException (IOError Nothing NoSuchThing "getEnv"
189    "no environment variable" Nothing (Just name))
190
191-- | @setEnv name value@ sets the specified environment variable to @value@.
192--
193-- Early versions of this function operated under the mistaken belief that
194-- setting an environment variable to the /empty string/ on Windows removes
195-- that environment variable from the environment.  For the sake of
196-- compatibility, it adopted that behavior on POSIX.  In particular
197--
198-- @
199-- setEnv name \"\"
200-- @
201--
202-- has the same effect as
203--
204-- @
205-- `unsetEnv` name
206-- @
207--
208-- If you'd like to be able to set environment variables to blank strings,
209-- use `System.Environment.Blank.setEnv`.
210--
211-- Throws `Control.Exception.IOException` if @name@ is the empty string or
212-- contains an equals sign.
213--
214-- @since 4.7.0.0
215setEnv :: String -> String -> IO ()
216setEnv key_ value_
217  | null key       = throwIO (mkIOError InvalidArgument "setEnv" Nothing Nothing)
218  | '=' `elem` key = throwIO (mkIOError InvalidArgument "setEnv" Nothing Nothing)
219  | null value     = unsetEnv key
220  | otherwise      = setEnv_ key value
221  where
222    key   = takeWhile (/= '\NUL') key_
223    value = takeWhile (/= '\NUL') value_
224
225setEnv_ :: String -> String -> IO ()
226#if defined(mingw32_HOST_OS)
227setEnv_ key value = withCWString key $ \k -> withCWString value $ \v -> do
228  success <- c_SetEnvironmentVariable k v
229  unless success (throwGetLastError "setEnv")
230
231foreign import WINDOWS_CCONV unsafe "windows.h SetEnvironmentVariableW"
232  c_SetEnvironmentVariable :: LPTSTR -> LPTSTR -> IO Bool
233#else
234
235-- NOTE: The 'setenv()' function is not available on all systems, hence we use
236-- 'putenv()'.  This leaks memory, but so do common implementations of
237-- 'setenv()' (AFAIK).
238setEnv_ k v = putEnv (k ++ "=" ++ v)
239
240putEnv :: String -> IO ()
241putEnv keyvalue = do
242  s <- getFileSystemEncoding >>= (`GHC.newCString` keyvalue)
243  -- IMPORTANT: Do not free `s` after calling putenv!
244  --
245  -- According to SUSv2, the string passed to putenv becomes part of the
246  -- environment.
247  throwErrnoIf_ (/= 0) "putenv" (c_putenv s)
248
249foreign import ccall unsafe "putenv" c_putenv :: CString -> IO CInt
250#endif
251
252-- | @unsetEnv name@ removes the specified environment variable from the
253-- environment of the current process.
254--
255-- Throws `Control.Exception.IOException` if @name@ is the empty string or
256-- contains an equals sign.
257--
258-- @since 4.7.0.0
259unsetEnv :: String -> IO ()
260#if defined(mingw32_HOST_OS)
261unsetEnv key = withCWString key $ \k -> do
262  success <- c_SetEnvironmentVariable k nullPtr
263  unless success $ do
264    -- We consider unsetting an environment variable that does not exist not as
265    -- an error, hence we ignore eRROR_ENVVAR_NOT_FOUND.
266    err <- c_GetLastError
267    unless (err == eRROR_ENVVAR_NOT_FOUND) $ do
268      throwGetLastError "unsetEnv"
269#else
270
271#if defined(HAVE_UNSETENV)
272unsetEnv key = withFilePath key (throwErrnoIf_ (/= 0) "unsetEnv" . c_unsetenv)
273foreign import ccall unsafe "__hsbase_unsetenv" c_unsetenv :: CString -> IO CInt
274#else
275unsetEnv key = setEnv_ key ""
276#endif
277
278#endif
279
280{-|
281'withArgs' @args act@ - while executing action @act@, have 'getArgs'
282return @args@.
283-}
284withArgs :: [String] -> IO a -> IO a
285withArgs xs act = do
286   p <- System.Environment.getProgName
287   withArgv (p:xs) act
288
289{-|
290'withProgName' @name act@ - while executing action @act@,
291have 'getProgName' return @name@.
292-}
293withProgName :: String -> IO a -> IO a
294withProgName nm act = do
295   xs <- System.Environment.getArgs
296   withArgv (nm:xs) act
297
298-- Worker routine which marshals and replaces an argv vector for
299-- the duration of an action.
300
301withArgv :: [String] -> IO a -> IO a
302withArgv = withProgArgv
303
304withProgArgv :: [String] -> IO a -> IO a
305withProgArgv new_args act = do
306  pName <- System.Environment.getProgName
307  existing_args <- System.Environment.getArgs
308  bracket_ (setProgArgv new_args)
309           (setProgArgv (pName:existing_args))
310           act
311
312setProgArgv :: [String] -> IO ()
313setProgArgv argv = do
314  enc <- argvEncoding
315  GHC.withCStringsLen enc argv $ \len css ->
316    c_setProgArgv (fromIntegral len) css
317
318-- setProgArgv copies the arguments
319foreign import ccall unsafe "setProgArgv"
320  c_setProgArgv  :: CInt -> Ptr CString -> IO ()
321
322-- |'getEnvironment' retrieves the entire environment as a
323-- list of @(key,value)@ pairs.
324--
325-- If an environment entry does not contain an @\'=\'@ character,
326-- the @key@ is the whole entry and the @value@ is the empty string.
327getEnvironment :: IO [(String, String)]
328
329#if defined(mingw32_HOST_OS)
330getEnvironment = bracket c_GetEnvironmentStrings c_FreeEnvironmentStrings $ \pBlock ->
331    if pBlock == nullPtr then return []
332     else go pBlock
333  where
334    go pBlock = do
335        -- The block is terminated by a null byte where there
336        -- should be an environment variable of the form X=Y
337        c <- peek pBlock
338        if c == 0 then return []
339         else do
340          -- Seek the next pair (or terminating null):
341          pBlock' <- seekNull pBlock False
342          -- We now know the length in bytes, but ignore it when
343          -- getting the actual String:
344          str <- peekCWString pBlock
345          fmap (divvy str :) $ go pBlock'
346
347    -- Returns pointer to the byte *after* the next null
348    seekNull pBlock done = do
349        let pBlock' = pBlock `plusPtr` sizeOf (undefined :: CWchar)
350        if done then return pBlock'
351         else do
352           c <- peek pBlock'
353           seekNull pBlock' (c == (0 :: Word8 ))
354
355foreign import WINDOWS_CCONV unsafe "windows.h GetEnvironmentStringsW"
356  c_GetEnvironmentStrings :: IO (Ptr CWchar)
357
358foreign import WINDOWS_CCONV unsafe "windows.h FreeEnvironmentStringsW"
359  c_FreeEnvironmentStrings :: Ptr CWchar -> IO Bool
360#else
361getEnvironment = do
362   pBlock <- getEnvBlock
363   if pBlock == nullPtr then return []
364    else do
365      enc <- getFileSystemEncoding
366      stuff <- peekArray0 nullPtr pBlock >>= mapM (GHC.peekCString enc)
367      return (map divvy stuff)
368
369foreign import ccall unsafe "__hscore_environ"
370  getEnvBlock :: IO (Ptr CString)
371#endif
372
373divvy :: String -> (String, String)
374divvy str =
375  case break (=='=') str of
376    (xs,[])        -> (xs,[]) -- don't barf (like Posix.getEnvironment)
377    (name,_:value) -> (name,value)
378