finally really add back custom-setup stanza

Fourth or fifth try at this and finally found a way to make it work.

Absurd amount of busy-work forced on me by change in cabal's behavior.
Split up Utility modules that need posix stuff out of ones used by
Setup. Various other hacks around inability for Setup to use anything
that ifdefs a use of unix.

Probably lost a full day of my life to this.
This is how build systems make their users hate them. Just saying.

Annex/Action.hs

@@ -12,6 +12,8 @@ module Annex.Action where
 import qualified Data.Map as M
 #ifndef mingw32_HOST_OS
 import System.Posix.Signals
+import System.Posix.Process (getAnyProcessStatus)
+import Utility.Exception
 #endif
 
 import Annex.Common
@@ -46,3 +48,19 @@ stopCoProcesses = do
 	checkAttrStop
 	hashObjectStop
 	checkIgnoreStop
+
+{- Reaps any zombie processes that may be hanging around.
+ -
+ - Warning: Not thread safe. Anything that was expecting to wait
+ - on a process and get back an exit status is going to be confused
+ - if this reap gets there first. -}
+reapZombies :: IO ()
+#ifndef mingw32_HOST_OS
+reapZombies =
+	-- throws an exception when there are no child processes
+	catchDefaultIO Nothing (getAnyProcessStatus False True)
+		>>= maybe (return ()) (const reapZombies)
+
+#else
+reapZombies = return ()
+#endif

Annex/AdjustedBranch.hs

@@ -50,7 +50,7 @@ import Annex.AutoMerge
 import Annex.Content
 import Annex.Perms
 import Annex.GitOverlay
-import Utility.Tmp
+import Utility.Tmp.Dir
 import Utility.CopyFile
 import qualified Database.Keys
 import Config

Annex/Branch.hs

@@ -65,6 +65,7 @@ import Annex.Branch.Transitions
 import qualified Annex
 import Annex.Hook
 import Utility.FileSystemEncoding
