git-annex 7.20190507 → 7.20190615

raw patch · 75 files changed

+1164/−395 lines, 75 files

Files

• Annex.hs +3/−3
• Annex/AdjustedBranch.hs +7/−1
• Annex/Concurrent.hs +2/−1
• Annex/Drop.hs +4/−2
• Annex/FileMatcher.hs +84/−45
• Annex/Import.hs +140/−19
• Annex/Ingest.hs +25/−16
• Annex/Init.hs +8/−3
• Annex/Locations.hs +12/−1
• Annex/ReplaceFile.hs +2/−0
• Annex/Ssh.hs +2/−1
• Annex/Transfer.hs +19/−10
• Annex/Url.hs +13/−10
• Annex/YoutubeDl.hs +3/−3
• Assistant/Threads/Committer.hs +20/−14
• Assistant/Threads/ConfigMonitor.hs +2/−1
• CHANGELOG +38/−0
• CmdLine/Action.hs +60/−42
• CmdLine/GitAnnex/Options.hs +6/−5
• CmdLine/Seek.hs +6/−5
• Command/Add.hs +3/−2
• Command/Describe.hs +1/−1
• Command/Drop.hs +2/−1
• Command/Export.hs +54/−5
• Command/Find.hs +1/−1
• Command/Fsck.hs +13/−11
• Command/Get.hs +2/−1
• Command/Import.hs +9/−5
• Command/Info.hs +2/−3
• Command/MatchExpression.hs +9/−2
• Command/MetaData.hs +2/−2
• Command/Mirror.hs +2/−1
• Command/Move.hs +2/−2
• Command/Smudge.hs +1/−1
• Command/Sync.hs +21/−18
• Command/Whereis.hs +1/−1
• Git/LsTree.hs +10/−0
• Git/Tree.hs +37/−3
• Limit.hs +3/−3
• Logs/Export.hs +25/−0
• Logs/File.hs +15/−1
• Logs/PreferredContent.hs +58/−26
• Logs/Transfer.hs +5/−3
• Messages.hs +6/−4
• Remote/Directory.hs +2/−0
• Remote/GCrypt.hs +11/−8
• Remote/Helper/ReadOnly.hs +38/−2
• Remote/Rsync.hs +20/−15
• Remote/Rsync/RsyncUrl.hs +3/−3
• Types/ActionItem.hs +26/−17
• Types/Command.hs +1/−1
• Types/Concurrency.hs +8/−1
• Types/FileMatcher.hs +2/−2
• Types/GitConfig.hs +7/−4
• Types/Remote.hs +5/−5
• Types/WorkerPool.hs +30/−0
• Utility/HttpManagerRestricted.hs +31/−3
• Utility/IPAddress.hs +13/−0
• Utility/Matcher.hs +8/−12
• Utility/Url.hs +149/−26
• doc/git-annex-add.mdwn +2/−0
• doc/git-annex-addurl.mdwn +3/−1
• doc/git-annex-copy.mdwn +2/−0
• doc/git-annex-drop.mdwn +2/−0
• doc/git-annex-export.mdwn +5/−0
• doc/git-annex-fsck.mdwn +2/−0
• doc/git-annex-get.mdwn +2/−0
• doc/git-annex-import.mdwn +22/−6
• doc/git-annex-importfeed.mdwn +1/−1
• doc/git-annex-mirror.mdwn +2/−0
• doc/git-annex-move.mdwn +2/−0
• doc/git-annex-preferred-content.mdwn +6/−2
• doc/git-annex-sync.mdwn +2/−0
• doc/git-annex.mdwn +15/−6
• git-annex.cabal +2/−1

@@ -66,13 +66,13 @@ import Types.DesktopNotify import Types.CleanupActions import Types.AdjustedBranch+import Types.WorkerPool import qualified Database.Keys.Handle as Keys import Utility.InodeCache import Utility.Url  import "mtl" Control.Monad.Reader import Control.Concurrent-import Control.Concurrent.Async import Control.Concurrent.STM import qualified Control.Monad.Fail as Fail import qualified Data.Map.Strict as M@@ -142,7 +142,7 @@ 	, tempurls :: M.Map Key URLString 	, existinghooks :: M.Map Git.Hook.Hook Bool 	, desktopnotify :: DesktopNotify-	, workers :: [Either AnnexState (Async AnnexState)]+	, workers :: WorkerPool AnnexState 	, activekeys :: TVar (M.Map Key ThreadId) 	, activeremotes :: MVar (M.Map (Types.Remote.RemoteA Annex) Integer) 	, keysdbhandle :: Maybe Keys.DbHandle@@ -199,7 +199,7 @@ 		, tempurls = M.empty 		, existinghooks = M.empty 		, desktopnotify = mempty-		, workers = []+		, workers = UnallocatedWorkerPool 		, activekeys = emptyactivekeys 		, activeremotes = emptyactiveremotes 		, keysdbhandle = Nothing

@@ -265,7 +265,12 @@ adjustTree :: Adjustment -> BasisBranch -> Annex Sha adjustTree adj (BasisBranch basis) = do 	let toadj = adjustTreeItem adj-	treesha <- Git.Tree.adjustTree toadj [] [] basis =<< Annex.gitRepo+	treesha <- Git.Tree.adjustTree+		toadj +		[] +		(\_old new -> new)+		[]+		basis =<< Annex.gitRepo 	return treesha  type CommitsPrevented = Git.LockFile.LockHandle@@ -544,6 +549,7 @@ 	treesha <- Git.Tree.adjustTree 		(propchanges changes) 		adds'+		(\_old new -> new) 		(map Git.DiffTree.file removes) 		basis 		=<< Annex.gitRepo

@@ -11,6 +11,7 @@ import Annex.Common import Annex.Action import qualified Annex.Queue+import Types.WorkerPool  import qualified Data.Map as M @@ -42,7 +43,7 @@ dupState = do 	st <- Annex.getState id 	return $ st-		{ Annex.workers = []+		{ Annex.workers = UnallocatedWorkerPool 		-- each thread has its own repoqueue 		, Annex.repoqueue = Nothing 		-- avoid sharing eg, open file handles

@@ -125,10 +125,12 @@ 			)  	dropl fs n = checkdrop fs n Nothing $ \numcopies ->-		Command.Drop.startLocal afile (mkActionItem afile) numcopies key preverified+		Command.Drop.startLocal afile ai numcopies key preverified  	dropr fs r n  = checkdrop fs n (Just $ Remote.uuid r) $ \numcopies ->-		Command.Drop.startRemote afile (mkActionItem afile) numcopies key r+		Command.Drop.startRemote afile ai numcopies key r++	ai = mkActionItem (key, afile)  	slocs = S.fromList locs 	

@@ -1,6 +1,6 @@ {- git-annex file matching  -- - Copyright 2012-2016 Joey Hess <id@joeyh.name>+ - Copyright 2012-2019 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -12,8 +12,13 @@ 	checkFileMatcher, 	checkFileMatcher', 	checkMatcher,+	checkMatcher', 	matchAll,+	PreferredContentData(..),+	preferredContentTokens,+	preferredContentKeylessTokens, 	preferredContentParser,+	ParseToken, 	parsedToMatcher, 	mkLargeFilesParser, 	largeFilesMatcher,@@ -59,8 +64,12 @@ 		(Just key, _) -> go (MatchingKey key afile) 		_ -> d   where-	go mi = matchMrun matcher $ \a -> a notpresent mi+	go mi = checkMatcher' matcher mi notpresent +checkMatcher' :: FileMatcher Annex -> MatchInfo -> AssumeNotPresent -> Annex Bool+checkMatcher' matcher mi notpresent =+	matchMrun matcher $ \a -> a notpresent mi+ fileMatchInfo :: FilePath -> Annex MatchInfo fileMatchInfo file = do 	matchfile <- getTopFilePath <$> inRepo (toTopFilePath file)@@ -72,21 +81,21 @@ matchAll :: FileMatcher Annex matchAll = generate [] -parsedToMatcher :: [ParseResult] -> Either String (FileMatcher Annex)+parsedToMatcher :: [ParseResult (MatchFiles Annex)] -> Either String (FileMatcher Annex) parsedToMatcher parsed = case partitionEithers parsed of 	([], vs) -> Right $ generate vs 	(es, _) -> Left $ unwords $ map ("Parse failure: " ++) es -data ParseToken-	= SimpleToken String ParseResult-	| ValueToken String (String -> ParseResult)+data ParseToken t+	= SimpleToken String (ParseResult t)+	| ValueToken String (String -> ParseResult t) -type ParseResult = Either String (Token (MatchFiles Annex))+type ParseResult t = Either String (Token t) -parseToken :: [ParseToken] -> String -> ParseResult-parseToken l t-	| t `elem` tokens = Right $ token t-	| otherwise = go l+parseToken :: [ParseToken t] -> String -> ParseResult t+parseToken l t = case syntaxToken t of+	Right st -> Right st+	Left _ -> go l   where 	go [] = Left $ "near " ++ show t 	go (SimpleToken s r : _) | s == t = r@@ -94,10 +103,17 @@ 	go (_ : ps) = go ps 	(k, v) = separate (== '=') t -commonTokens :: [ParseToken]-commonTokens =-	[ SimpleToken "unused" (simply limitUnused)-	, SimpleToken "anything" (simply limitAnything)+{- This is really dumb tokenization; there's no support for quoted values.+ - Open and close parens are always treated as standalone tokens;+ - otherwise tokens must be separated by whitespace. -}+tokenizeMatcher :: String -> [String]+tokenizeMatcher = filter (not . null) . concatMap splitparens . words+  where+	splitparens = segmentDelim (`elem` "()")++commonKeylessTokens :: [ParseToken (MatchFiles Annex)]+commonKeylessTokens =+	[ SimpleToken "anything" (simply limitAnything) 	, SimpleToken "nothing" (simply limitNothing) 	, ValueToken "include" (usev limitInclude) 	, ValueToken "exclude" (usev limitExclude)@@ -105,35 +121,57 @@ 	, ValueToken "smallerthan" (usev $ limitSize (<)) 	] -{- This is really dumb tokenization; there's no support for quoted values.- - Open and close parens are always treated as standalone tokens;- - otherwise tokens must be separated by whitespace. -}-tokenizeMatcher :: String -> [String]-tokenizeMatcher = filter (not . null ) . concatMap splitparens . words-  where-	splitparens = segmentDelim (`elem` "()")+commonKeyedTokens :: [ParseToken (MatchFiles Annex)]+commonKeyedTokens = +	[ SimpleToken "unused" (simply limitUnused)+	] -preferredContentParser :: FileMatcher Annex -> FileMatcher Annex -> Annex GroupMap -> M.Map UUID RemoteConfig -> Maybe UUID -> String -> [ParseResult]-preferredContentParser matchstandard matchgroupwanted getgroupmap configmap mu expr =-	map parse $ tokenizeMatcher expr+data PreferredContentData = PCD+	{ matchStandard :: Either String (FileMatcher Annex)+	, matchGroupWanted :: Either String (FileMatcher Annex)+	, getGroupMap :: Annex GroupMap+	, configMap :: M.Map UUID RemoteConfig+	, repoUUID :: Maybe UUID+	}++-- Tokens of preferred content expressions that do not need a Key to be+-- known. +--+-- When importing from a special remote, this is used to match+-- some preferred content expressions before the content is downloaded,+-- so the Key is not known.+preferredContentKeylessTokens :: PreferredContentData -> [ParseToken (MatchFiles Annex)]+preferredContentKeylessTokens pcd =+	[ SimpleToken "standard" (call $ matchStandard pcd)+	, SimpleToken "groupwanted" (call $ matchGroupWanted pcd)+	, SimpleToken "inpreferreddir" (simply $ limitInDir preferreddir)+	] ++ commonKeylessTokens   where- 	parse = parseToken $-		[ SimpleToken "standard" (call matchstandard)-		, SimpleToken "groupwanted" (call matchgroupwanted)-		, SimpleToken "present" (simply $ limitPresent mu)-		, SimpleToken "inpreferreddir" (simply $ limitInDir preferreddir)-		, SimpleToken "securehash" (simply limitSecureHash)-		, ValueToken "copies" (usev limitCopies)-		, ValueToken "lackingcopies" (usev $ limitLackingCopies False)-		, ValueToken "approxlackingcopies" (usev $ limitLackingCopies True)-		, ValueToken "inbacked" (usev limitInBackend)-		, ValueToken "metadata" (usev limitMetaData)-		, ValueToken "inallgroup" (usev $ limitInAllGroup getgroupmap)-		] ++ commonTokens 	preferreddir = fromMaybe "public" $-		M.lookup "preferreddir" =<< (`M.lookup` configmap) =<< mu+		M.lookup "preferreddir" =<< (`M.lookup` configMap pcd) =<< repoUUID pcd -mkLargeFilesParser :: Annex (String -> [ParseResult])+preferredContentKeyedTokens :: PreferredContentData -> [ParseToken (MatchFiles Annex)]+preferredContentKeyedTokens pcd =+	[ SimpleToken "present" (simply $ limitPresent $ repoUUID pcd)+	, SimpleToken "securehash" (simply limitSecureHash)+	, ValueToken "copies" (usev limitCopies)+	, ValueToken "lackingcopies" (usev $ limitLackingCopies False)+	, ValueToken "approxlackingcopies" (usev $ limitLackingCopies True)+	, ValueToken "inbacked" (usev limitInBackend)+	, ValueToken "metadata" (usev limitMetaData)+	, ValueToken "inallgroup" (usev $ limitInAllGroup $ getGroupMap pcd)+	] ++ commonKeyedTokens++preferredContentTokens :: PreferredContentData -> [ParseToken (MatchFiles Annex)]+preferredContentTokens pcd = concat+	[ preferredContentKeylessTokens pcd+	, preferredContentKeyedTokens pcd+	]++preferredContentParser :: [ParseToken (MatchFiles Annex)] -> String -> [ParseResult (MatchFiles Annex)]+preferredContentParser tokens = map (parseToken tokens) . tokenizeMatcher++mkLargeFilesParser :: Annex (String -> [ParseResult (MatchFiles Annex)]) mkLargeFilesParser = do 	magicmime <- liftIO initMagicMime #ifdef WITH_MAGICMIME@@ -142,7 +180,7 @@ 	let mimer n = ValueToken n $  		const $ Left $ "\""++n++"\" not supported; not built with MagicMime support" #endif-	let parse = parseToken $ commonTokens +++	let parse = parseToken $ commonKeyedTokens ++ commonKeylessTokens ++ #ifdef WITH_MAGICMIME 		[ mimer "mimetype" $ 			matchMagic "mimetype" getMagicMimeType providedMimeType@@ -176,12 +214,13 @@ 		either badexpr return $ parsedToMatcher $ parser expr 	badexpr e = giveup $ "bad annex.largefiles configuration: " ++ e -simply :: MatchFiles Annex -> ParseResult+simply :: MatchFiles Annex -> ParseResult (MatchFiles Annex) simply = Right . Operation -usev :: MkLimit Annex -> String -> ParseResult+usev :: MkLimit Annex -> String -> ParseResult (MatchFiles Annex) usev a v = Operation <$> a v -call :: FileMatcher Annex -> ParseResult-call sub = Right $ Operation $ \notpresent mi ->+call :: Either String (FileMatcher Annex) -> ParseResult (MatchFiles Annex)+call (Right sub) = Right $ Operation $ \notpresent mi -> 	matchMrun sub $ \a -> a notpresent mi+call (Left err) = Left err

@@ -13,7 +13,10 @@ 	ImportCommitConfig(..), 	buildImportCommit, 	buildImportTrees,-	downloadImport+	downloadImport,+	filterImportableContents,+	makeImportMatcher,+	listImportableContents, ) where  import Annex.Common@@ -41,6 +44,10 @@ import Utility.DataUnits import Logs.Export import Logs.Location+import Logs.PreferredContent+import Types.FileMatcher+import Annex.FileMatcher+import Utility.Matcher (isEmpty) import qualified Database.Export as Export import qualified Database.ContentIdentifier as CIDDb import qualified Logs.ContentIdentifier as CIDLog@@ -48,6 +55,7 @@ import Control.Concurrent.STM import qualified Data.Map.Strict as M import qualified Data.Set as S+import qualified System.FilePath.Posix as Posix  {- Configures how to build an import tree. -} data ImportTreeConfig@@ -103,7 +111,7 @@ 	go trackingcommit = do 		imported@(History finaltree _) <- 			buildImportTrees basetree subdir importable-		buildImportCommit' importcommitconfig trackingcommit imported >>= \case+		buildImportCommit' remote importcommitconfig trackingcommit imported >>= \case 			Just finalcommit -> do 				updatestate finaltree 				return (Just finalcommit)@@ -160,54 +168,66 @@ 			Export.runExportDiffUpdater updater db oldtree finaltree 		Export.closeDb db -buildImportCommit' :: ImportCommitConfig -> Maybe Sha -> History Sha -> Annex (Maybe Sha)-buildImportCommit' importcommitconfig mtrackingcommit imported@(History ti _) =+buildImportCommit' :: Remote -> ImportCommitConfig -> Maybe Sha -> History Sha -> Annex (Maybe Sha)+buildImportCommit' remote importcommitconfig mtrackingcommit imported@(History ti _) = 	case mtrackingcommit of-		Nothing -> Just <$> mkcommits imported+		Nothing -> Just <$> mkcommitsunconnected imported 		Just trackingcommit -> do 			-- Get history of tracking branch to at most 			-- one more level deep than what was imported, 			-- so we'll have enough history to compare, 			-- but not spend too much time getting it.-			let maxdepth = succ (historyDepth imported)+			let maxdepth = succ importeddepth 			inRepo (getHistoryToDepth maxdepth trackingcommit) 				>>= go trackingcommit   where-	go _ Nothing = Just <$> mkcommits imported+	go _ Nothing = Just <$> mkcommitsunconnected imported 	go trackingcommit (Just h) 		-- If the tracking branch head is a merge commit-		-- with a tree that matches the head of the history, 		-- and one side of the merge matches the history, 		-- nothing new needs to be committed.-		| t == ti && any (sametodepth imported) (S.toList s) = return Nothing+		| t == ti && any sametodepth (S.toList s) = return Nothing 		-- If the tracking branch matches the history, 		-- nothing new needs to be committed. 		-- (This is unlikely to happen.)-		| sametodepth imported h' = return Nothing+		| sametodepth h' = return Nothing 		| otherwise = do 			importedcommit <- case getRemoteTrackingBranchImportHistory h of-				Nothing ->-					mkcommits imported-				Just oldimported@(History oldhc _) -> do-					let oldimportedtrees = mapHistory historyCommitTree oldimported-					mknewcommits oldhc oldimportedtrees imported+				Nothing -> mkcommitsunconnected imported+				Just oldimported@(History oldhc _)+					| importeddepth == 1 ->+						mkcommitconnected imported oldimported+					| otherwise -> do+						let oldimportedtrees = mapHistory historyCommitTree oldimported+						mknewcommits oldhc oldimportedtrees imported+			ti' <- addBackExportExcluded remote ti 			Just <$> makeRemoteTrackingBranchMergeCommit'-				trackingcommit importedcommit ti+				trackingcommit importedcommit ti' 	  where 		h'@(History t s) = mapHistory historyCommitTree h -	sametodepth a b = a == truncateHistoryToDepth (historyDepth a) b+	importeddepth = historyDepth imported +	sametodepth b = imported == truncateHistoryToDepth importeddepth b+ 	mkcommit parents tree = inRepo $ Git.Branch.commitTree 		(importCommitMode importcommitconfig) 		(importCommitMessage importcommitconfig) 		parents 		tree -	mkcommits (History importedtree hs) = do-		parents <- mapM mkcommits (S.toList hs)+	-- Start a new history of import commits, not connected to any+	-- prior import commits.+	mkcommitsunconnected (History importedtree hs) = do+		parents <- mapM mkcommitsunconnected (S.toList hs) 		mkcommit parents importedtree +	-- Commit the new history connected with the old history.+	-- Used when the import is not versioned, so the history depth is 1.+	mkcommitconnected (History importedtree _) (History oldhc _) = do+		let parents = [historyCommit oldhc]+		mkcommit parents importedtree+ 	-- Reuse the commits from the old imported History when possible. 	mknewcommits oldhc old new@(History importedtree hs) 		| old == new = return $ historyCommit oldhc@@ -380,3 +400,104 @@ 	, keyVariety = OtherKey "CID" 	, keySize = Just size 	}++{-- Export omits non-preferred content from the tree stored on the+ -- remote. So the import will normally have that content+ -- omitted (unless something else added files with the same names to the+ -- special remote).+ --+ -- That presents a problem: Merging the imported tree would result+ -- in deletion of the files that were excluded from export.+ -- To avoid that happening, this adds them back to the imported tree.+ --}+addBackExportExcluded :: Remote -> Sha -> Annex Sha+addBackExportExcluded remote importtree =+	getExportExcluded (Remote.uuid remote) >>= \case+		[] -> return importtree+		excludedlist -> inRepo $+			adjustTree+				-- don't remove any+				(pure . Just)+				excludedlist+				-- if something was imported with the same+				-- name as a file that was previously+				-- excluded from import, use what was imported+				(\imported _excluded -> imported)+				[]+				importtree++{- Match the preferred content of the remote at import time.+ -+ - Only keyless tokens are supported, because the keys are not known+ - until an imported file is downloaded, which is too late to bother+ - excluding it from an import.+ -}+makeImportMatcher :: Remote -> Annex (Either String (FileMatcher Annex))+makeImportMatcher r = load preferredContentKeylessTokens >>= \case+	Nothing -> return $ Right matchAll+	Just (Right v) -> return $ Right v+	Just (Left err) -> load preferredContentTokens >>= \case+		Just (Left err') -> return $ Left err'+		_ -> return $ Left $+			"The preferred content expression contains terms that cannot be checked when importing: " ++ err+  where+	load t = M.lookup (Remote.uuid r) . fst <$> preferredRequiredMapsLoad' t++wantImport :: FileMatcher Annex -> ImportLocation -> ByteSize -> Annex Bool+wantImport matcher loc sz = checkMatcher' matcher mi mempty+  where+	mi = MatchingInfo $ ProvidedInfo+		{ providedFilePath = Right $ fromImportLocation loc+		, providedKey = unavail "key"+		, providedFileSize = Right sz+		, providedMimeType = unavail "mime"+		, providedMimeEncoding = unavail "mime"+		}+	-- This should never run, as long as the FileMatcher was generated+	-- using the preferredContentKeylessTokens.+	unavail v = Left $ error $ "Internal error: unavailable " ++ v++{- If a file is not preferred content, but it was previously exported or+ - imported to the remote, not importing it would result in a remote+ - tracking branch that, when merged, would delete the file.+ -+ - To avoid that problem, such files are included in the import.+ - The next export will remove them from the remote.+ -}+shouldImport :: Export.ExportHandle -> FileMatcher Annex -> ImportLocation -> ByteSize -> Annex Bool+shouldImport dbhandle matcher loc sz = +	wantImport matcher loc sz+		<||>+	liftIO (not . null <$> Export.getExportTreeKey dbhandle loc)++filterImportableContents :: Remote -> FileMatcher Annex -> ImportableContents (ContentIdentifier, ByteSize) -> Annex (ImportableContents (ContentIdentifier, ByteSize))+filterImportableContents r matcher importable+	| isEmpty matcher = return importable+	| otherwise = do+		dbhandle <- Export.openDb (Remote.uuid r)+		go dbhandle importable+  where+	go dbhandle ic = ImportableContents+		<$> filterM (match dbhandle) (importableContents ic)+		<*> mapM (go dbhandle) (importableHistory ic)+	+	match dbhandle (loc, (_cid, sz)) = shouldImport dbhandle matcher loc sz+	+{- Gets the ImportableContents from the remote.+ -+ - Filters out any paths that include a ".git" component, because git does+ - not allow storing ".git" in a git repository. While it is possible to+ - write a git tree that contains that, git will complain and refuse to+ - check it out.+ -}+listImportableContents :: Remote -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))+listImportableContents r = fmap removegitspecial+	<$> Remote.listImportableContents (Remote.importActions r)+  where+	removegitspecial ic = ImportableContents+		{ importableContents = +			filter (not . gitspecial . fst) (importableContents ic)+		, importableHistory =+			map removegitspecial (importableHistory ic)+		}+	gitspecial l = ".git" `elem` Posix.splitDirectories (fromImportLocation l)

