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