Movatterモバイル変換

{-# 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,)whereimportForeignimportForeign.CimportSystem.IO.Error(mkIOError)importControl.Exception.Base(bracket_,throwIO)#if defined(mingw32_HOST_OS)importControl.Exception.Base(bracket)#endif-- import GHC.IOimportGHC.IO.ExceptionimportqualifiedGHC.ForeignasGHCimportControl.Monad#if defined(mingw32_HOST_OS)importGHC.IO.Encoding(argvEncoding)importGHC.Windows#elseimportGHC.IO.Encoding(getFileSystemEncoding,argvEncoding)importSystem.Posix.Internals(withFilePath)#endifimportSystem.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=alloca$\p_argc->alloca$\p_argv->dogetProgArgvp_argcp_argvp<-fromIntegral`liftM`peekp_argcargv<-peekp_argvenc<-argvEncodingpeekArray(p-1)(advancePtrargv1)>>=mapM(GHC.peekCStringenc)foreignimportccallunsafe"getProgArgv"getProgArgv::PtrCInt->Ptr(PtrCString)->IO(){-|Computation 'getProgName' returns the name of the program as it wasinvoked.However, this is hard-to-impossible to implement on some non-UnixOSes, so instead, for maximum portability, we just return the leafnameof the program as invoked. Even then there are some differencesbetween platforms: on Windows, for example, a program invoked as foois 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=alloca$\p_argc->alloca$\p_argv->dogetProgArgvp_argcp_argvargv<-peekp_argvunpackProgNameargvunpackProgName::Ptr(PtrCChar)->IOString-- argv[0]unpackProgNameargv=doenc<-argvEncodings<-peekElemOffargv0>>=GHC.peekCStringencreturn(basenames)basename::FilePath->FilePathbasenamef=goffwheregoacc[]=accgoacc(x:xs)|isPathSeparatorx=goxsxs|otherwise=goaccxsisPathSeparator::Char->BoolisPathSeparator'/'=True#if defined(mingw32_HOST_OS)isPathSeparator'\\'=True#endifisPathSeparator_=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->IOStringgetEnvname=lookupEnvname>>=maybehandleErrorreturnwhere#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#elsehandleError=ioe_missingEnvVarname#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(MaybeString)#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#elselookupEnvname=withCStringname$\s->dolitstring<-c_getenvsiflitstring/=nullPtrthendoenc<-getFileSystemEncodingresult<-GHC.peekCStringenclitstringreturn$JustresultelsereturnNothingforeignimportccallunsafe"getenv"c_getenv::CString->IO(PtrCChar)#endifioe_missingEnvVar::String->IOaioe_missingEnvVarname=ioException(IOErrorNothingNoSuchThing"getEnv""no environment variable"Nothing(Justname))-- | @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()setEnvkey_value_|nullkey=throwIO(mkIOErrorInvalidArgument"setEnv"NothingNothing)|'='`elem`key=throwIO(mkIOErrorInvalidArgument"setEnv"NothingNothing)|nullvalue=unsetEnvkey|otherwise=setEnv_keyvaluewherekey=takeWhile(/='\NUL')key_value=takeWhile(/='\NUL')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_kv=putEnv(k++"="++v)putEnv::String->IO()putEnvkeyvalue=dos<-getFileSystemEncoding>>=(`GHC.newCString`keyvalue)-- IMPORTANT: Do not free `s` after calling putenv!---- According to SUSv2, the string passed to putenv becomes part of the-- environment.throwErrnoIf_(/=0)"putenv"(c_putenvs)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)unsetEnvkey=withFilePathkey(throwErrnoIf_(/=0)"unsetEnv".c_unsetenv)foreignimportccallunsafe"__hsbase_unsetenv"c_unsetenv::CString->IOCInt#elseunsetEnvkey=setEnv_key""#endif#endif{-|'withArgs' @args act@ - while executing action @act@, have 'getArgs'return @args@.-}withArgs::[String]->IOa->IOawithArgsxsact=dop<-System.Environment.getProgNamewithArgv(p:xs)act{-|'withProgName' @name act@ - while executing action @act@,have 'getProgName' return @name@.-}withProgName::String->IOa->IOawithProgNamenmact=doxs<-System.Environment.getArgswithArgv(nm:xs)act-- Worker routine which marshals and replaces an argv vector for-- the duration of an action.withArgv::[String]->IOa->IOawithArgv=withProgArgvwithProgArgv::[String]->IOa->IOawithProgArgvnew_argsact=dopName<-System.Environment.getProgNameexisting_args<-System.Environment.getArgsbracket_(setProgArgvnew_args)(setProgArgv(pName:existing_args))actsetProgArgv::[String]->IO()setProgArgvargv=doenc<-argvEncodingGHC.withCStringsLenencargv$\lencss->c_setProgArgv(fromIntegrallen)css-- setProgArgv copies the argumentsforeignimportccallunsafe"setProgArgv"c_setProgArgv::CInt->PtrCString->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#elsegetEnvironment=dopBlock<-getEnvBlockifpBlock==nullPtrthenreturn[]elsedoenc<-getFileSystemEncodingstuff<-peekArray0nullPtrpBlock>>=mapM(GHC.peekCStringenc)return(mapdivvystuff)foreignimportccallunsafe"__hscore_environ"getEnvBlock::IO(PtrCString)#endifdivvy::String->(String,String)divvystr=casebreak(=='=')strof(xs,[])->(xs,[])-- don't barf (like Posix.getEnvironment)(name,_:value)->(name,value)