git-annex 6.20171124 → 6.20171214

raw patch · 98 files changed

+997/−766 lines, 98 filesdep +tagsoupdep −yesod-default

Dependencies added: tagsoup

Dependencies removed: yesod-default

Files

• Annex.hs +0/−3
• Annex/Content.hs +53/−11
• Annex/Init.hs +24/−6
• Annex/Link.hs +3/−4
• Annex/Locations.hs +15/−1
• Annex/MakeRepo.hs +1/−1
• Annex/Notification.hs +24/−21
• Annex/NumCopies.hs +6/−9
• Annex/Perms.hs +2/−3
• Annex/Quvi.hs +0/−33
• Annex/SpecialRemote.hs +1/−2
• Annex/Ssh.hs +4/−7
• Annex/Transfer.hs +12/−34
• Annex/Url.hs +3/−5
• Annex/WorkTree.hs +10/−13
• Annex/YoutubeDl.hs +181/−0
• Assistant/MakeRemote.hs +3/−5
• Assistant/NamedThread.hs +17/−20
• Backend.hs +1/−2
• Backend/Hash.hs +2/−3
• BuildInfo.hs +0/−1
• CHANGELOG +25/−0
• CmdLine/Action.hs +5/−7
• CmdLine/GitAnnexShell/Checks.hs +4/−6
• CmdLine/GitRemoteTorAnnex.hs +6/−10
• CmdLine/Seek.hs +1/−2
• Command.hs +1/−2
• Command/Add.hs +17/−23
• Command/AddUrl.hs +196/−172
• Command/Adjust.hs +1/−1
• Command/CalcKey.hs +5/−7
• Command/CheckPresentKey.hs +4/−6
• Command/Config.hs +4/−5
• Command/ConfigList.hs +1/−1
• Command/Dead.hs +2/−3
• Command/Describe.hs +1/−1
• Command/Direct.hs +4/−6
• Command/Drop.hs +2/−2
• Command/DropKey.hs +1/−1
• Command/DropUnused.hs +1/−1
• Command/EnableRemote.hs +4/−6
• Command/EnableTor.hs +2/−3
• Command/Expire.hs +2/−2
• Command/Fix.hs +1/−2
• Command/Forget.hs +1/−1
• Command/FromKey.hs +1/−1
• Command/Fsck.hs +10/−13
• Command/Get.hs +1/−1
• Command/Group.hs +1/−1
• Command/GroupWanted.hs +1/−1
• Command/ImportFeed.hs +73/−37
• Command/Indirect.hs +2/−2
• Command/Init.hs +2/−2
• Command/InitRemote.hs +1/−1
• Command/LookupKey.hs +16/−4
• Command/Map.hs +1/−1
• Command/Merge.hs +1/−1
• Command/MetaData.hs +2/−2
• Command/Move.hs +1/−1
• Command/Multicast.hs +4/−4
• Command/NumCopies.hs +1/−1
• Command/P2P.hs +2/−2
• Command/RegisterUrl.hs +2/−2
• Command/Reinit.hs +2/−2
• Command/ResolveMerge.hs +1/−1
• Command/Schedule.hs +1/−1
• Command/SetPresentKey.hs +1/−1
• Command/Sync.hs +7/−7
• Command/TestRemote.hs +1/−1
• Command/Trust.hs +1/−1
• Command/Ungroup.hs +1/−1
• Command/Unused.hs +2/−2
• Command/Upgrade.hs +2/−2
• Command/VAdd.hs +1/−1
• Command/VCycle.hs +1/−1
• Command/VFilter.hs +1/−1
• Command/VPop.hs +1/−1
• Command/View.hs +1/−1
• Command/Wanted.hs +1/−1
• Command/Whereis.hs +1/−1
• Logs/Trust.hs +1/−1
• Logs/Web.hs +7/−4
• Messages.hs +10/−3
• Remote/Helper/Special.hs +1/−1
• Remote/Web.hs +4/−8
• Test.hs +2/−2
• Types/GitConfig.hs +2/−2
• Types/Transfer.hs +35/−0
• Utility/Gpg.hs +1/−1
• Utility/HtmlDetect.hs +46/−0
• Utility/Quvi.hs +0/−162
• Utility/Url.hs +39/−8
• doc/git-annex-addurl.mdwn +10/−5
• doc/git-annex-importfeed.mdwn +20/−4
• doc/git-annex-init.mdwn +5/−0
• doc/git-annex.mdwn +9/−3
• git-annex.cabal +4/−4
• stack.yaml +0/−1

@@ -64,7 +64,6 @@ import Types.DesktopNotify import Types.CleanupActions import qualified Database.Keys.Handle as Keys-import Utility.Quvi (QuviVersion) import Utility.InodeCache import Utility.Url @@ -134,7 +133,6 @@ 	, errcounter :: Integer 	, unusedkeys :: Maybe (S.Set Key) 	, tempurls :: M.Map Key URLString-	, quviversion :: Maybe QuviVersion 	, existinghooks :: M.Map Git.Hook.Hook Bool 	, desktopnotify :: DesktopNotify 	, workers :: [Either AnnexState (Async AnnexState)]@@ -190,7 +188,6 @@ 		, errcounter = 0 		, unusedkeys = Nothing 		, tempurls = M.empty-		, quviversion = Nothing 		, existinghooks = M.empty 		, desktopnotify = mempty 		, workers = []

