git-annex 6.20180913 → 6.20180926

raw patch · 64 files changed

+526/−194 lines, 64 files

Files

• Annex/Hook.hs +12/−5
• Backend/Hash.hs +21/−10
• Backend/WORM.hs +3/−3
• CHANGELOG +31/−0
• CmdLine/Batch.hs +35/−18
• CmdLine/GitRemoteTorAnnex.hs +4/−3
• Command/Add.hs +2/−2
• Command/AddUrl.hs +1/−1
• Command/CheckPresentKey.hs +2/−2
• Command/Copy.hs +1/−1
• Command/Drop.hs +1/−1
• Command/DropKey.hs +1/−1
• Command/Find.hs +1/−1
• Command/FromKey.hs +25/−12
• Command/Get.hs +1/−1
• Command/Info.hs +1/−1
• Command/MetaData.hs +2/−2
• Command/Migrate.hs +3/−2
• Command/Move.hs +1/−1
• Command/P2P.hs +1/−1
• Command/P2PStdIO.hs +8/−2
• Command/ReKey.hs +1/−1
• Command/RegisterUrl.hs +25/−9
• Command/RmUrl.hs +1/−1
• Command/SetPresentKey.hs +1/−1
• Command/Whereis.hs +1/−1
• Git/CatFile.hs +72/−6
• Git/Command.hs +9/−4
• Git/Hook.hs +35/−25
• P2P/Annex.hs +12/−11
• P2P/IO.hs +34/−21
• P2P/Protocol.hs +0/−4
• Remote/External.hs +1/−1
• Remote/Glacier.hs +1/−1
• Remote/Helper/Special.hs +12/−2
• Remote/Helper/Ssh.hs +1/−1
• Remote/Hook.hs +1/−1
• Remote/P2P.hs +2/−2
• Remote/S3.hs +2/−1
• RemoteDaemon/Transport/Tor.hs +6/−5
• Types/Backend.hs +1/−1
• Types/GitConfig.hs +5/−0
• Utility/DirWatcher/Kqueue.hs +8/−7
• Utility/PartialPrelude.hs +2/−5
• Utility/Process.hs +2/−1
• Utility/Url.hs +10/−2
• doc/git-annex-add.mdwn +5/−0
• doc/git-annex-addurl.mdwn +5/−0
• doc/git-annex-calckey.mdwn +7/−2
• doc/git-annex-copy.mdwn +5/−0
• doc/git-annex-drop.mdwn +5/−0
• doc/git-annex-find.mdwn +5/−0
• doc/git-annex-fromkey.mdwn +15/−3
• doc/git-annex-get.mdwn +5/−0
• doc/git-annex-info.mdwn +5/−0
• doc/git-annex-lookupkey.mdwn +5/−0
• doc/git-annex-metadata.mdwn +7/−0
• doc/git-annex-move.mdwn +5/−0
• doc/git-annex-registerurl.mdwn +18/−3
• doc/git-annex-rekey.mdwn +5/−0
• doc/git-annex-rmurl.mdwn +5/−0
• doc/git-annex-whereis.mdwn +9/−0
• doc/git-annex.mdwn +12/−1
• git-annex.cabal +1/−1

@@ -4,7 +4,7 @@  - not change, otherwise removing old hooks using an old version of  - the script would fail.  -- - Copyright 2013-2017 Joey Hess <id@joeyh.name>+ - Copyright 2013-2018 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -20,16 +20,23 @@ import qualified Data.Map as M  preCommitHook :: Git.Hook-preCommitHook = Git.Hook "pre-commit" (mkHookScript "git annex pre-commit .")+preCommitHook = Git.Hook "pre-commit" (mkHookScript "git annex pre-commit .") []  postReceiveHook :: Git.Hook-postReceiveHook = Git.Hook "post-receive" (mkHookScript "git annex post-receive")+postReceiveHook = Git.Hook "post-receive"+	-- Only run git-annex post-receive when git-annex supports it,+	-- to avoid failing if the repository with this hook is used+	-- with an older version of git-annex.+	(mkHookScript "if git annex post-receive --help >/dev/null 2>&1; then git annex post-receive; fi")+	-- This is an old version of the hook script.+	[ mkHookScript "git annex post-receive"+	]  preCommitAnnexHook :: Git.Hook-preCommitAnnexHook = Git.Hook "pre-commit-annex" ""+preCommitAnnexHook = Git.Hook "pre-commit-annex" "" []  postUpdateAnnexHook :: Git.Hook-postUpdateAnnexHook = Git.Hook "post-update-annex" ""+postUpdateAnnexHook = Git.Hook "post-update-annex" "" []  mkHookScript :: String -> String mkHookScript s = unlines

@@ -98,13 +98,16 @@ keyValueE :: Hash -> KeySource -> Annex (Maybe Key) keyValueE hash source = keyValue hash source >>= maybe (return Nothing) addE   where-	addE k = return $ Just $ k-		{ keyName = keyName k ++ selectExtension (keyFilename source)-		, keyVariety = hashKeyVariety hash (HasExt True)-		}+	addE k = do+		maxlen <- annexMaxExtensionLength <$> Annex.getGitConfig+		let ext = selectExtension maxlen (keyFilename source)+		return $ Just $ k+			{ keyName = keyName k ++ ext+			, keyVariety = hashKeyVariety hash (HasExt True)+			} -selectExtension :: FilePath -> String-selectExtension f+selectExtension :: Maybe Int -> FilePath -> String+selectExtension maxlen f 	| null es = "" 	| otherwise = intercalate "." ("":es)   where@@ -112,8 +115,11 @@ 		take 2 $ filter (all validInExtension) $ 		takeWhile shortenough $ 		reverse $ splitc '.' $ takeExtensions f-	shortenough e = length e <= 4 -- long enough for "jpeg"+	shortenough e = length e <= fromMaybe maxExtensionLen maxlen +maxExtensionLen :: Int+maxExtensionLen = 4 -- long enough for "jpeg"+ {- A key's checksum is checked during fsck when it's content is present  - except for in fast mode. -} checkKeyChecksum :: Hash -> Key -> FilePath -> Annex Bool@@ -162,8 +168,12 @@ 	, not (hasExt (keyVariety key)) && keyHash key /= keyName key 	] -trivialMigrate :: Key -> Backend -> AssociatedFile -> Maybe Key-trivialMigrate oldkey newbackend afile+trivialMigrate :: Key -> Backend -> AssociatedFile -> Annex (Maybe Key)+trivialMigrate oldkey newbackend afile = trivialMigrate' oldkey newbackend afile+	<$> (annexMaxExtensionLength <$> Annex.getGitConfig)++trivialMigrate' :: Key -> Backend -> AssociatedFile -> Maybe Int -> Maybe Key+trivialMigrate' oldkey newbackend afile maxextlen 	{- Fast migration from hashE to hash backend. -} 	| migratable && hasExt oldvariety = Just $ oldkey 		{ keyName = keyHash oldkey@@ -173,7 +183,8 @@ 	| migratable && hasExt newvariety = case afile of 		AssociatedFile Nothing -> Nothing 		AssociatedFile (Just file) -> Just $ oldkey-			{ keyName = keyHash oldkey ++ selectExtension file+			{ keyName = keyHash oldkey +				++ selectExtension maxextlen file 			, keyVariety = newvariety 			} 	{- Upgrade to fix bad previous migration that created a

@@ -47,11 +47,11 @@ needsUpgrade :: Key -> Bool needsUpgrade key = ' ' `elem` keyName key -removeSpaces :: Key -> Backend -> AssociatedFile -> Maybe Key+removeSpaces :: Key -> Backend -> AssociatedFile -> Annex (Maybe Key) removeSpaces oldkey newbackend _-	| migratable = Just $ oldkey+	| migratable = return $ Just $ oldkey 		{ keyName = reSanitizeKeyName (keyName oldkey) }-	| otherwise = Nothing+	| otherwise = return Nothing   where 	migratable = oldvariety == newvariety 	oldvariety = keyVariety oldkey

