diff options
author | stolz <unknown> | 2003-02-28 16:09:16 +0000 |
---|---|---|
committer | stolz <unknown> | 2003-02-28 16:09:16 +0000 |
commit | 10581c4a061eea0681560c295750fec6eda7caed (patch) | |
tree | ef2543656d9efe32d20ea9a4e5d3e02f3d95828a /System | |
parent | 9b1c00b5f832d6a1edc597dab913dbc287958a0b (diff) |
[project @ 2003-02-28 16:09:16 by stolz]
Add System.Posix.Env
Diffstat (limited to 'System')
-rw-r--r-- | System/Posix.hs | 2 | ||||
-rw-r--r-- | System/Posix/Env.hsc | 111 |
2 files changed, 113 insertions, 0 deletions
diff --git a/System/Posix.hs b/System/Posix.hs index c15bc24..c730294 100644 --- a/System/Posix.hs +++ b/System/Posix.hs @@ -19,6 +19,7 @@ module System.Posix ( module System.Posix.Files, module System.Posix.Unistd, module System.Posix.IO, + module System.Posix.Env, module System.Posix.Process, module System.Posix.Terminal, module System.Posix.Time, @@ -32,6 +33,7 @@ import System.Posix.Files import System.Posix.Unistd import System.Posix.Process import System.Posix.IO +import System.Posix.Env import System.Posix.Terminal import System.Posix.Time import System.Posix.User diff --git a/System/Posix/Env.hsc b/System/Posix/Env.hsc new file mode 100644 index 0000000..3692a5f --- /dev/null +++ b/System/Posix/Env.hsc @@ -0,0 +1,111 @@ +{-# OPTIONS -fffi #-} +----------------------------------------------------------------------------- +-- | +-- Module : System.Posix.Env +-- Copyright : (c) The University of Glasgow 2002 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : provisional +-- Portability : non-portable (requires POSIX) +-- +-- POSIX environment support +-- +----------------------------------------------------------------------------- + +module System.Posix.Env ( + getEnvVar, + getEnvVarDefault, + getEnvironmentPrim, + getEnvironment, + putEnv, + setEnv, + unsetEnv +) where + +#include "HsUnix.h" + +import Foreign.C.Error ( throwErrnoIfMinus1_ ) +import Foreign.C.Types ( CInt ) +import Foreign.C.String +import Foreign.Marshal.Array +import Foreign.Ptr +import Monad ( liftM ) +import Maybe ( fromMaybe ) + +-- |'getEnvVar' looks up a variable in the environment. + +getEnvVar :: String -> IO (Maybe String) +getEnvVar name = do + litstring <- withCString name c_getenv + if litstring /= nullPtr + then liftM Just $ peekCString litstring + else return Nothing + +-- |'getEnvVarDefault' is a wrapper around 'getEnvVar' where the +-- programmer can specify a fallback if the variable is not found +-- in the environment. + +getEnvVarDefault :: String -> String -> IO String +getEnvVarDefault name fallback = liftM (fromMaybe fallback) (getEnvVar name) + +foreign import ccall unsafe "getenv" + c_getenv :: CString -> IO CString + +getEnvironmentPrim :: IO [String] +getEnvironmentPrim = do + arr <- peekArray0 nullPtr c_environ + mapM peekCString arr + +foreign import ccall unsafe "__hsunix_environ" + c_environ :: Ptr CString + +-- |'getEnvironment' retrieves the entire environment as a +-- list of @(key,value)@ pairs. + +getEnvironment :: IO [(String,String)] +getEnvironment = do + env <- getEnvironmentPrim + return $ map (dropEq.(break ((==) '='))) env + where + dropEq (x,'=':ys) = (x,ys) + dropEq (x,_) = error $ "getEnvironment: insane variable " ++ x + +-- |The 'unsetenv' function deletes all instances of the variable name +-- from the environment. + +unsetEnv :: String -> IO () +unsetEnv name = withCString name c_unsetenv + +foreign import ccall unsafe "unsetenv" + c_unsetenv :: CString -> IO () + +-- |'putEnv' function takes an argument of the form @name=value@ +-- and is equivalent to @setEnv(key,value,True{-overwrite-})@. + +putEnv :: String -> IO () +putEnv keyvalue = withCString keyvalue $ \s -> + throwErrnoIfMinus1_ "putenv" (c_putenv s) + +foreign import ccall unsafe "putenv" + c_putenv :: CString -> IO CInt + +{- |The 'setenv' function inserts or resets the environment variable name in + the current environment list. If the variable @name@ does not exist in the + list, it is inserted with the given value. If the variable does exist, + the argument @overwrite@ is tested; if @overwrite@ is @False@, the variable is + not reset, otherwise it is reset to the given value. +-} + +setEnv :: String -> String -> Bool {-overwrite-} -> IO () +setEnv key value ovrwrt = do + withCString key $ \ keyP -> + withCString value $ \ valueP -> + throwErrnoIfMinus1_ "putenv" $ c_setenv keyP valueP (toInt ovrwrt) + where + toInt :: Bool -> CInt + toInt True = 1 + toInt False = 0 + +foreign import ccall unsafe "setenv" + c_setenv :: CString -> CString -> CInt -> IO CInt |