Ticket #7427: 0001-Add-setEnv-unsetEnv-to-System.Environment.patch

File 0001-Add-setEnv-unsetEnv-to-System.Environment.patch, 6.6 KB (added by SimonHengel, 2 years ago)
  • System/Environment.hs

    From 1f8133a1d735bc2d371353f372127ff59da595f9 Mon Sep 17 00:00:00 2001
    From: Simon Hengel <[email protected]>
    Date: Sun, 18 Nov 2012 18:20:54 +0100
    Subject: [PATCH] Add setEnv/unsetEnv to System.Environment
    
    ---
     System/Environment.hs |   96 +++++++++++++++++++++++++++++++++++++++++++++++--
     base.cabal            |    1 +
     cbits/SetEnv.c        |   11 ++++++
     configure.ac          |   16 +++++++++
     4 files changed, 122 insertions(+), 2 deletions(-)
     create mode 100644 cbits/SetEnv.c
    
    diff --git a/System/Environment.hs b/System/Environment.hs
    index 184c910..7d3df4e 100644
    a b module System.Environment 
    2222      getExecutablePath, 
    2323      getEnv, 
    2424      lookupEnv, 
     25      setEnv, 
     26      unsetEnv, 
    2527#ifndef __NHC__ 
    2628      withArgs, 
    2729      withProgName, 
    import Prelude 
    3638#ifdef __GLASGOW_HASKELL__ 
    3739import Foreign.Safe 
    3840import Foreign.C 
    39 import Control.Exception.Base   ( bracket ) 
     41import System.IO.Error (mkIOError) 
     42import Control.Exception.Base (bracket, throwIO) 
    4043-- import GHC.IO 
    4144import GHC.IO.Exception 
    4245import GHC.IO.Encoding (getFileSystemEncoding) 
    4346import qualified GHC.Foreign as GHC 
    4447import Data.List 
     48import Control.Monad 
    4549#ifdef mingw32_HOST_OS 
    4650import GHC.Environment 
    4751import GHC.Windows 
    4852#else 
    49 import Control.Monad 
     53import System.Posix.Internals (withFilePath) 
    5054#endif 
    5155#endif 
    5256 
    import System.Environment.ExecutablePath 
    7579#endif 
    7680 
    7781#ifdef __GLASGOW_HASKELL__ 
     82 
     83#include "HsBaseConfig.h" 
     84 
    7885-- --------------------------------------------------------------------------- 
    7986-- getArgs, getProgName, getEnv 
    8087 
    ioe_missingEnvVar :: String -> IO a 
    257264ioe_missingEnvVar name = ioException (IOError Nothing NoSuchThing "getEnv" 
    258265    "no environment variable" Nothing (Just name)) 
    259266 
     267-- | @setEnv name value@ sets the specified environment variable to @value@. 
     268-- 
     269-- On Windows setting an environment variable to the /empty string/ removes 
     270-- that environment variable from the environment.  For the sake of 
     271-- compatibility we adopt that behavior.  In particular 
     272-- 
     273-- @ 
     274-- setEnv name \"\" 
     275-- @ 
     276-- 
     277-- has the same effect as 
     278-- 
     279-- @ 
     280-- `unsetEnv` name 
     281-- @ 
     282-- 
     283-- If you don't care about Windows support and want to set an environment 
     284-- variable to the empty string use @System.Posix.Env.setEnv@ from the @unix@ 
     285-- package instead. 
     286-- 
     287-- Throws `Control.Exception.IOException` if @name@ is the empty string or 
     288-- contains an equals sign. 
     289setEnv :: String -> String -> IO () 
     290setEnv key_ value_ 
     291  | null key       = throwIO (mkIOError InvalidArgument "setEnv" Nothing Nothing) 
     292  | '=' `elem` key = throwIO (mkIOError InvalidArgument "setEnv" Nothing Nothing) 
     293  | null value     = unsetEnv key 
     294  | otherwise      = setEnv_ key value 
     295  where 
     296    key   = takeWhile (/= '\NUL') key_ 
     297    value = takeWhile (/= '\NUL') value_ 
     298 
     299setEnv_ :: String -> String -> IO () 
     300#ifdef mingw32_HOST_OS 
     301setEnv_ key value = withCWString key $ \k -> withCWString value $ \v -> do 
     302  success <- c_SetEnvironmentVariable k v 
     303  unless success (throwGetLastError "setEnv") 
     304 
     305foreign import WINDOWS_CCONV unsafe "windows.h SetEnvironmentVariableW" 
     306  c_SetEnvironmentVariable :: LPTSTR -> LPTSTR -> IO Bool 
     307#else 
     308 
     309-- NOTE: The 'setenv()' function is not available on all systems, hence we use 
     310-- 'putenv()'.  This leaks memory, but so do common implementations of 
     311-- 'setenv()' (AFAIK). 
     312setEnv_ k v = putEnv (k ++ "=" ++ v) 
     313 
     314putEnv :: String -> IO () 
     315putEnv keyvalue = do 
     316  s <- getFileSystemEncoding >>= (`GHC.newCString` keyvalue) 
     317  -- IMPORTANT: Do not free `s` after calling putenv! 
     318  -- 
     319  -- According to SUSv2, the string passed to putenv becomes part of the 
     320  -- enviroment. 
     321  throwErrnoIf_ (/= 0) "putenv" (c_putenv s) 
     322 
     323foreign import ccall unsafe "putenv" c_putenv :: CString -> IO CInt 
     324#endif 
     325 
     326-- | @unSet name@ removes the specified environment variable from the 
     327-- environment of the current process. 
     328-- 
     329-- Throws `Control.Exception.IOException` if @name@ is the empty string or 
     330-- contains an equals sign. 
     331unsetEnv :: String -> IO () 
     332#ifdef mingw32_HOST_OS 
     333unsetEnv key = withCWString key $ \k -> do 
     334  success <- c_SetEnvironmentVariable k nullPtr 
     335  unless success $ do 
     336    -- We consider unsetting an environment variable that does not exist not as 
     337    -- an error, hence we ignore eRROR_ENVVAR_NOT_FOUND. 
     338    err <- c_GetLastError 
     339    unless (err == eRROR_ENVVAR_NOT_FOUND) $ do 
     340      throwGetLastError "unsetEnv" 
     341#else 
     342 
     343#ifdef HAVE_UNSETENV 
     344unsetEnv key = withFilePath key (throwErrnoIf_ (/= 0) "unsetEnv" . c_unsetenv) 
     345foreign import ccall unsafe "__hsbase_unsetenv" c_unsetenv :: CString -> IO CInt 
     346#else 
     347unsetEnv key = setEnv_ key "" 
     348#endif 
     349 
     350#endif 
     351 
    260352{-| 
    261353'withArgs' @args act@ - while executing action @act@, have 'getArgs' 
    262354return @args@. 
  • base.cabal

    diff --git a/base.cabal b/base.cabal
    index a7d3ce9..3995e5d 100644
    a b Library { 
    222222        cbits/inputReady.c 
    223223        cbits/primFloat.c 
    224224        cbits/md5.c 
     225        cbits/SetEnv.c 
    225226    include-dirs: include 
    226227    includes:    HsBase.h 
    227228    install-includes:    HsBase.h HsBaseConfig.h EventConfig.h WCsubst.h consUtils.h Typeable.h 
  • new file cbits/SetEnv.c

    diff --git a/cbits/SetEnv.c b/cbits/SetEnv.c
    new file mode 100644
    index 0000000..38f0ed5
    - +  
     1#include "HsBase.h" 
     2#ifdef HAVE_UNSETENV 
     3int __hsbase_unsetenv(const char *name) { 
     4#ifdef UNSETENV_RETURNS_VOID 
     5    unsetenv(name); 
     6    return 0; 
     7#else 
     8    return unsetenv(name); 
     9#endif 
     10} 
     11#endif 
  • configure.ac

    diff --git a/configure.ac b/configure.ac
    index b679520..f64e5a2 100644
    a b if test "$ac_cv_header_poll_h" = yes -a "$ac_cv_func_poll" = yes; then 
    6363  AC_DEFINE([HAVE_POLL], [1], [Define if you have poll support.]) 
    6464fi 
    6565 
     66# unsetenv 
     67AC_CHECK_FUNCS([unsetenv]) 
     68 
     69###  POSIX.1003.1 unsetenv returns 0 or -1 (EINVAL), but older implementations 
     70###  in common use return void. 
     71AC_CACHE_CHECK([return type of unsetenv], fptools_cv_func_unsetenv_return_type, 
     72  [AC_EGREP_HEADER(changequote(<, >)<void[      ]+unsetenv>changequote([, ]), 
     73                   stdlib.h, 
     74                   [fptools_cv_func_unsetenv_return_type=void], 
     75                   [fptools_cv_func_unsetenv_return_type=int])]) 
     76case "$fptools_cv_func_unsetenv_return_type" in 
     77  "void" ) 
     78    AC_DEFINE([UNSETENV_RETURNS_VOID], [1], [Define if stdlib.h declares unsetenv to return void.]) 
     79  ;; 
     80esac 
     81 
    6682dnl-------------------------------------------------------------------- 
    6783dnl * Deal with arguments telling us iconv is somewhere odd 
    6884dnl--------------------------------------------------------------------