@@ -1,3 +1,34 @@+git-annex (6.20180926) upstream; urgency=medium++  [ Joey Hess ]+  * Fixes a reversion in the last release that broke interoperation with+    older versions of git-annex-shell.+  * init: Improve generated post-receive hook, so it won't fail when+    run on a system whose git-annex is too old to support git-annex post-receive+  * init: Update the post-receive hook when re-run in an existing repository.+  * S3: Fix url construction bug when the publicurl has been set to an url+    that does not end with a slash.+  * --debug shows urls accessed by git-annex, like it used to do when +    git-annex used wget and curl.+  * Fix support for filenames containing newlines when querying git+    cat-file, though less efficiently than other filenames.+    This should make git-annex fully support filenames containing newlines+    as the rest of git's interface is used in newline-safe ways.+  * Added -z option to git-annex commands that use --batch, useful for+    supporting filenames containing newlines.+  * Added annex.maxextensionlength for use cases where extensions longer+    than 4 characters are needed.+  * Added remote.name.annex-security-allow-unverified-downloads, a+    per-remote setting for annex.security.allow-unverified-downloads.+  * More FreeBSD build fixes.++  [ Yaroslav Halchenko ]+  * debian/control+    + add netbase to Depends: since required for basic tcp interactions+      (see e.g. https://github.com/nipy/heudiconv/issues/260)++ -- Joey Hess <id@joeyh.name>  Wed, 26 Sep 2018 12:56:49 -0400+ git-annex (6.20180913) upstream; urgency=medium    * When --batch is used with matching options like --in, --metadata,

@@ -15,13 +15,24 @@ import Limit import Types.FileMatcher -data BatchMode = Batch | NoBatch+data BatchMode = Batch BatchFormat | NoBatch +data BatchFormat = BatchLine | BatchNull+ parseBatchOption :: Parser BatchMode-parseBatchOption = flag NoBatch Batch-	( long "batch"-	<> help "enable batch mode"-	)+parseBatchOption = go +	<$> switch+		( long "batch"+		<> help "enable batch mode"+		)+	<*> switch+		( short 'z'+		<> help "null delimited batch input"+		)+  where+	go True False = Batch BatchLine+ 	go True True = Batch BatchNull+	go False _ = NoBatch  -- A batchable command can run in batch mode, or not. -- In batch mode, one line at a time is read, parsed, and a reply output to@@ -35,8 +46,10 @@ 		<*> parseBatchOption 		<*> cmdParams paramdesc 	-	batchseeker (opts, NoBatch, params) = mapM_ (go NoBatch opts) params-	batchseeker (opts, Batch, _) = batchInput Right (go Batch opts)+	batchseeker (opts, NoBatch, params) =+		mapM_ (go NoBatch opts) params+	batchseeker (opts, batchmode@(Batch fmt), _) = +		batchInput fmt Right (go batchmode opts)  	go batchmode opts p = 		unlessM (handler opts p) $@@ -46,11 +59,11 @@ -- mode, exit on bad input. batchBadInput :: BatchMode -> Annex () batchBadInput NoBatch = liftIO exitFailure-batchBadInput Batch = liftIO $ putStrLn ""+batchBadInput (Batch _) = liftIO $ putStrLn ""  -- Reads lines of batch mode input and passes to the action to handle.-batchInput :: (String -> Either String a) -> (a -> Annex ()) -> Annex ()-batchInput parser a = go =<< batchLines+batchInput :: BatchFormat -> (String -> Either String a) -> (a -> Annex ()) -> Annex ()+batchInput fmt parser a = go =<< batchLines fmt   where 	go [] = return () 	go (l:rest) = do@@ -58,8 +71,12 @@ 		go rest 	parseerr s = giveup $ "Batch input parse failure: " ++ s -batchLines :: Annex [String]-batchLines = liftIO $ lines <$> getContents+batchLines :: BatchFormat -> Annex [String]+batchLines fmt = liftIO $ splitter <$> getContents+  where+	splitter = case fmt of+		BatchLine -> lines+		BatchNull -> splitc '\0'  -- Runs a CommandStart in batch mode. --@@ -69,22 +86,22 @@ -- any output, so in that case, batchBadInput is used to provide the caller -- with an empty line. batchCommandAction :: CommandStart -> Annex ()-batchCommandAction a = maybe (batchBadInput Batch) (const noop)+batchCommandAction a = maybe (batchBadInput (Batch BatchLine)) (const noop) 	=<< callCommandAction' a  -- Reads lines of batch input and passes the filepaths to a CommandStart -- to handle them. -- -- File matching options are not checked.-allBatchFiles :: (FilePath -> CommandStart) -> Annex ()-allBatchFiles a = batchInput Right $ batchCommandAction . a+allBatchFiles :: BatchFormat -> (FilePath -> CommandStart) -> Annex ()+allBatchFiles fmt a = batchInput fmt Right $ batchCommandAction . a  -- Like allBatchFiles, but checks the file matching options -- and skips non-matching files.-batchFilesMatching :: (FilePath -> CommandStart) -> Annex ()-batchFilesMatching a = do+batchFilesMatching :: BatchFormat -> (FilePath -> CommandStart) -> Annex ()+batchFilesMatching fmt a = do 	matcher <- getMatcher-	allBatchFiles $ \f ->+	allBatchFiles fmt $ \f -> 		ifM (matcher $ MatchingFile $ FileInfo f f) 			( a f 			, return Nothing

@@ -32,8 +32,9 @@ 		| otherwise = parseAddressPort address 	go service = do 		ready-		either giveup exitWith-			=<< connectService onionaddress onionport service+		connectService onionaddress onionport service >>= \case+			Right exitcode -> exitWith exitcode+			Left e -> giveup $ describeProtoFailure e 	ready = do 		putStrLn "" 		hFlush stdout@@ -48,7 +49,7 @@ 		Nothing -> giveup "onion address must include port number" 		Just p -> (OnionAddress a, p) -connectService :: OnionAddress -> OnionPort -> Service -> IO (Either String ExitCode)+connectService :: OnionAddress -> OnionPort -> Service -> IO (Either ProtoFailure ExitCode) connectService address port service = do 	state <- Annex.new =<< Git.CurrentRepo.get 	Annex.eval state $ do

@@ -59,10 +59,10 @@ 			) 		) 	case batchOption o of-		Batch+		Batch fmt 			| updateOnly o -> 				giveup "--update --batch is not supported"-			| otherwise -> batchFilesMatching gofile+			| otherwise -> batchFilesMatching fmt gofile 		NoBatch -> do 			l <- workTreeItems (addThese o) 			let go a = a gofile l

