git-annex 6.20170301.1 → 6.20170321

raw patch · 70 files changed

+580/−332 lines, 70 filesdep ~directorydep ~dnsdep ~feed

Dependency ranges changed: directory, dns, feed, http-conduit, http-types

Files

• Annex.hs +2/−2
• Annex/Drop.hs +7/−5
• Annex/FileMatcher.hs +2/−2
• Annex/Notification.hs +8/−8
• Annex/Ssh.hs +36/−13
• Annex/Transfer.hs +14/−14
• Assistant/DeleteRemote.hs +1/−1
• Assistant/Threads/Committer.hs +4/−3
• Assistant/Threads/Cronner.hs +1/−1
• Assistant/Threads/SanityChecker.hs +2/−2
• Assistant/Threads/TransferScanner.hs +10/−4
• Assistant/TransferSlots.hs +5/−4
• Assistant/Upgrade.hs +1/−1
• Assistant/WebApp/DashBoard.hs +3/−0
• Backend/Hash.hs +2/−2
• Build/BundledPrograms.hs +10/−9
• CHANGELOG +31/−0
• COPYRIGHT +0/−4
• CmdLine/GitAnnexShell.hs +1/−1
• CmdLine/Seek.hs +3/−4
• Command/AddUrl.hs +10/−5
• Command/Copy.hs +2/−2
• Command/Drop.hs +4/−3
• Command/DropUnused.hs +2/−2
• Command/Fsck.hs +73/−55
• Command/Get.hs +4/−3
• Command/ImportFeed.hs +0/−8
• Command/Info.hs +7/−2
• Command/Map.hs +3/−3
• Command/MetaData.hs +2/−2
• Command/Migrate.hs +3/−2
• Command/Mirror.hs +6/−4
• Command/Move.hs +2/−2
• Command/SendKey.hs +1/−1
• Command/Status.hs +4/−2
• Command/Sync.hs +27/−4
• Command/TestRemote.hs +6/−5
• Command/TransferInfo.hs +2/−2
• Command/TransferKey.hs +2/−2
• Command/TransferKeys.hs +4/−4
• Command/Whereis.hs +1/−1
• Git/Ssh.hs +74/−0
• Key.hs +1/−1
• Limit/Wanted.hs +6/−4
• Logs/Transfer.hs +11/−6
• Logs/Unused.hs +0/−7
• P2P/Protocol.hs +5/−4
• Remote/Bup.hs +4/−4
• Remote/Ddar.hs +10/−15
• Remote/External.hs +8/−12
• Remote/GCrypt.hs +6/−3
• Remote/Git.hs +2/−1
• Remote/Helper/Ssh.hs +5/−11
• Remote/Rsync.hs +0/−1
• Test.hs +62/−17
• Types.hs +1/−1
• Types/ActionItem.hs +5/−7
• Types/Key.hs +2/−1
• Types/Test.hs +7/−2
• Types/Transfer.hs +3/−3
• Utility/Gpg.hs +1/−1
• Utility/Path.hs +2/−0
• Utility/SRV.hs +1/−8
• Utility/Shell.hs +1/−2
• Utility/Url.hs +0/−16
• doc/git-annex-get.mdwn +8/−1
• doc/git-annex-sync.mdwn +8/−0
• doc/git-annex.mdwn +31/−0
• git-annex.cabal +7/−6
• templates/dashboard/transfers.hamlet +1/−4

