packages feed

git-annex 6.20180316 → 6.20180409

raw patch · 59 files changed

+762/−310 lines, 59 filesdep −conduit-extra

Dependencies removed: conduit-extra

Files

Annex.hs view
@@ -144,6 +144,7 @@ 	, keysdbhandle :: Maybe Keys.DbHandle 	, cachedcurrentbranch :: Maybe Git.Branch 	, cachedgitenv :: Maybe [(String, String)]+	, urloptions :: Maybe UrlOptions 	}  newState :: GitConfig -> Git.Repo -> IO AnnexState@@ -200,6 +201,7 @@ 		, keysdbhandle = Nothing 		, cachedcurrentbranch = Nothing 		, cachedgitenv = Nothing+		, urloptions = Nothing 		}  {- Makes an Annex state object for the specified git repo.
Annex/Content.hs view
@@ -939,16 +939,14 @@  {- Downloads content from any of a list of urls. -} downloadUrl :: Key -> MeterUpdate -> [Url.URLString] -> FilePath -> Annex Bool-downloadUrl k p urls file = meteredFile file (Just p) k $-	go =<< annexWebDownloadCommand <$> Annex.getGitConfig+downloadUrl k p urls file = +	-- Poll the file to handle configurations where an external+	-- download command is used.+	meteredFile file (Just p) k $+		go =<< annexWebDownloadCommand <$> Annex.getGitConfig   where-	go Nothing = do-		a <- ifM commandProgressDisabled-			( return Url.downloadQuiet-			, return Url.download-			)-		Url.withUrlOptions $ \uo ->-			anyM (\u -> a u file uo) urls+	go Nothing = Url.withUrlOptions $ \uo -> +		liftIO $ anyM (\u -> Url.download p u file uo) urls 	go (Just basecmd) = anyM (downloadcmd basecmd) urls 	downloadcmd basecmd url = 		progressCommand "sh" [Param "-c", Param $ gencmd url basecmd]
Annex/MetaData.hs view
@@ -22,7 +22,6 @@ import Utility.Glob  import qualified Data.Set as S-import qualified Data.Map as M import Data.Time.Calendar import Data.Time.Clock import Data.Time.Clock.POSIX@@ -41,28 +40,43 @@ genMetaData key file status = do 	catKeyFileHEAD file >>= \case 		Nothing -> noop-		Just oldkey -> -			whenM (copyMetaData oldkey key)+		Just oldkey ->+			-- Have to copy first, before adding any+			-- more metadata, because copyMetaData does not+			-- preserve any metadata already on key.+			whenM (copyMetaData oldkey key <&&> (not <$> onlydatemeta oldkey)) $ 				warncopied 	whenM (annexGenMetaData <$> Annex.getGitConfig) $ do-		curr <- getCurrentMetaData key-		addMetaData key (dateMetaData mtime curr)+		old <- getCurrentMetaData key+		addMetaData key (dateMetaData mtime old)   where 	mtime = posixSecondsToUTCTime $ realToFrac $ modificationTime status 	warncopied = warning $  		"Copied metadata from old version of " ++ file ++ " to new version. " ++  		"If you don't want this copied metadata, run: git annex metadata --remove-all " ++ file+	-- If the only fields copied were date metadata, and they'll+	-- be overwritten with the current mtime, no need to warn about+	-- copying.+	onlydatemeta oldkey = ifM (annexGenMetaData <$> Annex.getGitConfig)+		( null . filter (not . isDateMetaField . fst) . fromMetaData +			<$> getCurrentMetaData oldkey+		, return False+		)  {- Generates metadata for a file's date stamp.- - Does not overwrite any existing metadata values. -}+ -+ - Any date fields in the old metadata will be overwritten.+ - + - Note that the returned MetaData does not contain all the input MetaData,+ - only changes to add the date fields. -} dateMetaData :: UTCTime -> MetaData -> MetaData-dateMetaData mtime old = MetaData $ M.fromList $ filter isnew-	[ (yearMetaField, S.singleton $ toMetaValue $ show y)-	, (monthMetaField, S.singleton $ toMetaValue $ show m)-	, (dayMetaField, S.singleton $ toMetaValue $ show d)-	]+dateMetaData mtime old = modMeta old $+	(SetMeta yearMetaField $ S.singleton $ toMetaValue $ show y)+		`ComposeModMeta`+	(SetMeta monthMetaField $ S.singleton $ toMetaValue $ show m)+		`ComposeModMeta`+	(SetMeta dayMetaField $ S.singleton $ toMetaValue $ show d)   where-	isnew (f, _) = S.null (currentMetaDataValues f old) 	(y, m, d) = toGregorian $ utctDay mtime  {- Parses field=value, field+=value, field-=value, field?=value -}
Annex/MetaData/StandardFields.hs view
@@ -10,6 +10,7 @@ 	yearMetaField, 	monthMetaField, 	dayMetaField,+	isDateMetaField, 	lastChangedField, 	mkLastChangedField, 	isLastChangedField@@ -30,6 +31,13 @@  dayMetaField :: MetaField dayMetaField = mkMetaFieldUnchecked "day"++isDateMetaField :: MetaField -> Bool+isDateMetaField f+	| f == yearMetaField = True+	| f == monthMetaField = True+	| f == dayMetaField = True+	| otherwise = False  lastChangedField :: MetaField lastChangedField = mkMetaFieldUnchecked lastchanged
Annex/Transfer.hs view
@@ -1,6 +1,6 @@ {- git-annex transfers  -- - Copyright 2012-2017 Joey Hess <id@joeyh.name>+ - Copyright 2012-2018 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -14,7 +14,7 @@ 	runTransfer, 	alwaysRunTransfer, 	noRetry,-	forwardRetry,+	stdRetry, 	pickRemote, ) where @@ -25,6 +25,7 @@ import Annex.Notification as X import Annex.Perms import Utility.Metered+import Utility.ThreadScheduler import Annex.LockPool import Types.Key import qualified Types.Remote as Remote@@ -71,7 +72,8 @@ alwaysRunTransfer = runTransfer' True  runTransfer' :: Observable v => Bool -> Transfer -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v-runTransfer' ignorelock t afile shouldretry transferaction = checkSecureHashes t $ do+runTransfer' ignorelock t afile retrydecider transferaction = checkSecureHashes t $ do+	shouldretry <- retrydecider 	info <- liftIO $ startTransferInfo afile 	(meter, tfile, createtfile, metervar) <- mkProgressUpdater t info 	mode <- annexFileMode@@ -81,7 +83,7 @@ 			showNote "transfer already in progress, or unable to take transfer lock" 			return observeFailure 		else do-			v <- retry info metervar $ transferaction meter+			v <- retry shouldretry info metervar $ transferaction meter 			liftIO $ cleanup tfile lck 			if observeBool v 				then removeFailedTransfer t@@ -132,15 +134,21 @@ 		dropLock lockhandle 		void $ tryIO $ removeFile lck #endif-	retry oldinfo metervar run = tryNonAsync run >>= \case-		Right b -> return b+	retry shouldretry oldinfo metervar run = tryNonAsync run >>= \case+		Right v+			| observeBool v -> return v+			| otherwise -> checkretry 		Left e -> do 			warning (show e)+			checkretry+	  where+		checkretry = do 			b <- getbytescomplete metervar 			let newinfo = oldinfo { bytesComplete = Just b }-			if shouldretry oldinfo newinfo-				then retry newinfo metervar run-				else return observeFailure+			ifM (shouldretry oldinfo newinfo)+				( retry shouldretry newinfo metervar run+				, return observeFailure+				) 	getbytescomplete metervar 		| transferDirection t == Upload = 			liftIO $ readMVar metervar@@ -172,15 +180,53 @@   where 	variety = keyVariety (transferKey t) -type RetryDecider = TransferInfo -> TransferInfo -> Bool+type RetryDecider = Annex (TransferInfo -> TransferInfo -> Annex Bool) +{- The first RetryDecider will be checked first; only if it says not to+ - retry will the second one be checked. -}+combineRetryDeciders :: RetryDecider -> RetryDecider -> RetryDecider+combineRetryDeciders a b = do+	ar <- a+	br <- b+	return $ \old new -> ar old new <||> br old new+ noRetry :: RetryDecider-noRetry _ _ = False+noRetry = pure $ \_ _ -> pure False +stdRetry :: RetryDecider+stdRetry = combineRetryDeciders forwardRetry configuredRetry+ {- Retries a transfer when it fails, as long as the failed transfer managed  - to send some data. -} forwardRetry :: RetryDecider-forwardRetry old new = bytesComplete old < bytesComplete new+forwardRetry = pure $ \old new -> pure $ bytesComplete old < bytesComplete new++{- Retries a number of times with growing delays in between when enabled+ - by git configuration. -}+configuredRetry :: RetryDecider+configuredRetry = do+	retrycounter <- liftIO $ newMVar 0+	return $ \_old new -> do+		(maxretries, Seconds initretrydelay) <- getcfg $ +			Remote.gitconfig <$> transferRemote new+		retries <- liftIO $ modifyMVar retrycounter $+			\n -> return (n + 1, n + 1)+		if retries < maxretries+			then do+				let retrydelay = Seconds (initretrydelay * 2^(retries-1))+				showSideAction $ "Delaying " ++ show (fromSeconds retrydelay) ++ "s before retrying."+				liftIO $ threadDelaySeconds retrydelay+				return True+			else return False+  where+	globalretrycfg = fromMaybe 0 . annexRetry+		<$> Annex.getGitConfig+	globalretrydelaycfg = fromMaybe (Seconds 1) . annexRetryDelay+		<$> Annex.getGitConfig+	getcfg Nothing = (,) <$> globalretrycfg <*> globalretrydelaycfg+	getcfg (Just gc) = (,)+		<$> maybe globalretrycfg return (remoteAnnexRetry gc)+		<*> maybe globalretrydelaycfg return (remoteAnnexRetryDelay gc)  {- Picks a remote from the list and tries a transfer to it. If the transfer  - does not succeed, goes on to try other remotes from the list.
Annex/Url.hs view
@@ -1,7 +1,7 @@ {- Url downloading, with git-annex user agent and configured http- - headers and wget/curl options.+ - headers and curl options.  -- - Copyright 2013-2014 Joey Hess <id@joeyh.name>+ - Copyright 2013-2018 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -26,15 +26,23 @@ 	Just . fromMaybe defaultUserAgent . Annex.useragent  getUrlOptions :: Annex U.UrlOptions-getUrlOptions = mkUrlOptions-	<$> getUserAgent-	<*> headers-	<*> options+getUrlOptions = Annex.getState Annex.urloptions >>= \case+	Just uo -> return uo+	Nothing -> do+		uo <- mk+		Annex.changeState $ \s -> s+			{ Annex.urloptions = Just uo }+		return uo   where+	mk = mkUrlOptions+		<$> getUserAgent+		<*> headers+		<*> options+		<*> liftIO (U.newManager U.managerSettings) 	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-withUrlOptions a = liftIO . a =<< getUrlOptions+withUrlOptions :: (U.UrlOptions -> Annex a) -> Annex a+withUrlOptions a = a =<< getUrlOptions
Annex/YoutubeDl.hs view
@@ -124,8 +124,7 @@ -- 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+htmlOnly url fallback a = withUrlOptions $ \uo ->  	liftIO (downloadPartial url uo htmlPrefixLength) >>= \case 		Just bs | isHtmlBs bs -> a 		_ -> return fallback
Assistant/Restart.hs view
@@ -95,7 +95,7 @@  - warp-tls listens to http, in order to show an error page, so this works.  -} assistantListening :: URLString -> IO Bool-assistantListening url = catchBoolIO $ exists url' def+assistantListening url = catchBoolIO $ exists url' =<< defUrlOptions   where 	url' = case parseURI url of 		Nothing -> url
Assistant/Upgrade.hs view
@@ -36,6 +36,7 @@ import Utility.UserInfo import Utility.Gpg import Utility.FileMode+import Utility.Metered import qualified Utility.Lsof as Lsof import qualified BuildInfo import qualified Utility.Url as Url@@ -322,8 +323,8 @@ 	liftIO $ withTmpDir "git-annex.tmp" $ \tmpdir -> do 		let infof = tmpdir </> "info" 		let sigf = infof ++ ".sig"-		ifM (Url.downloadQuiet distributionInfoUrl infof uo-			<&&> Url.downloadQuiet distributionInfoSigUrl sigf uo+		ifM (Url.download nullMeterUpdate distributionInfoUrl infof uo+			<&&> Url.download nullMeterUpdate distributionInfoSigUrl sigf uo 			<&&> verifyDistributionSig gpgcmd sigf) 			( parseInfoFile <$> readFileStrict infof 			, return Nothing
Build/BundledPrograms.hs view
@@ -70,14 +70,6 @@ #ifndef mingw32_HOST_OS 	, Just "sh" #endif-#ifndef mingw32_HOST_OS-#ifndef darwin_HOST_OS-	-- wget on OSX has been problematic, looking for certs in the wrong-	-- places. Don't ship it, use curl or the OSX's own wget if it has-	-- one.-	, ifset BuildInfo.wget "wget"-#endif-#endif 	, BuildInfo.lsof 	, BuildInfo.gcrypt #ifndef mingw32_HOST_OS
Build/Configure.hs view
@@ -6,14 +6,11 @@  import Build.TestConfig import Build.Version-import Utility.PartialPrelude-import Utility.Process import Utility.SafeCommand import Utility.ExternalSHA import Utility.Env.Basic import Utility.Exception import qualified Git.Version-import Utility.DottedVersion import Utility.Directory  import Control.Monad.IfElse@@ -34,8 +31,6 @@ 	, TestCase "xargs -0" $ testCmd "xargs_0" "xargs -0 </dev/null" 	, TestCase "rsync" $ testCmd "rsync" "rsync --version >/dev/null" 	, TestCase "curl" $ testCmd "curl" "curl --version >/dev/null"-	, TestCase "wget" $ testCmd "wget" "wget --version >/dev/null"-	, TestCase "wget unclutter options" checkWgetUnclutter 	, TestCase "bup" $ testCmd "bup" "bup --version >/dev/null" 	, TestCase "nice" $ testCmd "nice" "nice true >/dev/null" 	, TestCase "ionice" $ testCmd "ionice" "ionice -c3 true >/dev/null"@@ -105,19 +100,6 @@ 		when (v < oldestallowed) $ 			error $ "installed git version " ++ show v ++ " is too old! (Need " ++ show oldestallowed ++ " or newer)" 		return $ Config "gitversion" $ StringConfig $ show v--checkWgetUnclutter :: Test-checkWgetUnclutter = Config "wgetunclutter" . BoolConfig-	. maybe False (>= normalize "1.16")-	<$> getWgetVersion --getWgetVersion :: IO (Maybe DottedVersion)-getWgetVersion = catchDefaultIO Nothing $-	extract <$> readProcess "wget" ["--version"]-  where-	extract s = case lines s of-		[] -> Nothing-		(l:_) -> normalize <$> headMaybe (drop 2 $ words l)  getSshConnectionCaching :: Test getSshConnectionCaching = Config "sshconnectioncaching" . BoolConfig <$>
CHANGELOG view
@@ -1,3 +1,32 @@+git-annex (6.20180409) upstream; urgency=medium++  * Added adb special remote which allows exporting files to Android devices.+  * For url downloads, git-annex now defaults to using a http library,+    rather than wget or curl. But, if annex.web-options is set, it will+    use curl. To use the .netrc file, run: +      git config annex.web-options --netrc+  * git-annex no longer uses wget (and wget is no longer shipped with+    git-annex builds).+  * Enable HTTP connection reuse across multiple files for improved speed.+  * Fix calculation of estimated completion for progress meter.+  * OSX app: Work around libz/libPng/ImageIO.framework version skew+    by not bundling libz, assuming OSX includes a suitable libz.1.dylib.+  * Added annex.retry, annex.retry-delay, and per-remote versions+    to configure transfer retries.+  * Also do forward retrying in cases where no exception is thrown,+    but the transfer failed.+  * When adding a new version of a file, and annex.genmetadata is enabled,+    don't copy the data metadata from the old version of the file,+    instead use the mtime of the file.+  * Avoid running annex.http-headers-command more than once.+  * info: Added "combined size of repositories containing these files"+    stat when run on a directory.+  * info: Changed sorting of numcopies stats table, so it's ordered+    by the variance from the desired number of copies.+  * Fix resuming a download when using curl.++ -- Joey Hess <id@joeyh.name>  Mon, 09 Apr 2018 13:03:15 -0400+ git-annex (6.20180316) upstream; urgency=medium    * New protocol for communicating with git-annex-shell increases speed
@@ -10,7 +10,7 @@            © 2014 Sören Brunk License: AGPL-3+ -Files: Remote/Git.hs Remote/Helper/Ssh.hs+Files: Remote/Git.hs Remote/Helper/Ssh.hs Remote/Adb.hs Copyright: © 2011-2018 Joey Hess <id@joeyh.name> License: AGPL-3+ 
Command/AddUrl.hs view
@@ -27,6 +27,7 @@ import Types.UrlContents import Annex.FileMatcher import Logs.Location+import Messages.Progress import Utility.Metered import Utility.FileSystemEncoding import Utility.HtmlDetect@@ -196,7 +197,8 @@ 		pathmax <- liftIO $ fileNameLengthLimit "." 		urlinfo <- if relaxedOption (downloadOptions o) 			then pure Url.assumeUrlExists-			else Url.withUrlOptions (Url.getUrlInfo urlstring)+			else Url.withUrlOptions $+				liftIO . Url.getUrlInfo urlstring 		file <- adjustFile o <$> case fileOption (downloadOptions o) of 			Just f -> pure f 			Nothing -> case Url.urlSuggestedFile urlinfo of@@ -259,9 +261,8 @@ 	go =<< downloadWith' downloader urlkey webUUID url (AssociatedFile (Just file))   where 	urlkey = addSizeUrlKey urlinfo $ Backend.URL.fromUrl url Nothing-	downloader f p = do-		showOutput-		downloadUrl urlkey p [url] f+	downloader f p = metered (Just p) urlkey (pure Nothing) $ +		\_ p' -> downloadUrl urlkey p' [url] f 	go Nothing = return Nothing 	-- If we downloaded a html file, try to use youtube-dl to 	-- extract embedded media.@@ -339,7 +340,7 @@ 	checkDiskSpaceToGet dummykey Nothing $ do 		tmp <- fromRepo $ gitAnnexTmpObjectLocation dummykey 		ok <- Transfer.notifyTransfer Transfer.Download url $-			Transfer.download u dummykey afile Transfer.forwardRetry $ \p -> do+			Transfer.download u dummykey afile Transfer.stdRetry $ \p -> do 				liftIO $ createDirectoryIfMissing True (parentDir tmp) 				downloader tmp p 		if ok
Command/Export.hs view
@@ -216,6 +216,8 @@ 	sent <- case ek of 		AnnexKey k -> ifM (inAnnex k) 			( notifyTransfer Upload af $+				-- Using noRetry here because interrupted+				-- exports cannot be resumed. 				upload (uuid r) k af noRetry $ \pm -> do 					let rollback = void $ 						performUnexport r ea db [ek] loc
Command/Get.hs view
@@ -110,7 +110,7 @@ 			either (const False) id <$> Remote.hasKey r key 		| otherwise = return True 	docopy r witness = getViaTmp (RemoteVerify r) key $ \dest ->-		download (Remote.uuid r) key afile forwardRetry+		download (Remote.uuid r) key afile stdRetry 			(\p -> do 				showAction $ "from " ++ Remote.name r 				Remote.retrieveKeyFile r key afile dest p
Command/ImportFeed.hs view
@@ -33,6 +33,7 @@ import Logs.File import qualified Utility.Format import Utility.Tmp+import Utility.Metered import Command.AddUrl (addUrlFile, downloadRemoteFile, parseDownloadOptions, DownloadOptions(..)) import Annex.UUID import Backend.URL (fromUrl)@@ -148,12 +149,10 @@ downloadFeed :: URLString -> Annex (Maybe Feed) downloadFeed url 	| Url.parseURIRelaxed url == Nothing = giveup "invalid feed url"-	| otherwise = do-		showOutput-		uo <- Url.getUrlOptions+	| otherwise = Url.withUrlOptions $ \uo -> 		liftIO $ withTmpFile "feed" $ \f h -> do 			hClose h-			ifM (Url.download url f uo)+			ifM (Url.download nullMeterUpdate url f uo) 				( parseFeedString <$> readFileStrict f 				, return Nothing 				)@@ -167,7 +166,8 @@ 				then do 					urlinfo <- if relaxedOption (downloadOptions opts) 						then pure Url.assumeUrlExists-						else Url.withUrlOptions (Url.getUrlInfo url)+						else Url.withUrlOptions $+							liftIO . Url.getUrlInfo url 					let dlopts = (downloadOptions opts) 						-- force using the filename 						-- chosen here
Command/Info.hs view
@@ -56,6 +56,15 @@ 	, backendsKeys :: M.Map KeyVariety Integer 	} +instance Monoid KeyData where+	mempty = KeyData 0 0 0 M.empty+	mappend a b = KeyData+		{ countKeys = countKeys a + countKeys b+		, sizeKeys = sizeKeys a + sizeKeys b+		, unknownSizeKeys = unknownSizeKeys a + unknownSizeKeys b+		, backendsKeys = backendsKeys a <> backendsKeys b+		}+ data NumCopiesStats = NumCopiesStats 	{ numCopiesVarianceMap :: M.Map Variance Integer 	}@@ -237,6 +246,7 @@ tree_slow_stats = 	[ const numcopies_stats 	, const reposizes_stats+	, const reposizes_total 	]  file_stats :: FilePath -> Key -> [Stat]@@ -467,7 +477,7 @@ 	calc <$> (maybe M.empty numCopiesVarianceMap <$> cachedNumCopiesStats)   where 	calc = map (\(variance, count) -> (show variance, count)) -		. sortBy (flip (comparing snd))+		. sortBy (flip (comparing fst)) 		. M.toList 	fmt = multiLine . map (\(variance, count) -> "numcopies " ++ variance ++ ": " ++ show count) @@ -491,6 +501,10 @@ 		, dispJson = sz 		} 	lpad n s = (replicate (n - length s) ' ') ++ s++reposizes_total :: Stat+reposizes_total = simpleStat "combined size of repositories containing these files" $+	showSizeKeys . mconcat . M.elems =<< cachedRepoData  cachedPresentData :: StatState KeyData cachedPresentData = do
Command/Move.hs view
@@ -134,7 +134,7 @@ 		Right False -> do 			showAction $ "to " ++ Remote.name dest 			ok <- notifyTransfer Upload afile $-				upload (Remote.uuid dest) key afile forwardRetry $+				upload (Remote.uuid dest) key afile stdRetry $ 					Remote.storeKey dest key afile 			if ok 				then finish $@@ -199,7 +199,7 @@ 		)   where 	go = notifyTransfer Download afile $ -		download (Remote.uuid src) key afile forwardRetry $ \p ->+		download (Remote.uuid src) key afile stdRetry $ \p -> 			getViaTmp (RemoteVerify src) key $ \t -> 				Remote.retrieveKeyFile src key afile t p 	dispatch _ False = stop -- failed
Command/TestRemote.hs view
@@ -110,7 +110,7 @@  -- Variant of a remote with exporttree disabled. disableExportTree :: Remote -> Annex Remote-disableExportTree r = maybe (error "failed disabling exportreee") return +disableExportTree r = maybe (error "failed disabling exportree") return  		=<< adjustRemoteConfig r (M.delete "exporttree")  -- Variant of a remote with exporttree enabled.
Command/TransferKey.hs view
@@ -51,7 +51,7 @@  toPerform :: Key -> AssociatedFile -> Remote -> CommandPerform toPerform key file remote = go Upload file $-	upload (uuid remote) key file forwardRetry $ \p -> do+	upload (uuid remote) key file stdRetry $ \p -> do 		ok <- Remote.storeKey remote key file p 		when ok $ 			Remote.logStatus remote key InfoPresent@@ -59,7 +59,7 @@  fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform fromPerform key file remote = go Upload file $-	download (uuid remote) key file forwardRetry $ \p ->+	download (uuid remote) key file stdRetry $ \p -> 		getViaTmp (RemoteVerify remote) key $  			\t -> Remote.retrieveKeyFile remote key file t p 
Command/TransferKeys.hs view
@@ -35,13 +35,13 @@   where 	runner (TransferRequest direction remote key file) 		| direction == Upload = notifyTransfer direction file $-			upload (Remote.uuid remote) key file forwardRetry $ \p -> do+			upload (Remote.uuid remote) key file stdRetry $ \p -> do 				ok <- Remote.storeKey remote key file p 				when ok $ 					Remote.logStatus remote key InfoPresent 				return ok 		| otherwise = notifyTransfer direction file $-			download (Remote.uuid remote) key file forwardRetry $ \p ->+			download (Remote.uuid remote) key file stdRetry $ \p -> 				getViaTmp (RemoteVerify remote) key $ \t -> do 					r <- Remote.retrieveKeyFile remote key file t p 					-- Make sure we get the current
Messages/Progress.hs view
@@ -83,19 +83,11 @@ 				Nothing -> return Nothing 				Just f -> catchMaybeIO $ liftIO $ getFileSize f -{- Poll file size to display meter, but only when concurrent output or- - json progress needs the information. -}+{- Poll file size to display meter. -} meteredFile :: FilePath -> Maybe MeterUpdate -> Key -> Annex a -> Annex a meteredFile file combinemeterupdate key a = -	withMessageState $ \s -> if needOutputMeter s-		then metered combinemeterupdate key (return Nothing) $ \_ p ->-			watchFileSize file p a-		else a-  where-	needOutputMeter s = case outputType s of-		JSONOutput jsonoptions -> jsonProgress jsonoptions-		NormalOutput | concurrentOutputEnabled s -> True-		_ -> False+	metered combinemeterupdate key (return Nothing) $ \_ p ->+		watchFileSize file p a  {- Progress dots. -} showProgressDots :: Annex ()
P2P/Annex.hs view
@@ -120,6 +120,7 @@   where 	transfer mk k af ta = case runst of 		-- Update transfer logs when serving.+		-- Using noRetry because we're the sender. 		Serving theiruuid _ _ ->  			mk theiruuid k af noRetry ta noNotification 		-- Transfer logs are updated higher in the stack when
+ Remote/Adb.hs view
@@ -0,0 +1,280 @@+{- Remote on Android device accessed using adb.+ -+ - Copyright 2018 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Remote.Adb (remote) where++import qualified Data.Map as M++import Annex.Common+import Types.Remote+import Types.Creds+import Types.Export+import qualified Git+import Config.Cost+import Remote.Helper.Special+import Remote.Helper.Messages+import Remote.Helper.Export+import Annex.UUID+import Utility.Metered++-- | Each Android device has a serial number.+newtype AndroidSerial = AndroidSerial { fromAndroidSerial :: String }+	deriving (Show, Eq)++-- | A location on an Android device. +newtype AndroidPath = AndroidPath { fromAndroidPath :: FilePath }++remote :: RemoteType+remote = RemoteType+	{ typename = "adb"+	, enumerate = const (findSpecialRemotes "adb")+	, generate = gen+	, setup = adbSetup+	, exportSupported = exportIsSupported+	}++gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)+gen r u c gc = do+	let this = Remote+		{ uuid = u+		-- adb operates over USB or wifi, so is not as cheap+		-- as local, but not too expensive+		, cost = semiExpensiveRemoteCost+		, name = Git.repoDescribe r+		, storeKey = storeKeyDummy+		, retrieveKeyFile = retreiveKeyFileDummy+		, retrieveKeyFileCheap = \_ _ _ -> return False+		, removeKey = removeKeyDummy+		, lockContent = Nothing+		, checkPresent = checkPresentDummy+		, checkPresentCheap = False+		, exportActions = return $ ExportActions+			{ storeExport = storeExportM serial adir+			, retrieveExport = retrieveExportM serial adir+			, removeExport = removeExportM serial adir+			, checkPresentExport = checkPresentExportM this serial adir+			, removeExportDirectory = Just $ removeExportDirectoryM serial adir+			, renameExport = renameExportM serial adir+			}+		, whereisKey = Nothing+		, remoteFsck = Nothing+		, repairRepo = Nothing+		, config = c+		, repo = r+		, gitconfig = gc+		, localpath = Nothing+		, remotetype = remote+		, availability = LocallyAvailable+		, readonly = False+		, mkUnavailable = return Nothing+		, getInfo = return+			[ ("androidserial", fromAndroidSerial serial)+			, ("androiddirectory", fromAndroidPath adir)+			]+		, claimUrl = Nothing+		, checkUrl = Nothing+		}+	return $ Just $ specialRemote c+		(simplyPrepare $ store serial adir)+		(simplyPrepare $ retrieve serial adir)+		(simplyPrepare $ remove serial adir)+		(simplyPrepare $ checkKey this serial adir)+		this+  where+	adir = maybe (giveup "missing androiddirectory") AndroidPath+		(remoteAnnexAndroidDirectory gc)+	serial = maybe (giveup "missing androidserial") AndroidSerial+		(remoteAnnexAndroidSerial gc)++adbSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)+adbSetup _ mu _ c gc = do+	u <- maybe (liftIO genUUID) return mu++	-- verify configuration+	adir <- maybe (giveup "Specify androiddirectory=") (pure . AndroidPath)+		(M.lookup "androiddirectory" c)+	serial <- getserial =<< liftIO enumerateAdbConnected+	let c' = M.insert "androidserial" (fromAndroidSerial serial) c++	(c'', _encsetup) <- encryptionSetup c' gc++	ok <- liftIO $ adbShellBool serial+		[Param "mkdir", Param "-p", File (fromAndroidPath adir)]+	unless ok $+		giveup "Creating directory on Android device failed."++	gitConfigSpecialRemote u c''+		[ ("adb", "true")+		, ("androiddirectory", fromAndroidPath adir)+		, ("androidserial", fromAndroidSerial serial)+		]++	return (c'', u)+  where+	getserial [] = giveup "adb does not list any connected android devices. Plug in an Android device, or configure adb, and try again.."+	getserial l = case M.lookup "androidserial" c of+		Nothing -> case l of+			(s:[]) -> return s+			_ -> giveup $ unlines $+				"There are multiple connected android devices, specify which to use with androidserial="+				: map fromAndroidSerial l+		Just cs+			| AndroidSerial cs `elem` l -> return (AndroidSerial cs)+			| otherwise -> giveup $ "The device with androidserial=" ++ cs ++ " is not connected."++store :: AndroidSerial -> AndroidPath -> Storer+store serial adir = fileStorer $ \k src _p -> +	let dest = androidLocation adir k+	in store' serial dest src++store' :: AndroidSerial -> AndroidPath -> FilePath -> Annex Bool+store' serial dest src = do+	let destdir = takeDirectory $ fromAndroidPath dest+	liftIO $ void $ adbShell serial [Param "mkdir", Param "-p", File destdir]+	showOutput -- make way for adb push output+	let tmpdest = fromAndroidPath dest ++ ".tmp"+	ifM (liftIO $ boolSystem "adb" (mkAdbCommand serial [Param "push", File src, File tmpdest]))+		-- move into place atomically+		( liftIO $ adbShellBool serial [Param "mv", File tmpdest, File (fromAndroidPath dest)]+		, return False+		)++retrieve :: AndroidSerial -> AndroidPath -> Retriever+retrieve serial adir = fileRetriever $ \dest k _p ->+	let src = androidLocation adir k+	in unlessM (retrieve' serial src dest) $+		giveup "adb pull failed"++retrieve' :: AndroidSerial -> AndroidPath -> FilePath -> Annex Bool+retrieve' serial src dest = do+	showOutput -- make way for adb pull output+	liftIO $ boolSystem "adb" $ mkAdbCommand serial+		[ Param "pull"+		, File $ fromAndroidPath src+		, File dest+		]++remove :: AndroidSerial -> AndroidPath -> Remover+remove serial adir k = remove' serial (androidLocation adir k)++remove' :: AndroidSerial -> AndroidPath -> Annex Bool+remove' serial aloc = liftIO $ adbShellBool serial+	[Param "rm", Param "-f", File (fromAndroidPath aloc)]++checkKey :: Remote -> AndroidSerial -> AndroidPath -> CheckPresent+checkKey r serial adir k = checkKey' r serial (androidLocation adir k)++checkKey' :: Remote -> AndroidSerial -> AndroidPath -> Annex Bool+checkKey' r serial aloc = do+	showChecking r+	(out, st) <- liftIO $ adbShellRaw serial $ unwords+		[ "if test -e ", shellEscape (fromAndroidPath aloc)+		, "; then echo y"+		, "; else echo n"+		, "; fi"+		]+	case (out, st) of+		(["y"], ExitSuccess) -> return True+		(["n"], ExitSuccess) -> return False+		_ -> giveup $ "unable to access Android device" ++ show out++androidLocation :: AndroidPath -> Key -> AndroidPath+androidLocation adir k = AndroidPath $+	fromAndroidPath (androidHashDir adir k) ++ key2file k++androidHashDir :: AndroidPath -> Key -> AndroidPath+androidHashDir adir k = AndroidPath $ +	fromAndroidPath adir ++ "/" ++ hdir+  where+	hdir = replace [pathSeparator] "/" (hashDirLower def k)++storeExportM :: AndroidSerial -> AndroidPath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool +storeExportM serial adir src _k loc _p = store' serial dest src+  where+	dest = androidExportLocation adir loc++retrieveExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool+retrieveExportM serial adir _k loc dest _p = retrieve' serial src dest+  where+	src = androidExportLocation adir loc++removeExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> Annex Bool+removeExportM serial adir _k loc = remove' serial aloc+  where+	aloc = androidExportLocation adir loc++removeExportDirectoryM :: AndroidSerial -> AndroidPath -> ExportDirectory -> Annex Bool+removeExportDirectoryM serial abase dir = liftIO $ adbShellBool serial+	[Param "rm", Param "-rf", File (fromAndroidPath adir)]+  where+	adir = androidExportLocation abase (mkExportLocation (fromExportDirectory dir))++checkPresentExportM :: Remote -> AndroidSerial -> AndroidPath -> Key -> ExportLocation -> Annex Bool+checkPresentExportM r serial adir _k loc = checkKey' r serial aloc+  where+	aloc = androidExportLocation adir loc++renameExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> ExportLocation -> Annex Bool+renameExportM serial adir _k old new = liftIO $ adbShellBool serial+	[Param "mv", Param "-f", File oldloc, File newloc]+  where+	oldloc = fromAndroidPath $ androidExportLocation adir old+	newloc = fromAndroidPath $ androidExportLocation adir new++androidExportLocation :: AndroidPath -> ExportLocation -> AndroidPath+androidExportLocation adir loc = AndroidPath $+	fromAndroidPath adir ++ "/" ++ fromExportLocation loc++-- | List all connected Android devices.+enumerateAdbConnected :: IO [AndroidSerial]+enumerateAdbConnected = +	mapMaybe parse . lines <$> readProcess "adb" ["devices"]+  where+	parse l = +		let (serial, desc) = separate (== '\t') l+		in if null desc || length serial /= 16+			then Nothing +			else Just (AndroidSerial serial)++-- | Runs a command on the android device with the given serial number.+--+-- adb shell does not propigate the exit code of the command, so+-- it is echoed out in a trailing line, and the output is read to determine+-- it. Any stdout from the command is returned, separated into lines.+adbShell :: AndroidSerial -> [CommandParam] -> IO ([String], ExitCode)+adbShell serial cmd = adbShellRaw serial $+	unwords $ map shellEscape (toCommand cmd)++adbShellBool :: AndroidSerial -> [CommandParam] -> IO Bool+adbShellBool serial cmd = do+	(_ , ec) <- adbShell serial cmd+	return (ec == ExitSuccess)++-- | Runs a raw shell command on the android device.+-- Any necessary shellEscaping must be done by caller.+adbShellRaw :: AndroidSerial -> String -> IO ([String], ExitCode)+adbShellRaw serial cmd = processoutput <$> readProcess "adb"+	[ "-s"+	, fromAndroidSerial serial+	, "shell"+	-- The extra echo is in case cmd does not output a trailing+	-- newline after its other output.+	, cmd ++ "; echo; echo $?"+	]+  where+	processoutput s = case reverse (map trimcr (lines s)) of+		(c:"":rest) -> case readish c of+			Just 0 -> (reverse rest, ExitSuccess)+			Just n -> (reverse rest, ExitFailure n)+			Nothing -> (reverse rest, ExitFailure 1)+		ls -> (reverse ls, ExitFailure 1)+	-- For some reason, adb outputs lines with \r\n on linux,+	-- despite both linux and android being unix systems.+	trimcr = takeWhile (/= '\r')++mkAdbCommand :: AndroidSerial -> [CommandParam] -> [CommandParam]+mkAdbCommand serial cmd = [Param "-s", Param (fromAndroidSerial serial)] ++ cmd
Remote/BitTorrent.hs view
@@ -193,13 +193,13 @@ 		( return True 		, do 			showAction "downloading torrent file"-			showOutput 			createAnnexDirectory (parentDir torrent) 			if isTorrentMagnetUrl u 				then do 					tmpdir <- tmpTorrentDir u 					let metadir = tmpdir </> "meta" 					createAnnexDirectory metadir+					showOutput 					ok <- downloadMagnetLink u metadir torrent 					liftIO $ removeDirectoryRecursive metadir 					return ok@@ -207,7 +207,8 @@ 					misctmp <- fromRepo gitAnnexTmpMiscDir 					withTmpFileIn misctmp "torrent" $ \f h -> do 						liftIO $ hClose h-						ok <- Url.withUrlOptions $ Url.download u f+						ok <- Url.withUrlOptions $ +							liftIO . Url.download nullMeterUpdate u f 						when ok $ 							liftIO $ renameFile f torrent 						return ok
Remote/Bup.hs view
@@ -112,7 +112,7 @@  	-- The buprepo is stored in git config, as well as this repo's 	-- persistant state, so it can vary between hosts.-	gitConfigSpecialRemote u c' "buprepo" buprepo+	gitConfigSpecialRemote u c' [("buprepo", buprepo)]  	return (c', u) 
Remote/Ddar.hs view
@@ -97,7 +97,7 @@  	-- The ddarrepo is stored in git config, as well as this repo's 	-- persistant state, so it can vary between hosts.-	gitConfigSpecialRemote u c' "ddarrepo" ddarrepo+	gitConfigSpecialRemote u c' [("ddarrepo", ddarrepo)]  	return (c', u) 
Remote/Directory.hs view
@@ -104,7 +104,7 @@  	-- The directory is stored in git config, not in this remote's 	-- persistant state, so it can vary between hosts.-	gitConfigSpecialRemote u c' "directory" absdir+	gitConfigSpecialRemote u c' [("directory", absdir)] 	return (M.delete "directory" c', u)  {- Locations to try to access a given Key in the directory.
Remote/External.hs view
@@ -157,7 +157,7 @@ 			withExternalState external $ 				liftIO . atomically . readTVar . externalConfig -	gitConfigSpecialRemote u c'' "externaltype" externaltype+	gitConfigSpecialRemote u c'' [("externaltype", externaltype)] 	return (c'', u)  checkExportSupported :: RemoteConfig -> RemoteGitConfig -> Annex Bool@@ -683,7 +683,7 @@ checkKeyUrl r k = do 	showChecking r 	us <- getWebUrls k-	anyM (\u -> withUrlOptions $ checkBoth u (keySize k)) us+	anyM (\u -> withUrlOptions $ liftIO . checkBoth u (keySize k)) us  getWebUrls :: Key -> Annex [URLString] getWebUrls key = filter supported <$> getUrls key
Remote/GCrypt.hs view
@@ -218,7 +218,7 @@ 				if Just u == mu || isNothing mu 					then do 						method <- setupRepo gcryptid =<< inRepo (Git.Construct.fromRemoteLocation gitrepo)-						gitConfigSpecialRemote u c' "gcrypt" (fromAccessMethod method)+						gitConfigSpecialRemote u c' [("gcrypt", fromAccessMethod method)] 						return (c', u) 					else giveup $ "uuid mismatch; expected " ++ show mu ++ " but remote gitrepo has " ++ show u ++ " (" ++ show gcryptid ++ ")" 
Remote/Git.hs view
@@ -248,12 +248,11 @@ 				return $ Right r' 			Left l -> return $ Left l -	geturlconfig = do-		uo <- Url.getUrlOptions+	geturlconfig = Url.withUrlOptions $ \uo -> do 		v <- liftIO $ withTmpFile "git-annex.tmp" $ \tmpfile h -> do 			hClose h 			let url = Git.repoLocation r ++ "/config"-			ifM (Url.downloadQuiet url tmpfile uo)+			ifM (Url.download nullMeterUpdate url tmpfile uo) 				( Just <$> pipedconfig "git" [Param "config", Param "--null", Param "--list", Param "--file", File tmpfile] 				, return Nothing 				)@@ -337,10 +336,11 @@ 	r = repo rmt 	checkhttp = do 		showChecking r-		ifM (Url.withUrlOptions $ \uo -> anyM (\u -> Url.checkBoth u (keySize key) uo) (keyUrls rmt key))-			( return True-			, giveup "not found"-			)+		ifM (Url.withUrlOptions $ \uo -> liftIO $+			anyM (\u -> Url.checkBoth u (keySize key) uo) (keyUrls rmt key))+				( return True+				, giveup "not found"+				) 	checkremote =  		let fallback = Ssh.inAnnex r key 		in P2PHelper.checkpresent (Ssh.runProto rmt connpool (cantCheck rmt) fallback) key@@ -467,7 +467,7 @@ 				Just (object, checksuccess) -> do 					copier <- mkCopier hardlink params 					runTransfer (Transfer Download u key)-						file forwardRetry+						file stdRetry 						(\p -> copier object dest (combineMeterUpdate p meterupdate) checksuccess) 	| Git.repoIsSsh (repo r) = if forcersync 		then fallback meterupdate@@ -595,7 +595,7 @@ 				ensureInitialized 				copier <- mkCopier hardlink params 				let verify = Annex.Content.RemoteVerify r-				runTransfer (Transfer Download u key) file forwardRetry $ \p ->+				runTransfer (Transfer Download u key) file stdRetry $ \p -> 					let p' = combineMeterUpdate meterupdate p 					in Annex.Content.saveState True `after` 						Annex.Content.getViaTmp verify key
Remote/Glacier.hs view
@@ -93,7 +93,7 @@ 	case ss of 		Init -> genVault fullconfig gc u 		_ -> return ()-	gitConfigSpecialRemote u fullconfig "glacier" "true"+	gitConfigSpecialRemote u fullconfig [("glacier", "true")] 	return (fullconfig, u)   where 	remotename = fromJust (M.lookup "name" c)
Remote/Helper/Http.hs view
@@ -11,14 +11,14 @@  import Annex.Common import Types.StoreRetrieve-import Utility.Metered import Remote.Helper.Special-import Network.HTTP.Client (RequestBody(..), Response, responseStatus, responseBody, BodyReader, NeedsPopper)-import Network.HTTP.Types+import Utility.Metered  import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as S import Control.Concurrent+import Network.HTTP.Client (RequestBody(..), Response, responseStatus, responseBody, BodyReader, NeedsPopper)+import Network.HTTP.Types  -- A storer that expects to be provided with a http RequestBody containing -- the content to store.
Remote/Helper/Special.hs view
@@ -65,9 +65,10 @@ 	match k _ = "remote." `isPrefixOf` k && (".annex-"++s) `isSuffixOf` k  {- Sets up configuration for a special remote in .git/config. -}-gitConfigSpecialRemote :: UUID -> RemoteConfig -> String -> String -> Annex ()-gitConfigSpecialRemote u c k v = do-	setConfig (remoteConfig remotename k) v+gitConfigSpecialRemote :: UUID -> RemoteConfig -> [(String, String)] -> Annex ()+gitConfigSpecialRemote u c cfgs = do+	forM_ cfgs $ \(k, v) -> +		setConfig (remoteConfig remotename k) v 	setConfig (remoteConfig remotename "uuid") (fromUUID u)   where 	remotename = fromJust (M.lookup "name" c)
Remote/Hook.hs view
@@ -79,7 +79,7 @@ 	let hooktype = fromMaybe (giveup "Specify hooktype=") $ 		M.lookup "hooktype" c 	(c', _encsetup) <- encryptionSetup c gc-	gitConfigSpecialRemote u c' "hooktype" hooktype+	gitConfigSpecialRemote u c' [("hooktype", hooktype)] 	return (c', u)  hookEnv :: Action -> Key -> Maybe FilePath -> IO (Maybe [(String, String)])
Remote/List.hs view
@@ -36,6 +36,7 @@ #ifdef WITH_WEBDAV import qualified Remote.WebDAV #endif+import qualified Remote.Adb import qualified Remote.Tahoe import qualified Remote.Glacier import qualified Remote.Ddar@@ -58,6 +59,7 @@ #ifdef WITH_WEBDAV 	, Remote.WebDAV.remote #endif+	, Remote.Adb.remote 	, Remote.Tahoe.remote 	, Remote.Glacier.remote 	, Remote.Ddar.remote
Remote/Rsync.hs view
@@ -159,7 +159,7 @@  	-- The rsyncurl is stored in git config, not only in this remote's 	-- persistant state, so it can vary between hosts.-	gitConfigSpecialRemote u c' "rsyncurl" url+	gitConfigSpecialRemote u c' [("rsyncurl", url)] 	return (c', u)  {- To send a single key is slightly tricky; need to build up a temporary
Remote/S3.hs view
@@ -1,6 +1,6 @@ {- S3 remotes  -- - Copyright 2011-2017 Joey Hess <id@joeyh.name>+ - Copyright 2011-2018 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -22,12 +22,11 @@ import qualified Data.Map as M import Data.Char import Network.Socket (HostName)-import Network.HTTP.Conduit (Manager, newManager)+import Network.HTTP.Conduit (Manager) import Network.HTTP.Client (responseStatus, responseBody, RequestBody(..)) import Network.HTTP.Types import Control.Monad.Trans.Resource import Control.Monad.Catch-import Data.Conduit import Data.IORef import System.Log.Logger @@ -47,11 +46,12 @@ import Annex.UUID import Logs.Web import Utility.Metered+import qualified Utility.Url as Url import Utility.DataUnits import Utility.FileSystemEncoding import Annex.Content import Annex.Url (withUrlOptions)-import Utility.Url (checkBoth, managerSettings, closeManager)+import Utility.Url (checkBoth, UrlOptions(..))  type BucketName = String @@ -135,7 +135,7 @@ 		] 		 	use fullconfig = do-		gitConfigSpecialRemote u fullconfig "s3" "true"+		gitConfigSpecialRemote u fullconfig [("s3", "true")] 		return (fullconfig, u)  	defaulthost = do@@ -259,22 +259,9 @@  retrieveHelper :: S3Info -> S3Handle -> S3.Object -> FilePath -> MeterUpdate -> Annex () retrieveHelper info h object f p = liftIO $ runResourceT $ do-	(fr, fh) <- allocate (openFile f WriteMode) hClose 	let req = S3.getObject (bucket info) object 	S3.GetObjectResponse { S3.gorResponse = rsp } <- sendS3Handle' h req-	responseBody rsp $$+- sinkprogressfile fh p zeroBytesProcessed-	release fr-  where-	sinkprogressfile fh meterupdate sofar = do-		mbs <- await-		case mbs of-			Nothing -> return ()-			Just bs -> do-				let sofar' = addBytesProcessed sofar (S.length bs)-				liftIO $ do-					void $ meterupdate sofar'-					S.hPut fh bs-				sinkprogressfile fh meterupdate sofar'+	Url.sinkResponseFile p zeroBytesProcessed f WriteMode rsp  retrieveCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool retrieveCheap _ _ _ = return False@@ -295,7 +282,7 @@ 		giveup "No S3 credentials configured" 	Just geturl -> do 		showChecking r-		withUrlOptions $ checkBoth (geturl k) (keySize k)+		withUrlOptions $ liftIO . checkBoth (geturl k) (keySize k) checkKey r info (Just h) k = do 	showChecking r 	checkKeyHelper info h (T.pack $ bucketObject info k)@@ -500,8 +487,8 @@ #if MIN_VERSION_aws(0,17,0) 				Nothing #endif-			bracketIO (newManager managerSettings) closeManager $ \mgr -> -				a $ Just $ S3Handle mgr awscfg s3cfg+			withUrlOptions $ \ou ->+				a $ Just $ S3Handle (httpManager ou) awscfg s3cfg 		Nothing -> a Nothing   where 	s3cfg = s3Configuration c
Remote/Tahoe.hs view
@@ -107,7 +107,7 @@ 			, (scsk, scs) 			] 		else c-	gitConfigSpecialRemote u c' "tahoe" configdir+	gitConfigSpecialRemote u c' [("tahoe", configdir)] 	return (c', u)   where 	scsk = "shared-convergence-secret"
Remote/Web.hs view
@@ -17,6 +17,7 @@ import Config.Cost import Logs.Web import Annex.UUID+import Messages.Progress import Utility.Metered import qualified Annex.Url as Url import Annex.YoutubeDl@@ -74,13 +75,14 @@ 	get [] = do 		warning "no known url" 		return False-	get urls = do-		showOutput -- make way for download progress bar-		untilTrue urls $ \u -> do-			let (u', downloader) = getDownloader u-			case downloader of-				YoutubeDownloader -> youtubeDlTo key u' dest-				_ -> downloadUrl key p [u'] dest+	get urls = untilTrue urls $ \u -> do+		let (u', downloader) = getDownloader u+		case downloader of+			YoutubeDownloader -> do+				showOutput+				youtubeDlTo key u' dest+			_ -> metered (Just p) key (pure Nothing) $ \_ p' -> +				downloadUrl key p' [u'] dest  downloadKeyCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool downloadKeyCheap _ _ _ = return False@@ -108,7 +110,7 @@ 	case downloader of 		YoutubeDownloader -> youtubeDlCheck u' 		_ -> do-			Url.withUrlOptions $ catchMsgIO .+			Url.withUrlOptions $ liftIO . catchMsgIO . 				Url.checkBoth u' (keySize key)   where 	firsthit [] miss _ = return miss
Remote/WebDAV.hs view
@@ -112,7 +112,7 @@ 	(c', encsetup) <- encryptionSetup c gc 	creds <- maybe (getCreds c' gc u) (return . Just) mcreds 	testDav url creds-	gitConfigSpecialRemote u c' "webdav" "true"+	gitConfigSpecialRemote u c' [("webdav", "true")] 	c'' <- setRemoteCredPair encsetup c' gc (davCreds u) creds 	return (c'', u) 
Types/GitConfig.hs view
@@ -90,6 +90,8 @@ 	, annexPidLockTimeout :: Seconds 	, annexAddUnlocked :: Bool 	, annexSecureHashesOnly :: Bool+	, annexRetry :: Maybe Integer+	, annexRetryDelay :: Maybe Seconds 	, coreSymlinks :: Bool 	, coreSharedRepository :: SharedRepository 	, receiveDenyCurrentBranch :: DenyCurrentBranch@@ -154,6 +156,9 @@ 		getmayberead (annex "pidlocktimeout") 	, annexAddUnlocked = getbool (annex "addunlocked") False 	, annexSecureHashesOnly = getbool (annex "securehashesonly") False+	, annexRetry = getmayberead (annex "retry")+	, annexRetryDelay = Seconds+		<$> getmayberead (annex "retrydelay") 	, coreSymlinks = getbool "core.symlinks" True 	, coreSharedRepository = getSharedRepository r 	, receiveDenyCurrentBranch = getDenyCurrentBranch r@@ -208,6 +213,8 @@ 	, remoteAnnexStopCommand :: Maybe String 	, remoteAnnexAvailability :: Maybe Availability 	, remoteAnnexBare :: Maybe Bool+	, remoteAnnexRetry :: Maybe Integer+	, remoteAnnexRetryDelay :: Maybe Seconds  	{- These settings are specific to particular types of remotes 	 - including special remotes. -}@@ -224,6 +231,8 @@ 	, remoteAnnexTahoe :: Maybe FilePath 	, remoteAnnexBupSplitOptions :: [String] 	, remoteAnnexDirectory :: Maybe FilePath+	, remoteAnnexAndroidDirectory :: Maybe FilePath+	, remoteAnnexAndroidSerial :: Maybe String 	, remoteAnnexGCrypt :: Maybe String 	, remoteAnnexDdarRepo :: Maybe String 	, remoteAnnexHookType :: Maybe String@@ -259,7 +268,9 @@ 		, remoteAnnexStopCommand = notempty $ getmaybe "stop-command" 		, remoteAnnexAvailability = getmayberead "availability" 		, remoteAnnexBare = getmaybebool "bare"-	+		, remoteAnnexRetry = getmayberead "retry"+		, remoteAnnexRetryDelay = Seconds+			<$> getmayberead "retrydelay" 		, remoteAnnexShell = getmaybe "shell" 		, remoteAnnexSshOptions = getoptions "ssh-options" 		, remoteAnnexRsyncOptions = getoptions "rsync-options"@@ -273,6 +284,8 @@ 		, remoteAnnexTahoe = getmaybe "tahoe" 		, remoteAnnexBupSplitOptions = getoptions "bup-split-options" 		, remoteAnnexDirectory = notempty $ getmaybe "directory"+		, remoteAnnexAndroidDirectory = notempty $ getmaybe "androiddirectory"+		, remoteAnnexAndroidSerial = notempty $ getmaybe "androidserial" 		, remoteAnnexGCrypt = notempty $ getmaybe "gcrypt" 		, remoteAnnexDdarRepo = getmaybe "ddarrepo" 		, remoteAnnexHookType = notempty $ getmaybe "hooktype"
Types/MetaData.hs view
@@ -252,13 +252,15 @@ 	= AddMeta MetaField MetaValue 	| DelMeta MetaField (Maybe MetaValue) 	-- ^ delete value of a field. With Just, only that specific value-	-- is deleted; with Nothing, all current values are deleted.a+	-- is deleted; with Nothing, all current values are deleted. 	| DelAllMeta 	-- ^ delete all currently set metadata 	| SetMeta MetaField (S.Set MetaValue) 	-- ^ removes any existing values 	| MaybeSetMeta MetaField MetaValue 	-- ^ set when field has no existing value+	| ComposeModMeta ModMeta ModMeta+	-- ^ composing multiple modifications 	deriving (Show)  {- Applies a ModMeta, generating the new MetaData.@@ -279,6 +281,7 @@ modMeta m (MaybeSetMeta f v) 	| S.null (currentMetaDataValues f m) = updateMetaData f v emptyMetaData 	| otherwise = emptyMetaData+modMeta m (ComposeModMeta a b) = unionMetaData (modMeta m a) (modMeta m b)  {- Avoid putting too many fields in the map; extremely large maps make  - the seriaization test slow due to the sheer amount of data.
Utility/Metered.hs view
@@ -326,7 +326,7 @@ setMeterTotalSize (Meter totalsizev _ _ _) = void . swapMVar totalsizev . Just  -- | Updates the meter, displaying it if necessary.-updateMeter :: Meter -> BytesProcessed -> IO ()+updateMeter :: Meter -> MeterUpdate updateMeter (Meter totalsizev sv bv displaymeter) new = do 	now <- getPOSIXTime 	(old, before) <- swapMVar sv (new, now)@@ -383,5 +383,5 @@ 		Just totalsize 			| bytespersecond > 0 ->  				Just $ fromDuration $ Duration $-					totalsize `div` bytespersecond+					(totalsize - new) `div` bytespersecond 		_ -> Nothing
Utility/Url.hs view
@@ -1,6 +1,6 @@ {- Url downloading.  -- - Copyright 2011-2017 Joey Hess <id@joeyh.name>+ - Copyright 2011-2018 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}@@ -11,11 +11,12 @@ {-# LANGUAGE FlexibleContexts #-}  module Utility.Url (-	closeManager,+	newManager, 	managerSettings, 	URLString, 	UserAgent,-	UrlOptions,+	UrlOptions(..),+	defUrlOptions, 	mkUrlOptions, 	check, 	checkBoth,@@ -24,7 +25,7 @@ 	getUrlInfo, 	assumeUrlExists, 	download,-	downloadQuiet,+	sinkResponseFile, 	downloadPartial, 	parseURIRelaxed, 	matchStatusCodeException,@@ -32,8 +33,7 @@ ) where  import Common-import Utility.Tmp.Dir-import qualified BuildInfo+import Utility.Metered  import Network.URI import Network.HTTP.Types@@ -42,17 +42,9 @@ 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.Conduit 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.-#if ! MIN_VERSION_http_client(0,4,18)-import Network.HTTP.Client (closeManager)-#else-closeManager :: Manager -> IO ()-closeManager _ = return ()-#endif+import Data.Conduit  #if ! MIN_VERSION_http_client(0,5,0) responseTimeoutNone :: Maybe Int@@ -76,18 +68,30 @@ data UrlOptions = UrlOptions 	{ userAgent :: Maybe UserAgent 	, reqHeaders :: Headers-	, reqParams :: [CommandParam]+	, urlDownloader :: UrlDownloader 	, applyRequest :: Request -> Request+	, httpManager :: Manager 	} -instance Default UrlOptions-  where-	def = UrlOptions Nothing [] [] id+data UrlDownloader+	= DownloadWithConduit+	| DownloadWithCurl [CommandParam] -mkUrlOptions :: Maybe UserAgent -> Headers -> [CommandParam] -> UrlOptions-mkUrlOptions defuseragent reqheaders reqparams =-	UrlOptions useragent reqheaders reqparams applyrequest+defUrlOptions :: IO UrlOptions+defUrlOptions = UrlOptions+	<$> pure Nothing+	<*> pure []+	<*> pure DownloadWithConduit+	<*> pure id+	<*> newManager managerSettings++mkUrlOptions :: Maybe UserAgent -> Headers -> [CommandParam] -> Manager -> UrlOptions+mkUrlOptions defuseragent reqheaders reqparams manager =+	UrlOptions useragent reqheaders urldownloader applyrequest manager   where+	urldownloader = if null reqparams+		then DownloadWithConduit+		else DownloadWithCurl reqparams 	applyrequest = \r -> r { requestHeaders = requestHeaders r ++ addedheaders } 	addedheaders = uaheader ++ otherheaders 	useragent = maybe defuseragent (Just . B8.toString . snd)@@ -104,11 +108,16 @@ 			(' ':v') -> (h', B8.fromString v') 			_ -> (h', B8.fromString v) -addUserAgent :: UrlOptions -> [CommandParam] -> [CommandParam]-addUserAgent uo ps = case userAgent uo of-	Nothing -> ps-	-- --user-agent works for both wget and curl commands-	Just ua -> ps ++ [Param "--user-agent", Param ua] +curlParams :: UrlOptions -> [CommandParam] -> [CommandParam]+curlParams uo ps = ps ++ uaparams ++ headerparams ++ addedparams+  where+	uaparams = case userAgent uo of+		Nothing -> []+		Just ua -> [Param "--user-agent", Param ua]+	headerparams = concatMap (\h -> [Param "-H", Param h]) (reqHeaders uo)+	addedparams = case urlDownloader uo of+		DownloadWithConduit -> []+		DownloadWithCurl l -> l  {- Checks that an url exists and could be successfully downloaded,  - also checking that its size, if available, matches a specified size. -}@@ -118,7 +127,7 @@ 	return (fst v && snd v)  check :: URLString -> Maybe Integer -> UrlOptions -> IO (Bool, Bool)-check url expected_size = go <$$> getUrlInfo url+check url expected_size uo = go <$> getUrlInfo url uo   where 	go (UrlInfo False _ _) = (False, False) 	go (UrlInfo True Nothing _) = (True, True)@@ -143,8 +152,8 @@  - 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 req -> catchJust+	Just u -> case (urlDownloader uo, parseUrlConduit (show u)) of+		(DownloadWithConduit, Just req) -> catchJust 			-- When http redirects to a protocol which  			-- conduit does not support, it will throw 			-- a StatusCodeException with found302.@@ -154,7 +163,7 @@ 			`catchNonAsync` (const dne) 		-- http-conduit does not support file:, ftp:, etc urls, 		-- so fall back to reading files and using curl.-		Nothing+		_ 			| uriScheme u == "file:" -> do 				let f = unEscapeString (uriPath u) 				s <- catchMaybeIO $ getFileStatus f@@ -163,19 +172,18 @@ 						sz <- getFileSize' f stat 						found (Just sz) Nothing 					Nothing -> dne-			| BuildInfo.curl -> existscurl u-			| otherwise -> dne+			| otherwise -> existscurl u 	Nothing -> dne   where 	dne = return $ UrlInfo False Nothing Nothing 	found sz f = return $ UrlInfo True sz f -	curlparams = addUserAgent uo $+	curlparams = curlParams uo $ 		[ Param "-s" 		, Param "--head" 		, Param "-L", Param url 		, Param "-w", Param "%{http_code}"-		] ++ concatMap (\h -> [Param "-H", Param h]) (reqHeaders uo) ++ (reqParams uo)+		]  	extractlencurl s = case lastMaybe $ filter ("Content-Length:" `isPrefixOf`) (lines s) of 		Just l -> case lastMaybe $ words l of@@ -183,28 +191,23 @@ 			_ -> Nothing 		_ -> Nothing 	-	extractlen = readish . B8.toString <=< firstheader hContentLength+	extractlen = readish . B8.toString+		<=< lookup hContentLength . responseHeaders  	extractfilename = contentDispositionFilename . B8.toString-		<=< firstheader hContentDisposition--	firstheader h = headMaybe . map snd .-		filter (\p -> fst p == h) . responseHeaders+		<=< lookup hContentDisposition . responseHeaders  	existsconduit req = do-		mgr <- newManager managerSettings 		let req' = headRequest (applyRequest uo req)-		ret <- runResourceT $ do-			resp <- http req' mgr-			-- forces processing the response before the-			-- manager is closed+		runResourceT $ do+			resp <- http req' (httpManager uo)+			-- forces processing the response while+			-- within the runResourceT 			liftIO $ if responseStatus resp == ok200 				then found 					(extractlen resp) 					(extractfilename resp) 				else dne-		liftIO $ closeManager mgr-		return ret  	existscurl u = do 		output <- catchDefaultIO "" $@@ -244,80 +247,100 @@  {- Download a perhaps large file, with auto-resume of incomplete downloads.  -- - Uses wget or curl program for its progress bar and resuming support. - - Which program to use is determined at run time depending on which is- - in path and which works best in a particular situation.+ - By default, conduit is used for the download, except for file: urls,+ - which are copied. If the url scheme is not supported by conduit, falls+ - back to using curl.  -}-download :: URLString -> FilePath -> UrlOptions -> IO Bool-download = download' False+download :: MeterUpdate -> URLString -> FilePath -> UrlOptions -> IO Bool+download meterupdate url file uo = go `catchNonAsync` (const $ return False)+  where+	go = case parseURIRelaxed url of+		Just u -> case (urlDownloader uo, parseUrlConduit (show u)) of+			(DownloadWithConduit, Just req) -> catchJust+				-- When http redirects to a protocol which +				-- conduit does not support, it will throw+				-- a StatusCodeException with found302.+				(matchStatusCodeException (== found302))+				(downloadconduit req)+				(const downloadcurl)+			_+				| uriScheme u == "file:" -> do+					let src = unEscapeString (uriPath u)+					withMeteredFile src meterupdate $+						L.writeFile file+					return True+				| otherwise -> downloadcurl+		Nothing -> return False -{- No output to stdout. -}-downloadQuiet :: URLString -> FilePath -> UrlOptions -> IO Bool-downloadQuiet = download' True+	downloadconduit req = catchMaybeIO (getFileSize file) >>= \case+		Nothing -> runResourceT $ do+			resp <- http req (httpManager uo)+			if responseStatus resp == ok200+				then store zeroBytesProcessed WriteMode resp+				else return False+		Just sz -> resumeconduit req sz+	+	alreadydownloaded sz s h = s == requestedRangeNotSatisfiable416 +		&& case lookup hContentRange h of+			-- This could be improved by fixing+			-- https://github.com/aristidb/http-types/issues/87+			Just crh -> crh == B8.fromString ("bytes */" ++ show sz)+			Nothing -> False -download' :: Bool -> URLString -> FilePath -> UrlOptions -> IO Bool-download' quiet url file uo = do-	case parseURIRelaxed url of-		Just u-			| uriScheme u == "file:" -> curl-			-- curl is preferred in quiet mode, because-			-- it displays http errors to stderr, while wget-			-- does not display them in quiet mode-			| quiet -> ifM (inPath "curl") (curl, wget)-			-- wget is preferred mostly because it has a better-			-- progress bar-			| otherwise -> ifM (inPath "wget") (wget , curl)-		_ -> return False-  where-	headerparams = map (\h -> Param $ "--header=" ++ h) (reqHeaders uo)-	wget = go "wget" $ headerparams ++ quietopt "-q" ++ wgetparams-	{- Regular wget needs --clobber to continue downloading an existing-	 - file. On Android, busybox wget is used, which does not-	 - support, or need that option.-	 --	 - When the wget version is new enough, pass options for-	 - a less cluttered download display. Using -nv rather than -q-	 - avoids most clutter while still displaying http errors.-	 -}-#ifndef __ANDROID__-	wgetparams = concat-		[ if BuildInfo.wgetunclutter && not quiet-			then [Param "-nv", Param "--show-progress"]-			else []-		, [ Param "--clobber", Param "-c", Param "-O"]-		]-#else-	wgetparams = [Param "-c", Param "-O"]-#endif-	{- Uses the -# progress display, because the normal-	 - one is very confusing when resuming, showing-	 - the remainder to download as the whole file,-	 - and not indicating how much percent was-	 - downloaded before the resume. -}-	curl = do+	-- Resume download from where a previous download was interrupted, +	-- when supported by the http server. The server may also opt to+	-- send the whole file rather than resuming.+	resumeconduit req sz = catchJust+		(matchStatusCodeHeadersException (alreadydownloaded sz))+		dl+		(const $ return True)+	  where+		dl = runResourceT $ do+			let req' = req { requestHeaders = resumeFromHeader sz : requestHeaders req }+			resp <- http req' (httpManager uo)+			if responseStatus resp == partialContent206+				then store (BytesProcessed sz) AppendMode resp+				else if responseStatus resp == ok200+					then store zeroBytesProcessed WriteMode resp+					else return False+	+	store initialp mode resp = do+		sinkResponseFile meterupdate initialp file mode resp+		return True+	+	downloadcurl = do 		-- curl does not create destination file 		-- if the url happens to be empty, so pre-create.-		writeFile file ""-		go "curl" $ headerparams ++ quietopt "-sS" ++-			[ Param "-f"+		unlessM (doesFileExist file) $+			writeFile file ""+		let ps = curlParams uo+			[ Param "-sS"+			, Param "-f" 			, Param "-L" 			, Param "-C", Param "-"-			, Param "-#"-			, Param "-o" 			]-	-	{- Run wget in a temp directory because it has been buggy-	 - and overwritten files in the current directory, even though-	 - it was asked to write to a file elsewhere. -}-	go cmd opts = withTmpDir "downloadurl" $ \tmp -> do-		absfile <- absPath file-		let ps = addUserAgent uo $ opts++reqParams uo++[File absfile, File url]-		boolSystem' cmd ps $ \p -> p { cwd = Just tmp }-	-	quietopt s-		| quiet = [Param s]-		| otherwise = []+		boolSystem "curl" (ps ++ [Param "-o", File file, File url]) +{- Sinks a Response's body to a file. The file can either be opened in+ - WriteMode or AppendMode. Updates the meter as data is received.+ -+ - Note that the responseStatus is not checked by this function.+ -}+sinkResponseFile :: MonadResource m => MeterUpdate -> BytesProcessed -> FilePath -> IOMode -> Response (ResumableSource m B8.ByteString) -> m ()+sinkResponseFile meterupdate initialp file mode resp = do+	(fr, fh) <- allocate (openBinaryFile file mode) hClose+	responseBody resp $$+- go initialp fh+	release fr+  where+	go sofar fh = await >>= \case+		Nothing -> return ()+		Just bs -> do+			let sofar' = addBytesProcessed sofar (B.length bs)+			liftIO $ do+				void $ meterupdate sofar'+				B.hPut fh bs+			go sofar' fh+ {- 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@@ -327,14 +350,11 @@ 	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 ->+			withResponse req' (httpManager uo) $ \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@@ -380,22 +400,31 @@ hContentDisposition :: CI.CI B.ByteString hContentDisposition = "Content-Disposition" +hContentRange :: CI.CI B.ByteString+hContentRange = "Content-Range"++resumeFromHeader :: FileSize -> Header+resumeFromHeader sz = (hRange, renderByteRanges [ByteRangeFrom sz])+ {- Use with eg:  -  - > catchJust (matchStatusCodeException (== notFound404))  -}-#if MIN_VERSION_http_client(0,5,0) matchStatusCodeException :: (Status -> Bool) -> HttpException -> Maybe HttpException-matchStatusCodeException want e@(HttpExceptionRequest _ (StatusCodeException r _))-	| want (responseStatus r) = Just e+matchStatusCodeException want = matchStatusCodeHeadersException (\s _h -> want s)++#if MIN_VERSION_http_client(0,5,0)+matchStatusCodeHeadersException :: (Status -> ResponseHeaders -> Bool) -> HttpException -> Maybe HttpException+matchStatusCodeHeadersException want e@(HttpExceptionRequest _ (StatusCodeException r _))+	| want (responseStatus r) (responseHeaders r) = Just e 	| otherwise = Nothing-matchStatusCodeException _ _ = Nothing+matchStatusCodeHeadersException _ _ = Nothing #else-matchStatusCodeException :: (Status -> Bool) -> HttpException -> Maybe HttpException-matchStatusCodeException want e@(StatusCodeException s _ _)-	| want s = Just e+matchStatusCodeHeadersException :: (Status -> ResponseHeaders -> Bool) -> HttpException -> Maybe HttpException+matchStatusCodeHeadersException want e@(StatusCodeException s r _)+	| want s r = Just e 	| otherwise = Nothing-matchStatusCodeException _ _ = Nothing+matchStatusCodeHeadersException _ _ = Nothing #endif  #if MIN_VERSION_http_client(0,5,0)
doc/git-annex-copy.mdwn view
@@ -47,7 +47,7 @@   and always check if the remote has content. Can be useful if the location   tracking information is out of date. -* `--all`+* `--all` `-A`    Rather than specifying a filename or path to copy, this option can be   used to copy all available versions of all files.
doc/git-annex-drop.mdwn view
@@ -35,7 +35,7 @@   the last repository that is storing their content. Data loss can   result from using this option. -* `--all`+* `--all` `-A`    Rather than specifying a filename or path to drop, this option can be   used to drop all available versions of all files.
doc/git-annex-fsck.mdwn view
@@ -65,7 +65,7 @@   To verify data integrity only while disregarding required number of copies,   use `--numcopies=1`. -* `--all`+* `--all` `-A`    Normally only the files in the currently checked out branch   are fscked. This option causes all versions of all files to be fscked.
doc/git-annex-get.mdwn view
@@ -58,7 +58,7 @@   as git-annex does not know the associated file, and the associated file   may not even be in the current git working directory. -* `--all`+* `--all` `-A`    Rather than specifying a filename or path to get, this option can be   used to get all available versions of all files.
doc/git-annex-inprogress.mdwn view
@@ -25,15 +25,25 @@  # OPTIONS -* file matching options- -  The [[git-annex-matching-options]](1)-  can be used to specify files to access.+* `[path ..]` -* `--all`+  The files or directories whose partially downloaded content you want to+  access. +  Note that, when no path is specified, it defaults to all files in the+  current working directory, and subdirectories, which can take a while to+  traverse. It's most efficient to specify a the file you are interested+  in, or to use `--all`++* `--all` `-A`+   Rather than specifying a filename or path, this option can be   used to access all files that are currently being downloaded.++* file matching options+ +  The [[git-annex-matching-options]](1)+  can be used to specify files to access.  # EXIT STATUS 
doc/git-annex-log.mdwn view
@@ -34,7 +34,7 @@   The [[git-annex-matching-options]](1)   can be used to specify files to act on. -* `--all`+* `--all` `-A`    Shows location log changes to all files, with the most recent changes first.   In this mode, the names of files are not available and keys are displayed
doc/git-annex-metadata.mdwn view
@@ -80,7 +80,7 @@   The [[git-annex-matching-options]](1)   can be used to specify files to act on. -* `--all`+* `--all` `-A`    Specify instead of a file to get/set metadata on all known keys. 
doc/git-annex-mirror.mdwn view
@@ -36,7 +36,7 @@   Enables parallel transfers with up to the specified number of jobs   running at once. For example: `-J10` -* `--all`+* `--all` `-A`    Mirror all objects stored in the git annex, not only objects used by   currently existing files. 
doc/git-annex-move.mdwn view
@@ -30,7 +30,7 @@   Enables parallel transfers with up to the specified number of jobs   running at once. For example: `-J10` -* `--all`+* `--all` `-A`    Rather than specifying a filename or path to move, this option can be   used to move all available versions of all files.
doc/git-annex-sync.mdwn view
@@ -94,7 +94,7 @@    This option can be repeated multiple times with different paths. -* `--all`+* `--all` `-A`    This option, when combined with `--content`, makes all available versions   of all files be synced, when preferred content settings allow.
doc/git-annex-whereis.mdwn view
@@ -31,7 +31,7 @@    Show where a particular git-annex key is located. -* `--all`+* `--all` `-A`    Show whereis information for all known keys. 
doc/git-annex.mdwn view
@@ -1248,6 +1248,18 @@    git-annex caches UUIDs of remote repositories here. +* `remote.<name>.annex-retry`, `annex.retry`++  Configure retries of failed transfers on a per-remote and general+  basis, respectively. The value is the number of retries that can be+  made of the same transfer. (default 0)++* `remote.<name>.annex-retry-delay`, `annex.retry-delay`++  Number of seconds to delay before the first retry of a transfer.+  When making multiple retries of the same transfer, the delay +  doubles after each retry. (default 1)+ * `remote.<name>.annex-checkuuid`    This only affects remotes that have their url pointing to a directory on@@ -1344,9 +1356,12 @@  * `annex.web-options` -  Options to pass when running wget or curl.-  For example, to force IPv4 only, set it to "-4"+  Setting this makes git-annex use curl to download urls+  (rather than the default built-in url downloader). +  For example, to force IPv4 only, set it to "-4".+  Or to make curl use your ~/.netrc file, set it to "--netrc".+ * `annex.youtube-dl-options`    Options to pass to youtube-dl when using it to find the url to download@@ -1375,7 +1390,6 @@ * `annex.web-download-command`    Use to specify a command to run to download a file from the web.-  (The default is to use wget or curl.)    In the command line, %url is replaced with the url to download,   and %file is replaced with the file that it should be saved to.@@ -1414,6 +1428,25 @@   the location of the directory where annexed files are stored for this   remote. Normally this is automatically set up by `git annex initremote`,   but you can change it if needed.++* `remote.<name>.adb`++  Used to identify remotes on Android devices accessed via adb.+  Normally this is automatically set up by `git annex initremote`.++* `remote.<name>.androiddirectory`++  Used by adb special remotes, this is the directory on the Android+  device where files are stored for this remote. Normally this is+  automatically set up by `git annex initremote`, but you can change+  it if needed.++* `remote.<name>.androidserial`++  Used by adb special remotes, this is the serial number of the Android+  device used by the remote. Normally this is automatically set up by+  `git annex initremote`, but you can change it if needed, eg when+  upgrading to a new Android device.  * `remote.<name>.s3` 
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 6.20180316+Version: 6.20180409 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -343,6 +343,7 @@    http-client,    http-types (>= 0.7),    http-conduit (>= 2.0),+   conduit,    time,    old-locale,    esqueleto,@@ -409,7 +410,7 @@       Other-Modules: Utility.Touch.Old    if flag(S3)-    Build-Depends: conduit, conduit-extra, aws (>= 0.9.2)+    Build-Depends: aws (>= 0.9.2)     CPP-Options: -DWITH_S3     Other-Modules: Remote.S3 @@ -915,6 +916,7 @@     P2P.IO     P2P.Protocol     Remote+    Remote.Adb     Remote.BitTorrent     Remote.Bup     Remote.Ddar