@@ -97,7 +97,7 @@ seek o = allowConcurrentOutput $ do 	forM_ (addUrls o) (\u -> go (o, u)) 	case batchOption o of-		Batch -> batchInput (parseBatchInput o) go+		Batch fmt -> batchInput fmt (parseBatchInput o) go 		NoBatch -> noop   where 	go (o', u) = do

@@ -33,12 +33,12 @@ 		(ks:rn:[]) -> toRemote rn >>= (check ks . Just) >>= exitResult 		(ks:[]) -> check ks Nothing >>= exitResult 		_ -> wrongnumparams-	Batch -> do+	Batch fmt -> do 		checker <- case params o of 			(rn:[]) -> toRemote rn >>= \r -> return (flip check (Just r)) 			[] -> return (flip check Nothing) 			_ -> wrongnumparams-		batchInput Right $ checker >=> batchResult+		batchInput fmt Right $ checker >=> batchResult   where 	wrongnumparams = giveup "Wrong number of parameters" 					

@@ -47,7 +47,7 @@ seek o = allowConcurrentOutput $ do 	let go = whenAnnexed $ start o 	case batchOption o of-		Batch -> batchFilesMatching go+		Batch fmt -> batchFilesMatching fmt go 		NoBatch -> withKeyOptions 			(keyOptions o) (autoMode o) 			(Command.Move.startKey (fromToOptions o) Command.Move.RemoveNever)

@@ -54,7 +54,7 @@ seek :: DropOptions -> CommandSeek seek o = allowConcurrentOutput $ 	case batchOption o of-		Batch -> batchFilesMatching go+		Batch fmt -> batchFilesMatching fmt go 		NoBatch -> withKeyOptions (keyOptions o) (autoMode o) 			(startKeys o) 			(withFilesInGit go)

@@ -35,7 +35,7 @@ 		giveup "dropkey can cause data loss; use --force if you're sure you want to do this" 	withKeys start (toDrop o) 	case batchOption o of-		Batch -> batchInput parsekey $ batchCommandAction . start+		Batch fmt -> batchInput fmt parsekey $ batchCommandAction . start 		NoBatch -> noop   where 	parsekey = maybe (Left "bad key") Right . file2key

@@ -51,7 +51,7 @@ seek :: FindOptions -> CommandSeek seek o = case batchOption o of 	NoBatch -> withFilesInGit go =<< workTreeItems (findThese o)-	Batch -> batchFilesMatching go+	Batch fmt -> batchFilesMatching fmt go   where 	go = whenAnnexed $ start o 

@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2010, 2015 Joey Hess <id@joeyh.name>+ - Copyright 2010-2018 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -21,14 +21,27 @@ cmd = notDirect $ notBareRepo $ 	command "fromkey" SectionPlumbing "adds a file using a specific key" 		(paramRepeating (paramPair paramKey paramPath))-		(withParams seek)+		(seek <$$> optParser) -seek :: CmdParams -> CommandSeek-seek [] = withNothing startMass []-seek ps = do-	force <- Annex.getState Annex.force-	withPairs (start force) ps+data FromKeyOptions = FromKeyOptions+	{ keyFilePairs :: CmdParams +	, batchOption :: BatchMode+	} +optParser :: CmdParamsDesc -> Parser FromKeyOptions+optParser desc = FromKeyOptions+	<$> cmdParams desc+	<*> parseBatchOption++seek :: FromKeyOptions -> CommandSeek+seek o = case (batchOption o, keyFilePairs o) of+	(Batch fmt, _) -> withNothing (startMass fmt) []+	-- older way of enabling batch input, does not support BatchNull+	(NoBatch, []) -> withNothing (startMass BatchLine) []+	(NoBatch, ps) -> do+		force <- Annex.getState Annex.force+		withPairs (start force) ps+ start :: Bool -> (String, FilePath) -> CommandStart start force (keyname, file) = do 	let key = mkKey keyname@@ -39,13 +52,13 @@ 	showStart "fromkey" file 	next $ perform key file -startMass :: CommandStart-startMass = do+startMass :: BatchFormat -> CommandStart+startMass fmt = do 	showStart' "fromkey" (Just "stdin")-	next massAdd+	next (massAdd fmt) -massAdd :: CommandPerform-massAdd = go True =<< map (separate (== ' ')) <$> batchLines+massAdd :: BatchFormat -> CommandPerform+massAdd fmt = go True =<< map (separate (== ' ')) <$> batchLines fmt   where 	go status [] = next $ return status 	go status ((keyname,f):rest) | not (null keyname) && not (null f) = do

@@ -42,7 +42,7 @@ 	from <- maybe (pure Nothing) (Just <$$> getParsed) (getFrom o) 	let go = whenAnnexed $ start o from 	case batchOption o of-		Batch -> batchFilesMatching go+		Batch fmt -> batchFilesMatching fmt go 		NoBatch -> withKeyOptions (keyOptions o) (autoMode o) 			(startKeys from) 			(withFilesInGit go)

@@ -133,7 +133,7 @@ seek :: InfoOptions -> CommandSeek seek o = case batchOption o of 	NoBatch -> withWords (start o) (infoFor o)-	Batch -> batchInput Right (itemInfo o)+	Batch fmt -> batchInput fmt Right (itemInfo o)  start :: InfoOptions -> [String] -> CommandStart start o [] = do

@@ -83,10 +83,10 @@ 			(startKeys c o) 			(seeker $ whenAnnexed $ start c o) 			=<< workTreeItems (forFiles o)-	Batch -> withMessageState $ \s -> case outputType s of+	Batch fmt -> withMessageState $ \s -> case outputType s of 		JSONOutput _ -> ifM limited 			( giveup "combining --batch with file matching options is not currently supported"-			, batchInput parseJSONInput $+			, batchInput fmt parseJSONInput $ 				commandAction . startBatch 			) 		_ -> giveup "--batch is currently only supported in --json mode"

@@ -65,7 +65,7 @@  - generated.  -} perform :: FilePath -> Key -> Backend -> Backend -> CommandPerform-perform file oldkey oldbackend newbackend = go =<< genkey+perform file oldkey oldbackend newbackend = go =<< genkey (fastMigrate oldbackend)   where 	go Nothing = stop 	go (Just (newkey, knowngoodcontent))@@ -84,7 +84,8 @@ 			next $ Command.ReKey.cleanup file oldkey newkey 		, error "failed" 		)-	genkey = case maybe Nothing (\fm -> fm oldkey newbackend afile) (fastMigrate oldbackend) of+	genkey Nothing = return Nothing+	genkey (Just fm) = fm oldkey newbackend afile >>= \case 		Just newkey -> return $ Just (newkey, True) 		Nothing -> do 			content <- calcRepo $ gitAnnexLocation oldkey

@@ -57,7 +57,7 @@ seek o = allowConcurrentOutput $ do 	let go = whenAnnexed $ start (fromToOptions o) (removeWhen o) 	case batchOption o of-		Batch -> batchFilesMatching go+		Batch fmt -> batchFilesMatching fmt go 		NoBatch -> withKeyOptions (keyOptions o) False 			(startKey (fromToOptions o) (removeWhen o)) 			(withFilesInGit go)

@@ -324,4 +324,4 @@ 			storeP2PRemoteAuthToken addr authtoken 		return LinkSuccess 	go (Right Nothing) = return $ AuthenticationError "Unable to authenticate with peer. Please check the address and try again."-	go (Left e) = return $ AuthenticationError $ "Unable to authenticate with peer: " ++ e+	go (Left e) = return $ AuthenticationError $ "Unable to authenticate with peer: " ++ describeProtoFailure e

@@ -15,6 +15,8 @@ import Annex.UUID import qualified CmdLine.GitAnnexShell.Checks as Checks +import System.IO.Error+ cmd :: Command cmd = noMessages $ command "p2pstdio" SectionPlumbing 	"communicate in P2P protocol over stdio"@@ -40,5 +42,9 @@ 		P2P.serveAuthed servermode myuuid 	runst <- liftIO $ mkRunState $ Serving theiruuid Nothing 	runFullProto runst conn server >>= \case-		Right () -> next $ next $ return True-		Left e -> giveup e+		Right () -> done+		-- Avoid displaying an error when the client hung up on us.+		Left (ProtoFailureIOError e) | isEOFError e -> done+		Left e -> giveup (describeProtoFailure e)+  where+	done = next $ next $ return True

@@ -49,7 +49,7 @@  seek :: ReKeyOptions -> CommandSeek seek o = case batchOption o of-	Batch -> batchInput batchParser (batchCommandAction . start)+	Batch fmt -> batchInput fmt batchParser (batchCommandAction . start) 	NoBatch -> withPairs (start . parsekey) (reKeyThese o)   where 	parsekey (file, skey) =

@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2015 Joey Hess <id@joeyh.name>+ - Copyright 2015-2018 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -19,23 +19,39 @@ 	command "registerurl" 		SectionPlumbing "registers an url for a key" 		(paramPair paramKey paramUrl)-		(withParams seek)+		(seek <$$> optParser) -seek :: CmdParams -> CommandSeek-seek = withWords start+data RegisterUrlOptions = RegisterUrlOptions+	{ keyUrlPairs :: CmdParams+	, batchOption :: BatchMode+	} +optParser :: CmdParamsDesc -> Parser RegisterUrlOptions+optParser desc = RegisterUrlOptions+	<$> cmdParams desc+	<*> parseBatchOption++seek :: RegisterUrlOptions -> CommandSeek+seek o = case (batchOption o, keyUrlPairs o) of+	(Batch fmt, _) -> withNothing (startMass fmt) []+	-- older way of enabling batch input, does not support BatchNull+	(NoBatch, []) -> withNothing (startMass BatchLine) []+	(NoBatch, ps) -> withWords start ps+ start :: [String] -> CommandStart start (keyname:url:[]) = do 	let key = mkKey keyname 	showStart' "registerurl" (Just url) 	next $ perform key url-start [] = do-	showStart' "registerurl" (Just "stdin")-	next massAdd start _ = giveup "specify a key and an url" -massAdd :: CommandPerform-massAdd = go True =<< map (separate (== ' ')) <$> batchLines+startMass :: BatchFormat -> CommandStart+startMass fmt = do+	showStart' "registerurl" (Just "stdin")+	next (massAdd fmt)++massAdd :: BatchFormat -> CommandPerform+massAdd fmt = go True =<< map (separate (== ' ')) <$> batchLines fmt   where 	go status [] = next $ return status 	go status ((keyname,u):rest) | not (null keyname) && not (null u) = do

