git-annex 8.20210803 → 8.20210903

raw patch · 157 files changed

+1501/−851 lines, 157 files

Files

• Annex.hs +2/−2
• Annex/Branch.hs +2/−1
• Annex/Content.hs +32/−12
• Annex/CopyFile.hs +24/−46
• Annex/Ingest.hs +29/−12
• Annex/Init.hs +16/−12
• Annex/MetaData.hs +3/−3
• Annex/Perms.hs +36/−12
• Annex/Transfer.hs +3/−2
• Annex/UUID.hs +1/−1
• Annex/Url.hs +7/−6
• Annex/VectorClock.hs +22/−5
• Annex/VectorClock/Utility.hs +3/−3
• Annex/Verify.hs +210/−12
• Annex/View/ViewedFile.hs +8/−2
• Annex/YoutubeDl.hs +12/−5
• Assistant/Threads/Committer.hs +2/−0
• Assistant/Threads/Merger.hs +1/−1
• Assistant/Threads/Watcher.hs +1/−1
• Assistant/Upgrade.hs +2/−2
• Assistant/WebApp/Configurators/Edit.hs +1/−1
• Backend/External.hs +1/−1
• Backend/Hash.hs +4/−13
• Backend/Utilities.hs +6/−3
• Build/Configure.hs +6/−0
• CHANGELOG +36/−0
• CmdLine/Batch.hs +97/−38
• CmdLine/Option.hs +2/−2
• Command/Add.hs +3/−2
• Command/AddUrl.hs +4/−3
• Command/CheckPresentKey.hs +1/−1
• Command/Config.hs +4/−4
• Command/Copy.hs +4/−3
• Command/DiffDriver.hs +1/−1
• Command/Drop.hs +2/−2
• Command/DropKey.hs +1/−1
• Command/Find.hs +2/−2
• Command/FindRef.hs +1/−1
• Command/FromKey.hs +2/−2
• Command/Fsck.hs +11/−10
• Command/Get.hs +2/−2
• Command/Import.hs +33/−9
• Command/ImportFeed.hs +1/−1
• Command/Info.hs +5/−5
• Command/Log.hs +1/−1
• Command/Merge.hs +1/−1
• Command/MetaData.hs +4/−4
• Command/Move.hs +4/−3
• Command/ReKey.hs +1/−1
• Command/RegisterUrl.hs +9/−7
• Command/RmUrl.hs +1/−1
• Command/SetPresentKey.hs +1/−1
• Command/Smudge.hs +1/−0
• Command/TestRemote.hs +2/−2
• Command/TransferKey.hs +4/−2
• Command/TransferKeys.hs +1/−1
• Command/Transferrer.hs +2/−2
• Command/Uninit.hs +1/−1
• Command/UnregisterUrl.hs +1/−1
• Command/Unused.hs +1/−0
• Command/Vicfg.hs +1/−1
• Command/Whereis.hs +2/−2
• Config.hs +1/−1
• Database/Keys.hs +2/−2
• Database/Types.hs +2/−2
• Git/Config.hs +4/−4
• Git/ConfigTypes.hs +1/−1
• Git/DiffTree.hs +1/−1
• Git/Fsck.hs +1/−1
• Git/GCrypt.hs +2/−2
• Git/LsFiles.hs +2/−2
• Git/LsTree.hs +1/−1
• Git/Ref.hs +2/−2
• Git/Remote.hs +2/−2
• Git/Repair.hs +6/−6
• Git/Types.hs +5/−5
• Git/UpdateIndex.hs +2/−2
• Key.hs +2/−2
• Logs/Export.hs +2/−3
• Logs/Export/Pure.hs +6/−3
• Logs/FsckResults.hs +1/−1
• Logs/Location.hs +17/−20
• Logs/MapLog.hs +6/−2
• Logs/MetaData.hs +8/−7
• Logs/Presence.hs +28/−17
• Logs/Presence/Pure.hs +11/−3
• Logs/SingleValue.hs +8/−4
• Logs/SingleValue/Pure.hs +9/−4
• Logs/Transfer.hs +1/−1
• Logs/Transitions.hs +6/−5
• Logs/UUIDBased.hs +5/−3
• Logs/View.hs +1/−1
• Logs/Web.hs +2/−2
• Messages.hs +7/−7
• P2P/Annex.hs +6/−4
• P2P/Protocol.hs +3/−3
• Remote.hs +1/−1
• Remote/Adb.hs +5/−3
• Remote/BitTorrent.hs +3/−3
• Remote/Borg.hs +1/−1
• Remote/Bup.hs +4/−1
• Remote/Ddar.hs +3/−1
• Remote/Directory.hs +9/−13
• Remote/Directory/LegacyChunked.hs +3/−2
• Remote/External.hs +20/−21
• Remote/GCrypt.hs +6/−4
• Remote/Git.hs +33/−15
• Remote/GitLFS.hs +6/−5
• Remote/Glacier.hs +3/−1
• Remote/Helper/Chunked.hs +80/−30
• Remote/Helper/ExportImport.hs +6/−6
• Remote/Helper/Hooks.hs +4/−2
• Remote/Helper/Http.hs +6/−4
• Remote/Helper/P2P.hs +2/−2
• Remote/Helper/Special.hs +44/−20
• Remote/Hook.hs +5/−3
• Remote/HttpAlso.hs +11/−9
• Remote/P2P.hs +1/−2
• Remote/Rsync.hs +4/−8
• Remote/S3.hs +13/−11
• Remote/Tahoe.hs +2/−2
• Remote/Web.hs +29/−14
• Remote/WebDAV.hs +14/−9
• Test.hs +25/−8
• Test/Framework.hs +10/−1
• Types.hs +2/−0
• Types/ActionItem.hs +1/−1
• Types/Backend.hs +1/−10
• Types/GitConfig.hs +3/−1
• Types/Remote.hs +13/−3
• Types/StoreRetrieve.hs +14/−2
• Types/UUID.hs +2/−2
• Types/VectorClock.hs +6/−4
• Upgrade/V2.hs +1/−1
• Upgrade/V5/Direct.hs +1/−1
• Utility/CopyFile.hs +7/−1
• Utility/Data.hs +17/−1
• Utility/Debug.hs +2/−2
• Utility/FileSystemEncoding.hs +22/−126
• Utility/Hash.hs +53/−5
• Utility/LockFile/PidLock.hs +2/−1
• Utility/Path.hs +7/−1
• Utility/Tmp.hs +16/−2
• Utility/Url.hs +38/−17
• doc/git-annex-copy.mdwn +7/−4
• doc/git-annex-drop.mdwn +11/−4
• doc/git-annex-find.mdwn +4/−0
• doc/git-annex-fsck.mdwn +2/−2
• doc/git-annex-get.mdwn +7/−3
• doc/git-annex-log.mdwn +2/−2
• doc/git-annex-matching-options.mdwn +31/−30
• doc/git-annex-metadata.mdwn +3/−3
• doc/git-annex-mirror.mdwn +2/−2
• doc/git-annex-move.mdwn +7/−4
• doc/git-annex-whereis.mdwn +8/−4
• doc/git-annex.mdwn +8/−5
• git-annex.cabal +1/−1

