merge from git-annex

* Improve fetching from a remote with an url in host:path format.
* Merge from git-annex.

1 files changed, 45 insertions, 28 deletions

diff --git a/Git/Config.hs b/Git/Config.hs
index 4b60664..f50d5eb 100644
--- a/Git/Config.hs
+++ b/Git/Config.hs
@@ -1,6 +1,6 @@
 {- git repository configuration handling
  -
- - Copyright 2010-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -14,6 +14,7 @@ import qualified Data.ByteString as S
 import qualified Data.ByteString.Char8 as S8
 import Data.Char
 import qualified System.FilePath.ByteString as P
+import Control.Concurrent.Async
 
 import Common
 import Git
@@ -58,7 +59,7 @@ read' repo = go repo
 	go Repo { location = LocalUnknown d } = git_config d
 	go _ = assertLocal repo $ error "internal"
 	git_config d = withHandle StdoutHandle createProcessSuccess p $
-		hRead repo
+		hRead repo ConfigNullList
 	  where
 		params = ["config", "--null", "--list"]
 		p = (proc "git" params)
@@ -73,7 +74,7 @@ global = do
 	ifM (doesFileExist $ home </> ".gitconfig")
 		( do
 			repo <- withHandle StdoutHandle createProcessSuccess p $
-				hRead (Git.Construct.fromUnknown)
+				hRead (Git.Construct.fromUnknown) ConfigNullList
 			return $ Just repo
 		, return Nothing
 		)
@@ -82,18 +83,18 @@ global = do
 	p = (proc "git" params)
 
 {- Reads git config from a handle and populates a repo with it. -}
-hRead :: Repo -> Handle -> IO Repo
-hRead repo h = do
+hRead :: Repo -> ConfigStyle -> Handle -> IO Repo
+hRead repo st h = do
 	val <- S.hGetContents h
-	store val repo
+	store val st repo
 
 {- Stores a git config into a Repo, returning the new version of the Repo.
  - The git config may be multiple lines, or a single line.
  - Config settings can be updated incrementally.
  -}
-store :: S.ByteString -> Repo -> IO Repo
-store s repo = do
-	let c = parse s
+store :: S.ByteString -> ConfigStyle -> Repo -> IO Repo
+store s st repo = do
+	let c = parse s st
 	updateLocation $ repo
 		{ config = (M.map Prelude.head c) `M.union` config repo
 		, fullconfig = M.unionWith (++) c (fullconfig repo)
@@ -134,27 +135,30 @@ updateLocation' r l = do
 			top <- absPath $ fromRawFilePath (gitdir l)
 			let p = absPathFrom top (fromRawFilePath d)
 			return $ l { worktree = Just (toRawFilePath p) }
+		Just NoConfigValue -> return l
 	return $ r { location = l' }
 
+data ConfigStyle = ConfigList | ConfigNullList
+
 {- Parses git config --list or git config --null --list output into a
  - config map. -}
-parse :: S.ByteString -> M.Map ConfigKey [ConfigValue]
-parse s
+parse :: S.ByteString -> ConfigStyle -> M.Map ConfigKey [ConfigValue]
+parse s st
 	| S.null s = M.empty
-	-- --list output will have a '=' in the first line
-	-- (The first line of --null --list output is the name of a key,
-	-- which is assumed to never contain '='.)
-	| S.elem eq firstline = sep eq $ S.split nl s
-	-- --null --list output separates keys from values with newlines
-	| otherwise = sep nl $ S.split 0 s
+	| otherwise = case st of
+		ConfigList -> sep eq $ S.split nl s
+		ConfigNullList -> sep nl $ S.split 0 s
   where
 	nl = fromIntegral (ord '\n')
 	eq = fromIntegral (ord '=')
-	firstline = S.takeWhile (/= nl) s
 
 	sep c = M.fromListWith (++)
-		. map (\(k,v) -> (ConfigKey k, [ConfigValue (S.drop 1 v)])) 
+		. map (\(k,v) -> (ConfigKey k, [mkval v])) 
 		. map (S.break (== c))
+	
+	mkval v 
+		| S.null v = NoConfigValue
+		| otherwise = ConfigValue (S.drop 1 v)
 
 {- Checks if a string from git config is a true/false value. -}
 isTrueFalse :: String -> Maybe Bool
@@ -162,11 +166,21 @@ isTrueFalse = isTrueFalse' . ConfigValue . encodeBS'
 
 isTrueFalse' :: ConfigValue -> Maybe Bool
 isTrueFalse' (ConfigValue s)
+	| s' == "yes" = Just True
+	| s' == "on" = Just True
 	| s' == "true" = Just True
+	| s' == "1" = Just True
+
+	| s' == "no" = Just False
+	| s' == "off" = Just False
 	| s' == "false" = Just False
+	| s' == "0" = Just False
+	| s' == "" = Just False
+
 	| otherwise = Nothing
   where
 	s' = S8.map toLower s
+isTrueFalse' NoConfigValue = Just True
 
 boolConfig :: Bool -> String
 boolConfig True = "true"
@@ -184,25 +198,28 @@ coreBare = "core.bare"
 
 {- Runs a command to get the configuration of a repo,
  - and returns a repo populated with the configuration, as well as the raw
- - output of the command. -}
-fromPipe :: Repo -> String -> [CommandParam] -> IO (Either SomeException (Repo, S.ByteString))
-fromPipe r cmd params = try $
-	withHandle StdoutHandle createProcessSuccess p $ \h -> do
-		val <- S.hGetContents h
-		r' <- store val r
-		return (r', val)
+ - output and any standard output of the command. -}
+fromPipe :: Repo -> String -> [CommandParam] -> ConfigStyle -> IO (Either SomeException (Repo, S.ByteString, S.ByteString))
+fromPipe r cmd params st = try $
+	withOEHandles createProcessSuccess p $ \(hout, herr) -> do
+		geterr <- async $ S.hGetContents herr
+		getval <- async $ S.hGetContents hout
+		val <- wait getval
+		err <- wait geterr
+		r' <- store val st r
+		return (r', val, err)
   where
 	p = proc cmd $ toCommand params
 
 {- Reads git config from a specified file and returns the repo populated
  - with the configuration. -}
-fromFile :: Repo -> FilePath -> IO (Either SomeException (Repo, S.ByteString))
+fromFile :: Repo -> FilePath -> IO (Either SomeException (Repo, S.ByteString, S.ByteString))
 fromFile r f = fromPipe r "git"
 	[ Param "config"
 	, Param "--file"
 	, File f
 	, Param "--list"
-	]
+	] ConfigList
 
 {- Changes a git config setting in the specified config file.
  - (Creates the file if it does not already exist.) -}