@@ -30,7 +30,7 @@  seek :: RmUrlOptions -> CommandSeek seek o = case batchOption o of-	Batch -> batchInput batchParser (batchCommandAction . start)+	Batch fmt -> batchInput fmt batchParser (batchCommandAction . start) 	NoBatch -> withPairs start (rmThese o)  -- Split on the last space, since a FilePath can contain whitespace,

@@ -30,7 +30,7 @@  seek :: SetPresentKeyOptions -> CommandSeek seek o = case batchOption o of-	Batch -> batchInput+	Batch fmt -> batchInput fmt 		(parseKeyStatus . words) 		(batchCommandAction . start) 	NoBatch -> either giveup (commandAction . start)

@@ -40,7 +40,7 @@ 	m <- remoteMap id 	let go = whenAnnexed $ start m 	case batchOption o of-		Batch -> batchFilesMatching go+		Batch fmt -> batchFilesMatching fmt go 		NoBatch ->  			withKeyOptions (keyOptions o) False 				(startKeys m)

@@ -1,6 +1,6 @@ {- git cat-file interface  -- - Copyright 2011-2016 Joey Hess <id@joeyh.name>+ - Copyright 2011-2018 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -28,6 +28,7 @@ import Data.Char import Numeric import System.Posix.Types+import Text.Read  import Common import Git@@ -35,6 +36,7 @@ import Git.Command import Git.Types import Git.FilePath+import Git.HashObject import qualified Utility.CoProcess as CoProcess import Utility.FileSystemEncoding import Utility.Tuple@@ -42,6 +44,7 @@ data CatFileHandle = CatFileHandle  	{ catFileProcess :: CoProcess.CoProcessHandle 	, checkFileProcess :: CoProcess.CoProcessHandle+	, gitRepo :: Repo 	}  catFileStart :: Repo -> IO CatFileHandle@@ -51,6 +54,7 @@ catFileStart' restartable repo = CatFileHandle 	<$> startp "--batch" 	<*> startp "--batch-check=%(objectname) %(objecttype) %(objectsize)"+	<*> pure repo   where 	startp p = gitCoProcessStart restartable 		[ Param "cat-file"@@ -77,7 +81,7 @@ catObject h object = maybe L.empty fst3 <$> catObjectDetails h object  catObjectDetails :: CatFileHandle -> Ref -> IO (Maybe (L.ByteString, Sha, ObjectType))-catObjectDetails h object = query (catFileProcess h) object $ \from -> do+catObjectDetails h object = query (catFileProcess h) object newlinefallback $ \from -> do 	header <- hGetLine from 	case parseResp object header of 		Just (ParsedResp sha size objtype) -> do@@ -91,23 +95,48 @@ 		c <- hGetChar from 		when (c /= expected) $ 			error $ "missing " ++ (show expected) ++ " from git cat-file"+	+	-- Slow fallback path for filenames containing newlines.+	newlinefallback = queryObjectType object (gitRepo h) >>= \case+		Nothing -> return Nothing+		Just objtype -> queryContent object (gitRepo h) >>= \case+			Nothing -> return Nothing+			Just content -> do+				-- only the --batch interface allows getting+				-- the sha, so have to re-hash the object+				sha <- hashObject' objtype+					(flip L.hPut content)+					(gitRepo h)+				return (Just (content, sha, objtype))  {- Gets the size and type of an object, without reading its content. -} catObjectMetaData :: CatFileHandle -> Ref -> IO (Maybe (Integer, ObjectType))-catObjectMetaData h object = query (checkFileProcess h) object $ \from -> do+catObjectMetaData h object = query (checkFileProcess h) object newlinefallback $ \from -> do 	resp <- hGetLine from 	case parseResp object resp of 		Just (ParsedResp _ size objtype) -> 			return $ Just (size, objtype) 		Just DNE -> return Nothing 		Nothing -> error $ "unknown response from git cat-file " ++ show (resp, object)+  where+	-- Slow fallback path for filenames containing newlines.+	newlinefallback = do+		sz <- querySize object (gitRepo h)+		objtype <- queryObjectType object (gitRepo h)+		return $ (,) <$> sz <*> objtype  data ParsedResp = ParsedResp Sha Integer ObjectType | DNE -query :: CoProcess.CoProcessHandle -> Ref -> (Handle -> IO a) -> IO a-query hdl object receive = CoProcess.query hdl send receive+query :: CoProcess.CoProcessHandle -> Ref -> IO a -> (Handle -> IO a) -> IO a+query hdl object newlinefallback receive+	-- git cat-file --batch uses a line based protocol, so when the+	-- filename itself contains a newline, have to fall back to another+	-- method of getting the information.+	| '\n' `elem` s = newlinefallback+	| otherwise = CoProcess.query hdl send receive   where-	send to = hPutStrLn to (fromRef object)+	send to = hPutStrLn to s+	s = fromRef object  parseResp :: Ref -> String -> Maybe ParsedResp parseResp object l @@ -122,6 +151,43 @@ 					_ -> Nothing 			| otherwise -> Nothing 		_ -> Nothing++querySingle :: CommandParam -> Ref -> Repo -> (Handle -> IO a) -> IO (Maybe a)+querySingle o r repo reader = assertLocal repo $+	-- In non-batch mode, git cat-file warns on stderr when+	-- asked for an object that does not exist.+	-- Squelch that warning to behave the same as batch mode.+	withNullHandle $ \nullh -> do+		let p = gitCreateProcess +			[ Param "cat-file"+			, o+			, Param (fromRef r)+			] repo+		let p' = p+			{ std_err = UseHandle nullh+			, std_in = Inherit+			, std_out = CreatePipe+			}+		pid <- createProcess p'+		let h = stdoutHandle pid+		output <- reader h+		hClose h+		ifM (checkSuccessProcess (processHandle pid))+			( return (Just output)+			, return Nothing+			)++querySize :: Ref -> Repo -> IO (Maybe Integer)+querySize r repo = maybe Nothing (readMaybe . takeWhile (/= '\n'))+	<$> querySingle (Param "-s") r repo hGetContentsStrict++queryObjectType :: Ref -> Repo -> IO (Maybe ObjectType)+queryObjectType r repo = maybe Nothing (readObjectType . takeWhile (/= '\n'))+	<$> querySingle (Param "cat-file") r repo hGetContentsStrict++queryContent :: Ref -> Repo -> IO (Maybe L.ByteString)+queryContent r repo = fmap (\b -> L.fromChunks [b])+	<$> querySingle (Param "-p") r repo S.hGetContents  {- Gets a list of files and directories in a tree. (Not recursive.) -} catTree :: CatFileHandle -> Ref -> IO [(FilePath, FileMode)]

@@ -63,9 +63,13 @@  - Nonzero exit status is ignored.  -} pipeReadStrict :: [CommandParam] -> Repo -> IO String-pipeReadStrict params repo = assertLocal repo $+pipeReadStrict = pipeReadStrict' hGetContentsStrict++{- The reader action must be strict. -}+pipeReadStrict' :: (Handle -> IO a) -> [CommandParam] -> Repo -> IO a+pipeReadStrict' reader params repo = assertLocal repo $ 	withHandle StdoutHandle (createProcessChecked ignoreFailureProcess) p $ \h -> do-		output <- hGetContentsStrict h+		output <- reader h 		hClose h 		return output   where@@ -83,8 +87,9 @@  {- Runs a git command, feeding it input on a handle with an action. -} pipeWrite :: [CommandParam] -> Repo -> (Handle -> IO ()) -> IO ()-pipeWrite params repo = withHandle StdinHandle createProcessSuccess $-	gitCreateProcess params repo+pipeWrite params repo = assertLocal repo $ +	withHandle StdinHandle createProcessSuccess $+		gitCreateProcess params repo  {- Reads null terminated output of a git command (as enabled by the -z   - parameter), and splits it. -}