@@ -136,7 +136,7 @@ 	, existinghooks :: M.Map Git.Hook.Hook Bool 	, desktopnotify :: DesktopNotify 	, workers :: [Either AnnexState (Async AnnexState)]-	, activeremotes :: MVar (S.Set (Types.Remote.RemoteA Annex))+	, activeremotes :: MVar (M.Map (Types.Remote.RemoteA Annex) Integer) 	, keysdbhandle :: Maybe Keys.DbHandle 	, cachedcurrentbranch :: Maybe Git.Branch 	, cachedgitenv :: Maybe [(String, String)]@@ -144,7 +144,7 @@  newState :: GitConfig -> Git.Repo -> IO AnnexState newState c r = do-	emptyactiveremotes <- newMVar S.empty+	emptyactiveremotes <- newMVar M.empty 	return $ AnnexState 		{ repo = r 		, repoadjustment = return

@@ -55,8 +55,8 @@ 			map (`fromTopFilePath` g) <$> Database.Keys.getAssociatedFiles key 		) 	let fs = case afile of-		Just f -> nub (f : l)-		Nothing -> l+		AssociatedFile (Just f) -> nub (f : l)+		AssociatedFile Nothing -> l 	n <- getcopies fs 	void $ if fromhere && checkcopies n Nothing 		then go fs rs n >>= dropl fs@@ -93,9 +93,9 @@  	checkdrop fs n u a 		| null fs = check $ -- no associated files; unused content-			wantDrop True u (Just key) Nothing+			wantDrop True u (Just key) (AssociatedFile Nothing) 		| otherwise = check $-			allM (wantDrop True u (Just key) . Just) fs+			allM (wantDrop True u (Just key) . AssociatedFile . Just) fs 		where 			check c = ifM c 				( dodrop n u a@@ -107,7 +107,9 @@ 			( do 				liftIO $ debugM "drop" $ unwords 					[ "dropped"-					, fromMaybe (key2file key) afile+					, case afile of+						AssociatedFile Nothing -> key2file key+						AssociatedFile (Just af) -> af 					, "(from " ++ maybe "here" show u ++ ")" 					, "(copies now " ++ show (fromNumCopies have - 1) ++ ")" 					, ": " ++ reason

@@ -44,13 +44,13 @@ checkFileMatcher :: GetFileMatcher -> FilePath -> Annex Bool checkFileMatcher getmatcher file = do 	matcher <- getmatcher file-	checkMatcher matcher Nothing (Just file) S.empty True+	checkMatcher matcher Nothing (AssociatedFile (Just file)) S.empty True  checkMatcher :: FileMatcher Annex -> Maybe Key -> AssociatedFile -> AssumeNotPresent -> Bool -> Annex Bool checkMatcher matcher mkey afile notpresent d 	| isEmpty matcher = return d 	| otherwise = case (mkey, afile) of-		(_, Just file) -> go =<< fileMatchInfo file+		(_, AssociatedFile (Just file)) -> go =<< fileMatchInfo file 		(Just key, _) -> go (MatchingKey key) 		_ -> return d   where

@@ -28,10 +28,10 @@ {- Wrap around an action that performs a transfer, which may run multiple  - attempts. Displays notification when supported and when the user asked  - for it. -}-notifyTransfer :: Direction -> Maybe FilePath -> (NotifyWitness -> Annex Bool) -> Annex Bool-notifyTransfer _ Nothing a = a NotifyWitness+notifyTransfer :: Direction -> AssociatedFile -> (NotifyWitness -> Annex Bool) -> Annex Bool+notifyTransfer _ (AssociatedFile Nothing) a = a NotifyWitness #ifdef WITH_DBUS_NOTIFICATIONS-notifyTransfer direction (Just f) a = do+notifyTransfer direction (AssociatedFile (Just f)) a = do 	wanted <- Annex.getState Annex.desktopnotify 	if (notifyStart wanted || notifyFinish wanted) 		then do@@ -47,19 +47,19 @@ 			return ok 		else a NotifyWitness #else-notifyTransfer _ (Just _) a = a NotifyWitness+notifyTransfer _ (AssociatedFile (Just _)) a = a NotifyWitness #endif -notifyDrop :: Maybe FilePath -> Bool -> Annex ()-notifyDrop Nothing _ = noop+notifyDrop :: AssociatedFile -> Bool -> Annex ()+notifyDrop (AssociatedFile Nothing) _ = noop #ifdef WITH_DBUS_NOTIFICATIONS-notifyDrop (Just f) ok = do+notifyDrop (AssociatedFile (Just f)) ok = do 	wanted <- Annex.getState Annex.desktopnotify 	when (notifyFinish wanted) $ liftIO $ do 		client <- DBus.Client.connectSession 		void $ Notify.notify client (droppedNote ok f) #else-notifyDrop (Just _) _ = noop+notifyDrop (AssociatedFile (Just _)) _ = noop #endif  #ifdef WITH_DBUS_NOTIFICATIONS

@@ -9,6 +9,8 @@  module Annex.Ssh ( 	ConsumeStdin(..),+	SshCommand,+	sshCommand, 	sshOptions, 	sshCacheDir, 	sshReadPort,@@ -37,6 +39,7 @@ import Utility.FileSystemEncoding import Types.CleanupActions import Git.Env+import Git.Ssh #ifndef mingw32_HOST_OS import Annex.Perms import Annex.LockPool@@ -47,8 +50,21 @@  - not be allowed to consume the process's stdin. -} data ConsumeStdin = ConsumeStdin | NoConsumeStdin +{- Generates a command to ssh to a given host (or user@host) on a given+ - port. This includes connection caching parameters, and any ssh-options.+ - If GIT_SSH or GIT_SSH_COMMAND is set, they are used instead. -}+sshCommand :: ConsumeStdin -> (SshHost, Maybe SshPort) -> RemoteGitConfig -> SshCommand -> Annex (FilePath, [CommandParam])+sshCommand cs (host, port) gc remotecmd = maybe go return+	=<< liftIO (gitSsh' host port remotecmd (consumeStdinParams cs))+  where+	go = do+		ps <- sshOptions cs (host, port) gc []+		return ("ssh", Param host:ps++[Param remotecmd])+ {- Generates parameters to ssh to a given host (or user@host) on a given- - port. This includes connection caching parameters, and any ssh-options. -}+ - port. This includes connection caching parameters, and any+ - ssh-options. Note that the host to ssh to and the command to run+ - are not included in the returned options. -} sshOptions :: ConsumeStdin -> (String, Maybe Integer) -> RemoteGitConfig -> [CommandParam] -> Annex [CommandParam] sshOptions cs (host, port) gc opts = go =<< sshCachingInfo (host, port)   where@@ -61,12 +77,14 @@ 		, map Param (remoteAnnexSshOptions gc) 		, opts 		, portParams port-		, case cs of-			ConsumeStdin -> []-			NoConsumeStdin -> [Param "-n"]+		, consumeStdinParams cs 		, [Param "-T"] 		] +consumeStdinParams :: ConsumeStdin -> [CommandParam]+consumeStdinParams ConsumeStdin = []+consumeStdinParams NoConsumeStdin = [Param "-n"]+ {- Returns a filename to use for a ssh connection caching socket, and  - parameters to enable ssh connection caching. -} sshCachingInfo :: (String, Maybe Integer) -> Annex (Maybe FilePath, [CommandParam])@@ -285,19 +303,24 @@ {- To make any git commands be run with ssh caching enabled,  - and configured ssh-options alters the local Git.Repo's gitEnv  - to set GIT_SSH=git-annex, and set sshOptionsEnv when running git- - commands. -}+ - commands.+ -+ - If GIT_SSH or GIT_SSH_COMMAND are set, this has no effect. -} sshOptionsTo :: Git.Repo -> RemoteGitConfig -> Git.Repo -> Annex Git.Repo sshOptionsTo remote gc localr 	| not (Git.repoIsUrl remote) || Git.repoIsHttp remote = unchanged 	| otherwise = case Git.Url.hostuser remote of 		Nothing -> unchanged-		Just host -> do-			(msockfile, _) <- sshCachingInfo (host, Git.Url.port remote)-			case msockfile of-				Nothing -> use []-				Just sockfile -> do-					prepSocket sockfile-					use (sshConnectionCachingParams sockfile)+		Just host -> ifM (liftIO gitSshEnvSet)+			( unchanged+			, do+				(msockfile, _) <- sshCachingInfo (host, Git.Url.port remote)+				case msockfile of+					Nothing -> use []+					Just sockfile -> do+						prepSocket sockfile+						use (sshConnectionCachingParams sockfile)+			)   where 	unchanged = return localr @@ -313,7 +336,7 @@ 				liftIO $ do 					localr' <- addGitEnv localr sshOptionsEnv 						(toSshOptionsEnv sshopts)-					addGitEnv localr' "GIT_SSH" command+					addGitEnv localr' gitSshEnv command  runSshOptions :: [String] -> String -> IO () runSshOptions args s = do

@@ -32,7 +32,8 @@ import Types.Concurrency  import Control.Concurrent-import qualified Data.Set as S+import qualified Data.Map.Strict as M+import Data.Ord  class Observable a where 	observeBool :: a -> Bool@@ -76,7 +77,7 @@  - An upload can be run from a read-only filesystem, and in this case  - no transfer information or lock file is used.  -}-runTransfer :: Observable v => Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v+runTransfer :: Observable v => Transfer -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v runTransfer = runTransfer' False  {- Like runTransfer, but ignores any existing transfer lock file for the@@ -84,12 +85,12 @@  -  - Note that this may result in confusing progress meter display in the  - webapp, if multiple processes are writing to the transfer info file. -}-alwaysRunTransfer :: Observable v => Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v+alwaysRunTransfer :: Observable v => Transfer -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v alwaysRunTransfer = runTransfer' True -runTransfer' :: Observable v => Bool -> Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v-runTransfer' ignorelock t file shouldretry transferaction = checkSecureHashes t $ do-	info <- liftIO $ startTransferInfo file+runTransfer' :: Observable v => Bool -> Transfer -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v+runTransfer' ignorelock t afile shouldretry transferaction = checkSecureHashes t $ do+	info <- liftIO $ startTransferInfo afile 	(meter, tfile, metervar) <- mkProgressUpdater t info 	mode <- annexFileMode 	(lck, inprogress) <- prep tfile mode info@@ -218,7 +219,7 @@ 	go rs (Concurrent n) | n > 1 = do 		mv <- Annex.getState Annex.activeremotes 		active <- liftIO $ takeMVar mv-		let rs' = sortBy (inactiveFirst active) rs+		let rs' = sortBy (lessActiveFirst active) rs 		goconcurrent mv active rs' 	go (r:rs) _ = do 		ok <- a r@@ -229,11 +230,11 @@ 		liftIO $ putMVar mv active 		return observeFailure 	goconcurrent mv active (r:rs) = do-		let !active' = S.insert r active+		let !active' = M.insertWith (+) r 1 active 		liftIO $ putMVar mv active' 		let getnewactive = do 			active'' <- liftIO $ takeMVar mv-			let !active''' = S.delete r active''+			let !active''' = M.update (\n -> if n > 1 then Just (n-1) else Nothing) r active'' 			return active''' 		let removeactive = liftIO . putMVar mv =<< getnewactive 		ok <- a r `onException` removeactive@@ -246,11 +247,10 @@ 				-- Re-sort the remaining rs  				-- because other threads could have 				-- been assigned them in the meantime.-				let rs' = sortBy (inactiveFirst active'') rs+				let rs' = sortBy (lessActiveFirst active'') rs 				goconcurrent mv active'' rs' -inactiveFirst :: S.Set Remote -> Remote -> Remote -> Ordering-inactiveFirst active a b-	| Remote.cost a == Remote.cost b =-		if a `S.member` active then GT else LT+lessActiveFirst :: M.Map Remote Integer -> Remote -> Remote -> Ordering+lessActiveFirst active a b+	| Remote.cost a == Remote.cost b = comparing (`M.lookup` active) a b 	| otherwise = compare a b

@@ -64,7 +64,7 @@   where 	queueremaining r k =  		queueTransferWhenSmall "remaining object in unwanted remote"-			Nothing (Transfer Download uuid k) r+			(AssociatedFile Nothing) (Transfer Download uuid k) r 	{- Scanning for keys can take a long time; do not tie up 	 - the Annex monad while doing it, so other threads continue to 	 - run. -}

@@ -503,9 +503,10 @@ 		Just k -> whenM (scanComplete <$> getDaemonStatus) $ do 			present <- liftAnnex $ inAnnex k 			void $ if present-				then queueTransfers "new file created" Next k (Just f) Upload-				else queueTransfers "new or renamed file wanted" Next k (Just f) Download-			handleDrops "file renamed" present k (Just f) []+				then queueTransfers "new file created" Next k af Upload+				else queueTransfers "new or renamed file wanted" Next k af Download+			handleDrops "file renamed" present k af []   where 	f = changeFile change+	af = AssociatedFile (Just f) checkChangeContent _ = noop

@@ -190,7 +190,7 @@ 	void $ repairWhenNecessary urlrenderer u Nothing fsckresults 	mapM_ reget =<< liftAnnex (dirKeys gitAnnexBadDir)   where-	reget k = queueTransfers "fsck found bad file; redownloading" Next k Nothing Download+	reget k = queueTransfers "fsck found bad file; redownloading" Next k (AssociatedFile Nothing) Download runActivity' urlrenderer (ScheduledRemoteFsck u s d) = dispatch =<< liftAnnex (remoteFromUUID u)   where 	dispatch Nothing = debug ["skipping remote fsck of uuid without a configured remote", fromUUID u, fromSchedule s]

@@ -190,8 +190,8 @@ 	unused <- liftAnnex unusedKeys' 	void $ liftAnnex $ setUnusedKeys unused 	forM_ unused $ \k -> do-		unlessM (queueTransfers "unused" Later k Nothing Upload) $-			handleDrops "unused" True k Nothing []+		unlessM (queueTransfers "unused" Later k (AssociatedFile Nothing) Upload) $+			handleDrops "unused" True k (AssociatedFile Nothing) []  	return True   where

@@ -32,6 +32,7 @@ import CmdLine.Action  import qualified Data.Set as S+import Control.Concurrent  {- This thread waits until a remote needs to be scanned, to find transfers  - that need to be made, to keep data in sync.@@ -145,12 +146,17 @@ 			(findtransfers f unwanted) 				=<< liftAnnex (lookupFile f) 		mapM_ (enqueue f) ts++		{- Delay for a short time to avoid using too much CPU. -}+		liftIO $ threadDelay $ fromIntegral $ oneSecond `div` 200+ 		scan unwanted' fs  	enqueue f (r, t) = 		queueTransferWhenSmall "expensive scan found missing object"-			(Just f) t r+			(AssociatedFile (Just f)) t r 	findtransfers f unwanted key = do+		let af = AssociatedFile (Just f) 		{- The syncable remotes may have changed since this 		 - scan began. -} 		syncrs <- syncDataRemotes <$> getDaemonStatus@@ -158,14 +164,14 @@ 		present <- liftAnnex $ inAnnex key 		liftAnnex $ handleDropsFrom locs syncrs 			"expensive scan found too many copies of object"-			present key (Just f) [] callCommandAction+			present key af [] callCommandAction 		liftAnnex $ do 			let slocs = S.fromList locs 			let use a = return $ mapMaybe (a key slocs) syncrs 			ts <- if present-				then filterM (wantSend True (Just key) (Just f) . Remote.uuid . fst)+				then filterM (wantSend True (Just key) af . Remote.uuid . fst) 					=<< use (genTransfer Upload False)-				else ifM (wantGet True (Just key) (Just f))+				else ifM (wantGet True (Just key) af) 					( use (genTransfer Download True) , return [] ) 			let unwanted' = S.difference unwanted slocs 			return (unwanted', ts)

@@ -153,10 +153,11 @@ 	 -} 	go remote transferrer = ifM (liftIO $ performTransfer transferrer t info) 		( do-			maybe noop-				(void . addAlert . makeAlertFiller True -					. transferFileAlert direction True)-				(associatedFile info)+			case associatedFile info of+				AssociatedFile Nothing -> noop+				AssociatedFile (Just af) -> void $ +					addAlert $ makeAlertFiller True $+						transferFileAlert direction True af 			unless isdownload $ 				handleDrops 					("object uploaded to " ++ show remote)

@@ -85,7 +85,7 @@ 		hook <- asIO1 $ distributionDownloadComplete d dest cleanup 		modifyDaemonStatus_ $ \s -> s 			{ transferHook = M.insert k hook (transferHook s) }-		maybe noop (queueTransfer "upgrade" Next (Just f) t)+		maybe noop (queueTransfer "upgrade" Next (AssociatedFile (Just f)) t) 			=<< liftAnnex (remoteFromUUID webUUID) 		startTransfer t 	k = distributionKey d

@@ -43,6 +43,9 @@ 	ident = "transfers" 	isrunning info = not $ 		transferPaused info || isNothing (startedTime info)+	desc transfer info = case associatedFile info of+		AssociatedFile Nothing -> key2file $ transferKey transfer+		AssociatedFile (Just af) -> af  {- Simplifies a list of transfers, avoiding display of redundant  - equivilant transfers. -}

@@ -148,8 +148,8 @@ 		} 	{- Fast migration from hash to hashE backend. -} 	| migratable && hasExt oldvariety = case afile of-		Nothing -> Nothing-		Just file -> Just $ oldkey+		AssociatedFile Nothing -> Nothing+		AssociatedFile (Just file) -> Just $ oldkey 			{ keyName = keyHash oldkey ++ selectExtension file 			, keyVariety = newvariety 			}

@@ -32,6 +32,16 @@ #else 	[ #endif+#ifndef darwin_HOST_OS+#ifndef mingw32_HOST_OS+	-- OS X has ssh installed by default.+	-- On Windows, git provides ssh.+	-- Linux probably has ssh installed system wide,+	-- and if so the user probably wants to use that one.+	, Just "ssh"+	, Just "ssh-keygen"+#endif+#endif 	]  {- Programs that should be preferred for use from the bundle, over@@ -57,15 +67,6 @@ 	, Just "xargs" #endif 	, Just "rsync"-#ifndef darwin_HOST_OS-#ifndef mingw32_HOST_OS-	-- OS X has ssh installed by default.-	-- Linux probably has ssh, but not guaranteed.-	-- On Windows, git provides ssh.-	, Just "ssh"-	, Just "ssh-keygen"-#endif-#endif #ifndef mingw32_HOST_OS 	, Just "sh" #endif

@@ -1,3 +1,34 @@+git-annex (6.20170321) unstable; urgency=medium++  * Bugfix: Passing a command a filename that does not exist sometimes+    did not display an error, when a path to a directory was also passed.+  * status: Propigate nonzero exit code from git status.+  * Linux standalone builds put the bundled ssh last in PATH,+    so any system ssh will be preferred over it.+  * assistant: Add 1/200th second delay between checking each file+    in the full transfer scan, to avoid using too much CPU.+  * get -J: Improve distribution of jobs amoung remotes when there are more+    jobs than remotes.+  * fsck -q: When a file has bad content, include the name of the file+    in the warning message.+  * Windows: Improve handling of shebang in external special remote+    program, searching for the program in the PATH.+  * Drop support for building with old versions of dns, http-conduit,+    directory, feed, and http-types.+  * Windows: Fix bug in shell script shebang lookup code that+    caused a "delayed read on closed handle" error.+  * git-annex-shell: Fix bug when used with a recently cloned repository,+    where "merging" messages were included in the output of configlist+    (and perhaps other commands) and caused a "Failed to get annex.uuid+    configuration" error.+  * Support GIT_SSH and GIT_SSH_COMMAND, which are handled close the same+    as they are by git. However, unlike git, git-annex sometimes needs to+    pass the -n parameter when using these.+  * sync --content-of=path (-C path) added for when you want to sync+    only some files' contents, not the whole working tree.++ -- Joey Hess <id@joeyh.name>  Tue, 21 Mar 2017 11:27:38 -0400+ git-annex (6.20170301.1) unstable; urgency=medium    * Fix reversion in yesterday's release that made SHA1E and MD5E backends

@@ -24,10 +24,6 @@ Copyright: 2012-2017 Joey Hess <id@joeyh.name> License: BSD-2-clause -Files: Utility/Gpg.hs Utility/DirWatcher*-Copyright: © 2010-2014 Joey Hess <id@joeyh.name>-License: GPL-3+- Files: doc/logo* */favicon.ico standalone/osx/git-annex.app/Contents/Resources/git-annex.icns standalone/android/icons/* Copyright: 2007 Henrik Nyh <http://henrik.nyh.se/>            2010 Joey Hess <id@joeyh.name>

@@ -48,7 +48,7 @@ 	]  cmds :: [Command]-cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly+cmds = map (adddirparam . noMessages) (cmds_readonly ++ cmds_notreadonly)   where 	adddirparam c = c { cmdparamdesc = "DIRECTORY " ++ cmdparamdesc c } 

@@ -243,13 +243,12 @@  seekHelper :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> [FilePath] -> Annex [FilePath] seekHelper a params = do-	ll <- inRepo $ \g -> concat <$> forM (segmentXargsOrdered params)-		(runSegmentPaths (\fs -> Git.Command.leaveZombie <$> a fs g))-	forM_ (map fst $ filter (null . snd) $ zip params ll) $ \p ->+	forM_ params $ \p -> 		unlessM (isJust <$> liftIO (catchMaybeIO $ getSymbolicLinkStatus p)) $ do 			toplevelWarning False (p ++ " not found") 			Annex.incError-	return $ concat ll+	inRepo $ \g -> concat . concat <$> forM (segmentXargsOrdered params)+		(runSegmentPaths (\fs -> Git.Command.leaveZombie <$> a fs g))  notSymlink :: FilePath -> IO Bool notSymlink f = liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f

@@ -171,7 +171,9 @@ 			-- so that the remote knows what url it 			-- should use to download it. 			setTempUrl urlkey loguri-			let downloader = \dest p -> fst <$> Remote.retrieveKeyFile r urlkey (Just file) dest p+			let downloader = \dest p -> fst +				<$> Remote.retrieveKeyFile r urlkey+					(AssociatedFile (Just file)) dest p 			ret <- downloadWith downloader urlkey (Remote.uuid r) loguri file 			removeTempUrl urlkey 			return ret@@ -255,8 +257,8 @@ 			checkDiskSpaceToGet sizedkey Nothing $ do 				tmp <- fromRepo $ gitAnnexTmpObjectLocation key 				showOutput-				ok <- Transfer.notifyTransfer Transfer.Download (Just file) $-					Transfer.download webUUID key (Just file) Transfer.forwardRetry $ \p -> do+				ok <- Transfer.notifyTransfer Transfer.Download afile $+					Transfer.download webUUID key afile Transfer.forwardRetry $ \p -> do 						liftIO $ createDirectoryIfMissing True (parentDir tmp) 						downloadUrl key p [videourl] tmp 				if ok@@ -265,6 +267,8 @@ 						return (Just key) 					else return Nothing 		)+  where+	afile = AssociatedFile (Just file)  addUrlChecked :: Bool -> URLString -> UUID -> (Key -> Annex (Bool, Bool)) -> Key -> CommandPerform addUrlChecked relaxed url u checkexistssize key@@ -328,10 +332,11 @@ 			, return Nothing 			)   where-	runtransfer tmp =  Transfer.notifyTransfer Transfer.Download (Just file) $-		Transfer.download u dummykey (Just file) Transfer.forwardRetry $ \p -> do+	runtransfer tmp =  Transfer.notifyTransfer Transfer.Download afile $+		Transfer.download u dummykey afile Transfer.forwardRetry $ \p -> do 			liftIO $ createDirectoryIfMissing True (parentDir tmp) 			downloader tmp p+	afile = AssociatedFile (Just file)  {- Adds the url size to the Key. -} addSizeUrlKey :: Url.UrlInfo -> Key -> Key

@@ -53,6 +53,6 @@ 		| otherwise = return True 	want = case Command.Move.fromToOptions (moveOptions o) of 		ToRemote dest -> (Remote.uuid <$> getParsed dest) >>=-			wantSend False (Just key) (Just file)+			wantSend False (Just key) (AssociatedFile (Just file)) 		FromRemote _ ->-			wantGet False (Just key) (Just file)+			wantGet False (Just key) (AssociatedFile (Just file))

@@ -65,7 +65,7 @@ start :: DropOptions -> FilePath -> Key -> CommandStart start o file key = start' o key afile (mkActionItem afile)   where-	afile = Just file+	afile = AssociatedFile (Just file)  start' :: DropOptions -> Key -> AssociatedFile -> ActionItem -> CommandStart start' o key afile ai = do@@ -85,7 +85,7 @@ 			| otherwise = return True  startKeys :: DropOptions -> Key -> ActionItem -> CommandStart-startKeys o key = start' o key Nothing+startKeys o key = start' o key (AssociatedFile Nothing)  startLocal :: AssociatedFile -> ActionItem -> NumCopies -> Key -> [VerifiedCopy] -> CommandStart startLocal afile ai numcopies key preverified = stopUnless (inAnnex key) $ do@@ -202,7 +202,8 @@ {- In auto mode, only runs the action if there are enough  - copies on other semitrusted repositories. -} checkDropAuto :: Bool -> Maybe Remote -> AssociatedFile -> Key -> (NumCopies -> CommandStart) -> CommandStart-checkDropAuto automode mremote afile key a = go =<< maybe getNumCopies getFileNumCopies afile+checkDropAuto automode mremote (AssociatedFile afile) key a =+	go =<< maybe getNumCopies getFileNumCopies afile   where 	go numcopies 		| automode = do

@@ -46,9 +46,9 @@ perform from numcopies key = case from of 	Just r -> do 		showAction $ "from " ++ Remote.name r-		Command.Drop.performRemote key Nothing numcopies r+		Command.Drop.performRemote key (AssociatedFile Nothing) numcopies r 	Nothing -> ifM (inAnnex key)-		( Command.Drop.performLocal key Nothing numcopies []+		( Command.Drop.performLocal key (AssociatedFile Nothing) numcopies [] 		, next (return True) 		) 

@@ -36,6 +36,7 @@ import qualified Database.Fsck as FsckDb import Types.CleanupActions import Types.Key+import Types.ActionItem  import Data.Time.Clock.POSIX import System.Posix.Types (EpochTime)@@ -110,9 +111,10 @@ 			numcopies <- getFileNumCopies file 			case from of 				Nothing -> go $ perform key file backend numcopies-				Just r -> go $ performRemote key (Just file) backend numcopies r+				Just r -> go $ performRemote key afile backend numcopies r   where-	go = runFsck inc (mkActionItem (Just file)) key+	go = runFsck inc (mkActionItem afile) key+	afile = AssociatedFile (Just file)  perform :: Key -> FilePath -> Backend -> NumCopies -> Annex Bool perform key file backend numcopies = do@@ -120,13 +122,16 @@ 	check 		-- order matters 		[ fixLink key file-		, verifyLocationLog key keystatus file+		, verifyLocationLog key keystatus ai 		, verifyAssociatedFiles key keystatus file 		, verifyWorkTree key file-		, checkKeySize key keystatus-		, checkBackend backend key keystatus (Just file)-		, checkKeyNumCopies key (Just file) numcopies+		, checkKeySize key keystatus ai+		, checkBackend backend key keystatus afile+		, checkKeyNumCopies key afile numcopies 		]+  where+	afile = AssociatedFile (Just file)+	ai = ActionItemAssociatedFile afile  {- To fsck a remote, the content is retrieved to a tmp file,  - and checked locally. -}@@ -148,11 +153,12 @@ 				return False 	dispatch (Right False) = go False Nothing 	go present localcopy = check-		[ verifyLocationLogRemote key (maybe (key2file key) id afile) remote present-		, checkKeySizeRemote key remote localcopy-		, checkBackendRemote backend key remote localcopy+		[ verifyLocationLogRemote key ai remote present+		, withLocalCopy localcopy $ checkKeySizeRemote key remote ai+		, withLocalCopy localcopy $ checkBackendRemote backend key remote ai 		, checkKeyNumCopies key afile numcopies 		]+	ai = ActionItemAssociatedFile afile 	withtmp a = do 		pid <- liftIO getPID 		t <- fromRepo gitAnnexTmpObjectDir@@ -167,7 +173,7 @@ 			, ifM (Annex.getState Annex.fast) 				( return Nothing 				, Just . fst <$>-					Remote.retrieveKeyFile remote key Nothing tmp dummymeter+					Remote.retrieveKeyFile remote key (AssociatedFile Nothing) tmp dummymeter 				) 			) 		, return (Just False)@@ -181,16 +187,16 @@ 		Just backend -> runFsck inc ai key $ 			case from of 				Nothing -> performKey key backend numcopies-				Just r -> performRemote key Nothing backend numcopies r+				Just r -> performRemote key (AssociatedFile Nothing) backend numcopies r  performKey :: Key -> Backend -> NumCopies -> Annex Bool performKey key backend numcopies = do 	keystatus <- getKeyStatus key 	check-		[ verifyLocationLog key keystatus (key2file key)-		, checkKeySize key keystatus-		, checkBackend backend key keystatus Nothing-		, checkKeyNumCopies key Nothing numcopies+		[ verifyLocationLog key keystatus (mkActionItem key)+		, checkKeySize key keystatus (mkActionItem key)+		, checkBackend backend key keystatus (AssociatedFile Nothing)+		, checkKeyNumCopies key (AssociatedFile Nothing) numcopies 		]  check :: [Annex Bool] -> Annex Bool@@ -215,8 +221,8 @@  {- Checks that the location log reflects the current status of the key,  - in this repository only. -}-verifyLocationLog :: Key -> KeyStatus -> String -> Annex Bool-verifyLocationLog key keystatus desc = do+verifyLocationLog :: Key -> KeyStatus -> ActionItem -> Annex Bool+verifyLocationLog key keystatus ai = do 	direct <- isDirect 	obj <- calcRepo $ gitAnnexLocation key 	present <- if not direct && isKeyUnlocked keystatus@@ -247,15 +253,15 @@ 	 - but that is expected and not something to do anything about. -} 	if direct && not present 		then return True-		else verifyLocationLog' key desc present u (logChange key u)+		else verifyLocationLog' key ai present u (logChange key u) -verifyLocationLogRemote :: Key -> String -> Remote -> Bool -> Annex Bool-verifyLocationLogRemote key desc remote present =-	verifyLocationLog' key desc present (Remote.uuid remote)+verifyLocationLogRemote :: Key -> ActionItem -> Remote -> Bool -> Annex Bool+verifyLocationLogRemote key ai remote present =+	verifyLocationLog' key ai present (Remote.uuid remote) 		(Remote.logStatus remote key) -verifyLocationLog' :: Key -> String -> Bool -> UUID -> (LogStatus -> Annex ()) -> Annex Bool-verifyLocationLog' key desc present u updatestatus = do+verifyLocationLog' :: Key -> ActionItem -> Bool -> UUID -> (LogStatus -> Annex ()) -> Annex Bool+verifyLocationLog' key ai present u updatestatus = do 	uuids <- loggedLocations key 	case (present, u `elem` uuids) of 		(True, False) -> do@@ -265,8 +271,9 @@ 		(False, True) -> do 			fix InfoMissing 			warning $-				"** Based on the location log, " ++ desc-				++ "\n** was expected to be present, " +++				"** Based on the location log, " +++				actionItemDesc ai key +++				"\n** was expected to be present, " ++ 				"but its content is missing." 			return False 		(False, False) -> do@@ -338,22 +345,25 @@  -  - Not checked when a file is unlocked, or in direct mode.  -}-checkKeySize :: Key -> KeyStatus -> Annex Bool-checkKeySize _ KeyUnlocked = return True-checkKeySize key _ = do+checkKeySize :: Key -> KeyStatus -> ActionItem -> Annex Bool+checkKeySize _ KeyUnlocked _ = return True+checkKeySize key _ ai = do 	file <- calcRepo $ gitAnnexLocation key 	ifM (liftIO $ doesFileExist file)-		( checkKeySizeOr badContent key file+		( checkKeySizeOr badContent key file ai 		, return True 		) -checkKeySizeRemote :: Key -> Remote -> Maybe FilePath -> Annex Bool-checkKeySizeRemote _ _ Nothing = return True-checkKeySizeRemote key remote (Just file) =-	checkKeySizeOr (badContentRemote remote file) key file+withLocalCopy :: Maybe FilePath -> (FilePath -> Annex Bool) -> Annex Bool+withLocalCopy Nothing _ = return True+withLocalCopy (Just localcopy) f = f localcopy -checkKeySizeOr :: (Key -> Annex String) -> Key -> FilePath -> Annex Bool-checkKeySizeOr bad key file = case keySize key of+checkKeySizeRemote :: Key -> Remote -> ActionItem -> FilePath -> Annex Bool+checkKeySizeRemote key remote ai localcopy =+	checkKeySizeOr (badContentRemote remote localcopy) key localcopy ai++checkKeySizeOr :: (Key -> Annex String) -> Key -> FilePath -> ActionItem -> Annex Bool+checkKeySizeOr bad key file ai = case keySize key of 	Nothing -> return True 	Just size -> do 		size' <- liftIO $ getFileSize file@@ -366,7 +376,8 @@ 	badsize a b = do 		msg <- bad key 		warning $ concat-			[ "Bad file size ("+			[ actionItemDesc ai key+			, ": Bad file size (" 			, compareSizes storageUnits True a b 			, "); " 			, msg@@ -383,37 +394,38 @@  - because modification of direct mode files is allowed. It's still done  - if the file does not appear modified, to catch disk corruption, etc.  -}-checkBackend :: Backend -> Key -> KeyStatus -> Maybe FilePath -> Annex Bool-checkBackend backend key keystatus mfile = go =<< isDirect+checkBackend :: Backend -> Key -> KeyStatus -> AssociatedFile -> Annex Bool+checkBackend backend key keystatus afile = go =<< isDirect   where 	go False = do 		content <- calcRepo $ gitAnnexLocation key 		ifM (pure (isKeyUnlocked keystatus) <&&> (not <$> isUnmodified key content)) 			( nocheck-			, checkBackendOr badContent backend key content+			, checkBackendOr badContent backend key content (mkActionItem afile) 			)-	go True = maybe nocheck checkdirect mfile+	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+		( checkBackendOr' (badContentDirect file) backend key file (mkActionItem afile) 			(Direct.goodContent key file) 		, nocheck 		) 	nocheck = return True -checkBackendRemote :: Backend -> Key -> Remote -> Maybe FilePath -> Annex Bool-checkBackendRemote backend key remote = maybe (return True) go-  where-	go file = checkBackendOr (badContentRemote remote file) backend key file+checkBackendRemote :: Backend -> Key -> Remote -> ActionItem -> FilePath -> Annex Bool+checkBackendRemote backend key remote ai localcopy =+	checkBackendOr (badContentRemote remote localcopy) backend key localcopy ai -checkBackendOr :: (Key -> Annex String) -> Backend -> Key -> FilePath -> Annex Bool-checkBackendOr bad backend key file =-	checkBackendOr' bad backend key file (return True)+checkBackendOr :: (Key -> Annex String) -> Backend -> Key -> FilePath -> ActionItem -> Annex Bool+checkBackendOr bad backend key file ai =+	checkBackendOr' bad backend key file ai (return True)  -- The postcheck action is run after the content is verified, -- in order to detect situations where the file is changed while being -- verified (particularly in direct mode).-checkBackendOr' :: (Key -> Annex String) -> Backend -> Key -> FilePath -> Annex Bool -> Annex Bool-checkBackendOr' bad backend key file postcheck =+checkBackendOr' :: (Key -> Annex String) -> Backend -> Key -> FilePath -> ActionItem -> Annex Bool -> Annex Bool+checkBackendOr' bad backend key file ai postcheck = 	case Types.Backend.verifyKeyContent backend of 		Nothing -> return True 		Just verifier -> do@@ -422,28 +434,34 @@ 				( do 					unless ok $ do 						msg <- bad key-						warning $ "Bad file content; " ++ msg+						warning $ concat+							[ actionItemDesc ai key+							, ": Bad file content; "+							, msg+							] 					return ok 				, return True 				)  checkKeyNumCopies :: Key -> AssociatedFile -> NumCopies -> Annex Bool checkKeyNumCopies key afile numcopies = do-	let file = fromMaybe (key2file key) afile+	let (desc, hasafile) = case afile of+		AssociatedFile Nothing -> (key2file key, False)+		AssociatedFile (Just af) -> (af, True) 	locs <- loggedLocations key 	(untrustedlocations, otherlocations) <- trustPartition UnTrusted locs 	(deadlocations, safelocations) <- trustPartition DeadTrusted otherlocations 	let present = NumCopies (length safelocations) 	if present < numcopies-		then ifM (pure (isNothing afile) <&&> checkDead key)+		then ifM (pure (not hasafile) <&&> checkDead key) 			( do 				showLongNote $ "This key is dead, skipping." 				return True 			, do 				untrusted <- Remote.prettyPrintUUIDs "untrusted" untrustedlocations 				dead <- Remote.prettyPrintUUIDs "dead" deadlocations-				warning $ missingNote file present numcopies untrusted dead-				when (fromNumCopies present == 0 && isNothing afile) $+				warning $ missingNote desc present numcopies untrusted dead+				when (fromNumCopies present == 0 && not hasafile) $ 					showLongNote "(Avoid this check by running: git annex dead --key )" 				return False 			)

@@ -51,14 +51,15 @@ start :: GetOptions -> Maybe Remote -> FilePath -> Key -> CommandStart start o from file key = start' expensivecheck from key afile (mkActionItem afile)   where-	afile = Just file+	afile = AssociatedFile (Just file) 	expensivecheck-		| autoMode o = numCopiesCheck file key (<) <||> wantGet False (Just key) (Just file)+		| autoMode o = numCopiesCheck file key (<)+			<||> wantGet False (Just key) afile 		| otherwise = return True  startKeys :: Maybe Remote -> Key -> ActionItem -> CommandStart startKeys from key ai = checkFailedTransferDirection ai Download $-	start' (return True) from key Nothing ai+	start' (return True) from key (AssociatedFile Nothing) ai  start' :: Annex Bool -> Maybe Remote -> Key -> AssociatedFile -> ActionItem -> CommandStart start' expensivecheck from key afile ai = stopUnless (not <$> inAnnex key) $

@@ -272,24 +272,16 @@ 		, extractField "itempubdate" [pubdate $ item i] 		]   where-#if MIN_VERSION_feed(0,3,9) 	pubdate itm = case getItemPublishDate itm :: Maybe (Maybe UTCTime) of 		Just (Just d) -> Just $ 			formatTime defaultTimeLocale "%F" d 		-- if date cannot be parsed, use the raw string 		_ -> replace "/" "-" <$> getItemPublishDateString itm-#else-	pubdate _ = Nothing-#endif  extractMetaData :: ToDownload -> MetaData-#if MIN_VERSION_feed(0,3,9) extractMetaData i = case getItemPublishDate (item i) :: Maybe (Maybe UTCTime) of 	Just (Just d) -> unionMetaData meta (dateMetaData d meta) 	_ -> meta-#else-extractMetaData i = meta-#endif   where 	tometa (k, v) = (mkMetaFieldUnchecked k, S.singleton (toMetaValue v)) 	meta = MetaData $ M.fromList $ map tometa $ extractFields i

@@ -39,6 +39,7 @@ import Types.Key import Types.TrustLevel import Types.FileMatcher+import Types.ActionItem import qualified Limit import Messages.JSON (DualDisp(..), ObjectMap(..)) import Annex.BloomFilter@@ -420,7 +421,9 @@ 	desc = "transfers in progress" 	line uuidmap t i = unwords 		[ formatDirection (transferDirection t) ++ "ing"-		, fromMaybe (key2file $ transferKey t) (associatedFile i)+		, actionItemDesc+			(ActionItemAssociatedFile (associatedFile i))+			(transferKey t) 		, if transferDirection t == Upload then "to" else "from" 		, maybe (fromUUID $ transferUUID t) Remote.name $ 			M.lookup (transferUUID t) uuidmap@@ -428,9 +431,11 @@ 	jsonify t i = object $ map (\(k, v) -> (T.pack k, v)) $ 		[ ("transfer", toJSON (formatDirection (transferDirection t))) 		, ("key", toJSON (key2file (transferKey t)))-		, ("file", toJSON (associatedFile i))+		, ("file", toJSON afile) 		, ("remote", toJSON (fromUUID (transferUUID t))) 		]+	  where+		AssociatedFile afile = associatedFile i  disk_size :: Stat disk_size = simpleStat "available local disk space" $

@@ -224,10 +224,10 @@ 		(pipedconfig, return Nothing) "configlist" [] [] 	manualconfiglist = do 		gc <- Annex.getRemoteGitConfig r-		sshparams <- Ssh.toRepo NoConsumeStdin r gc [Param sshcmd]-		liftIO $ pipedconfig "ssh" sshparams+		(sshcmd, sshparams) <- Ssh.toRepo NoConsumeStdin r gc remotecmd+		liftIO $ pipedconfig sshcmd sshparams 	  where-		sshcmd = "sh -c " ++ shellEscape+		remotecmd = "sh -c " ++ shellEscape 			(cddir ++ " && " ++ "git config --null --list") 		dir = Git.repoPath r 		cddir

@@ -86,7 +86,7 @@ start :: POSIXTime -> MetaDataOptions -> FilePath -> Key -> CommandStart start now o file k = startKeys now o k (mkActionItem afile)   where-	afile = Just file+	afile = AssociatedFile (Just file)  startKeys :: POSIXTime -> MetaDataOptions -> Key -> ActionItem -> CommandStart startKeys now o k ai = case getSet o of@@ -155,7 +155,7 @@ 	Left f -> do 		mk <- lookupFile f 		case mk of-			Just k -> go k (mkActionItem (Just f))+			Just k -> go k (mkActionItem (AssociatedFile (Just f))) 			Nothing -> giveup $ "not an annexed file: " ++ f 	Right k -> go k (mkActionItem k)   where

@@ -73,7 +73,7 @@ 	go (Just (newkey, knowngoodcontent)) 		| knowngoodcontent = finish newkey 		| otherwise = stopUnless checkcontent $ finish newkey-	checkcontent = Command.Fsck.checkBackend oldbackend oldkey Command.Fsck.KeyLocked $ Just file+	checkcontent = Command.Fsck.checkBackend oldbackend oldkey Command.Fsck.KeyLocked afile 	finish newkey = ifM (Command.ReKey.linkKey file oldkey newkey) 		( do 			copyMetaData oldkey newkey@@ -86,7 +86,7 @@ 			next $ Command.ReKey.cleanup file oldkey newkey 		, error "failed" 		)-	genkey = case maybe Nothing (\fm -> fm oldkey newbackend (Just file)) (fastMigrate oldbackend) of+	genkey = case maybe Nothing (\fm -> fm oldkey newbackend afile) (fastMigrate oldbackend) of 		Just newkey -> return $ Just (newkey, True) 		Nothing -> do 			content <- calcRepo $ gitAnnexLocation oldkey@@ -99,3 +99,4 @@ 			return $ case v of 				Just (newkey, _) -> Just (newkey, False) 				_ -> Nothing+	afile = AssociatedFile (Just file)

@@ -43,16 +43,16 @@ seek :: MirrorOptions -> CommandSeek seek o = allowConcurrentOutput $  	withKeyOptions (keyOptions o) False-		(startKey o Nothing)+		(startKey o (AssociatedFile Nothing)) 		(withFilesInGit $ whenAnnexed $ start o) 		(mirrorFiles o)  start :: MirrorOptions -> FilePath -> Key -> CommandStart start o file k = startKey o afile k (mkActionItem afile)   where-	afile = Just file+	afile = AssociatedFile (Just file) -startKey :: MirrorOptions -> Maybe FilePath -> Key -> ActionItem -> CommandStart+startKey :: MirrorOptions -> AssociatedFile -> Key -> ActionItem -> CommandStart startKey o afile key ai = case fromToOptions o of 	ToRemote r -> checkFailedTransferDirection ai Upload $ ifM (inAnnex key) 		( Command.Move.toStart False afile key ai =<< getParsed r@@ -72,4 +72,6 @@ 				, stop 				)   where-	getnumcopies = maybe getNumCopies getFileNumCopies afile+	getnumcopies = case afile of+		AssociatedFile Nothing -> getNumCopies+		AssociatedFile (Just af) -> getFileNumCopies af

@@ -53,10 +53,10 @@ start :: MoveOptions -> Bool -> FilePath -> Key -> CommandStart start o move f k = start' o move afile k (mkActionItem afile)   where-	afile = Just f+	afile = AssociatedFile (Just f)  startKey :: MoveOptions -> Bool -> Key -> ActionItem -> CommandStart-startKey o move = start' o move Nothing+startKey o move = start' o move (AssociatedFile Nothing)  start' :: MoveOptions -> Bool -> AssociatedFile -> Key -> ActionItem -> CommandStart start' o move afile key ai = 

@@ -46,7 +46,7 @@ fieldTransfer :: Direction -> Key -> (MeterUpdate -> Annex Bool) -> CommandStart fieldTransfer direction key a = do 	liftIO $ debugM "fieldTransfer" "transfer start"-	afile <- Fields.getField Fields.associatedFile+	afile <- AssociatedFile <$> Fields.getField Fields.associatedFile 	ok <- maybe (a $ const noop) 		-- Using noRetry here because we're the sender. 		(\u -> runner (Transfer direction (toUUID u) key) afile noRetry a)

@@ -47,8 +47,10 @@ 		, return $ \s -> pure (Just s) 		) 	forM_ l $ \s -> maybe noop displayStatus =<< getstatus s-	void $ liftIO cleanup-	stop+	ifM (liftIO cleanup)+		( stop+		, giveup "git status failed"+		)   where 	ps = case ignoreSubmodules o of 		Nothing -> []

@@ -63,7 +63,7 @@ cmd = withGlobalOptions [jobsOption] $ 	command "sync" SectionCommon  		"synchronize local repository with remotes"-		(paramRepeating paramRemote) (seek <$$> optParser)+		(paramRepeating paramRemote) (seek <--< optParser)  data SyncOptions  = SyncOptions 	{ syncWith :: CmdParams@@ -74,6 +74,7 @@ 	, pushOption :: Bool 	, contentOption :: Bool 	, noContentOption :: Bool+	, contentOfOption :: [FilePath] 	, keyOptions :: Maybe KeyOptions 	} @@ -109,8 +110,29 @@ 		( long "no-content" 		<> help "do not transfer file contents" 		)+	<*> many (strOption+		( long "content-of"+		<> short 'C'+		<> help "transfer file contents of files in a given location"+		<> metavar paramPath+		)) 	<*> optional parseAllOption +-- Since prepMerge changes the working directory, FilePath options+-- have to be adjusted.+instance DeferredParseClass SyncOptions where+	finishParse v = SyncOptions+		<$> pure (syncWith v)+		<*> pure (commitOption v)+		<*> pure (noCommitOption v)+		<*> pure (messageOption v)+		<*> pure (pullOption v)+		<*> pure (pushOption v)+		<*> pure (contentOption v)+		<*> pure (noContentOption v)+		<*> liftIO (mapM absPath (contentOfOption v))+		<*> pure (keyOptions v)+ seek :: SyncOptions -> CommandSeek seek o = allowConcurrentOutput $ do 	prepMerge@@ -148,6 +170,7 @@ 	mapM_ (commandAction . withbranch . pushRemote o) gitremotes   where 	shouldsynccontent = pure (contentOption o)+		<||> pure (not (null (contentOfOption o))) 		<||> (pure (not (noContentOption o)) <&&> getGitConfigVal annexSyncContent)  type CurrBranch = (Maybe Git.Branch, Maybe Adjustment)@@ -510,7 +533,7 @@ 	mvar <- liftIO newEmptyMVar 	bloom <- case keyOptions o of 		Just WantAllKeys -> Just <$> genBloomFilter (seekworktree mvar [])-		_ -> seekworktree mvar [] (const noop) >> pure Nothing+		_ -> seekworktree mvar (contentOfOption o) (const noop) >> pure Nothing 	withKeyOptions' (keyOptions o) False 		(return (seekkeys mvar bloom)) 		(const noop)@@ -519,8 +542,8 @@ 	liftIO $ not <$> isEmptyMVar mvar   where 	seekworktree mvar l bloomfeeder = seekHelper LsFiles.inRepo l >>=-		mapM_ (\f -> ifAnnexed f (go (Right bloomfeeder) mvar (Just f)) noop)-	seekkeys mvar bloom k _ = go (Left bloom) mvar Nothing k+		mapM_ (\f -> ifAnnexed f (go (Right bloomfeeder) mvar (AssociatedFile (Just f))) noop)+	seekkeys mvar bloom k _ = go (Left bloom) mvar (AssociatedFile Nothing) k 	go ebloom mvar af k = commandAction $ do 		whenM (syncFile ebloom rs af k) $ 			void $ liftIO $ tryPutMVar mvar ()

@@ -155,8 +155,9 @@ 			Nothing -> return True 			Just verifier -> verifier k (key2file k) 	get = getViaTmp (RemoteVerify r) k $ \dest ->-		Remote.retrieveKeyFile r k Nothing dest nullMeterUpdate-	store = Remote.storeKey r k Nothing nullMeterUpdate+		Remote.retrieveKeyFile r k (AssociatedFile Nothing)+			dest nullMeterUpdate+	store = Remote.storeKey r k (AssociatedFile Nothing) nullMeterUpdate 	remove = Remote.removeKey r k  testUnavailable :: Annex.AnnexState -> Remote -> Key -> [TestTree]@@ -164,15 +165,15 @@ 	[ check (== Right False) "removeKey" $ 		Remote.removeKey r k 	, check (== Right False) "storeKey" $-		Remote.storeKey r k Nothing nullMeterUpdate+		Remote.storeKey r k (AssociatedFile Nothing) nullMeterUpdate 	, check (`notElem` [Right True, Right False]) "checkPresent" $ 		Remote.checkPresent r k 	, check (== Right False) "retrieveKeyFile" $ 		getViaTmp (RemoteVerify r) k $ \dest ->-			Remote.retrieveKeyFile r k Nothing dest nullMeterUpdate+			Remote.retrieveKeyFile r k (AssociatedFile Nothing) dest nullMeterUpdate 	, check (== Right False) "retrieveKeyFileCheap" $ 		getViaTmp (RemoteVerify r) k $ \dest -> unVerified $-			Remote.retrieveKeyFileCheap r k Nothing dest+			Remote.retrieveKeyFileCheap r k (AssociatedFile Nothing) dest 	]   where 	check checkval desc a = testCase desc $ do

@@ -41,7 +41,7 @@ 	case file2key k of 		Nothing -> error "bad key" 		(Just key) -> whenM (inAnnex key) $ do-			file <- Fields.getField Fields.associatedFile+			afile <- AssociatedFile <$> Fields.getField Fields.associatedFile 			u <- maybe (error "missing remoteuuid") toUUID 				<$> Fields.getField Fields.remoteUUID 			let t = Transfer@@ -49,7 +49,7 @@ 				, transferUUID = u 				, transferKey = key 				}-			tinfo <- liftIO $ startTransferInfo file+			tinfo <- liftIO $ startTransferInfo afile 			(update, tfile, _) <- mkProgressUpdater t tinfo 			liftIO $ mapM_ void 				[ tryIO $ forever $ do

@@ -30,10 +30,10 @@ optParser desc  = TransferKeyOptions 	<$> cmdParams desc 	<*> parseFromToOptions-	<*> optional (strOption+	<*> (AssociatedFile <$> optional (strOption 		( long "file" <> metavar paramFile 		<> help "the associated file"-		))+		)))  instance DeferredParseClass TransferKeyOptions where 	finishParse v = TransferKeyOptions

@@ -116,10 +116,10 @@ 	deserialize _ = Nothing  instance TCSerialized AssociatedFile where-	serialize (Just f) = f-	serialize Nothing = ""-	deserialize "" = Just Nothing-	deserialize f = Just $ Just f+	serialize (AssociatedFile (Just f)) = f+	serialize (AssociatedFile Nothing) = ""+	deserialize "" = Just (AssociatedFile Nothing)+	deserialize f = Just (AssociatedFile (Just f))  instance TCSerialized RemoteName where 	serialize n = n

@@ -49,7 +49,7 @@ start :: M.Map UUID Remote -> FilePath -> Key -> CommandStart start remotemap file key = startKeys remotemap key (mkActionItem afile)   where-	afile = Just file+	afile = AssociatedFile (Just file)  startKeys :: M.Map UUID Remote -> Key -> ActionItem -> CommandStart startKeys remotemap key ai = do

@@ -0,0 +1,74 @@+{- GIT_SSH and GIT_SSH_COMMAND support+ -+ - Copyright 2017 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Git.Ssh where++import Common+import Utility.Env++import Data.Char++gitSshEnv :: String+gitSshEnv = "GIT_SSH"++gitSshCommandEnv :: String+gitSshCommandEnv = "GIT_SSH_COMMAND"++gitSshEnvSet :: IO Bool+gitSshEnvSet = anyM (isJust <$$> getEnv) [gitSshEnv, gitSshCommandEnv]++-- Either a hostname, or user@host+type SshHost = String++type SshPort = Integer++-- Command to run on the remote host. It is run by the shell+-- there, so any necessary shell escaping of parameters in it should+-- already be done.+type SshCommand = String++-- | Checks for GIT_SSH and GIT_SSH_COMMAND and if set, returns+-- a command and parameters to run to ssh.+gitSsh :: SshHost -> Maybe SshPort -> SshCommand -> IO (Maybe (FilePath, [CommandParam]))+gitSsh host mp cmd = gitSsh' host mp cmd []++gitSsh' :: SshHost -> Maybe SshPort -> SshCommand -> [CommandParam] -> IO (Maybe (FilePath, [CommandParam]))+gitSsh' host mp cmd extrasshparams = do+	gsc <- getEnv gitSshCommandEnv+	case gsc of+		Just c+			-- git only runs the command with the shell+			-- when it contains spaces; otherwise it's+			-- treated the same as GIT_SSH+			| any isSpace c -> ret "sh"+				[ Param "-c"+				, Param (shellcmd c sshps)+				]+			| otherwise -> ret c sshps+		Nothing -> do+			gs <- getEnv gitSshEnv+			case gs of+				Just c -> ret c sshps+				Nothing -> return Nothing+ where+	ret c l = return $ Just (c, l)++	-- Git passes exactly these parameters to the ssh command.+	gitps = map Param $ case mp of+		Nothing -> [host, cmd]+		Just p -> [host, "-p", show p, cmd]++	-- Passing any extra parameters to the ssh command may+	-- break some commands.+	sshps = extrasshparams ++ gitps++	-- The shell command to run with sh -c is constructed+	-- this way, rather than using "$@" because there could be some+	-- unwanted parameters passed to the command, and this way they+	-- are ignored. For example, when Utility.Rsync.rsyncShell is +	-- used, rsync adds some parameters after the command.+	shellcmd c ps = c ++ " " ++ unwords (map shellEscape (toCommand ps))

@@ -9,7 +9,7 @@  module Key ( 	Key(..),-	AssociatedFile,+	AssociatedFile(..), 	stubKey, 	key2file, 	file2key,

@@ -13,12 +13,14 @@ import Types.FileMatcher  addWantGet :: Annex ()-addWantGet = addLimit $ Right $ const $ checkWant $ wantGet False Nothing+addWantGet = addLimit $ Right $ const $ checkWant $+	wantGet False Nothing  addWantDrop :: Annex ()-addWantDrop = addLimit $ Right $ const $ checkWant $ wantDrop False Nothing Nothing+addWantDrop = addLimit $ Right $ const $ checkWant $+	wantDrop False Nothing Nothing -checkWant :: (Maybe FilePath -> Annex Bool) -> MatchInfo -> Annex Bool-checkWant a (MatchingFile fi) = a (Just $ matchFile fi)+checkWant :: (AssociatedFile -> Annex Bool) -> MatchInfo -> Annex Bool+checkWant a (MatchingFile fi) = a (AssociatedFile (Just $ matchFile fi)) checkWant _ (MatchingKey _) = return False checkWant _ (MatchingInfo {}) = return False

@@ -10,6 +10,7 @@ module Logs.Transfer where  import Types.Transfer+import Types.ActionItem import Annex.Common import Annex.Perms import qualified Git@@ -27,7 +28,9 @@ describeTransfer t info = unwords 	[ show $ transferDirection t 	, show $ transferUUID t-	, fromMaybe (key2file $ transferKey t) (associatedFile info)+	, actionItemDesc+		(ActionItemAssociatedFile (associatedFile info))+		(transferKey t) 	, show $ bytesComplete info 	] @@ -67,8 +70,8 @@ 		Just sz -> sz `div` 100 		Nothing -> 100 * 1024 -- arbitrarily, 100 kb -startTransferInfo :: Maybe FilePath -> IO TransferInfo-startTransferInfo file = TransferInfo+startTransferInfo :: AssociatedFile -> IO TransferInfo+startTransferInfo afile = TransferInfo 	<$> (Just . utcTimeToPOSIXSeconds <$> getCurrentTime) #ifndef mingw32_HOST_OS 	<*> pure Nothing -- pid not stored in file, so omitted for speed@@ -78,7 +81,7 @@ 	<*> pure Nothing -- tid ditto 	<*> pure Nothing -- not 0; transfer may be resuming 	<*> pure Nothing-	<*> pure file+	<*> pure afile 	<*> pure False  {- If a transfer is still running, returns its TransferInfo.@@ -228,7 +231,9 @@ #ifdef mingw32_HOST_OS 	, maybe "" show (transferPid info) #endif-	, fromMaybe "" $ associatedFile info -- comes last; arbitrary content+	-- comes last; arbitrary content+	, let AssociatedFile afile = associatedFile info+	  in fromMaybe "" afile 	]  readTransferInfoFile :: Maybe PID -> FilePath -> IO (Maybe TransferInfo)@@ -246,7 +251,7 @@ 	<*> pure Nothing 	<*> pure Nothing 	<*> bytes-	<*> pure (if null filename then Nothing else Just filename)+	<*> pure (AssociatedFile (if null filename then Nothing else Just filename)) 	<*> pure False   where #ifdef mingw32_HOST_OS

@@ -15,8 +15,6 @@  - Licensed under the GNU GPL version 3 or higher.  -} -{-# LANGUAGE CPP #-}- module Logs.Unused ( 	UnusedMap, 	updateUnusedLog,@@ -93,14 +91,9 @@ readUnusedMap = log2map <$$> readUnusedLog  dateUnusedLog :: FilePath -> Annex (Maybe UTCTime)-#if MIN_VERSION_directory(1,2,0) dateUnusedLog prefix = do 	f <- fromRepo $ gitAnnexUnusedLog prefix 	liftIO $ catchMaybeIO $ getModificationTime f-#else--- old ghc's getModificationTime returned a ClockTime-dateUnusedLog _prefix = return Nothing-#endif  {- Set of unused keys. This is cached for speed. -} unusedKeys :: Annex (S.Set Key)

@@ -136,8 +136,9 @@ -- These mungings are ok, because an AssociatedFile is only ever displayed -- to the user and does not need to match a file on disk. instance Proto.Serializable AssociatedFile where-	serialize Nothing = ""-	serialize (Just af) = toInternalGitPath $ concatMap esc af+	serialize (AssociatedFile Nothing) = ""+	serialize (AssociatedFile (Just af)) = +		toInternalGitPath $ concatMap esc af 	  where 		esc '%' = "%%" 		esc c @@ -145,9 +146,9 @@ 			| otherwise = [c] 	 	deserialize s = case fromInternalGitPath $ deesc [] s of-		[] -> Just Nothing+		[] -> Just (AssociatedFile Nothing) 		f-			| isRelative f -> Just (Just f)+			| isRelative f -> Just (AssociatedFile (Just f)) 			| otherwise -> Nothing 	  where 	  	deesc b [] = reverse b

@@ -212,11 +212,11 @@ 	v = fromUUID u  onBupRemote :: Git.Repo -> (FilePath -> [CommandParam] -> IO a) -> FilePath -> [CommandParam] -> Annex a-onBupRemote r a command params = do+onBupRemote r runner command params = do 	c <- Annex.getRemoteGitConfig r-	sshparams <- Ssh.toRepo NoConsumeStdin r c [Param $-			"cd " ++ dir ++ " && " ++ unwords (command : toCommand params)]-	liftIO $ a "ssh" sshparams+	let remotecmd = "cd " ++ dir ++ " && " ++ unwords (command : toCommand params)+	(sshcmd, sshparams) <- Ssh.toRepo NoConsumeStdin r c remotecmd+	liftIO $ runner sshcmd sshparams   where 	path = Git.repoPath r 	base = fromMaybe path (stripPrefix "/~/" path)

@@ -121,13 +121,12 @@ ddarRemoteCall :: ConsumeStdin -> DdarRepo -> Char -> [CommandParam] -> Annex (String, [CommandParam]) ddarRemoteCall cs ddarrepo cmd params 	| ddarLocal ddarrepo = return ("ddar", localParams)-	| otherwise = do-		os <- sshOptions cs (host, Nothing) (ddarRepoConfig ddarrepo) []-		return ("ssh", os ++ remoteParams)+	| otherwise = sshCommand cs (host, Nothing) (ddarRepoConfig ddarrepo) remoteCommand   where 	(host, ddarrepo') = splitRemoteDdarRepo ddarrepo 	localParams = Param [cmd] : Param (ddarRepoLocation ddarrepo) : params-	remoteParams = Param host : Param "ddar" : Param [cmd] : Param ddarrepo' : params+	remoteCommand = unwords $ map shellEscape $ toCommand $+		[Param "ddar", Param [cmd], Param ddarrepo'] ++ params  {- Specialized ddarRemoteCall that includes extraction command and flags -} ddarExtractRemoteCall :: ConsumeStdin -> DdarRepo -> Key -> Annex (String, [CommandParam])@@ -159,23 +158,19 @@ 			Left _ -> Right False 			Right status -> Right $ isDirectory status 	| otherwise = do-		ps <- sshOptions NoConsumeStdin (host, Nothing)-			(ddarRepoConfig ddarrepo) []-		exitCode <- liftIO $ safeSystem "ssh" (ps ++ params)+		let remotecmd = unwords $ map shellEscape+			[ "test", "-d", ddarrepo' ]+		(sshcmd, sshps) <- sshCommand NoConsumeStdin (host, Nothing)+			(ddarRepoConfig ddarrepo) remotecmd+		exitCode <- liftIO $ safeSystem sshcmd sshps 		case exitCode of 			ExitSuccess -> return $ Right True 			ExitFailure 1 -> return $ Right False-			ExitFailure code -> return $ Left $ "ssh call " ++-				show (unwords $ toCommand params) +++			ExitFailure code -> return $ Left $ "ssh " +++				show (unwords $ toCommand sshps) ++ 				" failed with status " ++ show code   where 	(host, ddarrepo') = splitRemoteDdarRepo ddarrepo-	params =-		[ Param host-		, Param "test"-		, Param "-d"-		, Param ddarrepo'-		]  {- Use "ddar t" to determine if a given key is present in a ddar archive -} inDdarManifest :: DdarRepo -> Key -> Annex (Either String Bool)

@@ -375,7 +375,8 @@ 	return st   where 	start errrelayer g = liftIO $ do-		(cmd, ps) <- findShellCommand basecmd+		cmdpath <- searchPath basecmd+		(cmd, ps) <- maybe (pure (basecmd, [])) findShellCommand cmdpath 		let basep = (proc cmd (toCommand ps)) 			{ std_in = CreatePipe 			, std_out = CreatePipe@@ -383,9 +384,8 @@ 			} 		p <- propgit g basep 		(Just hin, Just hout, Just herr, ph) <- -			createProcess p `catchIO` runerr+			createProcess p `catchIO` runerr cmdpath 		stderrelay <- async $ errrelayer herr-		checkearlytermination =<< getProcessExitCode ph 		cv <- newTVarIO $ externalDefaultConfig external 		pv <- newTVarIO Unprepared 		pid <- atomically $ do@@ -409,15 +409,11 @@ 		environ <- propGitEnv g 		return $ p { env = Just environ } -	runerr _ = giveup ("Cannot run " ++ basecmd ++ " -- Make sure it's in your PATH and is executable.")--	checkearlytermination Nothing = noop-	checkearlytermination (Just exitcode) = ifM (inPath basecmd)-		( giveup $ unwords [ "failed to run", basecmd, "(" ++ show exitcode ++ ")" ]-		, do-			path <- intercalate ":" <$> getSearchPath-			giveup $ basecmd ++ " is not installed in PATH (" ++ path ++ ")"-		)+	runerr (Just cmd) _ =+		giveup $ "Cannot run " ++ cmd ++ " -- Make sure it's executable and that its dependencies are installed."+	runerr Nothing _ = do+		path <- intercalate ":" <$> getSearchPath+		giveup $ "Cannot run " ++ basecmd ++ " -- It is not installed in PATH (" ++ path ++ ")"  stopExternal :: External -> Annex () stopExternal external = liftIO $ do

@@ -326,7 +326,8 @@ 			return True 	| Git.repoIsSsh (repo r) = if accessShell r 		then fileStorer $ \k f p -> Ssh.rsyncHelper (Just p)-			=<< Ssh.rsyncParamsRemote False r Upload k f Nothing+			=<< Ssh.rsyncParamsRemote False r Upload k f+				(AssociatedFile Nothing) 		else fileStorer $ Remote.Rsync.store rsyncopts 	| otherwise = unsupportedUrl @@ -336,8 +337,10 @@ 		guardUsable (repo r) (return False) $ 			sink =<< liftIO (L.readFile $ gCryptLocation r k) 	| Git.repoIsSsh (repo r) = if accessShell r-		then fileRetriever $ \f k p ->-			unlessM (Ssh.rsyncHelper (Just p) =<< Ssh.rsyncParamsRemote False r Download k f Nothing) $+		then fileRetriever $ \f k p -> do+			ps <- Ssh.rsyncParamsRemote False r Download k f+				(AssociatedFile Nothing)+			unlessM (Ssh.rsyncHelper (Just p) ps) $ 				giveup "rsync failed" 		else fileRetriever $ Remote.Rsync.retrieve rsyncopts 	| otherwise = unsupportedUrl

@@ -479,8 +479,9 @@ 		) 	feedprogressback' a = do 		u <- getUUID+		let AssociatedFile afile = file 		let fields = (Fields.remoteUUID, fromUUID u)-			: maybe [] (\f -> [(Fields.associatedFile, f)]) file+			: maybe [] (\f -> [(Fields.associatedFile, f)]) afile 		Just (cmd, params) <- Ssh.git_annex_shell ConsumeStdin 			(repo r) "transferinfo"  			[Param $ key2file key] fields

@@ -23,15 +23,10 @@ import Types.Transfer import Config -{- Generates parameters to ssh to a repository's host and run a command.- - Caller is responsible for doing any neccessary shellEscaping of the- - passed command. -}-toRepo :: ConsumeStdin -> Git.Repo -> RemoteGitConfig -> [CommandParam] -> Annex [CommandParam]-toRepo cs r gc sshcmd = do-	let opts = map Param $ remoteAnnexSshOptions gc+toRepo :: ConsumeStdin -> Git.Repo -> RemoteGitConfig -> SshCommand -> Annex (FilePath, [CommandParam])+toRepo cs r gc remotecmd = do 	let host = fromMaybe (giveup "bad ssh url") $ Git.Url.hostuser r-	params <- sshOptions cs (host, Git.Url.port r) gc opts-	return $ params ++ Param host : sshcmd+	sshCommand cs (host, Git.Url.port r) gc remotecmd  {- Generates parameters to run a git-annex-shell command on a remote  - repository. -}@@ -49,8 +44,7 @@ 				: map shellEscape (toCommand shellopts) ++ 			uuidcheck u ++ 			map shellEscape (toCommand fieldopts)-		sshparams <- toRepo cs r gc [Param sshcmd]-		return $ Just ("ssh", sshparams)+		Just <$> toRepo cs r gc sshcmd 	| otherwise = return Nothing   where 	dir = Git.repoPath r@@ -126,7 +120,7 @@ {- Generates rsync parameters that ssh to the remote and asks it  - to either receive or send the key's content. -} rsyncParamsRemote :: Bool -> Remote -> Direction -> Key -> FilePath -> AssociatedFile -> Annex [CommandParam]-rsyncParamsRemote unlocked r direction key file afile = do+rsyncParamsRemote unlocked r direction key file (AssociatedFile afile) = do 	u <- getUUID 	let fields = (Fields.remoteUUID, fromUUID u) 		: (Fields.unlocked, if unlocked then "1" else "")

@@ -121,7 +121,6 @@ 			"ssh":sshopts -> do 				let (port, sshopts') = sshReadPort sshopts 				    userhost = takeWhile (/=':') url-				-- Connection caching 				(Param "ssh":) <$> sshOptions ConsumeStdin 					(userhost, port) gc 					(map Param $ loginopt ++ sshopts')

@@ -1,6 +1,6 @@ {- git-annex test suite  -- - Copyright 2010-2016 Joey Hess <id@joeyh.name>+ - Copyright 2010-2017 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -29,13 +29,14 @@ import Test.Tasty.HUnit import Test.Tasty.QuickCheck import Test.Tasty.Ingredients.Rerun-import Options.Applicative (switch, long, help)+import Options.Applicative (switch, long, help, internal)  import qualified Data.Map as M import qualified Data.Aeson import qualified Data.ByteString.Lazy.UTF8 as BU8  import Common+import CmdLine.GitAnnex.Options  import qualified Utility.SafeCommand import qualified Annex@@ -112,21 +113,31 @@ 	<*> switch 		( long "keep-failures" 		<> help "preserve repositories on test failure"-	)+		)+	<*> switch+		( long "fakessh"+		<> internal+		)+	<*> cmdParams "non-options are for internal use only"  runner :: Maybe (TestOptions -> IO ())-runner = Just $ \opts -> isolateGitConfig $ do-	ensuretmpdir-	crippledfilesystem <- Annex.Init.probeCrippledFileSystem' tmpdir-	case tryIngredients ingredients (tastyOptionSet opts) (tests crippledfilesystem opts) of-		Nothing -> error "No tests found!?"-		Just act -> ifM act-			( exitSuccess-			, do-				putStrLn "  (This could be due to a bug in git-annex, or an incompatibility"-				putStrLn "   with utilities, such as git, installed on this system.)"-				exitFailure-			)+runner = Just go+  where+	go opts+		| fakeSsh opts = runFakeSsh (internalData opts)+		| otherwise = runtests opts+	runtests opts = isolateGitConfig $ do+		ensuretmpdir+		crippledfilesystem <- Annex.Init.probeCrippledFileSystem' tmpdir+		case tryIngredients ingredients (tastyOptionSet opts) (tests crippledfilesystem opts) of+			Nothing -> error "No tests found!?"+			Just act -> ifM act+				( exitSuccess+				, do+					putStrLn "  (This could be due to a bug in git-annex, or an incompatibility"+					putStrLn "   with utilities, such as git, installed on this system.)"+					exitFailure+				)  ingredients :: [Ingredient] ingredients =@@ -211,7 +222,9 @@ 	, testCase "drop (with remote)" test_drop_withremote 	, testCase "drop (untrusted remote)" test_drop_untrustedremote 	, testCase "get" test_get+	, testCase "get (ssh remote)" test_get_ssh_remote 	, testCase "move" test_move+	, testCase "move (ssh remote)" test_move_ssh_remote 	, testCase "copy" test_copy 	, testCase "lock" test_lock 	, testCase "lock (v6 --force)" test_lock_v6_force@@ -458,7 +471,13 @@ 	inmainrepo $ annexed_present annexedfile  test_get :: Assertion-test_get = intmpclonerepo $ do+test_get = test_get' intmpclonerepo++test_get_ssh_remote :: Assertion+test_get_ssh_remote = test_get' (with_ssh_origin intmpclonerepo)++test_get' :: (Assertion -> Assertion) -> Assertion+test_get' setup = setup $ do 	inmainrepo $ annexed_present annexedfile 	annexed_notpresent annexedfile 	git_annex "get" [annexedfile] @? "get of file failed"@@ -475,7 +494,13 @@ 		unannexed ingitfile  test_move :: Assertion-test_move = intmpclonerepo $ do+test_move = test_move' intmpclonerepo++test_move_ssh_remote :: Assertion+test_move_ssh_remote = test_move' (with_ssh_origin intmpclonerepo)++test_move' :: (Assertion -> Assertion) -> Assertion+test_move' setup = setup $ do 	annexed_notpresent annexedfile 	inmainrepo $ annexed_present annexedfile 	git_annex "move" ["--from", "origin", annexedfile] @? "move --from of file failed"@@ -1740,6 +1765,16 @@ inmainrepo :: Assertion -> Assertion inmainrepo = indir mainrepodir +with_ssh_origin :: (Assertion -> Assertion) -> (Assertion -> Assertion)+with_ssh_origin cloner a = cloner $ do+	origindir <- absPath+		=<< annexeval (Config.getConfig (Config.ConfigKey config) "/dev/null")+	let originurl = "localhost:" ++ origindir+	boolSystem "git" [Param "config", Param config, Param originurl] @? "git config failed"+	a+  where+	config = "remote.origin.url"+ intmpclonerepo :: Assertion -> Assertion intmpclonerepo a = withtmpclonerepo $ \r -> indir r a @@ -2072,8 +2107,18 @@ 		, ("GIT_COMMITTER_NAME", "git-annex test") 		-- force gpg into batch mode for the tests 		, ("GPG_BATCH", "1")+		-- Make git and git-annex access ssh remotes on the local+		-- filesystem, without using ssh at all.+		, ("GIT_SSH_COMMAND", "git-annex test --fakessh --") 		, ("TESTMODE", show testmode) 		]++runFakeSsh :: [String] -> IO ()+runFakeSsh ("-n":ps) = runFakeSsh ps+runFakeSsh (_host:cmd:[]) = do+	(_, _, _, pid) <- createProcess (shell cmd)+	exitWith =<< waitForProcess pid+runFakeSsh ps = error $ "fake ssh option parse error: " ++ show ps  getTestMode :: IO TestMode getTestMode = Prelude.read <$> Utility.Env.getEnvDefault "TESTMODE" ""

@@ -9,7 +9,7 @@ 	Annex, 	Backend, 	Key,-	AssociatedFile,+	AssociatedFile(..), 	UUID(..), 	GitConfig(..), 	RemoteGitConfig(..),

@@ -13,8 +13,6 @@ import Types.Transfer import Git.FilePath -import Data.Maybe- data ActionItem  	= ActionItemAssociatedFile AssociatedFile 	| ActionItemKey@@ -37,15 +35,15 @@ 	mkActionItem = uncurry ActionItemFailedTransfer  actionItemDesc :: ActionItem -> Key -> String-actionItemDesc (ActionItemAssociatedFile (Just f)) _ = f-actionItemDesc (ActionItemAssociatedFile Nothing) k = key2file k+actionItemDesc (ActionItemAssociatedFile (AssociatedFile (Just f))) _ = f+actionItemDesc (ActionItemAssociatedFile (AssociatedFile Nothing)) k = key2file k actionItemDesc ActionItemKey k = key2file k actionItemDesc (ActionItemBranchFilePath bfp) _ = descBranchFilePath bfp-actionItemDesc (ActionItemFailedTransfer _ i) k = -	fromMaybe (key2file k) (associatedFile i)+actionItemDesc (ActionItemFailedTransfer _ i) k =+	actionItemDesc (ActionItemAssociatedFile (associatedFile i)) k  actionItemWorkTreeFile :: ActionItem -> Maybe FilePath-actionItemWorkTreeFile (ActionItemAssociatedFile af) = af+actionItemWorkTreeFile (ActionItemAssociatedFile (AssociatedFile af)) = af actionItemWorkTreeFile _ = Nothing  actionItemTransferDirection :: ActionItem -> Maybe Direction

@@ -23,7 +23,8 @@ 	} deriving (Eq, Ord, Read, Show)  {- A filename may be associated with a Key. -}-type AssociatedFile = Maybe FilePath+newtype AssociatedFile = AssociatedFile (Maybe FilePath)+	deriving (Show, Eq, Ord)  {- There are several different varieties of keys. -} data KeyVariety

@@ -1,6 +1,6 @@ {- git-annex test data types.  -- - Copyright 2011-2015 Joey Hess <id@joeyh.name>+ - Copyright 2011-2017 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -13,19 +13,24 @@ import Test.Tasty.Options import Data.Monoid import Prelude+import Types.Command #endif  #ifdef WITH_TESTSUITE data TestOptions = TestOptions 	{ tastyOptionSet :: OptionSet 	, keepFailuresOption :: Bool+	, fakeSsh :: Bool+	, internalData :: CmdParams 	}  instance Monoid TestOptions where-	mempty = TestOptions mempty False+	mempty = TestOptions mempty False False mempty 	mappend a b = TestOptions 		(tastyOptionSet a <> tastyOptionSet b) 		(keepFailuresOption a || keepFailuresOption b)+		(fakeSsh a || fakeSsh b)+		(internalData a <> internalData b)  #else type TestOptions = ()

@@ -36,13 +36,13 @@ 	, transferTid :: Maybe ThreadId 	, transferRemote :: Maybe Remote 	, bytesComplete :: Maybe Integer-	, associatedFile :: Maybe FilePath+	, associatedFile :: AssociatedFile 	, transferPaused :: Bool 	} 	deriving (Show, Eq, Ord)  stubTransferInfo :: TransferInfo-stubTransferInfo = TransferInfo Nothing Nothing Nothing Nothing Nothing Nothing False+stubTransferInfo = TransferInfo Nothing Nothing Nothing Nothing Nothing (AssociatedFile Nothing) False  data Direction = Upload | Download 	deriving (Eq, Ord, Show, Read)@@ -64,5 +64,5 @@ 		<*> pure Nothing -- remote not needed 		<*> arbitrary 		-- associated file cannot be empty (but can be Nothing)-		<*> arbitrary `suchThat` (/= Just "")+		<*> (AssociatedFile <$> arbitrary `suchThat` (/= Just "")) 		<*> arbitrary

@@ -2,7 +2,7 @@  -  - Copyright 2011 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - License: BSD-2-clause  -}  {-# LANGUAGE CPP #-}

@@ -227,6 +227,8 @@  -  - The command may be fully qualified already, in which case it will  - be returned if it exists.+ -+ - Note that this will find commands in PATH that are not executable.  -} searchPath :: String -> IO (Maybe FilePath) searchPath command

@@ -5,8 +5,6 @@  - License: BSD-2-clause  -} -{-# LANGUAGE CPP #-}- module Utility.SRV ( 	mkSRVTcp, 	mkSRV,@@ -42,12 +40,7 @@ lookupSRV (SRV srv) = do 	seed <- makeResolvSeed defaultResolvConf 	r <- withResolver seed $ flip DNS.lookupSRV $ B8.fromString srv-	return $-#if MIN_VERSION_dns(1,0,0)-		either (const []) use r-#else-		maybe [] use r-#endif+	return $ either (const []) use r   where 	use = orderHosts . map tohosts 	tohosts (priority, weight, port, hostname) =

@@ -49,8 +49,7 @@ #ifndef mingw32_HOST_OS 	defcmd #else-	l <- catchDefaultIO Nothing $ withFile f ReadMode $-		headMaybe . lines <$$> hGetContents+	l <- catchDefaultIO Nothing $ headMaybe . lines <$> readFile f 	case l of 		Just ('#':'!':rest) -> case words rest of 			[] -> defcmd

@@ -67,11 +67,7 @@ 	{ userAgent :: Maybe UserAgent 	, reqHeaders :: Headers 	, reqParams :: [CommandParam]-#if MIN_VERSION_http_conduit(2,0,0) 	, applyRequest :: Request -> Request-#else-	, applyRequest :: forall m. Request m -> Request m-#endif 	}  instance Default UrlOptions@@ -232,11 +228,7 @@ 			drop 1 $ dropWhile (/= '"') s 	| otherwise = Nothing -#if MIN_VERSION_http_conduit(2,0,0) headRequest :: Request -> Request-#else-headRequest :: Request m -> Request m-#endif headRequest r = r 	{ method = methodHead 	-- remove defaut Accept-Encoding header, to get actual,@@ -349,14 +341,6 @@  hContentDisposition :: CI.CI B.ByteString hContentDisposition = "Content-Disposition"--#if ! MIN_VERSION_http_types(0,7,0)-hContentLength :: CI.CI B.ByteString-hContentLength = "Content-Length"--hUserAgent :: CI.CI B.ByteString-hUserAgent = "User-Agent"-#endif  {- Use with eg:  -

@@ -23,7 +23,7 @@ * `--from=remote`    Normally git-annex will choose which remotes to get the content-  from, preferring less expensive remotes. Use this option to specify+  from, preferring remotes with lower costs. Use this option to specify   which remote to use.       Any files that are not available on the remote will be silently skipped.@@ -32,6 +32,13 @@    Enables parallel download with up to the specified number of jobs   running at once. For example: `-J10`++  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+  downloaded from A, and another file will be downloaded from B in+  parallel. (Remotes with lower costs are still preferred over higher cost+  remotes.)  * file matching options  

@@ -73,6 +73,14 @@   This behavior can be overridden by configuring the preferred content   of a repository. See [[git-annex-preferred-content]](1). +* `--content-of=path` `-C path`++  While --content operates on all annexed files in the work tree,+  --content-of allows limiting the transferred files to ones in a given+  location.++  This option can be repeated multiple times with different paths.+ * `--all`    This option, when combined with `--content`, makes all available versions

@@ -1404,6 +1404,37 @@ failure, unless the `--time-limit=time` option is hit, in which case it returns with exit code 101. +# ENVIRONMENT++These environment variables are used by git-annex when set:++* `GIT_WORK_TREE`, `GIT_DIR`++  Handled the same as they are by git, see git(1)++* `GIT_SSH`, `GIT_SSH_COMMAND`++  Handled similarly to the same as described in git(1).+  The one difference is that git-annex will sometimes pass an additional+  "-n" parameter to these, as the first parameter, to prevent ssh from+  reading from stdin.++  Note that setting either of these environment variables prevents+  git-annex from automatically enabling ssh connection caching+  (see `annex.sshcaching`), so it will slow down some operations with+  remotes over ssh. It's up to you to enable ssh connection caching+  if you need it; see ssh's documentation.++  Also, `annex.ssh-options` and `remote.<name>.annex-ssh-options`+  won't have any effect when these envionment variables are set.++  Usually it's better to configure any desired options through your+  ~/.ssh/config file, or by setting `annex.ssh-options`.++Some special remotes use additional environment variables+for authentication etc. For example, `AWS_ACCESS_KEY_ID`+and `GIT_ANNEX_P2P_AUTHTOKEN`. See special remote documentation.+ # FILES  These files are used by git-annex:

@@ -1,5 +1,5 @@ Name: git-annex-Version: 6.20170301.1+Version: 6.20170321 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -326,7 +326,7 @@    unix-compat,    SafeSemaphore,    async,-   directory,+   directory (>= 1.2),    filepath,    IfElse,    MissingH,@@ -343,8 +343,8 @@    edit-distance,    resourcet,    http-client,-   http-types,-   http-conduit,+   http-types (>= 0.7),+   http-conduit (>= 2.0),    time,    old-locale,    esqueleto,@@ -353,7 +353,7 @@    persistent-template,    aeson,    unordered-containers,-   feed,+   feed (>= 0.3.9),    regex-tdfa,    socks,    byteable,@@ -402,7 +402,7 @@     CPP-Options: -DWITH_WEBDAV    if flag(Assistant) && ! os(solaris)-    Build-Depends: dns, mountpoints+    Build-Depends: dns (>= 1.0.0), mountpoints     CPP-Options: -DWITH_ASSISTANT    if flag(Assistant)@@ -833,6 +833,7 @@     Git.Remote.Remove     Git.Repair     Git.Sha+    Git.Ssh     Git.Status     Git.Tree     Git.Types

@@ -6,10 +6,7 @@         <div .row>           <div .col-sm-10>             <h3 .forcewrap .small-margin-top .tiny-margin-bottom>-              $maybe file <- associatedFile info-                #{file}-              $nothing-                #{key2file $ transferKey transfer}+              #{desc transfer info}               $case transferDirection transfer                 $of Upload                   &rarr;