+import Utility.Directory.Stream
 
 {- Name of the branch that is used to store git-annex's information. -}
 name :: Git.Ref

Annex/Common.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 module Annex.Common (module X) where
 
 import Common as X
@@ -7,3 +9,6 @@ import Types.UUID as X
 import Annex as X (gitRepo, inRepo, fromRepo, calcRepo)
 import Annex.Locations as X
 import Messages as X
+#ifndef mingw32_HOST_OS
+import System.Posix.IO as X hiding (createPipe)
+#endif

Annex/Environment.hs

@@ -13,7 +13,7 @@ import Annex.Common
 import Utility.UserInfo
 import qualified Git.Config
 import Config
-import Utility.Env
+import Utility.Env.Set
 
 {- Checks that the system's environment allows git to function.
  - Git requires a GECOS username, or suitable git configuration, or

Annex/Journal.hs

@@ -17,6 +17,7 @@ import Annex.Common
 import qualified Git
 import Annex.Perms
 import Annex.LockFile
+import Utility.Directory.Stream
 
 {- Records content for a file in the branch to the journal.
  -

Annex/MakeRepo.hs

@@ -20,6 +20,7 @@ import Annex.Action
 import Types.StandardGroups
 import Logs.PreferredContent
 import qualified Annex.Branch
+import Utility.Process.Transcript
 
 {- Makes a new git repository. Or, if a git repository already
  - exists, returns False. -}

Annex/ReplaceFile.hs

@@ -11,7 +11,8 @@ module Annex.ReplaceFile where
 
 import Annex.Common
 import Annex.Perms
-import Utility.Tmp
+import Utility.Tmp.Dir
+import Utility.Path.Max
 
 {- Replaces a possibly already existing file with a new version, 
  - atomically, by running an action.

Annex/Ssh.hs

@@ -34,6 +34,7 @@ import Annex.Path
 import Utility.Env
 import Utility.FileSystemEncoding
 import Utility.Hash
+import Utility.Process.Transcript
 import Types.CleanupActions
 import Types.Concurrency
 import Git.Env

Annex/YoutubeDl.hs

@@ -21,6 +21,7 @@ import Annex.Url
 import Utility.Url (URLString)
 import Utility.DiskFree
 import Utility.HtmlDetect
+import Utility.Process.Transcript
 import Logs.Transfer
 
 import Network.URI

Assistant/Ssh.hs

@@ -9,12 +9,14 @@ module Assistant.Ssh where
 
 import Annex.Common
 import Utility.Tmp
+import Utility.Tmp.Dir
 import Utility.Shell
 import Utility.Rsync
 import Utility.FileMode
 import Utility.SshConfig
 import Git.Remote
 import Utility.SshHost
+import Utility.Process.Transcript
 
 import Data.Text (Text)
 import qualified Data.Text as T

Assistant/Upgrade.hs

@@ -15,6 +15,7 @@ import qualified Annex
 import Assistant.Alert
 import Assistant.DaemonStatus
 import Utility.Env
+import Utility.Env.Set
 import Types.Distribution
 import Types.Transfer
 import Logs.Web
@@ -31,7 +32,7 @@ import Remote (remoteFromUUID)
 import Annex.Path
 import Config.Files
 import Utility.ThreadScheduler
-import Utility.Tmp
+import Utility.Tmp.Dir
 import Utility.UserInfo
 import Utility.Gpg
 import Utility.FileMode

Assistant/WebApp/Configurators/Pairing.hs

@@ -34,6 +34,7 @@ import Command.P2P (unusedPeerRemoteName, PairingResult(..))
 import P2P.Address
 import Git
 import Config.Files
+import Utility.Process.Transcript
 
 import qualified Data.Map as M
 import qualified Data.Text as T

Assistant/WebApp/Configurators/Ssh.hs

@@ -40,6 +40,7 @@ import Utility.FileMode
 import Utility.ThreadScheduler
 import Utility.Env
 import Utility.SshHost
+import Utility.Process.Transcript
 
 import qualified Data.Text as T
 import qualified Data.Map as M

Build/Configure.hs

@@ -4,22 +4,23 @@
 
 module Build.Configure where
 
-import Control.Applicative
-import Control.Monad.IfElse
-import Control.Monad
-
 import Build.TestConfig
 import Build.Version
 import Utility.PartialPrelude
 import Utility.Process
 import Utility.SafeCommand
 import Utility.ExternalSHA
-import Utility.Env
+import Utility.Env.Basic
 import Utility.Exception
 import qualified Git.Version
 import Utility.DottedVersion
 import Utility.Directory
 
+import Control.Monad.IfElse
+import Control.Monad
+import Control.Applicative
+import Prelude
+
 tests :: [TestCase]
 tests =
 	[ TestCase "version" (Config "packageversion" . StringConfig <$> getVersion)

Build/DesktopFile.hs

@@ -22,9 +22,7 @@ import Assistant.Install.AutoStart
 import Assistant.Install.Menu
 
 import System.Environment
-#ifndef mingw32_HOST_OS
-import System.Posix.User
-#endif
+import System.PosixCompat.User
 import Data.Maybe
 import Control.Applicative
 import Prelude

CHANGELOG

@@ -10,6 +10,7 @@ git-annex (6.20171215) UNRELEASED; urgency=medium
     nothing, like it used to when quvi was used.
   * addurl: Fix encoding of filename queried from youtube-dl when in
     --fast mode.
+  * git-annex.cabal: Add back custom-setup stanza, so cabal new-build works.
 
  -- Joey Hess <id@joeyh.name>  Wed, 20 Dec 2017 12:11:46 -0400
 

Command/AddUrl.hs

@@ -30,6 +30,7 @@ import Logs.Location
 import Utility.Metered
 import Utility.FileSystemEncoding
 import Utility.HtmlDetect
+import Utility.Path.Max
 import qualified Annex.Transfer as Transfer
 
 cmd :: Command

Command/Multicast.hs

@@ -25,6 +25,8 @@ import Types.FileMatcher
 import qualified Git.LsFiles as LsFiles
 import Utility.Hash
 import Utility.Tmp
+import Utility.Tmp.Dir
+import Utility.Process.Transcript
 import Config
 
 import Data.Char

Command/P2P.hs

@@ -19,7 +19,7 @@ import qualified Annex
 import Annex.UUID
 import Config
 import Utility.AuthToken
-import Utility.Tmp
+import Utility.Tmp.Dir
 import Utility.FileMode
 import Utility.ThreadScheduler
 import qualified Utility.MagicWormhole as Wormhole

Command/Proxy.hs

@@ -9,7 +9,7 @@ module Command.Proxy where
 
 import Command
 import Config
-import Utility.Tmp
+import Utility.Tmp.Dir
 import Utility.Env
 import Annex.Direct
 import qualified Git

Command/Sync.hs

@@ -63,6 +63,7 @@ import Annex.TaggedPush
 import qualified Database.Export as Export
 import Utility.Bloom
 import Utility.OptParse
+import Utility.Process.Transcript
 
 import Control.Concurrent.MVar
 import qualified Data.Map as M

Common.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE PackageImports, CPP #-}
+{-# LANGUAGE PackageImports #-}
 
 module Common (module X) where
 
@@ -14,9 +14,6 @@ import Data.Default as X
 
 import System.FilePath as X
 import System.IO as X hiding (FilePath)
-#ifndef mingw32_HOST_OS
-import System.Posix.IO as X hiding (createPipe)
-#endif
 import System.Exit as X
 import System.PosixCompat.Files as X hiding (fileSize)
 

Git/CurrentRepo.hs

@@ -12,6 +12,7 @@ import Git.Types
 import Git.Construct
 import qualified Git.Config
 import Utility.Env
+import Utility.Env.Set
 
 {- Gets the current git repository.
  -

Git/Index.hs

@@ -10,6 +10,7 @@ module Git.Index where
 import Common
 import Git
 import Utility.Env
+import Utility.Env.Set
 
 indexEnv :: String
 indexEnv = "GIT_INDEX_FILE"

Git/LockFile.hs

@@ -13,6 +13,7 @@ import Common
 
 #ifndef mingw32_HOST_OS
 import System.Posix.Types
+import System.Posix.IO
 #else
 import System.Win32.Types
 import System.Win32.File

Git/Repair.hs

@@ -36,7 +36,7 @@ import qualified Git.Ref as Ref
 import qualified Git.RefLog as RefLog
 import qualified Git.UpdateIndex as UpdateIndex
 import qualified Git.Branch as Branch
-import Utility.Tmp
+import Utility.Tmp.Dir
 import Utility.Rsync
 import Utility.FileMode
 import Utility.Tuple

Remote/Rsync.hs

@@ -38,7 +38,7 @@ import Utility.Metered
 import Types.Transfer
 import Types.Creds
 import Annex.DirHashes
-import Utility.Tmp
+import Utility.Tmp.Dir
 import Utility.SshHost
 
 import qualified Data.Map as M

Test.hs

@@ -83,6 +83,7 @@ import qualified Utility.Process
 import qualified Utility.Misc
 import qualified Utility.InodeCache
 import qualified Utility.Env
+import qualified Utility.Env.Set
 import qualified Utility.Matcher
 import qualified Utility.Exception
 import qualified Utility.Hash
@@ -91,7 +92,7 @@ import qualified Utility.Scheduled.QuickCheck
 import qualified Utility.HumanTime
 import qualified Utility.ThreadScheduler
 import qualified Utility.Base64
-import qualified Utility.Tmp
+import qualified Utility.Tmp.Dir
 import qualified Utility.FileSystemEncoding
 import qualified Command.Uninit
 import qualified CmdLine.GitAnnex as GitAnnex
@@ -130,7 +131,7 @@ runner = Just go
 	subenv = "GIT_ANNEX_TEST_SUBPROCESS"
 	runsubprocesstests opts Nothing = do
 		pp <- Annex.Path.programPath
-		Utility.Env.setEnv subenv "1" True
+		Utility.Env.Set.setEnv subenv "1" True
 		ps <- getArgs
 		(Nothing, Nothing, Nothing, pid) <-createProcess (proc pp ps)
 		exitcode <- waitForProcess pid
@@ -356,7 +357,7 @@ test_log = intmpclonerepo $ do
 	git_annex "log" [annexedfile] @? "log failed"
 
 test_import :: Assertion
-test_import = intmpclonerepo $ Utility.Tmp.withTmpDir "importtest" $ \importdir -> do
+test_import = intmpclonerepo $ Utility.Tmp.Dir.withTmpDir "importtest" $ \importdir -> do
 	(toimport1, importf1, imported1) <- mktoimport importdir "import1"
 	git_annex "import" [toimport1] @? "import failed"
 	annexed_present_imported imported1
@@ -1917,11 +1918,11 @@ ensuretmpdir = do
 	
 {- Prevent global git configs from affecting the test suite. -}
 isolateGitConfig :: IO a -> IO a
-isolateGitConfig a = Utility.Tmp.withTmpDir "testhome" $ \tmphome -> do
+isolateGitConfig a = Utility.Tmp.Dir.withTmpDir "testhome" $ \tmphome -> do
 	tmphomeabs <- absPath tmphome
-	Utility.Env.setEnv "HOME" tmphomeabs True
-	Utility.Env.setEnv "XDG_CONFIG_HOME" tmphomeabs True
-	Utility.Env.setEnv "GIT_CONFIG_NOSYSTEM" "1" True
+	Utility.Env.Set.setEnv "HOME" tmphomeabs True
+	Utility.Env.Set.setEnv "XDG_CONFIG_HOME" tmphomeabs True
+	Utility.Env.Set.setEnv "GIT_CONFIG_NOSYSTEM" "1" True
 	a
 
 cleanup :: FilePath -> IO ()
@@ -1933,7 +1934,7 @@ cleanup dir = whenM (doesDirectoryExist dir) $ do
 
 finalCleanup :: IO ()
 finalCleanup = whenM (doesDirectoryExist tmpdir) $ do
-	Utility.Misc.reapZombies
+	Annex.Action.reapZombies
 	Command.Uninit.prepareRemoveAnnexDir' tmpdir
 	catchIO (removeDirectoryRecursive tmpdir) $ \e -> do
 		print e
@@ -1941,7 +1942,7 @@ finalCleanup = whenM (doesDirectoryExist tmpdir) $ do
 		Utility.ThreadScheduler.threadDelaySeconds $
 			Utility.ThreadScheduler.Seconds 10
 		whenM (doesDirectoryExist tmpdir) $ do
-			Utility.Misc.reapZombies
+			Annex.Action.reapZombies
 			removeDirectoryRecursive tmpdir
 	
 checklink :: FilePath -> Assertion
@@ -2107,7 +2108,7 @@ setTestMode testmode = do
 	currdir <- getCurrentDirectory
 	p <- Utility.Env.getEnvDefault "PATH" ""
 
-	mapM_ (\(var, val) -> Utility.Env.setEnv var val True)
+	mapM_ (\(var, val) -> Utility.Env.Set.setEnv var val True)
 		-- Ensure that the just-built git annex is used.
 		[ ("PATH", currdir ++ [searchPathSeparator] ++ p)
 		, ("TOPDIR", currdir)

Utility/Directory.hs

@@ -18,15 +18,11 @@ import Control.Monad
 import System.FilePath
 import System.PosixCompat.Files
 import Control.Applicative
-import Control.Concurrent
 import System.IO.Unsafe (unsafeInterleaveIO)
 import Data.Maybe
 import Prelude
 
-#ifdef mingw32_HOST_OS
-import qualified System.Win32 as Win32
-#else
-import qualified System.Posix as Posix
+#ifndef mingw32_HOST_OS
 import Utility.SafeCommand
 import Control.Monad.IfElse
 #endif
@@ -158,90 +154,3 @@ nukeFile file = void $ tryWhenExists go
 #else
 	go = removeFile file
 #endif
-
-#ifndef mingw32_HOST_OS
-data DirectoryHandle = DirectoryHandle IsOpen Posix.DirStream
-#else
-data DirectoryHandle = DirectoryHandle IsOpen Win32.HANDLE Win32.FindData (MVar ())
-#endif
-
-type IsOpen = MVar () -- full when the handle is open
-
-openDirectory :: FilePath -> IO DirectoryHandle
-openDirectory path = do
-#ifndef mingw32_HOST_OS
-	dirp <- Posix.openDirStream path
-	isopen <- newMVar ()
-	return (DirectoryHandle isopen dirp)
-#else
-	(h, fdat) <- Win32.findFirstFile (path </> "*")
-	-- Indicate that the fdat contains a filename that readDirectory
-	-- has not yet returned, by making the MVar be full.
-	-- (There's always at least a "." entry.)
-	alreadyhave <- newMVar ()
-	isopen <- newMVar ()
-	return (DirectoryHandle isopen h fdat alreadyhave)
-#endif
-
-closeDirectory :: DirectoryHandle -> IO ()
-#ifndef mingw32_HOST_OS
-closeDirectory (DirectoryHandle isopen dirp) =
-	whenOpen isopen $
-		Posix.closeDirStream dirp
-#else
-closeDirectory (DirectoryHandle isopen h _ alreadyhave) =
-	whenOpen isopen $ do
-		_ <- tryTakeMVar alreadyhave
-		Win32.findClose h
-#endif
-  where
-	whenOpen :: IsOpen -> IO () -> IO ()
-	whenOpen mv f = do
-		v <- tryTakeMVar mv
-		when (isJust v) f
-
-{- |Reads the next entry from the handle. Once the end of the directory
-is reached, returns Nothing and automatically closes the handle.
--}
-readDirectory :: DirectoryHandle -> IO (Maybe FilePath)
-#ifndef mingw32_HOST_OS
-readDirectory hdl@(DirectoryHandle _ dirp) = do
-	e <- Posix.readDirStream dirp
-	if null e
-		then do
-			closeDirectory hdl
-			return Nothing
-		else return (Just e)
-#else
-readDirectory hdl@(DirectoryHandle _ h fdat mv) = do
-	-- If the MVar is full, then the filename in fdat has
-	-- not yet been returned. Otherwise, need to find the next
-	-- file.
-	r <- tryTakeMVar mv
-	case r of
-		Just () -> getfn
-		Nothing -> do
-			more <- Win32.findNextFile h fdat
-			if more
-				then getfn
-				else do
-					closeDirectory hdl
-					return Nothing
-  where
-	getfn = do
-		filename <- Win32.getFindDataFileName fdat
-		return (Just filename)
-#endif
-
--- True only when directory exists and contains nothing.
--- Throws exception if directory does not exist.
-isDirectoryEmpty :: FilePath -> IO Bool
-isDirectoryEmpty d = bracket (openDirectory d) closeDirectory check
-  where
-	check h = do
-		v <- readDirectory h
-		case v of
-			Nothing -> return True
-			Just f
-				| not (dirCruft f) -> return False
-				| otherwise -> check h

Utility/Directory/Stream.hs

@@ -0,0 +1,113 @@
+{- streaming directory traversal
+ -
+ - Copyright 2011-2014 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.Directory.Stream where
+
+import Control.Monad
+import System.FilePath
+import Control.Concurrent
+import Data.Maybe
+import Prelude
+
+#ifdef mingw32_HOST_OS
+import qualified System.Win32 as Win32
+#else
+import qualified System.Posix as Posix
+#endif
+
+import Utility.Directory
+import Utility.Exception
+
+#ifndef mingw32_HOST_OS
+data DirectoryHandle = DirectoryHandle IsOpen Posix.DirStream
+#else
+data DirectoryHandle = DirectoryHandle IsOpen Win32.HANDLE Win32.FindData (MVar ())
+#endif
+
+type IsOpen = MVar () -- full when the handle is open
+
+openDirectory :: FilePath -> IO DirectoryHandle
+openDirectory path = do
+#ifndef mingw32_HOST_OS
+	dirp <- Posix.openDirStream path
+	isopen <- newMVar ()
+	return (DirectoryHandle isopen dirp)
+#else
+	(h, fdat) <- Win32.findFirstFile (path </> "*")
+	-- Indicate that the fdat contains a filename that readDirectory
+	-- has not yet returned, by making the MVar be full.
+	-- (There's always at least a "." entry.)
+	alreadyhave <- newMVar ()
+	isopen <- newMVar ()
+	return (DirectoryHandle isopen h fdat alreadyhave)
+#endif
+
+closeDirectory :: DirectoryHandle -> IO ()
+#ifndef mingw32_HOST_OS
+closeDirectory (DirectoryHandle isopen dirp) =
+	whenOpen isopen $
+		Posix.closeDirStream dirp
+#else
+closeDirectory (DirectoryHandle isopen h _ alreadyhave) =
+	whenOpen isopen $ do
+		_ <- tryTakeMVar alreadyhave
+		Win32.findClose h
+#endif
+  where
+	whenOpen :: IsOpen -> IO () -> IO ()
+	whenOpen mv f = do
+		v <- tryTakeMVar mv
+		when (isJust v) f
+
+{- |Reads the next entry from the handle. Once the end of the directory
+is reached, returns Nothing and automatically closes the handle.
+-}
+readDirectory :: DirectoryHandle -> IO (Maybe FilePath)
+#ifndef mingw32_HOST_OS
+readDirectory hdl@(DirectoryHandle _ dirp) = do
+	e <- Posix.readDirStream dirp
+	if null e
+		then do
+			closeDirectory hdl
+			return Nothing
+		else return (Just e)
+#else
+readDirectory hdl@(DirectoryHandle _ h fdat mv) = do
+	-- If the MVar is full, then the filename in fdat has
+	-- not yet been returned. Otherwise, need to find the next
+	-- file.
+	r <- tryTakeMVar mv
+	case r of
+		Just () -> getfn
+		Nothing -> do
+			more <- Win32.findNextFile h fdat
+			if more
+				then getfn
+				else do
+					closeDirectory hdl
+					return Nothing
+  where
+	getfn = do
+		filename <- Win32.getFindDataFileName fdat
+		return (Just filename)
+#endif
+
+-- True only when directory exists and contains nothing.
+-- Throws exception if directory does not exist.
+isDirectoryEmpty :: FilePath -> IO Bool
+isDirectoryEmpty d = bracket (openDirectory d) closeDirectory check
+  where
+	check h = do
+		v <- readDirectory h
+		case v of
+			Nothing -> return True
+			Just f
+				| not (dirCruft f) -> return False
+				| otherwise -> check h

Utility/Env.hs

@@ -16,7 +16,6 @@ import Control.Applicative
 import Data.Maybe
 import Prelude
 import qualified System.Environment as E
-import qualified System.SetEnv
 #else
 import qualified System.Posix.Env as PE
 #endif
@@ -42,29 +41,6 @@ getEnvironment = PE.getEnvironment
 getEnvironment = E.getEnvironment
 #endif
 
-{- Sets an environment variable. To overwrite an existing variable,
- - overwrite must be True.
- -
- - On Windows, setting a variable to "" unsets it. -}
-setEnv :: String -> String -> Bool -> IO ()
-#ifndef mingw32_HOST_OS
-setEnv var val overwrite = PE.setEnv var val overwrite
-#else
-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 ()
-#endif
-
-unsetEnv :: String -> IO ()
-#ifndef mingw32_HOST_OS
-unsetEnv = PE.unsetEnv
-#else
-unsetEnv = System.SetEnv.unsetEnv
-#endif
-
 {- Adds the environment variable to the input environment. If already
  - present in the list, removes the old value.
  -

Utility/Env/Basic.hs

@@ -0,0 +1,22 @@
+{- portable environment variables, without any dependencies
+ -
+ - Copyright 2013 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.Env.Basic where
+
+import Utility.Exception
+import Control.Applicative
+import Data.Maybe
+import Prelude
+import qualified System.Environment as E
+
+getEnv :: String -> IO (Maybe String)
+getEnv = catchMaybeIO . E.getEnv
+
+getEnvDefault :: String -> String -> IO String
+getEnvDefault var fallback = fromMaybe fallback <$> getEnv var

Utility/Env/Set.hs

@@ -0,0 +1,40 @@
+{- portable environment variables
+ -
+ - Copyright 2013 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Utility.Env.Set where
+
+#ifdef mingw32_HOST_OS
+import qualified System.Environment as E
+import qualified System.SetEnv
+#else
+import qualified System.Posix.Env as PE
+#endif
+
+{- Sets an environment variable. To overwrite an existing variable,
+ - overwrite must be True.
+ -
+ - On Windows, setting a variable to "" unsets it. -}
+setEnv :: String -> String -> Bool -> IO ()
+#ifndef mingw32_HOST_OS
+setEnv var val overwrite = PE.setEnv var val overwrite
+#else
+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 ()
+#endif
+
+unsetEnv :: String -> IO ()
+#ifndef mingw32_HOST_OS
+unsetEnv = PE.unsetEnv
+#else
+unsetEnv = System.SetEnv.unsetEnv
+#endif

Utility/Gpg.hs

@@ -13,10 +13,11 @@ import Common
 import qualified BuildInfo
 #ifndef mingw32_HOST_OS
 import System.Posix.Types
-import qualified System.Posix.IO
+import System.Posix.IO
 import Utility.Env
+import Utility.Env.Set
 #endif
-import Utility.Tmp
+import Utility.Tmp.Dir
 import Utility.Format (decode_c)
 
 import Control.Concurrent

Utility/LogFile.hs

@@ -13,6 +13,7 @@ import Common
 
 #ifndef mingw32_HOST_OS
 import System.Posix.Types
+import System.Posix.IO
 #endif
 
 openLog :: FilePath -> IO Handle

Utility/Lsof.hs

@@ -11,7 +11,7 @@ module Utility.Lsof where
 
 import Common
 import BuildInfo
-import Utility.Env
+import Utility.Env.Set
 
 import System.Posix.Types
 

Utility/Misc.hs

@@ -5,7 +5,6 @@
  - License: BSD-2-clause
  -}
 
-{-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.Misc where
@@ -16,10 +15,6 @@ import Foreign
 import Data.Char
 import Data.List
 import System.Exit
-#ifndef mingw32_HOST_OS
-import System.Posix.Process (getAnyProcessStatus)
-import Utility.Exception
-#endif
 import Control.Applicative
 import Prelude
 
@@ -112,22 +107,6 @@ hGetSomeString h sz = do
 	peekbytes :: Int -> Ptr Word8 -> IO [Word8]
 	peekbytes len buf = mapM (peekElemOff buf) [0..pred len]
 
-{- Reaps any zombie processes that may be hanging around.
- -
- - Warning: Not thread safe. Anything that was expecting to wait
- - on a process and get back an exit status is going to be confused
- - if this reap gets there first. -}
-reapZombies :: IO ()
-#ifndef mingw32_HOST_OS
-reapZombies =
-	-- throws an exception when there are no child processes
-	catchDefaultIO Nothing (getAnyProcessStatus False True)
-		>>= maybe (return ()) (const reapZombies)
-
-#else
-reapZombies = return ()
-#endif
-
 exitBool :: Bool -> IO a
 exitBool False = exitFailure
 exitBool True = exitSuccess

Utility/Path.hs

@@ -5,7 +5,7 @@
  - License: BSD-2-clause
  -}
 
-{-# LANGUAGE PackageImports, CPP #-}
+{-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.Path where
@@ -17,13 +17,6 @@ import Data.Char
 import Control.Applicative
 import Prelude
 
-#ifdef mingw32_HOST_OS
-import qualified System.FilePath.Posix as Posix
-#else
-import System.Posix.Files
-import Utility.Exception
-#endif
-
 import Utility.Monad
 import Utility.UserInfo
 import Utility.Directory
@@ -247,50 +240,6 @@ dotfile file
   where
 	f = takeFileName file
 
-{- Converts a DOS style path to a msys2 style path. Only on Windows.
- - Any trailing '\' is preserved as a trailing '/' 
- - 
- - Taken from: http://sourceforge.net/p/msys2/wiki/MSYS2%20introduction/i
- -
- - The virtual filesystem contains:
- -  /c, /d, ...	mount points for Windows drives
- -}
-toMSYS2Path :: FilePath -> FilePath
-#ifndef mingw32_HOST_OS
-toMSYS2Path = id
-#else
-toMSYS2Path p
-	| null drive = recombine parts
-	| otherwise = recombine $ "/" : driveletter drive : parts
-  where
-	(drive, p') = splitDrive p
-	parts = splitDirectories p'
-	driveletter = map toLower . takeWhile (/= ':')
-	recombine = fixtrailing . Posix.joinPath
-	fixtrailing s
-		| hasTrailingPathSeparator p = Posix.addTrailingPathSeparator s
-		| otherwise = s
-#endif
-
-{- Maximum size to use for a file in a specified directory.
- -
- - Many systems have a 255 byte limit to the name of a file, 
- - so that's taken as the max if the system has a larger limit, or has no
- - limit.
- -}
-fileNameLengthLimit :: FilePath -> IO Int
-#ifdef mingw32_HOST_OS
-fileNameLengthLimit _ = return 255
-#else
-fileNameLengthLimit dir = do
-	-- getPathVar can fail due to statfs(2) overflow
-	l <- catchDefaultIO 0 $
-		fromIntegral <$> getPathVar dir FileNameLimit
-	if l <= 0
-		then return 255
-		else return $ minimum [l, 255]
-#endif
-
 {- Given a string that we'd like to use as the basis for FilePath, but that
  - was provided by a third party and is not to be trusted, returns the closest
  - sane FilePath.

Utility/Path/Max.hs

@@ -0,0 +1,40 @@
+{- path manipulation
+ -
+ - Copyright 2010-2014 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.Path.Max where
+
+import System.FilePath
+import Data.List
+import Control.Applicative
+import Prelude
+
+#ifndef mingw32_HOST_OS
+import Utility.Exception
+import System.Posix.Files
+#endif
+
+{- Maximum size to use for a file in a specified directory.
+ -
+ - Many systems have a 255 byte limit to the name of a file, 
+ - so that's taken as the max if the system has a larger limit, or has no
+ - limit.
+ -}
+fileNameLengthLimit :: FilePath -> IO Int
+#ifdef mingw32_HOST_OS
+fileNameLengthLimit _ = return 255
+#else
+fileNameLengthLimit dir = do
+	-- getPathVar can fail due to statfs(2) overflow
+	l <- catchDefaultIO 0 $
+		fromIntegral <$> getPathVar dir FileNameLimit
+	if l <= 0
+		then return 255
+		else return $ minimum [l, 255]
+#endif

Utility/Process.hs

@@ -24,8 +24,6 @@ module Utility.Process (
 	createProcessSuccess,
 	createProcessChecked,
 	createBackgroundProcess,
-	processTranscript,
-	processTranscript',
 	withHandle,
 	withIOHandles,
 	withOEHandles,
@@ -54,13 +52,6 @@ import System.Log.Logger
 import Control.Concurrent
 import qualified Control.Exception as E
 import Control.Monad
-#ifndef mingw32_HOST_OS
-import qualified System.Posix.IO
-#else
-import Control.Applicative
-#endif
-import Data.Maybe
-import Prelude
 
 type CreateProcessRunner = forall a. CreateProcess -> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO a) -> IO a
 
@@ -170,68 +161,6 @@ createProcessChecked checker p a = do
 createBackgroundProcess :: CreateProcessRunner
 createBackgroundProcess p a = a =<< createProcess p
 
--- | Runs a process, optionally feeding it some input, and
--- returns a transcript combining its stdout and stderr, and
--- whether it succeeded or failed.
-processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)
-processTranscript cmd opts = processTranscript' (proc cmd opts)
-
-processTranscript' :: CreateProcess -> Maybe String -> IO (String, Bool)
-processTranscript' cp input = do
-#ifndef mingw32_HOST_OS
-{- This implementation interleves stdout and stderr in exactly the order
- - the process writes them. -}
-	(readf, writef) <- System.Posix.IO.createPipe
-	readh <- System.Posix.IO.fdToHandle readf
-	writeh <- System.Posix.IO.fdToHandle writef
-	p@(_, _, _, pid) <- createProcess $ cp
-		{ std_in = if isJust input then CreatePipe else Inherit
-		, std_out = UseHandle writeh
-		, std_err = UseHandle writeh
-		}
-	hClose writeh
-
-	get <- mkreader readh
-	writeinput input p
-	transcript <- get
-
-	ok <- checkSuccessProcess pid
-	return (transcript, ok)
-#else
-{- This implementation for Windows puts stderr after stdout. -}
-	p@(_, _, _, pid) <- createProcess $ cp
-		{ std_in = if isJust input then CreatePipe else Inherit
-		, std_out = CreatePipe
-		, std_err = CreatePipe
-		}
-
-	getout <- mkreader (stdoutHandle p)
-	geterr <- mkreader (stderrHandle p)
-	writeinput input p
-	transcript <- (++) <$> getout <*> geterr
-
-	ok <- checkSuccessProcess pid
-	return (transcript, ok)
-#endif
-  where
-	mkreader h = do
-		s <- hGetContents h
-		v <- newEmptyMVar
-		void $ forkIO $ do
-			void $ E.evaluate (length s)
-			putMVar v ()
-		return $ do
-			takeMVar v
-			return s
-
-	writeinput (Just s) p = do
-		let inh = stdinHandle p
-		unless (null s) $ do
-			hPutStr inh s
-			hFlush inh
-		hClose inh
-	writeinput Nothing _ = return ()
-
 -- | Runs a CreateProcessRunner, on a CreateProcess structure, that
 -- is adjusted to pipe only from/to a single StdHandle, and passes
 -- the resulting Handle to an action.

Utility/Process/Transcript.hs

@@ -0,0 +1,87 @@
+{- Process transcript
+ -
+ - Copyright 2012-2015 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.Process.Transcript where
+
+import Utility.Process
+
+import System.IO
+import Control.Concurrent
+import qualified Control.Exception as E
+import Control.Monad
+#ifndef mingw32_HOST_OS
+import qualified System.Posix.IO
+#else
+import Control.Applicative
+#endif
+import Data.Maybe
+import Prelude
+
+-- | Runs a process, optionally feeding it some input, and
+-- returns a transcript combining its stdout and stderr, and
+-- whether it succeeded or failed.
+processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)
+processTranscript cmd opts = processTranscript' (proc cmd opts)
+
+processTranscript' :: CreateProcess -> Maybe String -> IO (String, Bool)
+processTranscript' cp input = do
+#ifndef mingw32_HOST_OS
+{- This implementation interleves stdout and stderr in exactly the order
+ - the process writes them. -}
+	(readf, writef) <- System.Posix.IO.createPipe
+	readh <- System.Posix.IO.fdToHandle readf
+	writeh <- System.Posix.IO.fdToHandle writef
+	p@(_, _, _, pid) <- createProcess $ cp
+		{ std_in = if isJust input then CreatePipe else Inherit
+		, std_out = UseHandle writeh
+		, std_err = UseHandle writeh
+		}
+	hClose writeh
+
+	get <- mkreader readh
+	writeinput input p
+	transcript <- get
+
+	ok <- checkSuccessProcess pid
+	return (transcript, ok)
+#else
+{- This implementation for Windows puts stderr after stdout. -}
+	p@(_, _, _, pid) <- createProcess $ cp
+		{ std_in = if isJust input then CreatePipe else Inherit
+		, std_out = CreatePipe
+		, std_err = CreatePipe
+		}
+
+	getout <- mkreader (stdoutHandle p)
+	geterr <- mkreader (stderrHandle p)
+	writeinput input p
+	transcript <- (++) <$> getout <*> geterr
+
+	ok <- checkSuccessProcess pid
+	return (transcript, ok)
+#endif
+  where
+	mkreader h = do
+		s <- hGetContents h
+		v <- newEmptyMVar
+		void $ forkIO $ do
+			void $ E.evaluate (length s)
+			putMVar v ()
+		return $ do
+			takeMVar v
+			return s
+
+	writeinput (Just s) p = do
+		let inh = stdinHandle p
+		unless (null s) $ do
+			hPutStr inh s
+			hFlush inh
+		hClose inh
+	writeinput Nothing _ = return ()

Utility/Rsync.hs

@@ -13,6 +13,10 @@ import Common
 import Utility.Metered
 import Utility.Tuple
 
+#ifdef mingw32_HOST_OS
+import qualified System.FilePath.Posix as Posix
+#endif
+
 import Data.Char
 import System.Console.GetOpt
 
@@ -139,3 +143,29 @@ filterRsyncSafeOptions = fst3 . getOpt Permute
 	[ Option [] ["bwlimit"] (reqArgLong "bwlimit") "" ]
   where
 	reqArgLong x = ReqArg (\v -> "--" ++ x ++ "=" ++ v) ""
+
+{- Converts a DOS style path to a msys2 style path. Only on Windows.
+ - Any trailing '\' is preserved as a trailing '/' 
+ - 
+ - Taken from: http://sourceforge.net/p/msys2/wiki/MSYS2%20introduction/i
+ -
+ - The virtual filesystem contains:
+ -  /c, /d, ...	mount points for Windows drives
+ -}
+toMSYS2Path :: FilePath -> FilePath
+#ifndef mingw32_HOST_OS
+toMSYS2Path = id
+#else
+toMSYS2Path p
+	| null drive = recombine parts
+	| otherwise = recombine $ "/" : driveletter drive : parts
+  where
+	(drive, p') = splitDrive p
+	parts = splitDirectories p'
+	driveletter = map toLower . takeWhile (/= ':')
+	recombine = fixtrailing . Posix.joinPath
+	fixtrailing s
+		| hasTrailingPathSeparator p = Posix.addTrailingPathSeparator s
+		| otherwise = s
+#endif
+

Utility/Su.hs

@@ -13,6 +13,7 @@ import Common
 
 #ifndef mingw32_HOST_OS
 import Utility.Env
+import System.Posix.IO
 import System.Posix.Terminal
 #endif
 

Utility/Tmp.hs

@@ -1,4 +1,4 @@
-{- Temporary files and directories.
+{- Temporary files.
  -
  - Copyright 2010-2013 Joey Hess <id@joeyh.name>
  -
@@ -11,14 +11,10 @@
 module Utility.Tmp where
 
 import System.IO
-import Control.Monad.IfElse
 import System.FilePath
 import System.Directory
 import Control.Monad.IO.Class
 import System.PosixCompat.Files
-#ifndef mingw32_HOST_OS
-import System.Posix.Temp (mkdtemp)
-#endif
 
 import Utility.Exception
 import Utility.FileSystemEncoding
@@ -62,51 +58,6 @@ withTmpFileIn tmpdir template a = bracket create remove use
 		catchBoolIO (removeFile name >> return True)
 	use (name, h) = a name h
 
-{- Runs an action with a tmp directory located within the system's tmp
- - directory (or within "." if there is none), then removes the tmp
- - directory and all its contents. -}
-withTmpDir :: (MonadMask m, MonadIO m) => Template -> (FilePath -> m a) -> m a
-withTmpDir template a = do
-	topleveltmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory
-#ifndef mingw32_HOST_OS
-	-- Use mkdtemp to create a temp directory securely in /tmp.
-	bracket
-		(liftIO $ mkdtemp $ topleveltmpdir </> template)
-		removeTmpDir
-		a
-#else
-	withTmpDirIn topleveltmpdir template a
-#endif
-
-{- Runs an action with a tmp directory located within a specified directory,
- - then removes the tmp directory and all its contents. -}
-withTmpDirIn :: (MonadMask m, MonadIO m) => FilePath -> Template -> (FilePath -> m a) -> m a
-withTmpDirIn tmpdir template = bracketIO create removeTmpDir
-  where
-	create = do
-		createDirectoryIfMissing True tmpdir
-		makenewdir (tmpdir </> template) (0 :: Int)
-	makenewdir t n = do
-		let dir = t ++ "." ++ show n
-		catchIOErrorType AlreadyExists (const $ makenewdir t $ n + 1) $ do
-			createDirectory dir
-			return dir
-
-{- Deletes the entire contents of the the temporary directory, if it
- - exists. -}
-removeTmpDir :: MonadIO m => FilePath -> m ()
-removeTmpDir tmpdir = liftIO $ whenM (doesDirectoryExist tmpdir) $ do
-#if mingw32_HOST_OS
-	-- Windows will often refuse to delete a file
-	-- after a process has just written to it and exited.
-	-- Because it's crap, presumably. So, ignore failure
-	-- to delete the temp directory.
-	_ <- tryIO $ removeDirectoryRecursive tmpdir
-	return ()
-#else
-	removeDirectoryRecursive tmpdir
-#endif
-
 {- It's not safe to use a FilePath of an existing file as the template
  - for openTempFile, because if the FilePath is really long, the tmpfile
  - will be longer, and may exceed the maximum filename length.

Utility/Tmp/Dir.hs

@@ -0,0 +1,68 @@
+{- Temporary directorie
+ -
+ - Copyright 2010-2013 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.Tmp.Dir where
+
+import Control.Monad.IfElse
+import System.FilePath
+import System.Directory
+import Control.Monad.IO.Class
+#ifndef mingw32_HOST_OS
+import System.Posix.Temp (mkdtemp)
+#endif
+
+import Utility.Exception
+
+type Template = String
+
+{- Runs an action with a tmp directory located within the system's tmp
+ - directory (or within "." if there is none), then removes the tmp
+ - directory and all its contents. -}
+withTmpDir :: (MonadMask m, MonadIO m) => Template -> (FilePath -> m a) -> m a
+withTmpDir template a = do
+	topleveltmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory
+#ifndef mingw32_HOST_OS
+	-- Use mkdtemp to create a temp directory securely in /tmp.
+	bracket
+		(liftIO $ mkdtemp $ topleveltmpdir </> template)
+		removeTmpDir
+		a
+#else
+	withTmpDirIn topleveltmpdir template a
+#endif
+
+{- Runs an action with a tmp directory located within a specified directory,
+ - then removes the tmp directory and all its contents. -}
+withTmpDirIn :: (MonadMask m, MonadIO m) => FilePath -> Template -> (FilePath -> m a) -> m a
+withTmpDirIn tmpdir template = bracketIO create removeTmpDir
+  where
+	create = do
+		createDirectoryIfMissing True tmpdir
+		makenewdir (tmpdir </> template) (0 :: Int)
+	makenewdir t n = do
+		let dir = t ++ "." ++ show n
+		catchIOErrorType AlreadyExists (const $ makenewdir t $ n + 1) $ do
+			createDirectory dir
+			return dir
+
+{- Deletes the entire contents of the the temporary directory, if it
+ - exists. -}
+removeTmpDir :: MonadIO m => FilePath -> m ()
+removeTmpDir tmpdir = liftIO $ whenM (doesDirectoryExist tmpdir) $ do
+#if mingw32_HOST_OS
+	-- Windows will often refuse to delete a file
+	-- after a process has just written to it and exited.
+	-- Because it's crap, presumably. So, ignore failure
+	-- to delete the temp directory.
+	_ <- tryIO $ removeDirectoryRecursive tmpdir
+	return ()
+#else
+	removeDirectoryRecursive tmpdir
+#endif

Utility/Url.hs

@@ -32,7 +32,7 @@ module Utility.Url (
 ) where
 
 import Common
-import Utility.Tmp
+import Utility.Tmp.Dir
 import qualified BuildInfo
 
 import Network.URI

Utility/UserInfo.hs

@@ -14,7 +14,7 @@ module Utility.UserInfo (
 	myUserGecos,
 ) where
 
-import Utility.Env
+import Utility.Env.Basic
 import Utility.Exception
 #ifndef mingw32_HOST_OS
 import Utility.Data

doc/bugs/Add_custom-setup_stanza_to_.cabal_file.mdwn

@@ -44,3 +44,6 @@ Use -v to see a list of the files searched for.
 
 Yeah, it's amazing! I've been using the version from the Debian repos and then
 wanted to try building the new version for youtube-dl support.
+
+> Revisited it and seem to have managed to add custom-setup back. [[done]]
+> --[[Joey]]

git-annex.cabal

@@ -302,6 +302,11 @@ source-repository head
   type: git
   location: git://git-annex.branchable.com/
 
+custom-setup
+  Setup-Depends: base (>= 4.6), hslogger, split, unix-compat, process,
+    filepath, exceptions, bytestring, directory, IfElse, data-default,
+    utf8-string, Cabal
+
 Executable git-annex
   Main-Is: git-annex.hs
   Build-Depends:
@@ -987,10 +992,13 @@ Executable git-annex
     Utility.DirWatcher
     Utility.DirWatcher.Types
     Utility.Directory
+    Utility.Directory.Stream
     Utility.DiskFree
     Utility.Dot
     Utility.DottedVersion
     Utility.Env
+    Utility.Env.Basic
+    Utility.Env.Set
     Utility.Exception
     Utility.ExternalSHA
     Utility.FileMode
@@ -1029,9 +1037,11 @@ Executable git-annex
     Utility.Parallel
     Utility.PartialPrelude
     Utility.Path
+    Utility.Path.Max
     Utility.Percentage
     Utility.Process
     Utility.Process.Shim
+    Utility.Process.Transcript
     Utility.QuickCheck
     Utility.Rsync
     Utility.SRV
@@ -1050,6 +1060,7 @@ Executable git-annex
     Utility.ThreadLock
     Utility.ThreadScheduler
     Utility.Tmp
+    Utility.Tmp.Dir
     Utility.Tor
     Utility.Touch
     Utility.Tuple