@@ -1,6 +1,6 @@ {- git hooks  -- - Copyright 2013-2015 Joey Hess <id@joeyh.name>+ - Copyright 2013-2018 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -20,6 +20,7 @@ data Hook = Hook 	{ hookName :: FilePath 	, hookScript :: String+	, hookOldScripts :: [String] 	} 	deriving (Ord) @@ -30,38 +31,47 @@ hookFile h r = localGitDir r </> "hooks" </> hookName h  {- Writes a hook. Returns False if the hook already exists with a different- - content. -}+ - content. Upgrades old scripts. -} hookWrite :: Hook -> Repo -> IO Bool-hookWrite h r = do-	let f = hookFile h r-	ifM (doesFileExist f)-		( expectedContent h r-		, do-			viaTmp writeFile f (hookScript h)-			p <- getPermissions f-			setPermissions f $ p {executable = True}-			return True-		)+hookWrite h r = ifM (doesFileExist f)+	( expectedContent h r >>= \case+		UnexpectedContent -> return False+		ExpectedContent -> return True+		OldExpectedContent -> go+	, go+	)+  where+	f = hookFile h r+	go = do+		viaTmp writeFile f (hookScript h)+		p <- getPermissions f+		setPermissions f $ p {executable = True}+		return True  {- Removes a hook. Returns False if the hook contained something else, and  - could not be removed. -} hookUnWrite :: Hook -> Repo -> IO Bool-hookUnWrite h r = do-	let f = hookFile h r-	ifM (doesFileExist f)-		( ifM (expectedContent h r)-			( do-				removeFile f-				return True-			, return False-			)-		, return True-		)+hookUnWrite h r = ifM (doesFileExist f)+	( expectedContent h r >>= \case+		UnexpectedContent -> return False+		_ -> do+			removeFile f+			return True+	, return True+	)+  where+	f = hookFile h r -expectedContent :: Hook -> Repo -> IO Bool+data ExpectedContent = UnexpectedContent | ExpectedContent | OldExpectedContent++expectedContent :: Hook -> Repo -> IO ExpectedContent expectedContent h r = do 	content <- readFile $ hookFile h r-	return $ content == hookScript h+	return $ if content == hookScript h+		then ExpectedContent+		else if any (content ==) (hookOldScripts h)+			then OldExpectedContent+			else UnexpectedContent  hookExists :: Hook -> Repo -> IO Bool hookExists h r = do

@@ -28,7 +28,7 @@ import Control.Monad.Free  -- Full interpreter for Proto, that can receive and send objects.-runFullProto :: RunState -> P2PConnection -> Proto a -> Annex (Either String a)+runFullProto :: RunState -> P2PConnection -> Proto a -> Annex (Either ProtoFailure a) runFullProto runst conn = go   where 	go :: RunProto Annex@@ -36,7 +36,7 @@ 	go (Free (Net n)) = runNet runst conn go n 	go (Free (Local l)) = runLocal runst go l -runLocal :: RunState -> RunProto Annex -> LocalF (Proto a) -> Annex (Either String a)+runLocal :: RunState -> RunProto Annex -> LocalF (Proto a) -> Annex (Either ProtoFailure a) runLocal runst runner a = case a of 	TmpContentSize k next -> do 		tmp <- fromRepo $ gitAnnexTmpObjectLocation k@@ -57,12 +57,12 @@ 					transfer upload k af $ 						sinkfile f o checkchanged sender 				case v' of-					Left e -> return (Left (show e))-					Right (Left e) -> return (Left (show e))+					Left e -> return $ Left $ ProtoFailureException e+					Right (Left e) -> return $ Left e 					Right (Right ok) -> runner (next ok) 			-- content not available  			Right Nothing -> runner (next False)-			Left e -> return (Left (show e))+			Left e -> return $ Left $ ProtoFailureException e 	StoreContent k af o l getb validitycheck next -> do 		-- This is the same as the retrievalSecurityPolicy of 		-- Remote.P2P and Remote.Git. @@ -79,12 +79,12 @@ 	SetPresent k u next -> do 		v <- tryNonAsync $ logChange k u InfoPresent 		case v of-			Left e -> return (Left (show e))+			Left e -> return $ Left $ ProtoFailureException e 			Right () -> runner next 	CheckContentPresent k next -> do 		v <- tryNonAsync $ inAnnex k 		case v of-			Left e -> return (Left (show e))+			Left e -> return $ Left $ ProtoFailureException e 			Right result -> runner (next result) 	RemoveContent k next -> do 		v <- tryNonAsync $@@ -96,7 +96,7 @@ 				, return True 				) 		case v of-			Left e -> return (Left (show e))+			Left e -> return $ Left $ ProtoFailureException e 			Right result -> runner (next result) 	TryLockContent k protoaction next -> do 		v <- tryNonAsync $ lockContentShared k $ \verifiedcopy -> @@ -114,9 +114,10 @@ 		Serving _ (Just h) _ -> do 			v <- tryNonAsync $ liftIO $ waitChangedRefs h 			case v of-				Left e -> return (Left (show e))+				Left e -> return $ Left $ ProtoFailureException e 				Right changedrefs -> runner (next changedrefs)-		_ -> return $ Left "change notification not available"+		_ -> return $ Left $+			ProtoFailureMessage "change notification not available" 	UpdateMeterTotalSize m sz next -> do 		liftIO $ setMeterTotalSize m sz 		runner next@@ -153,7 +154,7 @@ 						-- known. Force content 						-- verification. 						return (rightsize, MustVerify)-			Left e -> error e+			Left e -> error $ describeProtoFailure e 	 	sinkfile f (Offset o) checkchanged sender p = bracket setup cleanup go 	  where

