Use haskell setenv library to clean up several ugly workarounds for inability to manipulate the environment on windows.

Didn't know that this library existed!

This includes making git-annex not re-exec itself on start on windows, and
making the test suite on Windows run tests without forking.
This commit is contained in:
Joey Hess 2014-10-15 20:33:52 -04:00
parent 65280d91e7
commit 1e59df083d
12 changed files with 40 additions and 79 deletions

View file

@ -14,6 +14,7 @@ import Utility.Exception
import Control.Applicative
import Data.Maybe
import qualified System.Environment as E
import qualified System.SetEnv
#else
import qualified System.Posix.Env as PE
#endif
@ -39,27 +40,27 @@ getEnvironment = PE.getEnvironment
getEnvironment = E.getEnvironment
#endif
{- Returns True if it could successfully set the environment variable.
{- Sets an environment variable. To overwrite an existing variable,
- overwrite must be True.
-
- There is, apparently, no way to do this in Windows. Instead,
- environment varuables must be provided when running a new process. -}
setEnv :: String -> String -> Bool -> IO Bool
- On Windows, setting a variable to "" unsets it. -}
setEnv :: String -> String -> Bool -> IO ()
#ifndef mingw32_HOST_OS
setEnv var val overwrite = do
PE.setEnv var val overwrite
return True
setEnv var val overwrite = PE.setEnv var val overwrite
#else
setEnv _ _ _ = return False
setEnv var val True = System.Setenv.setEnv var val
setEnv var val False = do
r <- getEnv var
case r of
Nothing -> setEnv var val True
Just _ -> return True
#endif
{- Returns True if it could successfully unset the environment variable. -}
unsetEnv :: String -> IO Bool
unsetEnv :: String -> IO ()
#ifndef mingw32_HOST_OS
unsetEnv var = do
PE.unsetEnv var
return True
unsetEnv = PE.unsetEnv
#else
unsetEnv _ = return False
unsetEnv = System.Setenv.unsetEnv
#endif
{- Adds the environment variable to the input environment. If already

View file

@ -334,7 +334,7 @@ testHarness a = do
setup = do
base <- getTemporaryDirectory
dir <- mktmpdir $ base </> "gpgtmpXXXXXX"
void $ setEnv var dir True
setEnv var dir True
-- For some reason, recent gpg needs a trustdb to be set up.
_ <- pipeStrict [Params "--trust-model auto --update-trustdb"] []
_ <- pipeStrict [Params "--import -q"] $ unlines

View file

@ -32,7 +32,7 @@ setup = do
when (isAbsolute cmd) $ do
path <- getSearchPath
let path' = takeDirectory cmd : path
void $ setEnv "PATH" (intercalate [searchPathSeparator] path') True
setEnv "PATH" (intercalate [searchPathSeparator] path') True
{- Checks each of the files in a directory to find open files.
- Note that this will find hard links to files elsewhere that are open. -}