@@ -30,7 +30,6 @@ import Annex.Content import Annex.Content.Direct import Annex.Perms-import Annex.Tmp import Annex.Link import Annex.MetaData import Annex.CurrentBranch@@ -58,8 +57,10 @@ 	deriving (Show)  data LockDownConfig = LockDownConfig-	{ lockingFile :: Bool -- ^ write bit removed during lock down-	, hardlinkFileTmp :: Bool -- ^ hard link to temp directory+	{ lockingFile :: Bool+	-- ^ write bit removed during lock down+	, hardlinkFileTmpDir :: Maybe FilePath+	-- ^ hard link to temp directory 	} 	deriving (Show) @@ -83,27 +84,35 @@ 	=<< lockDown' cfg file  lockDown' :: LockDownConfig -> FilePath -> Annex (Either IOException LockedDown)-lockDown' cfg file = ifM (pure (not (hardlinkFileTmp cfg)) <||> crippledFileSystem)-	( withTSDelta $ liftIO . tryIO . nohardlink-	, tryIO $ withOtherTmp $ \tmp -> do-		when (lockingFile cfg) $-			freezeContent file-		withTSDelta $ \delta -> liftIO $ do-			(tmpfile, h) <- openTempFile tmp $-				relatedTemplate $ "ingest-" ++ takeFileName file-			hClose h-			nukeFile tmpfile-			withhardlink delta tmpfile `catchIO` const (nohardlink delta)+lockDown' cfg file = tryIO $ ifM crippledFileSystem+	( nohardlink+	, case hardlinkFileTmpDir cfg of+		Nothing -> nohardlink+		Just tmpdir -> withhardlink tmpdir 	)   where-	nohardlink delta = do+	nohardlink = withTSDelta $ liftIO . nohardlink'++	nohardlink' delta = do 		cache <- genInodeCache file delta 		return $ LockedDown cfg $ KeySource 			{ keyFilename = file 			, contentLocation = file 			, inodeCache = cache 			}-	withhardlink delta tmpfile = do+	+	withhardlink tmpdir = do+		when (lockingFile cfg) $+			freezeContent file+		withTSDelta $ \delta -> liftIO $ do+			(tmpfile, h) <- openTempFile tmpdir $+				relatedTemplate $ "ingest-" ++ takeFileName file+			hClose h+			nukeFile tmpfile+			withhardlink' delta tmpfile+				`catchIO` const (nohardlink' delta)++	withhardlink' delta tmpfile = do 		createLink file tmpfile 		cache <- genInodeCache tmpfile delta 		return $ LockedDown cfg $ KeySource