@@ -1,6 +1,6 @@ {- P2P protocol, IO implementation  -- - Copyright 2016 Joey Hess <id@joeyh.name>+ - Copyright 2016-2018 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -18,6 +18,8 @@ 	, closeConnection 	, serveUnixSocket 	, setupHandle+	, ProtoFailure(..)+	, describeProtoFailure 	, runNetProto 	, runNet 	) where@@ -49,8 +51,18 @@ import qualified Network.Socket as S  -- Type of interpreters of the Proto free monad.-type RunProto m = forall a. Proto a -> m (Either String a)+type RunProto m = forall a. Proto a -> m (Either ProtoFailure a) +data ProtoFailure+	= ProtoFailureMessage String+	| ProtoFailureException SomeException+	| ProtoFailureIOError IOError++describeProtoFailure :: ProtoFailure -> String+describeProtoFailure (ProtoFailureMessage s) = s+describeProtoFailure (ProtoFailureException e) = show e+describeProtoFailure (ProtoFailureIOError e) = show e+ data RunState 	= Serving UUID (Maybe ChangedRefsHandle) (TVar ProtocolVersion) 	| Client (TVar ProtocolVersion)@@ -136,19 +148,20 @@ -- This only runs Net actions. No Local actions will be run -- (those need the Annex monad) -- if the interpreter reaches any, -- it returns Nothing.-runNetProto :: RunState -> P2PConnection -> Proto a -> IO (Either String a)+runNetProto :: RunState -> P2PConnection -> Proto a -> IO (Either ProtoFailure a) runNetProto runst conn = go   where 	go :: RunProto IO 	go (Pure v) = return (Right v) 	go (Free (Net n)) = runNet runst conn go n-	go (Free (Local _)) = return (Left "unexpected annex operation attempted")+	go (Free (Local _)) = return $ Left $+		ProtoFailureMessage "unexpected annex operation attempted"  -- Interpreter of the Net part of Proto. -- -- An interpreter of Proto has to be provided, to handle the rest of Proto -- actions.-runNet :: (MonadIO m, MonadMask m) => RunState -> P2PConnection -> RunProto m -> NetF (Proto a) -> m (Either String a)+runNet :: (MonadIO m, MonadMask m) => RunState -> P2PConnection -> RunProto m -> NetF (Proto a) -> m (Either ProtoFailure a) runNet runst conn runner f = case f of 	SendMessage m next -> do 		v <- liftIO $ tryNonAsync $ do@@ -157,15 +170,14 @@ 			hPutStrLn (connOhdl conn) l 			hFlush (connOhdl conn) 		case v of-			Left e -> return (Left (show e))+			Left e -> return $ Left $ ProtoFailureException e 			Right () -> runner next 	ReceiveMessage next -> do 		v <- liftIO $ tryIOError $ getProtocolLine (connIhdl conn) 		case v of-			Left e-				| isEOFError e -> runner (next (Just ProtocolEOF))-				| otherwise -> return (Left (show e))-			Right Nothing -> return (Left "protocol error")+			Left e -> return $ Left $ ProtoFailureIOError e+			Right Nothing -> return $ Left $+				ProtoFailureMessage "protocol error" 			Right (Just l) -> case parseMessage l of 				Just m -> do 					liftIO $ debugMessage "P2P <" m@@ -178,12 +190,13 @@ 			return ok 		case v of 			Right True -> runner next-			Right False -> return (Left "short data write")-			Left e -> return (Left (show e))+			Right False -> return $ Left $+				ProtoFailureMessage "short data write"+			Left e -> return $ Left $ ProtoFailureException e 	ReceiveBytes len p next -> do 		v <- liftIO $ tryNonAsync $ receiveExactly len (connIhdl conn) p 		case v of-			Left e -> return (Left (show e))+			Left e -> return $ Left $ ProtoFailureException e 			Right b -> runner (next b) 	CheckAuthToken _u t next -> do 		let authed = connCheckAuth conn t@@ -191,12 +204,12 @@ 	Relay hin hout next -> do 		v <- liftIO $ runRelay runnerio hin hout 		case v of-			Left e -> return (Left e)+			Left e -> return $ Left e 			Right exitcode -> runner (next exitcode) 	RelayService service next -> do 		v <- liftIO $ runRelayService conn runnerio service 		case v of-			Left e -> return (Left e)+			Left e -> return $ Left e 			Right () -> runner next 	SetProtocolVersion v next -> do 		liftIO $ atomically $ writeTVar versiontvar v@@ -239,10 +252,10 @@ receiveExactly :: Len -> Handle -> MeterUpdate -> IO L.ByteString receiveExactly (Len n) h p = hGetMetered h (Just n) p -runRelay :: RunProto IO -> RelayHandle -> RelayHandle -> IO (Either String ExitCode)+runRelay :: RunProto IO -> RelayHandle -> RelayHandle -> IO (Either ProtoFailure ExitCode) runRelay runner (RelayHandle hout) (RelayHandle hin) =  	bracket setup cleanup go-		`catchNonAsync` (return . Left . show)+		`catchNonAsync` (return . Left . ProtoFailureException)   where 	setup = do 		v <- newEmptyMVar@@ -256,10 +269,10 @@ 	 	go v = relayHelper runner v -runRelayService :: P2PConnection -> RunProto IO -> Service -> IO (Either String ())+runRelayService :: P2PConnection -> RunProto IO -> Service -> IO (Either ProtoFailure ()) runRelayService conn runner service =  	bracket setup cleanup go-		`catchNonAsync` (return . Left . show)+		`catchNonAsync` (return . Left . ProtoFailureException)   where 	cmd = case service of 		UploadPack -> "upload-pack"@@ -290,13 +303,13 @@ 	go (v, _, _, _, _) = do 		r <- relayHelper runner v 		case r of-			Left e -> return (Left (show e))+			Left e -> return $ Left e 			Right exitcode -> runner $ net $ relayToPeer (RelayDone exitcode) 	 	waitexit v pid = putMVar v . RelayDone =<< waitForProcess pid  -- Processes RelayData as it is put into the MVar.-relayHelper :: RunProto IO -> MVar RelayData -> IO (Either String ExitCode)+relayHelper :: RunProto IO -> MVar RelayData -> IO (Either ProtoFailure ExitCode) relayHelper runner v = loop   where 	loop = do

@@ -83,7 +83,6 @@ 	| DATA Len -- followed by bytes of data 	| VALIDITY Validity 	| ERROR String-	| ProtocolEOF 	deriving (Show)  instance Proto.Sendable Message where@@ -109,7 +108,6 @@ 	formatMessage (VALIDITY Invalid) = ["INVALID"] 	formatMessage (DATA len) = ["DATA", Proto.serialize len] 	formatMessage (ERROR err) = ["ERROR", Proto.serialize err]-	formatMessage (ProtocolEOF) = []  instance Proto.Receivable Message where 	parseCommand "AUTH" = Proto.parse2 AUTH@@ -369,8 +367,6 @@ serverLoop a = do 	mcmd <- net receiveMessage 	case mcmd of-		-- Stop loop at EOF-		Just ProtocolEOF -> return Nothing 		-- When the client sends ERROR to the server, the server 		-- gives up, since it's not clear what state the client 		-- is in, and so not possible to recover.

@@ -113,7 +113,7 @@ 			-- and have no protection against redirects to 			-- local private web servers, or in some cases 			-- to file:// urls.-			, retrievalSecurityPolicy = RetrievalVerifiableKeysSecure+			, retrievalSecurityPolicy = mkRetrievalVerifiableKeysSecure gc 			, removeKey = removeKeyDummy 			, lockContent = Nothing 			, checkPresent = checkPresentDummy

@@ -59,7 +59,7 @@ 			-- not support file://, as far as we know, but 			-- there's no guarantee that will continue to be 			-- the case, so require verifiable keys.-			, retrievalSecurityPolicy = RetrievalVerifiableKeysSecure+			, retrievalSecurityPolicy = mkRetrievalVerifiableKeysSecure gc 			, removeKey = removeKeyDummy 			, lockContent = Nothing 			, checkPresent = checkPresentDummy