@@ -200,7 +200,7 @@ 	, cachedgitenv :: Maybe (AltIndexFile, FilePath, [(String, String)]) 	, urloptions :: Maybe UrlOptions 	, insmudgecleanfilter :: Bool-	, getvectorclock :: IO VectorClock+	, getvectorclock :: IO CandidateVectorClock 	}  newAnnexState :: GitConfig -> Git.Repo -> IO AnnexState@@ -401,7 +401,7 @@ addGitConfigOverride :: String -> Annex () addGitConfigOverride v = do 	adjustGitRepo $ \r ->-		Git.Config.store (encodeBS' v) Git.Config.ConfigList $+		Git.Config.store (encodeBS v) Git.Config.ConfigList $ 			r { Git.gitGlobalOpts = go (Git.gitGlobalOpts r) } 	changeState $ \st -> st { gitconfigoverride = v : gitconfigoverride st }   where

@@ -84,6 +84,7 @@ import qualified Annex import Annex.Hook import Utility.Directory.Stream+import Utility.Tmp import qualified Utility.RawFilePath as R  {- Name of the branch that is used to store git-annex's information. -}@@ -596,7 +597,7 @@ 		mapM_ (removeFile . (dir </>)) stagedfs 		hClose jlogh 		removeWhenExistsWith (R.removeLink) (toRawFilePath jlogf)-	openjlog tmpdir = liftIO $ openTempFile tmpdir "jlog"+	openjlog tmpdir = liftIO $ openTmpFileIn tmpdir "jlog"  {- This is run after the refs have been merged into the index,  - but before the result is committed to the branch.

@@ -53,7 +53,8 @@ 	isUnmodifiedCheap, 	verifyKeyContentPostRetrieval, 	verifyKeyContent,-	VerifyConfig(..),+	VerifyConfig,+	VerifyConfigA(..), 	Verification(..), 	unVerified, 	withTmpWorkDir,@@ -83,7 +84,7 @@ import Annex.ReplaceFile import Annex.AdjustedBranch (adjustedBranchRefresh) import Messages.Progress-import Types.Remote (RetrievalSecurityPolicy(..))+import Types.Remote (RetrievalSecurityPolicy(..), VerifyConfigA(..)) import Types.NumCopies import Types.Key import Types.Transfer@@ -631,20 +632,39 @@ 			Annex.Branch.commit =<< Annex.Branch.commitMessage  {- Downloads content from any of a list of urls, displaying a progress- - meter. -}-downloadUrl :: Key -> MeterUpdate -> [Url.URLString] -> FilePath -> Url.UrlOptions -> Annex Bool-downloadUrl k p urls file uo = + - meter.+ -+ - Only displays error message if all the urls fail to download.+ - When listfailedurls is set, lists each url and why it failed.+ - Otherwise, only displays one error message, from one of the urls+ - that failed.+ -}+downloadUrl :: Bool -> Key -> MeterUpdate -> Maybe IncrementalVerifier -> [Url.URLString] -> FilePath -> Url.UrlOptions -> Annex Bool+downloadUrl listfailedurls k p iv urls file uo =  	-- Poll the file to handle configurations where an external 	-- download command is used.-	meteredFile file (Just p) k (go urls Nothing)+	meteredFile file (Just p) k (go urls [])   where-  	-- Display only one error message, if all the urls fail to-	-- download.-	go [] (Just err) = warning err >> return False-	go [] Nothing = return False-	go (u:us) _ = Url.download' p u file uo >>= \case+	go (u:us) errs = Url.download' p iv u file uo >>= \case 		Right () -> return True-		Left err -> go us (Just err)+		Left err -> do+			-- If the incremental verifier was fed anything+			-- while the download that failed ran, it's unable+			-- to be used for the other urls.+			case iv of+				Just iv' -> +					liftIO $ positionIncremental iv' >>= \case+					Just n | n > 0 -> unableIncremental iv'+					_ -> noop+				Nothing -> noop+			go us ((u, err) : errs)+	go [] [] = return False+	go [] errs@((_, err):_) = do+		if listfailedurls+			then warning $ unlines $ flip map errs $ \(u, err') ->+				u ++ " " ++ err'+			else warning err+		return False  {- Copies a key's content, when present, to a temp file.  - This is used to speed up some rsyncs. -}

@@ -10,32 +10,16 @@ module Annex.CopyFile where  import Annex.Common-import Types.Remote import Utility.Metered import Utility.CopyFile import Utility.FileMode import Utility.Touch-import Types.Backend-import Annex.Verify+import Utility.Hash (IncrementalVerifier(..))  import Control.Concurrent import qualified Data.ByteString as S import Data.Time.Clock.POSIX --- Copies from src to dest, updating a meter. If the copy finishes--- successfully, calls a final check action, which must also succeed, or--- returns false.------ If either the remote or local repository wants to use hard links,--- the copier will do so (falling back to copying if a hard link cannot be--- made).------ When a hard link is created, returns Verified; the repo being linked--- from is implicitly trusted, so no expensive verification needs to be--- done. Also returns Verified if the key's content is verified while--- copying it.-type FileCopier = FilePath -> FilePath -> Key -> MeterUpdate -> Annex Bool -> VerifyConfig -> Annex (Bool, Verification)- -- To avoid the overhead of trying copy-on-write every time, it's tried -- once and if it fails, is not tried again. newtype CopyCoWTried = CopyCoWTried (MVar Bool)@@ -62,14 +46,18 @@ 	docopycow = watchFileSize dest meterupdate $ 		copyCoW CopyTimeStamps src dest -{- Copys a file. Uses copy-on-write if it is supported. Otherwise,- - copies the file itself. If the destination already exists,- - an interruped copy will resume where it left off.+data CopyMethod = CopiedCoW | Copied++{- Copies from src to dest, updating a meter. Preserves mode and mtime.+ - Uses copy-on-write if it is supported. If the the destination already+ - exists, an interruped copy will resume where it left off.  -- - When copy-on-write is used, returns UnVerified, because the content of- - the file has not been verified to be correct. When the file has to be- - read to copy it, a hash is calulated at the same time.+ - The IncrementalVerifier is updated with the content of the file as it's+ - being copied. But it is not finalized at the end.  -+ - When copy-on-write is used, the IncrementalVerifier is not fed+ - the content of the file, and verification using it will fail.+ -  - Note that, when the destination file already exists, it's read both  - to start calculating the hash, and also to verify that its content is  - the same as the start of the source file. It's possible that the@@ -77,13 +65,15 @@  - (eg when isStableKey is false), and doing this avoids getting a  - corrupted file in such cases.  -}-fileCopier :: CopyCoWTried -> FileCopier+fileCopier :: CopyCoWTried -> FilePath -> FilePath -> MeterUpdate -> Maybe IncrementalVerifier -> Annex CopyMethod #ifdef mingw32_HOST_OS-fileCopier _ src dest k meterupdate check verifyconfig = docopy+fileCopier _ src dest meterupdate iv = docopy #else-fileCopier copycowtried src dest k meterupdate check verifyconfig =+fileCopier copycowtried src dest meterupdate iv = 	ifM (liftIO $ tryCopyCoW copycowtried src dest meterupdate)-		( unVerified check+		( do+			liftIO $ maybe noop unableIncremental iv+			return CopiedCoW 		, docopy 		) #endif@@ -91,16 +81,14 @@ 	dest' = toRawFilePath dest  	docopy = do-		iv <- startVerifyKeyContentIncrementally verifyconfig k- 		-- The file might have had the write bit removed, 		-- so make sure we can write to it. 		void $ liftIO $ tryIO $ allowWrite dest'  		liftIO $ withBinaryFile dest ReadWriteMode $ \hdest -> 			withBinaryFile src ReadMode $ \hsrc -> do-				sofar <- compareexisting iv hdest hsrc zeroBytesProcessed-				docopy' iv hdest hsrc sofar+				sofar <- compareexisting hdest hsrc zeroBytesProcessed+				docopy' hdest hsrc sofar  		-- Copy src mode and mtime. 		mode <- liftIO $ fileMode <$> getFileStatus src@@ -108,19 +96,9 @@ 		liftIO $ setFileMode dest mode 		liftIO $ touch dest' mtime False -		ifM check-			( case iv of-				Just x -> ifM (liftIO $ finalizeIncremental x)-					( return (True, Verified)-					, do-						warning "verification of content failed"-						return (False, UnVerified)-					)-				Nothing -> return (True, UnVerified)-			, return (False, UnVerified)-			)+		return Copied 	-	docopy' iv hdest hsrc sofar = do+	docopy' hdest hsrc sofar = do 		s <- S.hGet hsrc defaultChunkSize 		if s == S.empty 			then return ()@@ -129,12 +107,12 @@ 				S.hPut hdest s 				maybe noop (flip updateIncremental s) iv 				meterupdate sofar'-				docopy' iv hdest hsrc sofar'+				docopy' hdest hsrc sofar'  	-- Leaves hdest and hsrc seeked to wherever the two diverge, 	-- so typically hdest will be seeked to end, and hsrc to the same 	-- position.-	compareexisting iv hdest hsrc sofar = do+	compareexisting hdest hsrc sofar = do 		s <- S.hGet hdest defaultChunkSize 		if s == S.empty 			then return sofar@@ -145,7 +123,7 @@ 						maybe noop (flip updateIncremental s) iv 						let sofar' = addBytesProcessed sofar (S.length s) 						meterupdate sofar'-						compareexisting iv hdest hsrc sofar'+						compareexisting hdest hsrc sofar' 					else do 						seekbefore hdest s 						seekbefore hsrc s'

@@ -1,6 +1,6 @@ {- git-annex content ingestion  -- - Copyright 2010-2020 Joey Hess <id@joeyh.name>+ - Copyright 2010-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -9,6 +9,7 @@ 	LockedDown(..), 	LockDownConfig(..), 	lockDown,+	checkLockedDownWritePerms, 	ingestAdd, 	ingestAdd', 	ingest,@@ -51,8 +52,6 @@ import Annex.FileMatcher import qualified Utility.RawFilePath as R -import Control.Exception (IOException)- data LockedDown = LockedDown 	{ lockDownConfig :: LockDownConfig 	, keySource :: KeySource@@ -63,7 +62,9 @@ 	{ lockingFile :: Bool 	-- ^ write bit removed during lock down 	, hardlinkFileTmpDir :: Maybe RawFilePath-	-- ^ hard link to temp directory+	-- ^ hard link to temp directorya+	, checkWritePerms :: Bool+	-- ^ check that write perms are successfully removed 	} 	deriving (Show) @@ -78,16 +79,17 @@  - against some changes, like deletion or overwrite of the file, and  - allows lsof checks to be done more efficiently when adding a lot of files.  -- - Lockdown can fail if a file gets deleted, and Nothing will be returned.+ - Lockdown can fail if a file gets deleted, or if it's unable to remove+ - write permissions, and Nothing will be returned.  -}-lockDown :: LockDownConfig -> FilePath -> Annex (Maybe LockedDown)+lockDown :: LockDownConfig-> FilePath -> Annex (Maybe LockedDown) lockDown cfg file = either  		(\e -> warning (show e) >> return Nothing) 		(return . Just) 	=<< lockDown' cfg file -lockDown' :: LockDownConfig -> FilePath -> Annex (Either IOException LockedDown)-lockDown' cfg file = tryIO $ ifM crippledFileSystem+lockDown' :: LockDownConfig -> FilePath -> Annex (Either SomeException LockedDown)+lockDown' cfg file = tryNonAsync $ ifM crippledFileSystem 	( nohardlink 	, case hardlinkFileTmpDir cfg of 		Nothing -> nohardlink@@ -96,7 +98,9 @@   where 	file' = toRawFilePath file -	nohardlink = withTSDelta $ liftIO . nohardlink'+	nohardlink = do+		setperms+		withTSDelta $ liftIO . nohardlink'  	nohardlink' delta = do 		cache <- genInodeCache file' delta@@ -107,10 +111,9 @@ 			} 	 	withhardlink tmpdir = do-		when (lockingFile cfg) $-			freezeContent file'+		setperms 		withTSDelta $ \delta -> liftIO $ do-			(tmpfile, h) <- openTempFile (fromRawFilePath tmpdir) $+			(tmpfile, h) <- openTmpFileIn (fromRawFilePath tmpdir) $ 				relatedTemplate $ "ingest-" ++ takeFileName file 			hClose h 			removeWhenExistsWith R.removeLink (toRawFilePath tmpfile)@@ -125,6 +128,20 @@ 			, contentLocation = toRawFilePath tmpfile 			, inodeCache = cache 			}+		+	setperms = when (lockingFile cfg) $ do+		freezeContent file'+		when (checkWritePerms cfg) $+			maybe noop giveup =<< checkLockedDownWritePerms file' file'++checkLockedDownWritePerms :: RawFilePath -> RawFilePath -> Annex (Maybe String)+checkLockedDownWritePerms file displayfile = checkContentWritePerm file >>= return . \case+	Just False -> Just $ unwords+		[ "Unable to remove all write permissions from"+		, fromRawFilePath displayfile+		, "-- perhaps it has an xattr or ACL set."+		]+	_ -> Nothing  {- Ingests a locked down file into the annex. Updates the work tree and  - index. -}

@@ -275,18 +275,22 @@ 		liftIO $ createSymbolicLink f f2 		liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f2) 		(fromMaybe (liftIO . preventWrite) freezecontent) (toRawFilePath f)-		-- Should be unable to write to the file, unless-		-- running as root, but some crippled-		-- filesystems ignore write bit removals.-		liftIO $ ifM ((== 0) <$> getRealUserID)-			( return (False, [])-			, do-				r <- catchBoolIO $ do-					writeFile f "2"-					return True-				if r-					then return (True, ["Filesystem allows writing to files whose write bit is not set."])-					else return (False, [])+		-- Should be unable to write to the file (unless+		-- running as root). But some crippled+		-- filesystems ignore write bit removals or ignore+		-- permissions entirely.+		ifM ((== Just False) <$> liftIO (checkContentWritePerm' UnShared (toRawFilePath f)))+			( return (True, ["Filesystem does not allow removing write bit from files."])+			, liftIO $ ifM ((== 0) <$> getRealUserID)+				( return (False, [])+				, do+					r <- catchBoolIO $ do+						writeFile f "2"+						return True+					if r+						then return (True, ["Filesystem allows writing to files whose write bit is not set."])+						else return (False, [])+				) 			) #endif 

@@ -72,11 +72,11 @@  - only changes to add the date fields. -} dateMetaData :: UTCTime -> MetaData -> MetaData dateMetaData mtime old = modMeta old $-	(SetMeta yearMetaField $ S.singleton $ toMetaValue $ encodeBS' $ show y)+	(SetMeta yearMetaField $ S.singleton $ toMetaValue $ encodeBS $ show y) 		`ComposeModMeta`-	(SetMeta monthMetaField $ S.singleton $ toMetaValue $ encodeBS' $ show m)+	(SetMeta monthMetaField $ S.singleton $ toMetaValue $ encodeBS $ show m) 		`ComposeModMeta`-	(SetMeta dayMetaField $ S.singleton $ toMetaValue $ encodeBS' $ show d)+	(SetMeta dayMetaField $ S.singleton $ toMetaValue $ encodeBS $ show d)   where 	(y, m, d) = toGregorian $ utctDay mtime 

@@ -16,7 +16,8 @@ 	noUmask, 	freezeContent, 	freezeContent',-	isContentWritePermOk,+	checkContentWritePerm,+	checkContentWritePerm', 	thawContent, 	thawContent', 	createContentDir,@@ -131,6 +132,12 @@  - necessary to let other users in the group lock the file. But, in a  - shared repository, the current user may not be able to change a file  - owned by another user, so failure to set this mode is ignored.+ -+ - Note that, on Linux, xattrs can sometimes prevent removing+ - certain permissions from a file with chmod. (Maybe some ACLs too?) + - In such a case, this will return with the file still having some mode+ - it should not normally have. checkContentWritePerm can detect when+ - that happens with write permissions.  -} freezeContent :: RawFilePath -> Annex () freezeContent file = unlessM crippledFileSystem $@@ -149,19 +156,36 @@ 		removeModes writeModes . 		addModes [ownerReadMode] -isContentWritePermOk :: RawFilePath -> Annex Bool-isContentWritePermOk file = ifM crippledFileSystem-	( return True-	, withShared go+{- Checks if the write permissions are as freezeContent should set them.+ -+ - When the repository is shared, the user may not be able to change+ - permissions of a file owned by another user. So if the permissions seem+ - wrong, but the repository is shared, returns Nothing. If the permissions+ - are wrong otherwise, returns Just False.+ -}+checkContentWritePerm :: RawFilePath -> Annex (Maybe Bool)+checkContentWritePerm file = ifM crippledFileSystem+	( return (Just True)+	, withShared (\sr -> liftIO (checkContentWritePerm' sr file)) 	)++checkContentWritePerm' :: SharedRepository -> RawFilePath -> IO (Maybe Bool)+checkContentWritePerm' sr file = case sr of+	GroupShared -> want sharedret+		(includemodes [ownerWriteMode, groupWriteMode])+	AllShared -> want sharedret (includemodes writeModes)+	_ -> want Just (excludemodes writeModes)   where-	go GroupShared = want [ownerWriteMode, groupWriteMode]-	go AllShared = want writeModes-	go _ = return True-	want wantmode =-		liftIO (catchMaybeIO $ fileMode <$> R.getFileStatus file) >>= return . \case-			Nothing -> True-			Just havemode -> havemode == combineModes (havemode:wantmode)+	want mk f = catchMaybeIO (fileMode <$> R.getFileStatus file)+		>>= return . \case+			Just havemode -> mk (f havemode)+			Nothing -> mk True+	+	includemodes l havemode = havemode == combineModes (havemode:l)+	excludemodes l havemode = all (\m -> intersectFileModes m havemode == nullFileMode) l++	sharedret True = Just True+	sharedret False = Nothing  {- Allows writing to an annexed file that freezeContent was called on  - before. -}

@@ -78,10 +78,11 @@ 	Just StallDetectionDisabled -> go Nothing 	Just sd -> runTransferrer sd r key f d Download witness   where-	go sd = getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) key f $ \dest ->+	go sd = getViaTmp (Remote.retrievalSecurityPolicy r) vc key f $ \dest -> 		download' (Remote.uuid r) key f sd d (go' dest) witness 	go' dest p = verifiedAction $-		Remote.retrieveKeyFile r key f (fromRawFilePath dest) p+		Remote.retrieveKeyFile r key f (fromRawFilePath dest) p vc+	vc = Remote.RemoteVerify r  -- Download, not supporting canceling detected stalls. download' :: Observable v => UUID -> Key -> AssociatedFile -> Maybe StallDetection -> RetryDecider -> (MeterUpdate -> Annex v) -> NotifyWitness -> Annex v

@@ -110,7 +110,7 @@ {- Only sets the configkey in the Repo; does not change .git/config -} setUUID :: Git.Repo -> UUID -> IO Git.Repo setUUID r u = do-	let s = encodeBS' $ show configkeyUUID ++ "=" ++ fromUUID u+	let s = encodeBS $ show configkeyUUID ++ "=" ++ fromUUID u 	Git.Config.store s Git.Config.ConfigList r  -- Dummy uuid for the whole web. Do not alter.

@@ -34,6 +34,7 @@ import Annex.Common import qualified Annex import qualified Utility.Url as U+import Utility.Hash (IncrementalVerifier) import Utility.IPAddress #ifdef WITH_HTTP_CLIENT_RESTRICTED import Network.HTTP.Client.Restricted@@ -172,15 +173,15 @@ 		Right r -> return r 		Left err -> warning err >> return False -download :: MeterUpdate -> U.URLString -> FilePath -> U.UrlOptions -> Annex Bool-download meterupdate url file uo =-	liftIO (U.download meterupdate url file uo) >>= \case+download :: MeterUpdate -> Maybe IncrementalVerifier -> U.URLString -> FilePath -> U.UrlOptions -> Annex Bool+download meterupdate iv url file uo =+	liftIO (U.download meterupdate iv url file uo) >>= \case 		Right () -> return True 		Left err -> warning err >> return False -download' :: MeterUpdate -> U.URLString -> FilePath -> U.UrlOptions -> Annex (Either String ())-download' meterupdate url file uo =-	liftIO (U.download meterupdate url file uo)+download' :: MeterUpdate -> Maybe IncrementalVerifier -> U.URLString -> FilePath -> U.UrlOptions -> Annex (Either String ())+download' meterupdate iv url file uo =+	liftIO (U.download meterupdate iv url file uo)  exists :: U.URLString -> U.UrlOptions -> Annex Bool exists url uo = liftIO (U.exists url uo) >>= \case

@@ -1,9 +1,11 @@ {- git-annex vector clocks  -- - We don't have a way yet to keep true distributed vector clocks.- - The next best thing is a timestamp.+ - These are basically a timestamp. However, when logging a new+ - value, if the old value has a vector clock that is the same or greater+ - than the current vector clock, the old vector clock is incremented.+ - This way, clock skew does not cause confusion.  -- - Copyright 2017-2020 Joey Hess <id@joeyh.name>+ - Copyright 2017-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -21,10 +23,12 @@ import Data.ByteString.Builder import qualified Data.Attoparsec.ByteString.Lazy as A -currentVectorClock :: Annex VectorClock+currentVectorClock :: Annex CandidateVectorClock currentVectorClock = liftIO =<< Annex.getState Annex.getvectorclock --- Runs the action and uses the same vector clock throughout.+-- Runs the action and uses the same vector clock throughout,+-- except when it's necessary to use a newer one due to a past value having+-- a newer vector clock. -- -- When the action modifies several files in the git-annex branch, -- this can cause less space to be used, since the same vector clock@@ -51,6 +55,19 @@  	use vc = Annex.changeState $ \s -> 		s { Annex.getvectorclock = vc }++-- Convert a candidate vector clock in to the final one to use,+-- advancing it if necessary when necessary to get ahead of a previously+-- used vector clock.+advanceVectorClock :: CandidateVectorClock -> [VectorClock] -> VectorClock+advanceVectorClock (CandidateVectorClock c) [] = VectorClock c+advanceVectorClock (CandidateVectorClock c) prevs+	| prev >= VectorClock c = case prev of+		VectorClock v -> VectorClock (v + 1)+		Unknown -> VectorClock c+	| otherwise = VectorClock c+  where+	prev = maximum prevs  formatVectorClock :: VectorClock -> String formatVectorClock Unknown = "0"

@@ -13,11 +13,11 @@ import Utility.Env import Utility.TimeStamp -startVectorClock :: IO (IO VectorClock)+startVectorClock :: IO (IO CandidateVectorClock) startVectorClock = go =<< getEnv "GIT_ANNEX_VECTOR_CLOCK"   where 	go Nothing = timebased 	go (Just s) = case parsePOSIXTime s of-		Just t -> return (pure (VectorClock t))+		Just t -> return (pure (CandidateVectorClock t)) 		Nothing -> timebased-	timebased = return (VectorClock <$> getPOSIXTime)+	timebased = return (CandidateVectorClock <$> getPOSIXTime)

@@ -5,8 +5,9 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE CPP #-}+ module Annex.Verify (-	VerifyConfig(..), 	shouldVerify, 	verifyKeyContentPostRetrieval, 	verifyKeyContent,@@ -15,21 +16,29 @@ 	warnUnverifiableInsecure, 	isVerifiable, 	startVerifyKeyContentIncrementally,+	finishVerifyKeyContentIncrementally, 	IncrementalVerifier(..),+	tailVerify, ) where  import Annex.Common import qualified Annex import qualified Types.Remote+import Types.Remote (VerifyConfigA(..)) import qualified Types.Backend-import Types.Backend (IncrementalVerifier(..)) import qualified Backend import Types.Remote (unVerified, Verification(..), RetrievalSecurityPolicy(..))+import Utility.Hash (IncrementalVerifier(..)) import Annex.WorkerPool import Types.WorkerPool import Types.Key -data VerifyConfig = AlwaysVerify | NoVerify | RemoteVerify Remote | DefaultVerify+import Control.Concurrent.STM+import qualified Data.ByteString as S+#if WITH_INOTIFY+import qualified System.INotify as INotify+import qualified System.FilePath.ByteString as P+#endif  shouldVerify :: VerifyConfig -> Annex Bool shouldVerify AlwaysVerify = return True@@ -71,23 +80,71 @@ 		, return True 		) 	(_, MustVerify) -> verify+	(_, IncompleteVerify _) -> ifM (shouldVerify v)+		( verify+		, return True+		)   where-	verify = enteringStage VerifyStage $ verifyKeyContent k f+	verify = enteringStage VerifyStage $+		case verification of+			IncompleteVerify iv -> resumeVerifyKeyContent k f iv+			_ -> verifyKeyContent k f  verifyKeyContent :: Key -> RawFilePath -> Annex Bool-verifyKeyContent k f = verifysize <&&> verifycontent-  where-	verifysize = case fromKey keySize k of-		Nothing -> return True-		Just size -> do-			size' <- liftIO $ catchDefaultIO 0 $ getFileSize f-			return (size' == size)-	verifycontent = Backend.maybeLookupBackendVariety (fromKey keyVariety k) >>= \case+verifyKeyContent k f = verifyKeySize k f <&&> verifyKeyContent' k f++verifyKeyContent' :: Key -> RawFilePath -> Annex Bool+verifyKeyContent' k f = +	Backend.maybeLookupBackendVariety (fromKey keyVariety k) >>= \case 		Nothing -> return True 		Just b -> case Types.Backend.verifyKeyContent b of 			Nothing -> return True 			Just verifier -> verifier k f +resumeVerifyKeyContent :: Key -> RawFilePath -> IncrementalVerifier -> Annex Bool+resumeVerifyKeyContent k f iv = liftIO (positionIncremental iv) >>= \case+	Nothing -> fallback+	Just endpos -> do+		fsz <- liftIO $ catchDefaultIO 0 $ getFileSize f+		if fsz < endpos+			then fallback+			else case fromKey keySize k of+				Just size | fsz /= size -> return False+				_ -> go fsz endpos >>= \case+					Just v -> return v+					Nothing -> fallback+  where+	fallback = verifyKeyContent k f++	go fsz endpos+		| fsz == endpos =+			liftIO $ catchDefaultIO (Just False) $+				finalizeIncremental iv+		| otherwise = do+			showAction (descVerify iv)+			liftIO $ catchDefaultIO (Just False) $+				withBinaryFile (fromRawFilePath f) ReadMode $ \h -> do+					hSeek h AbsoluteSeek endpos+					feedincremental h+					finalizeIncremental iv+	+	feedincremental h = do+		b <- S.hGetSome h chunk+		if S.null b+			then return ()+			else do+				updateIncremental iv b+				feedincremental h++	chunk = 65536++verifyKeySize :: Key -> RawFilePath -> Annex Bool+verifyKeySize k f = case fromKey keySize k of+	Just size -> do+		size' <- liftIO $ catchDefaultIO 0 $ getFileSize f+		return (size' == size)+	Nothing -> return True+ warnUnverifiableInsecure :: Key -> Annex () warnUnverifiableInsecure k = warning $ unwords 	[ "Getting " ++ kv ++ " keys with this remote is not secure;"@@ -112,3 +169,144 @@ 			Nothing -> return Nothing 		, return Nothing 		)++finishVerifyKeyContentIncrementally :: Maybe IncrementalVerifier -> Annex (Bool, Verification)+finishVerifyKeyContentIncrementally Nothing = +	return (True, UnVerified)+finishVerifyKeyContentIncrementally (Just iv) =+	liftIO (finalizeIncremental iv) >>= \case+		Just True -> return (True, Verified)+		Just False -> do+			warning "verification of content failed"+			return (False, UnVerified)+		-- Incremental verification was not able to be done.+		Nothing -> return (True, UnVerified)++-- | Reads the file as it grows, and feeds it to the incremental verifier.+-- +-- The TMVar must start out empty, and be filled once whatever is+-- writing to the file finishes. Once the writer finishes, this returns+-- quickly. It may not feed the entire content of the file to the+-- incremental verifier.+--+-- The file does not need to exist yet when this is called. It will wait+-- for the file to appear before opening it and starting verification.+--+-- This is not supported for all OSs, and on OS's where it is not+-- supported, verification will not happen.+--+-- The writer probably needs to be another process. If the file is being+-- written directly by git-annex, the haskell RTS will prevent opening it+-- for read at the same time, and verification will not happen.+--+-- Note that there are situations where the file may fail to verify despite+-- having the correct content. For example, when the file is written out+-- of order, or gets replaced part way through. To deal with such cases,+-- when verification fails, it should not be treated as if the file's+-- content is known to be incorrect, but instead as an indication that the+-- file should be verified again, once it's done being written to.+--+-- (It is also possible, in theory, for a file to verify despite having+-- incorrect content. For that to happen, the file would need to have+-- the right content when this checks it, but then the content gets+-- changed later by whatever is writing to the file.)+--+-- This should be fairly efficient, reading from the disk cache,+-- as long as the writer does not get very far ahead of it. However,+-- there are situations where it would be much less expensive to verify+-- chunks as they are being written. For example, when resuming with+-- a lot of content in the file, all that content needs to be read,+-- and if the disk is slow, the reader may never catch up to the writer,+-- and the disk cache may never speed up reads. So this should only be+-- used when there's not a better way to incrementally verify.+tailVerify :: IncrementalVerifier -> RawFilePath -> TMVar () -> IO ()+#if WITH_INOTIFY+tailVerify iv f finished = +	tryNonAsync go >>= \case+		Right r -> return r+		Left _ -> unableIncremental iv+  where+	-- Watch the directory containing the file, and wait for+	-- the file to be modified. It's possible that the file already+	-- exists before the downloader starts, but it replaces it instead+	-- of resuming, and waiting for modification deals with such+	-- situations.+	inotifydirchange i cont =+		INotify.addWatch i [INotify.Modify] dir $ \case+			-- Ignore changes to other files in the directory.+			INotify.Modified { INotify.maybeFilePath = fn }+				| fn == Just basef -> cont+			_ -> noop+	  where+		(dir, basef) = P.splitFileName f+	+	inotifyfilechange i = INotify.addWatch i [INotify.Modify] f . const++	go = INotify.withINotify $ \i -> do+		modified <- newEmptyTMVarIO+		let signalmodified = atomically $ void $ tryPutTMVar modified ()+		wd <- inotifydirchange i signalmodified+		let cleanup = void . tryNonAsync . INotify.removeWatch+		let stop w = do+			cleanup w+			unableIncremental iv+		waitopen modified >>= \case+			Nothing -> stop wd+			Just h -> do+				cleanup wd+				wf <- inotifyfilechange i signalmodified+				tryNonAsync (follow h modified) >>= \case+					Left _ -> stop wf+					Right () -> cleanup wf+				hClose h++	waitopen modified = do+		v <- atomically $+			(Just <$> takeTMVar modified)+				`orElse` +			((const Nothing) <$> takeTMVar finished)+		case v of+			Just () -> do+				r <- tryNonAsync $+					tryWhenExists (openBinaryFile (fromRawFilePath f) ReadMode) >>= \case+						Just h -> return (Just h)+						-- File does not exist, must have been+						-- deleted. Wait for next modification+						-- and try again.+						Nothing -> waitopen modified+				case r of+					Right r' -> return r'+					-- Permission error prevents+					-- reading, or this same process+					-- is writing to the file,+					-- and it cannot be read at the+					-- same time.+					Left _ -> return Nothing+			-- finished without the file being modified+			Nothing -> return Nothing+	+	follow h modified = do+		b <- S.hGetNonBlocking h chunk+		if S.null b+			then do+				-- We've caught up to the writer.+				-- Wait for the file to get modified again,+				-- or until we're told it is done being+				-- written.+				cont <- atomically $+					(const (follow h modified)+						<$> takeTMVar modified)+							`orElse`+					(const (return ())+						<$> takeTMVar finished)+				cont+			else do+				updateIncremental iv b+				atomically (tryTakeTMVar finished) >>= \case+					Nothing -> follow h modified+					Just () -> return ()++	chunk = 65536+#else+tailVerify iv _ _ = unableIncremental iv+#endif

@@ -36,7 +36,7 @@  - So, from dir/subdir/file.foo, generate file_%dir%subdir%.foo  -} viewedFileFromReference :: MkViewedFile-viewedFileFromReference f = concat+viewedFileFromReference f = concat $ 	[ escape (fromRawFilePath base) 	, if null dirs then "" else "_%" ++ intercalate "%" (map escape dirs) ++ "%" 	, escape $ fromRawFilePath $ S.concat extensions@@ -44,7 +44,13 @@   where 	(path, basefile) = splitFileName f 	dirs = filter (/= ".") $ map dropTrailingPathSeparator (splitPath path)-	(base, extensions) = splitShortExtensions (toRawFilePath basefile)+	(base, extensions) = splitShortExtensions (toRawFilePath basefile')+	+	{- On Windows, if the filename looked like "dir/c:foo" then+	 - basefile would look like it contains a drive letter, which will+	 - not work. There cannot really be a filename like that, probably,+	 - but it prevents the test suite failing. -}+	(_basedrive, basefile') = splitDrive basefile  	{- To avoid collisions with filenames or directories that contain 	 - '%', and to allow the original directories to be extracted

@@ -1,6 +1,6 @@ {- youtube-dl integration for git-annex  -- - Copyright 2017-2020 Joey Hess <id@joeyh.name>+ - Copyright 2017-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -68,7 +68,7 @@  youtubeDl' :: URLString -> FilePath -> MeterUpdate -> UrlOptions -> Annex (Either String (Maybe FilePath)) youtubeDl' url workdir p uo-	| supportedScheme uo url = ifM (liftIO $ inSearchPath "youtube-dl")+	| supportedScheme uo url = ifM (liftIO . inSearchPath =<< youtubeDlCommand) 		( runcmd >>= \case 			Right True -> workdirfiles >>= \case 				(f:[]) -> return (Right (Just f))@@ -88,6 +88,7 @@ 	runcmd = youtubeDlMaxSize workdir >>= \case 		Left msg -> return (Left msg) 		Right maxsize -> do+			cmd <- youtubeDlCommand 			opts <- youtubeDlOpts (dlopts ++ maxsize) 			oh <- mkOutputHandlerQuiet 			-- The size is unknown to start. Once youtube-dl@@ -97,7 +98,7 @@ 			let unknownsize = Nothing :: Maybe FileSize 			ok <- metered (Just p) unknownsize $ \meter meterupdate -> 				liftIO $ commandMeter' -					parseYoutubeDlProgress oh (Just meter) meterupdate "youtube-dl" opts+					parseYoutubeDlProgress oh (Just meter) meterupdate cmd opts 					(\pr -> pr { cwd = Just workdir }) 			return (Right ok) 	dlopts = @@ -181,7 +182,8 @@ youtubeDlCheck' url uo 	| supportedScheme uo url = catchMsgIO $ htmlOnly url False $ do 		opts <- youtubeDlOpts [ Param url, Param "--simulate" ]-		liftIO $ snd <$> processTranscript "youtube-dl" (toCommand opts) Nothing+		cmd <- youtubeDlCommand+		liftIO $ snd <$> processTranscript cmd (toCommand opts) Nothing 	| otherwise = return (Right False)  -- Ask youtube-dl for the filename of media in an url.@@ -218,7 +220,8 @@ 			, Param "--no-warnings" 			, Param "--no-playlist" 			]-		let p = (proc "youtube-dl" (toCommand opts))+		cmd <- youtubeDlCommand+		let p = (proc cmd (toCommand opts)) 			{ std_out = CreatePipe 			, std_err = CreatePipe 			}@@ -244,6 +247,10 @@ youtubeDlOpts addopts = do 	opts <- map Param . annexYoutubeDlOptions <$> Annex.getGitConfig 	return (opts ++ addopts)++youtubeDlCommand :: Annex String+youtubeDlCommand = fromMaybe "yooutube-dl" . annexYoutubeDlCommand +	<$> Annex.getGitConfig  supportedScheme :: UrlOptions -> URLString -> Bool supportedScheme uo url = case parseURIRelaxed url of

@@ -265,6 +265,7 @@ 	let lockdownconfig = LockDownConfig 		{ lockingFile = False 		, hardlinkFileTmpDir = Just (toRawFilePath lockdowndir)+		, checkWritePerms = True 		} 	(postponed, toadd) <- partitionEithers 		<$> safeToAdd lockdowndir lockdownconfig havelsof delayadd pending inprocess@@ -310,6 +311,7 @@ 		let cfg = LockDownConfig 			{ lockingFile = False 			, hardlinkFileTmpDir = Just (toRawFilePath lockdowndir)+			, checkWritePerms = True 			} 		if M.null m 			then forM toadd (addannexed' cfg)

@@ -118,6 +118,6 @@ 	n = '/' : Git.fromRef Annex.Branch.name  fileToBranch :: FilePath -> Git.Ref-fileToBranch f = Git.Ref $ encodeBS' $ "refs" </> base+fileToBranch f = Git.Ref $ encodeBS $ "refs" </> base   where 	base = Prelude.last $ split "/refs/" f

@@ -321,7 +321,7 @@ addLink file link mk = do 	debug ["add symlink", file] 	liftAnnex $ do-		v <- catObjectDetails $ Ref $ encodeBS' $ ':':file+		v <- catObjectDetails $ Ref $ encodeBS $ ':':file 		case v of 			Just (currlink, sha, _type) 				| L.fromStrict link == currlink ->

@@ -326,8 +326,8 @@ 	liftIO $ withTmpDir "git-annex.tmp" $ \tmpdir -> do 		let infof = tmpdir </> "info" 		let sigf = infof ++ ".sig"-		ifM (isRight <$> Url.download nullMeterUpdate distributionInfoUrl infof uo-			<&&> (isRight <$> Url.download nullMeterUpdate distributionInfoSigUrl sigf uo)+		ifM (isRight <$> Url.download nullMeterUpdate Nothing distributionInfoUrl infof uo+			<&&> (isRight <$> Url.download nullMeterUpdate Nothing distributionInfoSigUrl sigf uo) 			<&&> verifyDistributionSig gpgcmd sigf) 			( parseInfoFile <$> readFileStrict infof 			, return Nothing

@@ -102,7 +102,7 @@ 			 - there's not. Special remotes don't normally 			 - have that, and don't use it. Temporarily add 			 - it if it's missing. -}-			let remotefetch = Git.ConfigKey $ encodeBS' $+			let remotefetch = Git.ConfigKey $ encodeBS $ 				"remote." ++ T.unpack (repoName oldc) ++ ".fetch" 			needfetch <- isNothing <$> fromRepo (Git.Config.getMaybe remotefetch) 			when needfetch $

@@ -239,7 +239,7 @@ 		warning msg  externalBackendProgram :: ExternalBackendName -> String-externalBackendProgram (ExternalBackendName bname) = "git-annex-backend-X" ++ decodeBS' bname+externalBackendProgram (ExternalBackendName bname) = "git-annex-backend-X" ++ decodeBS bname  -- Runs an action with an ExternalState, starting a new external backend -- process if necessary. It is returned to the pool once the action

@@ -28,7 +28,6 @@ import qualified Data.ByteString.Lazy as L import Control.DeepSeq import Control.Exception (evaluate)-import Data.IORef  data Hash 	= MD5Hash@@ -124,7 +123,7 @@ 	exists <- liftIO $ R.doesPathExist file 	case (exists, fast) of 		(True, False) -> do-			showAction "checksum"+			showAction descChecksum 			sameCheckSum key  				<$> hashFile hash file nullMeterUpdate 		_ -> return True@@ -221,7 +220,7 @@ hasher (Blake2spHash hashsize) = blake2spHasher hashsize  mkHasher :: HashAlgorithm h => (L.ByteString -> Digest h) -> Context h -> Hasher-mkHasher h c = (show . h, mkIncrementalVerifier c)+mkHasher h c = (show . h, mkIncrementalVerifier c descChecksum . sameCheckSum)  sha2Hasher :: HashSize -> Hasher sha2Hasher (HashSize hashsize)@@ -278,16 +277,8 @@ md5Hasher :: Hasher md5Hasher = mkHasher md5 md5_context -mkIncrementalVerifier :: HashAlgorithm h => Context h -> Key -> IO IncrementalVerifier-mkIncrementalVerifier ctx key = do-	v <- newIORef ctx-	return $ IncrementalVerifier-		{ updateIncremental = modifyIORef' v . flip hashUpdate-		, finalizeIncremental = do-			ctx' <- readIORef v-			let digest = hashFinalize ctx'-			return $ sameCheckSum key (show digest)-		}+descChecksum :: String+descChecksum = "checksum"  {- A varient of the SHA256E backend, for testing that needs special keys  - that cannot collide with legitimate keys in the repository.

@@ -28,10 +28,10 @@ genKeyName :: String -> S.ByteString genKeyName s 	-- Avoid making keys longer than the length of a SHA256 checksum.-	| bytelen > sha256len = encodeBS' $+	| bytelen > sha256len = encodeBS $ 		truncateFilePath (sha256len - md5len - 1) s' ++ "-" ++  			show (md5 bl)-	| otherwise = encodeBS' s'+	| otherwise = encodeBS s'   where 	s' = preSanitizeKeyName s 	bl = encodeBL s@@ -59,8 +59,11 @@ 	es = filter (not . S.null) $ reverse $ 		take 2 $ filter (S.all validInExtension) $ 		takeWhile shortenough $-		reverse $ S.split (fromIntegral (ord '.')) (P.takeExtensions f)+		reverse $ S.split (fromIntegral (ord '.')) (P.takeExtensions f') 	shortenough e = S.length e <= fromMaybe maxExtensionLen maxlen+	-- Avoid treating a file ".foo" as having its whole name as an+	-- extension.+	f' = S.dropWhile (== fromIntegral (ord '.')) (P.takeFileName f)  validInExtension :: Word8 -> Bool validInExtension c

@@ -25,6 +25,7 @@ 	, testCp "cp_p" "-p" 	, testCp "cp_preserve_timestamps" "--preserve=timestamps" 	, testCpReflinkAuto+	, testCpNoPreserveXattr 	, TestCase "xargs -0" $ testCmd "xargs_0" "xargs -0 </dev/null" 	, TestCase "rsync" $ testCmd "rsync" "rsync --version >/dev/null" 	, TestCase "curl" $ testCmd "curl" "curl --version >/dev/null"@@ -61,6 +62,11 @@ #endif   where 	k = "cp_reflink_supported"++testCpNoPreserveXattr :: TestCase+testCpNoPreserveXattr = testCp +	"cp_no_preserve_xattr_supported" +	"--no-preserve=xattr"  getUpgradeLocation :: Test getUpgradeLocation = do

@@ -1,3 +1,39 @@+git-annex (8.20210903) upstream; urgency=medium++  * Deal with clock skew, both forwards and backwards, when logging+    information to the git-annex branch.+  * GIT_ANNEX_VECTOR_CLOCK can now be set to a fixed value (eg 1)+    rather than needing to be advanced each time a new change is made.+  * Misuse of GIT_ANNEX_VECTOR_CLOCK will no longer confuse git-annex.+  * add: When adding a dotfile, avoid treating its name as an extension.+  * rsync special remote: Stop displaying rsync progress, and use+    git-annex's own progress display.+  * Many special remotes now checksum content while it is being retrieved,+    instead of in a separate pass at the end. This is supported for all+    special remotes on Linux (except for bittorrent), and for many+    on other OS's (except for adb, external, gcrypt, hook, and rsync).+  * unused: Skip the refs/annex/last-index ref that git-annex recently+    started creating.+  * Fix test suite failure on Windows.+  * New --batch-keys option added to these commands: +    get, drop, move, copy, whereis+  * Added annex.youtube-dl-command config. This can be used to run some+    forks of youtube-dl.+  * Run cp -a with --no-preserve=xattr, to avoid problems with copied+    xattrs, including them breaking permissions setting on some NFS+    servers.+  * add, import: Detect when xattrs or perhaps ACLs prevent removing+    write permissions from an annexed file, and fail with an informative+    message.+  * Fix support for readonly git remotes.+    (Reversion in version 8.20210621)+  * When downloading urls fail, explain which urls failed for which+    reasons.+  * web: Avoid displaying a warning when downloading one url failed+    but another url later succeeded.++ -- Joey Hess <id@joeyh.name>  Fri, 03 Sep 2021 12:00:46 -0400+ git-annex (8.20210803) upstream; urgency=medium    * whereused: New command, finds what files use a key, or where a key

@@ -1,6 +1,6 @@ {- git-annex batch commands  -- - Copyright 2015-2020 Joey Hess <id@joeyh.name>+ - Copyright 2015-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -24,23 +24,43 @@  data BatchMode = Batch BatchFormat | NoBatch -data BatchFormat = BatchLine | BatchNull+data BatchFormat = BatchFormat BatchSeparator BatchKeys -parseBatchOption :: Parser BatchMode-parseBatchOption = go +data BatchSeparator = BatchLine | BatchNull++newtype BatchKeys = BatchKeys Bool++parseBatchOption :: Bool -> Parser BatchMode+parseBatchOption supportbatchkeysoption = go  	<$> switch 		( long "batch"-		<> help "enable batch mode"+		<> help batchhelp 		)-	<*> switch+	<*> batchkeysswitch+	<*> flag BatchLine BatchNull 		( short 'z' 		<> help "null delimited batch input" 		)   where-	go True False = Batch BatchLine- 	go True True = Batch BatchNull-	go False _ = NoBatch+	go True False batchseparator = +		Batch (BatchFormat batchseparator (BatchKeys False))+	go _ True batchseparator = +		Batch (BatchFormat batchseparator (BatchKeys True))+	go _ _ _ = NoBatch +	batchhelp = "enable batch mode" +++		if supportbatchkeysoption+			then ", with files input"+			else ""+	batchkeyshelp = "enable batch mode, with keys input"++	batchkeysswitch+		| supportbatchkeysoption = switch+			( long "batch-keys"+			<> help batchkeyshelp+			)+		| otherwise = pure False+ -- 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 -- stdout. In non batch mode, the command's parameters are parsed and@@ -52,7 +72,7 @@   where 	batchparser = (,,) 		<$> parser-		<*> parseBatchOption+		<*> parseBatchOption False 		<*> cmdParams paramdesc 	 	batchseeker (opts, NoBatch, params) =@@ -68,7 +88,7 @@ -- mode, exit on bad input. batchBadInput :: BatchMode -> Annex () batchBadInput NoBatch = liftIO exitFailure-batchBadInput (Batch _) = liftIO $ putStrLn ""+batchBadInput _ = liftIO $ putStrLn ""  -- Reads lines of batch mode input, runs a parser, and passes the result -- to the action.@@ -87,12 +107,12 @@ 	parseerr s = giveup $ "Batch input parse failure: " ++ s  batchLines :: BatchFormat -> Annex [String]-batchLines fmt = do+batchLines (BatchFormat sep _) = do 	checkBatchConcurrency 	enableInteractiveBranchAccess 	liftIO $ splitter <$> getContents   where-	splitter = case fmt of+	splitter = case sep of 		BatchLine -> lines 		BatchNull -> splitc '\0' @@ -116,37 +136,76 @@ batchCommandStart a = a >>= \case 	Just v -> return (Just v) 	Nothing -> do-		batchBadInput (Batch BatchLine)+		batchBadInput (Batch (BatchFormat BatchLine (BatchKeys False))) 		return Nothing  -- Reads lines of batch input and passes the filepaths to a CommandStart -- to handle them. ----- Absolute filepaths are converted to relative, because in non-batch--- mode, that is done when CmdLine.Seek uses git ls-files.--- -- File matching options are checked, and non-matching files skipped.-batchFilesMatching :: BatchFormat -> ((SeekInput, RawFilePath) -> CommandStart) -> Annex ()-batchFilesMatching fmt a = do+batchFiles :: BatchFormat -> ((SeekInput, RawFilePath) -> CommandStart) -> Annex ()+batchFiles fmt a = batchFilesKeys fmt $ \(si, v) -> case v of+	Right f -> a (si, f)+	Left _k -> return Nothing++batchFilesKeys :: BatchFormat -> ((SeekInput, Either Key RawFilePath) -> CommandStart) -> Annex ()+batchFilesKeys fmt a = do 	matcher <- getMatcher-	go $ \si f ->-		let f' = toRawFilePath f-		in ifM (matcher $ MatchingFile $ FileInfo f' f' Nothing)-			( a (si, f')-			, return Nothing-			)+	go $ \si v -> case v of+		Right f -> +			let f' = toRawFilePath f+			in ifM (matcher $ MatchingFile $ FileInfo f' f' Nothing)+				( a (si, Right f')+				, return Nothing+				)+		Left k -> a (si, Left k)   where-	go a' = batchInput fmt -		(Right . fromRawFilePath <$$> liftIO . relPathCwdToFile . toRawFilePath)-		(batchCommandAction . uncurry a')+	go a' = batchInput fmt parser (batchCommandAction . uncurry a')+	parser = case fmt of+		-- Absolute filepaths are converted to relative,+		-- because in non-batch mode, that is done when+		-- CmdLine.Seek uses git ls-files.+		BatchFormat _ (BatchKeys False) -> +			Right . Right . fromRawFilePath +				<$$> liftIO . relPathCwdToFile . toRawFilePath+		BatchFormat _ (BatchKeys True) -> \i ->+			pure $ case deserializeKey i of+				Just k -> Right (Left k)+				Nothing -> Left "not a valid key" -batchAnnexedFilesMatching :: BatchFormat -> AnnexedFileSeeker -> Annex ()-batchAnnexedFilesMatching fmt seeker = batchFilesMatching fmt $ \(si, bf) ->-	flip whenAnnexed bf $ \f k -> -		case checkContentPresent seeker of-			Just v -> do-				present <- inAnnex k-				if present == v-					then startAction seeker si f k-					else return Nothing-			Nothing -> startAction seeker si f k+batchAnnexedFiles :: BatchFormat -> AnnexedFileSeeker -> Annex ()+batchAnnexedFiles fmt seeker = batchAnnexed fmt seeker (const (return Nothing))++-- Reads lines of batch input and passes filepaths to the AnnexedFileSeeker+-- to handle them. Or, with --batch-keys, passes keys to the keyaction.+--+-- Matching options are checked, and non-matching items skipped.+batchAnnexed :: BatchFormat -> AnnexedFileSeeker -> ((SeekInput, Key, ActionItem) -> CommandStart) -> Annex ()+batchAnnexed fmt seeker keyaction = do+	matcher <- getMatcher+	batchFilesKeys fmt $ \(si, v) ->+		case v of+			Right bf -> flip whenAnnexed bf $ \f k ->+				checkpresent k $+					startAction seeker si f k+			Left k -> ifM (matcher (MatchingInfo (mkinfo k)))+				( checkpresent k $+					keyaction (si, k, mkActionItem k)+				, return Nothing)+  where+	checkpresent k cont = case checkContentPresent seeker of+		Just v -> do+			present <- inAnnex k+			if present == v+				then cont+				else return Nothing+		Nothing -> cont+	+	mkinfo k = ProvidedInfo+		{ providedFilePath = Nothing+		, providedKey = Just k+		, providedFileSize = Nothing+		, providedMimeType = Nothing+		, providedMimeEncoding = Nothing+		, providedLinkType = Nothing+		}

@@ -79,7 +79,7 @@ 		-- Also set in git config so it will be passed on to any 		-- git-annex child processes. 		, setAnnexState $ Annex.addGitConfigOverride $-			decodeBS' $ debugconfig <> "=" <> boolConfig' v+			decodeBS $ debugconfig <> "=" <> boolConfig' v 		] 	 	setdebugfilter v = mconcat@@ -88,7 +88,7 @@ 		-- Also set in git config so it will be passed on to any 		-- git-annex child processes. 		, setAnnexState $ Annex.addGitConfigOverride $ -			decodeBS' (debugfilterconfig <> "=") ++ v+			decodeBS (debugfilterconfig <> "=") ++ v 		] 	 	(ConfigKey debugconfig) = annexConfig "debug"

@@ -50,7 +50,7 @@ optParser :: CmdParamsDesc -> Parser AddOptions optParser desc = AddOptions 	<$> cmdParams desc-	<*> parseBatchOption+	<*> parseBatchOption False 	<*> switch 		( long "update" 		<> short 'u'@@ -95,7 +95,7 @@ 		Batch fmt 			| updateOnly o -> 				giveup "--update --batch is not supported"-			| otherwise -> batchFilesMatching fmt gofile+			| otherwise -> batchFiles fmt gofile 		NoBatch -> do 			-- Avoid git ls-files complaining about files that 			-- are not known to git yet, since this will add@@ -188,6 +188,7 @@ 	let cfg = LockDownConfig 		{ lockingFile = lockingfile 		, hardlinkFileTmpDir = Just tmpdir+		, checkWritePerms = True 		} 	ld <- lockDown cfg (fromRawFilePath file) 	let sizer = keySource <$> ld

@@ -76,7 +76,7 @@ 		<> help "add a suffix to the filename" 		)) 	<*> parseDownloadOptions True-	<*> parseBatchOption+	<*> parseBatchOption False 	<*> switch 		( long "with-files" 		<> help "parse batch mode lines of the form \"$url $file\""@@ -201,7 +201,8 @@ 			-- should use to download it. 			setTempUrl urlkey loguri 			let downloader = \dest p ->-				fst <$> Remote.verifiedAction (Remote.retrieveKeyFile r urlkey af dest p)+				fst <$> Remote.verifiedAction+					(Remote.retrieveKeyFile r urlkey af dest p (RemoteVerify r)) 			ret <- downloadWith canadd addunlockedmatcher downloader urlkey (Remote.uuid r) loguri file 			removeTempUrl urlkey 			return ret@@ -313,7 +314,7 @@ 	go =<< downloadWith' downloader urlkey webUUID url (AssociatedFile (Just file))   where 	urlkey = addSizeUrlKey urlinfo $ Backend.URL.fromUrl url Nothing-	downloader f p = Url.withUrlOptions $ downloadUrl urlkey p [url] f+	downloader f p = Url.withUrlOptions $ downloadUrl False urlkey p Nothing [url] f 	go Nothing = return Nothing 	go (Just tmp) = ifM (pure (not (rawOption o)) <&&> liftIO (isHtmlFile (fromRawFilePath tmp))) 		( tryyoutubedl tmp

@@ -26,7 +26,7 @@ optParser :: CmdParamsDesc -> Parser CheckPresentKeyOptions optParser desc = CheckPresentKeyOptions 	<$> cmdParams desc-	<*> parseBatchOption+	<*> parseBatchOption False  seek :: CheckPresentKeyOptions -> CommandSeek seek o = case batchOption o of

@@ -55,23 +55,23 @@  seek :: Action -> CommandSeek seek (SetConfig ck@(ConfigKey name) val) = checkIsGlobalConfig ck $ commandAction $-	startingUsualMessages (decodeBS' name) ai si $ do+	startingUsualMessages (decodeBS name) ai si $ do 		setGlobalConfig ck val 		when (needLocalUpdate ck) $ 			setConfig ck (fromConfigValue val) 		next $ return True   where 	ai = ActionItemOther (Just (fromConfigValue val))-	si = SeekInput [decodeBS' name]+	si = SeekInput [decodeBS name] seek (UnsetConfig ck@(ConfigKey name)) = checkIsGlobalConfig ck $ commandAction $-	startingUsualMessages (decodeBS' name) ai si $ do+	startingUsualMessages (decodeBS name) ai si $ do 		unsetGlobalConfig ck 		when (needLocalUpdate ck) $ 			unsetConfig ck 		next $ return True   where 	ai = ActionItemOther (Just "unset")-	si = SeekInput [decodeBS' name]+	si = SeekInput [decodeBS name] seek (GetConfig ck) = checkIsGlobalConfig ck $ commandAction $ 	startingCustomOutput ai $ do 		getGlobalConfig ck >>= \case

@@ -33,7 +33,7 @@ 	<*> parseFromToHereOptions 	<*> optional (parseKeyOptions <|> parseFailedTransfersOption) 	<*> parseAutoOption-	<*> parseBatchOption+	<*> parseBatchOption True  instance DeferredParseClass CopyOptions where 	finishParse v = CopyOptions@@ -48,10 +48,10 @@ 	case batchOption o of 		NoBatch -> withKeyOptions 			(keyOptions o) (autoMode o) seeker-			(commandAction . Command.Move.startKey (fromToOptions o) Command.Move.RemoveNever)+			(commandAction . keyaction) 			(withFilesInGitAnnex ww seeker) 			=<< workTreeItems ww (copyFiles o)-		Batch fmt -> batchAnnexedFilesMatching fmt seeker+		Batch fmt -> batchAnnexed fmt seeker keyaction   where 	ww = WarnUnmatchLsFiles 	@@ -63,6 +63,7 @@ 			Left ToHere -> Just False 		, usesLocationLog = True 		}+	keyaction = Command.Move.startKey (fromToOptions o) Command.Move.RemoveNever  {- A copy is just a move that does not delete the source file.  - However, auto mode avoids unnecessary copies, and avoids getting or

@@ -89,7 +89,7 @@ 	check rOldFile rOldMode (\r f -> r { rOldFile = f }) req 		>>= check rNewFile rNewMode (\r f -> r { rNewFile = f })   where-	check getfile getmode setfile r = case readTreeItemType (encodeBS' (getmode r)) of+	check getfile getmode setfile r = case readTreeItemType (encodeBS (getmode r)) of 		Just TreeSymlink -> do 			v <- getAnnexLinkTarget' f False 			maybe (return r) repoint (parseLinkTargetOrPointer =<< v)

@@ -41,7 +41,7 @@ 	<*> optional parseDropFromOption 	<*> parseAutoOption 	<*> optional parseKeyOptions-	<*> parseBatchOption+	<*> parseBatchOption True  parseDropFromOption :: Parser (DeferredParse Remote) parseDropFromOption = parseRemoteOption <$> strOption@@ -67,11 +67,11 @@ 		, usesLocationLog = True 		} 	case batchOption o of-		Batch fmt -> batchAnnexedFilesMatching fmt seeker 		NoBatch -> withKeyOptions (keyOptions o) (autoMode o) seeker 			(commandAction . startKeys o from) 			(withFilesInGitAnnex ww seeker) 			=<< workTreeItems ww (dropFiles o)+		Batch fmt -> batchAnnexed fmt seeker (startKeys o from)   where 	ww = WarnUnmatchLsFiles 

@@ -27,7 +27,7 @@ optParser :: CmdParamsDesc -> Parser DropKeyOptions optParser desc = DropKeyOptions 	<$> cmdParams desc-	<*> parseBatchOption+	<*> parseBatchOption False  seek :: DropKeyOptions -> CommandSeek seek o = do

@@ -39,7 +39,7 @@ 	<$> cmdParams desc 	<*> optional parseFormatOption 	<*> optional parseBranchKeysOption-	<*> parseBatchOption+	<*> parseBatchOption False  parseFormatOption :: Parser Utility.Format.Format parseFormatOption = @@ -69,7 +69,7 @@ 			(commandAction . startKeys o) 			(withFilesInGitAnnex ww seeker) 			=<< workTreeItems ww (findThese o)-		Batch fmt -> batchAnnexedFilesMatching fmt seeker+		Batch fmt -> batchAnnexedFiles fmt seeker   where 	ww = WarnUnmatchLsFiles 

@@ -22,6 +22,6 @@   where 	o' = o  		{ Find.keyOptions = Just $ WantBranchKeys $-			map (Git.Ref . encodeBS') (Find.findThese o)+			map (Git.Ref . encodeBS) (Find.findThese o) 		, Find.findThese = [] 		}

@@ -35,7 +35,7 @@ optParser :: CmdParamsDesc -> Parser FromKeyOptions optParser desc = FromKeyOptions 	<$> cmdParams desc-	<*> parseBatchOption+	<*> parseBatchOption False  seek :: FromKeyOptions -> CommandSeek seek o = do@@ -43,7 +43,7 @@ 	case (batchOption o, keyFilePairs o) of 		(Batch fmt, _) -> seekBatch matcher fmt 		-- older way of enabling batch input, does not support BatchNull-		(NoBatch, []) -> seekBatch matcher BatchLine+		(NoBatch, []) -> seekBatch matcher (BatchFormat BatchLine (BatchKeys False)) 		(NoBatch, ps) -> do 			force <- Annex.getState Annex.force 			withPairs (commandAction . start matcher force) ps

@@ -199,7 +199,7 @@ 			) 		, return Nothing 		)-	getfile' tmp = Remote.retrieveKeyFile remote key (AssociatedFile Nothing) (fromRawFilePath tmp) dummymeter+	getfile' tmp = Remote.retrieveKeyFile remote key (AssociatedFile Nothing) (fromRawFilePath tmp) dummymeter (RemoteVerify remote) 	dummymeter _ = noop 	getcheap tmp = case Remote.retrieveKeyFileCheap remote of 		Just a -> isRight <$> tryNonAsync (a key afile (fromRawFilePath tmp))@@ -260,8 +260,9 @@ 			KeyUnlockedThin -> thawContent obj 			KeyLockedThin -> thawContent obj 			_ -> freezeContent obj-		unlessM (isContentWritePermOk obj) $-			warning $ "** Unable to set correct write mode for " ++ fromRawFilePath obj ++ " ; perhaps you don't own that file"+		checkContentWritePerm obj >>= \case+			Nothing -> warning $ "** Unable to set correct write mode for " ++ fromRawFilePath obj ++ " ; perhaps you don't own that file, or perhaps it has an xattr or ACL set"+			_ -> return () 	whenM (liftIO $ R.doesPathExist $ parentDir obj) $ 		freezeContentDir obj @@ -292,7 +293,7 @@ 			fix InfoMissing 			warning $ 				"** Based on the location log, " ++-				decodeBS' (actionItemDesc ai) +++				decodeBS (actionItemDesc ai) ++ 				"\n** was expected to be present, " ++ 				"but its content is missing." 			return False@@ -332,7 +333,7 @@ 				missingrequired <- Remote.prettyPrintUUIDs "missingrequired" missinglocs 				warning $ 					"** Required content " ++-					decodeBS' (actionItemDesc ai) +++					decodeBS (actionItemDesc ai) ++ 					" is missing from these repositories:\n" ++ 					missingrequired 				return False@@ -406,7 +407,7 @@ 	badsize a b = do 		msg <- bad key 		warning $ concat-			[ decodeBS' (actionItemDesc ai)+			[ decodeBS (actionItemDesc ai) 			, ": Bad file size (" 			, compareSizes storageUnits True a b 			, "); "@@ -424,11 +425,11 @@ 	case Types.Backend.canUpgradeKey backend of 		Just a | a key -> do 			warning $ concat-				[ decodeBS' (actionItemDesc ai)+				[ decodeBS (actionItemDesc ai) 				, ": Can be upgraded to an improved key format. " 				, "You can do so by running: git annex migrate --backend=" 				, decodeBS (formatKeyVariety (fromKey keyVariety key)) ++ " "-				, decodeBS' file+				, decodeBS file 				] 			return True 		_ -> return True@@ -475,7 +476,7 @@ 			unless ok $ do 				msg <- bad key 				warning $ concat-					[ decodeBS' (actionItemDesc ai)+					[ decodeBS (actionItemDesc ai) 					, ": Bad file content; " 					, msg 					]@@ -503,7 +504,7 @@ 					Nothing -> noop 					Just ic' -> whenM (compareInodeCaches ic ic') $ do 						warning $ concat-							[ decodeBS' (actionItemDesc ai)+							[ decodeBS (actionItemDesc ai) 							, ": Stale or missing inode cache; updating." 							] 						Database.Keys.addInodeCaches key [ic]

@@ -34,7 +34,7 @@ 	<*> optional (parseRemoteOption <$> parseFromOption) 	<*> parseAutoOption 	<*> optional (parseIncompleteOption <|> parseKeyOptions <|> parseFailedTransfersOption)-	<*> parseBatchOption+	<*> parseBatchOption True  seek :: GetOptions -> CommandSeek seek o = startConcurrency downloadStages $ do@@ -49,7 +49,7 @@ 			(commandAction . startKeys from) 			(withFilesInGitAnnex ww seeker) 			=<< workTreeItems ww (getFiles o)-		Batch fmt -> batchAnnexedFilesMatching fmt seeker+		Batch fmt -> batchAnnexed fmt seeker (startKeys from)   where 	ww = WarnUnmatchLsFiles 

@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2012-2020 Joey Hess <id@joeyh.name>+ - Copyright 2012-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -85,7 +85,7 @@ 			[bs] ->  				let (branch, subdir) = separate (== ':') bs 				in RemoteImportOptions r-					(Ref (encodeBS' branch))+					(Ref (encodeBS branch)) 					(if null subdir then Nothing else Just subdir) 					content 					ic@@ -200,13 +200,31 @@ 		-- Move or copy the src file to the dest file. 		-- The dest file is what will be ingested. 		createWorkTreeDirectory (parentDir destfile)-		liftIO $ if mode == Duplicate || mode == SkipDuplicates-			then void $ copyFileExternal CopyAllMetaData -				(fromRawFilePath srcfile)-				(fromRawFilePath destfile)-			else moveFile -				(fromRawFilePath srcfile)-				(fromRawFilePath destfile)+		unwind <- liftIO $ if mode == Duplicate || mode == SkipDuplicates+			then do+				void $ copyFileExternal CopyAllMetaData +					(fromRawFilePath srcfile)+					(fromRawFilePath destfile)+				return $ removeWhenExistsWith R.removeLink destfile+			else do+				moveFile +					(fromRawFilePath srcfile)+					(fromRawFilePath destfile)+				return $ moveFile+					(fromRawFilePath destfile)+					(fromRawFilePath srcfile)+		-- Make sure that the dest file has its write permissions+		-- removed; the src file normally already did, but may+		-- have imported it from a filesystem that does not allow+		-- removing write permissions, to a repo on a filesystem+		-- that does.+		when (lockingFile (lockDownConfig ld)) $ do+			freezeContent destfile+			checkLockedDownWritePerms destfile srcfile >>= \case+				Just err -> do+					liftIO unwind+					giveup err+				Nothing -> noop 		-- Get the inode cache of the dest file. It should be 		-- weakly the same as the originally locked down file's 		-- inode cache. (Since the file may have been copied,@@ -249,6 +267,12 @@ 		let cfg = LockDownConfig 			{ lockingFile = lockingfile 			, hardlinkFileTmpDir = Nothing+			-- The write perms of the file may not be able to be+			-- removed, if it's being imported from a crippled+			-- filesystem. So lockDown is asked to not check+			-- the write perms. They will be checked later, after+			-- the file gets copied into the repository.+			, checkWritePerms = False 			} 		v <- lockDown cfg (fromRawFilePath srcfile) 		case v of

@@ -173,7 +173,7 @@ 	| Url.parseURIRelaxed url == Nothing = giveup "invalid feed url" 	| otherwise = withTmpFile "feed" $ \f h -> do 		liftIO $ hClose h-		ifM (Url.withUrlOptions $ Url.download nullMeterUpdate url f)+		ifM (Url.withUrlOptions $ Url.download nullMeterUpdate Nothing url f) 			( Just <$> liftIO (readFileStrict f) 			, return Nothing 			)

@@ -114,7 +114,7 @@ 		( long "bytes" 		<> help "display file sizes in bytes" 		)-	<*> parseBatchOption+	<*> parseBatchOption False  seek :: InfoOptions -> CommandSeek seek o = case batchOption o of@@ -163,7 +163,7 @@  noInfo :: String -> SeekInput -> Annex () noInfo s si = do-	showStart "info" (encodeBS' s) si+	showStart "info" (encodeBS s) si 	showNote $ "not a directory or an annexed file or a treeish or a remote or a uuid" 	showEndFail @@ -183,7 +183,7 @@  treeishInfo :: InfoOptions -> String -> SeekInput -> Annex () treeishInfo o t si = do-	mi <- getTreeStatInfo o (Git.Ref (encodeBS' t))+	mi <- getTreeStatInfo o (Git.Ref (encodeBS t)) 	case mi of 		Nothing -> noInfo t si 		Just i -> showCustom (unwords ["info", t]) si $ do@@ -313,8 +313,8 @@ showStat s = maybe noop calc =<< s   where 	calc (desc, a) = do-		(lift . showHeader . encodeBS') desc-		lift . showRaw . encodeBS' =<< a+		(lift . showHeader . encodeBS) desc+		lift . showRaw . encodeBS =<< a  repo_list :: TrustLevel -> Stat repo_list level = stat n $ nojson $ lift $ do

@@ -230,7 +230,7 @@ 		[ Param $ Git.fromRef Annex.Branch.fullname 		, Param "--" 		] ++ map Param fs-	return (parseGitRawLog config (map decodeBL' ls), cleanup)+	return (parseGitRawLog config (map decodeBL ls), cleanup)  -- Parses chunked git log --raw output, which looks something like: --

@@ -39,7 +39,7 @@ 	| otherwise = do 		prepMerge 		forM_ (mergeBranches o) $-			commandAction . mergeBranch o . Git.Ref . encodeBS'+			commandAction . mergeBranch o . Git.Ref . encodeBS  mergeAnnexBranch :: CommandStart mergeAnnexBranch = starting "merge" ai si $ do

@@ -44,7 +44,7 @@ 	<$> cmdParams desc 	<*> ((Get <$> getopt) <|> (Set <$> some modopts) <|> pure GetAll) 	<*> optional parseKeyOptions-	<*> parseBatchOption+	<*> parseBatchOption False   where 	getopt = option (eitherReader (mkMetaField . T.pack)) 		( long "get" <> short 'g' <> metavar paramField@@ -98,12 +98,12 @@ 			) 		_ -> giveup "--batch is currently only supported in --json mode" -start :: VectorClock -> MetaDataOptions -> SeekInput -> RawFilePath -> Key -> CommandStart+start :: CandidateVectorClock -> MetaDataOptions -> SeekInput -> RawFilePath -> Key -> CommandStart start c o si file k = startKeys c o (si, k, mkActionItem (k, afile))   where 	afile = AssociatedFile (Just file) -startKeys :: VectorClock -> MetaDataOptions -> (SeekInput, Key, ActionItem) -> CommandStart+startKeys :: CandidateVectorClock -> MetaDataOptions -> (SeekInput, Key, ActionItem) -> CommandStart startKeys c o (si, k, ai) = case getSet o of 	Get f -> startingCustomOutput k $ do 		l <- S.toList . currentMetaDataValues f <$> getCurrentMetaData k@@ -113,7 +113,7 @@ 	_ -> starting "metadata" ai si $ 		perform c o k -perform :: VectorClock -> MetaDataOptions -> Key -> CommandPerform+perform :: CandidateVectorClock -> MetaDataOptions -> Key -> CommandPerform perform c o k = case getSet o of 	Set ms -> do 		oldm <- getCurrentMetaData k

@@ -44,7 +44,7 @@ 	<*> parseFromToHereOptions 	<*> pure RemoveSafe 	<*> optional (parseKeyOptions <|> parseFailedTransfersOption)-	<*> parseBatchOption+	<*> parseBatchOption True  instance DeferredParseClass MoveOptions where 	finishParse v = MoveOptions@@ -61,10 +61,10 @@ seek o = startConcurrency stages $ do 	case batchOption o of 		NoBatch -> withKeyOptions (keyOptions o) False seeker-			(commandAction . startKey (fromToOptions o) (removeWhen o))+			(commandAction . keyaction) 			(withFilesInGitAnnex ww seeker) 			=<< workTreeItems ww (moveFiles o)-		Batch fmt -> batchAnnexedFilesMatching fmt seeker+		Batch fmt -> batchAnnexed fmt seeker keyaction   where 	seeker = AnnexedFileSeeker 		{ startAction = start (fromToOptions o) (removeWhen o)@@ -78,6 +78,7 @@ 		Right (FromRemote _) -> downloadStages 		Right (ToRemote _) -> commandStages 		Left ToHere -> downloadStages+	keyaction = startKey (fromToOptions o) (removeWhen o) 	ww = WarnUnmatchLsFiles  start :: FromToHereOptions -> RemoveWhen -> SeekInput -> RawFilePath -> Key -> CommandStart

@@ -33,7 +33,7 @@ optParser :: CmdParamsDesc -> Parser ReKeyOptions optParser desc = ReKeyOptions 	<$> cmdParams desc-	<*> parseBatchOption+	<*> parseBatchOption False  -- Split on the last space, since a FilePath can contain whitespace, -- but a Key very rarely does.

@@ -28,11 +28,12 @@ optParser :: CmdParamsDesc -> Parser RegisterUrlOptions optParser desc = RegisterUrlOptions 	<$> cmdParams desc-	<*> parseBatchOption+	<*> parseBatchOption False  seek :: RegisterUrlOptions -> CommandSeek seek o = case (batchOption o, keyUrlPairs o) of-	(Batch fmt, _) -> commandAction $ startMass setUrlPresent fmt+	(Batch (BatchFormat sep _), _) ->+		commandAction $ startMass setUrlPresent sep 	-- older way of enabling batch input, does not support BatchNull 	(NoBatch, []) -> commandAction $ startMass setUrlPresent BatchLine 	(NoBatch, ps) -> withWords (commandAction . start setUrlPresent) ps@@ -46,14 +47,15 @@ 	si = SeekInput [keyname, url] start _ _ = giveup "specify a key and an url" -startMass :: (Key -> URLString -> Annex ()) -> BatchFormat -> CommandStart-startMass a fmt = +startMass :: (Key -> URLString -> Annex ()) -> BatchSeparator -> CommandStart+startMass a sep = 	starting "registerurl" (ActionItemOther (Just "stdin")) (SeekInput []) $-		performMass a fmt+		performMass a sep -performMass :: (Key -> URLString -> Annex ()) -> BatchFormat -> CommandPerform-performMass a fmt = go True =<< map (separate (== ' ')) <$> batchLines fmt+performMass :: (Key -> URLString -> Annex ()) -> BatchSeparator -> CommandPerform+performMass a sep = go True =<< map (separate (== ' ')) <$> batchLines fmt   where+	fmt = BatchFormat sep (BatchKeys False) 	go status [] = next $ return status 	go status ((keyname,u):rest) | not (null keyname) && not (null u) = do 		let key = keyOpt keyname

@@ -25,7 +25,7 @@ optParser :: CmdParamsDesc -> Parser RmUrlOptions optParser desc = RmUrlOptions 	<$> cmdParams desc-	<*> parseBatchOption+	<*> parseBatchOption False  seek :: RmUrlOptions -> CommandSeek seek o = case batchOption o of

@@ -26,7 +26,7 @@ optParser :: CmdParamsDesc -> Parser SetPresentKeyOptions optParser desc = SetPresentKeyOptions 	<$> cmdParams desc-	<*> parseBatchOption+	<*> parseBatchOption False  seek :: SetPresentKeyOptions -> CommandSeek seek o = case batchOption o of

@@ -160,6 +160,7 @@ 	cfg = LockDownConfig 		{ lockingFile = False 		, hardlinkFileTmpDir = Nothing+		, checkWritePerms = True 		}  	-- git diff can run the clean filter on files outside the

@@ -297,7 +297,7 @@ 			Nothing -> return True 			Just verifier -> verifier k (serializeKey' k) 	get r k = logStatusAfter k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) $ \dest ->-		tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) (fromRawFilePath dest) nullMeterUpdate) >>= \case+		tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) (fromRawFilePath dest) nullMeterUpdate (RemoteVerify r)) >>= \case 			Right v -> return (True, v) 			Left _ -> return (False, UnVerified) 	store r k = Remote.storeKey r k (AssociatedFile Nothing) nullMeterUpdate@@ -371,7 +371,7 @@ 		Remote.checkPresent r k 	, check (== Right False) "retrieveKeyFile" $ \r k -> 		logStatusAfter k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) $ \dest ->-			tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) (fromRawFilePath dest) nullMeterUpdate) >>= \case+			tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) (fromRawFilePath dest) nullMeterUpdate (RemoteVerify r)) >>= \case 				Right v -> return (True, v) 				Left _ -> return (False, UnVerified) 	, check (== Right False) "retrieveKeyFileCheap" $ \r k -> case Remote.retrieveKeyFileCheap r of

@@ -63,12 +63,14 @@ fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform fromPerform key file remote = go Upload file $ 	download' (uuid remote) key file Nothing stdRetry $ \p ->-		logStatusAfter key $ getViaTmp (retrievalSecurityPolicy remote) (RemoteVerify remote) key file $ \t ->-			tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p) >>= \case+		logStatusAfter key $ getViaTmp (retrievalSecurityPolicy remote) vc key file $ \t ->+			tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p vc) >>= \case 				Right v -> return (True, v)	 				Left e -> do 					warning (show e) 					return (False, UnVerified)+  where+	vc = RemoteVerify remote  go :: Direction -> AssociatedFile -> (NotifyWitness -> Annex Bool) -> CommandPerform go direction file a = notifyTransfer direction file a >>= liftIO . exitBool

@@ -51,7 +51,7 @@ 		| otherwise = notifyTransfer direction file $ 			download' (Remote.uuid remote) key file Nothing stdRetry $ \p -> 				logStatusAfter key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key file $ \t -> do-					r <- tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p) >>= \case+					r <- tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p (RemoteVerify remote)) >>= \case 						Left e -> do 							warning (show e) 							return (False, UnVerified)

@@ -56,7 +56,7 @@ 		-- and for retrying, and updating location log, 		-- and stall canceling. 		let go p = getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key file $ \t -> do-			Remote.verifiedAction (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p)+			Remote.verifiedAction (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p (RemoteVerify remote)) 		in download' (Remote.uuid remote) key file Nothing noRetry go  			noNotification 	runner (AssistantUploadRequest _ key (TransferAssociatedFile file)) remote =@@ -73,7 +73,7 @@ 		notifyTransfer Download file $ 			download' (Remote.uuid remote) key file Nothing stdRetry $ \p -> 				logStatusAfter key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key file $ \t -> do-					r <- tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p) >>= \case+					r <- tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p (RemoteVerify remote)) >>= \case 						Left e -> do 							warning (show e) 							return (False, UnVerified)

@@ -37,7 +37,7 @@ 	whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath currdir)) $ 		giveup "can only run uninit from the top of the git repository"   where-	current_branch = Git.Ref . encodeBS' . Prelude.head . lines . decodeBS' <$> revhead+	current_branch = Git.Ref . encodeBS . Prelude.head . lines . decodeBS <$> revhead 	revhead = inRepo $ Git.Command.pipeReadStrict 		[Param "rev-parse", Param "--abbrev-ref", Param "HEAD"] 

@@ -21,7 +21,7 @@  seek :: RegisterUrlOptions -> CommandSeek seek o = case (batchOption o, keyUrlPairs o) of-	(Batch fmt, _) -> commandAction $ startMass unregisterUrl fmt+	(Batch (BatchFormat sep _), _) -> commandAction $ startMass unregisterUrl sep 	(NoBatch, ps) -> withWords (commandAction . start unregisterUrl) ps  unregisterUrl :: Key -> String -> Annex ()

@@ -241,6 +241,7 @@ 	ourbranchend = S.cons (fromIntegral (ord '/')) (Git.fromRef' Annex.Branch.name) 	ourbranches (_, b) = not (ourbranchend `S.isSuffixOf` b) 		&& not ("refs/synced/" `S.isPrefixOf` b)+		&& not ("refs/annex/" `S.isPrefixOf` b) 		&& not (is_branchView (Git.Ref b)) 	getreflog rs = inRepo $ Git.RefLog.getMulti rs 

@@ -311,7 +311,7 @@ 				let m = M.insert u l (cfgScheduleMap cfg) 				in Right $ cfg { cfgScheduleMap = m } 		| setting == "config" =-			let m = M.insert (ConfigKey (encodeBS' f)) (ConfigValue (encodeBS' val)) (cfgGlobalConfigs cfg)+			let m = M.insert (ConfigKey (encodeBS f)) (ConfigValue (encodeBS val)) (cfgGlobalConfigs cfg) 			in Right $ cfg { cfgGlobalConfigs = m } 		| setting == "numcopies" = case readish val of 			Nothing -> Left "parse error (expected an integer)"

@@ -39,7 +39,7 @@ optParser desc = WhereisOptions 	<$> cmdParams desc 	<*> optional parseKeyOptions-	<*> parseBatchOption+	<*> parseBatchOption True 	<*> optional parseFormatOption  parseFormatOption :: Parser Utility.Format.Format@@ -62,7 +62,7 @@ 				(commandAction . startKeys o m) 				(withFilesInGitAnnex ww seeker) 				=<< workTreeItems ww (whereisFiles o)-		Batch fmt -> batchAnnexedFilesMatching fmt seeker+		Batch fmt -> batchAnnexed fmt seeker (startKeys o m)   where 	ww = WarnUnmatchLsFiles 

@@ -39,7 +39,7 @@ setConfig (ConfigKey key) value = do 	inRepo $ Git.Command.run 		[ Param "config"-		, Param (decodeBS' key)+		, Param (decodeBS key) 		, Param value 		] 	reloadConfig

@@ -75,7 +75,7 @@ 		v <- a (SQL.ReadHandle qh) 		return (v, st) 	go DbClosed = do-		st' <- openDb True DbClosed+		st' <- openDb False DbClosed 		v <- case st' of 			(DbOpen qh) -> a (SQL.ReadHandle qh) 			_ -> return mempty@@ -97,7 +97,7 @@ 		v <- a (SQL.WriteHandle qh) 		return (v, st) 	go st = do-		st' <- openDb False st+		st' <- openDb True st 		v <- case st' of 			DbOpen qh -> a (SQL.WriteHandle qh) 			_ -> error "internal"

@@ -95,10 +95,10 @@ 	deriving (Eq, Show)  toSSha :: Sha -> SSha-toSSha (Ref s) = SSha (decodeBS' s)+toSSha (Ref s) = SSha (decodeBS s)  fromSSha :: SSha -> Ref-fromSSha (SSha s) = Ref (encodeBS' s)+fromSSha (SSha s) = Ref (encodeBS s)  instance PersistField SSha where 	toPersistValue (SSha b) = toPersistValue b

@@ -170,7 +170,7 @@  {- Checks if a string from git config is a true/false value. -} isTrueFalse :: String -> Maybe Bool-isTrueFalse = isTrueFalse' . ConfigValue . encodeBS'+isTrueFalse = isTrueFalse' . ConfigValue . encodeBS  isTrueFalse' :: ConfigValue -> Maybe Bool isTrueFalse' (ConfigValue s)@@ -248,8 +248,8 @@ 	[ Param "config" 	, Param "--file" 	, File f-	, Param (decodeBS' k)-	, Param (decodeBS' v)+	, Param (decodeBS k)+	, Param (decodeBS v) 	]  {- Unsets a git config setting, in both the git repo,@@ -264,4 +264,4 @@ 	, return Nothing 	)   where-	ps = [Param "config", Param "--unset-all", Param (decodeBS' k)]+	ps = [Param "config", Param "--unset-all", Param (decodeBS k)]

@@ -31,7 +31,7 @@ 			"all" -> AllShared 			"world" -> AllShared 			"everybody" -> AllShared-			_ -> maybe UnShared UmaskShared (readish (decodeBS' v))+			_ -> maybe UnShared UmaskShared (readish (decodeBS v)) 		Just NoConfigValue -> UnShared 		Nothing -> UnShared 

@@ -114,7 +114,7 @@ 	go (info:f:rest) = case A.parse (parserDiffRaw (L.toStrict f)) info of 		A.Done _ r -> r : go rest 		A.Fail _ _ err -> error $ "diff-tree parse error: " ++ err-	go (s:[]) = error $ "diff-tree parse error near \"" ++ decodeBL' s ++ "\""+	go (s:[]) = error $ "diff-tree parse error near \"" ++ decodeBL s ++ "\""  -- :<srcmode> SP <dstmode> SP <srcsha> SP <dstsha> SP <status> --

@@ -159,7 +159,7 @@ 		] r  findShas :: [String] -> [Sha]-findShas = catMaybes . map (extractSha . encodeBS') +findShas = catMaybes . map (extractSha . encodeBS)  	. concat . map words . filter wanted   where 	wanted l = not ("dangling " `isPrefixOf` l)

@@ -107,7 +107,7 @@   where 	defaultkey = "gcrypt.participants" 	parse (Just (ConfigValue "simple")) = []-	parse (Just (ConfigValue b)) = words (decodeBS' b)+	parse (Just (ConfigValue b)) = words (decodeBS b) 	parse (Just NoConfigValue) = [] 	parse Nothing = [] @@ -122,4 +122,4 @@  remoteConfigKey :: S.ByteString -> RemoteName -> ConfigKey remoteConfigKey key remotename = ConfigKey $-	"remote." <> encodeBS' remotename <> "." <> key+	"remote." <> encodeBS remotename <> "." <> key

@@ -251,7 +251,7 @@ unmerged :: [RawFilePath] -> Repo -> IO ([Unmerged], IO Bool) unmerged l repo = guardSafeForLsFiles repo $ do 	(fs, cleanup) <- pipeNullSplit params repo-	return (reduceUnmerged [] $ catMaybes $ map (parseUnmerged . decodeBL') fs, cleanup)+	return (reduceUnmerged [] $ catMaybes $ map (parseUnmerged . decodeBL) fs, cleanup)   where 	params =  		Param "ls-files" :@@ -277,7 +277,7 @@ 				then Nothing 				else do 					treeitemtype <- readTreeItemType (encodeBS rawtreeitemtype)-					sha <- extractSha (encodeBS' rawsha)+					sha <- extractSha (encodeBS rawsha) 					return $ InternalUnmerged (stage == 2) (toRawFilePath file) 						(Just treeitemtype) (Just sha) 		_ -> Nothing

@@ -149,7 +149,7 @@  - generated, so any size information is not included. -} formatLsTree :: TreeItem -> S.ByteString formatLsTree ti = S.intercalate (S.singleton (fromIntegral (ord ' ')))-	[ encodeBS' (showOct (mode ti) "")+	[ encodeBS (showOct (mode ti) "") 	, typeobj ti 	, fromRef' (sha ti) 	] <> (S.cons (fromIntegral (ord '\t')) (getTopFilePath (file ti)))

@@ -82,7 +82,7 @@  {- Converts a Ref to refer to the content of the Ref on a given date. -} dateRef :: Ref -> RefDate -> Ref-dateRef r (RefDate d) = Ref $ fromRef' r <> "@" <> encodeBS' d+dateRef r (RefDate d) = Ref $ fromRef' r <> "@" <> encodeBS d  {- A Ref that can be used to refer to a file in the repository as it  - appears in a given Ref. -}@@ -177,7 +177,7 @@ 	[ Param "rev-parse" 	, Param "--verify" 	, Param "--quiet"-	, Param (decodeBS' ref')+	, Param (decodeBS ref') 	]   where 	ref' = if ":" `S.isInfixOf` ref

@@ -37,7 +37,7 @@ remoteKeyToRemoteName (ConfigKey k) 	| "remote." `S.isPrefixOf` k =  		let n = S.intercalate "." $ dropFromEnd 1 $ drop 1 $ S8.split '.' k-		in if S.null n then Nothing else Just (decodeBS' n)+		in if S.null n then Nothing else Just (decodeBS n) 	| otherwise = Nothing  {- Construct a legal git remote name out of an arbitrary input string.@@ -90,7 +90,7 @@ 		| null insteadofs = l 		| otherwise = replacement ++ drop (S.length bestvalue) l 	  where-		replacement = decodeBS' $ S.drop (S.length prefix) $+		replacement = decodeBS $ S.drop (S.length prefix) $ 			S.take (S.length bestkey - S.length suffix) bestkey 		(bestkey, bestvalue) =  			case maximumBy longestvalue insteadofs of

@@ -252,7 +252,7 @@ getAllRefs' :: FilePath -> IO [Ref] getAllRefs' refdir = do 	let topsegs = length (splitPath refdir) - 1-	let toref = Ref . encodeBS' . joinPath . drop topsegs . splitPath+	let toref = Ref . encodeBS . joinPath . drop topsegs . splitPath 	map toref <$> dirContentsRecursive refdir  explodePackedRefsFile :: Repo -> IO ()@@ -279,8 +279,8 @@ parsePacked :: String -> Maybe (Sha, Ref) parsePacked l = case words l of 	(sha:ref:[])-		| isJust (extractSha (encodeBS' sha)) && Ref.legal True ref ->-			Just (Ref (encodeBS' sha), Ref (encodeBS' ref))+		| isJust (extractSha (encodeBS sha)) && Ref.legal True ref ->+			Just (Ref (encodeBS sha), Ref (encodeBS ref)) 	_ -> Nothing  {- git-branch -d cannot be used to remove a branch that is directly@@ -350,8 +350,8 @@   where 	parse l = case words l of 		(commitsha:treesha:[]) -> (,)-			<$> extractSha (encodeBS' commitsha)-			<*> extractSha (encodeBS' treesha)+			<$> extractSha (encodeBS commitsha)+			<*> extractSha (encodeBS treesha) 		_ -> Nothing 	check [] = return True 	check ((c, t):rest)@@ -469,7 +469,7 @@   where 	headfile = localGitDir g P.</> "HEAD" 	validhead s = "ref: refs/" `isPrefixOf` s-		|| isJust (extractSha (encodeBS' s))+		|| isJust (extractSha (encodeBS s))  {- Put it all together. -} runRepair :: (Ref -> Bool) -> Bool -> Repo -> IO (Bool, [Branch])

@@ -75,7 +75,7 @@ 	def = ConfigValue mempty  fromConfigKey :: ConfigKey -> String-fromConfigKey (ConfigKey s) = decodeBS' s+fromConfigKey (ConfigKey s) = decodeBS s  instance Show ConfigKey where 	show = fromConfigKey@@ -88,16 +88,16 @@ 	fromConfigValue NoConfigValue = mempty  instance FromConfigValue String where-	fromConfigValue = decodeBS' . fromConfigValue+	fromConfigValue = decodeBS . fromConfigValue  instance Show ConfigValue where 	show = fromConfigValue  instance IsString ConfigKey where-	fromString = ConfigKey . encodeBS'+	fromString = ConfigKey . encodeBS  instance IsString ConfigValue where-	fromString = ConfigValue . encodeBS'+	fromString = ConfigValue . encodeBS  type RemoteName = String @@ -106,7 +106,7 @@ 	deriving (Eq, Ord, Read, Show)  fromRef :: Ref -> String-fromRef = decodeBS' . fromRef'+fromRef = decodeBS . fromRef'  fromRef' :: Ref -> S.ByteString fromRef' (Ref s) = s

@@ -80,14 +80,14 @@ 	mapM_ streamer s 	void $ cleanup   where-	params = map Param ["ls-tree", "-z", "-r", "--full-tree", decodeBS' x]+	params = map Param ["ls-tree", "-z", "-r", "--full-tree", decodeBS x] lsSubTree :: Ref -> FilePath -> Repo -> Streamer lsSubTree (Ref x) p repo streamer = do 	(s, cleanup) <- pipeNullSplit params repo 	mapM_ streamer s 	void $ cleanup   where-	params = map Param ["ls-tree", "-z", "-r", "--full-tree", decodeBS' x, p]+	params = map Param ["ls-tree", "-z", "-r", "--full-tree", decodeBS x, p]  {- Generates a line suitable to be fed into update-index, to add  - a given file with a given sha. -}

@@ -59,13 +59,13 @@ isChunkKey k = isJust (fromKey keyChunkSize k) && isJust (fromKey keyChunkNum k)  serializeKey :: Key -> String-serializeKey = decodeBS' . serializeKey'+serializeKey = decodeBS . serializeKey'  serializeKey' :: Key -> S.ByteString serializeKey' = keySerialization  deserializeKey :: String -> Maybe Key-deserializeKey = deserializeKey' . encodeBS'+deserializeKey = deserializeKey' . encodeBS  deserializeKey' :: S.ByteString -> Maybe Key deserializeKey' = eitherToMaybe . A.parseOnly keyParser

@@ -97,9 +97,8 @@ 	hereuuid <- getUUID 	let ep = ExportParticipants { exportFrom = hereuuid, exportTo = remoteuuid } 	let exported = mkExported (newTreeish ec) []-	Annex.Branch.change-		(Annex.Branch.RegardingUUID [remoteuuid, hereuuid]) -		exportLog $+	let ru = Annex.Branch.RegardingUUID [remoteuuid, hereuuid]+	Annex.Branch.change ru exportLog $  		buildExportLog 			. changeMapLog c ep exported  			. M.mapWithKey (updateForExportChange remoteuuid ec c hereuuid)

@@ -23,6 +23,7 @@ ) where  import Annex.Common+import Annex.VectorClock import qualified Git import Logs.MapLog @@ -110,7 +111,9 @@ -- This way, when multiple repositories are exporting to -- the same special remote, there's no conflict as long as they move -- forward in lock-step.-updateForExportChange :: UUID -> ExportChange -> VectorClock -> UUID -> ExportParticipants -> LogEntry Exported -> LogEntry Exported-updateForExportChange remoteuuid ec c hereuuid ep le@(LogEntry _ exported@(Exported { exportedTreeish = t }))+updateForExportChange :: UUID -> ExportChange -> CandidateVectorClock -> UUID -> ExportParticipants -> LogEntry Exported -> LogEntry Exported+updateForExportChange remoteuuid ec c hereuuid ep le@(LogEntry lc exported@(Exported { exportedTreeish = t })) 	| hereuuid == exportFrom ep || remoteuuid /= exportTo ep || t `notElem` oldTreeish ec = le-	| otherwise = LogEntry c (exported { exportedTreeish = newTreeish ec })+	| otherwise = LogEntry c' (exported { exportedTreeish = newTreeish ec })+  where+	c' = advanceVectorClock c [lc]

@@ -54,7 +54,7 @@ 	deserialize ("truncated":ls) = deserialize' ls True 	deserialize ls = deserialize' ls False 	deserialize' ls t =-		let s = S.fromList $ map (Ref . encodeBS') ls+		let s = S.fromList $ map (Ref . encodeBS) ls 		in if S.null s then FsckFailed else FsckFoundMissing s t  clearFsckResults :: UUID -> Annex ()

@@ -8,7 +8,7 @@  - Repositories record their UUID and the date when they --get or --drop  - a value.  - - - Copyright 2010-2018 Joey Hess <id@joeyh.name>+ - Copyright 2010-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -61,14 +61,14 @@  {- Log a change in the presence of a key's value in a repository. -} logChange :: Key -> UUID -> LogStatus -> Annex ()-logChange = logChange' logNow--logChange' :: (LogStatus -> LogInfo -> Annex LogLine) -> Key -> UUID -> LogStatus -> Annex ()-logChange' mklog key u@(UUID _) s = do+logChange key u@(UUID _) s = do 	config <- Annex.getGitConfig-	maybeAddLog (Annex.Branch.RegardingUUID [u]) (locationLogFile config key)-		=<< mklog s (LogInfo (fromUUID u))-logChange' _ _ NoUUID _ = noop+	maybeAddLog+		(Annex.Branch.RegardingUUID [u])+		(locationLogFile config key)+		s+		(LogInfo (fromUUID u))+logChange _ NoUUID _ = noop  {- Returns a list of repository UUIDs that, according to the log, have  - the value of a key. -}@@ -107,6 +107,9 @@  -   - Changes all logged lines for the key, in any location, that are  - currently InfoMissing, to be InfoDead.+ - + - The vector clock in the log is updated minimally, so that any+ - other location log changes are guaranteed to overrule this.  -} setDead :: Key -> Annex () setDead key = do@@ -117,18 +120,12 @@   where 	go logfile l =  		let u = toUUID (fromLogInfo (info l))-		in addLog (Annex.Branch.RegardingUUID [u]) logfile (setDead' l)--{- Note that the timestamp in the log is updated minimally, so that this- - can be overruled by other location log changes. -}-setDead' :: LogLine -> LogLine-setDead' l = l-	{ status = InfoDead-	, date = case date l of-		VectorClock c -> VectorClock $-			c + realToFrac (picosecondsToDiffTime 1)-		Unknown -> Unknown-	}+		    c = case date l of+			VectorClock v -> CandidateVectorClock $+				v + realToFrac (picosecondsToDiffTime 1)+			Unknown -> CandidateVectorClock 0+		in addLog' (Annex.Branch.RegardingUUID [u]) logfile InfoDead+			(info l) c  data Unchecked a = Unchecked (Annex (Maybe a)) 

@@ -67,8 +67,12 @@ 		A.endOfInput 		return (f, LogEntry c v) -changeMapLog :: Ord f => VectorClock -> f -> v -> MapLog f v -> MapLog f v-changeMapLog c f v = M.insert f $ LogEntry c v+changeMapLog :: Ord f => CandidateVectorClock -> f -> v -> MapLog f v -> MapLog f v+changeMapLog c f v m = M.insert f (LogEntry c' v) m+  where+	c' = case M.lookup f m of+		Nothing -> advanceVectorClock c []+		Just old -> advanceVectorClock c [changed old]  {- Only add an LogEntry if it's newer (or at least as new as) than any  - existing LogEntry for a field. -}

@@ -105,22 +105,23 @@ addMetaData' ru getlogfile k metadata =  	addMetaDataClocked' ru getlogfile k metadata =<< currentVectorClock -{- Reusing the same VectorClock when making changes to the metadata+{- Reusing the same CandidateVectorClock when making changes to the metadata  - of multiple keys is a nice optimisation. The same metadata lines  - will tend to be generated across the different log files, and so  - git will be able to pack the data more efficiently. -}-addMetaDataClocked :: Key -> MetaData -> VectorClock -> Annex ()+addMetaDataClocked :: Key -> MetaData -> CandidateVectorClock -> Annex () addMetaDataClocked = addMetaDataClocked' (Annex.Branch.RegardingUUID []) metaDataLogFile -addMetaDataClocked' :: Annex.Branch.RegardingUUID -> (GitConfig -> Key -> RawFilePath) -> Key -> MetaData -> VectorClock -> Annex ()+addMetaDataClocked' :: Annex.Branch.RegardingUUID -> (GitConfig -> Key -> RawFilePath) -> Key -> MetaData -> CandidateVectorClock -> Annex () addMetaDataClocked' ru getlogfile k d@(MetaData m) c 	| d == emptyMetaData = noop 	| otherwise = do 		config <- Annex.getGitConfig-		Annex.Branch.change ru (getlogfile config k) $-			buildLog . simplifyLog -				. S.insert (LogEntry c metadata)-				. parseLog+		Annex.Branch.change ru (getlogfile config k) $ \b ->+			let s = parseLog b+			    c' = advanceVectorClock c (map changed (S.toList s))+			    ent = LogEntry c' metadata+			in buildLog $ simplifyLog $ S.insert ent s   where 	metadata = MetaData $ M.filterWithKey (\f _ -> not (isLastChangedField f)) m 

@@ -6,7 +6,7 @@  - A line of the log will look like: "date N INFO"  - Where N=1 when the INFO is present, 0 otherwise.  - - - Copyright 2010-2014 Joey Hess <id@joeyh.name>+ - Copyright 2010-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -14,9 +14,9 @@ module Logs.Presence ( 	module X, 	addLog,+	addLog', 	maybeAddLog, 	readLog,-	logNow, 	currentLog, 	currentLogInfo, 	historicalLogInfo,@@ -28,31 +28,42 @@ import qualified Annex.Branch import Git.Types (RefDate) -{- Adds a LogLine to the log, removing any LogLines that are obsoleted by- - adding it. -}-addLog :: Annex.Branch.RegardingUUID -> RawFilePath -> LogLine -> Annex ()-addLog ru file line = Annex.Branch.change ru file $ \b ->-	buildLog $ compactLog (line : parseLog b)+{- Adds to the log, removing any LogLines that are obsoleted. -}+addLog :: Annex.Branch.RegardingUUID -> RawFilePath -> LogStatus -> LogInfo -> Annex ()+addLog ru file logstatus loginfo = +	addLog' ru file logstatus loginfo =<< currentVectorClock +addLog' :: Annex.Branch.RegardingUUID -> RawFilePath -> LogStatus -> LogInfo -> CandidateVectorClock -> Annex ()+addLog' ru file logstatus loginfo c = +	Annex.Branch.change ru file $ \b ->+		let old = parseLog b+		    line = genLine logstatus loginfo c old+		in buildLog $ compactLog (line : old)+ {- When a LogLine already exists with the same status and info, but an  - older timestamp, that LogLine is preserved, rather than updating the log  - with a newer timestamp.  -}-maybeAddLog :: Annex.Branch.RegardingUUID -> RawFilePath -> LogLine -> Annex ()-maybeAddLog ru file line = Annex.Branch.maybeChange ru file $ \s -> do-	m <- insertNewStatus line $ logMap $ parseLog s-	return $ buildLog $ mapLog m+maybeAddLog :: Annex.Branch.RegardingUUID -> RawFilePath -> LogStatus -> LogInfo -> Annex ()+maybeAddLog ru file logstatus loginfo = do+	c <- currentVectorClock+	Annex.Branch.maybeChange ru file $ \b ->+		let old = parseLog b+		    line = genLine logstatus loginfo c old+		in do+			m <- insertNewStatus line $ logMap old+			return $ buildLog $ mapLog m +genLine :: LogStatus -> LogInfo -> CandidateVectorClock -> [LogLine] -> LogLine+genLine logstatus loginfo c old = LogLine c' logstatus loginfo+  where+	oldcs = map date (filter (\l -> info l == loginfo) old)+	c' = advanceVectorClock c oldcs+ {- Reads a log file.  - Note that the LogLines returned may be in any order. -} readLog :: RawFilePath -> Annex [LogLine] readLog = parseLog <$$> Annex.Branch.get--{- Generates a new LogLine with the current time. -}-logNow :: LogStatus -> LogInfo -> Annex LogLine-logNow s i = do-	c <- currentVectorClock-	return $ LogLine c s i  {- Reads a log and returns only the info that is still in effect. -} currentLogInfo :: RawFilePath -> Annex [LogInfo]

@@ -19,6 +19,7 @@ import qualified Data.Attoparsec.ByteString.Lazy as A import Data.Attoparsec.ByteString.Char8 (char, anyChar) import Data.ByteString.Builder+import Data.Char  newtype LogInfo = LogInfo { fromLogInfo :: S.ByteString } 	deriving (Show, Eq, Ord)@@ -119,8 +120,15 @@ 		<*> elements [minBound..maxBound] 		<*> (LogInfo <$> arbinfo) 	  where-		arbinfo = (encodeBS <$> arbitrary) `suchThat`-			(\b -> C8.notElem '\n' b && C8.notElem '\r' b)+	  	-- Avoid newline characters, which cannot appear in +		-- LogInfo.+		--+		-- Avoid non-ascii values because fully arbitrary+		-- strings may not be encoded using the filesystem+		-- encoding, which is normally applied to all input.+		arbinfo = (encodeBS <$> arbitrary `suchThat` all isAscii)+			`suchThat` (\b -> C8.notElem '\n' b && C8.notElem '\r' b)  prop_parse_build_presence_log :: [LogLine] -> Bool-prop_parse_build_presence_log l = parseLog (toLazyByteString (buildLog l)) == l+prop_parse_build_presence_log l =+	parseLog (toLazyByteString (buildLog l)) == l

@@ -1,3 +1,5 @@+{-# LANGUAGE ScopedTypeVariables #-}+ {- git-annex single-value log  -  - This is used to store a value in a way that can be union merged.@@ -6,7 +8,7 @@  -  - The line with the newest timestamp wins.  -- - Copyright 2014 Joey Hess <id@joeyh.name>+ - Copyright 2014-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -31,8 +33,10 @@ getLog :: (Ord v, SingleValueSerializable v) => RawFilePath -> Annex (Maybe v) getLog = newestValue <$$> readLog -setLog :: (SingleValueSerializable v) => Annex.Branch.RegardingUUID -> RawFilePath -> v -> Annex ()+setLog :: (Ord v, SingleValueSerializable v) => Annex.Branch.RegardingUUID -> RawFilePath -> v -> Annex () setLog ru f v = do 	c <- currentVectorClock-	let ent = LogEntry c v-	Annex.Branch.change ru f $ \_old -> buildLog (S.singleton ent)+	Annex.Branch.change ru f $ \old ->+		let oldcs = map changed ((parseLog' old) `asTypeOf` [ent])+		    ent = LogEntry (advanceVectorClock c oldcs) v+		in buildLog (S.singleton ent)

@@ -1,6 +1,6 @@ {- git-annex single-value log, pure operations  -- - Copyright 2014-2019 Joey Hess <id@joeyh.name>+ - Copyright 2014-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -33,13 +33,18 @@ buildLog = mconcat . map genline . S.toList   where 	genline (LogEntry c v) =-		buildVectorClock c <> sp <> byteString (serialize v) <> nl+		buildVectorClock c+			<> sp +			<> byteString (serialize v)+			<> nl 	sp = charUtf8 ' ' 	nl = charUtf8 '\n'  parseLog :: (Ord v, SingleValueSerializable v) => L.ByteString -> Log v-parseLog = S.fromList . fromMaybe [] -	. A.maybeResult . A.parse (logParser <* A.endOfInput)+parseLog = S.fromList . parseLog'++parseLog' :: SingleValueSerializable v => L.ByteString -> [LogEntry v]+parseLog' = fromMaybe [] . A.maybeResult . A.parse (logParser <* A.endOfInput)  logParser :: SingleValueSerializable v => A.Parser [LogEntry v] logParser = parseLogLines $ LogEntry

@@ -35,7 +35,7 @@ describeTransfer t info = unwords 	[ show $ transferDirection t 	, show $ transferUUID t-	, decodeBS' $ actionItemDesc $ ActionItemAssociatedFile+	, decodeBS $ actionItemDesc $ ActionItemAssociatedFile 		(associatedFile info) 		(transferKey t) 	, show $ bytesComplete info

@@ -51,8 +51,12 @@ noTransitions :: Transitions noTransitions = S.empty -addTransition :: VectorClock -> Transition -> Transitions -> Transitions-addTransition c t = S.insert $ TransitionLine c (Right t)+addTransition :: CandidateVectorClock -> Transition -> Transitions -> Transitions+addTransition c t s = S.insert (TransitionLine c' (Right t)) s+  where+	oldcs = map transitionStarted $+		filter (\l -> transition l == Right t) (S.toList s)+	c' = advanceVectorClock c oldcs  buildTransitions :: Transitions -> Builder buildTransitions = mconcat . map genline . S.elems@@ -72,9 +76,6 @@ 	in if S.null $ S.filter (isLeft . transition) ts 		then ts 		else giveup $ "unknown transitions listed in " ++ source ++ "; upgrade git-annex!"--showTransitionLine :: TransitionLine -> String-showTransitionLine (TransitionLine c t) = unwords [show t, formatVectorClock c]  transitionLineParser :: A.Parser TransitionLine transitionLineParser = do

@@ -53,8 +53,10 @@ buildLogOld builder = mconcat . map genline . M.toList   where 	genline (u, LogEntry c@(VectorClock {}) v) =-		buildUUID u <> sp <> builder v <> sp <>-			byteString "timestamp=" <> buildVectorClock c <> nl+		buildUUID u <> sp <> builder v <> sp+			<> byteString "timestamp="+			<> buildVectorClock c+			<> nl 	genline (u, LogEntry Unknown v) = 		buildUUID u <> sp <> builder v <> nl 	sp = charUtf8 ' '@@ -89,7 +91,7 @@ parseLogNew :: A.Parser v -> L.ByteString -> Log v parseLogNew = parseMapLog (toUUID <$> A.takeByteString) -changeLog :: VectorClock -> UUID -> v -> Log v -> Log v+changeLog :: CandidateVectorClock -> UUID -> v -> Log v -> Log v changeLog = changeMapLog  addLog :: UUID -> LogEntry v -> Log v -> Log v

@@ -74,7 +74,7 @@ 	| B.null name = Git.Ref branchViewPrefix 	| otherwise = Git.Ref $ branchViewPrefix <> "/" <> name   where-	name = encodeBS' $+	name = encodeBS $ 		intercalate ";" $ map branchcomp (viewComponents view) 	branchcomp c 		| viewVisible c = branchcomp' c

@@ -61,7 +61,7 @@ 	unless (url `elem` us) $ do 		config <- Annex.getGitConfig 		addLog (Annex.Branch.RegardingUUID []) (urlLogFile config key)-			=<< logNow InfoPresent (LogInfo (encodeBS url))+			InfoPresent (LogInfo (encodeBS url)) 	-- If the url does not have an OtherDownloader, it must be present 	-- in the web. 	case snd (getDownloader url) of@@ -75,7 +75,7 @@ 	when (url `elem` us) $ do 		config <- Annex.getGitConfig 		addLog (Annex.Branch.RegardingUUID []) (urlLogFile config key)-			=<< logNow InfoMissing (LogInfo (encodeBS url))+			InfoMissing (LogInfo (encodeBS url)) 		-- If the url was a web url and none of the remaining urls 		-- for the key are web urls, the key must not be present 		-- in the web.

@@ -72,18 +72,18 @@  showStart :: String -> RawFilePath -> SeekInput -> Annex () showStart command file si = outputMessage json $-	encodeBS' command <> " " <> file <> " "+	encodeBS command <> " " <> file <> " "   where 	json = JSON.start command (Just file) Nothing si  showStartKey :: String -> Key -> ActionItem -> SeekInput -> Annex () showStartKey command key ai si = outputMessage json $-	encodeBS' command <> " " <> actionItemDesc ai <> " "+	encodeBS command <> " " <> actionItemDesc ai <> " "   where 	json = JSON.start command (actionItemFile ai) (Just key) si  showStartOther :: String -> Maybe String -> SeekInput -> Annex ()-showStartOther command mdesc si = outputMessage json $ encodeBS' $+showStartOther command mdesc si = outputMessage json $ encodeBS $ 	command ++ (maybe "" (" " ++) mdesc) ++ " "   where 	json = JSON.start command Nothing Nothing si@@ -116,7 +116,7 @@ showEndMessage (CustomOutput _) = const noop  showNote :: String -> Annex ()-showNote s = outputMessage (JSON.note s) $ encodeBS' $ "(" ++ s ++ ") "+showNote s = outputMessage (JSON.note s) $ encodeBS $ "(" ++ s ++ ") "  showAction :: String -> Annex () showAction s = showNote $ s ++ "..."@@ -131,7 +131,7 @@ 			Annex.changeState $ \s -> s { Annex.output = st' } 		| sideActionBlock st == InBlock = return () 		| otherwise = go'-	go' = outputMessage JSON.none $ encodeBS' $ "(" ++ m ++ "...)\n"+	go' = outputMessage JSON.none $ encodeBS $ "(" ++ m ++ "...)\n" 			 showStoringStateAction :: Annex () showStoringStateAction = showSideAction "recording state in git"@@ -175,7 +175,7 @@ 	outputMessage JSON.none "\n"  showLongNote :: String -> Annex ()-showLongNote s = outputMessage (JSON.note s) (encodeBS' (formatLongNote s))+showLongNote s = outputMessage (JSON.note s) (encodeBS (formatLongNote s))  formatLongNote :: String -> String formatLongNote s = '\n' : indent s ++ "\n"@@ -184,7 +184,7 @@ -- to console, but json object containing the info is emitted immediately. showInfo :: String -> Annex () showInfo s = outputMessage' outputJSON (JSON.info s) $-	encodeBS' (formatLongNote s)+	encodeBS (formatLongNote s)  showEndOk :: Annex () showEndOk = showEndResult True

@@ -202,10 +202,12 @@ 					 				runner validitycheck >>= \case 					Right (Just Valid) -> case incrementalverifier of-						Just iv -> ifM (liftIO (finalizeIncremental iv) <&&> pure rightsize)-							( return (True, Verified)-							, return (False, UnVerified)-							)+						Just iv+							| rightsize -> liftIO (finalizeIncremental iv) >>= \case+								Nothing -> return (True, UnVerified)+								Just True -> return (True, Verified)+								Just False -> return (False, UnVerified)+							| otherwise -> return (False, UnVerified) 						Nothing -> return (rightsize, UnVerified) 					Right (Just Invalid) | l == 0 -> 						-- Special case, for when

@@ -17,9 +17,9 @@ import Types (Annex) import Types.Key import Types.UUID-import Types.Remote (Verification(..))-import Types.Backend (IncrementalVerifier(..)) import Types.Transfer+import Types.Remote (Verification(..))+import Utility.Hash (IncrementalVerifier(..)) import Utility.AuthToken import Utility.Applicative import Utility.PartialPrelude@@ -172,7 +172,7 @@ instance Proto.Serializable ProtoAssociatedFile where 	serialize (ProtoAssociatedFile (AssociatedFile Nothing)) = "" 	serialize (ProtoAssociatedFile (AssociatedFile (Just af))) = -		decodeBS' $ toInternalGitPath $ encodeBS' $ concatMap esc $ fromRawFilePath af+		decodeBS $ toInternalGitPath $ encodeBS $ concatMap esc $ fromRawFilePath af 	  where 		esc '%' = "%%" 		esc c 

@@ -153,7 +153,7 @@  {- Finds the remote or remote group matching the name. -} byNameOrGroup :: RemoteName -> Annex [Remote]-byNameOrGroup n = go =<< getConfigMaybe (ConfigKey ("remotes." <> encodeBS' n))+byNameOrGroup n = go =<< getConfigMaybe (ConfigKey ("remotes." <> encodeBS n))   where 	go (Just l) = catMaybes 		<$> mapM (byName . Just) (splitc ' ' (fromConfigValue l))

@@ -5,6 +5,8 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE RankNTypes #-}+ module Remote.Adb (remote) where  import Annex.Common@@ -189,7 +191,7 @@ retrieve :: AndroidSerial -> AndroidPath -> Retriever retrieve serial adir = fileRetriever $ \dest k _p -> 	let src = androidLocation adir k-	in retrieve' serial src dest+	in retrieve' serial src (fromRawFilePath dest)  retrieve' :: AndroidSerial -> AndroidPath -> FilePath -> Annex () retrieve' serial src dest =@@ -307,7 +309,7 @@ 	mk ('S':'T':'\t':l) = 		let (stat, fn) = separate (== '\t') l 		    sz = fromMaybe 0 (readish (takeWhile (/= ' ') stat))-		    cid = ContentIdentifier (encodeBS' stat)+		    cid = ContentIdentifier (encodeBS stat) 		    loc = mkImportLocation $ toRawFilePath $  		    	Posix.makeRelative (fromAndroidPath adir) fn 		in Just (loc, (cid, sz))@@ -440,7 +442,7 @@ 	return $ case ls of 		Just ["n"] -> Right Nothing 		Just (('S':'T':'\t':stat):[]) -> Right $ Just $-			ContentIdentifier (encodeBS' stat)+			ContentIdentifier (encodeBS stat) 		_ -> Left (ExitFailure 1)   where 	aloc = fromAndroidPath $ androidExportLocation adir loc

@@ -96,8 +96,8 @@ 		, remoteStateHandle = rs 		} -downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification-downloadKey key _file dest p = do+downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification+downloadKey key _file dest p _ = do 	get . map (torrentUrlNum . fst . getDownloader) =<< getBitTorrentUrls key 	-- While bittorrent verifies the hash in the torrent file, 	-- the torrent file itself is downloaded without verification,@@ -215,7 +215,7 @@ 						liftIO $ hClose h 						resetAnnexFilePerm (toRawFilePath f) 						ok <- Url.withUrlOptions $ -							Url.download nullMeterUpdate u f+							Url.download nullMeterUpdate Nothing u f 						when ok $ 							liftIO $ renameFile f (fromRawFilePath torrent) 						return ok

@@ -149,7 +149,7 @@ borgLocal (BorgRepo r) = notElem ':' r  borgArchive :: BorgRepo -> BorgArchiveName -> String-borgArchive (BorgRepo r) n = r ++ "::" ++ decodeBS' n+borgArchive (BorgRepo r) n = r ++ "::" ++ decodeBS n  absBorgRepo :: BorgRepo -> IO BorgRepo absBorgRepo r@(BorgRepo p)

@@ -5,6 +5,8 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE RankNTypes #-}+ module Remote.Bup (remote) where  import qualified Data.Map as M@@ -184,10 +186,11 @@ 	bracketIO (createProcess p) cleanupProcess (go sink p)   where 	go sink p (_, Just h, _, pid) = do-		() <- sink =<< liftIO (L.hGetContents h)+		r <- sink =<< liftIO (L.hGetContents h) 		liftIO $ do 			hClose h 			forceSuccessProcess p pid+		return r 	go _ _ _ = error "internal"  {- Cannot revert having stored a key in bup, but at least the data for the

@@ -7,6 +7,7 @@  -}  {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE RankNTypes #-}  module Remote.Ddar (remote) where @@ -166,10 +167,11 @@ 	bracketIO (createProcess p) cleanupProcess (go sink p)   where 	go sink p (_, Just h, _, pid) = do-		() <- sink =<< liftIO (L.hGetContents h)+		r <- sink =<< liftIO (L.hGetContents h) 		liftIO $ do 			hClose h 			forceSuccessProcess p pid+		return r 	go _ _ _ = error "internal"  remove :: DdarRepo -> Remover

@@ -6,6 +6,7 @@  -}  {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE CPP #-}  module Remote.Directory (@@ -190,7 +191,7 @@ 			in byteStorer go k c m 		NoChunks -> 			let go _k src p = do-				fileCopierUnVerified cow src tmpf k p+				void $ fileCopier cow src tmpf p Nothing 				liftIO $ finalizeStoreGeneric d tmpdir destdir 			in fileStorer go k c m 		_ -> @@ -204,11 +205,6 @@ 	kf = keyFile k 	destdir = storeDir d k -fileCopierUnVerified :: CopyCoWTried -> FilePath -> FilePath -> Key -> MeterUpdate -> Annex ()-fileCopierUnVerified cow src dest k p = do-	(ok, _verification) <- fileCopier cow src dest k p (return True) NoVerify-	unless ok $ giveup "failed to copy file"- checkDiskSpaceDirectory :: RawFilePath -> Key -> Annex Bool checkDiskSpaceDirectory d k = do 	annexdir <- fromRepo gitAnnexObjectDir@@ -236,9 +232,9 @@  retrieveKeyFileM :: RawFilePath -> ChunkConfig -> CopyCoWTried -> Retriever retrieveKeyFileM d (LegacyChunks _) _ = Legacy.retrieve locations d-retrieveKeyFileM d NoChunks cow = fileRetriever $ \dest k p -> do+retrieveKeyFileM d NoChunks cow = fileRetriever' $ \dest k p iv -> do 	src <- liftIO $ fromRawFilePath <$> getLocation d k-	fileCopierUnVerified cow src dest k p+	void $ fileCopier cow src (fromRawFilePath dest) p iv retrieveKeyFileM d _ _ = byteRetriever $ \k sink -> 	sink =<< liftIO (L.readFile . fromRawFilePath =<< getLocation d k) @@ -304,17 +300,17 @@ 	)  storeExportM :: RawFilePath -> CopyCoWTried -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex ()-storeExportM d cow src k loc p = do+storeExportM d cow src _k loc p = do 	liftIO $ createDirectoryUnder d (P.takeDirectory dest) 	-- Write via temp file so that checkPresentGeneric will not 	-- see it until it's fully stored. 	viaTmp go (fromRawFilePath dest) ()   where 	dest = exportPath d loc-	go tmp () = fileCopierUnVerified cow src tmp k p+	go tmp () = void $ fileCopier cow src tmp p Nothing  retrieveExportM :: RawFilePath -> CopyCoWTried -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex ()-retrieveExportM d cow k loc dest p = fileCopierUnVerified cow src dest k p+retrieveExportM d cow _k loc dest p = void $ fileCopier cow src dest p Nothing   where 	src = fromRawFilePath $ exportPath d loc @@ -492,11 +488,11 @@ 		guardSameContentIdentifiers cont cid currcid  storeExportWithContentIdentifierM :: RawFilePath -> CopyCoWTried -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier-storeExportWithContentIdentifierM dir cow src k loc overwritablecids p = do+storeExportWithContentIdentifierM dir cow src _k loc overwritablecids p = do 	liftIO $ createDirectoryUnder dir (toRawFilePath destdir) 	withTmpFileIn destdir template $ \tmpf tmph -> do 		liftIO $ hClose tmph-		fileCopierUnVerified cow src tmpf k p+		void $ fileCopier cow src tmpf p Nothing 		let tmpf' = toRawFilePath tmpf 		resetAnnexFilePerm tmpf' 		liftIO (getFileStatus tmpf) >>= liftIO . mkContentIdentifier tmpf' >>= \case

@@ -8,6 +8,7 @@  -}  {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}  module Remote.Directory.LegacyChunked where @@ -97,7 +98,7 @@  - :/ This is legacy code..  -} retrieve :: (RawFilePath -> Key -> [RawFilePath]) -> RawFilePath -> Retriever-retrieve locations d basek p c = withOtherTmp $ \tmpdir -> do+retrieve locations d basek p miv c = withOtherTmp $ \tmpdir -> do 	showLongNote "This remote uses the deprecated chunksize setting. So this will be quite slow." 	let tmp = tmpdir P.</> keyFile basek <> ".directorylegacy.tmp" 	let tmp' = fromRawFilePath tmp@@ -109,7 +110,7 @@ 		b <- liftIO $ L.readFile tmp' 		liftIO $ removeWhenExistsWith R.removeLink tmp 		sink b-	byteRetriever go basek p c+	byteRetriever go basek p miv c  checkKey :: RawFilePath -> (RawFilePath -> Key -> [RawFilePath]) -> Key -> Annex Bool checkKey d locations k = liftIO $

@@ -7,6 +7,7 @@  {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE RankNTypes #-}  module Remote.External (remote) where @@ -66,17 +67,19 @@ 	| externaltype == "readonly" = do 		c <- parsedRemoteConfig remote rc 		cst <- remoteCost gc expensiveRemoteCost-		mk c cst GloballyAvailable-			readonlyStorer-			retrieveUrl-			readonlyRemoveKey-			checkKeyUrl+		let rmt = mk c cst GloballyAvailable 			Nothing 			(externalInfo externaltype) 			Nothing 			Nothing 			exportUnsupported 			exportUnsupported+		return $ Just $ specialRemote c+			readonlyStorer+			retrieveUrl+			readonlyRemoveKey+			checkKeyUrl+			rmt 	| otherwise = do 		c <- parsedRemoteConfig remote rc 		external <- newExternal externaltype (Just u) c (Just gc)@@ -103,20 +106,22 @@ 		let cheapexportsupported = if exportsupported 			then exportIsSupported 			else exportUnsupported-		mk c cst avail-			(storeKeyM external)-			(retrieveKeyFileM external)-			(removeKeyM external)-			(checkPresentM external)+		let rmt = mk c cst avail 			(Just (whereisKeyM external)) 			(getInfoM external) 			(Just (claimUrlM external)) 			(Just (checkUrlM external)) 			exportactions 			cheapexportsupported+		return $ Just $ specialRemote c+			(storeKeyM external)+			(retrieveKeyFileM external)+			(removeKeyM external)+			(checkPresentM external)+			rmt   where-	mk c cst avail tostore toretrieve toremove tocheckkey towhereis togetinfo toclaimurl tocheckurl exportactions cheapexportsupported = do-		let rmt = Remote+	mk c cst avail towhereis togetinfo toclaimurl tocheckurl exportactions cheapexportsupported =+		Remote 			{ uuid = u 			, cost = cst 			, name = Git.repoDescribe r@@ -154,12 +159,6 @@ 			, checkUrl = tocheckurl 			, remoteStateHandle = rs 			}-		return $ Just $ specialRemote c-			tostore-			toretrieve-			toremove-			tocheckkey-			rmt 	externaltype = fromMaybe (giveup "missing externaltype") (remoteAnnexExternalType gc)  externalSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)@@ -238,7 +237,7 @@ retrieveKeyFileM external = fileRetriever $ \d k p -> 	either giveup return =<< go d k p   where-	go d k p = handleRequestKey external (\sk -> TRANSFER Download sk d) k (Just p) $ \resp ->+	go d k p = handleRequestKey external (\sk -> TRANSFER Download sk (fromRawFilePath d)) k (Just p) $ \resp -> 		case resp of 			TRANSFER_SUCCESS Download k' 				| k == k' -> result $ Right ()@@ -809,9 +808,9 @@ 	mkmulti (u, s, f) = (u, s, f)  retrieveUrl :: Retriever-retrieveUrl = fileRetriever $ \f k p -> do+retrieveUrl = fileRetriever' $ \f k p iv -> do 	us <- getWebUrls k-	unlessM (withUrlOptions $ downloadUrl k p us f) $+	unlessM (withUrlOptions $ downloadUrl True k p iv us (fromRawFilePath f)) $ 		giveup "failed to download content"  checkKeyUrl :: CheckPresent

@@ -6,6 +6,7 @@  -}  {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}  module Remote.GCrypt ( 	remote,@@ -311,7 +312,7 @@ 			, Param tmpconfig 			] 		liftIO $ do-			void $ Git.Config.changeFile tmpconfig coreGCryptId (encodeBS' gcryptid)+			void $ Git.Config.changeFile tmpconfig coreGCryptId (encodeBS gcryptid) 			void $ Git.Config.changeFile tmpconfig denyNonFastForwards (Git.Config.boolConfig' False) 		ok <- liftIO $ rsync $ opts ++ 			[ Param "--recursive"@@ -406,9 +407,9 @@ 	storersync = fileStorer $ Remote.Rsync.store rsyncopts  retrieve :: Remote -> Remote.Rsync.RsyncOpts -> AccessMethod -> Retriever-retrieve r rsyncopts accessmethod k p sink = do+retrieve r rsyncopts accessmethod k p miv sink = do 	repo <- getRepo r-	retrieve' repo r rsyncopts accessmethod k p sink+	retrieve' repo r rsyncopts accessmethod k p miv sink  retrieve' :: Git.Repo -> Remote -> Remote.Rsync.RsyncOpts -> AccessMethod -> Retriever retrieve' repo r rsyncopts accessmethod@@ -417,7 +418,8 @@ 			sink =<< liftIO (L.readFile $ gCryptLocation repo k) 	| Git.repoIsSsh repo = if accessShell r 		then fileRetriever $ \f k p -> do-			ps <- Ssh.rsyncParamsRemote False r Download k f+			ps <- Ssh.rsyncParamsRemote False r Download k+				(fromRawFilePath f) 				(AssociatedFile Nothing) 			oh <- mkOutputHandler 			unlessM (Ssh.rsyncHelper oh (Just p) ps) $

@@ -29,6 +29,7 @@ import Logs.Presence import Annex.Transfer import Annex.CopyFile+import Annex.Verify import Annex.UUID import qualified Annex.Content import qualified Annex.BranchState@@ -291,7 +292,7 @@ 		let url = Git.repoLocation r ++ "/config" 		v <- withTmpFile "git-annex.tmp" $ \tmpfile h -> do 			liftIO $ hClose h-			Url.download' nullMeterUpdate url tmpfile uo >>= \case+			Url.download' nullMeterUpdate Nothing url tmpfile uo >>= \case 				Right () -> pipedconfig Git.Config.ConfigNullList 					False url "git" 					[ Param "config"@@ -528,23 +529,24 @@ 	failedlock = giveup "can't lock content"  {- Tries to copy a key's content from a remote's annex to a file. -}-copyFromRemote :: Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification+copyFromRemote :: Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification copyFromRemote = copyFromRemote' False -copyFromRemote' :: Bool -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification-copyFromRemote' forcersync r st key file dest meterupdate = do+copyFromRemote' :: Bool -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification+copyFromRemote' forcersync r st key file dest meterupdate vc = do 	repo <- getRepo r-	copyFromRemote'' repo forcersync r st key file dest meterupdate+	copyFromRemote'' repo forcersync r st key file dest meterupdate vc -copyFromRemote'' :: Git.Repo -> Bool -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification-copyFromRemote'' repo forcersync r st@(State connpool _ _ _ _) key file dest meterupdate+copyFromRemote'' :: Git.Repo -> Bool -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification+copyFromRemote'' repo forcersync r st@(State connpool _ _ _ _) key file dest meterupdate vc 	| Git.repoIsHttp repo = do+		iv <- startVerifyKeyContentIncrementally vc key 		gc <- Annex.getGitConfig 		ok <- Url.withUrlOptionsPromptingCreds $-			Annex.Content.downloadUrl key meterupdate (keyUrls gc repo r key) dest+			Annex.Content.downloadUrl False key meterupdate iv (keyUrls gc repo r key) dest 		unless ok $ 			giveup "failed to download content"-		return UnVerified+		snd <$> finishVerifyKeyContentIncrementally iv 	| not $ Git.repoIsUrl repo = guardUsable repo (giveup "cannot access remote") $ do 		u <- getUUID 		hardlink <- wantHardLink@@ -554,12 +556,11 @@ 				let checksuccess = check >>= \case 					Just err -> giveup err 					Nothing -> return True-				let verify = Annex.Content.RemoteVerify r 				copier <- mkFileCopier hardlink st 				(ok, v) <- runTransfer (Transfer Download u (fromKey id key)) 					file Nothing stdRetry $ \p -> 						metered (Just (combineMeterUpdate p meterupdate)) key $ \_ p' -> -							copier object dest key p' checksuccess verify+							copier object dest key p' checksuccess vc 				if ok 					then return v 					else giveup "failed to retrieve content from remote"@@ -571,9 +572,8 @@ 				then return v 				else giveup "failed to retrieve content from remote" 		else P2PHelper.retrieve-			(Annex.Content.RemoteVerify r) 			(\p -> Ssh.runProto r connpool (return (False, UnVerified)) (fallback p))-			key file dest meterupdate+			key file dest meterupdate vc 	| otherwise = giveup "copying from non-ssh, non-http remote not supported"   where 	fallback p = unVerified $ feedprogressback $ \p' -> do@@ -698,7 +698,7 @@ 		res <- onLocalFast st $ ifM (Annex.Content.inAnnex key) 			( return True 			, runTransfer (Transfer Download u (fromKey id key)) file Nothing stdRetry $ \p -> do-				let verify = Annex.Content.RemoteVerify r+				let verify = RemoteVerify r 				copier <- mkFileCopier hardlink st 				let rsp = RetrievalAllKeysSecure 				let checksuccess = liftIO checkio >>= \case@@ -839,9 +839,18 @@ 	-- because they can be modified at any time. 	<&&> (not <$> annexThin <$> Annex.getGitConfig) +type FileCopier = FilePath -> FilePath -> Key -> MeterUpdate -> Annex Bool -> VerifyConfig -> Annex (Bool, Verification)++-- If either the remote or local repository wants to use hard links,+-- the copier will do so (falling back to copying if a hard link cannot be+-- made).+--+-- When a hard link is created, returns Verified; the repo being linked+-- from is implicitly trusted, so no expensive verification needs to be+-- done. Also returns Verified if the key's content is verified while+-- copying it. mkFileCopier :: Bool -> State -> Annex FileCopier mkFileCopier remotewanthardlink (State _ _ copycowtried _ _) = do-	let copier = fileCopier copycowtried 	localwanthardlink <- wantHardLink 	let linker = \src dest -> createLink src dest >> return True 	if remotewanthardlink || localwanthardlink@@ -854,6 +863,15 @@ 				, copier src dest k p check verifyconfig 				) 		else return copier+  where+	copier src dest k p check verifyconfig = do+		iv <- startVerifyKeyContentIncrementally verifyconfig k+		fileCopier copycowtried src dest p iv >>= \case+			Copied -> ifM check+				( finishVerifyKeyContentIncrementally iv+				, return (False, UnVerified)+				)+			CopiedCoW -> unVerified check  {- Normally the UUID of a local repository is checked at startup,  - but annex-checkuuid config can prevent that. To avoid getting

@@ -6,6 +6,7 @@  -}  {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE CPP #-}  module Remote.GitLFS (remote, gen, configKnownUrl) where@@ -213,7 +214,7 @@ 	set k v r' = do 		let k' = remoteAnnexConfig r' k 		setConfig k' v-		return $ Git.Config.store' k' (Git.ConfigValue (encodeBS' v)) r'+		return $ Git.Config.store' k' (Git.ConfigValue (encodeBS v)) r'  data LFSHandle = LFSHandle 	{ downloadEndpoint :: Maybe LFS.Endpoint@@ -475,7 +476,7 @@ 						makeSmallAPIRequest . setRequestCheckStatus  retrieve :: RemoteStateHandle -> TVar LFSHandle -> Retriever-retrieve rs h = fileRetriever $ \dest k p -> getLFSEndpoint LFS.RequestDownload h >>= \case+retrieve rs h = fileRetriever' $ \dest k p iv -> getLFSEndpoint LFS.RequestDownload h >>= \case 	Nothing -> giveup "unable to connect to git-lfs endpoint" 	Just endpoint -> mkDownloadRequest rs k >>= \case 		Nothing -> giveup "unable to download this object from git-lfs"@@ -486,9 +487,9 @@ 				(tro:_) 					| LFS.resp_oid tro /= sha256 || LFS.resp_size tro /= size -> 						giveup "git-lfs server replied with other object than the one we requested"-					| otherwise -> go dest p tro+					| otherwise -> go dest p iv tro   where-	go dest p tro = case LFS.resp_error tro of+	go dest p iv tro = case LFS.resp_error tro of 		Just err -> giveup $ T.unpack $ LFS.respobjerr_message err 		Nothing -> case LFS.resp_actions tro of 			Nothing -> giveup "git-lfs server did not provide a way to download this object"@@ -496,7 +497,7 @@ 				Nothing -> giveup "unable to parse git-lfs server download url" 				Just req -> do 					uo <- getUrlOptions-					liftIO $ downloadConduit p req dest uo+					liftIO $ downloadConduit p iv req (fromRawFilePath dest) uo  -- Since git-lfs does not support removing content, nothing needs to be -- done to lock content in the remote, except for checking that the content

@@ -5,6 +5,8 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE RankNTypes #-}+ module Remote.Glacier (remote, jobList, checkSaneGlacierCommand) where  import qualified Data.Map as M@@ -176,7 +178,7 @@ retrieve :: Remote -> Retriever retrieve = byteRetriever . retrieve' -retrieve' :: Remote -> Key -> (L.ByteString -> Annex ()) -> Annex ()+retrieve' :: Remote -> Key -> (L.ByteString -> Annex a) -> Annex a retrieve' r k sink = go =<< glacierEnv c gc u   where 	c = config r

@@ -1,10 +1,12 @@ {- git-annex chunked remotes  -- - Copyright 2014-2020 Joey Hess <id@joeyh.name>+ - Copyright 2014-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE RankNTypes #-}+ module Remote.Helper.Chunked ( 	ChunkSize, 	ChunkConfig(..),@@ -30,6 +32,7 @@ import Crypto import Backend (isStableKey) import Annex.SpecialRemote.Config+import Annex.Verify import qualified Utility.RawFilePath as R  import qualified Data.ByteString as S@@ -250,6 +253,7 @@ 	:: LensGpgEncParams encc 	=> Retriever 	-> UUID+	-> VerifyConfig 	-> ChunkConfig 	-> EncKey 	-> Key@@ -257,23 +261,27 @@ 	-> MeterUpdate 	-> Maybe (Cipher, EncKey) 	-> encc-	-> Annex ()-retrieveChunks retriever u chunkconfig encryptor basek dest basep enc encc-	| noChunks chunkconfig =+	-> Annex Verification+retrieveChunks retriever u vc chunkconfig encryptor basek dest basep enc encc+	| noChunks chunkconfig = do 		-- Optimisation: Try the unchunked key first, to avoid 		-- looking in the git-annex branch for chunk counts 		-- that are likely not there.-		getunchunked `catchNonAsync`-			(\e -> go (Just e) =<< chunkKeysOnly u chunkconfig basek)-	| otherwise = go Nothing =<< chunkKeys u chunkconfig basek+		tryNonAsync getunchunked >>= \case+			Right r -> finalize r+			Left e -> go (Just e)+				=<< chunkKeysOnly u chunkconfig basek+	| otherwise = go Nothing +		=<< chunkKeys u chunkconfig basek   where 	go pe cks = do 		let ls = map chunkKeyList cks 		currsize <- liftIO $ catchMaybeIO $ getFileSize (toRawFilePath dest) 		let ls' = maybe ls (setupResume ls) currsize 		if any null ls'-			then noop -- dest is already complete-			else firstavail pe currsize ls'+			-- dest is already complete+			then finalize (Right Nothing)+			else finalize =<< firstavail pe currsize ls'  	firstavail Nothing _ [] = giveup "unable to determine the chunks to use for this remote" 	firstavail (Just e) _ [] = throwM e@@ -287,35 +295,59 @@ 				(offsetMeterUpdate basep . toBytesProcessed) 				offset 			v <- tryNonAsync $-				retriever (encryptor k) p $ \content ->-					bracketIO (maybe opennew openresume offset) hClose $ \h -> do-						retrieved (Just h) p content+				retriever (encryptor k) p Nothing $ \content ->+					bracket (maybe opennew openresume offset) (liftIO . hClose . fst) $ \(h, iv) -> do+						retrieved iv (Just h) p content 						let sz = toBytesProcessed $ 							fromMaybe 0 $ fromKey keyChunkSize k-						getrest p h sz sz ks+						getrest p h iv sz sz ks 			case v of 				Left e 					| null ls -> throwM e 					| otherwise -> firstavail (Just e) currsize ls 				Right r -> return r -	getrest _ _ _ _ [] = noop-	getrest p h sz bytesprocessed (k:ks) = do+	getrest _ _ iv _ _ [] = return (Right iv)+	getrest p h iv sz bytesprocessed (k:ks) = do 		let p' = offsetMeterUpdate p bytesprocessed 		liftIO $ p' zeroBytesProcessed-		retriever (encryptor k) p' $ retrieved (Just h) p'-		getrest p h sz (addBytesProcessed bytesprocessed sz) ks+		retriever (encryptor k) p' Nothing $ +			retrieved iv (Just h) p'+		getrest p h iv sz (addBytesProcessed bytesprocessed sz) ks -	getunchunked = retriever (encryptor basek) basep $ retrieved Nothing basep+	getunchunked = do+		iv <- startVerifyKeyContentIncrementally vc basek+		case enc of+			Just _ -> do+				retriever (encryptor basek) basep Nothing $+					retrieved iv Nothing basep+				return (Right iv)+			-- Not chunked and not encrypted, so ask the+			-- retriever to incrementally verify when it+			-- retrieves to a file. It may not finish+			-- passing the whole file content to the+			-- incremental verifier though.+			Nothing -> do+				retriever (encryptor basek) basep iv $+					retrieved iv Nothing basep+				return $ case iv of+					Nothing -> Right iv+					Just iv' -> Left (IncompleteVerify iv') -	opennew = openBinaryFile dest WriteMode+	opennew = do+		iv <- startVerifyKeyContentIncrementally vc basek+		h <- liftIO $ openBinaryFile dest WriteMode+		return (h, iv)  	-- Open the file and seek to the start point in order to resume. 	openresume startpoint = do 		-- ReadWriteMode allows seeking; AppendMode does not.-		h <- openBinaryFile dest ReadWriteMode-		hSeek h AbsoluteSeek startpoint-		return h+		h <- liftIO $ openBinaryFile dest ReadWriteMode+		liftIO $ hSeek h AbsoluteSeek startpoint+		-- No incremental verification when resuming, since that+		-- would need to read up to the startpoint.+		let iv = Nothing+		return (h, iv)  	{- Progress meter updating is a bit tricky: If the Retriever 	 - populates a file, it is responsible for updating progress@@ -326,18 +358,29 @@ 	 - Instead, writeRetrievedContent is passed a meter to update 	 - as it consumes the ByteString. 	 -}-	retrieved h p content = writeRetrievedContent dest enc encc h p' content+	retrieved iv h p content =+		writeRetrievedContent dest enc encc h p' content iv 	  where 		p' 			| isByteContent content = Just p 			| otherwise = Nothing+	+	finalize (Right Nothing) = return UnVerified+	finalize (Right (Just iv)) =+		liftIO (finalizeIncremental iv) >>= \case+			Just True -> return Verified+			_ -> return UnVerified+	finalize (Left v) = return v -{- Writes retrieved file content into the provided Handle, decrypting it+{- Writes retrieved file content to the provided Handle, decrypting it  - first if necessary.  -   - If the remote did not store the content using chunks, no Handle- - will be provided, and it's up to us to open the destination file.+ - will be provided, and instead the content will be written to the+ - dest file.  -+ - The IncrementalVerifier is updated as the file content is read.+ -  - Note that when neither chunking nor encryption is used, and the remote  - provides FileContent, that file only needs to be renamed  - into place. (And it may even already be in the right place..)@@ -350,8 +393,9 @@ 	-> Maybe Handle 	-> Maybe MeterUpdate 	-> ContentSource+	-> Maybe IncrementalVerifier 	-> Annex ()-writeRetrievedContent dest enc encc mh mp content = case (enc, mh, content) of+writeRetrievedContent dest enc encc mh mp content miv = case (enc, mh, content) of 	(Nothing, Nothing, FileContent f) 		| f == dest -> noop 		| otherwise -> liftIO $ moveFile f dest@@ -371,10 +415,16 @@ 	(Nothing, _, ByteContent b) -> write b   where 	write b = case mh of-		Just h -> liftIO $ b `streamto` h-		Nothing -> liftIO $ bracket opendest hClose (b `streamto`)-	streamto b h = case mp of-		Just p -> meteredWrite p (S.hPut h) b+		Just h -> liftIO $ write' b h+		Nothing -> liftIO $ bracket opendest hClose (write' b)+	write' b h = case mp of+		Just p -> +			let writer = case miv of+				Just iv -> \s -> do+					updateIncremental iv s+					S.hPut h s+				Nothing -> S.hPut h+			in meteredWrite p writer b 		Nothing -> L.hPut h b 	opendest = openBinaryFile dest WriteMode 

@@ -171,14 +171,14 @@ 		, lockContent = if versioned 			then lockContent r 			else Nothing-		, retrieveKeyFile = \k af dest p ->+		, retrieveKeyFile = \k af dest p vc -> 			if isimport-				then supportversionedretrieve k af dest p $+				then supportversionedretrieve k af dest p vc $ 					retrieveKeyFileFromImport dbv ciddbv k af dest p 				else if isexport-					then supportversionedretrieve k af dest p $+					then supportversionedretrieve k af dest p vc $ 						retrieveKeyFileFromExport dbv k af dest p-					else retrieveKeyFile r k af dest p+					else retrieveKeyFile r k af dest p vc 		, retrieveKeyFileCheap = if versioned 			then retrieveKeyFileCheap r 			else Nothing@@ -369,9 +369,9 @@ 	-- versionedExport remotes have a key/value store, so can use 	-- the usual retrieveKeyFile, rather than an import/export 	-- variant. However, fall back to that if retrieveKeyFile fails.-	supportversionedretrieve k af dest p a+	supportversionedretrieve k af dest p vc a 		| versionedExport (exportActions r) =-			retrieveKeyFile r k af dest p+			retrieveKeyFile r k af dest p vc 				`catchNonAsync` const a 		| otherwise = a 

@@ -34,8 +34,10 @@ addHooks' r starthook stophook = r'   where 	r' = r-		{ storeKey = \k f p -> wrapper $ storeKey r k f p-		, retrieveKeyFile = \k f d p -> wrapper $ retrieveKeyFile r k f d p+		{ storeKey = \k f p -> +			wrapper $ storeKey r k f p+		, retrieveKeyFile = \k f d p vc -> +			wrapper $ retrieveKeyFile r k f d p vc 		, retrieveKeyFileCheap = case retrieveKeyFileCheap r of 			Just a -> Just $ \k af f -> wrapper $ a k af f 			Nothing -> Nothing

@@ -1,6 +1,6 @@ {- helpers for remotes using http  -- - Copyright 2014 Joey Hess <id@joeyh.name>+ - Copyright 2014-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -13,6 +13,7 @@ import Types.StoreRetrieve import Remote.Helper.Special import Utility.Metered+import Utility.Hash (IncrementalVerifier(..))  import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as S@@ -67,9 +68,9 @@ 	target = toBytesProcessed (numchunks * fromIntegral chunksize)  -- Reads the http body and stores it to the specified file, updating the--- meter as it goes.-httpBodyRetriever :: FilePath -> MeterUpdate -> Response BodyReader -> IO ()-httpBodyRetriever dest meterupdate resp+-- meter and incremental verifier as it goes.+httpBodyRetriever :: FilePath -> MeterUpdate -> Maybe IncrementalVerifier -> Response BodyReader -> IO ()+httpBodyRetriever dest meterupdate iv resp 	| responseStatus resp /= ok200 = giveup $ show $ responseStatus resp 	| otherwise = bracket (openBinaryFile dest WriteMode) hClose (go zeroBytesProcessed)   where@@ -82,4 +83,5 @@ 				let sofar' = addBytesProcessed sofar $ S.length b 				S.hPut h b 				meterupdate sofar'+				maybe noop (flip updateIncremental b) iv 				go sofar' h

@@ -40,8 +40,8 @@ 			Just False -> giveup "Transfer failed" 			Nothing -> remoteUnavail -retrieve :: VerifyConfig -> (MeterUpdate -> ProtoRunner (Bool, Verification)) -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification-retrieve verifyconfig runner k af dest p = do+retrieve :: (MeterUpdate -> ProtoRunner (Bool, Verification)) -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification+retrieve runner k af dest p verifyconfig = do 	iv <- startVerifyKeyContentIncrementally verifyconfig k 	metered (Just p) k $ \m p' ->  		runner p' (P2P.get dest k iv af m p') >>= \case

@@ -1,10 +1,11 @@ {- helpers for special remotes  -- - Copyright 2011-2020 Joey Hess <id@joeyh.name>+ - Copyright 2011-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE OverloadedStrings #-}  module Remote.Helper.Special (@@ -19,6 +20,7 @@ 	fileStorer, 	byteStorer, 	fileRetriever,+	fileRetriever', 	byteRetriever, 	storeKeyDummy, 	retrieveKeyFileDummy,@@ -38,6 +40,7 @@ import Annex.SpecialRemote.Config import Types.StoreRetrieve import Types.Remote+import Annex.Verify import Annex.UUID import Config import Config.Cost@@ -53,6 +56,8 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified Data.Map as M+import Control.Concurrent.STM+import Control.Concurrent.Async  {- Special remotes don't have a configured url, so Git.Repo does not  - automatically generate remotes for them. This looks for a different@@ -68,13 +73,13 @@ 		(pure Git.Construct.fromUnknown) 	match (ConfigKey k) _ = 		"remote." `S.isPrefixOf` k -		&& (".annex-" <> encodeBS' s) `S.isSuffixOf` k+		&& (".annex-" <> encodeBS s) `S.isSuffixOf` k  {- Sets up configuration for a special remote in .git/config. -} gitConfigSpecialRemote :: UUID -> RemoteConfig -> [(String, String)] -> Annex () gitConfigSpecialRemote u c cfgs = do 	forM_ cfgs $ \(k, v) -> -		setConfig (remoteAnnexConfig c (encodeBS' k)) v+		setConfig (remoteAnnexConfig c (encodeBS k)) v 	storeUUIDIn (remoteAnnexConfig c "uuid") u  -- RetrievalVerifiableKeysSecure unless overridden by git config.@@ -100,20 +105,40 @@ byteStorer :: (Key -> L.ByteString -> MeterUpdate -> Annex ()) -> Storer byteStorer a k c m = withBytes c $ \b -> a k b m --- A Retriever that writes the content of a Key to a provided file.--- It is responsible for updating the progress meter as it retrieves data.-fileRetriever :: (FilePath -> Key -> MeterUpdate -> Annex ()) -> Retriever-fileRetriever a k m callback = do-	f <- prepTmp k-	a (fromRawFilePath f) k m-	pruneTmpWorkDirBefore f (callback . FileContent . fromRawFilePath)- -- A Retriever that generates a lazy ByteString containing the Key's -- content, and passes it to a callback action which will fully consume it -- before returning.-byteRetriever :: (Key -> (L.ByteString -> Annex ()) -> Annex ()) -> Retriever-byteRetriever a k _m callback = a k (callback . ByteContent)+byteRetriever :: (Key -> (L.ByteString -> Annex a) -> Annex a) -> Key -> MeterUpdate -> Maybe IncrementalVerifier -> (ContentSource -> Annex a) -> Annex a+byteRetriever a k _m _miv callback = a k (callback . ByteContent) +-- A Retriever that writes the content of a Key to a provided file.+-- The action is responsible for updating the progress meter as it +-- retrieves data. The incremental verifier is updated in the background as+-- the action writes to the file, but may not be updated with the entire+-- content of the file.+fileRetriever :: (RawFilePath -> Key -> MeterUpdate -> Annex ()) -> Retriever+fileRetriever a = fileRetriever' $ \f k m miv -> do+	let retrieve = a f k m+	case miv of+		Nothing -> retrieve+		Just iv -> do+			finished <- liftIO newEmptyTMVarIO+			t <- liftIO $ async $ tailVerify iv f finished+			let finishtail = do+				liftIO $ atomically $ putTMVar finished ()+				liftIO (wait t)+			retrieve `finally` finishtail++{- A Retriever that writes the content of a Key to a provided file.+ - The action is responsible for updating the progress meter and the + - incremental verifier as it retrieves data.+ -}+fileRetriever' :: (RawFilePath -> Key -> MeterUpdate -> Maybe IncrementalVerifier -> Annex ()) -> Retriever+fileRetriever' a k m miv callback = do+	f <- prepTmp k+	a f k m miv+	pruneTmpWorkDirBefore f (callback . FileContent . fromRawFilePath)+ {- The base Remote that is provided to specialRemote needs to have  - storeKey, retrieveKeyFile, removeKey, and checkPresent methods,  - but they are never actually used (since specialRemote replaces them).@@ -121,8 +146,8 @@  -} storeKeyDummy :: Key -> AssociatedFile -> MeterUpdate -> Annex () storeKeyDummy _ _ _ = error "missing storeKey implementation"-retrieveKeyFileDummy :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification-retrieveKeyFileDummy _ _ _ _ = error "missing retrieveKeyFile implementation"+retrieveKeyFileDummy :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification+retrieveKeyFileDummy _ _ _ _ _ = error "missing retrieveKeyFile implementation" removeKeyDummy :: Key -> Annex () removeKeyDummy _ = error "missing removeKey implementation" checkPresentDummy :: Key -> Annex Bool@@ -167,7 +192,7 @@   where 	encr = baser 		{ storeKey = \k _f p -> cip >>= storeKeyGen k p-		, retrieveKeyFile = \k _f d p -> cip >>= retrieveKeyFileGen k d p+		, retrieveKeyFile = \k _f d p vc -> cip >>= retrieveKeyFileGen k d p vc 		, retrieveKeyFileCheap = case retrieveKeyFileCheap baser of 			Nothing -> Nothing 			Just a@@ -216,11 +241,10 @@ 		enck = maybe id snd enc  	-- call retriever to get chunks; decrypt them; stream to dest file-	retrieveKeyFileGen k dest p enc = do+	retrieveKeyFileGen k dest p vc enc = 		displayprogress p k Nothing $ \p' ->-			retrieveChunks retriever (uuid baser) chunkconfig-				enck k dest p' enc encr-		return UnVerified+			retrieveChunks retriever (uuid baser) vc+				chunkconfig enck k dest p' enc encr 	  where 		enck = maybe id snd enc 

@@ -5,6 +5,8 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE RankNTypes #-}+ module Remote.Hook (remote) where  import Annex.Common@@ -131,8 +133,8 @@ 				else return $ Just fallback 		else return $ Just command   where-	hook = annexConfig $ encodeBS' $ hookname ++ "-" ++ action ++ "-hook"-	hookfallback = annexConfig $ encodeBS' $ hookname ++ "-hook"+	hook = annexConfig $ encodeBS $ hookname ++ "-" ++ action ++ "-hook"+	hookfallback = annexConfig $ encodeBS $ hookname ++ "-hook"  runHook :: HookName -> Action -> Key -> Maybe FilePath -> Annex () runHook hook action k f = lookupHook hook action >>= \case@@ -160,7 +162,7 @@  retrieve :: HookName -> Retriever retrieve h = fileRetriever $ \d k _p ->-	unlessM (runHook' h "retrieve" k (Just d) $ return True) $+	unlessM (runHook' h "retrieve" k (Just (fromRawFilePath d)) $ return True) $ 		giveup "failed to retrieve content"  remove :: HookName -> Remover

@@ -1,6 +1,6 @@ {- HttpAlso remote (readonly).  -- - Copyright 2020 Joey Hess <id@joeyh.name>+ - Copyright 2020-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -20,6 +20,7 @@ import Creds import Messages.Progress import Utility.Metered+import Annex.Verify import qualified Annex.Url as Url import Annex.SpecialRemote.Config @@ -113,20 +114,21 @@ 	gitConfigSpecialRemote u c' [("httpalso", "true")] 	return (c', u) -downloadKey :: Maybe URLString -> LearnedLayout -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification-downloadKey baseurl ll key _af dest p = do-	downloadAction dest p key (keyUrlAction baseurl ll key)-	return UnVerified+downloadKey :: Maybe URLString -> LearnedLayout -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification+downloadKey baseurl ll key _af dest p vc = do+	iv <- startVerifyKeyContentIncrementally vc key+	downloadAction dest p iv key (keyUrlAction baseurl ll key)+	snd <$> finishVerifyKeyContentIncrementally iv  retriveExportHttpAlso :: Maybe URLString -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex () retriveExportHttpAlso baseurl key loc dest p = -	downloadAction dest p key (exportLocationUrlAction baseurl loc)+	downloadAction dest p Nothing key (exportLocationUrlAction baseurl loc) -downloadAction :: FilePath -> MeterUpdate -> Key -> ((URLString -> Annex (Either String ())) -> Annex (Either String ())) -> Annex ()-downloadAction dest p key run =+downloadAction :: FilePath -> MeterUpdate -> Maybe IncrementalVerifier -> Key -> ((URLString -> Annex (Either String ())) -> Annex (Either String ())) -> Annex ()+downloadAction dest p iv key run = 	Url.withUrlOptions $ \uo -> 		meteredFile dest (Just p) key $-			run (\url -> Url.download' p url dest uo)+			run (\url -> Url.download' p iv url dest uo) 				>>= either giveup (const (return ()))  checkKey :: Maybe URLString -> LearnedLayout -> Key -> Annex Bool

@@ -13,7 +13,6 @@ import Annex.Common import qualified Annex import qualified P2P.Protocol as P2P-import qualified Annex.Content import P2P.Address import P2P.Annex import P2P.IO@@ -57,7 +56,7 @@ 		, cost = cst 		, name = Git.repoDescribe r 		, storeKey = store (const protorunner)-		, retrieveKeyFile = retrieve (Annex.Content.RemoteVerify this) (const protorunner)+		, retrieveKeyFile = retrieve (const protorunner) 		, retrieveKeyFileCheap = Nothing 		, retrievalSecurityPolicy = RetrievalAllKeysSecure 		, removeKey = remove protorunner

@@ -76,10 +76,7 @@ 		fromMaybe (giveup "missing rsyncurl") $ remoteAnnexRsyncUrl gc 	let o = genRsyncOpts c gc transport url 	let islocal = rsyncUrlIsPath $ rsyncUrl o-	let specialcfg = (specialRemoteCfg c)-		-- Rsync displays its own progress.-		{ displayProgress = False }-	return $ Just $ specialRemote' specialcfg c+	return $ Just $ specialRemote c 		(fileStorer $ store o) 		(fileRetriever $ retrieve o) 		(remove o)@@ -238,8 +235,8 @@ 			] 		else return False -retrieve :: RsyncOpts -> FilePath -> Key -> MeterUpdate -> Annex ()-retrieve o f k p = rsyncRetrieveKey o k f (Just p)+retrieve :: RsyncOpts -> RawFilePath -> Key -> MeterUpdate -> Annex ()+retrieve o f k p = rsyncRetrieveKey o k (fromRawFilePath f) (Just p)  retrieveCheap :: RsyncOpts -> Key -> AssociatedFile -> FilePath -> Annex () retrieveCheap o k _af f = ifM (preseedTmp k f)@@ -381,13 +378,12 @@  rsyncRemote :: Direction -> RsyncOpts -> Maybe MeterUpdate -> [CommandParam] -> Annex Bool rsyncRemote direction o m params = do-	showOutput -- make way for progress bar 	opts <- mkopts 	let ps = opts ++ Param "--progress" : params 	case m of 		Nothing -> liftIO $ rsync ps 		Just meter -> do-			oh <- mkOutputHandler+			oh <- mkOutputHandlerQuiet 			liftIO $ rsyncProgress oh meter ps   where 	mkopts

@@ -8,6 +8,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE CPP #-}  module Remote.S3 (remote, iaHost, configIA, iaItemUrl) where@@ -59,6 +60,7 @@ import Types.ProposedAccepted import Types.NumCopies import Utility.Metered+import Utility.Hash (IncrementalVerifier) import Utility.DataUnits import Annex.Content import qualified Annex.Url as Url@@ -400,32 +402,32 @@  - out to the file. Would be better to implement a byteRetriever, but  - that is difficult. -} retrieve :: S3HandleVar -> Remote -> RemoteStateHandle -> ParsedRemoteConfig -> S3Info -> Retriever-retrieve hv r rs c info = fileRetriever $ \f k p -> withS3Handle hv $ \case+retrieve hv r rs c info = fileRetriever' $ \f k p iv -> withS3Handle hv $ \case 	(Just h) ->  		eitherS3VersionID info rs c k (T.pack $ bucketObject info k) >>= \case 			Left failreason -> do 				warning failreason 				giveup "cannot download content"-			Right loc -> retrieveHelper info h loc f p+			Right loc -> retrieveHelper info h loc (fromRawFilePath f) p iv 	Nothing -> 		getPublicWebUrls' (uuid r) rs info c k >>= \case 			Left failreason -> do 				warning failreason 				giveup "cannot download content"-			Right us -> unlessM (withUrlOptions $ downloadUrl k p us f) $+			Right us -> unlessM (withUrlOptions $ downloadUrl False k p iv us (fromRawFilePath f)) $ 				giveup "failed to download content" -retrieveHelper :: S3Info -> S3Handle -> (Either S3.Object S3VersionID) -> FilePath -> MeterUpdate -> Annex ()-retrieveHelper info h loc f p = retrieveHelper' h f p $+retrieveHelper :: S3Info -> S3Handle -> (Either S3.Object S3VersionID) -> FilePath -> MeterUpdate -> Maybe IncrementalVerifier -> Annex ()+retrieveHelper info h loc f p iv = retrieveHelper' h f p iv $ 	case loc of 		Left o -> S3.getObject (bucket info) o 		Right (S3VersionID o vid) -> (S3.getObject (bucket info) o) 			{ S3.goVersionId = Just vid } -retrieveHelper' :: S3Handle -> FilePath -> MeterUpdate -> S3.GetObject -> Annex ()-retrieveHelper' h f p req = liftIO $ runResourceT $ do+retrieveHelper' :: S3Handle -> FilePath -> MeterUpdate -> Maybe IncrementalVerifier -> S3.GetObject -> Annex ()+retrieveHelper' h f p iv req = liftIO $ runResourceT $ do 	S3.GetObjectResponse { S3.gorResponse = rsp } <- sendS3Handle h req-	Url.sinkResponseFile p zeroBytesProcessed f WriteMode rsp+	Url.sinkResponseFile p iv zeroBytesProcessed f WriteMode rsp  remove :: S3HandleVar -> Remote -> S3Info -> Remover remove hv r info k = withS3HandleOrFail (uuid r) hv $ \h -> do@@ -496,11 +498,11 @@ retrieveExportS3 :: S3HandleVar -> Remote -> S3Info -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex () retrieveExportS3 hv r info _k loc f p = do 	withS3Handle hv $ \case-		Just h -> retrieveHelper info h (Left (T.pack exportloc)) f p+		Just h -> retrieveHelper info h (Left (T.pack exportloc)) f p Nothing 		Nothing -> case getPublicUrlMaker info of 			Just geturl -> either giveup return =<< 				Url.withUrlOptions-					(Url.download' p (geturl exportloc) f)+					(Url.download' p Nothing (geturl exportloc) f) 			Nothing -> giveup $ needS3Creds (uuid r)   where 	exportloc = bucketExportLocation info loc@@ -648,7 +650,7 @@ retrieveExportWithContentIdentifierS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> ExportLocation -> ContentIdentifier -> FilePath -> Annex Key -> MeterUpdate -> Annex Key retrieveExportWithContentIdentifierS3 hv r rs info loc cid dest mkkey p = withS3Handle hv $ \case 	Just h -> do-		rewritePreconditionException $ retrieveHelper' h dest p $+		rewritePreconditionException $ retrieveHelper' h dest p Nothing $ 			limitGetToContentIdentifier cid $ 				S3.getObject (bucket info) o 		k <- mkkey

@@ -144,8 +144,8 @@ 		(giveup "tahoe failed to store content") 		(\cap -> storeCapability rs k cap) -retrieve :: RemoteStateHandle -> TahoeHandle -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification-retrieve rs hdl k _f d _p = do+retrieve :: RemoteStateHandle -> TahoeHandle -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification+retrieve rs hdl k _f d _p _ = do 	go =<< getCapability rs k 	-- Tahoe verifies the content it retrieves using cryptographically 	-- secure methods.

@@ -1,6 +1,6 @@ {- Web remote.  -- - Copyright 2011 Joey Hess <id@joeyh.name>+ - Copyright 2011-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -13,6 +13,7 @@ import qualified Git import qualified Git.Construct import Annex.Content+import Annex.Verify import Config.Cost import Config import Logs.Web@@ -81,20 +82,34 @@ 		, remoteStateHandle = rs 		} -downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification-downloadKey key _af dest p = do-	get =<< getWebUrls key-	return UnVerified+downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification+downloadKey key _af dest p vc = go =<< getWebUrls key   where-	get [] = giveup "no known url"-	get urls = do-		r <- untilTrue urls $ \u -> do-			let (u', downloader) = getDownloader u-			case downloader of-				YoutubeDownloader -> youtubeDlTo key u' dest p-				_ -> Url.withUrlOptions $ downloadUrl key p [u'] dest-		unless r $-			giveup "download failed"+	go [] = giveup "no known url"+	go urls = dl (partition (not . isyoutube) (map getDownloader urls)) >>= \case+		Just v -> return v+		Nothing -> giveup $ unwords+			[ "downloading from all"+			, show (length urls)+			, "known url(s) failed"+			]++	dl ([], ytus) = flip getM (map fst ytus) $ \u ->+		ifM (youtubeDlTo key u dest p)+			( return (Just UnVerified)+			, return Nothing+			)+	dl (us, ytus) = do+		iv <- startVerifyKeyContentIncrementally vc key+		ifM (Url.withUrlOptions $ downloadUrl True key p iv (map fst us) dest)+			( finishVerifyKeyContentIncrementally iv >>= \case+				(True, v) -> return (Just v)+				(False, _) -> dl ([], ytus)+			, dl ([], ytus)+			)++	isyoutube (_, YoutubeDownloader) = True+	isyoutube _ = False  uploadKey :: Key -> AssociatedFile -> MeterUpdate -> Annex () uploadKey _ _ _ = giveup "upload to web not supported"

@@ -1,12 +1,13 @@ {- WebDAV remotes.  -- - Copyright 2012-2020 Joey Hess <id@joeyh.name>+ - Copyright 2012-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}  module Remote.WebDAV (remote, davCreds, configUrl) where @@ -39,6 +40,7 @@ import Creds import Utility.Metered import Utility.Url (URLString, matchStatusCodeException, matchHttpExceptionContent)+import Utility.Hash (IncrementalVerifier(..)) import Annex.UUID import Remote.WebDAV.DavLocation import Types.ProposedAccepted@@ -167,17 +169,20 @@ 	moveDAV (baseURL dav) tmp dest  retrieve :: DavHandleVar -> ChunkConfig -> Retriever-retrieve hv cc = fileRetriever $ \d k p ->+retrieve hv cc = fileRetriever' $ \d k p iv -> 	withDavHandle hv $ \dav -> case cc of-		LegacyChunks _ -> retrieveLegacyChunked d k p dav-		_ -> liftIO $-			goDAV dav $ retrieveHelper (keyLocation k) d p+		LegacyChunks _ -> do+			-- Not doing incremental verification for chunks.+			liftIO $ maybe noop unableIncremental iv+			retrieveLegacyChunked (fromRawFilePath d) k p dav+		_ -> liftIO $ goDAV dav $+			retrieveHelper (keyLocation k) (fromRawFilePath d) p iv -retrieveHelper :: DavLocation -> FilePath -> MeterUpdate -> DAVT IO ()-retrieveHelper loc d p = do+retrieveHelper :: DavLocation -> FilePath -> MeterUpdate -> Maybe IncrementalVerifier -> DAVT IO ()+retrieveHelper loc d p iv = do 	debugDav $ "retrieve " ++ loc 	inLocation loc $-		withContentM $ httpBodyRetriever d p+		withContentM $ httpBodyRetriever d p iv  remove :: DavHandleVar -> Remover remove hv k = withDavHandle hv $ \dav -> liftIO $ goDAV dav $@@ -216,7 +221,7 @@ retrieveExportDav :: DavHandleVar -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex () retrieveExportDav hdl  _k loc d p = case exportLocation loc of 	Right src -> withDavHandle hdl $ \h -> runExport h $ \_dav ->-		retrieveHelper src d p+		retrieveHelper src d p Nothing 	Left err -> giveup err  checkPresentExportDav :: DavHandleVar -> Remote -> Key -> ExportLocation -> Annex Bool

@@ -75,6 +75,7 @@ import qualified Utility.Format import qualified Utility.Verifiable import qualified Utility.Process+import qualified Utility.Process.Transcript import qualified Utility.Misc import qualified Utility.InodeCache import qualified Utility.Env@@ -309,6 +310,7 @@ unitTests note = testGroup ("Unit Tests " ++ note) 	[ testCase "add dup" test_add_dup 	, testCase "add extras" test_add_extras+	, testCase "readonly" test_readonly 	, testCase "ignore deleted files" test_ignore_deleted_files 	, testCase "metadata" test_metadata 	, testCase "export_import" test_export_import@@ -427,6 +429,29 @@ 	annexed_present wormannexedfile 	checkbackend wormannexedfile backendWORM +test_readonly :: Assertion+test_readonly =+#ifndef mingw32_HOST_OS+	withtmpclonerepo $ \r1 ->+		withtmpclonerepo $ \r2 -> do+			pair r1 r2+			indir r1 $ do+				git_annex "get" [annexedfile] "get failed in first repo"+			{- chmod may fail, or not be available, or the+			 - filesystem not support permissions. -}+			void $ Utility.Process.Transcript.processTranscript+				"chmod" ["-R", "-w", r1] Nothing+			indir r2 $ do+				git_annex "sync" ["r1", "--no-push"] "sync with readonly repo"+				git_annex "get" [annexedfile, "--from", "r1"] "get from readonly repo"+				git "remote" ["rm", "origin"] "remote rm"+				git_annex "drop" [annexedfile] "drop vs readonly repo"+#else+	-- This test does not work on Windows, and it doesn't make sense to+	-- try to support this on Windows anyway.+	return ()+#endif+ test_ignore_deleted_files :: Assertion test_ignore_deleted_files = intmpclonerepo $ do 	git_annex "get" [annexedfile] "get"@@ -1639,14 +1664,6 @@ 			git_annex "sync" [] "sync" 			git "checkout" [origbranch] "git checkout" 			doesFileExist "a/b/x/y" @? ("a/b/x/y missing from master after adjusted branch sync")--{- Set up repos as remotes of each other. -}-pair :: FilePath -> FilePath -> Assertion-pair r1 r2 = forM_ [r1, r2] $ \r -> indir r $ do-	when (r /= r1) $-		git "remote" ["add", "r1", "../../" ++ r1] "remote add"-	when (r /= r2) $-		git "remote" ["add", "r2", "../../" ++ r2] "remote add"  test_map :: Assertion test_map = intmpclonerepo $ do

@@ -108,7 +108,7 @@  with_ssh_origin :: (Assertion -> Assertion) -> (Assertion -> Assertion) with_ssh_origin cloner a = cloner $ do-	let k = Git.Types.ConfigKey (encodeBS' config)+	let k = Git.Types.ConfigKey (encodeBS config) 	let v = Git.Types.ConfigValue (toRawFilePath "/dev/null") 	origindir <- absPath . Git.Types.fromConfigValue 		=<< annexeval (Config.getConfig k v)@@ -631,3 +631,12 @@ origBranch = maybe "foo" 	(Git.Types.fromRef . Git.Ref.base . Annex.AdjustedBranch.fromAdjustedBranch) 	<$> Annex.inRepo Git.Branch.current++{- Set up repos as remotes of each other. -}+pair :: FilePath -> FilePath -> Assertion+pair r1 r2 = forM_ [r1, r2] $ \r -> indir r $ do+	when (r /= r1) $+		git "remote" ["add", "r1", "../../" ++ r1] "remote add"+	when (r /= r2) $+		git "remote" ["add", "r2", "../../" ++ r2] "remote add"+

@@ -15,6 +15,7 @@ 	RemoteGitConfig(..), 	Remote, 	RemoteType,+	VerifyConfig, ) where  import Annex@@ -27,3 +28,4 @@ type Backend = BackendA Annex type Remote = RemoteA Annex type RemoteType = RemoteTypeA Annex+type VerifyConfig = VerifyConfigA Annex

@@ -65,7 +65,7 @@ actionItemDesc (ActionItemFailedTransfer t i) = actionItemDesc $ 	ActionItemAssociatedFile (associatedFile i) (transferKey t) actionItemDesc (ActionItemTreeFile f) = f-actionItemDesc (ActionItemOther s) = encodeBS' (fromMaybe "" s)+actionItemDesc (ActionItemOther s) = encodeBS (fromMaybe "" s) actionItemDesc (OnlyActionOn _ ai) = actionItemDesc ai  actionItemKey :: ActionItem -> Maybe Key

@@ -13,8 +13,7 @@ import Types.KeySource import Utility.Metered import Utility.FileSystemEncoding--import Data.ByteString (ByteString)+import Utility.Hash (IncrementalVerifier)  data BackendA a = Backend 	{ backendVariety :: KeyVariety@@ -43,11 +42,3 @@  instance Eq (BackendA a) where 	a == b = backendVariety a == backendVariety b--data IncrementalVerifier = IncrementalVerifier-	{ updateIncremental :: ByteString -> IO ()-	-- ^ Called repeatedly on each peice of the content.-	, finalizeIncremental :: IO Bool-	-- ^ Called once the full content has been sent, returns true-	-- if the hash verified.-	}

@@ -95,6 +95,7 @@ 	, annexDebugFilter :: Maybe String 	, annexWebOptions :: [String] 	, annexYoutubeDlOptions :: [String]+	, annexYoutubeDlCommand :: Maybe String 	, annexAriaTorrentOptions :: [String] 	, annexCrippledFileSystem :: Bool 	, annexLargeFiles :: GlobalConfigurable (Maybe String)@@ -180,6 +181,7 @@ 	, annexDebugFilter = getmaybe (annexConfig "debugfilter") 	, annexWebOptions = getwords (annexConfig "web-options") 	, annexYoutubeDlOptions = getwords (annexConfig "youtube-dl-options")+	, annexYoutubeDlCommand = getmaybe (annexConfig "youtube-dl-command") 	, annexAriaTorrentOptions = getwords (annexConfig "aria-torrent-options") 	, annexCrippledFileSystem = getbool (annexConfig "crippledfilesystem") False 	, annexLargeFiles = configurable Nothing $@@ -476,4 +478,4 @@ {- A per-remote setting in git config. -} remoteConfig :: RemoteNameable r => r -> UnqualifiedConfigKey -> ConfigKey remoteConfig r key = ConfigKey $-	"remote." <> encodeBS' (getRemoteName r) <> "." <> key+	"remote." <> encodeBS (getRemoteName r) <> "." <> key

@@ -2,7 +2,7 @@  -  - Most things should not need this, using Types instead  -- - Copyright 2011-2020 Joey Hess <id@joeyh.name>+ - Copyright 2011-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -16,6 +16,7 @@ 	, RemoteStateHandle 	, SetupStage(..) 	, Availability(..)+	, VerifyConfigA(..) 	, Verification(..) 	, unVerified 	, RetrievalSecurityPolicy(..)@@ -41,6 +42,7 @@ import Types.Export import Types.Import import Types.RemoteConfig+import Utility.Hash (IncrementalVerifier) import Config.Cost import Utility.Metered import Git.Types (RemoteName)@@ -94,7 +96,7 @@ 	-- (The MeterUpdate does not need to be used if it writes 	-- sequentially to the file.) 	-- Throws exception on failure.-	, retrieveKeyFile :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> a Verification+	, retrieveKeyFile :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfigA a -> a Verification 	-- Retrieves a key's contents to a tmp file, if it can be done cheaply. 	-- It's ok to create a symlink or hardlink. 	-- Throws exception on failure.@@ -191,6 +193,12 @@ instance ToUUID (RemoteA a) where 	toUUID = uuid +data VerifyConfigA a+	= AlwaysVerify+	| NoVerify+	| RemoteVerify (RemoteA a)+	| DefaultVerify+ data Verification 	= UnVerified  	-- ^ Content was not verified during transfer, but is probably@@ -203,7 +211,9 @@ 	| MustVerify 	-- ^ Content likely to have been altered during transfer, 	-- verify even if verification is normally disabled-	deriving (Show)+	| IncompleteVerify IncrementalVerifier+	-- ^ Content was partially verified during transfer, but+	-- the verification is not complete.  unVerified :: Monad m => m a -> m (a, Verification) unVerified a = do

@@ -1,14 +1,17 @@ {- Types for Storer and Retriever actions for remotes.  -- - Copyright 2014 Joey Hess <id@joeyh.name>+ - Copyright 2014-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE RankNTypes #-}+ module Types.StoreRetrieve where  import Annex.Common import Utility.Metered+import Utility.Hash (IncrementalVerifier)  import qualified Data.ByteString.Lazy as L @@ -27,8 +30,17 @@  -- Action that retrieves a Key's content from a remote, passing it to a -- callback, which will fully consume the content before returning.+-- -- Throws exception if key is not present, or remote is not accessible.-type Retriever = Key -> MeterUpdate -> (ContentSource -> Annex ()) -> Annex ()+--+-- When it retrieves FileContent, it is responsible for updating the+-- MeterUpdate. And when the IncrementalVerifier is passed to it,+-- and it retrieves FileContent, it can feed some or all of the file's+-- content to the verifier before running the callback.+-- This should not be done when it retrieves ByteContent.+type Retriever = forall a.+	Key -> MeterUpdate -> Maybe IncrementalVerifier+		-> (ContentSource -> Annex a) -> Annex a  -- Action that removes a Key's content from a remote. -- Succeeds if key is already not present.

@@ -48,10 +48,10 @@ 		| otherwise = UUID b  instance FromUUID String where-	fromUUID s = decodeBS' (fromUUID s)+	fromUUID s = decodeBS (fromUUID s)  instance ToUUID String where-	toUUID s = toUUID (encodeBS' s)+	toUUID s = toUUID (encodeBS s)  instance FromUUID ConfigValue where 	fromUUID s = (ConfigValue (fromUUID s))

@@ -1,9 +1,6 @@ {- git-annex vector clocks  -- - We don't have a way yet to keep true distributed vector clocks.- - The next best thing is a timestamp.- -- - Copyright 2017-2020 Joey Hess <id@joeyh.name>+ - Copyright 2017-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -20,6 +17,11 @@ -- Unknown is used for those. data VectorClock = Unknown | VectorClock POSIXTime 	deriving (Eq, Ord, Show)++-- | This is a candidate value to use in a VectorClock. It+-- may not be suitable to use this, when a previously used VectorClock+-- is the same or higher.+data CandidateVectorClock = CandidateVectorClock POSIXTime  -- Unknown is oldest. prop_VectorClock_sane :: Bool

@@ -93,7 +93,7 @@ push :: Annex () push = do 	origin_master <- inRepo $ Git.Ref.exists $ -		Git.Ref $ encodeBS' "origin/master"+		Git.Ref $ encodeBS "origin/master" 	origin_gitannex <- Annex.Branch.hasOrigin 	case (origin_master, origin_gitannex) of 		(_, True) -> do

@@ -60,7 +60,7 @@ fromDirectBranch :: Ref -> Ref fromDirectBranch directhead = case splitc '/' $ fromRef directhead of 	("refs":"heads":"annex":"direct":rest) -> -		Ref $ encodeBS' $ "refs/heads/" ++ intercalate "/" rest+		Ref $ encodeBS $ "refs/heads/" ++ intercalate "/" rest 	_ -> directhead  switchHEADBack :: Annex ()

@@ -1,6 +1,6 @@ {- file copying  -- - Copyright 2010-2019 Joey Hess <id@joeyh.name>+ - Copyright 2010-2021 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}@@ -30,6 +30,12 @@ 		, Param "-p") 	, (not allmeta && BuildInfo.cp_preserve_timestamps 		, Param "--preserve=timestamps")+	-- cp -a may preserve xattrs that have special meaning,+	-- eg to NFS, and have even been observed to prevent later+	-- changing the permissions of the file. So prevent preserving+	-- xattrs.+	, (allmeta && BuildInfo.cp_a && BuildInfo.cp_no_preserve_xattr_supported+		, Param "--no-preserve=xattr") 	]   where 	allmeta = meta == CopyAllMetaData

@@ -1,6 +1,6 @@ {- utilities for simple data types  -- - Copyright 2013 Joey Hess <id@joeyh.name>+ - Copyright 2013-2021 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}@@ -10,8 +10,12 @@ module Utility.Data ( 	firstJust, 	eitherToMaybe,+	s2w8,+	w82s, ) where +import Data.Word+ {- First item in the list that is not Nothing. -} firstJust :: Eq a => [Maybe a] -> Maybe a firstJust ms = case dropWhile (== Nothing) ms of@@ -20,3 +24,15 @@  eitherToMaybe :: Either a b -> Maybe b eitherToMaybe = either (const Nothing) Just++c2w8 :: Char -> Word8+c2w8 = fromIntegral . fromEnum++w82c :: Word8 -> Char+w82c = toEnum . fromIntegral++s2w8 :: String -> [Word8]+s2w8 = map c2w8++w82s :: [Word8] -> String+w82s = map w82c

@@ -34,7 +34,7 @@ 	deriving (Eq, Show)  instance IsString DebugSource where-	fromString = DebugSource . encodeBS'+	fromString = DebugSource . encodeBS  -- | Selects whether to display a message from a source. data DebugSelector @@ -97,6 +97,6 @@  formatDebugMessage :: DebugSource -> String -> IO S.ByteString formatDebugMessage (DebugSource src) msg = do-	t <- encodeBS' . formatTime defaultTimeLocale "[%F %X%Q]"+	t <- encodeBS . formatTime defaultTimeLocale "[%F %X%Q]" 		<$> getZonedTime 	return (t <> " (" <> src <> ") " <> encodeBS msg)

@@ -1,6 +1,6 @@ {- GHC File system encoding handling.  -- - Copyright 2012-2016 Joey Hess <id@joeyh.name>+ - Copyright 2012-2021 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}@@ -11,7 +11,6 @@ module Utility.FileSystemEncoding ( 	useFileSystemEncoding, 	fileEncoding,-	withFilePath, 	RawFilePath, 	fromRawFilePath, 	toRawFilePath,@@ -19,36 +18,22 @@ 	encodeBL, 	decodeBS, 	encodeBS,-	decodeBL',-	encodeBL',-	decodeBS',-	encodeBS', 	truncateFilePath,-	s2w8,-	w82s,-	c2w8,-	w82c, ) where  import qualified GHC.Foreign as GHC import qualified GHC.IO.Encoding as Encoding-import Foreign.C import System.IO import System.IO.Unsafe-import Data.Word import System.FilePath.ByteString (RawFilePath, encodeFilePath, decodeFilePath) import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L+import Data.ByteString.Unsafe (unsafePackMallocCStringLen) #ifdef mingw32_HOST_OS import qualified Data.ByteString.UTF8 as S8 import qualified Data.ByteString.Lazy.UTF8 as L8-#else-import Data.List-import Utility.Split #endif -import Utility.Exception- {- Makes all subsequent Handles that are opened, as well as stdio Handles,  - use the filesystem encoding, instead of the encoding of the current  - locale.@@ -81,40 +66,10 @@ fileEncoding h = hSetEncoding h Encoding.utf8 #endif -{- Marshal a Haskell FilePath into a NUL terminated C string using temporary- - storage. The FilePath is encoded using the filesystem encoding,- - reversing the decoding that should have been done when the FilePath- - was obtained. -}-withFilePath :: FilePath -> (CString -> IO a) -> IO a-withFilePath fp f = Encoding.getFileSystemEncoding-	>>= \enc -> GHC.withCString enc fp f--{- Encodes a FilePath into a String, applying the filesystem encoding.- -- - There are very few things it makes sense to do with such an encoded- - string. It's not a legal filename; it should not be displayed.- - So this function is not exported, but instead used by the few functions- - that can usefully consume it.- -- - This use of unsafePerformIO is belived to be safe; GHC's interface- - only allows doing this conversion with CStrings, and the CString buffer- - is allocated, used, and deallocated within the call, with no side- - effects.- -- - If the FilePath contains a value that is not legal in the filesystem- - encoding, rather than thowing an exception, it will be returned as-is.- -}-{-# NOINLINE _encodeFilePath #-}-_encodeFilePath :: FilePath -> String-_encodeFilePath fp = unsafePerformIO $ do-	enc <- Encoding.getFileSystemEncoding-	GHC.withCString enc fp (GHC.peekCString Encoding.char8)-		`catchNonAsync` (\_ -> return fp)- {- Decodes a ByteString into a FilePath, applying the filesystem encoding. -} decodeBL :: L.ByteString -> FilePath #ifndef mingw32_HOST_OS-decodeBL = encodeW8NUL . L.unpack+decodeBL = decodeBS . L.toStrict #else {- On Windows, we assume that the ByteString is utf-8, since Windows  - only uses unicode for filenames. -}@@ -124,104 +79,45 @@ {- Encodes a FilePath into a ByteString, applying the filesystem encoding. -} encodeBL :: FilePath -> L.ByteString #ifndef mingw32_HOST_OS-encodeBL = L.pack . decodeW8NUL+encodeBL = L.fromStrict . encodeBS #else encodeBL = L8.fromString #endif  decodeBS :: S.ByteString -> FilePath #ifndef mingw32_HOST_OS-decodeBS = encodeW8NUL . S.unpack+-- This is a copy of code from System.FilePath.Internal.decodeFilePath.+-- However, older versions of that library truncated at NUL, which this+-- must not do, because it may end up used on something other than a unix+-- filepath.+{-# NOINLINE decodeBS #-}+decodeBS b = unsafePerformIO $ do+	enc <- Encoding.getFileSystemEncoding+	S.useAsCStringLen b (GHC.peekCStringLen enc) #else decodeBS = S8.toString #endif  encodeBS :: FilePath -> S.ByteString #ifndef mingw32_HOST_OS-encodeBS = S.pack . decodeW8NUL+-- This is a copy of code from System.FilePath.Internal.encodeFilePath.+-- However, older versions of that library truncated at NUL, which this+-- must not do, because it may end up used on something other than a unix+-- filepath.+{-# NOINLINE encodeBS #-}+encodeBS f = unsafePerformIO $ do+	enc <- Encoding.getFileSystemEncoding+	GHC.newCStringLen enc f >>= unsafePackMallocCStringLen #else encodeBS = S8.fromString #endif -{- Faster version that assumes the string does not contain NUL;- - if it does it will be truncated before the NUL. -}-decodeBS' :: S.ByteString -> FilePath-#ifndef mingw32_HOST_OS-decodeBS' = encodeW8 . S.unpack-#else-decodeBS' = S8.toString-#endif--encodeBS' :: FilePath -> S.ByteString-#ifndef mingw32_HOST_OS-encodeBS' = S.pack . decodeW8-#else-encodeBS' = S8.fromString-#endif--decodeBL' :: L.ByteString -> FilePath-#ifndef mingw32_HOST_OS-decodeBL' = encodeW8 . L.unpack-#else-decodeBL' = L8.toString-#endif--encodeBL' :: FilePath -> L.ByteString-#ifndef mingw32_HOST_OS-encodeBL' = L.pack . decodeW8-#else-encodeBL' = L8.fromString-#endif- fromRawFilePath :: RawFilePath -> FilePath fromRawFilePath = decodeFilePath  toRawFilePath :: FilePath -> RawFilePath toRawFilePath = encodeFilePath -#ifndef mingw32_HOST_OS-{- Converts a [Word8] to a FilePath, encoding using the filesystem encoding.- -- - w82s produces a String, which may contain Chars that are invalid- - unicode. From there, this is really a simple matter of applying the- - file system encoding, only complicated by GHC's interface to doing so.- -- - Note that the encoding stops at any NUL in the input. FilePaths- - cannot contain embedded NUL, but Haskell Strings may.- -}-{-# NOINLINE encodeW8 #-}-encodeW8 :: [Word8] -> FilePath-encodeW8 w8 = unsafePerformIO $ do-	enc <- Encoding.getFileSystemEncoding-	GHC.withCString Encoding.char8 (w82s w8) $ GHC.peekCString enc--decodeW8 :: FilePath -> [Word8]-decodeW8 = s2w8 . _encodeFilePath--{- Like encodeW8 and decodeW8, but NULs are passed through unchanged. -}-encodeW8NUL :: [Word8] -> FilePath-encodeW8NUL = intercalate [nul] . map encodeW8 . splitc (c2w8 nul)-  where-	nul = '\NUL'--decodeW8NUL :: FilePath -> [Word8]-decodeW8NUL = intercalate [c2w8 nul] . map decodeW8 . splitc nul-  where-	nul = '\NUL'-#endif--c2w8 :: Char -> Word8-c2w8 = fromIntegral . fromEnum--w82c :: Word8 -> Char-w82c = toEnum . fromIntegral--s2w8 :: String -> [Word8]-s2w8 = map c2w8--w82s :: [Word8] -> String-w82s = map w82c- {- Truncates a FilePath to the given number of bytes (or less),  - as represented on disk.  -@@ -233,8 +129,8 @@ truncateFilePath n = go . reverse   where 	go f =-		let bytes = decodeW8 f-		in if length bytes <= n+		let b = encodeBS f+		in if S.length b <= n 			then reverse f 			else go (drop 1 f) #else

@@ -1,5 +1,12 @@-{- Convenience wrapper around cryptonite's hashing. -}+{- Convenience wrapper around cryptonite's hashing.+ -+ - Copyright 2013-2021 Joey Hess <id@joeyh.name>+ -+ - License: BSD-2-clause+ -} +{-# LANGUAGE BangPatterns #-}+ module Utility.Hash ( 	sha1, 	sha1_context,@@ -57,12 +64,15 @@ 	Mac(..), 	calcMac, 	props_macs_stable,+	IncrementalVerifier(..),+	mkIncrementalVerifier, ) where  import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified Data.Text as T import qualified Data.Text.Encoding as T+import Data.IORef import "cryptonite" Crypto.MAC.HMAC hiding (Context) import "cryptonite" Crypto.Hash @@ -237,10 +247,6 @@   where 	foo = L.fromChunks [T.encodeUtf8 $ T.pack "foo"] -{- File names are (client-side) MAC'ed on special remotes.- - The chosen MAC algorithm needs to be same for all files stored on the- - remote.- -} data Mac = HmacSha1 | HmacSha224 | HmacSha256 | HmacSha384 | HmacSha512 	deriving (Eq) @@ -273,3 +279,45 @@   where 	key = T.encodeUtf8 $ T.pack "foo" 	msg = T.encodeUtf8 $ T.pack "bar"++data IncrementalVerifier = IncrementalVerifier+	{ updateIncremental :: S.ByteString -> IO ()+	-- ^ Called repeatedly on each peice of the content.+	, finalizeIncremental :: IO (Maybe Bool)+	-- ^ Called once the full content has been sent, returns True+	-- if the hash verified, False if it did not, and Nothing if+	-- incremental verification was unable to be done.+	, unableIncremental :: IO ()+	-- ^ Call if the incremental verification is unable to be done.+	, positionIncremental :: IO (Maybe Integer)+	-- ^ Returns the number of bytes that have been fed to this+	-- incremental verifier so far. (Nothing if unableIncremental was+	-- called.)+	, descVerify :: String+	-- ^ A description of what is done to verify the content.+	}++mkIncrementalVerifier :: HashAlgorithm h => Context h -> String -> (String -> Bool) -> IO IncrementalVerifier+mkIncrementalVerifier ctx descverify samechecksum = do+	v <- newIORef (Just (ctx, 0))+	return $ IncrementalVerifier+		{ updateIncremental = \b ->+			modifyIORef' v $ \case+				(Just (ctx', n)) -> +					let !ctx'' = hashUpdate ctx' b+					    !n' = n + fromIntegral (S.length b)+					in (Just (ctx'', n'))+				Nothing -> Nothing+		, finalizeIncremental =+			readIORef v >>= \case+				(Just (ctx', _)) -> do+					let digest = hashFinalize ctx'+					return $ Just $ +						samechecksum (show digest)+				Nothing -> return Nothing+		, unableIncremental = writeIORef v Nothing+		, positionIncremental = readIORef v >>= \case+			Just (_, n) -> return (Just n)+			Nothing -> return Nothing+		, descVerify = descverify+		}

@@ -33,6 +33,7 @@ import Utility.FileSystemEncoding import Utility.Env import Utility.Env.Set+import Utility.Tmp import qualified Utility.LockFile.Posix as Posix  import System.IO@@ -143,7 +144,7 @@   where 	go abslockfile sidelock = do 		let abslockfile' = fromRawFilePath abslockfile-		(tmp, h) <- openTempFile (takeDirectory abslockfile') "locktmp"+		(tmp, h) <- openTmpFileIn (takeDirectory abslockfile') "locktmp" 		let tmp' = toRawFilePath tmp 		setFileMode tmp' (combineModes readModes) 		hPutStr h . show =<< mkPidLock

@@ -187,7 +187,13 @@ 	dotdots = replicate (length pfrom - numcommon) ".." 	numcommon = length common #ifdef mingw32_HOST_OS-	normdrive = map toLower . takeWhile (/= ':') . fromRawFilePath . takeDrive+	normdrive = map toLower+		-- Get just the drive letter, removing any leading+		-- path separator, which takeDrive leaves on the drive+		-- letter.+		. dropWhileEnd (isPathSeparator . fromIntegral . ord)+		. fromRawFilePath +		. takeDrive #endif  {- Checks if a command is available in PATH.

@@ -14,6 +14,7 @@ 	withTmpFile, 	withTmpFileIn, 	relatedTemplate,+	openTmpFileIn, ) where  import System.IO@@ -21,6 +22,7 @@ import System.Directory import Control.Monad.IO.Class import System.PosixCompat.Files hiding (removeLink)+import System.IO.Error  import Utility.Exception import Utility.FileSystemEncoding@@ -28,6 +30,18 @@  type Template = String +{- This is the same as openTempFile, except when there is an+ - error, it displays the template as well as the directory,+ - to help identify what call was responsible.+ -}+openTmpFileIn :: FilePath -> String -> IO (FilePath, Handle)+openTmpFileIn dir template = openTempFile dir template+	`catchIO` decoraterrror+  where+	decoraterrror e = throwM $+		let loc = ioeGetLocation e ++ " template " ++ template+		in annotateIOError e loc Nothing Nothing+ {- Runs an action like writeFile, writing to a temp file first and  - then moving it into place. The temp file is stored in the same  - directory as the final file to avoid cross-device renames.@@ -43,7 +57,7 @@ 	template = relatedTemplate (base ++ ".tmp") 	setup = do 		createDirectoryIfMissing True dir-		openTempFile dir template+		openTmpFileIn dir template 	cleanup (tmpfile, h) = do 		_ <- tryIO $ hClose h 		tryIO $ removeFile tmpfile@@ -73,7 +87,7 @@ withTmpFileIn :: (MonadIO m, MonadMask m) => FilePath -> Template -> (FilePath -> Handle -> m a) -> m a withTmpFileIn tmpdir template a = bracket create remove use   where-	create = liftIO $ openTempFile tmpdir template+	create = liftIO $ openTmpFileIn tmpdir template 	remove (name, h) = liftIO $ do 		hClose h 		catchBoolIO (removeFile name >> return True)

@@ -1,6 +1,6 @@ {- Url downloading.  -- - Copyright 2011-2020 Joey Hess <id@joeyh.name>+ - Copyright 2011-2021 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}@@ -53,6 +53,7 @@ #endif import Utility.IPAddress import qualified Utility.RawFilePath as R+import Utility.Hash (IncrementalVerifier(..))  import Network.URI import Network.HTTP.Types@@ -363,11 +364,11 @@  -  - When the download fails, returns an error message.  -}-download :: MeterUpdate -> URLString -> FilePath -> UrlOptions -> IO (Either String ())+download :: MeterUpdate -> Maybe IncrementalVerifier -> URLString -> FilePath -> UrlOptions -> IO (Either String ()) download = download' False -download' :: Bool -> MeterUpdate -> URLString -> FilePath -> UrlOptions -> IO (Either String ())-download' nocurlerror meterupdate url file uo =+download' :: Bool -> MeterUpdate -> Maybe IncrementalVerifier -> URLString -> FilePath -> UrlOptions -> IO (Either String ())+download' nocurlerror meterupdate iv url file uo = 	catchJust matchHttpException go showhttpexception 		`catchNonAsync` (dlfailed . show)   where@@ -376,7 +377,7 @@ 			case (urlDownloader uo, parseRequest (show u)) of 				(DownloadWithConduit (DownloadWithCurlRestricted r), Just req) -> catchJust 					(matchStatusCodeException (== found302))-					(downloadConduit meterupdate req file uo >> return (Right ()))+					(downloadConduit meterupdate iv req file uo >> return (Right ())) 					(followredir r) 				(DownloadWithConduit (DownloadWithCurlRestricted r), Nothing) 					| isfileurl u -> downloadfile u@@ -404,7 +405,9 @@ 		HttpExceptionRequest _ other -> show other 		_ -> show he 	-	dlfailed msg = return $ Left $ "download failed: " ++ msg+	dlfailed msg = do+		noverification+		return $ Left $ "download failed: " ++ msg  	basecurlparams = curlParams uo 		[ if nocurlerror@@ -416,6 +419,7 @@ 		]  	downloadcurl rawurl curlparams = do+		noverification 		-- curl does not create destination file 		-- if the url happens to be empty, so pre-create. 		unlessM (doesFileExist file) $@@ -429,6 +433,7 @@ 		downloadcurl rawurl =<< curlRestrictedParams r u defport basecurlparams  	downloadfile u = do+		noverification 		let src = unEscapeString (uriPath u) 		withMeteredFile src meterupdate $ 			L.writeFile file@@ -446,6 +451,8 @@ 			Nothing -> throwIO ex 	followredir _ ex = throwIO ex +	noverification = maybe noop unableIncremental iv+ {- Download a perhaps large file using conduit, with auto-resume  - of incomplete downloads.  -@@ -456,8 +463,8 @@  - thrown for reasons other than http status codes will still be thrown  - as usual.)  -}-downloadConduit :: MeterUpdate -> Request -> FilePath -> UrlOptions -> IO ()-downloadConduit meterupdate req file uo =+downloadConduit :: MeterUpdate -> Maybe IncrementalVerifier -> Request -> FilePath -> UrlOptions -> IO ()+downloadConduit meterupdate iv req file uo = 	catchMaybeIO (getFileSize (toRawFilePath file)) >>= \case 		Just sz | sz > 0 -> resumedownload sz 		_ -> join $ runResourceT $ do@@ -504,7 +511,9 @@ 					store zeroBytesProcessed WriteMode resp 					return (return ()) 				else if alreadydownloaded sz resp-					then return (return ())+					then do+						liftIO noverification+						return (return ()) 					else do 						rf <- extractFromResourceT (respfailure resp) 						if responseStatus resp == unauthorized401@@ -529,13 +538,13 @@ 			Nothing -> True 	 	store initialp mode resp =-		sinkResponseFile meterupdate initialp file mode resp+		sinkResponseFile meterupdate iv initialp file mode resp 	 	respfailure = B8.toString . statusMessage . responseStatus 	 	retryauthed (ba, signalsuccess) = do 		r <- tryNonAsync $ downloadConduit-			meterupdate+			meterupdate iv 			(applyBasicAuth' ba req) 			file 			(uo { getBasicAuth = noBasicAuth })@@ -545,32 +554,44 @@ 				() <- signalsuccess False 				throwM e 	-{- Sinks a Response's body to a file. The file can either be opened in- - WriteMode or AppendMode. Updates the meter as data is received.+	noverification = maybe noop unableIncremental iv+	+{- Sinks a Response's body to a file. The file can either be appended to+ - (AppendMode), or written from the start of the response (WriteMode).+ - Updates the meter and incremental verifier as data is received,+ - when not appending.  -  - Note that the responseStatus is not checked by this function.  -} sinkResponseFile 	:: MonadResource m 	=> MeterUpdate+	-> Maybe IncrementalVerifier 	-> BytesProcessed 	-> FilePath 	-> IOMode 	-> Response (ConduitM () B8.ByteString m ()) 	-> m ()-sinkResponseFile meterupdate initialp file mode resp = do+sinkResponseFile meterupdate iv initialp file mode resp = do+	ui <- case (iv, mode) of+		(Just iv', AppendMode) -> do+			liftIO $ unableIncremental iv'+			return (const noop)+		(Just iv', _) -> return (updateIncremental iv')+		(Nothing, _) -> return (const noop) 	(fr, fh) <- allocate (openBinaryFile file mode) hClose-	runConduit $ responseBody resp .| go initialp fh+	runConduit $ responseBody resp .| go ui initialp fh 	release fr   where-	go sofar fh = await >>= \case+	go ui sofar fh = await >>= \case 		Nothing -> return () 		Just bs -> do 			let sofar' = addBytesProcessed sofar (B.length bs) 			liftIO $ do 				void $ meterupdate sofar'+				() <- ui bs 				B.hPut fh bs-			go sofar' fh+			go ui sofar' fh  {- Downloads at least the specified number of bytes from an url. -} downloadPartial :: URLString -> UrlOptions -> Int -> IO (Maybe L.ByteString)

@@ -74,10 +74,10 @@    Use this option to copy a specified key. -* file matching options+* matching options    The [[git-annex-matching-options]](1)-  can be used to specify files to copy.+  can be used to specify what to copy.  * `--batch` @@ -93,10 +93,13 @@   machine-parseable, you may want to use --json in combination with   --batch. +* `--batch-keys`++  This is like `--batch` but the lines read from stdin are parsed as keys.+ * `-z` -  Makes the `--batch` input be delimited by nulls instead of the usual-  newlines.+  Makes batch input be delimited by nulls instead of the usual newlines.  * `--json` 

@@ -87,10 +87,10 @@   Note that this bypasses checking the .gitattributes annex.numcopies   setting and required content settings. -* file matching options+* matching options    The [[git-annex-matching-options]](1)-  can be used to specify files to drop.+  can be used to specify what to drop.  * `--jobs=N` `-JN` @@ -110,10 +110,17 @@   match specified matching options, or it is not an annexed file,   a blank line is output in response instead. +* `--batch-keys`++  This is like `--batch` but the lines read from stdin are parsed as keys.++  Note that this bypasses checking the .gitattributes annex.numcopies+  setting and required content settings.+ * `-z` -  Makes the `--batch` input be delimited by nulls instead of the usual-  newlines.+  Makes the batch input be delimited by nulls+  instead of the usual newlines.  * `--json` 

@@ -72,6 +72,10 @@   or otherwise doesn't meet the matching options, an empty line   will be output instead. +* `--batch-keys`++  This is like `--batch` but the lines read from stdin are parsed as keys.+ * `-z`    Makes the `--batch` input be delimited by nulls instead of the usual

@@ -89,10 +89,10 @@    Use this option to fsck a specified key.   -* file matching options+* matching options    The [[git-annex-matching-options]](1)-  can be used to specify files to fsck.+  can be used to control what to fsck.  * `--jobs=N` `-JN` 

@@ -56,10 +56,10 @@   parallel. (Remotes with lower costs are still preferred over higher cost   remotes.) -* file matching options+* matching options     The [[git-annex-matching-options]](1)-  can be used to specify files to get.+  can be used to control what to get.  * `--incomplete` @@ -114,9 +114,13 @@   machine-parseable, you may want to use --json in combination with   --batch. +* `--batch-keys`++  This is like `--batch` but the lines read from stdin are parsed as keys.+ * `-z` -  Makes the `--batch` input be delimited by nulls instead of the usual+  Makes batch input be delimited by nulls instead of the usual   newlines.  * `--json`

@@ -39,10 +39,10 @@    Generates output suitable for the `gource` visualization program. -* file matching options+* matching options      The [[git-annex-matching-options]](1)-  can be used to specify files to act on.+  can be used to control what to act on.  * `--all` `-A` 

@@ -1,11 +1,12 @@ # NAME -git-annex-matching-options - specifying files to act on+git-annex-matching-options - specifying what to act on  # DESCRIPTION  Many git-annex commands support using these options to specify which-files they act on.+files they act on. Some of these options can also be used by commands to+specify which keys they act on.  Arbitrarily complicated expressions can be built using these options. For example:@@ -58,8 +59,8 @@  * `--in=repository` -  Matches only files that git-annex believes have their contents present-  in a repository. Note that it does not check the repository to verify+  Matches only when git-annex believes that the content is present in a+  repository. Note that it does not check the repository to verify   that it still has the content.    The repository should be specified using the name of a configured remote,@@ -68,8 +69,8 @@  * `--in=repository@{date}` -  Matches files currently in the work tree whose content was present in-  the repository on the given date.+  Matches only when the content was present in a repository on the given+  date.    The date is specified in the same syntax documented in   gitrevisions(7). Note that this uses the reflog, so dates far in the@@ -81,13 +82,13 @@  * `--copies=number` -  Matches only files that git-annex believes to have the specified number+  Matches only when git-annex believes there are the specified number   of copies, or more. Note that it does not check remotes to verify that   the copies still exist.  * `--copies=trustlevel:number` -  Matches only files that git-annex believes have the specified number of+  Matches only when git-annex believes there are the specified number of   copies, on remotes with the specified trust level. For example,   `--copies=trusted:2` @@ -96,14 +97,14 @@  * `--copies=groupname:number` -  Matches only files that git-annex believes have the specified number of+  Matches only when git-annex believes there are the specified number of   copies, on remotes in the specified group. For example,   `--copies=archive:2`  * `--lackingcopies=number` -  Matches only files that git-annex believes need the specified number or -  more additional copies to be made in order to satisfy their numcopies+  Matches only when git-annex beleives that the specified number or +  more additional copies to be made in order to satisfy numcopies   settings.  * `--approxlackingcopies=number`@@ -113,23 +114,23 @@  * `--inbackend=name` -  Matches only files whose content is stored using the specified key-value+  Matches only when content is stored using the specified key-value   backend.  * `--securehash` -  Matches only files whose content is hashed using a cryptographically+  Matches only when content is hashed using a cryptographically   secure function.   * `--inallgroup=groupname` -  Matches only files that git-annex believes are present in all repositories-  in the specified group.+  Matches only when git-annex believes content is present in+  all repositories in the specified group.  * `--smallerthan=size` * `--largerthan=size` -  Matches only files whose content is smaller than, or larger than the+  Matches only when the content is is smaller than, or larger than the   specified size.    The size can be specified with any commonly used units, for example,@@ -137,14 +138,14 @@  * `--metadata field=glob` -  Matches only files that have a metadata field attached with a value that+  Matches only when there is a metadata field attached with a value that   matches the glob. The values of metadata fields are matched case   insensitively.  * `--metadata field<number` / `--metadata field>number` * `--metadata field<=number` / `--metadata field>=number` -  Matches only files that have a metadata field attached with a value that+  Matches only when there is a metadata field attached with a value that   is a number and is less than or greater than the specified number.    (Note that you will need to quote the second parameter to avoid@@ -152,34 +153,34 @@  * `--want-get` -  Matches files that the preferred content settings for the repository-  make it want to get. Note that this will match even files that are-  already present, unless limited with e.g., `--not --in .`+  Matches only when the preferred content settings for the repository+  make it want to get content. Note that this will match even when+  the content is already present, unless limited with e.g., `--not --in .`  * `--want-drop` -  Matches files that the preferred content settings for the repository-  make it want to drop. Note that this will match even files that have-  already been dropped, unless limited with e.g., `--in .`+  Matches only when the preferred content settings for the repository+  make it want to drop content. Note that this will match even when+  the content is not present, unless limited with e.g., `--in .` -  Files that this matches will not necessarily be dropped by+  Things that this matches will not necessarily be dropped by   `git-annex drop --auto`. This does not check that there are enough copies   to drop. Also the same content may be used by a file that is not wanted   to be dropped.  * `--accessedwithin=interval` -  Matches files that were accessed recently, within the specified time+  Matches when the content was accessed recently, within the specified time   interval.      The interval can be in the form "5m" or "1h" or "2d" or "1y", or a   combination such as "1h5m". -  So for example, `--accessedwithin=1d` matches files that have been+  So for example, `--accessedwithin=1d` matches when the content was   accessed within the past day.    If the OS or filesystem does not support access times, this will not-  match any files.+  match anything.  * `--unlocked` @@ -220,8 +221,8 @@  * `--not` -  Inverts the next matching option. For example, to only act on-  files with less than 3 copies, use `--not --copies=3`+  Inverts the next matching option. For example, to match+  when there are less than 3 copies, use `--not --copies=3`  * `--and` 

@@ -82,10 +82,10 @@   throughout the files in a directory. This option enables such recursive   setting. -* file matching options+* matching options     The [[git-annex-matching-options]](1)-  can be used to specify files to act on.+  can be used to control what to act on.  * `--all` `-A` @@ -159,7 +159,7 @@  	{"file":"foo","fields":{"author":[]}} -  Note that file matching options do not affect the files that are+  Note that matching options do not affect the files that are   processed when in batch mode.  * Also the [[git-annex-common-options]](1) can be used.

@@ -63,10 +63,10 @@    Operate on files that have recently failed to be transferred. -* file matching options+* matching options    The [[git-annex-matching-options]](1)-  can be used to specify files to mirror.+  can be used to control what to mirror.  * `--json` 

@@ -74,10 +74,10 @@   already has content. This can be faster, but might skip moving content   to the remote in some cases. -* file matching options+* matching options    The [[git-annex-matching-options]](1)-  can be used to specify files to move.+  can be used to control what to move.  * `--batch` @@ -93,10 +93,13 @@   machine-parseable, you may want to use --json in combination with   --batch. +* `--batch-keys`++  This is like `--batch` but the lines read from stdin are parsed as keys.+ * `-z` -  Makes the `--batch` input be delimited by nulls instead of the usual-  newlines.+  Makes batch input be delimited by nulls instead of the usual newlines.  * `--json` 

@@ -26,10 +26,10 @@  # OPTIONS -* file matching options+* matching options      The [[git-annex-matching-options]](1)-  can be used to specify files to act on.+  can be used to control what to act on.  * `--key=keyname` @@ -53,12 +53,16 @@   its information displayed, and repeat.    Note that if the file is not an annexed file, or does not match-  specified file matching options, an empty line will be+  specified matching options, an empty line will be   output instead. +* `--batch-keys`++  This is like `--batch` but the lines read from stdin are parsed as keys.+ * `-z` -  Makes the `--batch` input be delimited by nulls instead of the usual+  Makes batch input be delimited by nulls instead of the usual   newlines.  * `--json`

@@ -1657,6 +1657,10 @@   file any options that cause youtube-dl to download more than one file,   or to store the file anywhere other than the current working directory. +* `annex.youtube-dl-command`++  Command to run for youtube-dl. Default is "youtube-dl".+ * `annex.aria-torrent-options`    Options to pass to aria2c when using it to download a torrent.@@ -1908,14 +1912,13 @@    Normally git-annex timestamps lines in the log files committed to the   git-annex branch. Setting this environment variable to a number-  will make git-annex use that rather than the current number of seconds-  since the UNIX epoch. Note that decimal seconds are supported.+  will make git-annex use that (or a larger number) +  rather than the current number of seconds since the UNIX epoch.+  Note that decimal seconds are supported.      This is only provided for advanced users who either have a better way to   tell which commit is current than the local clock, or who need to avoid-  embedding timestamps for policy reasons. Misuse of this environment-  variable can confuse git-annex's book-keeping, sometimes in ways that-  `git annex fsck` is unable to repair.+  embedding timestamps for policy reasons.  * Some special remotes use additional environment variables   for authentication etc. For example, `AWS_ACCESS_KEY_ID`

@@ -1,5 +1,5 @@ Name: git-annex-Version: 8.20210803+Version: 8.20210903 Cabal-Version: >= 1.10 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>