{-# LANGUAGE Safe #-}{-# LANGUAGE CPP #-}------------------------------------------------------------------------------- |-- Module : System.Environment-- Copyright : (c) The University of Glasgow 2001-- License : BSD-style (see the file libraries/base/LICENSE)---- Maintainer : libraries@haskell.org-- Stability : provisional-- Portability : portable---- Miscellaneous information about the system environment.-------------------------------------------------------------------------------moduleSystem.Environment(getArgs ,getProgName ,getExecutablePath ,getEnv ,lookupEnv ,setEnv ,unsetEnv ,withArgs ,withProgName ,getEnvironment ,)whereimportForeign importForeign.C importSystem.IO.Error (mkIOError )importControl.Exception.Base (bracket_ ,throwIO ) #if defined(mingw32_HOST_OS) importControl.Exception.Base(bracket) #endif -- import GHC.IOimportGHC.IO.Exception importqualifiedGHC.Foreign asGHCimportControl.Monad #if defined(mingw32_HOST_OS) importGHC.IO.Encoding(argvEncoding)importGHC.Windows #else importGHC.IO.Encoding (getFileSystemEncoding ,argvEncoding )importSystem.Posix.Internals (withFilePath ) #endif importSystem.Environment.ExecutablePath #if defined(mingw32_HOST_OS) # if defined(i386_HOST_ARCH) # define WINDOWS_CCONV stdcall # elif defined(x86_64_HOST_ARCH) # define WINDOWS_CCONV ccall # else # error Unknown mingw32 arch # endif #endif #include "HsBaseConfig.h" -- ----------------------------------------------------------------------------- getArgs, getProgName, getEnv-- | Computation 'getArgs' returns a list of the program's command-- line arguments (not including the program name).getArgs ::IO[String ]getArgs :: IO [String] getArgs =(Ptr CInt -> IO [String]) -> IO [String] forall a b. Storable a => (Ptr a -> IO b) -> IO b alloca ((Ptr CInt -> IO [String]) -> IO [String]) -> (Ptr CInt -> IO [String]) -> IO [String] forall a b. (a -> b) -> a -> b $ \Ptr CInt p_argc ->(Ptr (Ptr CString) -> IO [String]) -> IO [String] forall a b. Storable a => (Ptr a -> IO b) -> IO b alloca ((Ptr (Ptr CString) -> IO [String]) -> IO [String]) -> (Ptr (Ptr CString) -> IO [String]) -> IO [String] forall a b. (a -> b) -> a -> b $ \Ptr (Ptr CString) p_argv ->doPtr CInt -> Ptr (Ptr CString) -> IO () getProgArgv Ptr CInt p_argc Ptr (Ptr CString) p_argv Int p <-CInt -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral (CInt -> Int) -> IO CInt -> IO Int forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r `liftM` Ptr CInt -> IO CInt forall a. Storable a => Ptr a -> IO a peek Ptr CInt p_argc Ptr CString argv <-Ptr (Ptr CString) -> IO (Ptr CString) forall a. Storable a => Ptr a -> IO a peek Ptr (Ptr CString) p_argv TextEncoding enc <-IO TextEncoding argvEncoding Int -> Ptr CString -> IO [CString] forall a. Storable a => Int -> Ptr a -> IO [a] peekArray (Int p Int -> Int -> Int forall a. Num a => a -> a -> a - Int 1)(Ptr CString -> Int -> Ptr CString forall a. Storable a => Ptr a -> Int -> Ptr a advancePtr Ptr CString argv Int 1)IO [CString] -> ([CString] -> IO [String]) -> IO [String] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (CString -> IO String) -> [CString] -> IO [String] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM (TextEncoding -> CString -> IO String GHC.peekCString TextEncoding enc )foreignimportccallunsafe"getProgArgv"getProgArgv ::Ptr CInt ->Ptr (Ptr CString )->IO(){-| Computation 'getProgName' returns the name of the program as it was invoked. However, this is hard-to-impossible to implement on some non-Unix OSes, so instead, for maximum portability, we just return the leafname of the program as invoked. Even then there are some differences between platforms: on Windows, for example, a program invoked as foo is probably really @FOO.EXE@, and that is what 'getProgName' will return. -}getProgName ::IOString -- Ignore the arguments to hs_init on Windows for the sake of Unicode compatgetProgName :: IO String getProgName =(Ptr CInt -> IO String) -> IO String forall a b. Storable a => (Ptr a -> IO b) -> IO b alloca ((Ptr CInt -> IO String) -> IO String) -> (Ptr CInt -> IO String) -> IO String forall a b. (a -> b) -> a -> b $ \Ptr CInt p_argc ->(Ptr (Ptr CString) -> IO String) -> IO String forall a b. Storable a => (Ptr a -> IO b) -> IO b alloca ((Ptr (Ptr CString) -> IO String) -> IO String) -> (Ptr (Ptr CString) -> IO String) -> IO String forall a b. (a -> b) -> a -> b $ \Ptr (Ptr CString) p_argv ->doPtr CInt -> Ptr (Ptr CString) -> IO () getProgArgv Ptr CInt p_argc Ptr (Ptr CString) p_argv Ptr CString argv <-Ptr (Ptr CString) -> IO (Ptr CString) forall a. Storable a => Ptr a -> IO a peek Ptr (Ptr CString) p_argv Ptr CString -> IO String unpackProgName Ptr CString argv unpackProgName ::Ptr (Ptr CChar )->IOString -- argv[0]unpackProgName :: Ptr CString -> IO String unpackProgName Ptr CString argv =doTextEncoding enc <-IO TextEncoding argvEncoding String s <-Ptr CString -> Int -> IO CString forall a. Storable a => Ptr a -> Int -> IO a peekElemOff Ptr CString argv Int 0IO CString -> (CString -> IO String) -> IO String forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= TextEncoding -> CString -> IO String GHC.peekCString TextEncoding enc String -> IO String forall (m :: * -> *) a. Monad m => a -> m a return (String -> String basename String s )basename ::FilePath ->FilePath basename :: String -> String basename String f =String -> String -> String go String f String f wherego :: String -> String -> String go String acc []=String acc go String acc (Char x :String xs )|Char -> Bool isPathSeparator Char x =String -> String -> String go String xs String xs |Bool otherwise =String -> String -> String go String acc String xs isPathSeparator ::Char->BoolisPathSeparator :: Char -> Bool isPathSeparator Char '/'=Bool True #if defined(mingw32_HOST_OS) isPathSeparator'\\'=True #endif isPathSeparator Char _=Bool False-- | Computation 'getEnv' @var@ returns the value-- of the environment variable @var@. For the inverse, the-- `System.Environment.setEnv` function can be used.---- This computation may fail with:---- * 'System.IO.Error.isDoesNotExistError' if the environment variable-- does not exist.getEnv ::String ->IOString getEnv :: String -> IO String getEnv String name =String -> IO (Maybe String) lookupEnv String name IO (Maybe String) -> (Maybe String -> IO String) -> IO String forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= IO String -> (String -> IO String) -> Maybe String -> IO String forall b a. b -> (a -> b) -> Maybe a -> b maybe IO String forall a. IO a handleError String -> IO String forall (m :: * -> *) a. Monad m => a -> m a return where #if defined(mingw32_HOST_OS) handleError=doerr<-c_GetLastErroriferr==eRROR_ENVVAR_NOT_FOUNDthenioe_missingEnvVarnameelsethrowGetLastError"getEnv"eRROR_ENVVAR_NOT_FOUND::DWORDeRROR_ENVVAR_NOT_FOUND=203foreignimportWINDOWS_CCONVunsafe"windows.h GetLastError"c_GetLastError::IODWORD #else handleError :: IO a handleError =String -> IO a forall a. String -> IO a ioe_missingEnvVar String name #endif -- | Return the value of the environment variable @var@, or @Nothing@ if-- there is no such value.---- For POSIX users, this is equivalent to 'System.Posix.Env.getEnv'.---- @since 4.6.0.0lookupEnv ::String ->IO(Maybe String ) #if defined(mingw32_HOST_OS) lookupEnvname=withCWStringname$\s->try_sizes256wheretry_sizessize=allocaArray(fromIntegralsize)$\p_value->dores<-c_GetEnvironmentVariablesp_valuesizecaseresof0->returnNothing_|res>size->try_sizesres-- Rare: size increased between calls to GetEnvironmentVariable|otherwise->peekCWStringp_value>>=return.JustforeignimportWINDOWS_CCONVunsafe"windows.h GetEnvironmentVariableW"c_GetEnvironmentVariable::LPWSTR->LPWSTR->DWORD->IODWORD #else lookupEnv :: String -> IO (Maybe String) lookupEnv String name =String -> (CString -> IO (Maybe String)) -> IO (Maybe String) forall a. String -> (CString -> IO a) -> IO a withCString String name ((CString -> IO (Maybe String)) -> IO (Maybe String)) -> (CString -> IO (Maybe String)) -> IO (Maybe String) forall a b. (a -> b) -> a -> b $ \CString s ->doCString litstring <-CString -> IO CString c_getenv CString s ifCString litstring CString -> CString -> Bool forall a. Eq a => a -> a -> Bool /=CString forall a. Ptr a nullPtr thendoTextEncoding enc <-IO TextEncoding getFileSystemEncoding String result <-TextEncoding -> CString -> IO String GHC.peekCString TextEncoding enc CString litstring Maybe String -> IO (Maybe String) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe String -> IO (Maybe String)) -> Maybe String -> IO (Maybe String) forall a b. (a -> b) -> a -> b $ String -> Maybe String forall a. a -> Maybe a Just String result elseMaybe String -> IO (Maybe String) forall (m :: * -> *) a. Monad m => a -> m a return Maybe String forall a. Maybe a Nothing foreignimportccallunsafe"getenv"c_getenv ::CString ->IO(Ptr CChar ) #endif ioe_missingEnvVar ::String ->IOa ioe_missingEnvVar :: String -> IO a ioe_missingEnvVar String name =IOException -> IO a forall a. IOException -> IO a ioException (Maybe Handle -> IOErrorType -> String -> String -> Maybe CInt -> Maybe String -> IOException IOError Maybe Handle forall a. Maybe a Nothing IOErrorType NoSuchThing String "getEnv"String "no environment variable"Maybe CInt forall a. Maybe a Nothing (String -> Maybe String forall a. a -> Maybe a Just String name ))-- | @setEnv name value@ sets the specified environment variable to @value@.---- Early versions of this function operated under the mistaken belief that-- setting an environment variable to the /empty string/ on Windows removes-- that environment variable from the environment. For the sake of-- compatibility, it adopted that behavior on POSIX. In particular---- @-- setEnv name \"\"-- @---- has the same effect as---- @-- `unsetEnv` name-- @---- If you'd like to be able to set environment variables to blank strings,-- use `System.Environment.Blank.setEnv`.---- Throws `Control.Exception.IOException` if @name@ is the empty string or-- contains an equals sign.---- @since 4.7.0.0setEnv ::String ->String ->IO()setEnv :: String -> String -> IO () setEnv String key_ String value_ |String -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null String key =IOException -> IO () forall e a. Exception e => e -> IO a throwIO (IOErrorType -> String -> Maybe Handle -> Maybe String -> IOException mkIOError IOErrorType InvalidArgument String "setEnv"Maybe Handle forall a. Maybe a Nothing Maybe String forall a. Maybe a Nothing )|Char '='Char -> String -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `elem` String key =IOException -> IO () forall e a. Exception e => e -> IO a throwIO (IOErrorType -> String -> Maybe Handle -> Maybe String -> IOException mkIOError IOErrorType InvalidArgument String "setEnv"Maybe Handle forall a. Maybe a Nothing Maybe String forall a. Maybe a Nothing )|String -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null String value =String -> IO () unsetEnv String key |Bool otherwise =String -> String -> IO () setEnv_ String key String value wherekey :: String key =(Char -> Bool) -> String -> String forall a. (a -> Bool) -> [a] -> [a] takeWhile (Char -> Char -> Bool forall a. Eq a => a -> a -> Bool /=Char '\NUL')String key_ value :: String value =(Char -> Bool) -> String -> String forall a. (a -> Bool) -> [a] -> [a] takeWhile (Char -> Char -> Bool forall a. Eq a => a -> a -> Bool /=Char '\NUL')String value_ setEnv_ ::String ->String ->IO() #if defined(mingw32_HOST_OS) setEnv_keyvalue=withCWStringkey$\k->withCWStringvalue$\v->dosuccess<-c_SetEnvironmentVariablekvunlesssuccess(throwGetLastError"setEnv")foreignimportWINDOWS_CCONVunsafe"windows.h SetEnvironmentVariableW"c_SetEnvironmentVariable::LPTSTR->LPTSTR->IOBool #else -- NOTE: The 'setenv()' function is not available on all systems, hence we use-- 'putenv()'. This leaks memory, but so do common implementations of-- 'setenv()' (AFAIK).setEnv_ :: String -> String -> IO () setEnv_ String k String v =String -> IO () putEnv (String k String -> String -> String forall a. [a] -> [a] -> [a] ++ String "="String -> String -> String forall a. [a] -> [a] -> [a] ++ String v )putEnv ::String ->IO()putEnv :: String -> IO () putEnv String keyvalue =doCString s <-IO TextEncoding getFileSystemEncoding IO TextEncoding -> (TextEncoding -> IO CString) -> IO CString forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (TextEncoding -> String -> IO CString `GHC.newCString` String keyvalue )-- IMPORTANT: Do not free `s` after calling putenv!---- According to SUSv2, the string passed to putenv becomes part of the-- environment.(CInt -> Bool) -> String -> IO CInt -> IO () forall a. (a -> Bool) -> String -> IO a -> IO () throwErrnoIf_ (CInt -> CInt -> Bool forall a. Eq a => a -> a -> Bool /=CInt 0)String "putenv"(CString -> IO CInt c_putenv CString s )foreignimportccallunsafe"putenv"c_putenv ::CString ->IOCInt #endif -- | @unsetEnv name@ removes the specified environment variable from the-- environment of the current process.---- Throws `Control.Exception.IOException` if @name@ is the empty string or-- contains an equals sign.---- @since 4.7.0.0unsetEnv ::String ->IO() #if defined(mingw32_HOST_OS) unsetEnvkey=withCWStringkey$\k->dosuccess<-c_SetEnvironmentVariableknullPtrunlesssuccess$do-- We consider unsetting an environment variable that does not exist not as-- an error, hence we ignore eRROR_ENVVAR_NOT_FOUND.err<-c_GetLastErrorunless(err==eRROR_ENVVAR_NOT_FOUND)$dothrowGetLastError"unsetEnv" #else #if defined(HAVE_UNSETENV) unsetEnv :: String -> IO () unsetEnv String key =String -> (CString -> IO ()) -> IO () forall a. String -> (CString -> IO a) -> IO a withFilePath String key ((CInt -> Bool) -> String -> IO CInt -> IO () forall a. (a -> Bool) -> String -> IO a -> IO () throwErrnoIf_ (CInt -> CInt -> Bool forall a. Eq a => a -> a -> Bool /=CInt 0)String "unsetEnv"(IO CInt -> IO ()) -> (CString -> IO CInt) -> CString -> IO () forall b c a. (b -> c) -> (a -> b) -> a -> c . CString -> IO CInt c_unsetenv )foreignimportccallunsafe"__hsbase_unsetenv"c_unsetenv ::CString ->IOCInt #else unsetEnvkey=setEnv_key"" #endif #endif {-| 'withArgs' @args act@ - while executing action @act@, have 'getArgs' return @args@. -}withArgs ::[String ]->IOa ->IOa withArgs :: [String] -> IO a -> IO a withArgs [String] xs IO a act =doString p <-IO String System.Environment.getProgName [String] -> IO a -> IO a forall a. [String] -> IO a -> IO a withArgv (String p String -> [String] -> [String] forall a. a -> [a] -> [a] :[String] xs )IO a act {-| 'withProgName' @name act@ - while executing action @act@, have 'getProgName' return @name@. -}withProgName ::String ->IOa ->IOa withProgName :: String -> IO a -> IO a withProgName String nm IO a act =do[String] xs <-IO [String] System.Environment.getArgs [String] -> IO a -> IO a forall a. [String] -> IO a -> IO a withArgv (String nm String -> [String] -> [String] forall a. a -> [a] -> [a] :[String] xs )IO a act -- Worker routine which marshals and replaces an argv vector for-- the duration of an action.withArgv ::[String ]->IOa ->IOa withArgv :: [String] -> IO a -> IO a withArgv =[String] -> IO a -> IO a forall a. [String] -> IO a -> IO a withProgArgv withProgArgv ::[String ]->IOa ->IOa withProgArgv :: [String] -> IO a -> IO a withProgArgv [String] new_args IO a act =doString pName <-IO String System.Environment.getProgName [String] existing_args <-IO [String] System.Environment.getArgs IO () -> IO () -> IO a -> IO a forall a b c. IO a -> IO b -> IO c -> IO c bracket_ ([String] -> IO () setProgArgv [String] new_args )([String] -> IO () setProgArgv (String pName String -> [String] -> [String] forall a. a -> [a] -> [a] :[String] existing_args ))IO a act setProgArgv ::[String ]->IO()setProgArgv :: [String] -> IO () setProgArgv [String] argv =doTextEncoding enc <-IO TextEncoding argvEncoding TextEncoding -> [String] -> (Int -> Ptr CString -> IO ()) -> IO () forall a. TextEncoding -> [String] -> (Int -> Ptr CString -> IO a) -> IO a GHC.withCStringsLen TextEncoding enc [String] argv ((Int -> Ptr CString -> IO ()) -> IO ()) -> (Int -> Ptr CString -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $ \Int len Ptr CString css ->CInt -> Ptr CString -> IO () c_setProgArgv (Int -> CInt forall a b. (Integral a, Num b) => a -> b fromIntegral Int len )Ptr CString css -- setProgArgv copies the argumentsforeignimportccallunsafe"setProgArgv"c_setProgArgv ::CInt ->Ptr CString ->IO()-- |'getEnvironment' retrieves the entire environment as a-- list of @(key,value)@ pairs.---- If an environment entry does not contain an @\'=\'@ character,-- the @key@ is the whole entry and the @value@ is the empty string.getEnvironment ::IO[(String ,String )] #if defined(mingw32_HOST_OS) getEnvironment=bracketc_GetEnvironmentStringsc_FreeEnvironmentStrings$\pBlock->ifpBlock==nullPtrthenreturn[]elsegopBlockwheregopBlock=do-- The block is terminated by a null byte where there-- should be an environment variable of the form X=Yc<-peekpBlockifc==0thenreturn[]elsedo-- Seek the next pair (or terminating null):pBlock'<-seekNullpBlockFalse-- We now know the length in bytes, but ignore it when-- getting the actual String:str<-peekCWStringpBlockfmap(divvystr:)$gopBlock'-- Returns pointer to the byte *after* the next nullseekNullpBlockdone=doletpBlock'=pBlock`plusPtr`sizeOf(undefined::CWchar)ifdonethenreturnpBlock'elsedoc<-peekpBlock'seekNullpBlock'(c==(0::Word8))foreignimportWINDOWS_CCONVunsafe"windows.h GetEnvironmentStringsW"c_GetEnvironmentStrings::IO(PtrCWchar)foreignimportWINDOWS_CCONVunsafe"windows.h FreeEnvironmentStringsW"c_FreeEnvironmentStrings::PtrCWchar->IOBool #else getEnvironment :: IO [(String, String)] getEnvironment =doPtr CString pBlock <-IO (Ptr CString) getEnvBlock ifPtr CString pBlock Ptr CString -> Ptr CString -> Bool forall a. Eq a => a -> a -> Bool ==Ptr CString forall a. Ptr a nullPtr then[(String, String)] -> IO [(String, String)] forall (m :: * -> *) a. Monad m => a -> m a return []elsedoTextEncoding enc <-IO TextEncoding getFileSystemEncoding [String] stuff <-CString -> Ptr CString -> IO [CString] forall a. (Storable a, Eq a) => a -> Ptr a -> IO [a] peekArray0 CString forall a. Ptr a nullPtr Ptr CString pBlock IO [CString] -> ([CString] -> IO [String]) -> IO [String] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (CString -> IO String) -> [CString] -> IO [String] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM (TextEncoding -> CString -> IO String GHC.peekCString TextEncoding enc )[(String, String)] -> IO [(String, String)] forall (m :: * -> *) a. Monad m => a -> m a return ((String -> (String, String)) -> [String] -> [(String, String)] forall a b. (a -> b) -> [a] -> [b] map String -> (String, String) divvy [String] stuff )foreignimportccallunsafe"__hscore_environ"getEnvBlock ::IO(Ptr CString ) #endif divvy ::String ->(String ,String )divvy :: String -> (String, String) divvy String str =case(Char -> Bool) -> String -> (String, String) forall a. (a -> Bool) -> [a] -> ([a], [a]) break (Char -> Char -> Bool forall a. Eq a => a -> a -> Bool ==Char '=')String str of(String xs ,[])->(String xs ,[])-- don't barf (like Posix.getEnvironment)(String name ,Char _:String value )->(String name ,String value )