@@ -1,6 +1,6 @@ {- helpers for special remotes  -- - Copyright 2011-2014 Joey Hess <id@joeyh.name>+ - Copyright 2011-2018 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -8,6 +8,7 @@ module Remote.Helper.Special ( 	findSpecialRemotes, 	gitConfigSpecialRemote,+	mkRetrievalVerifiableKeysSecure, 	Preparer, 	Storer, 	Retriever,@@ -73,6 +74,15 @@   where 	remotename = fromJust (M.lookup "name" c) +-- RetrievalVerifiableKeysSecure unless overridden by git config.+--+-- Only looks at the RemoteGitConfig; the GitConfig's setting is+-- checked at the same place the RetrievalSecurityPolicy is checked.+mkRetrievalVerifiableKeysSecure :: RemoteGitConfig -> RetrievalSecurityPolicy+mkRetrievalVerifiableKeysSecure gc+	| remoteAnnexAllowUnverifiedDownloads gc = RetrievalAllKeysSecure+	| otherwise = RetrievalVerifiableKeysSecure+ -- Use when nothing needs to be done to prepare a helper. simplyPrepare :: helper -> Preparer helper simplyPrepare helper _ a = a $ Just helper@@ -168,7 +178,7 @@ 		-- into the git-annex repository. Verifiable keys 		-- are the main protection against this attack. 		, retrievalSecurityPolicy = if isencrypted-			then RetrievalVerifiableKeysSecure+			then mkRetrievalVerifiableKeysSecure (gitconfig baser) 			else retrievalSecurityPolicy baser 		, removeKey = \k -> cip >>= removeKeyGen k 		, checkPresent = \k -> cip >>= checkPresentGen k

@@ -343,7 +343,7 @@ 		-- When runFullProto fails, the connection is no longer 		-- usable, so close it. 		Left e -> do-			warning $ "Lost connection (" ++ e ++ ")"+			warning $ "Lost connection (" ++ P2P.describeProtoFailure e ++ ")" 			conn' <- fst <$> liftIO (closeP2PSshConnection conn) 			return (conn', Nothing) 

@@ -51,7 +51,7 @@ 			, retrieveKeyFileCheap = retrieveCheap hooktype 			-- A hook could use http and be vulnerable to 			-- redirect to file:// attacks, etc.-			, retrievalSecurityPolicy = RetrievalVerifiableKeysSecure+			, retrievalSecurityPolicy = mkRetrievalVerifiableKeysSecure gc 			, removeKey = removeKeyDummy 			, lockContent = Nothing 			, checkPresent = checkPresentDummy

@@ -97,7 +97,7 @@ 	-- so close it. 	case v of 		Left e -> do-			warning $ "Lost connection to peer (" ++ e ++ ")"+			warning $ "Lost connection to peer (" ++ describeProtoFailure e ++ ")" 			liftIO $ closeConnection conn 			return (ClosedConnection, Nothing) 		Right r -> return (c, Just r)@@ -162,7 +162,7 @@ 					liftIO $ closeConnection conn 					return ClosedConnection 				Left e -> do-					warning $ "Problem communicating with peer. (" ++ e ++ ")"+					warning $ "Problem communicating with peer. (" ++ describeProtoFailure e ++ ")" 					liftIO $ closeConnection conn 					return ClosedConnection 		Left e -> do

@@ -21,6 +21,7 @@ import qualified Data.ByteString as BS import qualified Data.Map as M import qualified Data.Set as S+import qualified System.FilePath.Posix as Posix import Data.Char import Network.Socket (HostName) import Network.HTTP.Conduit (Manager)@@ -690,7 +691,7 @@ 	"https://" ++ T.unpack (bucket info) ++ ".s3.amazonaws.com/"   genericPublicUrl :: URLString -> BucketObject -> URLString-genericPublicUrl baseurl p = baseurl ++ p+genericPublicUrl baseurl p = baseurl Posix.</> p  genCredentials :: CredPair -> IO AWS.Credentials genCredentials (keyid, secret) = AWS.Credentials

@@ -120,10 +120,10 @@ 			v <- liftIO $ runNetProto runstauth conn $ P2P.serveAuth u 			case v of 				Right (Just theiruuid) -> authed conn theiruuid-				Right Nothing -> liftIO $-					debugM "remotedaemon" "Tor connection failed to authenticate"-				Left e -> liftIO $-					debugM "remotedaemon" ("Tor connection error before authentication: " ++ e)+				Right Nothing -> liftIO $ debugM "remotedaemon"+					"Tor connection failed to authenticate"+				Left e -> liftIO $ debugM "remotedaemon" $+					"Tor connection error before authentication: " ++ describeProtoFailure e 		-- Merge the duplicated state back in. 		liftAnnex th $ mergeState st' 	@@ -134,7 +134,8 @@ 				P2P.serveAuthed P2P.ServeReadWrite u 			case v' of 				Right () -> return ()-				Left e -> liftIO $ debugM "remotedaemon" ("Tor connection error: " ++ e)+				Left e -> liftIO $ debugM "remotedaemon" $ +					"Tor connection error: " ++ describeProtoFailure e  -- Connect to peer's tor hidden service. transport :: Transport

@@ -21,7 +21,7 @@ 	, canUpgradeKey :: Maybe (Key -> Bool) 	-- Checks if there is a fast way to migrate a key to a different 	-- backend (ie, without re-hashing).-	, fastMigrate :: Maybe (Key -> BackendA a -> AssociatedFile -> Maybe Key)+	, fastMigrate :: Maybe (Key -> BackendA a -> AssociatedFile -> a (Maybe Key)) 	-- Checks if a key is known (or assumed) to always refer to the 	-- same data. 	, isStableKey :: Key -> Bool

@@ -98,6 +98,7 @@ 	, annexAllowedUrlSchemes :: S.Set Scheme 	, annexAllowedHttpAddresses :: String 	, annexAllowUnverifiedDownloads :: Bool+	, annexMaxExtensionLength :: Maybe Int 	, coreSymlinks :: Bool 	, coreSharedRepository :: SharedRepository 	, receiveDenyCurrentBranch :: DenyCurrentBranch@@ -171,6 +172,7 @@ 		getmaybe (annex "security.allowed-http-addresses") 	, annexAllowUnverifiedDownloads = (== Just "ACKTHPPT") $ 		getmaybe (annex "security.allow-unverified-downloads")+	, annexMaxExtensionLength = getmayberead (annex "maxextensionlength") 	, coreSymlinks = getbool "core.symlinks" True 	, coreSharedRepository = getSharedRepository r 	, receiveDenyCurrentBranch = getDenyCurrentBranch r@@ -232,6 +234,7 @@ 	, remoteAnnexBare :: Maybe Bool 	, remoteAnnexRetry :: Maybe Integer 	, remoteAnnexRetryDelay :: Maybe Seconds+	, remoteAnnexAllowUnverifiedDownloads :: Bool  	{- These settings are specific to particular types of remotes 	 - including special remotes. -}@@ -289,6 +292,8 @@ 		, remoteAnnexRetry = getmayberead "retry" 		, remoteAnnexRetryDelay = Seconds 			<$> getmayberead "retrydelay"+		, remoteAnnexAllowUnverifiedDownloads = (== Just "ACKTHPPT") $+			getmaybe ("security-allow-unverified-downloads") 		, remoteAnnexShell = getmaybe "shell" 		, remoteAnnexSshOptions = getoptions "ssh-options" 		, remoteAnnexRsyncOptions = getoptions "rsync-options"

@@ -27,7 +27,8 @@ import Foreign.Marshal import qualified Data.Map.Strict as M import qualified Data.Set as S-import qualified System.Posix.Files as Files+import qualified System.Posix.Files as Posix+import qualified System.Posix.IO as Posix import Control.Concurrent  data Change@@ -109,7 +110,7 @@ 				Nothing -> walk c rest 				Just info -> do 					mfd <- catchMaybeIO $-						Files.openFd dir Files.ReadOnly Nothing Files.defaultFileFlags+						Posix.openFd dir Posix.ReadOnly Nothing Posix.defaultFileFlags 					case mfd of 						Nothing -> walk c rest 						Just fd -> do@@ -129,7 +130,7 @@ {- Removes a subdirectory (and all its children) from a directory map. -} removeSubDir :: DirMap -> FilePath -> IO DirMap removeSubDir dirmap dir = do-	mapM_ Files.closeFd $ M.keys toremove+	mapM_ Posix.closeFd $ M.keys toremove 	return rest   where 	(toremove, rest) = M.partition (dirContains dir . dirName) dirmap@@ -167,7 +168,7 @@ {- Stops a Kqueue. Note: Does not directly close the Fds in the dirmap,  - so it can be reused.  -} stopKqueue :: Kqueue -> IO ()-stopKqueue = Files.closeFd . kqueueFd+stopKqueue = Posix.closeFd . kqueueFd  {- Waits for a change on a Kqueue.  - May update the Kqueue.@@ -249,9 +250,9 @@ 		withstatus change $ dispatchadd dirmap 		 	dispatchadd dirmap change s-		| Files.isSymbolicLink s = callhook addSymlinkHook (Just s) change-		| Files.isDirectory s = recursiveadd dirmap change-		| Files.isRegularFile s = callhook addHook (Just s) change+		| Posix.isSymbolicLink s = callhook addSymlinkHook (Just s) change+		| Posix.isDirectory s = recursiveadd dirmap change+		| Posix.isRegularFile s = callhook addHook (Just s) change 		| otherwise = noop  	recursiveadd dirmap change = do

@@ -38,11 +38,8 @@  {- Attempts to read a value from a String.  -- - Ignores leading/trailing whitespace, and throws away any trailing- - text after the part that can be read.- -- - readMaybe is available in Text.Read in new versions of GHC,- - but that one requires the entire string to be consumed.+ - Unlike Text.Read.readMaybe, this ignores leading/trailing whitespace,+ - and throws away any trailing text after the part that can be read.  -} readish :: Read a => String -> Maybe a readish s = case reads s of

@@ -249,7 +249,8 @@ #ifndef mingw32_HOST_OS devNull = "/dev/null" #else-devNull = "NUL"+-- Use device namespace to prevent GHC from rewriting path+devNull = "\\\\.\\NUL" #endif  -- | Extract a desired handle from createProcess's tuple.

@@ -51,6 +51,7 @@ import Network.HTTP.Conduit import Network.HTTP.Client import Data.Conduit+import System.Log.Logger  #if ! MIN_VERSION_http_client(0,5,0) responseTimeoutNone :: Maybe Int@@ -150,7 +151,7 @@ unsupportedUrlScheme :: URI -> IO () unsupportedUrlScheme u = do 	hPutStrLn stderr $ -		"Unsupported url scheme" ++ show u+		"Unsupported url scheme " ++ show u 	hFlush stderr  allowedScheme :: UrlOptions -> URI -> Bool@@ -232,6 +233,7 @@  	existsconduit req = do 		let req' = headRequest (applyRequest uo req)+		debugM "url" (show req') 		runResourceT $ do 			resp <- http req' (httpManager uo) 			-- forces processing the response while@@ -309,12 +311,16 @@ 				(DownloadWithCurl _, _) 					| isfileurl u -> downloadfile u 					| otherwise -> downloadcurl-		Nothing -> return False+		Nothing -> do+			liftIO $ debugM "url" url+			hPutStrLn stderr "download failed: invalid url"+			return False 	 	isfileurl u = uriScheme u == "file:"  	downloadconduit req = catchMaybeIO (getFileSize file) >>= \case 		Nothing -> runResourceT $ do+			liftIO $ debugM "url" (show req') 			resp <- http (applyRequest uo req') (httpManager uo) 			if responseStatus resp == ok200 				then store zeroBytesProcessed WriteMode resp@@ -347,6 +353,7 @@ 	  where 		dl = runResourceT $ do 			let req' = req { requestHeaders = resumeFromHeader sz : requestHeaders req }+			liftIO $ debugM "url" (show req') 			resp <- http req' (httpManager uo) 			if responseStatus resp == partialContent206 				then store (BytesProcessed sz) AppendMode resp@@ -452,6 +459,7 @@ 		Nothing -> return Nothing 		Just req -> do 			let req' = applyRequest uo req+			liftIO $ debugM "url" (show req') 			withResponse req' (httpManager uo) $ \resp -> 				if responseStatus resp == ok200 					then Just <$> brread n [] (responseBody resp)

@@ -81,6 +81,11 @@   an empty line will be output instead of the normal output produced   when adding a file. +* `-z`++  Makes the `--batch` input be delimited by nulls instead of the usual+  newlines.+ # SEE ALSO  [[git-annex]](1)

@@ -83,6 +83,11 @@   Enables batch mode, in which lines containing urls to add are read from   stdin. +* `-z`++  Makes the `--batch` input be delimited by nulls instead of the usual+  newlines. + * `--with-files`    When batch mode is enabled, makes it parse lines of the form: "$url $file"

@@ -20,14 +20,19 @@  # OPTIONS +* `--backend=name`++  Specifies which key-value backend to use.+ * `--batch`    Enable batch mode, in which a line containing the filename is read from   stdin, the key is output to stdout (with a trailing newline), and repeat. -* `--backend=name`+* `-z` -  Specifies which key-value backend to use.+  Makes the `--batch` input be delimited by nulls instead of the usual+  newlines.  # SEE ALSO 

@@ -88,6 +88,11 @@   machine-parseable, you may want to use --json in combination with   --batch. +* `-z`++  Makes the `--batch` input be delimited by nulls instead of the usual+  newlines.+ * `--json`    Enable JSON output. This is intended to be parsed by programs that use

@@ -87,6 +87,11 @@   match specified matching options, or it is not an annexed file,   a blank line is output in response instead. +* `-z`++  Makes the `--batch` input be delimited by nulls instead of the usual+  newlines.+ * `--json`    Enable JSON output. This is intended to be parsed by programs that use

@@ -68,6 +68,11 @@   or otherwise doesn't meet the matching options, an empty line   will be output instead. +* `-z`++  Makes the `--batch` input be delimited by nulls instead of the usual+  newlines.+ # SEE ALSO  [[git-annex]](1)

@@ -13,9 +13,8 @@  Multiple pairs of file and key can be given in a single command line. -If no key and file pair are specified on the command line, they are-instead read from stdin. Any number of lines can be provided in this-mode, each containing a key and filename, separated by a single space.+If no key and file pair are specified on the command line, batch input+is used, the same as if the --batch option were specified.  Normally the key is a git-annex formatted key. However, to make it easier to use this to add urls, if the key cannot be parsed as a key, and is a@@ -29,6 +28,19 @@    Allow making a file link to a key whose content is not in the local   repository. The key may not be known to git-annex at all.++* `--batch`++  In batch input mode, lines are read from stdin, and each line+  should contain a key and filename, separated by a single space.++* `-z`++  When in batch mode, the input is delimited by nulls instead of the usual+  newlines.++  (Note that for this to be used, you have to explicitly enable batch mode+  with `--batch`)  # SEE ALSO 

@@ -98,6 +98,11 @@   machine-parseable, you may want to use --json in combination with   --batch. +* `-z`++  Makes the `--batch` input be delimited by nulls instead of the usual+  newlines.+ * `--json`    Enable JSON output. This is intended to be parsed by programs that use

@@ -40,6 +40,11 @@   Enable batch mode, in which a line containing an item is read from stdin,   the information about it is output to stdout, and repeat. +* `-z`++  Makes the `--batch` input be delimited by nulls instead of the usual+  newlines.+ * file matching options    When a directory is specified, the [[git-annex-matching-options]](1)

@@ -23,6 +23,11 @@   Note that if there is no key corresponding to the file, an empty line is   output to stdout instead. +* `-z`++  Makes the `--batch` input be delimited by nulls instead of the usual+  newlines.+ # SEE ALSO  [[git-annex]](1)

@@ -22,6 +22,13 @@ this cannot be directly modified by this command. It is updated automatically. +Note that the metadata is attached to the particular content of a file,+not to a particular filename on a particular git branch. +All files with the same content share the same metadata, which is+stored in the git-annex branch. If a file is edited, old+metadata will be copied to the new contents when you [[git-annex-add]]+the edited file. + # OPTIONS  * `-g field` / `--get field`

@@ -88,6 +88,11 @@   machine-parseable, you may want to use --json in combination with   --batch. +* `-z`++  Makes the `--batch` input be delimited by nulls instead of the usual+  newlines.+ * `--json`    Enable JSON output. This is intended to be parsed by programs that use

@@ -13,13 +13,28 @@  No verification is performed of the url's contents. -If the key and url are not specified on the command line, they are-instead read from stdin. Any number of lines can be provided in this-mode, each containing a key and url, separated by a single space.+If no key and url pair are specified on the command line,+batch input is used, the same as if the --batch option were+specified.  Normally the key is a git-annex formatted key. However, to make it easier to use this to add urls, if the key cannot be parsed as a key, and is a valid url, an URL key is constructed from the url.++# OPTIONS++* `--batch`++  In batch input mode, lines are read from stdin, and each line+  should contain a key and url, separated by a single space.++* `-z`++   When in batch mode, the input is delimited by nulls instead of the usual+   newlines.++   (Note that for this to be used, you have to explicitly enable batch mode+   with `--batch`)  # SEE ALSO 

@@ -26,6 +26,11 @@   Each line should contain the file, and the new key to use for that file,   separated by a single space. +* `-z`++  Makes the `--batch` input be delimited by nulls instead of the usual+  newlines.+ # SEE ALSO  [[git-annex]](1)

@@ -18,6 +18,11 @@   Each line should contain the file, and the url to remove from that file,   separated by a single space. +* `-z`++  Makes the `--batch` input be delimited by nulls instead of the usual+  newlines.+ # SEE ALSO  [[git-annex]](1)

@@ -20,6 +20,10 @@ 		62b39bbe-4149-11e0-af01-bb89245a1e61  -- usb drive [here] 		7570b02e-15e9-11e0-adf0-9f3f94cb2eaa  -- backup drive +Note that this command does not contact remotes to verify if they still+have the content of files. It only reports on the last information that was+received from remotes.+ # OPTIONS  * file matching options@@ -51,6 +55,11 @@   Note that if the file is not an annexed file, or does not match   specified file matching options, an empty line will be   output instead.++* `-z`++  Makes the `--batch` input be delimited by nulls instead of the usual+  newlines.  * `--json` 

@@ -865,6 +865,13 @@   To configure the behavior in new clones of the repository,   this can be set in [[git-annex-config]]. +* `annex.maxextensionlength`++  Maximum length of what is considered a filename extension when adding a+  file to a backend that preserves filename extensions. The default length+  is 4, which allows extensions like "jpeg". The dot before the extension+  is not counted part of its length.+ * `annex.diskreserve`    Amount of disk space to reserve. Disk space is checked when transferring@@ -1443,7 +1450,7 @@   these IP address restrictions to be enforced, curl and youtube-dl will   never be used unless annex.security.allowed-http-addresses=all. -* `annex.security.allow-unverified-downloads`, +* `annex.security.allow-unverified-downloads`    For security reasons, git-annex refuses to download content from   most special remotes when it cannot check a hash to verify @@ -1479,6 +1486,10 @@    It would be a good idea to check that it downloaded the file you expected,   too.++* `remote.name.annex-security-allow-unverified-downloads`++  Per-remote configuration of annex.security.allow-unverified-downloads.  * `annex.secure-erase-command` 

@@ -1,5 +1,5 @@ Name: git-annex-Version: 6.20180913+Version: 6.20180926 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess <id@joeyh.name>