@@ -21,6 +21,7 @@ 	prepTmp, 	withTmp, 	checkDiskSpace,+	needMoreDiskSpace, 	moveAnnex, 	populatePointerFile, 	linkToAnnex,@@ -42,11 +43,13 @@ 	dirKeys, 	withObjectLoc, 	staleKeysPrune,+	pruneTmpWorkDirBefore, 	isUnmodified, 	verifyKeyContent, 	VerifyConfig(..), 	Verification(..), 	unVerified,+	withTmpWorkDir, ) where  import System.IO.Unsafe (unsafeInterleaveIO)@@ -167,7 +170,7 @@ 	checkdirect contentfile lockfile = 		ifM (liftIO $ doesFileExist contentfile) 			( modifyContent lockfile $ liftIO $-				lockShared >>= \case+				lockShared lockfile >>= \case 					Nothing -> return is_locked 					Just lockhandle -> do 						dropLock lockhandle@@ -303,7 +306,7 @@ 	(ok, verification) <- action tmpfile 	if ok 		then ifM (verifyKeyContent v verification key tmpfile)-			( ifM (moveAnnex key tmpfile)+			( ifM (pruneTmpWorkDirBefore tmpfile (moveAnnex key)) 				( do 					logStatus key InfoPresent 					return True@@ -311,7 +314,7 @@ 				) 			, do 				warning "verification of content failed"-				liftIO $ nukeFile tmpfile+				pruneTmpWorkDirBefore tmpfile (liftIO . nukeFile) 				return False 			) 		-- On transfer failure, the tmp file is left behind, in case@@ -386,7 +389,7 @@ 	createAnnexDirectory (parentDir tmp) 	return tmp -{- Creates a temp file for a key, runs an action on it, and cleans up+{- Prepares a temp file for a key, runs an action on it, and cleans up  - the temp file. If the action throws an exception, the temp file is  - left behind, which allows for resuming.  -}@@ -394,7 +397,7 @@ withTmp key action = do 	tmp <- prepTmp key 	res <- action tmp-	liftIO $ nukeFile tmp+	pruneTmpWorkDirBefore tmp (liftIO . nukeFile) 	return res  {- Checks that there is disk space available to store a given key,@@ -429,16 +432,17 @@ 				let delta = need + reserve - have - alreadythere + inprogress 				let ok = delta <= 0 				unless ok $-					needmorespace delta+					warning $ needMoreDiskSpace delta 				return ok 			_ -> return True 	)   where 	dir = maybe (fromRepo gitAnnexDir) return destdir-	needmorespace n =-		warning $ "not enough free space, need " ++ -			roughSize storageUnits True n ++-			" more" ++ forcemsg++needMoreDiskSpace :: Integer -> String+needMoreDiskSpace n = "not enough free space, need " ++ +	roughSize storageUnits True n ++ " more" ++ forcemsg+  where 	forcemsg = " (use --force to override this check or adjust annex.diskreserve)"  {- Moves a key's content into .git/annex/objects/@@ -989,7 +993,8 @@ 	let stale = contents `exclude` dups  	dir <- fromRepo dirspec-	liftIO $ forM_ dups $ \t -> removeFile $ dir </> keyFile t+	forM_ dups $ \k ->+		pruneTmpWorkDirBefore (dir </> keyFile k) (liftIO . removeFile)  	if nottransferred 		then do@@ -997,6 +1002,43 @@ 				<$> getTransfers 			return $ filter (`S.notMember` inprogress) stale 		else return stale++{- Prune the work dir associated with the specified content file,+ - before performing an action that deletes the file, or moves it away.+ -+ - This preserves the invariant that the workdir never exists without+ - the content file.+ -}+pruneTmpWorkDirBefore :: FilePath -> (FilePath -> Annex a) -> Annex a+pruneTmpWorkDirBefore f action = do+	let workdir = gitAnnexTmpWorkDir f+	liftIO $ whenM (doesDirectoryExist workdir) $+		removeDirectoryRecursive workdir+	action f++{- Runs an action, passing it a temporary work directory where+ - it can write files while receiving the content of a key.+ -+ - On exception, or when the action returns Nothing,+ - the temporary work directory is left, so resumes can use it.+ -}+withTmpWorkDir :: Key -> (FilePath -> Annex (Maybe a)) -> Annex (Maybe a)+withTmpWorkDir key action = do+	-- Create the object file if it does not exist. This way,+	-- staleKeysPrune only has to look for object files, and can+	-- clean up gitAnnexTmpWorkDir for those it finds.+	obj <- prepTmp key+	unlessM (liftIO $ doesFileExist obj) $ do+		liftIO $ writeFile obj ""+		setAnnexFilePerm obj+	let tmpdir = gitAnnexTmpWorkDir obj+	liftIO $ createDirectoryIfMissing True tmpdir+	setAnnexDirPerm tmpdir+	res <- action tmpdir+	case res of+		Just _ -> liftIO $ removeDirectoryRecursive tmpdir+		Nothing -> noop+	return res  {- Finds items in the first, smaller list, that are not  - present in the second, larger list.

@@ -8,6 +8,7 @@ {-# LANGUAGE CPP #-}  module Annex.Init (+	AutoInit(..), 	ensureInitialized, 	isInitialized, 	initialize,@@ -48,6 +49,23 @@ import qualified Utility.LockFile.Posix as Posix #endif +newtype AutoInit = AutoInit Bool++checkCanInitialize :: AutoInit -> Annex a -> Annex a+checkCanInitialize (AutoInit True) a = a+checkCanInitialize (AutoInit False) a = fromRepo Git.repoWorkTree >>= \case+	Nothing -> a+	Just wt -> liftIO (catchMaybeIO (readFile (wt </> ".noannex"))) >>= \case+		Nothing -> a+		Just noannexmsg -> ifM (Annex.getState Annex.force)+			( a+			, do+				warning "Initialization prevented by .noannex file (use --force to override)"+				unless (null noannexmsg) $+					warning noannexmsg+				giveup "Not initialized."+			)+ genDescription :: Maybe String -> Annex String genDescription (Just d) = return d genDescription Nothing = do@@ -59,8 +77,8 @@ 		Right username -> [username, at, hostname, ":", reldir] 		Left _ -> [hostname, ":", reldir] -initialize :: Maybe String -> Maybe Version -> Annex ()-initialize mdescription mversion = do+initialize :: AutoInit -> Maybe String -> Maybe Version -> Annex ()+initialize ai mdescription mversion = checkCanInitialize ai $ do 	{- Has to come before any commits are made as the shared 	 - clone heuristic expects no local objects. -} 	sharedclone <- checkSharedClone@@ -70,7 +88,7 @@ 	ensureCommit $ Annex.Branch.create  	prepUUID-	initialize' mversion+	initialize' (AutoInit True) mversion 	 	initSharedClone sharedclone @@ -79,8 +97,8 @@  -- Everything except for uuid setup, shared clone setup, and initial -- description.-initialize' :: Maybe Version -> Annex ()-initialize' mversion = do+initialize' :: AutoInit -> Maybe Version -> Annex ()+initialize' ai mversion = checkCanInitialize ai $ do 	checkLockSupport 	checkFifoSupport 	checkCrippledFileSystem@@ -131,7 +149,7 @@ ensureInitialized = getVersion >>= maybe needsinit checkUpgrade   where 	needsinit = ifM Annex.Branch.hasSibling-			( initialize Nothing Nothing+			( initialize (AutoInit True) Nothing Nothing 			, giveup "First run: git-annex init" 			) 

@@ -55,11 +55,10 @@ 		check probefilecontent $ 			return Nothing   where-	check getlinktarget fallback = do-		v <- liftIO $ catchMaybeIO $ getlinktarget file-		case v of+	check getlinktarget fallback = +		liftIO (catchMaybeIO $ getlinktarget file) >>= \case 			Just l-				| isLinkToAnnex (fromInternalGitPath l) -> return v+				| isLinkToAnnex (fromInternalGitPath l) -> return (Just l) 				| otherwise -> return Nothing 			Nothing -> fallback 

@@ -1,6 +1,6 @@ {- git-annex file locations  -- - Copyright 2010-2015 Joey Hess <id@joeyh.name>+ - Copyright 2010-2017 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -27,6 +27,7 @@ 	gitAnnexTmpMiscDir, 	gitAnnexTmpObjectDir, 	gitAnnexTmpObjectLocation,+	gitAnnexTmpWorkDir, 	gitAnnexBadDir, 	gitAnnexBadLocation, 	gitAnnexUnusedLog,@@ -250,6 +251,19 @@ {- The temp file to use for a given key's content. -} gitAnnexTmpObjectLocation :: Key -> Git.Repo -> FilePath gitAnnexTmpObjectLocation key r = gitAnnexTmpObjectDir r </> keyFile key++{- Given a temp file such as gitAnnexTmpObjectLocation, makes a name for a+ - subdirectory in the same location, that can be used as a work area+ - when receiving the key's content.+ -+ - There are ordering requirements for creating these directories;+ - use Annex.Content.withTmpWorkDir to set them up.+ -}+gitAnnexTmpWorkDir :: FilePath -> FilePath+gitAnnexTmpWorkDir p =+	let (dir, f) = splitFileName p+	-- Using a prefix avoids name conflict with any other keys.+	in dir </> "work." ++ f  {- .git/annex/bad/ is used for bad files found during fsck -} gitAnnexBadDir :: Git.Repo -> FilePath

@@ -76,7 +76,7 @@  initRepo' :: Maybe String -> Maybe StandardGroup -> Annex () initRepo' desc mgroup = unlessM isInitialized $ do-	initialize desc Nothing+	initialize (AutoInit False) desc Nothing 	u <- getUUID 	maybe noop (defaultStandardGroup u) mgroup 	{- Ensure branch gets committed right away so it is

@@ -5,6 +5,7 @@  - Licensed under the GNU GPL version 3 or higher.  -} +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} {-# LANGUAGE CPP #-}  module Annex.Notification (NotifyWitness, noNotification, notifyTransfer, notifyDrop) where@@ -28,26 +29,28 @@ {- 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 -> AssociatedFile -> (NotifyWitness -> Annex Bool) -> Annex Bool-notifyTransfer _ (AssociatedFile Nothing) a = a NotifyWitness+notifyTransfer :: Transferrable t => Observable v => Direction -> t -> (NotifyWitness -> Annex v) -> Annex v #ifdef WITH_DBUS_NOTIFICATIONS-notifyTransfer direction (AssociatedFile (Just f)) a = do-	wanted <- Annex.getState Annex.desktopnotify-	if (notifyStart wanted || notifyFinish wanted)-		then do-			client <- liftIO DBus.Client.connectSession-			startnotification <- liftIO $ if notifyStart wanted-				then Just <$> Notify.notify client (startedTransferNote direction f)-				else pure Nothing-			ok <- a NotifyWitness-			when (notifyFinish wanted) $ liftIO $ void $ maybe -				(Notify.notify client $ finishedTransferNote ok direction f)-				(\n -> Notify.replace client n $ finishedTransferNote ok direction f)-				startnotification-			return ok-		else a NotifyWitness+notifyTransfer direction t a = case descTransfrerrable t of+	Nothing -> a NotifyWitness+	Just desc -> do+		wanted <- Annex.getState Annex.desktopnotify+		if (notifyStart wanted || notifyFinish wanted)+			then do+				client <- liftIO DBus.Client.connectSession+				startnotification <- liftIO $ if notifyStart wanted+					then Just <$> Notify.notify client (startedTransferNote direction desc)+					else pure Nothing+				res <- a NotifyWitness+				let ok = observeBool res+				when (notifyFinish wanted) $ liftIO $ void $ maybe +					(Notify.notify client $ finishedTransferNote ok direction desc)+					(\n -> Notify.replace client n $ finishedTransferNote ok direction desc)+					startnotification+				return res+			else a NotifyWitness #else-notifyTransfer _ (AssociatedFile (Just _)) a = a NotifyWitness+notifyTransfer _ _ a = a NotifyWitness #endif  notifyDrop :: AssociatedFile -> Bool -> Annex ()@@ -63,13 +66,13 @@ #endif  #ifdef WITH_DBUS_NOTIFICATIONS-startedTransferNote :: Direction -> FilePath -> Notify.Note+startedTransferNote :: Direction -> String -> Notify.Note startedTransferNote Upload   = mkNote Notify.Transfer Notify.Low iconUpload 	"Uploading" startedTransferNote Download = mkNote Notify.Transfer Notify.Low iconDownload 	"Downloading" -finishedTransferNote :: Bool -> Direction -> FilePath -> Notify.Note+finishedTransferNote :: Bool -> Direction -> String -> Notify.Note finishedTransferNote False Upload   = mkNote Notify.TransferError Notify.Normal iconFailure 	"Failed to upload" finishedTransferNote False Download = mkNote Notify.TransferError Notify.Normal iconFailure@@ -79,7 +82,7 @@ finishedTransferNote True  Download = mkNote Notify.TransferComplete Notify.Low iconSuccess 	"Finished downloading" -droppedNote :: Bool -> FilePath -> Notify.Note+droppedNote :: Bool -> String -> Notify.Note droppedNote False = mkNote Notify.TransferError Notify.Normal iconFailure 	"Failed to drop" droppedNote True  = mkNote Notify.TransferComplete Notify.Low iconSuccess

@@ -121,24 +121,21 @@ verifyEnoughCopiesToDrop nolocmsg key removallock need skip preverified tocheck dropaction nodropaction =  	helper [] [] preverified (nub tocheck)   where-	helper bad missing have [] = do-		p <- liftIO $ mkSafeDropProof need have removallock-		case p of+	helper bad missing have [] =+		liftIO (mkSafeDropProof need have removallock) >>= \case 			Right proof -> dropaction proof 			Left stillhave -> do 				notEnoughCopies key need stillhave (skip++missing) bad nolocmsg 				nodropaction 	helper bad missing have (c:cs)-		| isSafeDrop need have removallock = do-			p <- liftIO $ mkSafeDropProof need have removallock-			case p of+		| isSafeDrop need have removallock =+			liftIO (mkSafeDropProof need have removallock) >>= \case 				Right proof -> dropaction proof 				Left stillhave -> helper bad missing stillhave (c:cs) 		| otherwise = case c of 			UnVerifiedHere -> lockContentShared key contverified-			UnVerifiedRemote r -> checkremote r contverified $ do-				haskey <- Remote.hasKey r key-				case haskey of+			UnVerifiedRemote r -> checkremote r contverified $+				Remote.hasKey r key >>= \case 					Right True  -> helper bad missing (mkVerifiedCopy RecentlyVerifiedCopy r : have) cs 					Left _      -> helper (r:bad) missing have cs 					Right False -> helper bad (Remote.uuid r:missing) have cs

@@ -111,9 +111,8 @@ 	go GroupShared = want [ownerWriteMode, groupWriteMode] 	go AllShared = want writeModes 	go _ = return True-	want wantmode = do-		mmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file-		return $ case mmode of+	want wantmode =+		liftIO (catchMaybeIO $ fileMode <$> getFileStatus file) >>= return . \case 			Nothing -> True 			Just havemode -> havemode == combineModes (havemode:wantmode) 

@@ -1,33 +0,0 @@-{- quvi options for git-annex- -- - Copyright 2013 Joey Hess <id@joeyh.name>- -- - Licensed under the GNU GPL version 3 or higher.- -}--{-# LANGUAGE Rank2Types #-}--module Annex.Quvi where--import Annex.Common-import qualified Annex-import Utility.Quvi-import Utility.Url--withQuviOptions :: forall a. Query a -> [QuviParams] -> URLString -> Annex a-withQuviOptions a ps url = do-	v <- quviVersion-	opts <- map Param . annexQuviOptions <$> Annex.getGitConfig-	liftIO $ a v (concatMap (\mkp -> mkp v) ps ++ opts) url--quviSupported :: URLString -> Annex Bool-quviSupported u = liftIO . flip supported u =<< quviVersion--quviVersion :: Annex QuviVersion-quviVersion = go =<< Annex.getState Annex.quviversion-  where-	go (Just v) = return v-	go Nothing = do-		v <- liftIO probeVersion-		Annex.changeState $ \s -> s { Annex.quviversion = Just v }-		return v

@@ -81,8 +81,7 @@ 			(Just name, Right t) -> whenM (canenable u) $ do 				showSideAction $ "Auto enabling special remote " ++ name 				dummycfg <- liftIO dummyRemoteGitConfig-				res <- tryNonAsync $ setup t (Enable c) (Just u) Nothing c dummycfg-				case res of+				tryNonAsync (setup t (Enable c) (Just u) Nothing c dummycfg) >>= \case 					Left e -> warning (show e) 					Right _ -> return () 			_ -> return ()

@@ -101,9 +101,8 @@ sshCachingInfo (host, port) = go =<< sshCacheDir   where 	go Nothing = return (Nothing, [])-	go (Just dir) = do-		r <- liftIO $ bestSocketPath $ dir </> hostport2socket host port-		return $ case r of+	go (Just dir) =+		liftIO (bestSocketPath $ dir </> hostport2socket host port) >>= return . \case 			Nothing -> (Nothing, []) 			Just socketfile -> (Just socketfile, sshConnectionCachingParams socketfile) @@ -190,8 +189,7 @@ 	liftIO $ createDirectoryIfMissing True $ parentDir socketfile 	let socketlock = socket2lock socketfile -	c <- Annex.getState Annex.concurrency-	case c of+	Annex.getState Annex.concurrency >>= \case 		Concurrent {} 			| annexUUID (remoteGitConfig gc) /= NoUUID -> 				makeconnection socketlock@@ -267,8 +265,7 @@ 		let lockfile = socket2lock socketfile 		unlockFile lockfile 		mode <- annexFileMode-		v <- noUmask mode $ tryLockExclusive (Just mode) lockfile-		case v of+		noUmask mode (tryLockExclusive (Just mode) lockfile) >>= \case 			Nothing -> noop 			Just lck -> do 				forceStopSsh socketfile

@@ -5,7 +5,7 @@  - Licensed under the GNU GPL version 3 or higher.  -} -{-# LANGUAGE CPP, FlexibleInstances, BangPatterns #-}+{-# LANGUAGE CPP, BangPatterns #-}  module Annex.Transfer ( 	module X,@@ -27,7 +27,6 @@ import Utility.Metered import Annex.LockPool import Types.Key-import Types.Remote (Verification(..)) import qualified Types.Remote as Remote import Types.Concurrency @@ -35,23 +34,6 @@ import qualified Data.Map.Strict as M import Data.Ord -class Observable a where-	observeBool :: a -> Bool-	observeFailure :: a--instance Observable Bool where-	observeBool = id-	observeFailure = False--instance Observable (Bool, Verification) where-	observeBool = fst-	observeFailure = (False, UnVerified)--instance Observable (Either e Bool) where-	observeBool (Left _) = False-	observeBool (Right b) = b-	observeFailure = Right False- upload :: Observable v => UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex v) -> NotifyWitness -> Annex v upload u key f d a _witness = guardHaveUUID u $  	runTransfer (Transfer Upload u key) f d a@@ -110,8 +92,7 @@ 	prep tfile mode info = catchPermissionDenied (const prepfailed) $ do 		let lck = transferLockFile tfile 		createAnnexDirectory $ takeDirectory lck-		r <- tryLockExclusive (Just mode) lck-		case r of+		tryLockExclusive (Just mode) lck >>= \case 			Nothing -> return (Nothing, True) 			Just lockhandle -> ifM (checkSaneLock lck lockhandle) 				( do@@ -126,8 +107,7 @@ 	prep tfile _mode info = catchPermissionDenied (const prepfailed) $ do 		let lck = transferLockFile tfile 		createAnnexDirectory $ takeDirectory lck-		v <- catchMaybeIO $ liftIO $ lockExclusive lck-		case v of+		catchMaybeIO (liftIO $ lockExclusive lck) >>= \case 			Nothing -> return (Nothing, False) 			Just Nothing -> return (Nothing, True) 			Just (Just lockhandle) -> do@@ -153,17 +133,15 @@ 		dropLock lockhandle 		void $ tryIO $ removeFile lck #endif-	retry oldinfo metervar run = do-		v <- tryNonAsync run-		case v of-			Right b -> return b-			Left e -> do-				warning (show e)-				b <- getbytescomplete metervar-				let newinfo = oldinfo { bytesComplete = Just b }-				if shouldretry oldinfo newinfo-					then retry newinfo metervar run-					else return observeFailure+	retry oldinfo metervar run = tryNonAsync run >>= \case+		Right b -> return b+		Left e -> do+			warning (show e)+			b <- getbytescomplete metervar+			let newinfo = oldinfo { bytesComplete = Just b }+			if shouldretry oldinfo newinfo+				then retry newinfo metervar run+				else return observeFailure 	getbytescomplete metervar 		| transferDirection t == Upload = 			liftIO $ readMVar metervar

@@ -31,11 +31,9 @@ 	<*> headers 	<*> options   where-	headers = do-		v <- annexHttpHeadersCommand <$> Annex.getGitConfig-		case v of-			Just cmd -> lines <$> liftIO (readProcess "sh" ["-c", cmd])-			Nothing -> annexHttpHeaders <$> Annex.getGitConfig+	headers = annexHttpHeadersCommand <$> Annex.getGitConfig >>= \case+		Just cmd -> lines <$> liftIO (readProcess "sh" ["-c", cmd])+		Nothing -> annexHttpHeaders <$> Annex.getGitConfig 	options = map Param . annexWebOptions <$> Annex.getGitConfig  withUrlOptions :: (U.UrlOptions -> IO a) -> Annex a

@@ -30,17 +30,15 @@  - looking for a pointer to a key in git.  -} lookupFile :: FilePath -> Annex (Maybe Key)-lookupFile file = do-	mkey <- isAnnexLink file-	case mkey of-		Just key -> makeret key-		Nothing -> ifM (versionSupportsUnlockedPointers <||> isDirect)-			( ifM (liftIO $ doesFileExist file)-				( maybe (return Nothing) makeret =<< catKeyFile file-				, return Nothing-				)-			, return Nothing +lookupFile file = isAnnexLink file >>= \case+	Just key -> makeret key+	Nothing -> ifM (versionSupportsUnlockedPointers <||> isDirect)+		( ifM (liftIO $ doesFileExist file)+			( maybe (return Nothing) makeret =<< catKeyFile file+			, return Nothing 			)+		, return Nothing +		)   where 	makeret = return . Just @@ -84,9 +82,8 @@ 		whenM (inAnnex k) $ do 			f <- fromRepo $ fromTopFilePath tf 			destmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus f-			replaceFile f $ \tmp -> do-				r <- linkFromAnnex k tmp destmode-				case r of+			replaceFile f $ \tmp ->+				linkFromAnnex k tmp destmode >>= \case 					LinkAnnexOk -> return () 					LinkAnnexNoop -> return () 					LinkAnnexFailed -> liftIO $

@@ -0,0 +1,181 @@+{- youtube-dl integration for git-annex+ -+ - Copyright 2017 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Annex.YoutubeDl (+	youtubeDl,+	youtubeDlTo,+	youtubeDlSupported,+	youtubeDlCheck,+	youtubeDlFileName,+) where++import Annex.Common+import qualified Annex+import Annex.Content+import Annex.Url+import Utility.Url (URLString)+import Utility.DiskFree+import Utility.HtmlDetect+import Logs.Transfer++import Network.URI++-- Runs youtube-dl in a work directory, to download a single media file+-- from the url. Reutrns the path to the media file in the work directory.+--+-- If youtube-dl fails without writing any files to the work directory, +-- or is not installed, returns Right Nothing.+--+-- The work directory can contain files from a previous run of youtube-dl+-- and it will resume. It should not contain any other files though,+-- and youtube-dl needs to finish up with only one file in the directory+-- so we know which one it downloaded.+--+-- (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+	| supportedScheme url = ifM (liftIO $ inPath "youtube-dl")+		( runcmd >>= \case+			Right True -> workdirfiles >>= \case+				(f:[]) -> return (Right (Just f))+				[] -> return nofiles+				fs -> return (toomanyfiles fs)+			Right False -> workdirfiles >>= \case+				[] -> return (Right Nothing)+				_ -> return (Left "youtube-dl download is incomplete. Run the command again to resume.")+			Left msg -> return (Left msg)+		, return (Right Nothing)+		)+	| otherwise = return (Right Nothing)+  where+	nofiles = Left "youtube-dl did not put any media in its work directory, perhaps it's been configured to store files somewhere else?"+	toomanyfiles fs = Left $ "youtube-dl downloaded multiple media files; git-annex is only able to deal with one per url: " ++ show fs+	workdirfiles = liftIO $ filterM (doesFileExist) =<< dirContents workdir+	runcmd = youtubeDlMaxSize workdir >>= \case+		Left msg -> return (Left msg)+		Right maxsize -> do+			quiet <- commandProgressDisabled+			opts <- youtubeDlOpts $ dlopts ++ maxsize ++ +				if quiet then [ Param "--quiet" ] else []+			ok <- liftIO $ boolSystem' "youtube-dl" opts $+				\p -> p { cwd = Just workdir }+			return (Right ok)+	dlopts = +		[ Param url+		-- To make youtube-dl only download one file when given a+		-- page with a video and a playlist, download only the video.+		, Param "--no-playlist"+		-- And when given a page with only a playlist, download only+		-- the first video on the playlist. (Assumes the video is+		-- somewhat stable, but this is the only way to prevent+		-- youtube-dl from downloading the whole playlist.)+		, Param "--playlist-items", Param "0"+		]++-- To honor annex.diskreserve, ask youtube-dl to not download too+-- large a media file. Factors in other downloads that are in progress,+-- and any files in the workdir that it may have partially downloaded+-- before.+youtubeDlMaxSize :: FilePath -> Annex (Either String [CommandParam])+youtubeDlMaxSize workdir = ifM (Annex.getState Annex.force)+	( return $ Right []+	, liftIO (getDiskFree workdir) >>= \case+		Just have -> do+			inprogress <- sizeOfDownloadsInProgress (const True)+			partial <- liftIO $ sum +				<$> (mapM getFileSize =<< dirContents workdir)+			reserve <- annexDiskReserve <$> Annex.getGitConfig+			let maxsize = have - reserve - inprogress + partial+			if maxsize > 0+				then return $ Right+					[ Param "--max-filesize"+					, Param (show maxsize)+					]+				else return $ Left $+					needMoreDiskSpace $+						negate maxsize + 1024+		Nothing -> return $ Right []+	)++-- Download a media file to a destination, +youtubeDlTo :: Key -> URLString -> FilePath -> Annex Bool+youtubeDlTo key url dest = do+	res <- withTmpWorkDir key $ \workdir ->+		youtubeDl url workdir >>= \case+			Right (Just mediafile) -> do+				liftIO $ renameFile mediafile dest+				return (Just True)+			Right Nothing -> return (Just False)+			Left msg -> do+				warning msg+				return Nothing+	return (fromMaybe False res)++-- youtube-dl supports downloading urls that are not html pages,+-- but we don't want to use it for such urls, since they can be downloaded+-- without it. So, this first downloads part of the content and checks +-- if it's a html page; only then is youtube-dl used.+htmlOnly :: URLString -> a -> Annex a -> Annex a+htmlOnly url fallback a = do+	uo <- getUrlOptions+	liftIO (downloadPartial url uo htmlPrefixLength) >>= \case+		Just bs | isHtmlBs bs -> a+		_ -> return fallback++youtubeDlSupported :: URLString -> Annex Bool+youtubeDlSupported url = either (const False) id <$> youtubeDlCheck url++-- Check if youtube-dl can find media in an url.+youtubeDlCheck :: URLString -> Annex (Either String Bool)+youtubeDlCheck url+	| supportedScheme url = catchMsgIO $ htmlOnly url False $ do+		opts <- youtubeDlOpts [ Param url, Param "--simulate" ]+		liftIO $ snd <$> processTranscript "youtube-dl" (toCommand opts) Nothing+	| otherwise = return (Right False)++-- Ask youtube-dl for the filename of media in an url.+--+-- (This is not always identical to the filename it uses when downloading.)+youtubeDlFileName :: URLString -> Annex (Either String FilePath)+youtubeDlFileName url+	| supportedScheme url = flip catchIO (pure . Left . show) $+		htmlOnly url nomedia go+	| otherwise = return nomedia+  where+	go = do+		-- Sometimes youtube-dl will fail with an ugly backtrace+		-- (eg, http://bugs.debian.org/874321)+		-- so catch stderr as well as stdout to avoid the user+		-- seeing it. --no-warnings avoids warning messages that+		-- are output to stdout.+		opts <- youtubeDlOpts+			[ Param url+			, Param "--get-filename"+			, Param "--no-warnings"+			]+		(output, ok) <- liftIO $ processTranscript "youtube-dl"+			(toCommand opts) Nothing+		return $ case (ok, lines output) of+			(True, (f:_)) | not (null f) -> Right f+			_ -> nomedia+	nomedia = Left "no media in url"++youtubeDlOpts :: [CommandParam] -> Annex [CommandParam]+youtubeDlOpts addopts = do+	opts <- map Param . annexYoutubeDlOptions <$> Annex.getGitConfig+	return (opts ++ addopts)++supportedScheme :: URLString -> Bool+supportedScheme url = case uriScheme <$> parseURIRelaxed url of+	Nothing -> False+	-- avoid ugly message from youtube-dl about not supporting file:+	Just "file:" -> False+	-- ftp indexes may look like html pages, and there's no point+	-- involving youtube-dl in a ftp download+	Just "ftp:" -> False+	Just _ -> True

@@ -79,17 +79,15 @@ 	go :: Int -> Annex RemoteName 	go n = do 		let fullname = if n == 0  then name else name ++ show n-		r <- Annex.SpecialRemote.findExisting fullname-		case r of+		Annex.SpecialRemote.findExisting fullname >>= \case 			Nothing -> setupSpecialRemote fullname remotetype config mcreds 				(Nothing, R.Init, Annex.SpecialRemote.newConfig fullname) 			Just _ -> go (n + 1)  {- Enables an existing special remote. -} enableSpecialRemote :: SpecialRemoteMaker-enableSpecialRemote name remotetype mcreds config = do-	r <- Annex.SpecialRemote.findExisting name-	case r of+enableSpecialRemote name remotetype mcreds config =+	Annex.SpecialRemote.findExisting name >>= \case 		Nothing -> error $ "Cannot find a special remote named " ++ name 		Just (u, c) -> setupSpecialRemote' False name remotetype config mcreds (Just u, R.Enable c, c) 

@@ -35,9 +35,8 @@  - Named threads are run by a management thread, so if they crash  - an alert is displayed, allowing the thread to be restarted. -} startNamedThread :: UrlRenderer -> NamedThread -> Assistant ()-startNamedThread urlrenderer (NamedThread afterstartupsanitycheck name a) = do-	m <- startedThreads <$> getDaemonStatus-	case M.lookup name m of+startNamedThread urlrenderer (NamedThread afterstartupsanitycheck name a) =+	M.lookup name . startedThreads <$> getDaemonStatus >>= \case 		Nothing -> start 		Just (aid, _) -> do 			r <- liftIO (E.try (poll aid) :: IO (Either E.SomeException (Maybe (Either E.SomeException ()))))@@ -65,24 +64,22 @@ 			a 		void $ forkIO $ manager d aid 		return aid-	manager d aid = do-		r <- E.try (wait aid) :: IO (Either E.SomeException ())-		case r of-			Right _ -> noop-			Left e -> do-				let msg = unwords-					[ fromThreadName $ threadName d-					, "crashed:", show e-					]-				hPutStrLn stderr msg+	manager d aid = (E.try (wait aid) :: IO (Either E.SomeException ())) >>= \case+		Right _ -> noop+		Left e -> do+			let msg = unwords+				[ fromThreadName $ threadName d+				, "crashed:", show e+				]+			hPutStrLn stderr msg #ifdef WITH_WEBAPP-				button <- runAssistant d $ mkAlertButton True-					(T.pack "Restart Thread")-					urlrenderer -					(RestartThreadR name)-				runAssistant d $ void $ addAlert $-					(warningAlert (fromThreadName name) msg)-						{ alertButtons = [button] }+			button <- runAssistant d $ mkAlertButton True+				(T.pack "Restart Thread")+				urlrenderer +				(RestartThreadR name)+			runAssistant d $ void $ addAlert $+				(warningAlert (fromThreadName name) msg)+					{ alertButtons = [button] } #endif  namedThreadId :: NamedThread -> Assistant (Maybe ThreadId)

@@ -52,8 +52,7 @@ genKey :: KeySource -> Maybe Backend -> Annex (Maybe (Key, Backend)) genKey source preferredbackend = do 	b <- maybe defaultBackend return preferredbackend-	r <- B.getKey b source-	return $ case r of+	B.getKey b source >>= return . \case 		Nothing -> Nothing 		Just k -> Just (makesane k, b)   where

@@ -176,9 +176,8 @@ 	 	usehasher hashsize@(HashSize sz) = case shaHasher hashsize filesize of 		Left sha -> use sha-		Right (external, internal) -> do-			v <- liftIO $ externalSHA external sz file-			case v of+		Right (external, internal) ->+			liftIO (externalSHA external sz file) >>= \case 				Right r -> return r 				Left e -> do 					warning e

@@ -81,7 +81,6 @@ 	-- Always enabled now, but users may be used to seeing these flags 	-- listed. 	, "Feeds"-	, "Quvi" 	]  -- Not a complete list, let alone a listing transitive deps, but only

@@ -1,3 +1,28 @@+git-annex (6.20171214) unstable; urgency=medium++  * Use youtube-dl rather than quvi to download media from web pages,+    since quvi is not being actively developed and youtube-dl supports+    many more sites.+  * addurl --relaxed got slower, since youtube-dl has to hit the network+    to check for embedded media. If you relied on --relaxed not hitting the+    network for speed reasons, using --relaxed --raw will get the old level+    of speed, but can't be used for urls with embedded videos.+  * importfeed now downloads things linked to by feeds, even when they are+    not media files.+  * Removed no longer needed dependency on yesod-default.+  * Allow exporttree remotes to be marked as dead.+  * initremote, enableremote: Really support gpg subkeys suffixed with an+    exclamation mark, which forces gpg to use a specific subkey.+    (Previous try had a bug.)+  * lookupkey: Support being given an absolute filename to a file+    within the current git repository.+  * A top-level .noannex file will prevent git-annex init from being used+    in a repository. This is useful for repositories that have a policy+    reason not to use git-annex. The content of the file will be displayed+    to the user who tries to run git-annex init.++ -- Joey Hess <id@joeyh.name>  Thu, 14 Dec 2017 11:50:48 -0400+ git-annex (6.20171124) unstable; urgency=medium    * Display progress meter when uploading a key without size information,

@@ -186,13 +186,11 @@ onlyActionOn :: Key -> CommandStart -> CommandStart onlyActionOn k a = onlyActionOn' k run   where-	run = do-		-- Run whole action, not just start stage, so other threads-		-- block until it's done.-		r <- callCommandAction' a-		case r of-			Nothing -> return Nothing-			Just r' -> return $ Just $ return $ Just $ return r'+	-- Run whole action, not just start stage, so other threads+	-- block until it's done.+	run = callCommandAction' a >>= \case+		Nothing -> return Nothing+		Just r' -> return $ Just $ return $ Just $ return r'  onlyActionOn' :: Key -> Annex a -> Annex a onlyActionOn' k a = go =<< Annex.getState Annex.concurrency

@@ -21,12 +21,10 @@ checkNotReadOnly = checkEnv "GIT_ANNEX_SHELL_READONLY"  checkEnv :: String -> IO ()-checkEnv var = do-	v <- getEnv var-	case v of-		Nothing -> noop-		Just "" -> noop-		Just _ -> giveup $ "Action blocked by " ++ var+checkEnv var = getEnv var >>= \case+	Nothing -> noop+	Just "" -> noop+	Just _ -> giveup $ "Action blocked by " ++ var  checkDirectory :: Maybe FilePath -> IO () checkDirectory mdir = do

@@ -19,14 +19,12 @@ import P2P.Auth  run :: [String] -> IO ()-run (_remotename:address:[]) = forever $ do-	-- gitremote-helpers protocol-	l <- getLine-	case l of+run (_remotename:address:[]) = forever $+	getLine >>= \case 		"capabilities" -> putStrLn "connect" >> ready 		"connect git-upload-pack" -> go UploadPack 		"connect git-receive-pack" -> go ReceivePack-		_ -> error $ "git-remote-helpers protocol error at " ++ show l+		l -> error $ "git-remote-helpers protocol error at " ++ show l   where 	(onionaddress, onionport) 		| '/' `elem` address = parseAddressPort $@@ -59,8 +57,6 @@ 		myuuid <- getUUID 		g <- Annex.gitRepo 		conn <- liftIO $ connectPeer g (TorAnnex address port)-		liftIO $ runNetProto conn $ do-			v <- auth myuuid authtoken-			case v of-				Just _theiruuid -> connect service stdin stdout-				Nothing -> giveup $ "authentication failed, perhaps you need to set " ++ p2pAuthTokenEnv+		liftIO $ runNetProto conn $ auth myuuid authtoken >>= \case+			Just _theiruuid -> connect service stdin stdout+			Nothing -> giveup $ "authentication failed, perhaps you need to set " ++ p2pAuthTokenEnv

@@ -84,8 +84,7 @@ 		(l, cleanup) <- inRepo $ LsTree.lsTree r 		forM_ l $ \i -> do 			let f = getTopFilePath $ LsTree.file i-			v <- catKey (LsTree.sha i)-			case v of+			catKey (LsTree.sha i) >>= \case 				Nothing -> noop 				Just k -> whenM (matcher $ MatchingKey k) $ 					commandAction $ a f k

@@ -68,8 +68,7 @@ {- Undoes noMessages -} allowMessages :: Annex () allowMessages = do-	curr <- Annex.getState Annex.output-	case outputType curr of+	outputType <$> Annex.getState Annex.output >>= \case 		QuietOutput -> Annex.setOutput NormalOutput 		_ -> noop 	Annex.changeState $ \s -> s

@@ -98,31 +98,25 @@ 		)   where 	go = ifAnnexed file addpresent add-	add = do-		ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file-		case ms of-			Nothing -> stop-			Just s -				| not (isRegularFile s) && not (isSymbolicLink s) -> stop-				| otherwise -> do-					showStart "add" file-					next $ if isSymbolicLink s-						then next $ addFile file-						else perform file+	add = liftIO (catchMaybeIO $ getSymbolicLinkStatus file) >>= \case+		Nothing -> stop+		Just s +			| not (isRegularFile s) && not (isSymbolicLink s) -> stop+			| otherwise -> do+				showStart "add" file+				next $ if isSymbolicLink s+					then next $ addFile file+					else perform file 	addpresent key = ifM versionSupportsUnlockedPointers-		( do-			ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file-			case ms of-				Just s | isSymbolicLink s -> fixuplink key-				_ -> ifM (sameInodeCache file =<< Database.Keys.getInodeCaches key)-						( stop, add )+		( liftIO (catchMaybeIO $ getSymbolicLinkStatus file) >>= \case+			Just s | isSymbolicLink s -> fixuplink key+			_ -> ifM (sameInodeCache file =<< Database.Keys.getInodeCaches key)+				( stop, add ) 		, ifM isDirect-			( do-				ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file-				case ms of-					Just s | isSymbolicLink s -> fixuplink key-					_ -> ifM (goodContent key file)-						( stop , add )+			( liftIO (catchMaybeIO $ getSymbolicLinkStatus file) >>= \case+				Just s | isSymbolicLink s -> fixuplink key+				_ -> ifM (goodContent key file)+					( stop , add ) 			, fixuplink key 			) 		)

@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2011-2014 Joey Hess <id@joeyh.name>+ - Copyright 2011-2017 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -21,6 +21,7 @@ import Annex.Ingest import Annex.CheckIgnore import Annex.UUID+import Annex.YoutubeDl import Logs.Web import Types.KeySource import Types.UrlContents@@ -28,9 +29,8 @@ import Logs.Location import Utility.Metered import Utility.FileSystemEncoding+import Utility.HtmlDetect import qualified Annex.Transfer as Transfer-import Annex.Quvi-import qualified Utility.Quvi as Quvi  cmd :: Command cmd = notBareRepo $ withGlobalOptions [jobsOption, jsonOption, jsonProgressOption] $@@ -39,23 +39,23 @@  data AddUrlOptions = AddUrlOptions 	{ addUrls :: CmdParams-	, fileOption :: Maybe FilePath 	, pathdepthOption :: Maybe Int 	, prefixOption :: Maybe String 	, suffixOption :: Maybe String-	, relaxedOption :: Bool-	, rawOption :: Bool+	, downloadOptions :: DownloadOptions 	, batchOption :: BatchMode 	, batchFilesOption :: Bool 	} +data DownloadOptions = DownloadOptions+	{ relaxedOption :: Bool+	, rawOption :: Bool+	, fileOption :: Maybe FilePath+	}+ optParser :: CmdParamsDesc -> Parser AddUrlOptions optParser desc = AddUrlOptions 	<$> cmdParams desc-	<*> optional (strOption-		( long "file" <> metavar paramFile-		<> help "specify what file the url is added to"-		)) 	<*> optional (option auto 		( long "pathdepth" <> metavar paramNumber 		<> help "number of url path components to use in filename"@@ -68,25 +68,29 @@ 		( long "suffix" <> metavar paramValue 		<> help "add a suffix to the filename" 		))-	<*> parseRelaxedOption-	<*> parseRawOption+	<*> parseDownloadOptions True 	<*> parseBatchOption 	<*> switch 		( long "with-files" 		<> help "parse batch mode lines of the form \"$url $file\"" 		) -parseRelaxedOption :: Parser Bool-parseRelaxedOption = switch-	( long "relaxed"-	<> help "skip size check"-	)--parseRawOption :: Parser Bool-parseRawOption = switch-	( long "raw"-	<> help "disable special handling for torrents, quvi, etc"-	)+parseDownloadOptions :: Bool -> Parser DownloadOptions+parseDownloadOptions withfileoption = DownloadOptions+	<$> switch+		( long "relaxed"+		<> help "skip size check"+		)+	<*> switch+		( long "raw"+		<> help "disable special handling for torrents, youtube-dl, etc"+		)+	<*> if withfileoption+		then optional (strOption+			( long "file" <> metavar paramFile+			<> help "specify what file the url is added to"+			))+		else pure Nothing  seek :: AddUrlOptions -> CommandSeek seek o = allowConcurrentOutput $ do@@ -97,7 +101,7 @@   where 	go (o', u) = do 		r <- Remote.claimingUrl u-		if Remote.uuid r == webUUID || rawOption o'+		if Remote.uuid r == webUUID || rawOption (downloadOptions o') 			then void $ commandAction $ startWeb o' u 			else checkUrl r o' u @@ -107,13 +111,13 @@ 		let (u, f) = separate (== ' ') s 		in if null u || null f 			then Left ("parsed empty url or filename in input: " ++ s)-			else Right (o { fileOption = Just f }, u)+			else Right (o { downloadOptions = (downloadOptions o) { fileOption = Just f } }, u) 	| otherwise = Right (o, s)  checkUrl :: Remote -> AddUrlOptions -> URLString -> Annex () checkUrl r o u = do 	pathmax <- liftIO $ fileNameLengthLimit "."-	let deffile = fromMaybe (urlString2file u (pathdepthOption o) pathmax) (fileOption o)+	let deffile = fromMaybe (urlString2file u (pathdepthOption o) pathmax) (fileOption (downloadOptions o)) 	go deffile =<< maybe 		(error $ "unable to checkUrl of " ++ Remote.name r) 		(tryNonAsync . flip id u)@@ -121,50 +125,50 @@   where  	go _ (Left e) = void $ commandAction $ do-		showStart "addurl" u+		showStart' "addurl" (Just u) 		warning (show e) 		next $ next $ return False 	go deffile (Right (UrlContents sz mf)) = do-		let f = adjustFile o (fromMaybe (maybe deffile fromSafeFilePath mf) (fileOption o))-		void $ commandAction $-			startRemote r (relaxedOption o) f u sz+		let f = adjustFile o (fromMaybe (maybe deffile fromSafeFilePath mf) (fileOption (downloadOptions o)))+		void $ commandAction $ startRemote r o f u sz 	go deffile (Right (UrlMulti l))-		| isNothing (fileOption o) =+		| isNothing (fileOption (downloadOptions o)) = 			forM_ l $ \(u', sz, f) -> do 				let f' = adjustFile o (deffile </> fromSafeFilePath f) 				void $ commandAction $-					startRemote r (relaxedOption o) f' u' sz+					startRemote r o f' u' sz 		| otherwise = giveup $ unwords 			[ "That url contains multiple files according to the" 			, Remote.name r 			, " remote; cannot add it to a single file." 			] -startRemote :: Remote -> Bool -> FilePath -> URLString -> Maybe Integer -> CommandStart-startRemote r relaxed file uri sz = do+startRemote :: Remote -> AddUrlOptions -> FilePath -> URLString -> Maybe Integer -> CommandStart+startRemote r o file uri sz = do 	pathmax <- liftIO $ fileNameLengthLimit "." 	let file' = joinPath $ map (truncateFilePath pathmax) $ splitDirectories file-	showStart "addurl" file'+	showStart' "addurl" (Just uri) 	showNote $ "from " ++ Remote.name r -	next $ performRemote r relaxed uri file' sz+	showDestinationFile file'+	next $ performRemote r o uri file' sz -performRemote :: Remote -> Bool -> URLString -> FilePath -> Maybe Integer -> CommandPerform-performRemote r relaxed uri file sz = ifAnnexed file adduri geturi+performRemote :: Remote -> AddUrlOptions -> URLString -> FilePath -> Maybe Integer -> CommandPerform+performRemote r o uri file sz = ifAnnexed file adduri geturi   where 	loguri = setDownloader uri OtherDownloader-	adduri = addUrlChecked relaxed loguri (Remote.uuid r) checkexistssize+	adduri = addUrlChecked o loguri file (Remote.uuid r) checkexistssize 	checkexistssize key = return $ case sz of-		Nothing -> (True, True)-		Just n -> (True, n == fromMaybe n (keySize key))-	geturi = next $ isJust <$> downloadRemoteFile r relaxed uri file sz+		Nothing -> (True, True, loguri)+		Just n -> (True, n == fromMaybe n (keySize key), loguri)+	geturi = next $ isJust <$> downloadRemoteFile r (downloadOptions o) uri file sz -downloadRemoteFile :: Remote -> Bool -> URLString -> FilePath -> Maybe Integer -> Annex (Maybe Key)-downloadRemoteFile r relaxed uri file sz = checkCanAdd file $ do+downloadRemoteFile :: Remote -> DownloadOptions -> URLString -> FilePath -> Maybe Integer -> Annex (Maybe Key)+downloadRemoteFile r o uri file sz = checkCanAdd file $ do 	let urlkey = Backend.URL.fromUrl uri sz 	liftIO $ createDirectoryIfMissing True (parentDir file)-	ifM (Annex.getState Annex.fast <||> pure relaxed)+	ifM (Annex.getState Annex.fast <||> pure (relaxedOption o)) 		( do-			cleanup (Remote.uuid r) loguri file urlkey Nothing+			addWorkTree (Remote.uuid r) loguri file urlkey Nothing 			return (Just urlkey) 		, do 			-- Set temporary url for the urlkey@@ -181,24 +185,18 @@   where 	loguri = setDownloader uri OtherDownloader -startWeb :: AddUrlOptions -> String -> CommandStart-startWeb o s = go $ fromMaybe bad $ parseURI urlstring+startWeb :: AddUrlOptions -> URLString -> CommandStart+startWeb o urlstring = go $ fromMaybe bad $ parseURI urlstring   where-	(urlstring, downloader) = getDownloader s 	bad = fromMaybe (giveup $ "bad url " ++ urlstring) $ 		Url.parseURIRelaxed $ urlstring-	go url = case downloader of-		QuviDownloader -> usequvi-		_ -> ifM (quviSupported urlstring)-			( usequvi-			, regulardownload url-			)-	regulardownload url = do+	go url = do+		showStart' "addurl" (Just urlstring) 		pathmax <- liftIO $ fileNameLengthLimit "."-		urlinfo <- if relaxedOption o+		urlinfo <- if relaxedOption (downloadOptions o) 			then pure Url.assumeUrlExists 			else Url.withUrlOptions (Url.getUrlInfo urlstring)-		file <- adjustFile o <$> case fileOption o of+		file <- adjustFile o <$> case fileOption (downloadOptions o) of 			Just f -> pure f 			Nothing -> case Url.urlSuggestedFile urlinfo of 				Nothing -> pure $ url2file url (pathdepthOption o) pathmax@@ -209,79 +207,31 @@ 						( pure $ url2file url (pathdepthOption o) pathmax 						, pure f 						)-		showStart "addurl" file-		next $ performWeb (relaxedOption o) urlstring file urlinfo-	badquvi = giveup $ "quvi does not know how to download url " ++ urlstring-	usequvi = do-		page <- fromMaybe badquvi-			<$> withQuviOptions Quvi.forceQuery [Quvi.quiet, Quvi.httponly] urlstring-		let link = fromMaybe badquvi $ headMaybe $ Quvi.pageLinks page-		pathmax <- liftIO $ fileNameLengthLimit "."-		let file = adjustFile o $ flip fromMaybe (fileOption o) $-			truncateFilePath pathmax $ sanitizeFilePath $-				Quvi.pageTitle page ++ "." ++ fromMaybe "m" (Quvi.linkSuffix link)-		showStart "addurl" file-		next $ performQuvi (relaxedOption o) urlstring (Quvi.linkUrl link) file--performWeb :: Bool -> URLString -> FilePath -> Url.UrlInfo -> CommandPerform-performWeb relaxed url file urlinfo = ifAnnexed file addurl geturl-  where-	geturl = next $ isJust <$> addUrlFile relaxed url urlinfo file-	addurl = addUrlChecked relaxed url webUUID $ \k -> return $-		(Url.urlExists urlinfo, Url.urlSize urlinfo == keySize k)+		next $ performWeb o urlstring file urlinfo -performQuvi :: Bool -> URLString -> URLString -> FilePath -> CommandPerform-performQuvi relaxed pageurl videourl file = ifAnnexed file addurl geturl+performWeb :: AddUrlOptions -> URLString -> FilePath -> Url.UrlInfo -> CommandPerform+performWeb o url file urlinfo = ifAnnexed file addurl geturl   where-	quviurl = setDownloader pageurl QuviDownloader-	addurl key = next $ do-		cleanup webUUID quviurl file key Nothing-		return True-	geturl = next $ isJust <$> addUrlFileQuvi relaxed quviurl videourl file+	geturl = next $ isJust <$> addUrlFile (downloadOptions o) url urlinfo file+	addurl = addUrlChecked o url file webUUID $ \k -> +		ifM (pure (not (rawOption (downloadOptions o))) <&&> youtubeDlSupported url)+			( return (True, True, setDownloader url YoutubeDownloader)+			, return (Url.urlExists urlinfo, Url.urlSize urlinfo == keySize k, url)+			) -addUrlFileQuvi :: Bool -> URLString -> URLString -> FilePath -> Annex (Maybe Key)-addUrlFileQuvi relaxed quviurl videourl file = checkCanAdd file $ do-	let key = Backend.URL.fromUrl quviurl Nothing-	ifM (pure relaxed <||> Annex.getState Annex.fast)+{- Check that the url exists, and has the same size as the key,+ - and add it as an url to the key. -}+addUrlChecked :: AddUrlOptions -> URLString -> FilePath -> UUID -> (Key -> Annex (Bool, Bool, URLString)) -> Key -> CommandPerform+addUrlChecked o url file u checkexistssize key =+	ifM ((elem url <$> getUrls key) <&&> (elem u <$> loggedLocations key)) 		( do-			cleanup webUUID quviurl file key Nothing-			return (Just key)-		, do-			{- Get the size, and use that to check-			 - disk space. However, the size info is not-			 - retained, because the size of a video stream-			 - might change and we want to be able to download-			 - it later. -}-			urlinfo <- Url.withUrlOptions (Url.getUrlInfo videourl)-			let sizedkey = addSizeUrlKey urlinfo key-			checkDiskSpaceToGet sizedkey Nothing $ do-				tmp <- fromRepo $ gitAnnexTmpObjectLocation key-				showOutput-				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-					then do-						cleanup webUUID quviurl file key (Just tmp)-						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-	| relaxed = do-		setUrlPresent u key url-		next $ return True-	| otherwise = ifM ((elem url <$> getUrls key) <&&> (elem u <$> loggedLocations key))-		( next $ return True -- nothing to do+			showDestinationFile file+			next $ return True 		, do-			(exists, samesize) <- checkexistssize key-			if exists && samesize+			(exists, samesize, url') <- checkexistssize key+			if exists && (samesize || relaxedOption (downloadOptions o)) 				then do-					setUrlPresent u key url+					setUrlPresent u key url' 					next $ return True 				else do 					warning $ "while adding a new url to an already annexed file, " ++ if exists@@ -290,64 +240,120 @@ 					stop 		) -addUrlFile :: Bool -> URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key)-addUrlFile relaxed url urlinfo file = checkCanAdd file $ do-	liftIO $ createDirectoryIfMissing True (parentDir file)-	ifM (Annex.getState Annex.fast <||> pure relaxed)-		( nodownload url urlinfo file-		, downloadWeb url urlinfo file+{- Downloads an url (except in fast or relaxed mode) and adds it to the+ - repository, normally at the specified FilePath. + - But, if youtube-dl supports the url, it will be written to a+ - different file, based on the title of the media. Unless the user+ - specified fileOption, which then forces using the FilePath.+ -}+addUrlFile :: DownloadOptions -> URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key)+addUrlFile o url urlinfo file =+	ifM (Annex.getState Annex.fast <||> pure (relaxedOption o))+		( nodownloadWeb o url urlinfo file+		, downloadWeb o url urlinfo file 		) -downloadWeb :: URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key)-downloadWeb url urlinfo file = do-	let dummykey = addSizeUrlKey urlinfo $ Backend.URL.fromUrl url Nothing-	let downloader f p = do+downloadWeb :: DownloadOptions -> URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key)+downloadWeb o url urlinfo file =+	go =<< downloadWith' downloader urlkey webUUID url (AssociatedFile (Just file))+  where+	urlkey = addSizeUrlKey urlinfo $ Backend.URL.fromUrl url Nothing+	downloader f p = do 		showOutput-		downloadUrl dummykey p [url] f-	showAction $ "downloading " ++ url ++ " "-	downloadWith downloader dummykey webUUID url file+		downloadUrl urlkey p [url] f+	go Nothing = return Nothing+	-- If we downloaded a html file, try to use youtube-dl to+	-- extract embedded media.+	go (Just tmp) = ifM (pure (not (rawOption o)) <&&> liftIO (isHtml <$> readFile tmp))+		( tryyoutubedl tmp+		, normalfinish tmp+		)+	normalfinish tmp = checkCanAdd file $ do+		showDestinationFile file+		liftIO $ createDirectoryIfMissing True (parentDir file)+		finishDownloadWith tmp webUUID url file+	tryyoutubedl tmp = withTmpWorkDir mediakey $ \workdir ->+		Transfer.notifyTransfer Transfer.Download url $+			Transfer.download webUUID mediakey (AssociatedFile Nothing) Transfer.noRetry $ \_p ->+				youtubeDl url workdir >>= \case+					Right (Just mediafile) -> do+						pruneTmpWorkDirBefore tmp (liftIO . nukeFile)+						let dest = if isJust (fileOption o)+							then file+							else takeFileName mediafile+						checkCanAdd dest $ do+							showDestinationFile dest+							addWorkTree webUUID mediaurl dest mediakey (Just mediafile)+							return $ Just mediakey+					Right Nothing -> normalfinish tmp+					Left msg -> do+						warning msg+						return Nothing+	  where+		mediaurl = setDownloader url YoutubeDownloader+		mediakey = Backend.URL.fromUrl mediaurl Nothing +showDestinationFile :: FilePath -> Annex ()+showDestinationFile file = do+	showNote ("to " ++ file)+	maybeShowJSON $ JSONChunk [("file", file)]+ {- The Key should be a dummy key, based on the URL, which is used  - for this download, before we can examine the file and find its real key.  - For resuming downloads to work, the dummy key for a given url should be- - stable. -}+ - stable. For disk space checking to work, the dummy key should have+ - the size of the url already set.+ -+ - Downloads the url, sets up the worktree file, and returns the+ - real key.+ -} downloadWith :: (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> FilePath -> Annex (Maybe Key) downloadWith downloader dummykey u url file =-	checkDiskSpaceToGet dummykey Nothing $ do-		tmp <- fromRepo $ gitAnnexTmpObjectLocation dummykey-		ifM (runtransfer tmp)-			( do-				backend <- chooseBackend file-				let source = KeySource-					{ keyFilename = file-					, contentLocation = tmp-					, inodeCache = Nothing-					}-				k <- genKey source backend-				case k of-					Nothing -> return Nothing-					Just (key, _) -> do-						cleanup u url file key (Just tmp)-						return (Just key)-			, return Nothing-			)+	go =<< downloadWith' downloader dummykey u url afile   where-	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)+	go Nothing = return Nothing+	go (Just tmp) = finishDownloadWith tmp u url file +{- Like downloadWith, but leaves the dummy key content in+ - the returned location. -}+downloadWith' :: (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> AssociatedFile -> Annex (Maybe FilePath)+downloadWith' downloader dummykey u url afile =+	checkDiskSpaceToGet dummykey Nothing $ do+		tmp <- fromRepo $ gitAnnexTmpObjectLocation dummykey+		ok <- Transfer.notifyTransfer Transfer.Download url $+			Transfer.download u dummykey afile Transfer.forwardRetry $ \p -> do+				liftIO $ createDirectoryIfMissing True (parentDir tmp)+				downloader tmp p+		if ok+			then return (Just tmp)+			else return Nothing++finishDownloadWith :: FilePath -> UUID -> URLString -> FilePath -> Annex (Maybe Key)+finishDownloadWith tmp u url file = do+	backend <- chooseBackend file+	let source = KeySource+		{ keyFilename = file+		, contentLocation = tmp+		, inodeCache = Nothing+		}+	genKey source backend >>= \case+		Nothing -> return Nothing+		Just (key, _) -> do+			addWorkTree u url file key (Just tmp)+			return (Just key)+ {- Adds the url size to the Key. -} addSizeUrlKey :: Url.UrlInfo -> Key -> Key addSizeUrlKey urlinfo key = key { keySize = Url.urlSize urlinfo } -cleanup :: UUID -> URLString -> FilePath -> Key -> Maybe FilePath -> Annex ()-cleanup u url file key mtmp = case mtmp of+{- Adds worktree file to the repository. -}+addWorkTree :: UUID -> URLString -> FilePath -> Key -> Maybe FilePath -> Annex ()+addWorkTree u url file key mtmp = case mtmp of 	Nothing -> go 	Just tmp -> do 		-- Move to final location for large file check.-		liftIO $ renameFile tmp file+		pruneTmpWorkDirBefore tmp (\_ -> liftIO $ renameFile tmp file) 		largematcher <- largeFilesMatcher 		large <- checkFileMatcher largematcher file 		if large@@ -366,19 +372,37 @@ 			( do 				when (isJust mtmp) $ 					logStatus key InfoPresent-			, liftIO $ maybe noop nukeFile mtmp+			, maybe noop (\tmp -> pruneTmpWorkDirBefore tmp (liftIO . nukeFile)) mtmp 			) -nodownload :: URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key)-nodownload url urlinfo file-	| Url.urlExists urlinfo = do-		let key = Backend.URL.fromUrl url (Url.urlSize urlinfo)-		cleanup webUUID url file key Nothing-		return (Just key)+nodownloadWeb :: DownloadOptions -> URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key)+nodownloadWeb o url urlinfo file+	| Url.urlExists urlinfo = if rawOption o+		then nomedia+		else either (const nomedia) usemedia+			=<< youtubeDlFileName url 	| otherwise = do 		warning $ "unable to access url: " ++ url 		return Nothing+  where+	nomedia = do+		let key = Backend.URL.fromUrl url (Url.urlSize urlinfo)+		nodownloadWeb' url key file+	usemedia mediafile = do+		let dest = if isJust (fileOption o)+			then file+			else takeFileName mediafile+		let mediaurl = setDownloader url YoutubeDownloader+		let mediakey = Backend.URL.fromUrl mediaurl Nothing+		nodownloadWeb' mediaurl mediakey dest +nodownloadWeb' :: URLString -> Key -> FilePath -> Annex (Maybe Key)+nodownloadWeb' url key file = checkCanAdd file $ do+	showDestinationFile file+	liftIO $ createDirectoryIfMissing True (parentDir file)+	addWorkTree webUUID url file key Nothing+	return (Just key)+ url2file :: URI -> Maybe Int -> Int -> FilePath url2file url pathdepth pathmax = case pathdepth of 	Nothing -> truncateFilePath pathmax $ sanitizeFilePath fullurl@@ -411,7 +435,7 @@ checkCanAdd :: FilePath -> Annex (Maybe a) -> Annex (Maybe a) checkCanAdd file a = ifM (isJust <$> (liftIO $ catchMaybeIO $ getSymbolicLinkStatus file)) 	( do-		warning $ file ++ " already exists and is not annexed; not overwriting"+		warning $ file ++ " already exists; not overwriting" 		return Nothing 	, ifM ((not <$> Annex.getState Annex.force) <&&> checkIgnored file) 		( do

@@ -38,5 +38,5 @@ start :: Adjustment -> CommandStart start adj = do 	checkVersionSupported-	showStart "adjust" ""+	showStart' "adjust" Nothing 	next $ next $ enterAdjustedBranch adj

@@ -19,10 +19,8 @@ 		(batchable run (pure ()))  run :: () -> String -> Annex Bool-run _ file = do-	mkb <- genKey (KeySource file file Nothing) Nothing-	case mkb of-		Just (k, _) -> do-			liftIO $ putStrLn $ key2file k-			return True-		Nothing -> return False+run _ file = genKey (KeySource file file Nothing) Nothing >>= \case+	Just (k, _) -> do+		liftIO $ putStrLn $ key2file k+		return True+	Nothing -> return False

@@ -52,12 +52,10 @@ 	k = toKey ks 	go Nothing [] = return NotPresent 	go (Just e) [] = return $ CheckFailure e-	go olderr (r:rs) = do-		v <- Remote.hasKey r k-		case v of-			Right True -> return Present-			Right False -> go olderr rs-			Left e -> go (Just e) rs+	go olderr (r:rs) = Remote.hasKey r k >>= \case+		Right True -> return Present+		Right False -> go olderr rs+		Left e -> go (Just e) rs  exitResult :: Result -> Annex a exitResult Present = liftIO exitSuccess

@@ -50,21 +50,20 @@ seek :: Action -> CommandSeek seek (SetConfig name val) = commandAction $ do 	allowMessages-	showStart name val+	showStart' name (Just val) 	next $ next $ do 		setGlobalConfig name val 		setConfig (ConfigKey name) val 		return True seek (UnsetConfig name) = commandAction $ do 	allowMessages-	showStart name "unset"+	showStart' name (Just "unset") 	next $ next $ do 		unsetGlobalConfig name 		unsetConfig (ConfigKey name) 		return True-seek (GetConfig name) = commandAction $ do-	mv <- getGlobalConfig name-	case mv of+seek (GetConfig name) = commandAction $+	getGlobalConfig name >>= \case 		Nothing -> stop 		Just v -> do 			liftIO $ putStrLn v

@@ -45,7 +45,7 @@ 		else ifM (Annex.Branch.hasSibling <||> (isJust <$> Fields.getField Fields.autoInit)) 			( do 				liftIO checkNotReadOnly-				initialize Nothing Nothing+				initialize (AutoInit True) Nothing Nothing 				getUUID 			, return NoUUID 			)

@@ -33,9 +33,8 @@  startKey :: Key -> CommandStart startKey key = do-	showStart "dead" (key2file key)-	ls <- keyLocations key-	case ls of+	showStart' "dead" (Just $ key2file key)+	keyLocations key >>= \case 		[] -> next $ performKey key 		_ -> giveup "This key is still known to be present in some locations; not marking as dead." 		

@@ -22,7 +22,7 @@  start :: [String] -> CommandStart start (name:description) = do-	showStart "describe" name+	showStart' "describe" (Just name) 	u <- Remote.nameToUUID name 	next $ perform u $ unwords description start _ = giveup "Specify a repository and a description."	

@@ -31,7 +31,7 @@  perform :: CommandPerform perform = do-	showStart "commit" ""+	showStart' "commit" Nothing 	showOutput 	_ <- inRepo $ Git.Branch.commitCommand Git.Branch.ManualCommit 		[ Param "-a"@@ -47,13 +47,11 @@ 	next cleanup   where 	go = whenAnnexed $ \f k -> do-		r <- toDirectGen k f-		case r of+		toDirectGen k f >>= \case 			Nothing -> noop 			Just a -> do 				showStart "direct" f-				r' <- tryNonAsync a-				case r' of+				tryNonAsync a >>= \case 					Left e -> warnlocked e 					Right _ -> showEndOk 		return Nothing@@ -65,6 +63,6 @@  cleanup :: CommandCleanup cleanup = do-	showStart "direct" ""+	showStart' "direct" Nothing 	setDirect True 	return True

@@ -89,12 +89,12 @@  startLocal :: AssociatedFile -> ActionItem -> NumCopies -> Key -> [VerifiedCopy] -> CommandStart startLocal afile ai numcopies key preverified = stopUnless (inAnnex key) $ do-	showStart' "drop" key ai+	showStartKey "drop" key ai 	next $ performLocal key afile numcopies preverified  startRemote :: AssociatedFile -> ActionItem -> NumCopies -> Key -> Remote -> CommandStart startRemote afile ai numcopies key remote = do-	showStart' ("drop " ++ Remote.name remote) key ai+	showStartKey ("drop " ++ Remote.name remote) key ai 	next $ performRemote key afile numcopies remote  performLocal :: Key -> AssociatedFile -> NumCopies -> [VerifiedCopy] -> CommandPerform

@@ -42,7 +42,7 @@  start :: Key -> CommandStart start key = do-	showStart' "dropkey" key (mkActionItem key)+	showStartKey "dropkey" key (mkActionItem key) 	next $ perform key  perform :: Key -> CommandPerform

@@ -55,5 +55,5 @@ performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform performOther filespec key = do 	f <- fromRepo $ filespec key-	liftIO $ nukeFile f+	pruneTmpWorkDirBefore f (liftIO . nukeFile) 	next $ return True

@@ -55,7 +55,7 @@ startNormalRemote :: Git.RemoteName -> [String] -> Git.Repo -> CommandStart startNormalRemote name restparams r 	| null restparams = do-		showStart "enableremote" name+		showStart' "enableremote" (Just name) 		next $ next $ do 			setRemoteIgnore r False 			r' <- Remote.Git.configRead False r@@ -68,8 +68,7 @@ startSpecialRemote name config Nothing = do 	m <- Annex.SpecialRemote.specialRemoteMap 	confm <- Logs.Remote.readRemoteLog-	v <- Remote.nameToUUID' name-	case v of+	Remote.nameToUUID' name >>= \case 		Right u | u `M.member` m -> 			startSpecialRemote name config $ 				Just (u, fromMaybe M.empty (M.lookup u confm))@@ -77,7 +76,7 @@ startSpecialRemote name config (Just (u, c)) = do 	let fullconfig = config `M.union` c	 	t <- either giveup return (Annex.SpecialRemote.findType fullconfig)-	showStart "enableremote" name+	showStart' "enableremote" (Just name) 	gc <- maybe (liftIO dummyRemoteGitConfig)  		(return . Remote.gitconfig) 		=<< Remote.byUUID u@@ -91,8 +90,7 @@ cleanupSpecialRemote :: UUID -> R.RemoteConfig -> CommandCleanup cleanupSpecialRemote u c = do 	Logs.Remote.configSet u c-	mr <- Remote.byUUID u-	case mr of+	Remote.byUUID u >>= \case 		Nothing -> noop 		Just r -> setRemoteIgnore (R.repo r) False 	return True

@@ -51,7 +51,7 @@ 			Nothing -> giveup "Need user-id parameter." 			Just userid -> go uuid userid 		else do-			showStart "enable-tor" ""+			showStart' "enable-tor" Nothing 			gitannex <- liftIO readProgramFile 			let ps = [Param (cmdname cmd), Param (show curruserid)] 			sucommand <- liftIO $ mkSuCommand gitannex ps@@ -91,8 +91,7 @@ 		g <- Annex.gitRepo 		-- Connect but don't bother trying to auth, 		-- we just want to know if the tor circuit works.-		cv <- liftIO $ tryNonAsync $ connectPeer g addr-		case cv of+		liftIO (tryNonAsync $ connectPeer g addr) >>= \case 			Left e -> do 				warning $ "Unable to connect to hidden service. It may not yet have propigated to the Tor network. (" ++ show e ++ ") Will retry.." 				liftIO $ threadDelaySeconds (Seconds 2)

@@ -59,12 +59,12 @@ start (Expire expire) noact actlog descs u = 	case lastact of 		Just ent | notexpired ent -> checktrust (== DeadTrusted) $ do-			showStart "unexpire" desc+			showStart' "unexpire" (Just desc) 			showNote =<< whenactive 			unless noact $ 				trustSet u SemiTrusted 		_ -> checktrust (/= DeadTrusted) $ do-			showStart "expire" desc+			showStart' "expire" (Just desc) 			showNote =<< whenactive 			unless noact $ 				trustSet u DeadTrusted

@@ -82,8 +82,7 @@ makeHardLink file key = do 	replaceFile file $ \tmp -> do 		mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file-		r <- linkFromAnnex key tmp mode-		case r of+		linkFromAnnex key tmp mode >>= \case 			LinkAnnexFailed -> error "unable to make hard link" 			_ -> noop 	next $ return True

@@ -34,7 +34,7 @@  start :: ForgetOptions -> CommandStart start o = do-	showStart "forget" "git-annex"+	showStart' "forget" (Just "git-annex") 	c <- liftIO currentVectorClock 	let basets = addTransition c ForgetGitHistory noTransitions 	let ts = if dropDead o

@@ -41,7 +41,7 @@  startMass :: CommandStart startMass = do-	showStart "fromkey" "stdin"+	showStart' "fromkey" (Just "stdin") 	next massAdd  massAdd :: CommandPerform

@@ -103,15 +103,13 @@ 		earlyWarning "Warning: Fscking a repository that is currently marked as dead."  start :: Maybe Remote -> Incremental -> FilePath -> Key -> CommandStart-start from inc file key = do-	v <- Backend.getBackend file key-	case v of-		Nothing -> stop-		Just backend -> do-			numcopies <- getFileNumCopies file-			case from of-				Nothing -> go $ perform key file backend numcopies-				Just r -> go $ performRemote key afile backend numcopies r+start from inc file key = Backend.getBackend file key >>= \case+	Nothing -> stop+	Just backend -> do+		numcopies <- getFileNumCopies file+		case from of+			Nothing -> go $ perform key file backend numcopies+			Just r -> go $ performRemote key afile backend numcopies r   where 	go = runFsck inc (mkActionItem afile) key 	afile = AssociatedFile (Just file)@@ -142,9 +140,8 @@ 	dispatch (Left err) = do 		showNote err 		return False-	dispatch (Right True) = withtmp $ \tmpfile -> do-		r <- getfile tmpfile-		case r of+	dispatch (Right True) = withtmp $ \tmpfile ->+		getfile tmpfile >>= \case 			Nothing -> go True Nothing 			Just True -> go True (Just tmpfile) 			Just False -> do@@ -536,7 +533,7 @@ runFsck :: Incremental -> ActionItem -> Key -> Annex Bool -> CommandStart runFsck inc ai key a = ifM (needFsck inc key) 	( do-		showStart' "fsck" key ai+		showStartKey "fsck" key ai 		next $ do 			ok <- a 			when ok $

@@ -71,7 +71,7 @@ 					go $ Command.Move.fromPerform src False key afile   where 	go a = do-		showStart' "get" key ai+		showStartKey "get" key ai 		next a  perform :: Key -> AssociatedFile -> CommandPerform

@@ -24,7 +24,7 @@ start :: [String] -> CommandStart start (name:g:[]) = do 	allowMessages-	showStart "group" name+	showStart' "group" (Just name) 	u <- Remote.nameToUUID name 	next $ setGroup u g start (name:[]) = do

@@ -24,6 +24,6 @@ start (g:[]) = next $ performGet groupPreferredContentMapRaw g start (g:expr:[]) = do 	allowMessages-	showStart "groupwanted" g+	showStart' "groupwanted" (Just g) 	next $ performSet groupPreferredContentSet expr g start _ = giveup "Specify a group."

@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2013 Joey Hess <id@joeyh.name>+ - Copyright 2013-2017 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -32,16 +32,16 @@ import Logs.Web import qualified Utility.Format import Utility.Tmp-import Command.AddUrl (addUrlFile, downloadRemoteFile, parseRelaxedOption, parseRawOption)+import Command.AddUrl (addUrlFile, downloadRemoteFile, parseDownloadOptions, DownloadOptions(..)) import Annex.Perms import Annex.UUID import Backend.URL (fromUrl)-import Annex.Quvi-import qualified Utility.Quvi as Quvi-import Command.AddUrl (addUrlFileQuvi)+import Annex.Content+import Annex.YoutubeDl import Types.MetaData import Logs.MetaData import Annex.MetaData+import Command.AddUrl (addWorkTree)  cmd :: Command cmd = notBareRepo $@@ -51,8 +51,7 @@ data ImportFeedOptions = ImportFeedOptions 	{ feedUrls :: CmdParams 	, templateOption :: Maybe String-	, relaxedOption :: Bool-	, rawOption :: Bool+	, downloadOptions :: DownloadOptions 	}  optParser :: CmdParamsDesc -> Parser ImportFeedOptions@@ -62,8 +61,7 @@ 		( long "template" <> metavar paramFormat 		<> help "template for filenames" 		))-	<*> parseRelaxedOption-	<*> parseRawOption+	<*> parseDownloadOptions False  seek :: ImportFeedOptions -> CommandSeek seek o = do@@ -72,7 +70,7 @@  start :: ImportFeedOptions -> Cache -> URLString -> CommandStart start opts cache url = do-	showStart "importfeed" url+	showStart' "importfeed" (Just url) 	next $ perform opts cache url  perform :: ImportFeedOptions -> Cache -> URLString -> CommandPerform@@ -101,7 +99,7 @@ 	, location :: DownloadLocation 	} -data DownloadLocation = Enclosure URLString | QuviLink URLString+data DownloadLocation = Enclosure URLString | MediaLink URLString  type ItemId = String @@ -141,14 +139,10 @@ 		Just (enclosureurl, _, _) -> return $  			Just $ ToDownload f u i $ Enclosure $  				fromFeed enclosureurl-		Nothing -> mkquvi f i-	mkquvi f i = case getItemLink i of-		Just link -> ifM (quviSupported $ fromFeed link)-			( return $ Just $ ToDownload f u i $ QuviLink $ -				fromFeed link-			, return Nothing-			)-		Nothing -> return Nothing+		Nothing -> case getItemLink i of+			Just link -> return $ Just $ ToDownload f u i $ +				MediaLink $ fromFeed link+			Nothing -> return Nothing  {- Feeds change, so a feed download cannot be resumed. -} downloadFeed :: URLString -> Annex (Maybe Feed)@@ -169,12 +163,19 @@ 	Enclosure url -> checkknown url $ 		rundownload url (takeWhile (/= '?') $ takeExtension url) $ \f -> do 			r <- Remote.claimingUrl url-			if Remote.uuid r == webUUID || rawOption opts+			if Remote.uuid r == webUUID || rawOption (downloadOptions opts) 				then do-					urlinfo <- if relaxedOption opts+					urlinfo <- if relaxedOption (downloadOptions opts) 						then pure Url.assumeUrlExists 						else Url.withUrlOptions (Url.getUrlInfo url)-					maybeToList <$> addUrlFile (relaxedOption opts) url urlinfo f+					let dlopts = (downloadOptions opts)+						-- force using the filename+						-- chosen here+						{ fileOption = Just f+						-- don't use youtube-dl+						, rawOption = True+						}+					maybeToList <$> addUrlFile dlopts url urlinfo f 				else do 					res <- tryNonAsync $ maybe 						(error $ "unable to checkUrl of " ++ Remote.name r)@@ -184,27 +185,26 @@ 						Left _ -> return [] 						Right (UrlContents sz _) -> 							maybeToList <$>-								downloadRemoteFile r (relaxedOption opts) url f sz+								downloadRemoteFile r (downloadOptions opts) url f sz 						Right (UrlMulti l) -> do 							kl <- forM l $ \(url', sz, subf) ->-								downloadRemoteFile r (relaxedOption opts) url' (f </> fromSafeFilePath subf) sz+								downloadRemoteFile r (downloadOptions opts) url' (f </> fromSafeFilePath subf) sz 							return $ if all isJust kl 								then catMaybes kl 								else [] 							-	QuviLink pageurl -> do-		let quviurl = setDownloader pageurl QuviDownloader-		checkknown quviurl $ do-			mp <- withQuviOptions Quvi.query [Quvi.quiet, Quvi.httponly] pageurl-			case mp of-				Nothing -> return False-				Just page -> case headMaybe $ Quvi.pageLinks page of-					Nothing -> return False-					Just link -> do-						let videourl = Quvi.linkUrl link-						checkknown videourl $-							rundownload videourl ("." ++ fromMaybe "m" (Quvi.linkSuffix link)) $ \f ->-								maybeToList <$> addUrlFileQuvi (relaxedOption opts) quviurl videourl f+	MediaLink linkurl -> do+		let mediaurl = setDownloader linkurl YoutubeDownloader+		let mediakey = Backend.URL.fromUrl mediaurl Nothing+		-- Old versions of git-annex that used quvi might have+		-- used the quviurl for this, so check i/f it's known+		-- to avoid adding it a second time.+		let quviurl = setDownloader linkurl QuviDownloader+		checkknown mediaurl $ checkknown quviurl $+			ifM (Annex.getState Annex.fast <||> pure (relaxedOption (downloadOptions opts)))+				( addmediafast linkurl mediaurl mediakey+				, downloadmedia linkurl mediaurl mediakey+				)   where 	forced = Annex.getState Annex.force @@ -264,6 +264,42 @@ 		checksameurl k = ifM (elem url <$> getUrls k) 			( return Nothing 			, tryanother+			)+	+	downloadmedia linkurl mediaurl mediakey+		| rawOption (downloadOptions opts) = downloadlink+		| otherwise = do+			r <- withTmpWorkDir mediakey $ \workdir -> do+				dl <- youtubeDl linkurl workdir+				case dl of+					Right (Just mediafile) -> do+						let ext = case takeExtension mediafile of+							[] -> ".m"+							s -> s+						ok <- rundownload linkurl ext $ \f -> do+							addWorkTree webUUID mediaurl f mediakey (Just mediafile)+							return [mediakey]+						return (Just ok)+					-- youtude-dl didn't support it, so+					-- download it as if the link were+					-- an enclosure.+					Right Nothing -> Just <$> downloadlink+					Left msg -> do+						warning msg+						return Nothing+			return (fromMaybe False r)+	  where+		downloadlink = performDownload opts cache todownload+			{ location = Enclosure linkurl }++	addmediafast linkurl mediaurl mediakey =+		ifM (pure (not (rawOption (downloadOptions opts)))+		     <&&> youtubeDlSupported linkurl)+			( rundownload linkurl ".m" $ \f -> do+				addWorkTree webUUID mediaurl f mediakey Nothing+				return [mediakey]+			, performDownload opts cache todownload+				{ location = Enclosure linkurl } 			)  defaultTemplate :: String

@@ -42,7 +42,7 @@  perform :: CommandPerform perform = do-	showStart "commit" ""+	showStart' "commit" Nothing 	whenM stageDirect $ do 		showOutput 		void $ inRepo $ Git.Branch.commitCommand Git.Branch.ManualCommit@@ -100,6 +100,6 @@ 	 cleanup :: CommandCleanup cleanup = do-	showStart "indirect" ""+	showStart' "indirect" Nothing 	showEndOk 	return True

@@ -40,12 +40,12 @@  start :: InitOptions -> CommandStart start os = do-	showStart "init" (initDesc os)+	showStart' "init" (Just $ initDesc os) 	next $ perform os  perform :: InitOptions -> CommandPerform perform os = do-	initialize +	initialize (AutoInit False) 		(if null (initDesc os) then Nothing else Just (initDesc os)) 		(initVersion os) 	Annex.SpecialRemote.autoEnable

@@ -38,7 +38,7 @@ 				let c = newConfig name 				t <- either giveup return (findType config) -				showStart "initremote" name+				showStart' "initremote" (Just name) 				next $ perform t name $ M.union config c 			) 	)

@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2013 Joey Hess <id@joeyh.name>+ - Copyright 2013-2017 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -9,6 +9,7 @@  import Command import Annex.CatFile+import qualified Git.LsFiles  cmd :: Command cmd = notBareRepo $ noCommit $ noMessages $@@ -18,10 +19,21 @@ 		(batchable run (pure ()))  run :: () -> String -> Annex Bool-run _ file = do-	mk <- catKeyFile file-	case mk of+run _ file = seekSingleGitFile file >>= \case+	Nothing -> return False+	Just file' -> catKeyFile file' >>= \case 		Just k  -> do 			liftIO $ putStrLn $ key2file k 			return True 		Nothing -> return False++-- To support absolute filenames, pass through git ls-files.+-- But, this plumbing command does not recurse through directories.+seekSingleGitFile :: FilePath -> Annex (Maybe FilePath)+seekSingleGitFile file = do+	(l, cleanup) <- inRepo (Git.LsFiles.inRepo [file])+	r <- case l of+		(f:[]) | takeFileName f == takeFileName file -> return (Just f)+		_ -> return Nothing+	void $ liftIO cleanup+	return r

@@ -189,7 +189,7 @@ {- reads the config of a remote, with progress display -} scan :: Git.Repo -> Annex Git.Repo scan r = do-	showStart "map" $ Git.repoDescribe r+	showStart' "map" (Just $ Git.repoDescribe r) 	v <- tryScan r 	case v of 		Just r' -> do

@@ -23,7 +23,7 @@  mergeBranch :: CommandStart mergeBranch = do-	showStart "merge" "git-annex"+	showStart' "merge" (Just "git-annex") 	next $ do 		Annex.Branch.update 		-- commit explicitly, in case no remote branches were merged

@@ -100,7 +100,7 @@ 			putStrLn . fromMetaValue 		stop 	_ -> do-		showStart' "metadata" k ai+		showStartKey "metadata" k ai 		next $ perform c o k  perform :: VectorClock -> MetaDataOptions -> Key -> CommandPerform@@ -164,7 +164,7 @@ 	Right k -> go k (mkActionItem k)   where 	go k ai = do-		showStart' "metadata" k ai+		showStartKey "metadata" k ai 		let o = MetaDataOptions 			{ forFiles = [] 			, getSet = if MetaData m == emptyMetaData

@@ -87,7 +87,7 @@ 				toHereStart move afile key ai  showMoveAction :: Bool -> Key -> ActionItem -> Annex ()-showMoveAction move = showStart' (if move then "move" else "copy")+showMoveAction move = showStartKey (if move then "move" else "copy")  {- Moves (or copies) the content of an annexed file to a remote.  -

@@ -78,7 +78,7 @@  genAddress :: CommandStart genAddress = do-	showStart "gen-address" ""+	showStart' "gen-address" Nothing 	k <- uftpKey 	(s, ok) <- case k of 		KeyContainer s -> liftIO $ genkey (Param s)@@ -130,7 +130,7 @@ 	whenM isDirect $ 		giveup "Sorry, multicast send cannot be done from a direct mode repository." 	-	showStart "generating file list" ""+	showStart' "generating file list" Nothing 	fs' <- seekHelper LsFiles.inRepo =<< workTreeItems fs 	matcher <- Limit.getMatcher 	let addlist f o = whenM (matcher $ MatchingFile $ FileInfo f f) $@@ -143,7 +143,7 @@ 	liftIO $ hClose h 	showEndOk -	showStart "sending files" ""+	showStart' "sending files" Nothing 	showOutput 	serverkey <- uftpKey 	u <- getUUID@@ -169,7 +169,7 @@  receive :: [CommandParam] -> CommandStart receive ups = do-	showStart "receiving multicast files" ""+	showStart' "receiving multicast files" Nothing 	showNote "Will continue to run until stopped by ctrl-c" 	 	showOutput

@@ -48,7 +48,7 @@ startSet :: Int -> CommandStart startSet n = do 	allowMessages-	showStart "numcopies" (show n)+	showStart' "numcopies" (Just $ show n) 	next $ next $ do 		setGlobalNumCopies $ NumCopies n 		return True

@@ -97,7 +97,7 @@ -- Address is read from stdin, to avoid leaking it in shell history. linkRemote :: RemoteName -> CommandStart linkRemote remotename = do-	showStart "p2p link" remotename+	showStart' "p2p link" (Just remotename) 	next $ next promptaddr   where 	promptaddr = do@@ -123,7 +123,7 @@ startPairing :: RemoteName -> [P2PAddress] -> CommandStart startPairing _ [] = giveup "No P2P networks are currrently available." startPairing remotename addrs = do-	showStart "p2p pair" remotename+	showStart' "p2p pair" (Just remotename) 	ifM (liftIO Wormhole.isInstalled) 		( next $ performPairing remotename addrs 		, giveup "Magic Wormhole is not installed, and is needed for pairing. Install it from your distribution or from https://github.com/warner/magic-wormhole/"

@@ -27,10 +27,10 @@ start :: [String] -> CommandStart start (keyname:url:[]) = do 	let key = mkKey keyname-	showStart "registerurl" url+	showStart' "registerurl" (Just url) 	next $ perform key url start [] = do-	showStart "registerurl" "stdin"+	showStart' "registerurl" (Just "stdin") 	next massAdd start _ = giveup "specify a key and an url" 

@@ -25,7 +25,7 @@  start :: [String] -> CommandStart start ws = do-	showStart "reinit" s+	showStart' "reinit" (Just s) 	next $ perform s   where 	s = unwords ws@@ -36,6 +36,6 @@ 		then return $ toUUID s 		else Remote.nameToUUID s 	storeUUID u-	initialize' Nothing+	initialize' (AutoInit False) Nothing 	Annex.SpecialRemote.autoEnable 	next $ return True

@@ -23,7 +23,7 @@  start :: CommandStart start = do-	showStart "resolvemerge" ""+	showStart' "resolvemerge" Nothing 	us <- fromMaybe nobranch <$> inRepo Git.Branch.current 	d <- fromRepo Git.localGitDir 	let merge_head = d </> "MERGE_HEAD"

@@ -28,7 +28,7 @@ 	parse (name:[]) = go name performGet 	parse (name:expr:[]) = go name $ \uuid -> do 		allowMessages-		showStart "schedule" name+		showStart' "schedule" (Just name) 		performSet expr uuid 	parse _ = giveup "Specify a repository." 

@@ -23,7 +23,7 @@  start :: [String] -> CommandStart start (ks:us:vs:[]) = do-	showStart' "setpresentkey" k (mkActionItem k)+	showStartKey "setpresentkey" k (mkActionItem k) 	next $ perform k (toUUID us) s   where 	k = fromMaybe (giveup "bad key") (file2key ks)

@@ -299,7 +299,7 @@ commit :: SyncOptions -> CommandStart commit o = stopUnless shouldcommit $ next $ next $ do 	commitmessage <- maybe commitMsg return (messageOption o)-	showStart "commit" ""+	showStart' "commit" Nothing 	Annex.Branch.commit "update" 	ifM isDirect 		( do@@ -342,7 +342,7 @@   where 	go Nothing = stop 	go (Just syncbranch) = do-		showStart "merge" $ Git.Ref.describe syncbranch+		showStart' "merge" (Just $ Git.Ref.describe syncbranch) 		next $ next $ merge currbranch mergeconfig resolvemergeoverride Git.Branch.ManualCommit syncbranch mergeLocal _ _ (Nothing, madj) = do 	b <- inRepo Git.Branch.currentUnsafe@@ -401,7 +401,7 @@  pullRemote :: SyncOptions -> [Git.Merge.MergeConfig] -> Remote -> CurrBranch -> CommandStart pullRemote o mergeconfig remote branch = stopUnless (pure $ pullOption o && wantpull) $ do-	showStart "pull" (Remote.name remote)+	showStart' "pull" (Just (Remote.name remote)) 	next $ do 		showOutput 		stopUnless fetch $@@ -438,7 +438,7 @@ pushRemote :: SyncOptions -> Remote -> CurrBranch -> CommandStart pushRemote _o _remote (Nothing, _) = stop pushRemote o remote (Just branch, _) = stopUnless (pure (pushOption o) <&&> needpush) $ do-	showStart "push" (Remote.name remote)+	showStart' "push" (Just (Remote.name remote)) 	next $ next $ do 		showOutput 		ok <- inRepoWithSshOptionsTo (Remote.repo remote) gc $@@ -651,7 +651,7 @@ 		, return [] 		) 	get have = includeCommandAction $ do-		showStart' "get" k (mkActionItem af)+		showStartKey "get" k (mkActionItem af) 		next $ next $ getKey' k af have  	wantput r@@ -703,7 +703,7 @@ cleanupLocal :: CurrBranch -> CommandStart cleanupLocal (Nothing, _) = stop cleanupLocal (Just currb, _) = do-	showStart "cleanup" "local"+	showStart' "cleanup" (Just "local") 	next $ next $ do 		delbranch $ syncBranch currb 		delbranch $ syncBranch $ Git.Ref.base $ Annex.Branch.name@@ -717,7 +717,7 @@ cleanupRemote :: Remote -> CurrBranch -> CommandStart cleanupRemote _ (Nothing, _) = stop cleanupRemote remote (Just b, _) = do-	showStart "cleanup" (Remote.name remote)+	showStart' "cleanup" (Just (Remote.name remote)) 	next $ next $ 		inRepo $ Git.Command.runBool 			[ Param "push"

@@ -58,7 +58,7 @@  start :: Int -> RemoteName -> CommandStart start basesz name = do-	showStart "testremote" name+	showStart' "testremote" (Just name) 	fast <- Annex.getState Annex.fast 	r <- either giveup disableExportTree =<< Remote.byName' name 	rs <- catMaybes <$> mapM (adjustChunkSize r) (chunkSizes basesz fast)

@@ -27,7 +27,7 @@   where 	start ws = do 		let name = unwords ws-		showStart c name+		showStart' c (Just name) 		u <- Remote.nameToUUID name 		next $ perform u 	perform uuid = do

@@ -23,7 +23,7 @@  start :: [String] -> CommandStart start (name:g:[]) = do-	showStart "ungroup" name+	showStart' "ungroup" (Just name) 	u <- Remote.nameToUUID name 	next $ perform u g start _ = giveup "Specify a repository and a group."

@@ -70,7 +70,7 @@ 		Just "." -> (".", checkUnused refspec) 		Just "here" -> (".", checkUnused refspec) 		Just n -> (n, checkRemoteUnused n refspec)-	showStart "unused" name+	showStart' "unused" (Just name) 	next perform  checkUnused :: RefSpec -> CommandPerform@@ -338,5 +338,5 @@ 		case M.lookup n m of 			Nothing -> search rest 			Just key -> do-				showStart message (show n)+				showStart' message (Just $ show n) 				next $ a key

@@ -23,8 +23,8 @@  start :: CommandStart start = do-	showStart "upgrade" "."+	showStart' "upgrade" Nothing 	whenM (isNothing <$> getVersion) $ do-		initialize Nothing Nothing+		initialize (AutoInit False) Nothing Nothing 	r <- upgrade False latestVersion 	next $ next $ return r

@@ -23,7 +23,7 @@  start :: [String] -> CommandStart start params = do-	showStart "vadd" ""+	showStart' "vadd" Nothing 	withCurrentView $ \view -> do 		let (view', change) = refineView view $ 			map parseViewParam $ reverse params

@@ -27,7 +27,7 @@   where 	go Nothing = giveup "Not in a view." 	go (Just v) = do-		showStart "vcycle" ""+		showStart' "vcycle" Nothing 		let v' = v { viewComponents = vcycle [] (viewComponents v) } 		if v == v' 			then do

@@ -21,7 +21,7 @@  start :: [String] -> CommandStart start params = do-	showStart "vfilter" ""+	showStart' "vfilter" Nothing 	withCurrentView $ \view -> do 		let view' = filterView view $ 			map parseViewParam $ reverse params

@@ -28,7 +28,7 @@   where 	go Nothing = giveup "Not in a view." 	go (Just v) = do-		showStart "vpop" (show num)+		showStart' "vpop" (Just $ show num) 		removeView v 		(oldvs, vs) <- splitAt (num - 1) . filter (sameparentbranch v) 			<$> recentViews

@@ -27,7 +27,7 @@ start :: [String] -> CommandStart start [] = giveup "Specify metadata to include in view" start ps = do-	showStart "view" ""+	showStart' "view" Nothing 	view <- mkView ps 	go view  =<< currentView   where

@@ -35,7 +35,7 @@ 	start (rname:[]) = go rname (performGet getter) 	start (rname:expr:[]) = go rname $ \uuid -> do 		allowMessages-		showStart name rname+		showStart' name (Just rname) 		performSet setter expr uuid 	start _ = giveup "Specify a repository." 		

@@ -53,7 +53,7 @@  startKeys :: M.Map UUID Remote -> Key -> ActionItem -> CommandStart startKeys remotemap key ai = do-	showStart' "whereis" key ai+	showStartKey "whereis" key ai 	next $ perform remotemap key  perform :: M.Map UUID Remote -> Key -> CommandPerform

@@ -72,7 +72,7 @@ 		map (\r -> (Types.Remote.uuid r, UnTrusted)) exports 	logged <- trustMapRaw 	let configured = M.fromList $ mapMaybe configuredtrust l-	let m = M.union exportoverrides $+	let m = M.unionWith max exportoverrides $ 		M.union overrides $ 		M.union configured logged 	Annex.changeState $ \s -> s { Annex.trustmap = Just m }

@@ -100,15 +100,15 @@ removeTempUrl key = Annex.changeState $ \s -> 	s { Annex.tempurls = M.delete key (Annex.tempurls s) } -data Downloader = WebDownloader | QuviDownloader | OtherDownloader+data Downloader = WebDownloader | YoutubeDownloader | QuviDownloader | OtherDownloader 	deriving (Eq, Show)  {- To keep track of how an url is downloaded, it's mangled slightly in- - the log. For quvi, "quvi:" is prefixed. For urls that are handled by- - some other remote, ":" is prefixed. -}+ - the log, with a prefix indicating when a Downloader is used. -} setDownloader :: URLString -> Downloader -> String setDownloader u WebDownloader = u setDownloader u QuviDownloader = "quvi:" ++ u+setDownloader u YoutubeDownloader = "yt:" ++ u setDownloader u OtherDownloader = ":" ++ u  setDownloader' :: URLString -> Remote -> String@@ -118,6 +118,9 @@  getDownloader :: URLString -> (URLString, Downloader) getDownloader u = case separate (== ':') u of-	("quvi", u') -> (u', QuviDownloader)+	("yt", u') -> (u', YoutubeDownloader)+	-- quvi is not used any longer; youtube-dl should be able to handle+	-- all urls it did.+	("quvi", u') -> (u', YoutubeDownloader) 	("", u') -> (u', OtherDownloader) 	_ -> (u, WebDownloader)

@@ -7,9 +7,10 @@  module Messages ( 	showStart,+	showStart',+	showStartKey, 	ActionItem, 	mkActionItem,-	showStart', 	showNote, 	showAction, 	showSideAction,@@ -66,8 +67,14 @@   where 	json = JSON.start command (Just file) Nothing -showStart' :: String -> Key -> ActionItem -> Annex ()-showStart' command key i = outputMessage json $+showStart' :: String -> Maybe String -> Annex ()+showStart' command mdesc = outputMessage json $+	command ++ (maybe "" (" " ++) mdesc) ++ " "+  where+	json = JSON.start command Nothing Nothing++showStartKey :: String -> Key -> ActionItem -> Annex ()+showStartKey command key i = outputMessage json $ 	command ++ " " ++ actionItemDesc i key ++ " "   where 	json = JSON.start command (actionItemWorkTreeFile i) (Just key)

@@ -107,7 +107,7 @@ fileRetriever a k m callback = do 	f <- prepTmp k 	a f k m-	callback (FileContent f)+	pruneTmpWorkDirBefore f (callback . FileContent)  -- A Retriever that generates a lazy ByteString containing the Key's -- content, and passes it to a callback action which will fully consume it

@@ -19,8 +19,7 @@ import Annex.UUID import Utility.Metered import qualified Annex.Url as Url-import Annex.Quvi-import qualified Utility.Quvi as Quvi+import Annex.YoutubeDl  remote :: RemoteType remote = RemoteType@@ -80,9 +79,7 @@ 		untilTrue urls $ \u -> do 			let (u', downloader) = getDownloader u 			case downloader of-				QuviDownloader -> do-					flip (downloadUrl key p) dest-						=<< withQuviOptions Quvi.queryLinks [Quvi.httponly, Quvi.quiet] u'+				YoutubeDownloader -> youtubeDlTo key u' dest 				_ -> downloadUrl key p [u'] dest  downloadKeyCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool@@ -109,8 +106,7 @@ 	let (u', downloader) = getDownloader u 	showChecking u' 	case downloader of-		QuviDownloader ->-			Right <$> withQuviOptions Quvi.check [Quvi.httponly, Quvi.quiet] u'+		YoutubeDownloader -> youtubeDlCheck u' 		_ -> do 			Url.withUrlOptions $ catchMsgIO . 				Url.checkBoth u' (keySize key)@@ -126,4 +122,4 @@ getWebUrls key = filter supported <$> getUrls key   where 	supported u = snd (getDownloader u) -		`elem` [WebDownloader, QuviDownloader]+		`elem` [WebDownloader, YoutubeDownloader]

@@ -675,7 +675,7 @@ 		annexeval $ do 			Database.Keys.closeDb 			dbdir <- Annex.fromRepo Annex.Locations.gitAnnexKeysDb-			liftIO $ removeDirectoryRecursive dbdir+			liftIO $ renameDirectory dbdir (dbdir ++ ".old") 		writeFile annexedfile "test_lock_v6_force content" 		not <$> git_annex "lock" [annexedfile] @? "lock of modified file failed to fail in v6 mode" 		git_annex "lock" ["--force", annexedfile] @? "lock --force of modified file failed in v6 mode"@@ -1810,7 +1810,7 @@ 		)   where 	isdirect = annexeval $ do-		Annex.Init.initialize Nothing Nothing+		Annex.Init.initialize (Annex.Init.AutoInit False) Nothing Nothing 		Config.isDirect  checkRepo :: Types.Annex a -> FilePath -> IO a

@@ -67,7 +67,7 @@ 	, annexSyncContent :: Configurable Bool 	, annexDebug :: Bool 	, annexWebOptions :: [String]-	, annexQuviOptions :: [String]+	, annexYoutubeDlOptions :: [String] 	, annexAriaTorrentOptions :: [String] 	, annexWebDownloadCommand :: Maybe String 	, annexCrippledFileSystem :: Bool@@ -127,7 +127,7 @@ 		getmaybebool (annex "synccontent") 	, annexDebug = getbool (annex "debug") False 	, annexWebOptions = getwords (annex "web-options")-	, annexQuviOptions = getwords (annex "quvi-options")+	, annexYoutubeDlOptions = getwords (annex "youtube-dl-options") 	, annexAriaTorrentOptions = getwords (annex "aria-torrent-options") 	, annexWebDownloadCommand = getmaybe (annex "web-download-command") 	, annexCrippledFileSystem = getbool (annex "crippledfilesystem") False

@@ -5,11 +5,15 @@  - Licensed under the GNU GPL version 3 or higher.  -} +{-# LANGUAGE FlexibleInstances #-}+ module Types.Transfer where  import Types+import Types.Remote (Verification(..)) import Utility.PID import Utility.QuickCheck+import Utility.Url  import Data.Time.Clock.POSIX import Control.Concurrent@@ -66,3 +70,34 @@ 		-- associated file cannot be empty (but can be Nothing) 		<*> (AssociatedFile <$> arbitrary `suchThat` (/= Just "")) 		<*> arbitrary++class Observable a where+	observeBool :: a -> Bool+	observeFailure :: a++instance Observable Bool where+	observeBool = id+	observeFailure = False++instance Observable (Bool, Verification) where+	observeBool = fst+	observeFailure = (False, UnVerified)++instance Observable (Either e Bool) where+	observeBool (Left _) = False+	observeBool (Right b) = b+	observeFailure = Right False++instance Observable (Maybe a) where+	observeBool (Just _) = True+	observeBool Nothing = False+	observeFailure = Nothing++class Transferrable t where+	descTransfrerrable :: t -> Maybe String++instance Transferrable AssociatedFile where+	descTransfrerrable (AssociatedFile af) = af++instance Transferrable URLString where+	descTransfrerrable = Just

@@ -171,7 +171,7 @@  {- "subkey!" tells gpg to force use of a specific subkey -} isForcedSubKey :: String -> Bool-isForcedSubKey s = "!" `isSuffixOf` s && all isHexDigit (drop 1 s)+isForcedSubKey s = "!" `isSuffixOf` s && all isHexDigit (drop 1 (reverse s))  type UserId = String 

@@ -0,0 +1,46 @@+{- html detection+ -+ - Copyright 2017 Joey Hess <id@joeyh.name>+ -+ - License: BSD-2-clause+ -}++module Utility.HtmlDetect where++import Text.HTML.TagSoup+import Data.Char+import qualified Data.ByteString.Lazy as B+import qualified Data.ByteString.Lazy.Char8 as B8++-- | Detect if a String is a html document.+--+-- The document many not be valid, or may be truncated, and will+-- still be detected as html, as long as it starts with a+-- "<html>" or "<!DOCTYPE html>" tag.+--+-- Html fragments like "<p>this</p>" are not detected as being html,+-- although some browsers may chose to render them as html.+isHtml :: String -> Bool+isHtml = evaluate . canonicalizeTags . parseTags . take htmlPrefixLength+  where+	evaluate (TagOpen "!DOCTYPE" ((t, _):_):_) = map toLower t == "html"+	evaluate (TagOpen "html" _:_) = True+	-- Allow some leading whitespace before the tag.+	evaluate (TagText t:rest)+		| all isSpace t = evaluate rest+		| otherwise = False+	-- It would be pretty weird to have a html comment before the html+	-- tag, but easy to allow for.+	evaluate (TagComment _:rest) = evaluate rest+	evaluate _ = False++-- | Detect if a ByteString is a html document.+isHtmlBs :: B.ByteString -> Bool+-- The encoding of the ByteString is not known, but isHtml only+-- looks for ascii strings.+isHtmlBs = isHtml . B8.unpack++-- | How much of the beginning of a html document is needed to detect it.+-- (conservatively)+htmlPrefixLength :: Int+htmlPrefixLength = 8192

@@ -1,162 +0,0 @@-{- querying quvi (import qualified)- -- - Copyright 2013 Joey Hess <id@joeyh.name>- -- - License: BSD-2-clause- -}--{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleContexts #-}--module Utility.Quvi where--import Common-import Utility.Url--import Data.Aeson-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import qualified Data.Map as M-import Network.URI (uriAuthority, uriRegName)-import Data.Char--data QuviVersion-	= Quvi04-	| Quvi09-	| NoQuvi-	deriving (Show)--data Page = Page-	{ pageTitle :: String-	, pageLinks :: [Link]-	} deriving (Show)--data Link = Link-	{ linkSuffix :: Maybe String-	, linkUrl :: URLString-	} deriving (Show)--{- JSON instances for quvi 0.4. -}-instance FromJSON Page where-	parseJSON (Object v) = Page-		<$> v .: "page_title"-		<*> v .: "link"-	parseJSON _ = mzero--instance FromJSON Link where-	parseJSON (Object v) = Link-		<$> v .:? "file_suffix"-		<*> v .: "url"-	parseJSON _ = mzero--{- "enum" format used by quvi 0.9 -}-parseEnum :: String -> Maybe Page-parseEnum s = Page-	<$> get "QUVI_MEDIA_PROPERTY_TITLE"-	<*> ((:[]) <$>-		( Link-			<$> Just <$> (get "QUVI_MEDIA_STREAM_PROPERTY_CONTAINER")-			<*> get "QUVI_MEDIA_STREAM_PROPERTY_URL"-		)-	    )-  where-	get = flip M.lookup m-	m = M.fromList $ map (separate (== '=')) $ lines s--probeVersion :: IO QuviVersion-probeVersion = catchDefaultIO NoQuvi $-	examine <$> processTranscript "quvi" ["--version"] Nothing-  where-	examine (s, True)-		| "quvi v0.4" `isInfixOf` s = Quvi04-		| otherwise = Quvi09-	examine _ = NoQuvi--type Query a = QuviVersion -> [CommandParam] -> URLString -> IO a--{- Throws an error when quvi is not installed. -}-forceQuery :: Query (Maybe Page)-forceQuery v ps url = query' v ps url `catchNonAsync` onerr-  where-	onerr e = ifM (inPath "quvi")-		( giveup ("quvi failed: " ++ show e)-		, giveup "quvi is not installed"-		)--{- Returns Nothing if the page is not a video page, or quvi is not- - installed. -}-query :: Query (Maybe Page)-query v ps url = flip catchNonAsync (const $ return Nothing) (query' v ps url)--query' :: Query (Maybe Page)-query' Quvi09 ps url = parseEnum-	<$> readQuvi (toCommand $ [Param "dump", Param "-p", Param "enum"] ++ ps ++ [Param url])-query' Quvi04 ps url = do-	let p = proc "quvi" (toCommand $ ps ++ [Param url])-	decode . BL.fromStrict-		<$> withHandle StdoutHandle createProcessSuccess p B.hGetContents-query' NoQuvi _ _ = return Nothing--queryLinks :: Query [URLString]-queryLinks v ps url = maybe [] (map linkUrl . pageLinks) <$> query v ps url--{- Checks if quvi can still find a download link for an url.- - If quvi is not installed, returns False. -}-check :: Query Bool-check v ps url = maybe False (not . null . pageLinks) <$> query v ps url--{- Checks if an url is supported by quvi, as quickly as possible- - (without hitting it if possible), and without outputting- - anything. Also returns False if quvi is not installed. -}-supported :: QuviVersion -> URLString -> IO Bool-supported NoQuvi _ = return False-supported Quvi04 url = boolSystem "quvi"-		[ Param "--verbosity", Param "mute"-		, Param "--support"-		, Param url-		]-{- Use quvi-info to see if the url's domain is supported.- - If so, have to do a online verification of the url. -}-supported Quvi09 url = (firstlevel <&&> secondlevel)-		`catchNonAsync` (\_ -> return False)-  where-	firstlevel = case uriAuthority =<< parseURIRelaxed url of-		Nothing -> return False-		Just auth -> do-			let domain = map toLower $ uriRegName auth-			let basedomain = intercalate "." $ reverse $ take 2 $ reverse $ splitc '.' domain-			any (\h -> domain `isSuffixOf` h || basedomain `isSuffixOf` h) -				. map (map toLower) <$> listdomains Quvi09-	secondlevel = snd <$> processTranscript "quvi"-		(toCommand [Param "dump", Param "-o", Param url]) Nothing--listdomains :: QuviVersion -> IO [String]-listdomains Quvi09 = concatMap (splitc ',') -	. concatMap (drop 1 . words) -	. filter ("domains: " `isPrefixOf`) . lines-	<$> readQuvi (toCommand [Param "info", Param "-p", Param "domains"])-listdomains _ = return []--type QuviParams = QuviVersion -> [CommandParam]--{- Disables progress, but not information output. -}-quiet :: QuviParams--- Cannot use quiet as it now disables informational output.--- No way to disable progress.-quiet Quvi09 = [Param "--verbosity", Param "verbose"]-quiet Quvi04 = [Param "--verbosity", Param "quiet"]-quiet NoQuvi = []--{- Only return http results, not streaming protocols. -}-httponly :: QuviParams--- No way to do it with 0.9?-httponly Quvi04 = [Param "-c", Param "http"]-httponly _ = [] -- No way to do it with 0.9?--readQuvi :: [String] -> IO String-readQuvi ps = withHandle StdoutHandle createProcessSuccess p $ \h -> do-	r <- hGetContentsStrict h-	hClose h-	return r-  where-	p = proc "quvi" ps

@@ -1,6 +1,6 @@ {- Url downloading.  -- - Copyright 2011-2014 Joey Hess <id@joeyh.name>+ - Copyright 2011-2017 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}@@ -25,6 +25,7 @@ 	assumeUrlExists, 	download, 	downloadQuiet,+	downloadPartial, 	parseURIRelaxed, 	matchStatusCodeException, 	matchHttpExceptionContent,@@ -39,8 +40,10 @@ 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 Control.Monad.Trans.Resource import Network.HTTP.Conduit hiding (closeManager)+import Network.HTTP.Client (brRead, withResponse)  -- closeManager is needed with older versions of http-client, -- but not new versions, which warn about using it. Urgh.@@ -140,7 +143,7 @@  - also returning its size and suggested filename if available. -} getUrlInfo :: URLString -> UrlOptions -> IO UrlInfo getUrlInfo url uo = case parseURIRelaxed url of-	Just u -> case parseurlconduit (show u) of+	Just u -> case parseUrlConduit (show u) of 		Just req -> catchJust 			-- When http redirects to a protocol which  			-- conduit does not support, it will throw@@ -220,12 +223,6 @@ 			_ | isftp && isJust len -> good 			_ -> dne -#if MIN_VERSION_http_client(0,4,30)-	parseurlconduit = parseUrlThrow-#else-	parseurlconduit = parseUrl-#endif- -- Parse eg: attachment; filename="fname.ext" -- per RFC 2616 contentDispositionFilename :: String -> Maybe FilePath@@ -321,10 +318,44 @@ 		| quiet = [Param s] 		| otherwise = [] +{- Downloads at least the specified number of bytes from an url. -}+downloadPartial :: URLString -> UrlOptions -> Int -> IO (Maybe L.ByteString)+downloadPartial url uo n = case parseURIRelaxed url of+	Nothing -> return Nothing+	Just u -> go u `catchNonAsync` const (return Nothing)+  where+	go u = case parseUrlConduit (show u) of+		Nothing -> return Nothing+		Just req -> do+			mgr <- newManager managerSettings+			let req' = applyRequest uo req+			ret <- withResponse req' mgr $ \resp ->+				if responseStatus resp == ok200+					then Just <$> brread n [] (responseBody resp)+					else return Nothing+			liftIO $ closeManager mgr+			return ret++	-- could use brReadSome here, needs newer http-client dependency+	brread n' l rb+		| n' <= 0 = return (L.fromChunks (reverse l))+		| otherwise = do+			bs <- brRead rb+			if B.null bs+				then return (L.fromChunks (reverse l))+				else brread (n' - B.length bs) (bs:l) rb+ {- Allows for spaces and other stuff in urls, properly escaping them. -} parseURIRelaxed :: URLString -> Maybe URI parseURIRelaxed s = maybe (parseURIRelaxed' s) Just $ 	parseURI $ escapeURIString isAllowedInURI s++parseUrlConduit :: URLString -> Maybe Request+#if MIN_VERSION_http_client(0,4,30)+parseUrlConduit = parseUrlThrow+#else+parseUrlConduit = parseUrl+#endif  {- Some characters like '[' are allowed in eg, the address of  - an uri, but cannot appear unescaped further along in the uri.

@@ -10,8 +10,8 @@  Downloads each url to its own file, which is added to the annex. -When `quvi` is installed, urls are automatically tested to see if they-point to a video hosting site, and the video is downloaded instead.+When `youtube-dl` is installed, it's used to check for a video embedded in +a web page at the url, and that is added to the annex instead.    Urls to torrent files (including magnet links) will cause the content of the torrent to be downloaded, using `aria2c`.@@ -30,12 +30,17 @@  * `--relaxed` -  Avoid storing the size of the url's content, and accept whatever-  content is there at a future point. (Implies `--fast`.)+  Don't immediately download the url, and avoid storing the size of the+  url's content. This makes git-annex accept whatever content is there+  at a future point. +  This is the fastest option, but it still has to access the network+  to check if the url contains embedded media. When adding large numbers+  of urls, using `--relaxed --raw` is much faster.+   * `--raw` -  Prevent special handling of urls by quvi, bittorrent, and other+  Prevent special handling of urls by youtube-dl, bittorrent, and other   special remotes. This will for example, make addurl   download the .torrent file and not the contents it points to. 

@@ -8,14 +8,13 @@  # DESCRIPTION -Imports the contents of podcast feeds. Only downloads files whose+Imports the contents of podcasts and other feeds. Only downloads files whose content has not already been added to the repository before, so you can delete, rename, etc the resulting files and repeated runs won't duplicate them. -When quvi is installed, links in the feed are tested to see if they-are on a video hosting site, and the video is downloaded. This allows-importing e.g., YouTube playlists.+When `youtube-dl` is installed, it's used to download links in the feed.+This allows importing e.g., YouTube playlists.  To make the import process add metadata to the imported files from the feed, `git config annex.genmetadata true`@@ -37,6 +36,23 @@ * `--relaxed`, `--fast`, `--raw`    These options behave the same as when using [[git-annex-addurl]](1).++* `--fast`++  Avoid immediately downloading urls. The url is still checked+  (via HEAD) to verify that it exists, and to get its size if possible.++* `--relaxed`++  Don't immediately download urls, and avoid storing the size of the+  url's content. This makes git-annex accept whatever content is there+  at a future point.++* `--raw`++  Prevent special handling of urls by youtube-dl, bittorrent, and other+  special remotes. This will for example, make importfeed+  download a .torrent file and not the contents it points to.  # SEE ALSO 

@@ -23,6 +23,11 @@  This command is entirely safe, although usually pointless, to run inside an already initialized git-annex repository.+  +A top-level `.noannex` file will prevent git-annex init from being used+in a repository. This is useful for repositories that have a policy+reason not to use git-annex. The content of the file will be displayed+to the user who tries to run git-annex init.  # OPTIONS 

@@ -1315,10 +1315,16 @@   Options to pass when running wget or curl.   For example, to force IPv4 only, set it to "-4" -* `annex.quvi-options`+* `annex.youtube-dl-options` -  Options to pass to quvi when using it to find the url to download for a-  video.+  Options to pass to youtube-dl when using it to find the url to download+  for a video.++  Some options may break git-annex's integration with youtube-dl. For+  example, the --output option could cause it to store files somewhere+  git-annex won't find them. Avoid setting here or in the youtube-dl config+  file any options that cause youtube-dl to download more than one file,+  or to store the file anywhere other than the current working directory.  * `annex.aria-torrent-options` 

@@ -1,5 +1,5 @@ Name: git-annex-Version: 6.20171124+Version: 6.20171214 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -347,6 +347,7 @@    persistent,    persistent-template,    aeson,+   tagsoup,    unordered-containers,    feed (>= 0.3.9),    regex-tdfa,@@ -447,7 +448,6 @@   if flag(Webapp)     Build-Depends:      yesod (>= 1.2.6), -     yesod-default (>= 1.2.0),      yesod-static (>= 1.2.4),      yesod-form (>= 1.3.15),      yesod-core (>= 1.2.19),@@ -530,7 +530,6 @@     Annex.Path     Annex.Perms     Annex.Queue-    Annex.Quvi     Annex.ReplaceFile     Annex.SpecialRemote     Annex.Ssh@@ -546,6 +545,7 @@     Annex.View.ViewedFile     Annex.Wanted     Annex.WorkTree+    Annex.YoutubeDl     Assistant     Assistant.Alert     Assistant.Alert.Utility@@ -1001,6 +1001,7 @@     Utility.Glob     Utility.Gpg     Utility.Hash+    Utility.HtmlDetect     Utility.HumanNumber     Utility.HumanTime     Utility.InodeCache@@ -1032,7 +1033,6 @@     Utility.Process     Utility.Process.Shim     Utility.QuickCheck-    Utility.Quvi     Utility.Rsync     Utility.SRV     Utility.SafeCommand

@@ -20,7 +20,6 @@ - aws-0.17.1 - bloomfilter-2.0.1.0 - torrent-10000.1.1-- yesod-default-1.2.0 explicit-setup-deps:   git-annex: true resolver: lts-9.9