@@ -1,6 +1,6 @@ {- git-annex repository initialization  -- - Copyright 2011-2017 Joey Hess <id@joeyh.name>+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -43,15 +43,17 @@ import Annex.Hook import Annex.InodeSentinal import Upgrade-import Annex.Perms import Annex.Tmp import Utility.UserInfo #ifndef mingw32_HOST_OS+import Annex.Perms import Utility.FileMode import System.Posix.User import qualified Utility.LockFile.Posix as Posix #endif +import qualified Data.Map as M+ checkCanInitialize :: Annex a -> Annex a checkCanInitialize a = inRepo (noAnnexFileContent . Git.repoWorkTree) >>= \case 	Nothing -> a@@ -88,7 +90,10 @@ 	initSharedClone sharedclone  	u <- getUUID-	describeUUID u =<< genDescription mdescription+	{- Avoid overwriting existing description with a default+	 - description. -}+	whenM (pure (isJust mdescription) <||> not . M.member u <$> uuidDescMap) $+		describeUUID u =<< genDescription mdescription  -- Everything except for uuid setup, shared clone setup, and initial -- description.

@@ -31,6 +31,7 @@ 	gitAnnexTmpOtherDir, 	gitAnnexTmpOtherLock, 	gitAnnexTmpOtherDirOld,+	gitAnnexTmpWatcherDir, 	gitAnnexTmpObjectDir, 	gitAnnexTmpObjectLocation, 	gitAnnexTmpWorkDir,@@ -49,6 +50,7 @@ 	gitAnnexExportDbDir, 	gitAnnexExportLock, 	gitAnnexExportUpdateLock,+	gitAnnexExportExcludeLog, 	gitAnnexContentIdentifierDbDir, 	gitAnnexContentIdentifierLock, 	gitAnnexScheduleState,@@ -264,10 +266,14 @@ gitAnnexTmpOtherLock :: Git.Repo -> FilePath gitAnnexTmpOtherLock r = gitAnnexDir r </> "othertmp.lck" -{- Directory used by old versions of git-annex. -}+{- Tmp directory used by old versions of git-annex. -} gitAnnexTmpOtherDirOld :: Git.Repo -> FilePath gitAnnexTmpOtherDirOld r = addTrailingPathSeparator $ gitAnnexDir r </> "misctmp" +{- .git/annex/watchtmp/ is used by the watcher and assistant -}+gitAnnexTmpWatcherDir :: Git.Repo -> FilePath+gitAnnexTmpWatcherDir r = addTrailingPathSeparator $ gitAnnexDir r </> "watchtmp"+ {- The temp file to use for a given key's content. -} gitAnnexTmpObjectLocation :: Key -> Git.Repo -> FilePath gitAnnexTmpObjectLocation key r = gitAnnexTmpObjectDir r </> keyFile key@@ -355,6 +361,11 @@ {- Lock file for updating the export state for a special remote. -} gitAnnexExportUpdateLock :: UUID -> Git.Repo -> FilePath gitAnnexExportUpdateLock u r = gitAnnexExportDbDir u r ++ ".upl"++{- Log file used to keep track of files that were in the tree exported to a+ - remote, but were excluded by its preferred content settings. -}+gitAnnexExportExcludeLog :: UUID -> Git.Repo -> FilePath+gitAnnexExportExcludeLog u r = gitAnnexDir r </> "export.ex" </> fromUUID u  {- Directory containing database used to record remote content ids.  -

@@ -12,7 +12,9 @@ import Annex.Common import Annex.Tmp import Utility.Tmp.Dir+#ifndef mingw32_HOST_OS import Utility.Path.Max+#endif  {- Replaces a possibly already existing file with a new version,   - atomically, by running an action.

@@ -189,8 +189,9 @@ 	let socketlock = socket2lock socketfile  	Annex.getState Annex.concurrency >>= \case+		NonConcurrent -> return () 		Concurrent {} -> makeconnection socketlock-		_ -> return ()+		ConcurrentPerCpu -> makeconnection socketlock 	 	lockFileCached socketlock   where

@@ -247,20 +247,29 @@   where 	go [] _ = return observeFailure 	go (r:[]) _ = a r-	go rs (Concurrent n) | n > 1 = do-		mv <- Annex.getState Annex.activeremotes-		active <- liftIO $ takeMVar mv-		let rs' = sortBy (lessActiveFirst active) rs-		goconcurrent mv active rs'-	go (r:rs) _ = do+	go rs NonConcurrent = gononconcurrent rs+	go rs (Concurrent n)+		| n <= 1 = gononconcurrent rs+		| otherwise = goconcurrent rs+	go rs ConcurrentPerCpu = goconcurrent rs+	+	gononconcurrent [] = return observeFailure+	gononconcurrent (r:rs) = do 		ok <- a r 		if observeBool ok 			then return ok-			else go rs NonConcurrent-	goconcurrent mv active [] = do+			else gononconcurrent rs+	+	goconcurrent rs = do+		mv <- Annex.getState Annex.activeremotes+		active <- liftIO $ takeMVar mv+		let rs' = sortBy (lessActiveFirst active) rs+		goconcurrent' mv active rs'++	goconcurrent' mv active [] = do 		liftIO $ putMVar mv active 		return observeFailure-	goconcurrent mv active (r:rs) = do+	goconcurrent' mv active (r:rs) = do 		let !active' = M.insertWith (+) r 1 active 		liftIO $ putMVar mv active' 		let getnewactive = do@@ -279,7 +288,7 @@ 				-- because other threads could have 				-- been assigned them in the meantime. 				let rs' = sortBy (lessActiveFirst active'') rs-				goconcurrent mv active'' rs'+				goconcurrent' mv active'' rs'  lessActiveFirst :: M.Map Remote Integer -> Remote -> Remote -> Ordering lessActiveFirst active a b

@@ -11,7 +11,7 @@ 	withUrlOptions, 	getUrlOptions, 	getUserAgent,-	httpAddressesUnlimited,+	ipAddressesUnlimited, ) where  import Annex.Common@@ -52,14 +52,15 @@ 		Just cmd -> lines <$> liftIO (readProcess "sh" ["-c", cmd]) 		Nothing -> annexHttpHeaders <$> Annex.getGitConfig 	-	checkallowedaddr = words . annexAllowedHttpAddresses <$> Annex.getGitConfig >>= \case+	checkallowedaddr = words . annexAllowedIPAddresses <$> Annex.getGitConfig >>= \case 		["all"] -> do 			-- Only allow curl when all are allowed, 			-- as its interface does not allow preventing 			-- it from accessing specific IP addresses. 			curlopts <- map Param . annexWebOptions <$> Annex.getGitConfig 			let urldownloader = if null curlopts-				then U.DownloadWithConduit+				then U.DownloadWithConduit $+					U.DownloadWithCurlRestricted mempty 				else U.DownloadWithCurl curlopts 			manager <- liftIO $ U.newManager U.managerSettings 			return (urldownloader, manager)@@ -76,9 +77,9 @@ 				| isPrivateAddress addr = False 				| otherwise = True 			let connectionrestricted = addrConnectionRestricted -				("Configuration of annex.security.allowed-http-addresses does not allow accessing address " ++)+				("Configuration of annex.security.allowed-ip-addresses does not allow accessing address " ++) 			let r = Restriction-				{ addressRestriction = \addr ->+				{ checkAddressRestriction = \addr -> 					if isallowed (addrAddress addr) 						then Nothing 						else Just (connectionrestricted addr)@@ -88,13 +89,15 @@ 			case pr of 				Nothing -> return () 				Just ProxyRestricted -> toplevelWarning True-					"http proxy settings not used due to annex.security.allowed-http-addresses configuration"+					"http proxy settings not used due to annex.security.allowed-ip-addresses configuration" 			manager <- liftIO $ U.newManager settings-			return (U.DownloadWithConduit, manager)+			let urldownloader = U.DownloadWithConduit $+				U.DownloadWithCurlRestricted r+			return (urldownloader, manager) -httpAddressesUnlimited :: Annex Bool-httpAddressesUnlimited = -	("all" == ) . annexAllowedHttpAddresses <$> Annex.getGitConfig+ipAddressesUnlimited :: Annex Bool+ipAddressesUnlimited = +	("all" == ) . annexAllowedIPAddresses <$> Annex.getGitConfig  withUrlOptions :: (U.UrlOptions -> Annex a) -> Annex a withUrlOptions a = a =<< getUrlOptions

@@ -31,13 +31,13 @@ -- localhost or a private address. So, it's only allowed to download -- content if the user has allowed access to all addresses. youtubeDlAllowed :: Annex Bool-youtubeDlAllowed = httpAddressesUnlimited+youtubeDlAllowed = ipAddressesUnlimited  youtubeDlNotAllowedMessage :: String youtubeDlNotAllowedMessage = unwords 	[ "This url is supported by youtube-dl, but" 	, "youtube-dl could potentially access any address, and the"-	, "configuration of annex.security.allowed-http-addresses"+	, "configuration of annex.security.allowed-ip-addresses" 	, "does not allow that. Not using youtube-dl." 	] @@ -55,7 +55,7 @@ -- (Note that we can't use --output to specifiy the file to download to, -- due to <https://github.com/rg3/youtube-dl/issues/14864>) youtubeDl :: URLString -> FilePath -> Annex (Either String (Maybe FilePath))-youtubeDl url workdir = ifM httpAddressesUnlimited+youtubeDl url workdir = ifM ipAddressesUnlimited 	( withUrlOptions $ youtubeDl' url workdir 	, return $ Left youtubeDlNotAllowedMessage 	)

@@ -1,6 +1,6 @@ {- git-annex assistant commit thread  -- - Copyright 2012 Joey Hess <id@joeyh.name>+ - Copyright 2012, 2019 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -29,7 +29,7 @@ import Annex.Content import Annex.Ingest import Annex.Link-import Annex.Tmp+import Annex.Perms import Annex.CatFile import Annex.InodeSentinal import Annex.Version@@ -56,8 +56,14 @@ 		maybe delayaddDefault (return . Just . Seconds) 			=<< annexDelayAdd <$> Annex.getGitConfig 	msg <- liftAnnex Command.Sync.commitMsg+	lockdowndir <- liftAnnex $ fromRepo gitAnnexTmpWatcherDir+	liftAnnex $ do+		-- Clean up anything left behind by a previous process+		-- on unclean shutdown.+		void $ liftIO $ tryIO $ removeDirectoryRecursive lockdowndir+		void $ createAnnexDirectory lockdowndir 	waitChangeTime $ \(changes, time) -> do-		readychanges <- handleAdds havelsof delayadd $+		readychanges <- handleAdds lockdowndir havelsof delayadd $ 			simplifyChanges changes 		if shouldCommit False time (length readychanges) readychanges 			then do@@ -265,21 +271,21 @@  - Any pending adds that are not ready yet are put back into the ChangeChan,  - where they will be retried later.  -}-handleAdds :: Bool -> Maybe Seconds -> [Change] -> Assistant [Change]-handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do+handleAdds :: FilePath -> Bool -> Maybe Seconds -> [Change] -> Assistant [Change]+handleAdds lockdowndir havelsof delayadd cs = returnWhen (null incomplete) $ do 	let (pending, inprocess) = partition isPendingAddChange incomplete 	direct <- liftAnnex isDirect 	unlocked <- liftAnnex versionSupportsUnlockedPointers 	let lockingfiles = not (unlocked || direct) 	let lockdownconfig = LockDownConfig 		{ lockingFile = lockingfiles-		, hardlinkFileTmp = True+		, hardlinkFileTmpDir = Just lockdowndir 		} 	(pending', cleanup) <- if unlocked || direct 		then return (pending, noop) 		else findnew pending 	(postponed, toadd) <- partitionEithers-		<$> safeToAdd lockdownconfig havelsof delayadd pending' inprocess+		<$> safeToAdd lockdowndir lockdownconfig havelsof delayadd pending' inprocess 	cleanup  	unless (null postponed) $@@ -294,7 +300,7 @@ 		if DirWatcher.eventsCoalesce || null added || unlocked || direct 			then return $ added ++ otherchanges 			else do-				r <- handleAdds havelsof delayadd =<< getChanges+				r <- handleAdds lockdowndir havelsof delayadd =<< getChanges 				return $ r ++ added ++ otherchanges   where 	(incomplete, otherchanges) = partition (\c -> isPendingAddChange c || isInProcessAddChange c) cs@@ -341,7 +347,7 @@ 		delta <- liftAnnex getTSDelta 		let cfg = LockDownConfig 			{ lockingFile = False-			, hardlinkFileTmp = True+			, hardlinkFileTmpDir = Just lockdowndir 			} 		if M.null m 			then forM toadd (add cfg)@@ -429,9 +435,9 @@  -  - Check by running lsof on the repository.  -}-safeToAdd :: LockDownConfig -> Bool -> Maybe Seconds -> [Change] -> [Change] -> Assistant [Either Change Change]-safeToAdd _ _ _ [] [] = return []-safeToAdd lockdownconfig havelsof delayadd pending inprocess = do+safeToAdd :: FilePath -> LockDownConfig -> Bool -> Maybe Seconds -> [Change] -> [Change] -> Assistant [Either Change Change]+safeToAdd _ _ _ _ [] [] = return []+safeToAdd lockdowndir lockdownconfig havelsof delayadd pending inprocess = do 	maybe noop (liftIO . threadDelaySeconds) delayadd 	liftAnnex $ do 		lockeddown <- forM pending $ lockDown lockdownconfig . changeFile@@ -478,7 +484,7 @@  	allRight = return . map Right -	{- Normally the KeySources are locked down inside the temp directory,+	{- Normally the KeySources are locked down inside the lockdowndir, 	 - so can just lsof that, which is quite efficient. 	 - 	 - In crippled filesystem mode, there is no lock down, so must run lsof@@ -488,7 +494,7 @@ 		( liftIO $ do 			let segments = segmentXargsUnordered $ map keyFilename keysources 			concat <$> forM segments (\fs -> Lsof.query $ "--" : fs)-		, withOtherTmp $ liftIO . Lsof.queryDir+		, liftIO $ Lsof.queryDir lockdowndir 		)  {- After a Change is committed, queue any necessary transfers or drops

@@ -23,6 +23,7 @@ import Git.Types import Git.FilePath import qualified Annex.Branch+import Annex.FileMatcher  import qualified Data.Set as S @@ -73,7 +74,7 @@ reloadConfigs :: Configs -> Assistant () reloadConfigs changedconfigs = do 	sequence_ as-	void $ liftAnnex preferredRequiredMapsLoad+	void $ liftAnnex $ preferredRequiredMapsLoad preferredContentTokens 	{- Changes to the remote log, or the trust log, can affect the 	 - syncRemotes list. Changes to the uuid log may affect its 	 - display so are also included. -}

@@ -1,3 +1,41 @@+git-annex (7.20190615) upstream; urgency=medium++  * Fixed bug that caused git-annex to fail to add a file when another+    git-annex process cleaned up the temp directory it was using.+  * Makefile: Added install-completions to install target.+  * Added the ability to run one job per CPU (core), by setting+    annex.jobs=cpus, or using option --jobs=cpus or -Jcpus.+  * Honor preferred content of a special remote when exporting trees to it;+    unwanted files are filtered out of the tree that is exported.+  * Importing from a special remote honors its preferred content too;+    unwanted files are not imported. But, some preferred content+    expressions can't be checked before files are imported, and trying to+    import with such an expression will fail.+  * Don't try to import .git directories from special remotes, because+    git does not support storing git repositories inside a git repository.+  * Improve shape of commit tree when importing from unversioned special+    remotes.+  * init: When the repository already has a description, don't change it.+  * describe: When run with no description parameter it used to set+    the description to "", now it will error out.+  * Android: Improve installation process when the user's login shell is not+    bash.+  * When a remote is configured to be readonly, don't allow changing+    what's exported to it.+  * Renamed annex.security.allowed-http-addresses to+    annex.security.allowed-ip-addresses because it is not really specific+    to the http protocol, also limiting eg, git-annex's use of ftp.+    The old name for the config will still work.+  * Add back support for ftp urls, which was disabled as part of the fix for+    security hole CVE-2018-10857 (except for configurations which enabled curl+    and bypassed public IP address restrictions). Now it will work+    if allowed by annex.security.allowed-ip-addresses.+  * Avoid a delay at startup when concurrency is enabled and there are+    rsync or gcrypt special remotes, which was caused by git-annex+    opening a ssh connection to the remote too early.++ -- Joey Hess <id@joeyh.name>  Sat, 15 Jun 2019 12:38:25 -0400+ git-annex (7.20190507) upstream; urgency=medium    * Fix reversion in last release that caused wrong tree to be written

@@ -16,12 +16,14 @@ import Types.Concurrency import Messages.Concurrent import Types.Messages+import Types.WorkerPool import Remote.List  import Control.Concurrent import Control.Concurrent.Async import Control.Concurrent.STM import Control.Exception (throwIO)+import GHC.Conc import Data.Either import qualified Data.Map.Strict as M import qualified System.Console.Regions as Regions@@ -51,12 +53,17 @@  - This should only be run in the seek stage.  -} commandAction :: CommandStart -> Annex ()-commandAction a = go =<< Annex.getState Annex.concurrency+commandAction a = Annex.getState Annex.concurrency >>= \case+	NonConcurrent -> run+	Concurrent n -> runconcurrent n+	ConcurrentPerCpu -> runconcurrent =<< liftIO getNumProcessors   where-	go (Concurrent n) = do-		ws <- Annex.getState Annex.workers-		(st, ws') <- if null ws-			then do+	run = void $ includeCommandAction a++	runconcurrent n = do+		ws <- liftIO . drainTo (n-1) =<< Annex.getState Annex.workers+		(st, ws') <- case ws of+			UnallocatedWorkerPool -> do 				-- Generate the remote list now, to avoid 				-- each thread generating it, which would 				-- be more expensive and could cause@@ -64,15 +71,12 @@ 				-- setConfig. 				_ <- remoteList 				st <- dupState-				return (st, replicate (n-1) (Left st))-			else do-				l <- liftIO $ drainTo (n-1) ws-				findFreeSlot l-		w <- liftIO $ async-			$ snd <$> Annex.run st (inOwnConsoleRegion (Annex.output st) run)-		Annex.changeState $ \s -> s { Annex.workers = Right w:ws' }-	go NonConcurrent = run-	run = void $ includeCommandAction a+				return (st, allocateWorkerPool st (n-1))+			WorkerPool l -> findFreeSlot l+		w <- liftIO $ async $ snd <$> Annex.run st+			(inOwnConsoleRegion (Annex.output st) run)+		Annex.changeState $ \s -> s+			{ Annex.workers = addWorkerPool ws' (Right w) }  commandActions :: [CommandStart] -> Annex () commandActions = mapM_ commandAction@@ -87,42 +91,41 @@ finishCommandActions :: Annex () finishCommandActions = do 	ws <- Annex.getState Annex.workers-	Annex.changeState $ \s -> s { Annex.workers = [] }-	l <- liftIO $ drainTo 0 ws-	forM_ (lefts l) mergeState+	Annex.changeState $ \s -> s { Annex.workers = UnallocatedWorkerPool }+	ws' <- liftIO $ drainTo 0 ws+	forM_ (idleWorkers ws') mergeState -{- Wait for Asyncs from the list to finish, replacing them with their- - final AnnexStates, until the list of remaining Asyncs is not larger- - than the specified size, then returns the new list.+{- Wait for jobs from the WorkerPool to complete, until+ - the number of running jobs is not larger than the specified number.  -- - If the action throws an exception, it is propigated, but first- - all other actions are waited for, to allow for a clean shutdown.+ - If a job throws an exception, it is propigated, but first+ - all other jobs are waited for, to allow for a clean shutdown.  -}-drainTo-	:: Int-	-> [Either Annex.AnnexState (Async Annex.AnnexState)]-	-> IO [Either Annex.AnnexState (Async Annex.AnnexState)]-drainTo sz l-	| null as || sz >= length as = return l+drainTo :: Int -> WorkerPool t -> IO (WorkerPool t)+drainTo _ UnallocatedWorkerPool = pure UnallocatedWorkerPool+drainTo sz (WorkerPool l)+	| null as || sz >= length as = pure (WorkerPool l) 	| otherwise = do 		(done, ret) <- waitAnyCatch as 		let as' = filter (/= done) as 		case ret of 			Left e -> do-				void $ drainTo 0 (map Left sts ++ map Right as')+				void $ drainTo 0 $ WorkerPool $+					map Left sts ++ map Right as' 				throwIO e 			Right st -> do-				drainTo sz $ map Left (st:sts) ++ map Right as'+				drainTo sz $ WorkerPool $+					map Left (st:sts) ++ map Right as'   where 	(sts, as) = partitionEithers l -findFreeSlot :: [Either Annex.AnnexState (Async Annex.AnnexState)] -> Annex (Annex.AnnexState, [Either Annex.AnnexState (Async Annex.AnnexState)])+findFreeSlot :: [Worker Annex.AnnexState] -> Annex (Annex.AnnexState, WorkerPool Annex.AnnexState) findFreeSlot = go []   where 	go c [] = do 		st <- dupState-		return (st, c)-	go c (Left st:rest) = return (st, c ++ rest)+		return (st, WorkerPool c)+	go c (Left st:rest) = return (st, WorkerPool (c ++ rest)) 	go c (v:rest) = go (v:c) rest  {- Like commandAction, but without the concurrency. -}@@ -170,18 +173,23 @@ allowConcurrentOutput a = do 	fromcmdline <- Annex.getState Annex.concurrency 	fromgitcfg <- annexJobs <$> Annex.getGitConfig+	let usegitcfg = Annex.changeState $ +		\c -> c { Annex.concurrency = fromgitcfg } 	case (fromcmdline, fromgitcfg) of 		(NonConcurrent, NonConcurrent) -> a-		(Concurrent n, _) -> goconcurrent n+		(Concurrent n, _) -> do+			raisecapabilitiesto n+			goconcurrent+		(ConcurrentPerCpu, _) -> goconcurrent 		(NonConcurrent, Concurrent n) -> do-			Annex.changeState $ -				\c -> c { Annex.concurrency = fromgitcfg }-			goconcurrent n+			usegitcfg+			raisecapabilitiesto n+			goconcurrent+		(NonConcurrent, ConcurrentPerCpu) -> do+			usegitcfg+			goconcurrent   where-	goconcurrent n = do-		c <- liftIO getNumCapabilities-		when (n > c) $-			liftIO $ setNumCapabilities n+	goconcurrent = do 		withMessageState $ \s -> case outputType s of 			NormalOutput -> ifM (liftIO concurrentOutputSupported) 				( Regions.displayConsoleRegions $@@ -190,13 +198,21 @@ 				) 			_ -> goconcurrent' False 	goconcurrent' b = bracket_ (setup b) cleanup a+ 	setup = setconcurrentoutputenabled+ 	cleanup = do 		finishCommandActions 		setconcurrentoutputenabled False+ 	setconcurrentoutputenabled b = Annex.changeState $ \s -> 		s { Annex.output = (Annex.output s) { concurrentOutputEnabled = b } } +	raisecapabilitiesto n = do+		c <- liftIO getNumCapabilities+		when (n > c) $+			liftIO $ setNumCapabilities n+ {- Ensures that only one thread processes a key at a time.  - Other threads will block until it's done. -} onlyActionOn :: Key -> CommandStart -> CommandStart@@ -212,7 +228,9 @@ onlyActionOn' k a = go =<< Annex.getState Annex.concurrency   where 	go NonConcurrent = a-	go (Concurrent _) = do+	go (Concurrent _) = goconcurrent+	go ConcurrentPerCpu = goconcurrent+	goconcurrent = do 		tv <- Annex.getState Annex.activekeys 		bracket (setup tv) id (const a) 	setup tv = liftIO $ do

@@ -324,8 +324,8 @@ 	, shortopt ')' "close group of options" 	]   where-	longopt o h = globalFlag (Limit.addToken o) ( long o <> help h <> hidden )-	shortopt o h = globalFlag (Limit.addToken [o]) ( short o <> help h <> hidden )+	longopt o h = globalFlag (Limit.addSyntaxToken o) ( long o <> help h <> hidden )+	shortopt o h = globalFlag (Limit.addSyntaxToken [o]) ( short o <> help h <> hidden )  jsonOptions :: [GlobalOption] jsonOptions = @@ -366,14 +366,15 @@ jobsOption :: [GlobalOption] jobsOption =  	[ globalSetter set $ -		option auto-			( long "jobs" <> short 'J' <> metavar paramNumber+		option (maybeReader parseConcurrency)+			( long "jobs" <> short 'J' +			<> metavar (paramNumber `paramOr` "cpus") 			<> help "enable concurrent jobs" 			<> hidden 			) 	]   where-	set n = Annex.changeState $ \s -> s { Annex.concurrency = Concurrent n }+	set v = Annex.changeState $ \s -> s { Annex.concurrency = v }  timeLimitOption :: [GlobalOption] timeLimitOption = 

@@ -186,7 +186,7 @@ 		matcher <- Limit.getMatcher 		return $ \v@(k, ai) -> 			let i = case ai of-				ActionItemBranchFilePath (BranchFilePath _ topf) ->+				ActionItemBranchFilePath (BranchFilePath _ topf) _ -> 					MatchingKey k (AssociatedFile $ Just $ getTopFilePath topf) 				_ -> MatchingKey k (AssociatedFile Nothing) 			in whenM (matcher i) $@@ -229,10 +229,11 @@ 		keyaction <- mkkeyaction 		forM_ bs $ \b -> do 			(l, cleanup) <- inRepo $ LsTree.lsTree LsTree.LsTreeRecursive b-			forM_ l $ \i -> do-				let bfp = mkActionItem $ BranchFilePath b (LsTree.file i)-				maybe noop (\k -> keyaction (k, bfp))-					=<< catKey (LsTree.sha i)+			forM_ l $ \i -> catKey (LsTree.sha i) >>= \case+				Nothing -> noop+				Just k -> +					let bfp = mkActionItem (BranchFilePath b (LsTree.file i), k)+					in keyaction (k, bfp) 			unlessM (liftIO cleanup) $ 				error ("git ls-tree " ++ Git.fromRef b ++ " failed") 	runfailedtransfers = do

@@ -19,6 +19,7 @@ import Annex.FileMatcher import Annex.Link import Annex.Version+import Annex.Tmp import Git.FilePath  cmd :: Command@@ -137,11 +138,11 @@ 		next $ next $ addFile file  perform :: FilePath -> CommandPerform-perform file = do+perform file = withOtherTmp $ \tmpdir -> do 	lockingfile <- not <$> addUnlocked 	let cfg = LockDownConfig 		{ lockingFile = lockingfile-		, hardlinkFileTmp = True+		, hardlinkFileTmpDir = Just tmpdir 		} 	lockDown cfg file >>= ingestAdd >>= finish   where

@@ -21,7 +21,7 @@ seek = withWords (commandAction . start)  start :: [String] -> CommandStart-start (name:description) = do+start (name:description) | not (null description) = do 	showStart' "describe" (Just name) 	u <- Remote.nameToUUID name 	next $ perform u $ unwords description

@@ -63,9 +63,10 @@ 	go = whenAnnexed $ start o  start :: DropOptions -> FilePath -> Key -> CommandStart-start o file key = start' o key afile (mkActionItem afile)+start o file key = start' o key afile ai   where 	afile = AssociatedFile (Just file)+	ai = mkActionItem (key, afile)  start' :: DropOptions -> Key -> AssociatedFile -> ActionItem -> CommandStart start' o key afile ai = onlyActionOn key $ do

@@ -14,6 +14,7 @@ import qualified Git import qualified Git.DiffTree import qualified Git.LsTree+import qualified Git.Tree import qualified Git.Ref import Git.Types import Git.FilePath@@ -24,13 +25,17 @@ import Annex.Content import Annex.Transfer import Annex.CatFile+import Annex.FileMatcher+import Types.FileMatcher import Annex.RemoteTrackingBranch import Logs.Location import Logs.Export+import Logs.PreferredContent import Database.Export import Config import Utility.Tmp import Utility.Metered+import Utility.Matcher  import qualified Data.ByteString.Lazy as L import qualified Data.Map as M@@ -79,7 +84,8 @@ 		setConfig (remoteConfig r "annex-tracking-branch") 			(fromRef $ exportTreeish o) 	-	tree <- fromMaybe (giveup "unknown tree") <$>+	tree <- filterPreferredContent r =<<+		fromMaybe (giveup "unknown tree") <$> 		inRepo (Git.Ref.tree (exportTreeish o)) 	 	mtbcommitsha <- getExportCommit r (exportTreeish o)@@ -112,8 +118,8 @@  -- | Changes what's exported to the remote. Does not upload any new -- files, but does delete and rename files already exported to the remote.-changeExport :: Remote -> ExportHandle -> Git.Ref -> CommandSeek-changeExport r db new = do+changeExport :: Remote -> ExportHandle -> PreferredFiltered Git.Ref -> CommandSeek+changeExport r db (PreferredFiltered new) = do 	old <- getExport (uuid r) 	recordExportBeginning (uuid r) new 	@@ -223,8 +229,8 @@ -- -- Once all exported files have reached the remote, updates the -- remote tracking branch.-fillExport :: Remote -> ExportHandle -> Git.Ref -> Maybe (RemoteTrackingBranch, Sha) -> Annex Bool-fillExport r db newtree mtbcommitsha = do+fillExport :: Remote -> ExportHandle -> PreferredFiltered Git.Ref -> Maybe (RemoteTrackingBranch, Sha) -> Annex Bool+fillExport r db (PreferredFiltered newtree) mtbcommitsha = do 	(l, cleanup) <- inRepo $ Git.LsTree.lsTree Git.LsTree.LsTreeRecursive newtree 	cvar <- liftIO $ newMVar (FileUploaded False) 	allfilledvar <- liftIO $ newMVar (AllFilled True)@@ -431,3 +437,46 @@ 			( removeexportdirectory d 			, return True 			)++-- | A value that has been filtered through the remote's preferred content+-- expression.+newtype PreferredFiltered t = PreferredFiltered t++-- | Filters the tree to files that are preferred content of the remote.+--+-- A log is written with files that were filtered out, so they can be added+-- back in when importing from the remote.+filterPreferredContent :: Remote -> Git.Ref -> Annex (PreferredFiltered Git.Ref)+filterPreferredContent r tree = logExportExcluded (uuid r) $ \logwriter -> do+	m <- preferredContentMap+	case M.lookup (uuid r) m of+		Just matcher | not (isEmpty matcher) -> do+			PreferredFiltered <$> go matcher logwriter+		_ -> return (PreferredFiltered tree)+  where+	go matcher logwriter = do+		g <- Annex.gitRepo+		Git.Tree.adjustTree+			(checkmatcher matcher logwriter)+			[]+			(\_old new -> new)+			[]+			tree+			g+	+	checkmatcher matcher logwriter ti@(Git.Tree.TreeItem topf _ sha) =+		catKey sha >>= \case+			Just k -> do+				-- Match filename relative to the+				-- top of the tree.+				let af = AssociatedFile $ Just $+					getTopFilePath topf+				let mi = MatchingKey k af+				ifM (checkMatcher' matcher mi mempty)+					( return (Just ti)+					, do+						() <- liftIO $ logwriter ti+						return Nothing+					)+			-- Always export non-annexed files.+			Nothing -> return (Just ti)

@@ -73,7 +73,7 @@ 	)  startKeys :: FindOptions -> (Key, ActionItem) -> CommandStart-startKeys o (key, ActionItemBranchFilePath (BranchFilePath _ topf)) = +startKeys o (key, ActionItemBranchFilePath (BranchFilePath _ topf) _) =  	start o (getTopFilePath topf) key startKeys _ _ = stop 

@@ -114,7 +114,7 @@ 			Nothing -> go $ perform key file backend numcopies 			Just r -> go $ performRemote key afile backend numcopies r   where-	go = runFsck inc (mkActionItem afile) key+	go = runFsck inc (mkActionItem (key, afile)) key 	afile = AssociatedFile (Just file)  perform :: Key -> FilePath -> Backend -> NumCopies -> Annex Bool@@ -134,7 +134,7 @@ 		]   where 	afile = AssociatedFile (Just file)-	ai = ActionItemAssociatedFile afile+	ai = mkActionItem (key, afile)  {- To fsck a remote, the content is retrieved to a tmp file,  - and checked locally. -}@@ -161,7 +161,7 @@ 		, withLocalCopy localcopy $ checkBackendRemote backend key remote ai 		, checkKeyNumCopies key afile numcopies 		]-	ai = ActionItemAssociatedFile afile+	ai = mkActionItem (key, afile) 	withtmp a = do 		pid <- liftIO getPID 		t <- fromRepo gitAnnexTmpObjectDir@@ -275,7 +275,7 @@ 			fix InfoMissing 			warning $ 				"** Based on the location log, " ++-				actionItemDesc ai key +++				actionItemDesc ai ++ 				"\n** was expected to be present, " ++ 				"but its content is missing." 			return False@@ -295,7 +295,7 @@ {- Verifies that all repos that are required to contain the content do,  - checking against the location log. -} verifyRequiredContent :: Key -> ActionItem -> Annex Bool-verifyRequiredContent key ai@(ActionItemAssociatedFile afile) = do+verifyRequiredContent key ai@(ActionItemAssociatedFile afile _) = do 	requiredlocs <- S.fromList . M.keys <$> requiredContentMap 	if S.null requiredlocs 		then return True@@ -310,7 +310,7 @@ 					missingrequired <- Remote.prettyPrintUUIDs "missingrequired" missinglocs 					warning $ 						"** Required content " ++-						actionItemDesc ai key +++						actionItemDesc ai ++ 						" is missing from these repositories:\n" ++ 						missingrequired 					return False@@ -401,7 +401,7 @@ 	badsize a b = do 		msg <- bad key 		warning $ concat-			[ actionItemDesc ai key+			[ actionItemDesc ai 			, ": Bad file size (" 			, compareSizes storageUnits True a b 			, "); "@@ -419,7 +419,7 @@ 	case Types.Backend.canUpgradeKey backend of 		Just a | a key -> do 			warning $ concat-				[ actionItemDesc ai key+				[ actionItemDesc ai 				, ": Can be upgraded to an improved key format. " 				, "You can do so by running: git annex migrate --backend=" 				, decodeBS (formatKeyVariety (keyVariety key)) ++ " "@@ -451,18 +451,20 @@ 		content <- calcRepo $ gitAnnexLocation key 		ifM (pure (isKeyUnlockedThin keystatus) <&&> (not <$> isUnmodified key content)) 			( nocheck-			, checkBackendOr badContent backend key content (mkActionItem afile)+			, checkBackendOr badContent backend key content ai 			) 	go True = case afile of 		AssociatedFile Nothing -> nocheck 		AssociatedFile (Just f) -> checkdirect f 	checkdirect file = ifM (Direct.goodContent key file)-		( checkBackendOr' (badContentDirect file) backend key file (mkActionItem afile)+		( checkBackendOr' (badContentDirect file) backend key file ai 			(Direct.goodContent key file) 		, nocheck 		) 	nocheck = return True +	ai = mkActionItem (key, afile)+ checkBackendRemote :: Backend -> Key -> Remote -> ActionItem -> FilePath -> Annex Bool checkBackendRemote backend key remote ai localcopy = 	checkBackendOr (badContentRemote remote localcopy) backend key localcopy ai@@ -485,7 +487,7 @@ 					unless ok $ do 						msg <- bad key 						warning $ concat-							[ actionItemDesc ai key+							[ actionItemDesc ai 							, ": Bad file content; " 							, msg 							]

@@ -49,9 +49,10 @@ 			=<< workTreeItems (getFiles o)  start :: GetOptions -> Maybe Remote -> FilePath -> Key -> CommandStart-start o from file key = start' expensivecheck from key afile (mkActionItem afile)+start o from file key = start' expensivecheck from key afile ai   where 	afile = AssociatedFile (Just file)+	ai = mkActionItem (key, afile) 	expensivecheck 		| autoMode o = numCopiesCheck file key (<) 			<||> wantGet False (Just key) afile

@@ -214,7 +214,7 @@ 		-- has to be done to clean up from it. 		let cfg = LockDownConfig 			{ lockingFile = lockingfile-			, hardlinkFileTmp = False+			, hardlinkFileTmpDir = Nothing 			} 		v <- lockDown cfg srcfile 		case v of@@ -291,11 +291,15 @@ listContents :: Remote -> TVar (Maybe (ImportableContents (ContentIdentifier, Remote.ByteSize))) -> CommandStart listContents remote tvar = do 	showStart' "list" (Just (Remote.name remote))-	next $ Remote.listImportableContents (Remote.importActions remote) >>= \case+	next $ listImportableContents remote >>= \case 		Nothing -> giveup $ "Unable to list contents of " ++ Remote.name remote-		Just importable -> next $ do-			liftIO $ atomically $ writeTVar tvar (Just importable)-			return True+		Just importable -> do+			importable' <- makeImportMatcher remote >>= \case+				Right matcher -> filterImportableContents remote matcher importable+				Left err -> giveup $ "Cannot import from " ++ Remote.name remote ++ " because of a problem with its configuration: " ++ err+			next $ do+				liftIO $ atomically $ writeTVar tvar (Just importable')+				return True  commitRemote :: Remote -> Branch -> RemoteTrackingBranch -> Maybe Sha -> ImportTreeConfig -> ImportCommitConfig -> ImportableContents Key -> CommandStart commitRemote remote branch tb trackingcommit importtreeconfig importcommitconfig importable = do

@@ -445,9 +445,8 @@ 	desc = "transfers in progress" 	line uuidmap t i = unwords 		[ formatDirection (transferDirection t) ++ "ing"-		, actionItemDesc-			(ActionItemAssociatedFile (associatedFile i))-			(transferKey t)+		, actionItemDesc $ mkActionItem+			(transferKey t, associatedFile i) 		, if transferDirection t == Upload then "to" else "from" 		, maybe (fromUUID $ transferUUID t) Remote.name $ 			M.lookup (transferUUID t) uuidmap

@@ -76,8 +76,15 @@ seek o = do 	parser <- if largeFilesExpression o 		then mkLargeFilesParser-		else preferredContentParser -			matchAll matchAll groupMap M.empty . Just <$> getUUID+		else do+			u <- getUUID+			pure $ preferredContentParser $ preferredContentTokens $ PCD+				{ matchStandard = Right matchAll+				, matchGroupWanted = Right matchAll+				, getGroupMap = groupMap+				, configMap = M.empty+				, repoUUID = Just u+				} 	case parsedToMatcher $ parser ((matchexpr o)) of 		Left e -> liftIO $ bail $ "bad expression: " ++ e 		Right matcher -> ifM (checkmatcher matcher)

@@ -93,7 +93,7 @@ 		_ -> giveup "--batch is currently only supported in --json mode"  start :: VectorClock -> MetaDataOptions -> FilePath -> Key -> CommandStart-start c o file k = startKeys c o (k, mkActionItem afile)+start c o file k = startKeys c o (k, mkActionItem (k, afile))   where 	afile = AssociatedFile (Just file) @@ -164,7 +164,7 @@ 	Left f -> do 		mk <- lookupFile f 		case mk of-			Just k -> go k (mkActionItem (AssociatedFile (Just f)))+			Just k -> go k (mkActionItem (k, AssociatedFile (Just f))) 			Nothing -> giveup $ "not an annexed file: " ++ f 	Right k -> go k (mkActionItem k)   where

@@ -48,9 +48,10 @@ 		=<< workTreeItems (mirrorFiles o)  start :: MirrorOptions -> FilePath -> Key -> CommandStart-start o file k = startKey o afile (k, mkActionItem afile)+start o file k = startKey o afile (k, ai)   where 	afile = AssociatedFile (Just file)+	ai = mkActionItem (k, afile)  startKey :: MirrorOptions -> AssociatedFile -> (Key, ActionItem) -> CommandStart startKey o afile (key, ai) = onlyActionOn key $ case fromToOptions o of

@@ -64,10 +64,10 @@ 			=<< workTreeItems (moveFiles o)  start :: FromToHereOptions -> RemoveWhen -> FilePath -> Key -> CommandStart-start fromto removewhen f k =-	start' fromto removewhen afile k (mkActionItem afile)+start fromto removewhen f k = start' fromto removewhen afile k ai   where 	afile = AssociatedFile (Just f)+	ai = mkActionItem (k, afile)  startKey :: FromToHereOptions -> RemoveWhen -> (Key, ActionItem) -> CommandStart startKey fromto removewhen = 

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

@@ -690,7 +690,7 @@ 		, return [] 		) 	get have = includeCommandAction $ do-		showStartKey "get" k (mkActionItem af)+		showStartKey "get" k ai 		next $ next $ getKey' k af have  	wantput r@@ -705,8 +705,10 @@ 		, return [] 		) 	put dest = includeCommandAction $ -		Command.Move.toStart' dest Command.Move.RemoveNever af k (mkActionItem af)+		Command.Move.toStart' dest Command.Move.RemoveNever af k ai +	ai = mkActionItem (k, af)+ {- When a remote has an annex-tracking-branch configuration, change the export  - to contain the current content of the branch. Otherwise, transfer any files  - that were part of an export but are not in the remote yet.@@ -723,23 +725,22 @@ 			(Export.openDb (Remote.uuid r)) 			Export.closeDb 			(\db -> Export.writeLockDbWhile db (go' r db))-	go' r db = do-		(exported, mtbcommitsha) <- case remoteAnnexTrackingBranch (Remote.gitconfig r) of-			Nothing -> nontracking r-			Just b -> do-				mtree <- inRepo $ Git.Ref.tree b-				mtbcommitsha <- Command.Export.getExportCommit r b-				case (mtree, mtbcommitsha) of-					(Just tree, Just _) -> do-						Command.Export.changeExport r db tree-						return ([mkExported tree []], mtbcommitsha)-					_ -> nontracking r-		fillexport r db (exportedTreeishes exported) mtbcommitsha-		-	nontracking r = do+	go' r db = case remoteAnnexTrackingBranch (Remote.gitconfig r) of+		Nothing -> nontracking r db+		Just b -> do+			mtree <- inRepo $ Git.Ref.tree b+			mtbcommitsha <- Command.Export.getExportCommit r b+			case (mtree, mtbcommitsha) of+				(Just tree, Just _) -> do+					filteredtree <- Command.Export.filterPreferredContent r tree+					Command.Export.changeExport r db filteredtree+					Command.Export.fillExport r db filteredtree mtbcommitsha+				_ -> nontracking r db+	+	nontracking r db = do 		exported <- getExport (Remote.uuid r) 		maybe noop (warnnontracking r exported) currbranch-		return (exported, Nothing)+		fillexport r db (exportedTreeishes exported) Nothing 	 	warnnontracking r exported currb = inRepo (Git.Ref.tree currb) >>= \case 		Just currt | not (any (== currt) (exportedTreeishes exported)) ->@@ -754,7 +755,9 @@ 		gitconfig = show (remoteConfig r "tracking-branch")  	fillexport _ _ [] _ = return False-	fillexport r db (t:[]) mtbcommitsha = Command.Export.fillExport r db t mtbcommitsha+	fillexport r db (tree:[]) mtbcommitsha = do+		let filteredtree = Command.Export.PreferredFiltered tree+		Command.Export.fillExport r db filteredtree mtbcommitsha 	fillexport r _ _ _ = do 		warnExportImportConflict r 		return False

@@ -48,7 +48,7 @@ 				=<< workTreeItems (whereisFiles o)  start :: M.Map UUID Remote -> FilePath -> Key -> CommandStart-start remotemap file key = startKeys remotemap (key, mkActionItem afile)+start remotemap file key = startKeys remotemap (key, mkActionItem (key, afile))   where 	afile = AssociatedFile (Just file) 

@@ -15,6 +15,7 @@ 	lsTreeParams, 	lsTreeFiles, 	parseLsTree,+	formatLsTree, ) where  import Common@@ -90,3 +91,12 @@ 	!f = drop 1 past_s 	!smode = fst $ Prelude.head $ readOct m 	!sfile = asTopFilePath $ Git.Filename.decode f++{- Inverse of parseLsTree -}+formatLsTree :: TreeItem -> String+formatLsTree ti = unwords+	[ showOct (mode ti) ""+	, typeobj ti+	, fromRef (sha ti)+	, getTopFilePath (file ti)+	]

@@ -15,6 +15,8 @@ 	recordTree', 	TreeItem(..), 	treeItemsToTree,+	treeItemToLsTreeItem,+	lsTreeItemToTreeItem, 	adjustTree, 	graftTree, 	graftTree',@@ -127,6 +129,20 @@ treeItemToTreeContent :: TreeItem -> TreeContent treeItemToTreeContent (TreeItem f m s) = TreeBlob f m s +treeItemToLsTreeItem :: TreeItem -> LsTree.TreeItem+treeItemToLsTreeItem (TreeItem f mode sha) = LsTree.TreeItem+	{ LsTree.mode = mode+	, LsTree.typeobj = show BlobObject+	, LsTree.sha = sha+	, LsTree.file = f+	}++lsTreeItemToTreeItem :: LsTree.TreeItem -> TreeItem+lsTreeItemToTreeItem ti = TreeItem+	(LsTree.file ti)+	(LsTree.mode ti)+	(LsTree.sha ti)+ treeItemsToTree :: [TreeItem] -> Tree treeItemsToTree = go M.empty   where@@ -179,12 +195,16 @@ 	-- Cannot move the item to a different tree. 	-> [TreeItem] 	-- ^ New items to add to the tree.+	-> (TreeContent -> TreeContent -> TreeContent)+	-- ^ When adding a new item to the tree and an item with the same+	-- name already exists, this function picks which to use.+	-- The first one is the item that was already in the tree. 	-> [TopFilePath] 	-- ^ Files to remove from the tree. 	-> Ref 	-> Repo 	-> m Sha-adjustTree adjusttreeitem addtreeitems removefiles r repo =+adjustTree adjusttreeitem addtreeitems resolveaddconflict removefiles r repo = 	withMkTreeHandle repo $ \h -> do 		(l, cleanup) <- liftIO $ lsTreeWithObjects LsTree.LsTreeRecursive r repo 		(l', _, _) <- go h False [] 1 inTopTree l@@ -223,16 +243,30 @@ 	adjustlist h depth ishere underhere l = do 		let (addhere, rest) = partition ishere addtreeitems 		let l' = filter (not . removed) $-			map treeItemToTreeContent addhere ++ l+			addoldnew l (map treeItemToTreeContent addhere) 		let inl i = any (\t -> beneathSubTree t i) l' 		let (Tree addunderhere) = flattenTree depth $ treeItemsToTree $ 			filter (\i -> underhere i && not (inl i)) rest 		addunderhere' <- liftIO $ mapM (recordSubTree h) addunderhere-		return (addunderhere'++l')+		return (addoldnew l' addunderhere')  	removeset = S.fromList $ map (normalise . gitPath) removefiles 	removed (TreeBlob f _ _) = S.member (normalise (gitPath f)) removeset 	removed _ = False++	addoldnew [] new = new+	addoldnew old [] = old+	addoldnew old new = addoldnew' (M.fromList $ map (\i -> (mkk i, i)) old) new+	addoldnew' oldm (n:ns) = +			let k = mkk n+			in case M.lookup k oldm of+				Just o -> +					resolveaddconflict o n+					: +					addoldnew' (M.delete k oldm) ns+				Nothing -> n : addoldnew' oldm ns+	addoldnew' oldm [] = M.elems oldm+	mkk = normalise . gitPath  {- Grafts subtree into the basetree at the specified location, replacing  - anything that the basetree already had at that location.

@@ -63,9 +63,9 @@ 	prepend (BuildingMatcher ls) = BuildingMatcher $ l:ls 	prepend _ = error "internal" -{- Adds a new token. -}-addToken :: String -> Annex ()-addToken = add . Utility.Matcher.token+{- Adds a new syntax token. -}+addSyntaxToken :: String -> Annex ()+addSyntaxToken = either error add . Utility.Matcher.syntaxToken  {- Adds a new limit. -} addLimit :: Either String (MatchFiles Annex) -> Annex ()

@@ -15,6 +15,8 @@ 	incompleteExportedTreeishes, 	recordExport, 	recordExportBeginning,+	logExportExcluded,+	getExportExcluded, ) where  import qualified Data.Map as M@@ -26,6 +28,9 @@ import Git.FilePath import Logs import Logs.MapLog+import Logs.File+import qualified Git.LsTree+import qualified Git.Tree import Annex.UUID  import qualified Data.ByteString.Lazy as L@@ -156,3 +161,23 @@   where 	refparser = (Git.Ref . decodeBS <$> A8.takeWhile1 (/= ' ') ) 		<* ((const () <$> A8.char ' ') <|> A.endOfInput)++logExportExcluded :: UUID -> ((Git.Tree.TreeItem -> IO ()) -> Annex a) -> Annex a+logExportExcluded u a = do+	logf <- fromRepo $ gitAnnexExportExcludeLog u+	withLogHandle logf $ \logh -> do+		liftIO $ hSetNewlineMode logh noNewlineTranslation+		a (writer logh)+  where+	writer logh = hPutStrLn logh+		. Git.LsTree.formatLsTree+		. Git.Tree.treeItemToLsTreeItem++getExportExcluded :: UUID -> Annex [Git.Tree.TreeItem]+getExportExcluded u = do+	logf <- fromRepo $ gitAnnexExportExcludeLog u+	liftIO $ catchDefaultIO [] $ +		(map parser . lines)+			<$> readFile logf+  where+	parser = Git.Tree.lsTreeItemToTreeItem . Git.LsTree.parseLsTree

@@ -5,11 +5,12 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -module Logs.File (writeLogFile, appendLogFile, streamLogFile) where+module Logs.File (writeLogFile, withLogHandle, appendLogFile, streamLogFile) where  import Annex.Common import Annex.Perms import Annex.LockFile+import Annex.ReplaceFile import qualified Git import Utility.Tmp @@ -22,6 +23,19 @@ 	writelog f' c' = do 		liftIO $ writeFile f' c' 		setAnnexFilePerm f'++-- | Runs the action with a handle connected to a temp file.+-- The temp file replaces the log file once the action succeeds.+withLogHandle :: FilePath -> (Handle -> Annex a) -> Annex a+withLogHandle f a = do+	createAnnexDirectory (parentDir f)+	replaceFile f $ \tmp ->+		bracket (setup tmp) cleanup a+  where+	setup tmp = do+		setAnnexFilePerm tmp+		liftIO $ openFile tmp WriteMode+	cleanup h = liftIO $ hClose h  -- | Appends a line to a log file, first locking it to prevent -- concurrent writers.

@@ -20,6 +20,7 @@ 	setStandardGroup, 	defaultStandardGroup, 	preferredRequiredMapsLoad,+	preferredRequiredMapsLoad', 	prop_standardGroups_parse, ) where @@ -34,7 +35,7 @@ import qualified Annex import Logs import Logs.UUIDBased-import Utility.Matcher hiding (tokens)+import Utility.Matcher import Annex.FileMatcher import Annex.UUID import Types.Group@@ -62,30 +63,46 @@ 		Just matcher -> checkMatcher matcher mkey afile notpresent (return d) (return d)  preferredContentMap :: Annex (FileMatcherMap Annex)-preferredContentMap = maybe (fst <$> preferredRequiredMapsLoad) return+preferredContentMap = maybe (fst <$> preferredRequiredMapsLoad preferredContentTokens) return 	=<< Annex.getState Annex.preferredcontentmap  requiredContentMap :: Annex (FileMatcherMap Annex)-requiredContentMap = maybe (snd <$> preferredRequiredMapsLoad) return+requiredContentMap = maybe (snd <$> preferredRequiredMapsLoad preferredContentTokens) return 	=<< Annex.getState Annex.requiredcontentmap -preferredRequiredMapsLoad :: Annex (FileMatcherMap Annex, FileMatcherMap Annex)-preferredRequiredMapsLoad = do+preferredRequiredMapsLoad :: (PreferredContentData -> [ParseToken (MatchFiles Annex)]) -> Annex (FileMatcherMap Annex, FileMatcherMap Annex)+preferredRequiredMapsLoad mktokens = do+	(pc, rc) <- preferredRequiredMapsLoad' mktokens+	let pc' = handleunknown pc+	let rc' = handleunknown rc+	Annex.changeState $ \s -> s+		{ Annex.preferredcontentmap = Just pc'+		, Annex.requiredcontentmap = Just rc'+		}+	return (pc', rc')+  where+	handleunknown = M.mapWithKey $ \u ->+		either (const $ unknownMatcher u) id++preferredRequiredMapsLoad' :: (PreferredContentData -> [ParseToken (MatchFiles Annex)]) -> Annex (M.Map UUID (Either String (FileMatcher Annex)), M.Map UUID (Either String (FileMatcher Annex)))+preferredRequiredMapsLoad' mktokens = do 	groupmap <- groupMap 	configmap <- readRemoteLog-	let genmap l gm = simpleMap-		. parseLogOldWithUUID (\u -> makeMatcher groupmap configmap gm u . decodeBS <$> A.takeByteString)-		<$> Annex.Branch.get l+	let genmap l gm = +		let mk u = makeMatcher groupmap configmap gm u mktokens+		in simpleMap+			. parseLogOldWithUUID (\u -> mk u . decodeBS <$> A.takeByteString)+			<$> Annex.Branch.get l 	pc <- genmap preferredContentLog =<< groupPreferredContentMapRaw 	rc <- genmap requiredContentLog M.empty-	-- Required content is implicitly also preferred content, so-	-- combine.-	let m = M.unionWith combineMatchers pc rc-	Annex.changeState $ \s -> s-		{ Annex.preferredcontentmap = Just m-		, Annex.requiredcontentmap = Just rc-		}-	return (m, rc)+	-- Required content is implicitly also preferred content, so combine.+	let pc' = M.unionWith combiner pc rc+	return (pc', rc)+  where+	combiner (Right a) (Right b) = Right (combineMatchers a b)+	combiner (Left a)  (Left b)  = Left (a ++ " " ++ b)+	combiner (Left a)  (Right _) = Left a+	combiner (Right _) (Left b)  = Left b  {- This intentionally never fails, even on unparsable expressions,  - because the configuration is shared among repositories and newer@@ -95,23 +112,31 @@ 	-> M.Map UUID RemoteConfig 	-> M.Map Group PreferredContentExpression 	-> UUID+	-> (PreferredContentData -> [ParseToken (MatchFiles Annex)]) 	-> PreferredContentExpression-	-> FileMatcher Annex-makeMatcher groupmap configmap groupwantedmap u = go True True+	-> Either String (FileMatcher Annex)+makeMatcher groupmap configmap groupwantedmap u mktokens = go True True   where 	go expandstandard expandgroupwanted expr-		| null (lefts tokens) = generate $ rights tokens-		| otherwise = unknownMatcher u+		| null (lefts tokens) = Right $ generate $ rights tokens+		| otherwise = Left (unwords (lefts tokens)) 	  where-		tokens = preferredContentParser matchstandard matchgroupwanted (pure groupmap) configmap (Just u) expr+		tokens = preferredContentParser (mktokens pcd) expr+		pcd = PCD+			{ matchStandard = matchstandard+			, matchGroupWanted = matchgroupwanted+			, getGroupMap = pure groupmap+			, configMap = configmap+			, repoUUID = Just u+			} 		matchstandard-			| expandstandard = maybe (unknownMatcher u) (go False False)+			| expandstandard = maybe (Right $ unknownMatcher u) (go False False) 				(standardPreferredContent <$> getStandardGroup mygroups)-			| otherwise = unknownMatcher u+			| otherwise = Right $ unknownMatcher u 		matchgroupwanted-			| expandgroupwanted = maybe (unknownMatcher u) (go True False)+			| expandgroupwanted = maybe (Right $ unknownMatcher u) (go True False) 				(groupwanted mygroups)-			| otherwise = unknownMatcher u+			| otherwise = Right $ unknownMatcher u 		mygroups = fromMaybe S.empty (u `M.lookup` groupsByUUID groupmap) 		groupwanted s = case M.elems $ M.filterWithKey (\k _ -> S.member k s) groupwantedmap of 			[pc] -> Just pc@@ -134,7 +159,14 @@ 	Left e -> Just e 	Right _ -> Nothing   where-	tokens = preferredContentParser matchAll matchAll (pure emptyGroupMap) M.empty Nothing expr+	tokens = preferredContentParser (preferredContentTokens pcd) expr+	pcd = PCD+		{ matchStandard = Right matchAll+		, matchGroupWanted = Right matchAll+		, getGroupMap = pure emptyGroupMap+		, configMap = M.empty+		, repoUUID = Nothing+		}  {- Puts a UUID in a standard group, and sets its preferred content to use  - the standard expression for that group (unless preferred content is

@@ -12,7 +12,6 @@ import Types.Transfer import Types.ActionItem import Annex.Common-import Annex.Perms import qualified Git import Utility.Metered import Utility.Percentage@@ -20,6 +19,9 @@ import Annex.LockPool import Utility.TimeStamp import Logs.File+#ifndef mingw32_HOST_OS+import Annex.Perms+#endif  import Data.Time.Clock import Data.Time.Clock.POSIX@@ -29,8 +31,8 @@ describeTransfer t info = unwords 	[ show $ transferDirection t 	, show $ transferUUID t-	, actionItemDesc-		(ActionItemAssociatedFile (associatedFile info))+	, actionItemDesc $ ActionItemAssociatedFile+		(associatedFile info) 		(transferKey t) 	, show $ bytesComplete info 	]

@@ -77,7 +77,7 @@  showStartKey :: String -> Key -> ActionItem -> Annex () showStartKey command key i = outputMessage json $-	command ++ " " ++ actionItemDesc i key ++ " "+	command ++ " " ++ actionItemDesc i ++ " "   where 	json = JSON.start command (actionItemWorkTreeFile i) (Just key) @@ -262,10 +262,12 @@  - the user.  -} prompt :: Annex a -> Annex a-prompt a = debugLocks $ go =<< Annex.getState Annex.concurrency+prompt a = debugLocks $ Annex.getState Annex.concurrency >>= \case+	NonConcurrent -> a+	(Concurrent _) -> goconcurrent+	ConcurrentPerCpu -> goconcurrent   where-	go NonConcurrent = a-	go (Concurrent {}) = withMessageState $ \s -> do+	goconcurrent = withMessageState $ \s -> do 		let l = promptLock s 		bracketIO 			(takeMVar l)

@@ -81,6 +81,8 @@ 				, retrieveExportWithContentIdentifier = retrieveExportWithContentIdentifierM dir 				, storeExportWithContentIdentifier = storeExportWithContentIdentifierM dir 				, removeExportWithContentIdentifier = removeExportWithContentIdentifierM dir+				-- Not needed because removeExportWithContentIdentifier+				-- auto-removes empty directories. 				, removeExportDirectoryWhenEmpty = Nothing 				, checkPresentExportWithContentIdentifier = checkPresentExportWithContentIdentifierM dir 				}

@@ -150,12 +150,12 @@ 			{ displayProgress = False } 		| otherwise = specialRemoteCfg c -rsyncTransportToObjects :: Git.Repo -> RemoteGitConfig -> Annex ([CommandParam], String)+rsyncTransportToObjects :: Git.Repo -> RemoteGitConfig -> Annex (Annex [CommandParam], String) rsyncTransportToObjects r gc = do 	(rsynctransport, rsyncurl, _) <- rsyncTransport r gc 	return (rsynctransport, rsyncurl ++ "/annex/objects") -rsyncTransport :: Git.Repo -> RemoteGitConfig -> Annex ([CommandParam], String, AccessMethod)+rsyncTransport :: Git.Repo -> RemoteGitConfig -> Annex (Annex [CommandParam], String, AccessMethod) rsyncTransport r gc 	| "ssh://" `isPrefixOf` loc = sshtransport $ break (== '/') $ drop (length "ssh://") loc 	| "//:" `isInfixOf` loc = othertransport@@ -168,9 +168,10 @@ 			then drop 3 path 			else path 		let sshhost = either error id (mkSshHost host)-		opts <- sshOptions ConsumeStdin (sshhost, Nothing) gc []-		return (rsyncShell $ Param "ssh" : opts, fromSshHost sshhost ++ ":" ++ rsyncpath, AccessShell)-	othertransport = return ([], loc, AccessDirect)+		let mkopts = rsyncShell . (Param "ssh" :) +			<$> sshOptions ConsumeStdin (sshhost, Nothing) gc []+		return (mkopts, fromSshHost sshhost ++ ":" ++ rsyncpath, AccessShell)+	othertransport = return (pure [], loc, AccessDirect)  noCrypto :: Annex a noCrypto = giveup "cannot use gcrypt remote without encryption enabled"@@ -263,14 +264,15 @@ 		dummycfg <- liftIO dummyRemoteGitConfig 		(rsynctransport, rsyncurl, _) <- rsyncTransport r dummycfg 		let tmpconfig = tmp </> "config"-		void $ liftIO $ rsync $ rsynctransport +++		opts <- rsynctransport+		void $ liftIO $ rsync $ opts ++ 			[ Param $ rsyncurl ++ "/config" 			, Param tmpconfig 			] 		liftIO $ do 			void $ Git.Config.changeFile tmpconfig coreGCryptId gcryptid 			void $ Git.Config.changeFile tmpconfig denyNonFastForwards (Git.Config.boolConfig False)-		ok <- liftIO $ rsync $ rsynctransport +++		ok <- liftIO $ rsync $ opts ++ 			[ Param "--recursive" 			, Param $ tmp ++ "/" 			, Param rsyncurl@@ -456,9 +458,10 @@ getConfigViaRsync :: Git.Repo -> RemoteGitConfig -> Annex (Either SomeException (Git.Repo, String)) getConfigViaRsync r gc = do 	(rsynctransport, rsyncurl, _) <- rsyncTransport r gc+	opts <- rsynctransport 	liftIO $ do 		withTmpFile "tmpconfig" $ \tmpconfig _ -> do-			void $ rsync $ rsynctransport +++			void $ rsync $ opts ++ 				[ Param $ rsyncurl ++ "/config" 				, Param tmpconfig 				]

@@ -1,6 +1,6 @@ {- Adds readonly support to remotes.  -- - Copyright 2013, 2015 Joey Hess <id@joeyh.name>+ - Copyright 2013-2019 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -15,6 +15,8 @@ import Annex.Common import Types.Remote import Types.StoreRetrieve+import Types.Import+import Types.Export import Utility.Metered  {- Adds support for read-only remotes, by replacing the@@ -28,6 +30,17 @@ 		{ storeKey = readonlyStoreKey 		, removeKey = readonlyRemoveKey 		, repairRepo = Nothing+		, exportActions = (exportActions r)+			{ storeExport = readonlyStoreExport+			, removeExport = readonlyRemoveExport+			, removeExportDirectory = Just readonlyRemoveExportDirectory+			, renameExport = readonlyRenameExport+			}+		, importActions = (importActions r)+			{ storeExportWithContentIdentifier = readonlyStoreExportWithContentIdentifier+			, removeExportWithContentIdentifier = readonlyRemoveExportWithContentIdentifier+			, removeExportDirectoryWhenEmpty = Just readonlyRemoveExportDirectory+			} 		} 	| otherwise = r @@ -40,7 +53,30 @@ readonlyStorer :: Storer readonlyStorer _ _ _ = readonlyFail +readonlyStoreExport :: FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool+readonlyStoreExport _ _ _ _ = readonlyFail++readonlyRemoveExport :: Key -> ExportLocation -> Annex Bool+readonlyRemoveExport _ _ = readonlyFail++readonlyRemoveExportDirectory :: ExportDirectory -> Annex Bool+readonlyRemoveExportDirectory _ = readonlyFail++readonlyRenameExport :: Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)+readonlyRenameExport _ _ _ = return Nothing++readonlyStoreExportWithContentIdentifier :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex (Maybe ContentIdentifier)+readonlyStoreExportWithContentIdentifier _ _ _ _ _ = do+	readonlyWarning+	return Nothing++readonlyRemoveExportWithContentIdentifier :: Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool+readonlyRemoveExportWithContentIdentifier _ _ _ = readonlyFail+ readonlyFail :: Annex Bool readonlyFail = do-	warning "this remote is readonly"+	readonlyWarning 	return False++readonlyWarning :: Annex ()+readonlyWarning = warning "this remote is readonly"

@@ -110,15 +110,18 @@ 		-- Rsync displays its own progress. 		{ displayProgress = False } -genRsyncOpts :: RemoteConfig -> RemoteGitConfig -> [CommandParam] -> RsyncUrl -> RsyncOpts+genRsyncOpts :: RemoteConfig -> RemoteGitConfig -> Annex [CommandParam] -> RsyncUrl -> RsyncOpts genRsyncOpts c gc transport url = RsyncOpts 	{ rsyncUrl = url-	, rsyncOptions = transport ++ opts []-	, rsyncUploadOptions = transport ++ opts (remoteAnnexRsyncUploadOptions gc)-	, rsyncDownloadOptions = transport ++ opts (remoteAnnexRsyncDownloadOptions gc)+	, rsyncOptions = appendtransport $ opts []+	, rsyncUploadOptions = appendtransport $+		opts (remoteAnnexRsyncUploadOptions gc)+	, rsyncDownloadOptions = appendtransport $+		opts (remoteAnnexRsyncDownloadOptions gc) 	, rsyncShellEscape = (yesNo =<< M.lookup "shellescape" c) /= Just False 	}   where+	appendtransport l = (++ l) <$> transport 	opts specificopts = map Param $ filter safe $ 		remoteAnnexRsyncOptions gc ++ specificopts 	safe opt@@ -129,23 +132,23 @@ 		| opt == "--delete-excluded" = False 		| otherwise = True -rsyncTransport :: RemoteGitConfig -> RsyncUrl -> Annex ([CommandParam], RsyncUrl)+rsyncTransport :: RemoteGitConfig -> RsyncUrl -> Annex (Annex [CommandParam], RsyncUrl) rsyncTransport gc url 	| rsyncUrlIsShell url =-		(\rsh -> return (rsyncShell rsh, url)) =<<+		(\transport -> return (rsyncShell <$> transport, url)) =<< 		case fromNull ["ssh"] (remoteAnnexRsyncTransport gc) of 			"ssh":sshopts -> do 				let (port, sshopts') = sshReadPort sshopts 				    userhost = either error id $ mkSshHost $  				    	takeWhile (/= ':') url-				(Param "ssh":) <$> sshOptions ConsumeStdin+				return $ (Param "ssh":) <$> sshOptions ConsumeStdin 					(userhost, port) gc 					(map Param $ loginopt ++ sshopts')-			"rsh":rshopts -> return $ map Param $ "rsh" :+			"rsh":rshopts -> return $ pure $ map Param $ "rsh" : 				loginopt ++ rshopts 			rsh -> giveup $ "Unknown Rsync transport: " 				++ unwords rsh-	| otherwise = return ([], url)+	| otherwise = return (pure [], url)   where 	login = case separate (=='@') url of 		(_h, "") -> Nothing@@ -232,9 +235,10 @@ removeGeneric :: RsyncOpts -> [String] -> Annex Bool removeGeneric o includes = do 	ps <- sendParams+	opts <- rsyncOptions o 	withRsyncScratchDir $ \tmp -> liftIO $ do 		{- Send an empty directory to rysnc to make it delete. -}-		rsync $ rsyncOptions o ++ ps +++		rsync $ opts ++ ps ++ 			map (\s -> Param $ "--include=" ++ s) includes ++ 			[ Param "--exclude=*" -- exclude everything else 			, Param "--quiet", Param "--delete", Param "--recursive"@@ -249,14 +253,14 @@ 	checkPresentGeneric o (rsyncUrls o k)  checkPresentGeneric :: RsyncOpts -> [RsyncUrl] -> Annex Bool-checkPresentGeneric o rsyncurls =+checkPresentGeneric o rsyncurls = do+	opts <- rsyncOptions o 	-- note: Does not currently differentiate between rsync failing 	-- to connect, and the file not being present. 	untilTrue rsyncurls $ \u ->  		liftIO $ catchBoolIO $ do 			withQuietOutput createProcessSuccess $-				proc "rsync" $ toCommand $-					rsyncOptions o ++ [Param u]+				proc "rsync" $ toCommand $ opts ++ [Param u] 			return True  storeExportM :: RsyncOpts -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool@@ -341,13 +345,14 @@ 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 			liftIO $ rsyncProgress oh meter ps   where-	ps = opts ++ Param "--progress" : params-	opts+	mkopts 		| direction == Download = rsyncDownloadOptions o 		| otherwise = rsyncUploadOptions o

@@ -25,9 +25,9 @@  data RsyncOpts = RsyncOpts 	{ rsyncUrl :: RsyncUrl-	, rsyncOptions :: [CommandParam]-	, rsyncUploadOptions :: [CommandParam]-	, rsyncDownloadOptions :: [CommandParam]+	, rsyncOptions :: Annex [CommandParam]+	, rsyncUploadOptions :: Annex [CommandParam]+	, rsyncDownloadOptions :: Annex [CommandParam] 	, rsyncShellEscape :: Bool } 

@@ -1,6 +1,6 @@ {- items that a command can act on  -- - Copyright 2016 Joey Hess <id@joeyh.name>+ - Copyright 2016-2019 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -14,36 +14,45 @@ import Git.FilePath  data ActionItem -	= ActionItemAssociatedFile AssociatedFile-	| ActionItemKey-	| ActionItemBranchFilePath BranchFilePath+	= ActionItemAssociatedFile AssociatedFile Key+	| ActionItemKey Key+	| ActionItemBranchFilePath BranchFilePath Key 	| ActionItemFailedTransfer Transfer TransferInfo  class MkActionItem t where 	mkActionItem :: t -> ActionItem -instance MkActionItem AssociatedFile where-	mkActionItem = ActionItemAssociatedFile+instance MkActionItem (AssociatedFile, Key) where+	mkActionItem = uncurry ActionItemAssociatedFile +instance MkActionItem (Key, AssociatedFile) where+	mkActionItem = uncurry $ flip ActionItemAssociatedFile+ instance MkActionItem Key where-	mkActionItem _ = ActionItemKey+	mkActionItem = ActionItemKey -instance MkActionItem BranchFilePath where-	mkActionItem = ActionItemBranchFilePath+instance MkActionItem (BranchFilePath, Key) where+	mkActionItem = uncurry ActionItemBranchFilePath  instance MkActionItem (Transfer, TransferInfo) where 	mkActionItem = uncurry ActionItemFailedTransfer -actionItemDesc :: ActionItem -> Key -> String-actionItemDesc (ActionItemAssociatedFile (AssociatedFile (Just f))) _ = f-actionItemDesc (ActionItemAssociatedFile (AssociatedFile Nothing)) k = serializeKey k-actionItemDesc ActionItemKey k = serializeKey k-actionItemDesc (ActionItemBranchFilePath bfp) _ = descBranchFilePath bfp-actionItemDesc (ActionItemFailedTransfer _ i) k =-	actionItemDesc (ActionItemAssociatedFile (associatedFile i)) k+actionItemDesc :: ActionItem -> String+actionItemDesc (ActionItemAssociatedFile (AssociatedFile (Just f)) _) = f+actionItemDesc (ActionItemAssociatedFile (AssociatedFile Nothing) k) = serializeKey k+actionItemDesc (ActionItemKey k) = serializeKey k+actionItemDesc (ActionItemBranchFilePath bfp _) = descBranchFilePath bfp+actionItemDesc (ActionItemFailedTransfer t i) = actionItemDesc $+	ActionItemAssociatedFile (associatedFile i) (transferKey t) +actionItemKey :: ActionItem -> Key+actionItemKey (ActionItemAssociatedFile _ k) = k+actionItemKey (ActionItemKey k) = k+actionItemKey (ActionItemBranchFilePath _ k) = k+actionItemKey (ActionItemFailedTransfer t _) = transferKey t+ actionItemWorkTreeFile :: ActionItem -> Maybe FilePath-actionItemWorkTreeFile (ActionItemAssociatedFile (AssociatedFile af)) = af+actionItemWorkTreeFile (ActionItemAssociatedFile (AssociatedFile af) _) = af actionItemWorkTreeFile _ = Nothing  actionItemTransferDirection :: ActionItem -> Maybe Direction

@@ -27,7 +27,7 @@ type CommandSeek = Annex () {- d. The start stage is run before anything is printed about the  -    command, is passed some input, and can early abort it- -    if the input does not make sense. It should run quickly and+ -    if nothing needs to be done. It should run quickly and  -    should not modify Annex state. -} type CommandStart = Annex (Maybe CommandPerform) {- e. The perform stage is run after a message is printed about the command

@@ -5,4 +5,11 @@  module Types.Concurrency where -data Concurrency = NonConcurrent | Concurrent Int+import Utility.PartialPrelude++data Concurrency = NonConcurrent | Concurrent Int | ConcurrentPerCpu++parseConcurrency :: String -> Maybe Concurrency+parseConcurrency "cpus" = Just ConcurrentPerCpu+parseConcurrency "cpu" = Just ConcurrentPerCpu+parseConcurrency s = Concurrent <$> readish s

@@ -31,7 +31,7 @@ 	}  -- This is used when testing a matcher, with values to match against--- provided by the user, rather than queried from files.+-- provided in some way, rather than queried from files on disk. data ProvidedInfo = ProvidedInfo 	{ providedFilePath :: OptInfo FilePath 	, providedKey :: OptInfo Key@@ -48,7 +48,7 @@ getInfo (Right i) = return i getInfo (Left e) = liftIO e -type FileMatcherMap a = M.Map UUID (Utility.Matcher.Matcher (S.Set UUID -> MatchInfo -> a Bool))+type FileMatcherMap a = M.Map UUID (FileMatcher a)  type MkLimit a = String -> Either String (MatchFiles a) 

@@ -98,7 +98,7 @@ 	, annexRetry :: Maybe Integer 	, annexRetryDelay :: Maybe Seconds 	, annexAllowedUrlSchemes :: S.Set Scheme-	, annexAllowedHttpAddresses :: String+	, annexAllowedIPAddresses :: String 	, annexAllowUnverifiedDownloads :: Bool 	, annexMaxExtensionLength :: Maybe Int 	, annexJobs :: Concurrency@@ -172,12 +172,15 @@ 	, annexAllowedUrlSchemes = S.fromList $ map mkScheme $ 		maybe ["http", "https", "ftp"] words $ 			getmaybe (annex "security.allowed-url-schemes")-	, annexAllowedHttpAddresses = fromMaybe "" $-		getmaybe (annex "security.allowed-http-addresses")+	, annexAllowedIPAddresses = fromMaybe "" $+		getmaybe (annex "security.allowed-ip-addresses")+			<|>+		getmaybe (annex "security.allowed-http-addresses") -- old name 	, annexAllowUnverifiedDownloads = (== Just "ACKTHPPT") $ 		getmaybe (annex "security.allow-unverified-downloads") 	, annexMaxExtensionLength = getmayberead (annex "maxextensionlength")-	, annexJobs = maybe NonConcurrent Concurrent $ getmayberead (annex "jobs")+	, annexJobs = fromMaybe NonConcurrent $ +		parseConcurrency =<< getmaybe (annex "jobs") 	, annexCacheCreds = getbool (annex "cachecreds") True 	, coreSymlinks = getbool "core.symlinks" True 	, coreSharedRepository = getSharedRepository r

@@ -231,11 +231,11 @@ 	-- Removes an exported file (succeeds if the contents are not present) 	, removeExport :: Key -> ExportLocation -> a Bool 	-- Removes an exported directory. Typically the directory will be-	-- empty, but it could possbly contain files or other directories,-	-- and it's ok to delete those. If the remote does not use-	-- directories, or automatically cleans up empty directories,-	-- this can be Nothing. Should not fail if the directory was-	-- already removed.+	-- empty, but it could possibly contain files or other directories,+	-- and it's ok to delete those (but not required to). +	-- If the remote does not use directories, or automatically cleans+	-- up empty directories, this can be Nothing.+	-- Should not fail if the directory was already removed. 	, removeExportDirectory :: Maybe (ExportDirectory -> a Bool) 	-- Checks if anything is exported to the remote at the specified 	-- ExportLocation.

@@ -0,0 +1,30 @@+{- Command worker pool.+ -+ - Copyright 2019 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Types.WorkerPool where++import Control.Concurrent.Async+import Data.Either++-- | Pool of worker threads. +data WorkerPool t+	= UnallocatedWorkerPool+	| WorkerPool [Worker t]++-- | A worker can either be idle or running an Async action.+type Worker t = Either t (Async t)++allocateWorkerPool :: t -> Int -> WorkerPool t+allocateWorkerPool t n = WorkerPool $ replicate n (Left t)++addWorkerPool :: WorkerPool t -> Worker t -> WorkerPool t+addWorkerPool (WorkerPool l) w = WorkerPool (w:l)+addWorkerPool UnallocatedWorkerPool w = WorkerPool [w]++idleWorkers :: WorkerPool t -> [t]+idleWorkers UnallocatedWorkerPool = []+idleWorkers (WorkerPool l) = lefts l

@@ -30,11 +30,39 @@ import Data.Default import Data.Typeable import Control.Applicative+#if MIN_VERSION_base(4,9,0)+import qualified Data.Semigroup as Sem+#endif+import Data.Monoid+import Prelude  data Restriction = Restriction-	{ addressRestriction :: AddrInfo -> Maybe ConnectionRestricted+	{ checkAddressRestriction :: AddrInfo -> Maybe ConnectionRestricted 	} +appendRestrictions :: Restriction -> Restriction -> Restriction+appendRestrictions a b = Restriction+	{ checkAddressRestriction = \addr ->+		checkAddressRestriction a addr <|> checkAddressRestriction b addr+	}++-- | mempty does not restrict HTTP connections in any way+instance Monoid Restriction where+	mempty = Restriction+		{ checkAddressRestriction = \_ -> Nothing+		}+#if MIN_VERSION_base(4,11,0)+#elif MIN_VERSION_base(4,9,0)+	mappend = (Sem.<>)+#else+	mappend = appendRestrictions+#endif++#if MIN_VERSION_base(4,9,0)+instance Sem.Semigroup Restriction where+	(<>) = appendRestrictions+#endif+ -- | An exception used to indicate that the connection was restricted. data ConnectionRestricted = ConnectionRestricted String 	deriving (Show, Typeable)@@ -117,7 +145,7 @@ 			return $ proxy $ f $ dummyreq https 	 	mkproxy Nothing = (noProxy, Nothing)-	mkproxy (Just proxyaddr) = case addressRestriction cfg proxyaddr of+	mkproxy (Just proxyaddr) = case checkAddressRestriction cfg proxyaddr of 		Nothing -> (addrtoproxy (addrAddress proxyaddr), Nothing) 		Just _ -> (noProxy, Just ProxyRestricted) 	@@ -200,7 +228,7 @@ 			close 			(\sock -> NC.connectFromSocket context sock connparams) 	  where-		tryToConnect addr = case addressRestriction cfg addr of+		tryToConnect addr = case checkAddressRestriction cfg addr of 			Nothing -> bracketOnError 				(socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)) 				close

@@ -12,8 +12,21 @@ import Network.Socket import Data.Word import Data.Memory.Endian+import Data.List import Control.Applicative+import Text.Printf import Prelude++extractIPAddress :: SockAddr -> Maybe String+extractIPAddress (SockAddrInet _ ipv4) =+	let (a,b,c,d) = hostAddressToTuple ipv4+	in Just $ intercalate "." [show a, show b, show c, show d]+extractIPAddress (SockAddrInet6 _ _ ipv6 _) =+	let (a,b,c,d,e,f,g,h) = hostAddress6ToTuple ipv6+	in Just $ intercalate ":" [s a, s b, s c, s d, s e, s f, s g, s h]+  where+	s = printf "%x"+extractIPAddress _ = Nothing  {- Check if an IP address is a loopback address; connecting to it  - may connect back to the local host. -}

@@ -20,8 +20,7 @@ module Utility.Matcher ( 	Token(..), 	Matcher(..),-	token,-	tokens,+	syntaxToken, 	generate, 	match, 	matchM,@@ -47,16 +46,13 @@ 	deriving (Show, Eq)  {- Converts a word of syntax into a token. Doesn't handle operations. -}-token :: String -> Token op-token "and" = And-token "or" = Or-token "not" = Not-token "(" = Open-token ")" = Close-token t = error $ "unknown token " ++ t--tokens :: [String]-tokens = words "and or not ( )"+syntaxToken :: String -> Either String (Token op)+syntaxToken "and" = Right And+syntaxToken "or" = Right Or+syntaxToken "not" = Right Not+syntaxToken "(" = Right Open+syntaxToken ")" = Right Close+syntaxToken t = Left $ "unknown token " ++ t  {- Converts a list of Tokens into a Matcher. -} generate :: [Token op] -> Matcher op

@@ -1,6 +1,6 @@ {- Url downloading.  -- - Copyright 2011-2018 Joey Hess <id@joeyh.name>+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}@@ -19,6 +19,7 @@ 	mkScheme, 	allowedScheme, 	UrlDownloader(..),+	NonHttpUrlDownloader(..), 	UrlOptions(..), 	defUrlOptions, 	mkUrlOptions,@@ -40,18 +41,26 @@ import Common import Utility.Metered import Utility.HttpManagerRestricted+import Utility.IPAddress  import Network.URI import Network.HTTP.Types+import qualified Network.Connection as NC import qualified Data.CaseInsensitive as CI import qualified Data.ByteString as B import qualified Data.ByteString.UTF8 as B8 import qualified Data.ByteString.Lazy as L import qualified Data.Set as S+import Control.Exception (throwIO) import Control.Monad.Trans.Resource import Network.HTTP.Conduit import Network.HTTP.Client+import Network.HTTP.Simple (getResponseHeader)+import Network.Socket+import Network.BSD (getProtocolNumber)+import Data.Either import Data.Conduit+import Text.Read import System.Log.Logger  #if ! MIN_VERSION_http_client(0,5,0)@@ -92,14 +101,17 @@ 	}  data UrlDownloader-	= DownloadWithConduit+	= DownloadWithConduit NonHttpUrlDownloader 	| DownloadWithCurl [CommandParam] +data NonHttpUrlDownloader+	= DownloadWithCurlRestricted Restriction+ defUrlOptions :: IO UrlOptions defUrlOptions = UrlOptions 	<$> pure Nothing 	<*> pure []-	<*> pure DownloadWithConduit+	<*> pure (DownloadWithConduit (DownloadWithCurlRestricted mempty)) 	<*> pure id 	<*> newManager managerSettings 	<*> pure (S.fromList $ map mkScheme ["http", "https", "ftp"])@@ -132,7 +144,7 @@ 		Just ua -> [Param "--user-agent", Param ua] 	headerparams = concatMap (\h -> [Param "-H", Param h]) (reqHeaders uo) 	addedparams = case urlDownloader uo of-		DownloadWithConduit -> []+		DownloadWithConduit _ -> [] 		DownloadWithCurl l -> l 	schemeparams = 		[ Param "--proto"@@ -197,28 +209,39 @@ getUrlInfo url uo = case parseURIRelaxed url of 	Just u -> checkPolicy uo u dne warnError $ 		case (urlDownloader uo, parseUrlRequest (show u)) of-			(DownloadWithConduit, Just req) ->-				existsconduit req+			(DownloadWithConduit (DownloadWithCurlRestricted r), Just req) -> catchJust+				-- When http redirects to a protocol which +				-- conduit does not support, it will throw+				-- a StatusCodeException with found302+				-- and a Response with the redir Location.+				(matchStatusCodeException (== found302))+				(existsconduit req)+				(followredir r) 					`catchNonAsync` (const $ return dne)-			(DownloadWithConduit, Nothing)+			(DownloadWithConduit (DownloadWithCurlRestricted r), Nothing) 				| isfileurl u -> existsfile u+				| isftpurl u -> existscurlrestricted r u url ftpport+					`catchNonAsync` (const $ return dne) 				| otherwise -> do 					unsupportedUrlScheme u warnError 					return dne 			(DownloadWithCurl _, _)  				| isfileurl u -> existsfile u-				| otherwise -> existscurl u+				| otherwise -> existscurl u (basecurlparams url) 	Nothing -> return dne   where 	dne = UrlInfo False Nothing Nothing 	found sz f = return $ UrlInfo True sz f  	isfileurl u = uriScheme u == "file:"+	isftpurl u = uriScheme u == "ftp:" -	curlparams = curlParams uo $+	ftpport = 21++	basecurlparams u = curlParams uo $ 		[ Param "-s" 		, Param "--head"-		, Param "-L", Param url+		, Param "-L", Param u 		, Param "-w", Param "%{http_code}" 		] @@ -247,7 +270,7 @@ 					(extractfilename resp) 				else return dne -	existscurl u = do+	existscurl u curlparams = do 		output <- catchDefaultIO "" $ 			readProcess "curl" $ toCommand curlparams 		let len = extractlencurl output@@ -264,6 +287,9 @@ 			_ | isftp && isJust len -> good 			_ -> return dne 	+	existscurlrestricted r u url' defport = existscurl u +		=<< curlRestrictedParams r u defport (basecurlparams url')+ 	existsfile u = do 		let f = unEscapeString (uriPath u) 		s <- catchMaybeIO $ getFileStatus f@@ -272,6 +298,23 @@ 				sz <- getFileSize' f stat 				found (Just sz) Nothing 			Nothing -> return dne+#if MIN_VERSION_http_client(0,5,0)+	followredir r (HttpExceptionRequest _ (StatusCodeException resp _)) = +		case headMaybe $ map decodeBS $ getResponseHeader hLocation resp of+#else+	followredir r (StatusCodeException _ respheaders _) =+		case headMaybe $ map (decodeBS . snd) $ filter (\(h, _) -> h == hLocation) respheaders+#endif+			Just url' -> case parseURIRelaxed url' of+				-- only follow http to ftp redirects;+				-- http to file redirect would not be secure,+				-- and http-conduit follows http to http.+				Just u' | isftpurl u' ->+					checkPolicy uo u' dne warnError $+						existscurlrestricted r u' url' ftpport+				_ -> return dne+			Nothing -> return dne+	followredir _ _ = return dne  -- Parse eg: attachment; filename="fname.ext" -- per RFC 2616@@ -310,20 +353,27 @@ 	go = case parseURIRelaxed url of 		Just u -> checkPolicy uo u False dlfailed $ 			case (urlDownloader uo, parseUrlRequest (show u)) of-				(DownloadWithConduit, Just req) ->-					downloadconduit req-				(DownloadWithConduit, Nothing)+				(DownloadWithConduit (DownloadWithCurlRestricted r), Just req) -> catchJust+					(matchStatusCodeException (== found302))+					(downloadconduit req)+					(followredir r)+				(DownloadWithConduit (DownloadWithCurlRestricted r), Nothing) 					| isfileurl u -> downloadfile u+					| isftpurl u -> downloadcurlrestricted r u url ftpport+						`catchNonAsync` (dlfailed . show) 					| otherwise -> unsupportedUrlScheme u dlfailed 				(DownloadWithCurl _, _) 					| isfileurl u -> downloadfile u-					| otherwise -> downloadcurl+					| otherwise -> downloadcurl url basecurlparams 		Nothing -> do 			liftIO $ debugM "url" url 			dlfailed "invalid url" 	 	isfileurl u = uriScheme u == "file:"+	isftpurl u = uriScheme u == "ftp:" +	ftpport = 21+ 	downloadconduit req = catchMaybeIO (getFileSize file) >>= \case 		Nothing -> runResourceT $ do 			liftIO $ debugM "url" (show req')@@ -405,27 +455,46 @@ 		sinkResponseFile meterupdate initialp file mode resp 		return True 	-	downloadcurl = do+	basecurlparams = curlParams uo+		[ if noerror+			then Param "-S"+			else Param "-sS"+		, Param "-f"+		, Param "-L"+		, Param "-C", Param "-"+		]++	downloadcurl rawurl curlparams = do 		-- curl does not create destination file 		-- if the url happens to be empty, so pre-create. 		unlessM (doesFileExist file) $ 			writeFile file ""-		let ps = curlParams uo-			[ if noerror-				then Param "-S"-				else Param "-sS"-			, Param "-f"-			, Param "-L"-			, Param "-C", Param "-"-			]-		boolSystem "curl" (ps ++ [Param "-o", File file, File url])-	+		boolSystem "curl" (curlparams ++ [Param "-o", File file, File rawurl])++	downloadcurlrestricted r u rawurl defport =+		downloadcurl rawurl =<< curlRestrictedParams r u defport basecurlparams+ 	downloadfile u = do 		let src = unEscapeString (uriPath u) 		withMeteredFile src meterupdate $ 			L.writeFile file 		return True +#if MIN_VERSION_http_client(0,5,0)+	followredir r ex@(HttpExceptionRequest _ (StatusCodeException resp _)) = +		case headMaybe $ map decodeBS $ getResponseHeader hLocation resp of+#else+	followredir r ex@(StatusCodeException _ respheaders _) =+		case headMaybe $ map (decodeBS . snd) $ filter (\(h, _) -> h == hLocation) respheaders+#endif+			Just url' -> case parseURIRelaxed url' of+				Just u' | isftpurl u' ->+					checkPolicy uo u' False dlfailed $+						downloadcurlrestricted r u' url' ftpport+				_ -> throwIO ex+			Nothing -> throwIO ex+	followredir _ ex = throwIO ex+ {- 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.  -@@ -554,3 +623,57 @@ 	| want e = Just e 	| otherwise = Nothing #endif++{- Constructs parameters that prevent curl from accessing any IP addresses+ - blocked by the Restriction. These are added to the input parameters,+ - which should tell curl what to do.+ -+ - This has to disable redirects because it looks up the IP addresses + - of the host and after limiting to those allowed by the Restriction,+ - makes curl resolve the host to those IP addresses. It doesn't make sense+ - to use this for http anyway, only for ftp or perhaps other protocols+ - supported by curl.+ -+ - Throws an exception if the Restriction blocks all addresses, or+ - if the dns lookup fails. A malformed url will also cause an exception.+ -}+curlRestrictedParams :: Restriction -> URI -> Int -> [CommandParam] -> IO [CommandParam]+curlRestrictedParams r u defport ps = case uriAuthority u of+	Nothing -> giveup "malformed url"+	Just uath -> case uriPort uath of+		"" -> go (uriRegName uath) defport+		-- strict parser because the port we provide to curl+		-- needs to match the port in the url+		(':':s) -> case readMaybe s :: Maybe Int of+			Just p -> go (uriRegName uath) p+			Nothing -> giveup "malformed url"+		_ -> giveup "malformed url"+  where+	go hostname p = do+		proto <- getProtocolNumber "tcp"+		let serv = show p+		let hints = defaultHints+			{ addrFlags = [AI_ADDRCONFIG]+			, addrProtocol = proto+			, addrSocketType = Stream+			}+		addrs <- getAddrInfo (Just hints) (Just hostname) (Just serv)+		case partitionEithers (map checkrestriction addrs) of+			((e:_es), []) -> throwIO e+			(_, as)+				| null as -> throwIO $ +					NC.HostNotResolved hostname+				| otherwise -> return $+					(limitresolve p) as ++ ps+	checkrestriction addr = maybe (Right addr) Left $+		checkAddressRestriction r addr+	limitresolve p addrs =+		[ Param "--resolve"+		, Param $ "*:" ++ show p ++ ":" ++ intercalate ":"+			(mapMaybe (bracketaddr <$$> extractIPAddress . addrAddress) addrs)+		-- Don't let a ftp server provide an IP address.+		, Param "--ftp-skip-pasv-ip"+		-- Prevent all http redirects.+		, Param "--max-redirs", Param "0"+		]+	bracketaddr a = "[" ++ a ++ "]"

@@ -56,6 +56,8 @@   Adds multiple files in parallel. This may be faster.   For example: `-J4`   +  Setting this to "cpus" will run one job per CPU core.+ * `--update` `-u`    Like `git add --update`, this does not add new files, but any updates

@@ -13,7 +13,7 @@ When `youtube-dl` is installed, it can be used to check for a video embedded in  a web page at the url, and that is added to the annex instead. (However, this is disabled by default as it can be a security risk. -See the documentation of annex.security.allowed-http-addresses+See the documentation of annex.security.allowed-ip-addresses in [[git-annex]](1) for details.)  Urls to torrent files (including magnet links) will cause the content of@@ -77,6 +77,8 @@    Enables parallel downloads when multiple urls are being added.   For example: `-J4`  ++  Setting this to "cpus" will run one job per CPU core.  * `--batch` 

@@ -34,6 +34,8 @@   Enables parallel transfers with up to the specified number of jobs   running at once. For example: `-J10` +  Setting this to "cpus" will run one job per CPU core.+ * `--auto`    Rather than copying all files, only copy files that don't yet have

@@ -77,6 +77,8 @@   when git-annex has to contact remotes to check if it can drop files.   For example: `-J4`   +  Setting this to "cpus" will run one job per CPU core.+ * `--batch`    Enables batch mode, in which lines containing names of files to drop

@@ -23,6 +23,9 @@ other treeish accepted by git, including eg master:subdir to only export a subdirectory from a branch. +When the remote has a preferred content setting, the treeish is filtered+through it, excluding files it does not want from being exported to it.+ Repeated exports are done efficiently, by diffing the old and new tree, and transferring only the changed files, and renaming files as necessary. @@ -131,6 +134,8 @@ [[git-annex-import]](1)  [[git-annex-sync]](1)++[[git-annex-preferred-content]](1)  # HISTORY 

@@ -93,6 +93,8 @@    Runs multiple fsck jobs in parallel. For example: `-J4` +  Setting this to "cpus" will run one job per CPU core.+ * `--json`    Enable JSON output. This is intended to be parsed by programs that use

@@ -33,6 +33,8 @@   Enables parallel download with up to the specified number of jobs   running at once. For example: `-J10` +  Setting this to "cpus" will run one job per CPU core.+   When files can be downloaded from multiple remotes, enabling parallel   downloads will split the load between the remotes. For example, if   the files are available on remotes A and B, then one file will be

@@ -12,7 +12,7 @@ repository. It can import files from a directory into your repository,  or it can import files from a git-annex special remote. -## IMPORTING FROM A SPECIAL REMOTE+# IMPORTING FROM A SPECIAL REMOTE  Importing from a special remote first downloads all new content from it, and then constructs a git commit that reflects files that have changed on@@ -49,10 +49,10 @@ `git annex export` files to a remote, and then `git annex import` from it, you won't need that option. -You can also limit the import to a subdirectory, using the-"branch:subdir" syntax. For example, if "camera" is a special remote-that accesses a camera, and you want to import those into the photos-directory, rather than to the root of your repository:+You can import into a subdirectory, using the "branch:subdir" syntax. For+example, if "camera" is a special remote that accesses a camera, and you+want to import those into the photos directory, rather than to the root of+your repository:  	git annex import master:photos --from camera 	git merge camera/master@@ -65,8 +65,20 @@ 	git config remote.myremote.annex-tracking-branch master 	git annex sync --content -## IMPORTING FROM A DIRECTORY+If a preferred content expression is configured for the special remote,+it will be honored when importing from it. Files that are not preferred+content of the remote will not be imported from it, but will be left on the+remote.  +However, preferred content expressions that relate to the key+can't be matched when importing, because the content of the file is not+known. Importing will fail when such a preferred content expression is+set. This includes expressions containing "copies=", "metadata=", and other+things that depend on the key. Preferred content expressions containing+"include=", "exclude=" "smallerthan=", "largerthan=" will work.++# IMPORTING FROM A DIRECTORY+ When run with a path, `git annex import` moves files from somewhere outside the git working copy, and adds them to the annex. @@ -141,6 +153,8 @@   Imports multiple files in parallel. This may be faster.   For example: `-J4`   +  Setting this to "cpus" will run one job per CPU core.+ * `--json`    Enable JSON output. This is intended to be parsed by programs that use@@ -167,6 +181,8 @@ [[git-annex-add]](1)  [[git-annex-export]](1)++[[git-annex-preferred-content]](1)  # AUTHOR 

@@ -16,7 +16,7 @@ When `youtube-dl` is installed, it can be used to download links in the feed. This allows importing e.g., YouTube playlists. (However, this is disabled by default as it can be a security risk. -See the documentation of annex.security.allowed-http-addresses+See the documentation of annex.security.allowed-ip-addresses in [[git-annex]](1) for details.)  To make the import process add metadata to the imported files from the feed,

@@ -36,6 +36,8 @@   Enables parallel transfers with up to the specified number of jobs   running at once. For example: `-J10` +  Setting this to "cpus" will run one job per CPU core.+ * `--all` `-A`    Mirror all objects stored in the git annex, not only objects used by

@@ -40,6 +40,8 @@   Enables parallel transfers with up to the specified number of jobs   running at once. For example: `-J10` +  Setting this to "cpus" will run one job per CPU core.+ * `--all` `-A`    Rather than specifying a filename or path to move, this option can be

@@ -37,12 +37,16 @@   Match files to include, or exclude.    While --include=glob and --exclude=glob match files relative to the current-  directory, preferred content expressions always match files relative to the-  top of the git repository. +  directory, preferred content expressions match files relative to the+  top of the git repository.    For example, suppose you put files into `archive` directories   when you're done with them. Then you could configure your laptop to prefer   to not retain those files, like this: `exclude=*/archive/*`++  When a subdirectory is being exported or imported to a special remote (see+  [[git-annex-export]](1)) and [[git-annex-import]](1), these match relative+  to the top of the subdirectory.  * `copies=number` 

@@ -112,6 +112,8 @@   Enables parallel syncing with up to the specified number of jobs   running at once. For example: `-J10` +  Setting this to "cpus" will run one job per CPU core.+   When there are multiple git remotes, pushes will be made to them in   parallel. Pulls are not done in parallel because that tends to be   less efficient. When --content is synced, the files are processed

@@ -952,6 +952,8 @@   Only git-annex commands that support the --jobs option will   use this. +  Setting this to "cpus" will run one job per CPU core.+ * `annex.queuesize`    git-annex builds a queue of git commands, in order to combine similar@@ -1424,7 +1426,7 @@   Or to make curl use your ~/.netrc file, set it to "--netrc".    Setting this option makes git-annex use curl, but only-  when annex.security.allowed-http-addresses is configured in a+  when annex.security.allowed-ip-addresses is configured in a   specific way. See its documentation.  * `annex.youtube-dl-options`@@ -1467,10 +1469,11 @@   Some special remotes support their own domain-specific URL   schemes; those are not affected by this configuration setting. -* `annex.security.allowed-http-addresses`+* `annex.security.allowed-ip-addresses` -  By default, git-annex only makes HTTP connections to public IP addresses;-  it will refuse to use HTTP servers on localhost or on a private network.+  By default, git-annex only makes connections to public IP addresses;+  it will refuse to use HTTP and other servers on localhost or on a+  private network.    This setting can override that behavior, allowing access to particular   IP addresses. For example "127.0.0.1 ::1" allows access to localhost@@ -1478,13 +1481,19 @@      Think very carefully before changing this; there are security   implications. Anyone who can get a commit into your git-annex repository-  could `git annex addurl` an url on a private http server, possibly+  could `git annex addurl` an url on a private server, possibly   causing it to be downloaded into your repository and transferred to   other remotes, exposing its content.    Note that, since the interfaces of curl and youtube-dl do not allow   these IP address restrictions to be enforced, curl and youtube-dl will-  never be used unless annex.security.allowed-http-addresses=all.+  never be used unless annex.security.allowed-ip-addresses=all.++* `annex.security.allowed-http-addresses`++  Old name for annex.security.allowed-ip-addresses.+  If set, this is treated the same as having+  annex.security.allowed-ip-addresses set.  * `annex.security.allow-unverified-downloads` 

@@ -1,5 +1,5 @@ Name: git-annex-Version: 7.20190507+Version: 7.20190615 Cabal-Version: >= 1.8 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -1001,6 +1001,7 @@     Types.UUID     Types.UrlContents     Types.View+    Types.WorkerPool     Upgrade     Upgrade.V0     Upgrade.V1