packages feed

git-annex 5.20141203 → 5.20141219

raw patch · 89 files changed

+2404/−450 lines, 89 filesdep +torrent

Dependencies added: torrent

Files

Annex.hs view
@@ -63,6 +63,7 @@ import Utility.Quvi (QuviVersion) #endif import Utility.InodeCache+import Utility.Url  import "mtl" Control.Monad.Reader import Control.Concurrent@@ -128,6 +129,7 @@ 	, useragent :: Maybe String 	, errcounter :: Integer 	, unusedkeys :: Maybe (S.Set Key)+	, tempurls :: M.Map Key URLString #ifdef WITH_QUVI 	, quviversion :: Maybe QuviVersion #endif@@ -173,6 +175,7 @@ 	, useragent = Nothing 	, errcounter = 0 	, unusedkeys = Nothing+	, tempurls = M.empty #ifdef WITH_QUVI 	, quviversion = Nothing #endif
Annex/UUID.hs view
@@ -23,6 +23,8 @@ 	storeUUID, 	storeUUIDIn, 	setUUID,+	webUUID,+	bitTorrentUUID, ) where  import Common.Annex@@ -98,3 +100,11 @@ setUUID r u = do 	let s = show configkey ++ "=" ++ fromUUID u 	Git.Config.store s r++-- Dummy uuid for the whole web. Do not alter.+webUUID :: UUID+webUUID = UUID "00000000-0000-0000-0000-000000000001"++-- Dummy uuid for bittorrent. Do not alter.+bitTorrentUUID :: UUID+bitTorrentUUID = UUID "00000000-0000-0000-0000-000000000002"
Assistant/Threads/TransferScanner.hs view
@@ -19,7 +19,6 @@ import Logs.Transfer import Logs.Location import Logs.Group-import Logs.Web (webUUID) import qualified Remote import qualified Types.Remote as Remote import Utility.ThreadScheduler@@ -115,7 +114,7 @@  - since we need to look at the locations of all keys anyway.  -} expensiveScan :: UrlRenderer -> [Remote] -> Assistant ()-expensiveScan urlrenderer rs = unless onlyweb $ batch <~> do+expensiveScan urlrenderer rs = batch <~> do 	debug ["starting scan of", show visiblers]  	let us = map Remote.uuid rs@@ -135,7 +134,6 @@ 	remove <- asIO1 $ removableRemote urlrenderer 	liftIO $ mapM_ (void . tryNonAsync . remove) $ S.toList removablers   where-	onlyweb = all (== webUUID) $ map Remote.uuid rs 	visiblers = let rs' = filter (not . Remote.readonly) rs 		in if null rs' then rs else rs' 
Assistant/Upgrade.hs view
@@ -21,6 +21,7 @@ import Logs.Presence import Logs.Location import Annex.Content+import Annex.UUID import qualified Backend import qualified Types.Backend import qualified Types.Key@@ -80,7 +81,7 @@   where 	go Nothing = debug ["Skipping redundant upgrade"] 	go (Just dest) = do-		liftAnnex $ setUrlPresent k u+		liftAnnex $ setUrlPresent webUUID k u 		hook <- asIO1 $ distributionDownloadComplete d dest cleanup 		modifyDaemonStatus_ $ \s -> s 			{ transferHook = M.insert k hook (transferHook s) }@@ -97,7 +98,7 @@ 		} 	cleanup = liftAnnex $ do 		lockContent k removeAnnex-		setUrlMissing k u+		setUrlMissing webUUID k u 		logStatus k InfoMissing  {- Called once the download is done.
Assistant/WebApp/Configurators/Edit.hs view
@@ -42,7 +42,6 @@ import Annex.UUID import Assistant.Ssh import Config-import Logs.Web (webUUID)  import qualified Data.Text as T import qualified Data.Map as M@@ -193,7 +192,7 @@  editForm :: Bool -> RepoId -> Handler Html editForm new (RepoUUID uuid)-	| uuid == webUUID = page "The web" (Just Configuration) $ do+	| uuid == webUUID || uuid == bitTorrentUUID = page "The web" (Just Configuration) $ do 		$(widgetFile "configurators/edit/webrepository") 	| otherwise = page "Edit repository" (Just Configuration) $ do 		mremote <- liftAnnex $ Remote.remoteFromUUID uuid
Assistant/WebApp/Configurators/WebDAV.hs view
@@ -78,7 +78,7 @@ 				-- Box.com has a max file size of 100 mb, but 				-- using smaller chunks has better memory 				-- performance.-				, ("chunksize", "10mb")+				, ("chunk", "10mb") 				] 		_ -> $(widgetFile "configurators/addbox.com") #else
Build/Configure.hs view
@@ -10,10 +10,13 @@  import Build.TestConfig import Build.Version+import Utility.PartialPrelude+import Utility.Process import Utility.SafeCommand import Utility.ExternalSHA import Utility.Env import qualified Git.Version+import Utility.DottedVersion  tests :: [TestCase] tests =@@ -29,6 +32,7 @@ 	, TestCase "rsync" $ requireCmd "rsync" "rsync --version >/dev/null" 	, TestCase "curl" $ testCmd "curl" "curl --version >/dev/null" 	, TestCase "wget" $ testCmd "wget" "wget --version >/dev/null"+	, TestCase "wget supports -q --show-progress" checkWgetQuietProgress 	, 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"@@ -95,6 +99,18 @@ 	when (v < oldestallowed) $ 		error $ "installed git version " ++ show v ++ " is too old! (Need " ++ show oldestallowed ++ " or newer)" 	return $ Config "gitversion" $ StringConfig $ show v++checkWgetQuietProgress :: Test+checkWgetQuietProgress = Config "wgetquietprogress" . BoolConfig+	. maybe False (>= normalize "1.16")+	<$> getWgetVersion ++getWgetVersion :: IO (Maybe DottedVersion)+getWgetVersion = 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 <$>
BuildFlags.hs view
@@ -86,6 +86,11 @@ #else #warning Building without CryptoHash. #endif+#ifdef WITH_TORRENTParser+	, "TorrentParser"+#else+#warning Building without haskell torrent library; will instead use btshowmetainfo to parse torrent files.+#endif #ifdef WITH_EKG 	, "EKG" #endif
CHANGELOG view
@@ -1,3 +1,26 @@+git-annex (5.20141219) unstable; urgency=medium++  * Webapp: When adding a new box.com remote, use the new style chunking.+    Thanks, Jon Ander Peñalba.+  * External special remote protocol now includes commands for setting+    and getting the urls associated with a key.+  * Urls can now be claimed by remotes. This will allow creating,+    for example, a external special remote that handles magnet: and+    *.torrent urls.+  * Use wget -q --show-progress for less verbose wget output,+    when built with wget 1.16.+  * Added bittorrent special remote.+  * addurl behavior change: When downloading an url ending in .torrent,+    it will download files from bittorrent, instead of the old behavior+    of adding the torrent file to the repository.+  * Added Recommends on aria2.+  * When possible, build with the haskell torrent library for parsing+    torrent files. As a fallback, can instead use btshowmetainfo from+    bittornado | bittorrent.+  * Fix build with -f-S3.++ -- Joey Hess <id@joeyh.name>  Fri, 19 Dec 2014 16:53:26 -0400+ git-annex (5.20141203) unstable; urgency=medium    * proxy: New command for direct mode repositories, allows bypassing
Command/AddUrl.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2011-2013 Joey Hess <joey@kitenet.net>+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -19,13 +19,18 @@ import qualified Annex.Queue import qualified Annex.Url as Url import qualified Backend.URL+import qualified Remote+import qualified Types.Remote as Remote import Annex.Content+import Annex.UUID import Logs.Web import Types.Key import Types.KeySource+import Types.UrlContents import Config import Annex.Content.Direct import Logs.Location+import Utility.Metered import qualified Annex.Transfer as Transfer #ifdef WITH_QUVI import Annex.Quvi@@ -47,22 +52,83 @@ relaxedOption = flagOption [] "relaxed" "skip size check"  seek :: CommandSeek-seek ps = do-	f <- getOptionField fileOption return+seek us = do+	optfile <- getOptionField fileOption return 	relaxed <- getOptionFlag relaxedOption-	d <- getOptionField pathdepthOption (return . maybe Nothing readish)-	withStrings (start relaxed f d) ps+	pathdepth <- getOptionField pathdepthOption (return . maybe Nothing readish)+	forM_ us $ \u -> do+		r <- Remote.claimingUrl u+		if Remote.uuid r == webUUID+			then void $ commandAction $ startWeb relaxed optfile pathdepth u+			else do+				pathmax <- liftIO $ fileNameLengthLimit "."+				let deffile = fromMaybe (urlString2file u pathdepth pathmax) optfile+				res <- tryNonAsync $ maybe+					(error $ "unable to checkUrl of " ++ Remote.name r)+					(flip id u)+					(Remote.checkUrl r)+				case res of+					Left e -> void $ commandAction $ do+						showStart "addurl" u+						warning (show e)+						next $ next $ return False+					Right (UrlContents sz mf) -> do+						void $ commandAction $+							startRemote r relaxed (maybe deffile fromSafeFilePath mf) u sz+					Right (UrlMulti l) ->+						forM_ l $ \(u', sz, f) ->+							void $ commandAction $+								startRemote r relaxed (deffile </> fromSafeFilePath f) u' sz -start :: Bool -> Maybe FilePath -> Maybe Int -> String -> CommandStart-start relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI s+startRemote :: Remote -> Bool -> FilePath -> URLString -> Maybe Integer -> CommandStart+startRemote r relaxed file uri sz = do+	pathmax <- liftIO $ fileNameLengthLimit "."+	let file' = joinPath $ map (truncateFilePath pathmax) $ splitDirectories file+	showStart "addurl" file'+	showNote $ "from " ++ Remote.name r +	next $ performRemote r relaxed uri file' sz++performRemote :: Remote -> Bool -> URLString -> FilePath -> Maybe Integer -> CommandPerform+performRemote r relaxed uri file sz = ifAnnexed file adduri geturi   where+	loguri = setDownloader uri OtherDownloader+	adduri = addUrlChecked relaxed loguri (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++downloadRemoteFile :: Remote -> Bool -> URLString -> FilePath -> Maybe Integer -> Annex (Maybe Key)+downloadRemoteFile r relaxed uri file sz = do+	urlkey <- Backend.URL.fromUrl uri sz+	liftIO $ createDirectoryIfMissing True (parentDir file)+	ifM (Annex.getState Annex.fast <||> pure relaxed)+		( do+			cleanup (Remote.uuid r) loguri file urlkey Nothing+			return (Just urlkey)+		, do+			-- Set temporary url for the urlkey+			-- so that the remote knows what url it+			-- should use to download it.+			setTempUrl urlkey loguri+			let downloader = Remote.retrieveKeyFile r urlkey (Just file)+			ret <- downloadWith downloader urlkey (Remote.uuid r) loguri file+			removeTempUrl urlkey+			return ret+		)+  where+	loguri = setDownloader uri OtherDownloader++startWeb :: Bool -> Maybe FilePath -> Maybe Int -> String -> CommandStart+startWeb relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI s+  where 	(s', downloader) = getDownloader s 	bad = fromMaybe (error $ "bad url " ++ s') $ 		parseURI $ escapeURIString isUnescapedInURI s' 	choosefile = flip fromMaybe optfile 	go url = case downloader of 		QuviDownloader -> usequvi-		DefaultDownloader -> +		_ ->  #ifdef WITH_QUVI 			ifM (quviSupported s') 				( usequvi@@ -75,7 +141,7 @@ 		pathmax <- liftIO $ fileNameLengthLimit "." 		let file = choosefile $ url2file url pathdepth pathmax 		showStart "addurl" file-		next $ perform relaxed s' file+		next $ performWeb relaxed s' file #ifdef WITH_QUVI 	badquvi = error $ "quvi does not know how to download url " ++ s' 	usequvi = do@@ -91,12 +157,21 @@ 	usequvi = error "not built with quvi support" #endif +performWeb :: Bool -> URLString -> FilePath -> CommandPerform+performWeb relaxed url file = ifAnnexed file addurl geturl+  where+	geturl = next $ isJust <$> addUrlFile relaxed url file+	addurl = addUrlChecked relaxed url webUUID checkexistssize+	checkexistssize = Url.withUrlOptions . Url.check url . keySize+ #ifdef WITH_QUVI performQuvi :: Bool -> URLString -> URLString -> FilePath -> CommandPerform performQuvi relaxed pageurl videourl file = ifAnnexed file addurl geturl   where 	quviurl = setDownloader pageurl QuviDownloader-	addurl key = next $ cleanup quviurl file key Nothing+	addurl key = next $ do+		cleanup webUUID quviurl file key Nothing+		return True 	geturl = next $ isJust <$> addUrlFileQuvi relaxed quviurl videourl file #endif @@ -106,7 +181,7 @@ 	key <- Backend.URL.fromUrl quviurl Nothing 	ifM (pure relaxed <||> Annex.getState Annex.fast) 		( do-			cleanup' quviurl file key Nothing+			cleanup webUUID quviurl file key Nothing 			return (Just key) 		, do 			{- Get the size, and use that to check@@ -124,55 +199,58 @@ 						downloadUrl [videourl] tmp 				if ok 					then do-						cleanup' quviurl file key (Just tmp)+						cleanup webUUID quviurl file key (Just tmp) 						return (Just key) 					else return Nothing 		) #endif -perform :: Bool -> URLString -> FilePath -> CommandPerform-perform relaxed url file = ifAnnexed file addurl geturl-  where-	geturl = next $ isJust <$> addUrlFile relaxed url file-	addurl key-		| relaxed = do-			setUrlPresent key url-			next $ return True-		| otherwise = ifM (elem url <$> getUrls key)-			( stop-			, do-				(exists, samesize) <- Url.withUrlOptions $ Url.check url (keySize key)-				if exists && samesize-					then do-						setUrlPresent key url-						next $ return True-					else do-						warning $ "while adding a new url to an already annexed file, " ++ if exists-							then "url does not have expected file size (use --relaxed to bypass this check) " ++ url-							else "failed to verify url exists: " ++ url-						stop-			)+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)+		( next $ return True -- nothing to do+		, do+			(exists, samesize) <- checkexistssize key+			if exists && samesize+				then do+					setUrlPresent u key url+					next $ return True+				else do+					warning $ "while adding a new url to an already annexed file, " ++ if exists+						then "url does not have expected file size (use --relaxed to bypass this check) " ++ url+						else "failed to verify url exists: " ++ url+					stop+		)  addUrlFile :: Bool -> URLString -> FilePath -> Annex (Maybe Key) addUrlFile relaxed url file = do 	liftIO $ createDirectoryIfMissing True (parentDir file) 	ifM (Annex.getState Annex.fast <||> pure relaxed) 		( nodownload relaxed url file-		, do-			showAction $ "downloading " ++ url ++ " "-			download url file+		, downloadWeb url file 		) -download :: URLString -> FilePath -> Annex (Maybe Key)-download url file = do-	{- Generate a dummy key to use for this download, before we can-	 - examine the file and find its real key. This allows resuming-	 - downloads, as the dummy key for a given url is stable. -}+downloadWeb :: URLString -> FilePath -> Annex (Maybe Key)+downloadWeb url file = do 	dummykey <- addSizeUrlKey url =<< Backend.URL.fromUrl url Nothing+	let downloader f _ = do+		showOutput+		downloadUrl [url] f+	showAction $ "downloading " ++ url ++ " "+	downloadWith downloader dummykey webUUID url 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. -}+downloadWith :: (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> FilePath -> Annex (Maybe Key)+downloadWith downloader dummykey u url file = 	prepGetViaTmpChecked dummykey Nothing $ do 		tmp <- fromRepo $ gitAnnexTmpObjectLocation dummykey-		showOutput-		ifM (runtransfer dummykey tmp)+		ifM (runtransfer tmp) 			( do 				backend <- chooseBackend file 				let source = KeySource@@ -184,15 +262,15 @@ 				case k of 					Nothing -> return Nothing 					Just (key, _) -> do-						cleanup' url file key (Just tmp)+						cleanup u url file key (Just tmp) 						return (Just key) 			, return Nothing 			)   where-	runtransfer dummykey tmp =  Transfer.notifyTransfer Transfer.Download (Just file) $-		Transfer.download webUUID dummykey (Just file) Transfer.forwardRetry $ const $ do+	runtransfer tmp =  Transfer.notifyTransfer Transfer.Download (Just file) $+		Transfer.download u dummykey (Just file) Transfer.forwardRetry $ \p -> do 			liftIO $ createDirectoryIfMissing True (parentDir tmp)-			downloadUrl [url] tmp+			downloader tmp p  {- Hits the url to get the size, if available.  -@@ -204,16 +282,11 @@ 	size <- snd <$> Url.withUrlOptions (Url.exists url) 	return $ key { keySize = size } -cleanup :: URLString -> FilePath -> Key -> Maybe FilePath -> Annex Bool-cleanup url file key mtmp = do-	cleanup' url file key mtmp-	return True--cleanup' :: URLString -> FilePath -> Key -> Maybe FilePath -> Annex ()-cleanup' url file key mtmp = do+cleanup :: UUID -> URLString -> FilePath -> Key -> Maybe FilePath -> Annex ()+cleanup u url file key mtmp = do 	when (isJust mtmp) $ 		logStatus key InfoPresent-	setUrlPresent key url+	setUrlPresent u key url 	Command.Add.addLink file key Nothing 	whenM isDirect $ do 		void $ addAssociatedFile key file@@ -230,7 +303,7 @@ 	if exists 		then do 			key <- Backend.URL.fromUrl url size-			cleanup' url file key Nothing+			cleanup webUUID url file key Nothing 			return (Just key) 		else do 			warning $ "unable to access url: " ++ url@@ -245,8 +318,16 @@ 		| depth < 0 -> frombits $ reverse . take (negate depth) . reverse 		| otherwise -> error "bad --pathdepth"   where-	fullurl = uriRegName auth ++ uriPath url ++ uriQuery url+	fullurl = concat+		[ maybe "" uriRegName (uriAuthority url)+		, uriPath url+		, uriQuery url+		] 	frombits a = intercalate "/" $ a urlbits 	urlbits = map (truncateFilePath pathmax . sanitizeFilePath) $ 		filter (not . null) $ split "/" fullurl-	auth = fromMaybe (error $ "bad url " ++ show url) $ uriAuthority url++urlString2file :: URLString -> Maybe Int -> Int -> FilePath+urlString2file s pathdepth pathmax = case Url.parseURIRelaxed s of+	Nothing -> error $ "bad uri " ++ s+	Just u -> url2file u pathdepth pathmax
Command/ImportFeed.hs view
@@ -22,11 +22,15 @@ import qualified Annex import Command import qualified Annex.Url as Url+import qualified Remote+import qualified Types.Remote as Remote+import Types.UrlContents import Logs.Web import qualified Utility.Format import Utility.Tmp-import Command.AddUrl (addUrlFile, relaxedOption)+import Command.AddUrl (addUrlFile, downloadRemoteFile, relaxedOption) import Annex.Perms+import Annex.UUID import Backend.URL (fromUrl) #ifdef WITH_QUVI import Annex.Quvi@@ -137,9 +141,29 @@ performDownload :: Bool -> Cache -> ToDownload -> Annex Bool performDownload relaxed cache todownload = case location todownload of 	Enclosure url -> checkknown url $-		rundownload url (takeExtension url) $ -			addUrlFile relaxed url+		rundownload url (takeExtension url) $ \f -> do+			r <- Remote.claimingUrl url+			if Remote.uuid r == webUUID+				then maybeToList <$> addUrlFile relaxed url f+				else do+					res <- tryNonAsync $ maybe+						(error $ "unable to checkUrl of " ++ Remote.name r)+						(flip id url)+						(Remote.checkUrl r)+					case res of+						Left _ -> return []+						Right (UrlContents sz _) ->+							maybeToList <$>+								downloadRemoteFile r relaxed url f sz+						Right (UrlMulti l) -> do+							kl <- forM l $ \(url', sz, subf) ->+								downloadRemoteFile r relaxed url' (f </> fromSafeFilePath subf) sz+							return $ if all isJust kl+								then catMaybes kl+								else []+							 	QuviLink pageurl -> do+#ifdef WITH_QUVI 		let quviurl = setDownloader pageurl QuviDownloader 		checkknown quviurl $ do 			mp <- withQuviOptions Quvi.query [Quvi.quiet, Quvi.httponly] pageurl@@ -150,8 +174,11 @@ 					Just link -> do 						let videourl = Quvi.linkUrl link 						checkknown videourl $-							rundownload videourl ("." ++ Quvi.linkSuffix link) $-								addUrlFileQuvi relaxed quviurl videourl+							rundownload videourl ("." ++ Quvi.linkSuffix link) $ \f ->+								maybeToList <$> addUrlFileQuvi relaxed quviurl videourl f+#else+		return False+#endif   where 	forced = Annex.getState Annex.force @@ -168,16 +195,17 @@ 			Nothing -> return True 			Just f -> do 				showStart "addurl" f-				mk <- getter f-				case mk of-					Just key -> do-						whenM (annexGenMetaData <$> Annex.getGitConfig) $-							addMetaData key $ extractMetaData todownload-						showEndOk-						return True-					Nothing -> do+				ks <- getter f+				if null ks+					then do 						showEndFail 						checkFeedBroken (feedurl todownload)+					else do+						forM_ ks $ \key ->+							whenM (annexGenMetaData <$> Annex.getGitConfig) $+								addMetaData key $ extractMetaData todownload+						showEndOk+						return True  	{- Find a unique filename to save the url to. 	 - If the file exists, prefixes it with a number.
Command/ReKey.hs view
@@ -16,6 +16,7 @@ import Logs.Web import Logs.Location import Utility.CopyFile+import qualified Remote  cmd :: [Command] cmd = [notDirect $ command "rekey"@@ -61,8 +62,9 @@ 	-- If the old key had some associated urls, record them for 	-- the new key as well. 	urls <- getUrls oldkey-	unless (null urls) $-		mapM_ (setUrlPresent newkey) urls+	forM_ urls $ \url -> do+		r <- Remote.claimingUrl url+		setUrlPresent (Remote.uuid r) newkey url  	-- Update symlink to use the new key. 	liftIO $ removeFile file
Command/RmUrl.hs view
@@ -10,6 +10,8 @@ import Common.Annex import Command import Logs.Web+import Annex.UUID+import qualified Remote  cmd :: [Command] cmd = [notBareRepo $@@ -26,5 +28,9 @@  cleanup :: String -> Key -> CommandCleanup cleanup url key = do-	setUrlMissing key url+	r <- Remote.claimingUrl url+	let url' = if Remote.uuid r == webUUID+		then url+		else setDownloader url OtherDownloader+	setUrlMissing (Remote.uuid r) key url' 	return True
Command/Whereis.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2010 Joey Hess <joey@kitenet.net>+ - Copyright 2010-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -13,6 +13,7 @@ import Command import Remote import Logs.Trust+import Logs.Web  cmd :: [Command] cmd = [noCommit $ withOptions (jsonOption : keyOptions) $@@ -57,9 +58,17 @@ 	untrustedheader = "The following untrusted locations may also have copies:\n"  performRemote :: Key -> Remote -> Annex () -performRemote key remote = maybe noop go $ whereisKey remote+performRemote key remote = do+	ls <- (++)+		<$> askremote+		<*> claimedurls+	unless (null ls) $ showLongNote $ unlines $+		map (\l -> name remote ++ ": " ++ l) ls   where-	go a = do-		ls <- a key-		unless (null ls) $ showLongNote $ unlines $-			map (\l -> name remote ++ ": " ++ l) ls+	askremote = maybe (pure []) (flip id key) (whereisKey remote)+	claimedurls = do+		us <- map fst +			. filter (\(_, d) -> d == OtherDownloader)+			. map getDownloader+			<$> getUrls key+		filterM (\u -> (==) <$> pure remote <*> claimingUrl u) us
Git/Version.hs view
@@ -5,18 +5,16 @@  - Licensed under the GNU GPL version 3 or higher.  -} -module Git.Version where+module Git.Version (+	installed,+	normalize,+	GitVersion,+) where  import Common--data GitVersion = GitVersion String Integer-	deriving (Eq)--instance Ord GitVersion where-	compare (GitVersion _ x) (GitVersion _ y) = compare x y+import Utility.DottedVersion -instance Show GitVersion where-	show (GitVersion s _) = s+type GitVersion = DottedVersion  installed :: IO GitVersion installed = normalize . extract <$> readProcess "git" ["--version"]@@ -24,20 +22,3 @@ 	extract s = case lines s of 		[] -> "" 		(l:_) -> unwords $ drop 2 $ words l--{- To compare dotted versions like 1.7.7 and 1.8, they are normalized to- - a somewhat arbitrary integer representation. -}-normalize :: String -> GitVersion-normalize v = GitVersion v $ -	sum $ mult 1 $ reverse $ extend precision $ take precision $-		map readi $ split "." v-  where-	extend n l = l ++ replicate (n - length l) 0-	mult _ [] = []-	mult n (x:xs) = (n*x) : mult (n*10^width) xs-	readi :: String -> Integer-	readi s = case reads s of-		((x,_):_) -> x-		_ -> 0-	precision = 10 -- number of segments of the version to compare-	width = length "yyyymmddhhmmss" -- maximum width of a segment
Logs/Trust.hs view
@@ -15,7 +15,6 @@ 	trustExclude, 	lookupTrust, 	trustMapLoad,-	trustMapRaw, ) where  import qualified Data.Map as M@@ -23,7 +22,6 @@  import Common.Annex import Types.TrustLevel-import qualified Annex.Branch import qualified Annex import Logs import Remote.List@@ -77,8 +75,3 @@ 	configuredtrust r = (\l -> Just (Types.Remote.uuid r, l)) 		=<< readTrustLevel  		=<< remoteAnnexTrustLevel (Types.Remote.gitconfig r)--{- Does not include forcetrust or git config values, just those from the- - log file. -}-trustMapRaw :: Annex TrustMap-trustMapRaw = calcTrustMap <$> Annex.Branch.get trustLog
Logs/Trust/Basic.hs view
@@ -8,6 +8,7 @@ module Logs.Trust.Basic ( 	module X, 	trustSet,+	trustMapRaw, ) where  import Data.Time.Clock.POSIX@@ -30,3 +31,8 @@ 				parseLog (Just . parseTrustLog) 	Annex.changeState $ \s -> s { Annex.trustmap = Nothing } trustSet NoUUID _ = error "unknown UUID; cannot modify"++{- Does not include forcetrust or git config values, just those from the+ - log file. -}+trustMapRaw :: Annex TrustMap+trustMapRaw = calcTrustMap <$> Annex.Branch.get trustLog
Logs/Web.hs view
@@ -1,26 +1,30 @@ {- Web url logs.  -- - Copyright 2011, 2013 Joey Hess <joey@kitenet.net>+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}  module Logs.Web ( 	URLString,-	webUUID, 	getUrls,+	getUrlsWithPrefix, 	setUrlPresent, 	setUrlMissing, 	knownUrls, 	Downloader(..), 	getDownloader, 	setDownloader,+	setTempUrl,+	removeTempUrl, ) where  import qualified Data.ByteString.Lazy.Char8 as L+import qualified Data.Map as M import Data.Tuple.Utils  import Common.Annex+import qualified Annex import Logs import Logs.Presence import Logs.Location@@ -28,16 +32,14 @@ import Annex.CatFile import qualified Git import qualified Git.LsFiles--type URLString = String---- Dummy uuid for the whole web. Do not alter.-webUUID :: UUID-webUUID = UUID "00000000-0000-0000-0000-000000000001"+import Utility.Url  {- Gets all urls that a key might be available from. -} getUrls :: Key -> Annex [URLString]-getUrls key = go $ urlLogFile key : oldurlLogs key+getUrls key = do+	l <- go $ urlLogFile key : oldurlLogs key+	tmpl <- Annex.getState (maybeToList . M.lookup key . Annex.tempurls)+	return (tmpl ++ l)   where 	go [] = return [] 	go (l:ls) = do@@ -46,19 +48,21 @@ 			then go ls 			else return us -setUrlPresent :: Key -> URLString -> Annex ()-setUrlPresent key url = do+getUrlsWithPrefix :: Key -> String -> Annex [URLString]+getUrlsWithPrefix key prefix = filter (prefix `isPrefixOf`) <$> getUrls key++setUrlPresent :: UUID -> Key -> URLString -> Annex ()+setUrlPresent uuid key url = do 	us <- getUrls key 	unless (url `elem` us) $ do 		addLog (urlLogFile key) =<< logNow InfoPresent url-		-- update location log to indicate that the web has the key-		logChange key webUUID InfoPresent+		logChange key uuid InfoPresent -setUrlMissing :: Key -> URLString -> Annex ()-setUrlMissing key url = do+setUrlMissing :: UUID -> Key -> URLString -> Annex ()+setUrlMissing uuid key url = do 	addLog (urlLogFile key) =<< logNow InfoMissing url 	whenM (null <$> getUrls key) $-		logChange key webUUID InfoMissing+		logChange key uuid InfoMissing  {- Finds all known urls. -} knownUrls :: Annex [URLString]@@ -78,18 +82,27 @@ 	geturls Nothing = return [] 	geturls (Just logsha) = getLog . L.unpack <$> catObject logsha -data Downloader = DefaultDownloader | QuviDownloader+setTempUrl :: Key -> URLString -> Annex ()+setTempUrl key url = Annex.changeState $ \s ->+	s { Annex.tempurls = M.insert key url (Annex.tempurls s) } -{- Determines the downloader for an URL.- -- - Some URLs are not downloaded by normal means, and this is indicated- - by prefixing them with downloader: when they are recorded in the url- - logs. -}+removeTempUrl :: Key -> Annex ()+removeTempUrl key = Annex.changeState $ \s ->+	s { Annex.tempurls = M.delete key (Annex.tempurls s) }++data Downloader = WebDownloader | QuviDownloader | OtherDownloader+	deriving (Eq)++{- 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. -}+setDownloader :: URLString -> Downloader -> String+setDownloader u WebDownloader = u+setDownloader u QuviDownloader = "quvi:" ++ u+setDownloader u OtherDownloader = ":" ++ u+ getDownloader :: URLString -> (URLString, Downloader) getDownloader u = case separate (== ':') u of 	("quvi", u') -> (u', QuviDownloader)-	_ -> (u, DefaultDownloader)--setDownloader :: URLString -> Downloader -> URLString-setDownloader u DefaultDownloader = u-setDownloader u QuviDownloader = "quvi:" ++ u+	("", u') -> (u', OtherDownloader)+	_ -> (u, WebDownloader)
Remote.hs view
@@ -45,7 +45,8 @@ 	forceTrust, 	logStatus, 	checkAvailable,-	isXMPPRemote+	isXMPPRemote,+	claimingUrl, ) where  import qualified Data.Map as M@@ -60,6 +61,7 @@ import Logs.UUID import Logs.Trust import Logs.Location hiding (logStatus)+import Logs.Web import Remote.List import Config import Git.Types (RemoteName)@@ -318,3 +320,12 @@  hasKeyCheap :: Remote -> Bool hasKeyCheap = checkPresentCheap++{- The web special remote claims urls by default. -}+claimingUrl :: URLString -> Annex Remote+claimingUrl url = do+	rs <- remoteList+	let web = Prelude.head $ filter (\r -> uuid r == webUUID) rs+	fromMaybe web <$> firstM checkclaim rs+  where+	checkclaim = maybe (pure False) (flip id url) . claimUrl
+ Remote/BitTorrent.hs view
@@ -0,0 +1,390 @@+{- BitTorrent remote.+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# LANGUAGE CPP #-}++module Remote.BitTorrent (remote) where++import Common.Annex+import Types.Remote+import qualified Annex+import qualified Git+import qualified Git.Construct+import Config.Cost+import Logs.Web+import Types.UrlContents+import Types.CleanupActions+import Types.Key+import Utility.Metered+import Utility.Tmp+import Backend.URL+import Annex.Perms+import Annex.UUID+import qualified Annex.Url as Url++import Network.URI++#ifdef WITH_TORRENTPARSER+import Data.Torrent+import qualified Data.ByteString.Lazy as B+#endif++remote :: RemoteType+remote = RemoteType {+	typename = "bittorrent",+	enumerate = list,+	generate = gen,+	setup = error "not supported"+}++-- There is only one bittorrent remote, and it always exists.+list :: Annex [Git.Repo]+list = do+	r <- liftIO $ Git.Construct.remoteNamed "bittorrent" Git.Construct.fromUnknown+	return [r]++gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)+gen r _ c gc = +	return $ Just Remote+		{ uuid = bitTorrentUUID+		, cost = expensiveRemoteCost+		, name = Git.repoDescribe r+		, storeKey = uploadKey+		, retrieveKeyFile = downloadKey+		, retrieveKeyFileCheap = downloadKeyCheap+		, removeKey = dropKey+		, checkPresent = checkKey+		, checkPresentCheap = False+		, whereisKey = Nothing+		, remoteFsck = Nothing+		, repairRepo = Nothing+		, config = c+		, gitconfig = gc+		, localpath = Nothing+		, repo = r+		, readonly = True+		, availability = GloballyAvailable+		, remotetype = remote+		, mkUnavailable = return Nothing+		, getInfo = return []+		, claimUrl = Just (pure . isSupportedUrl)+		, checkUrl = Just checkTorrentUrl+		}++downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool+downloadKey key _file dest p = +	get . map (torrentUrlNum . fst . getDownloader) =<< getBitTorrentUrls key+  where+	get [] = do+		warning "could not download torrent"+		return False+	get urls = do+		showOutput -- make way for download progress bar+		untilTrue urls $ \(u, filenum) -> do+			registerTorrentCleanup u+			checkDependencies+			ifM (downloadTorrentFile u)+				( downloadTorrentContent key u dest filenum p+				, return False+				)++downloadKeyCheap :: Key -> FilePath -> Annex Bool+downloadKeyCheap _ _ = return False++uploadKey :: Key -> AssociatedFile -> MeterUpdate -> Annex Bool+uploadKey _ _ _ = do+	warning "upload to bittorrent not supported"+	return False++dropKey :: Key -> Annex Bool+dropKey k = do+	mapM_ (setUrlMissing bitTorrentUUID k) =<< getBitTorrentUrls k+	return True++{- We punt and don't try to check if a torrent has enough seeders+ - with all the pieces etc. That would be quite hard.. and even if+ - implemented, it tells us nothing about the later state of the torrent.+ -}+checkKey :: Key -> Annex Bool+checkKey = error "cannot reliably check torrent status"++getBitTorrentUrls :: Key -> Annex [URLString]+getBitTorrentUrls key = filter supported <$> getUrls key+  where+	supported u =+		let (u', dl) = (getDownloader u)+		in dl == OtherDownloader && isSupportedUrl u'++isSupportedUrl :: URLString -> Bool+isSupportedUrl u = isTorrentMagnetUrl u || isTorrentUrl u++isTorrentUrl :: URLString -> Bool+isTorrentUrl = maybe False (\u -> ".torrent" `isSuffixOf` uriPath u) . parseURI++isTorrentMagnetUrl :: URLString -> Bool+isTorrentMagnetUrl u = "magnet:" `isPrefixOf` u && checkbt (parseURI u)+  where+	checkbt (Just uri) | "xt=urn:btih:" `isInfixOf` uriQuery uri = True+	checkbt _ = False++checkTorrentUrl :: URLString -> Annex UrlContents+checkTorrentUrl u = do+	checkDependencies+	registerTorrentCleanup u+	ifM (downloadTorrentFile u)+		( torrentContents u+		, error "could not download torrent file"+		)++{- To specify which file inside a multi-url torrent, the file number is+ - appended to the url. -}+torrentUrlWithNum :: URLString -> Int -> URLString+torrentUrlWithNum u n = u ++ "#" ++ show n++torrentUrlNum :: URLString -> (URLString, Int)+torrentUrlNum u+	| '#' `elem` u = +		let (n, ru) = separate (== '#') (reverse u)+		in (reverse ru, fromMaybe 1 $ readish $ reverse n)+	| otherwise = (u, 1)++{- A Key corresponding to the URL of a torrent file. -}+torrentUrlKey :: URLString -> Annex Key+torrentUrlKey u = fromUrl (fst $ torrentUrlNum u) Nothing++{- Temporary directory used to download a torrent. -}+tmpTorrentDir :: URLString -> Annex FilePath+tmpTorrentDir u = do+	d <- fromRepo gitAnnexTmpMiscDir+	f <- keyFile <$> torrentUrlKey u+	return (d </> f)++{- Temporary filename to use to store the torrent file. -}+tmpTorrentFile :: URLString -> Annex FilePath+tmpTorrentFile u = fromRepo . gitAnnexTmpObjectLocation =<< torrentUrlKey u++{- A cleanup action is registered to delete the torrent file and its+ - associated temp directory when git-annex exits.+ -+ - This allows multiple actions that use the same torrent file and temp+ - directory to run in a single git-annex run.+ -}+registerTorrentCleanup :: URLString -> Annex ()+registerTorrentCleanup u = Annex.addCleanup (TorrentCleanup u) $ do+	liftIO . nukeFile =<< tmpTorrentFile u+	d <- tmpTorrentDir u+	liftIO $ whenM (doesDirectoryExist d) $+		removeDirectoryRecursive d++{- Downloads the torrent file. (Not its contents.) -}+downloadTorrentFile :: URLString -> Annex Bool+downloadTorrentFile u = do+	torrent <- tmpTorrentFile u+	ifM (liftIO $ doesFileExist torrent)+		( 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+					ok <- downloadMagnetLink u metadir torrent+					liftIO $ removeDirectoryRecursive metadir+					return ok+				else do+					misctmp <- fromRepo gitAnnexTmpMiscDir+					withTmpFileIn misctmp "torrent" $ \f _h -> do+						ok <- Url.withUrlOptions $ Url.download u f+						when ok $+							liftIO $ renameFile f torrent+						return ok+		)++downloadMagnetLink :: URLString -> FilePath -> FilePath -> Annex Bool+downloadMagnetLink u metadir dest = ifM download+	( liftIO $ do+		ts <- filter (".torrent" `isPrefixOf`)+			<$> dirContents metadir+		case ts of+			(t:[]) -> do+				renameFile t dest+				return True+			_ -> return False+	, return False+	)+  where+	download = runAria+		[ Param "--bt-metadata-only"+		, Param "--bt-save-metadata"+		, Param u+		, Param "--seed-time=0"+		, Param "--summary-interval=0"+		, Param "-d"+		, File metadir+		]++downloadTorrentContent :: Key -> URLString -> FilePath -> Int -> MeterUpdate -> Annex Bool+downloadTorrentContent k u dest filenum p = do+	torrent <- tmpTorrentFile u+	tmpdir <- tmpTorrentDir u+	createAnnexDirectory tmpdir+	f <- wantedfile torrent+	showOutput+	ifM (download torrent tmpdir <&&> liftIO (doesFileExist (tmpdir </> f)))+		( do+			liftIO $ renameFile (tmpdir </> f) dest+			return True+		, return False+		)+  where+	download torrent tmpdir = ariaProgress (keySize k) p+		[ Param $ "--select-file=" ++ show filenum+		, File torrent+		, Param "-d"+		, File tmpdir+		, Param "--seed-time=0"+		, Param "--summary-interval=0"+		, Param "--file-allocation=none"+		-- Needed so aria will resume partially downloaded files+		-- in multi-file torrents.+		, Param "--check-integrity=true"+		]+	+	{- aria2c will create part of the directory structure+	 - contained in the torrent. It may download parts of other files+	 - in addition to the one we asked for. So, we need to find+	 - out the filename we want based on the filenum.+	 -}+	wantedfile torrent = do+		fs <- liftIO $ map fst <$> torrentFileSizes torrent+		if length fs >= filenum+			then return (fs !! (filenum - 1))+			else error "Number of files in torrent seems to have changed."++checkDependencies :: Annex ()+checkDependencies = do+	missing <- liftIO $ filterM (not <$$> inPath) deps+	unless (null missing) $+		error $ "need to install additional software in order to download from bittorrent: " ++ unwords missing+  where+	deps =+		[ "aria2c"+#ifndef TORRENT+		, "btshowmetainfo"+#endif+		]++ariaParams :: [CommandParam] -> Annex [CommandParam]+ariaParams ps = do+	opts <- map Param . annexAriaTorrentOptions <$> Annex.getGitConfig+	return (ps ++ opts)++runAria :: [CommandParam] -> Annex Bool+runAria ps = liftIO . boolSystem "aria2c" =<< ariaParams ps++-- Parse aria output to find "(n%)" and update the progress meter+-- with it. The output is also output to stdout.+ariaProgress :: Maybe Integer -> MeterUpdate -> [CommandParam] -> Annex Bool+ariaProgress Nothing _ ps = runAria ps+ariaProgress (Just sz) meter ps =+	liftIO . commandMeter (parseAriaProgress sz) meter "aria2c"+		=<< ariaParams ps++parseAriaProgress :: Integer -> ProgressParser+parseAriaProgress totalsize = go [] . reverse . split ['\r']+  where+	go remainder [] = (Nothing, remainder)+	go remainder (x:xs) = case readish (findpercent x) of+		Nothing -> go (x++remainder) xs+		Just p -> (Just (frompercent p), remainder)++	-- "(N%)"+	findpercent = takeWhile (/= '%') . drop 1 . dropWhile (/= '(')++	frompercent p = toBytesProcessed $ totalsize * p `div` 100++{- Used only if the haskell torrent library is not available. -}+#ifndef WITH_TORRENTPARSER+btshowmetainfo :: FilePath -> String -> IO [String]+btshowmetainfo torrent field = +	findfield [] . lines <$> readProcess "btshowmetainfo" [torrent]+  where+	findfield c [] = reverse c+	findfield c (l:ls)+		| l == fieldkey = multiline c ls+		| fieldkey `isPrefixOf` l =+			findfield ((drop (length fieldkey) l):c) ls+		| otherwise = findfield c ls++	multiline c (l:ls)+		| "   " `isPrefixOf` l = multiline (drop 3 l:c) ls+		| otherwise = findfield c ls+	multiline c [] = findfield c []++	fieldkey = field ++ take (14 - length field) (repeat '.') ++ ": "+#endif++{- Examines the torrent file and gets the list of files in it,+ - and their sizes.+ -}+torrentFileSizes :: FilePath -> IO [(FilePath, Integer)]+torrentFileSizes torrent = do+#ifdef WITH_TORRENTPARSER+	let mkfile = joinPath . map (scrub . decodeBS)+	b <- B.readFile torrent+	return $ case readTorrent b of+		Left e -> error $ "failed to parse torrent: " ++ e+		Right t -> case tInfo t of+			SingleFile { tLength = l, tName = f } ->+				[ (mkfile [f], l) ]+			MultiFile { tFiles = fs, tName = dir } ->+				map (\tf -> (mkfile $ dir:filePath tf, fileLength tf)) fs+  where+#else+	files <- getfield "files"+	if null files+		then do+			fnl <- getfield "file name"+			szl <- map readish <$> getfield "file size"+			case (fnl, szl) of+				((fn:[]), (Just sz:[])) -> return [(scrub fn, sz)]+		 		_ -> parsefailed (show (fnl, szl))+		else do+			v <- getfield "directory name"+			case v of+				(d:[]) -> return $ map (splitsize d) files+				_ -> parsefailed (show v)+  where+	getfield = btshowmetainfo torrent+	parsefailed s = error $ "failed to parse btshowmetainfo output for torrent file: " ++ show s++	-- btshowmetainfo outputs a list of "filename (size)"+	splitsize d l = (scrub (d </> fn), sz)+	  where+		sz = fromMaybe (parsefailed l) $ readish $ +			reverse $ takeWhile (/= '(') $ dropWhile (== ')') $+				reverse l+		fn = reverse $ drop 2 $+			dropWhile (/= '(') $ dropWhile (== ')') $ reverse l+#endif+	-- a malicious torrent file might try to do directory traversal+	scrub f = if isAbsolute f || any (== "..") (splitPath f)+		then error "found unsafe filename in torrent!"+		else f++torrentContents :: URLString -> Annex UrlContents+torrentContents u = convert+	<$> (liftIO . torrentFileSizes =<< tmpTorrentFile u)+  where+	convert [(fn, sz)] = UrlContents (Just sz) (Just (mkSafeFilePath fn))+	convert l = UrlMulti $ map mkmulti (zip l [1..])++	mkmulti ((fn, sz), n) = +		(torrentUrlWithNum u n, Just sz, mkSafeFilePath $ joinPath $ drop 1 $ splitPath fn)
Remote/Bup.hs view
@@ -74,6 +74,8 @@ 		, readonly = False 		, mkUnavailable = return Nothing 		, getInfo = return [("repo", buprepo)]+		, claimUrl = Nothing+		, checkUrl = Nothing 		} 	return $ Just $ specialRemote' specialcfg c 		(simplyPrepare $ store this buprepo)
Remote/Ddar.hs view
@@ -71,6 +71,8 @@ 		, readonly = False 		, mkUnavailable = return Nothing 		, getInfo = return [("repo", ddarrepo)]+		, claimUrl = Nothing+		, checkUrl = Nothing 		} 	ddarrepo = fromMaybe (error "missing ddarrepo") $ remoteAnnexDdarRepo gc 	specialcfg = (specialRemoteCfg c)
Remote/Directory.hs view
@@ -46,30 +46,32 @@ 		(retrieve dir chunkconfig) 		(simplyPrepare $ remove dir) 		(simplyPrepare $ checkKey dir chunkconfig)-		Remote {-			uuid = u,-			cost = cst,-			name = Git.repoDescribe r,-			storeKey = storeKeyDummy,-			retrieveKeyFile = retreiveKeyFileDummy,-			retrieveKeyFileCheap = retrieveCheap dir chunkconfig,-			removeKey = removeKeyDummy,-			checkPresent = checkPresentDummy,-			checkPresentCheap = True,-			whereisKey = Nothing,-			remoteFsck = Nothing,-			repairRepo = Nothing,-			config = c,-			repo = r,-			gitconfig = gc,-			localpath = Just dir,-			readonly = False,-			availability = LocallyAvailable,-			remotetype = remote,-			mkUnavailable = gen r u c $-				gc { remoteAnnexDirectory = Just "/dev/null" },-			getInfo = return [("directory", dir)]-		}+		Remote+			{ uuid = u+			, cost = cst+			, name = Git.repoDescribe r+			, storeKey = storeKeyDummy+			, retrieveKeyFile = retreiveKeyFileDummy+			, retrieveKeyFileCheap = retrieveCheap dir chunkconfig+			, removeKey = removeKeyDummy+			, checkPresent = checkPresentDummy+			, checkPresentCheap = True+			, whereisKey = Nothing+			, remoteFsck = Nothing+			, repairRepo = Nothing+			, config = c+			, repo = r+			, gitconfig = gc+			, localpath = Just dir+			, readonly = False+			, availability = LocallyAvailable+			, remotetype = remote+			, mkUnavailable = gen r u c $+				gc { remoteAnnexDirectory = Just "/dev/null" }+			, getInfo = return [("directory", dir)]+			, claimUrl = Nothing+			, checkUrl = Nothing+			}   where 	dir = fromMaybe (error "missing directory") $ remoteAnnexDirectory gc 
Remote/External.hs view
@@ -12,6 +12,7 @@ import Common.Annex import Types.Remote import Types.CleanupActions+import Types.UrlContents import qualified Git import Config import Remote.Helper.Special@@ -19,6 +20,7 @@ import Logs.Transfer import Logs.PreferredContent.Raw import Logs.RemoteState+import Logs.Web import Config.Cost import Annex.UUID import Creds@@ -46,30 +48,32 @@ 		(simplyPrepare $ retrieve external) 		(simplyPrepare $ remove external) 		(simplyPrepare $ checkKey external)-		Remote {-			uuid = u,-			cost = cst,-			name = Git.repoDescribe r,-			storeKey = storeKeyDummy,-			retrieveKeyFile = retreiveKeyFileDummy,-			retrieveKeyFileCheap = \_ _ -> return False,-			removeKey = removeKeyDummy,-			checkPresent = checkPresentDummy,-			checkPresentCheap = False,-			whereisKey = Nothing,-			remoteFsck = Nothing,-			repairRepo = Nothing,-			config = c,-			localpath = Nothing,-			repo = r,-			gitconfig = gc,-			readonly = False,-			availability = avail,-			remotetype = remote,-			mkUnavailable = gen r u c $+		Remote+			{ uuid = u+			, cost = cst+			, name = Git.repoDescribe r+			, storeKey = storeKeyDummy+			, retrieveKeyFile = retreiveKeyFileDummy+			, retrieveKeyFileCheap = \_ _ -> return False+			, removeKey = removeKeyDummy+			, checkPresent = checkPresentDummy+			, checkPresentCheap = False+			, whereisKey = Nothing+			, remoteFsck = Nothing+			, repairRepo = Nothing+			, config = c+			, localpath = Nothing+			, repo = r+			, gitconfig = gc+			, readonly = False+			, availability = avail+			, remotetype = remote+			, mkUnavailable = gen r u c $ 				gc { remoteAnnexExternalType = Just "!dne!" } 			, getInfo = return [("externaltype", externaltype)]-		}+			, claimUrl = Just (claimurl external)+			, checkUrl = Just (checkurl external)+			}   where 	externaltype = fromMaybe (error "missing externaltype") (remoteAnnexExternalType gc) @@ -215,6 +219,14 @@ 		state <- fromMaybe "" 			<$> getRemoteState (externalUUID external) key 		send $ VALUE state+	handleRemoteRequest (SETURLPRESENT key url) =+		setUrlPresent (externalUUID external) key url+	handleRemoteRequest (SETURLMISSING key url) =+		setUrlMissing (externalUUID external) key url+	handleRemoteRequest (GETURLS key prefix) = do+		mapM_ (send . VALUE . fst . getDownloader)+			=<< getUrlsWithPrefix key prefix+		send (VALUE "") -- end of list 	handleRemoteRequest (DEBUG msg) = liftIO $ debugM "external" msg 	handleRemoteRequest (VERSION _) = 		sendMessage lck external $ ERROR "too late to send VERSION"@@ -409,3 +421,27 @@ 			_ -> Nothing 		setRemoteAvailability r avail 		return avail++claimurl :: External -> URLString -> Annex Bool+claimurl external url =+	handleRequest external (CLAIMURL url) Nothing $ \req -> case req of+		CLAIMURL_SUCCESS -> Just $ return True+		CLAIMURL_FAILURE -> Just $ return False+		UNSUPPORTED_REQUEST -> Just $ return False+		_ -> Nothing++checkurl :: External -> URLString -> Annex UrlContents+checkurl external url = +	handleRequest external (CHECKURL url) Nothing $ \req -> case req of+		CHECKURL_CONTENTS sz f -> Just $ return $ UrlContents sz+			(if null f then Nothing else Just $ mkSafeFilePath f)+		-- Treat a single item multi response specially to+		-- simplify the external remote implementation.+		CHECKURL_MULTI ((_, sz, f):[]) ->+			Just $ return $ UrlContents sz $ Just $ mkSafeFilePath f+		CHECKURL_MULTI l -> Just $ return $ UrlMulti $ map mkmulti l+		CHECKURL_FAILURE errmsg -> Just $ error errmsg+		UNSUPPORTED_REQUEST -> error "CHECKURL not implemented by external special remote"+		_ -> Nothing+  where+	mkmulti (u, s, f) = (u, s, mkSafeFilePath f)
Remote/External/Types.hs view
@@ -39,6 +39,7 @@ import Config.Cost (Cost) import Types.Remote (RemoteConfig) import Types.Availability (Availability(..))+import Utility.Url (URLString) import qualified Utility.SimpleProtocol as Proto  import Control.Concurrent.STM@@ -90,6 +91,8 @@ 	| INITREMOTE 	| GETCOST 	| GETAVAILABILITY+	| CLAIMURL URLString+	| CHECKURL URLString 	| TRANSFER Direction Key FilePath 	| CHECKPRESENT Key 	| REMOVE Key@@ -106,6 +109,8 @@ 	formatMessage INITREMOTE = ["INITREMOTE"] 	formatMessage GETCOST = ["GETCOST"] 	formatMessage GETAVAILABILITY = ["GETAVAILABILITY"]+	formatMessage (CLAIMURL url) = [ "CLAIMURL", Proto.serialize url ]+	formatMessage (CHECKURL url) = [ "CHECKURL", Proto.serialize url ] 	formatMessage (TRANSFER direction key file) = 		[ "TRANSFER" 		, Proto.serialize direction@@ -130,6 +135,11 @@ 	| AVAILABILITY Availability 	| INITREMOTE_SUCCESS 	| INITREMOTE_FAILURE ErrorMsg+	| CLAIMURL_SUCCESS+	| CLAIMURL_FAILURE+	| CHECKURL_CONTENTS Size FilePath+	| CHECKURL_MULTI [(URLString, Size, FilePath)]+	| CHECKURL_FAILURE ErrorMsg 	| UNSUPPORTED_REQUEST 	deriving (Show) @@ -147,6 +157,11 @@ 	parseCommand "AVAILABILITY" = Proto.parse1 AVAILABILITY 	parseCommand "INITREMOTE-SUCCESS" = Proto.parse0 INITREMOTE_SUCCESS 	parseCommand "INITREMOTE-FAILURE" = Proto.parse1 INITREMOTE_FAILURE+	parseCommand "CLAIMURL-SUCCESS" = Proto.parse0 CLAIMURL_SUCCESS+	parseCommand "CLAIMURL-FAILURE" = Proto.parse0 CLAIMURL_FAILURE+	parseCommand "CHECKURL-CONTENTS" = Proto.parse2 CHECKURL_CONTENTS+	parseCommand "CHECKURL-MULTI" = Proto.parse1 CHECKURL_MULTI+	parseCommand "CHECKURL-FAILURE" = Proto.parse1 CHECKURL_FAILURE 	parseCommand "UNSUPPORTED-REQUEST" = Proto.parse0 UNSUPPORTED_REQUEST 	parseCommand _ = Proto.parseFail @@ -165,6 +180,9 @@ 	| GETWANTED 	| SETSTATE Key String 	| GETSTATE Key+	| SETURLPRESENT Key URLString+	| SETURLMISSING Key URLString+	| GETURLS Key String 	| DEBUG String 	deriving (Show) @@ -182,6 +200,9 @@ 	parseCommand "GETWANTED" = Proto.parse0 GETWANTED 	parseCommand "SETSTATE" = Proto.parse2 SETSTATE 	parseCommand "GETSTATE" = Proto.parse1 GETSTATE+	parseCommand "SETURLPRESENT" = Proto.parse2 SETURLPRESENT+	parseCommand "SETURLMISSING" = Proto.parse2 SETURLMISSING+	parseCommand "GETURLS" = Proto.parse2 GETURLS 	parseCommand "DEBUG" = Proto.parse1 DEBUG 	parseCommand _ = Proto.parseFail @@ -212,6 +233,7 @@ type ErrorMsg = String type Setting = String type ProtocolVersion = Int+type Size = Maybe Integer  supportedProtocolVersions :: [ProtocolVersion] supportedProtocolVersions = [1]@@ -240,6 +262,12 @@ 	serialize = show 	deserialize = readish +instance Proto.Serializable Size where+	serialize (Just s) = show s+	serialize Nothing = "UNKNOWN"+	deserialize "UNKNOWN" = Just Nothing+	deserialize s = maybe Nothing (Just . Just) (readish s)+ instance Proto.Serializable Availability where 	serialize GloballyAvailable = "GLOBAL" 	serialize LocallyAvailable = "LOCAL"@@ -251,3 +279,12 @@ instance Proto.Serializable BytesProcessed where 	serialize (BytesProcessed n) = show n 	deserialize = BytesProcessed <$$> readish++instance Proto.Serializable [(URLString, Size, FilePath)] where+	serialize = unwords . map go+	  where+		go (url, sz, f) = url ++ " " ++ maybe "UNKNOWN" show sz ++ " " ++ f+	deserialize = Just . go [] . words+	  where+		go c (url:sz:f:rest) = go ((url, readish sz, f):c) rest+		go c _ = reverse c
Remote/GCrypt.hs view
@@ -122,6 +122,8 @@ 		, remotetype = remote 		, mkUnavailable = return Nothing 		, getInfo = return $ gitRepoInfo r+		, claimUrl = Nothing+		, checkUrl = Nothing 	} 	return $ Just $ specialRemote' specialcfg c 		(simplyPrepare $ store this rsyncopts)
Remote/Git.hs view
@@ -160,6 +160,8 @@ 			, remotetype = remote 			, mkUnavailable = unavailable r u c gc 			, getInfo = return $ gitRepoInfo r+			, claimUrl = Nothing+			, checkUrl = Nothing 			}  unavailable :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
Remote/Glacier.hs view
@@ -46,30 +46,32 @@ 		(simplyPrepare $ checkKey this) 		this 	  where-		this = Remote {-			uuid = u,-			cost = cst,-			name = Git.repoDescribe r,-			storeKey = storeKeyDummy,-			retrieveKeyFile = retreiveKeyFileDummy,-			retrieveKeyFileCheap = retrieveCheap this,-			removeKey = removeKeyDummy,-			checkPresent = checkPresentDummy,-			checkPresentCheap = False,-			whereisKey = Nothing,-			remoteFsck = Nothing,-			repairRepo = Nothing,-			config = c,-			repo = r,-			gitconfig = gc,-			localpath = Nothing,-			readonly = False,-			availability = GloballyAvailable,-			remotetype = remote,-			mkUnavailable = return Nothing,-			getInfo = includeCredsInfo c (AWS.creds u) $+		this = Remote+			{ uuid = u+			, cost = cst+			, name = Git.repoDescribe r+			, storeKey = storeKeyDummy+			, retrieveKeyFile = retreiveKeyFileDummy+			, retrieveKeyFileCheap = retrieveCheap this+			, removeKey = removeKeyDummy+			, checkPresent = checkPresentDummy+			, checkPresentCheap = False+			, whereisKey = Nothing+			, remoteFsck = Nothing+			, repairRepo = Nothing+			, config = c+			, repo = r+			, gitconfig = gc+			, localpath = Nothing+			, readonly = False+			, availability = GloballyAvailable+			, remotetype = remote+			, mkUnavailable = return Nothing+			, getInfo = includeCredsInfo c (AWS.creds u) $ 				[ ("glacier vault", getVault c) ]-		}+			, claimUrl = Nothing+			, checkUrl = Nothing+			} 	specialcfg = (specialRemoteCfg c) 		-- Disabled until jobList gets support for chunks. 		{ chunkConfig = NoChunks
Remote/Helper/AWS.hs view
@@ -5,21 +5,19 @@  - Licensed under the GNU GPL version 3 or higher.  -} -{-# LANGUAGE OverloadedStrings, TupleSections #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}  module Remote.Helper.AWS where  import Common.Annex import Creds -import qualified Aws-import qualified Aws.S3 as S3 import qualified Data.Map as M import qualified Data.ByteString as B import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import Data.Text (Text)-import Data.IORef  creds :: UUID -> CredPairStorage creds u = CredPairStorage@@ -28,13 +26,6 @@ 	, credPairRemoteKey = Just "s3creds" 	} -genCredentials :: CredPair -> IO Aws.Credentials-genCredentials (keyid, secret) = Aws.Credentials-	<$> pure (encodeUtf8 (T.pack keyid))-	<*> pure (encodeUtf8 (T.pack secret))-	<*> newIORef []-	<*> pure Nothing- data Service = S3 | Glacier 	deriving (Eq) @@ -82,7 +73,3 @@  s3DefaultHost :: String s3DefaultHost = "s3.amazonaws.com"--mkLocationConstraint :: Region -> S3.LocationConstraint-mkLocationConstraint "US" = S3.locationUsClassic-mkLocationConstraint r = r
Remote/Hook.hs view
@@ -39,30 +39,32 @@ 		(simplyPrepare $ retrieve hooktype) 		(simplyPrepare $ remove hooktype) 		(simplyPrepare $ checkKey r hooktype)-		Remote {-			uuid = u,-			cost = cst,-			name = Git.repoDescribe r,-			storeKey = storeKeyDummy,-			retrieveKeyFile = retreiveKeyFileDummy,-			retrieveKeyFileCheap = retrieveCheap hooktype,-			removeKey = removeKeyDummy,-			checkPresent = checkPresentDummy,-			checkPresentCheap = False,-			whereisKey = Nothing,-			remoteFsck = Nothing,-			repairRepo = Nothing,-			config = c,-			localpath = Nothing,-			repo = r,-			gitconfig = gc,-			readonly = False,-			availability = GloballyAvailable,-			remotetype = remote,-			mkUnavailable = gen r u c $-				gc { remoteAnnexHookType = Just "!dne!" },-			getInfo = return [("hooktype", hooktype)]-		}+		Remote+			{ uuid = u+			, cost = cst+			, name = Git.repoDescribe r+			, storeKey = storeKeyDummy+			, retrieveKeyFile = retreiveKeyFileDummy+			, retrieveKeyFileCheap = retrieveCheap hooktype+			, removeKey = removeKeyDummy+			, checkPresent = checkPresentDummy+			, checkPresentCheap = False+			, whereisKey = Nothing+			, remoteFsck = Nothing+			, repairRepo = Nothing+			, config = c+			, localpath = Nothing+			, repo = r+			, gitconfig = gc+			, readonly = False+			, availability = GloballyAvailable+			, remotetype = remote+			, mkUnavailable = gen r u c $+				gc { remoteAnnexHookType = Just "!dne!" }+			, getInfo = return [("hooktype", hooktype)]+			, claimUrl = Nothing+			, checkUrl = Nothing+			}   where 	hooktype = fromMaybe (error "missing hooktype") $ remoteAnnexHookType gc 
Remote/List.hs view
@@ -30,6 +30,7 @@ import qualified Remote.Directory import qualified Remote.Rsync import qualified Remote.Web+import qualified Remote.BitTorrent #ifdef WITH_WEBDAV import qualified Remote.WebDAV #endif@@ -52,6 +53,7 @@ 	, Remote.Directory.remote 	, Remote.Rsync.remote 	, Remote.Web.remote+	, Remote.BitTorrent.remote #ifdef WITH_WEBDAV 	, Remote.WebDAV.remote #endif
Remote/Rsync.hs view
@@ -84,6 +84,8 @@ 			, remotetype = remote 			, mkUnavailable = return Nothing 			, getInfo = return [("url", url)]+			, claimUrl = Nothing+			, checkUrl = Nothing 			}   where 	specialcfg = (specialRemoteCfg c)
Remote/S3.hs view
@@ -6,6 +6,7 @@  -}  {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-}  module Remote.S3 (remote, iaHost, configIA, iaItemUrl) where@@ -26,6 +27,7 @@ import Control.Monad.Trans.Resource import Control.Monad.Catch import Data.Conduit+import Data.IORef  import Common.Annex import Types.Remote@@ -65,35 +67,37 @@ 		(prepareS3 this info $ checkKey this) 		this 	  where-		this = Remote {-			uuid = u,-			cost = cst,-			name = Git.repoDescribe r,-			storeKey = storeKeyDummy,-			retrieveKeyFile = retreiveKeyFileDummy,-			retrieveKeyFileCheap = retrieveCheap,-			removeKey = removeKeyDummy,-			checkPresent = checkPresentDummy,-			checkPresentCheap = False,-			whereisKey = Nothing,-			remoteFsck = Nothing,-			repairRepo = Nothing,-			config = c,-			repo = r,-			gitconfig = gc,-			localpath = Nothing,-			readonly = False,-			availability = GloballyAvailable,-			remotetype = remote,-			mkUnavailable = gen r u (M.insert "host" "!dne!" c) gc,-			getInfo = includeCredsInfo c (AWS.creds u) $ catMaybes+		this = Remote+			{ uuid = u+			, cost = cst+			, name = Git.repoDescribe r+			, storeKey = storeKeyDummy+			, retrieveKeyFile = retreiveKeyFileDummy+			, retrieveKeyFileCheap = retrieveCheap+			, removeKey = removeKeyDummy+			, checkPresent = checkPresentDummy+			, checkPresentCheap = False+			, whereisKey = Nothing+			, remoteFsck = Nothing+			, repairRepo = Nothing+			, config = c+			, repo = r+			, gitconfig = gc+			, localpath = Nothing+			, readonly = False+			, availability = GloballyAvailable+			, remotetype = remote+			, mkUnavailable = gen r u (M.insert "host" "!dne!" c) gc+			, getInfo = includeCredsInfo c (AWS.creds u) $ catMaybes 				[ Just ("bucket", fromMaybe "unknown" (getBucketName c)) 				, if configIA c 					then Just ("internet archive item", iaItemUrl $ fromMaybe "unknown" $ getBucketName c) 					else Nothing 				, Just ("partsize", maybe "unlimited" (roughSize storageUnits False) (getPartSize c)) 				]-		}+			, claimUrl = Nothing+			, checkUrl = Nothing+			}  s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) s3Setup mu mcreds c = do@@ -162,7 +166,7 @@ 		_ -> singlepartupload k f p	 	-- Store public URL to item in Internet Archive. 	when (isIA (hinfo h) && not (isChunkKey k)) $-		setUrlPresent k (iaKeyUrl r k)+		setUrlPresent webUUID k (iaKeyUrl r k) 	return True   where 	singlepartupload k f p = do@@ -306,7 +310,7 @@ 				showAction $ "creating bucket in " ++ datacenter 				void $ sendS3Handle h $ 					S3.PutBucket (bucket $ hinfo h) Nothing $-						AWS.mkLocationConstraint $+						mkLocationConstraint $ 							T.pack datacenter 		writeUUIDFile c u h 	@@ -389,7 +393,7 @@ withS3Handle :: RemoteConfig -> UUID -> S3Info -> (S3Handle -> Annex a) -> Annex a withS3Handle c u info a = do 	creds <- getRemoteCredPairFor "S3" c (AWS.creds u)-	awscreds <- liftIO $ AWS.genCredentials $ fromMaybe nocreds creds+	awscreds <- liftIO $ genCredentials $ fromMaybe nocreds creds 	let awscfg = AWS.Configuration AWS.Timestamp awscreds (AWS.defaultLog AWS.Error) 	bracketIO (newManager httpcfg) closeManager $ \mgr ->  		a $ S3Handle mgr awscfg s3cfg info@@ -503,3 +507,14 @@ iaKeyUrl r k = "http://archive.org/download/" ++ b ++ "/" ++ getBucketObject (config r) k   where 	b = fromMaybe "" $ getBucketName $ config r++genCredentials :: CredPair -> IO AWS.Credentials+genCredentials (keyid, secret) = AWS.Credentials+	<$> pure (T.encodeUtf8 (T.pack keyid))+	<*> pure (T.encodeUtf8 (T.pack secret))+	<*> newIORef []+	<*> pure Nothing++mkLocationConstraint :: AWS.Region -> S3.LocationConstraint+mkLocationConstraint "US" = S3.locationUsClassic+mkLocationConstraint r = r
Remote/Tahoe.hs view
@@ -64,29 +64,31 @@ 	hdl <- liftIO $ TahoeHandle 		<$> maybe (defaultTahoeConfigDir u) return (remoteAnnexTahoe gc) 		<*> newEmptyTMVarIO-	return $ Just $ Remote {-		uuid = u,-		cost = cst,-		name = Git.repoDescribe r,-		storeKey = store u hdl,-		retrieveKeyFile = retrieve u hdl,-		retrieveKeyFileCheap = \_ _ -> return False,-		removeKey = remove,-		checkPresent = checkKey u hdl,-		checkPresentCheap = False,-		whereisKey = Nothing,-		remoteFsck = Nothing,-		repairRepo = Nothing,-		config = c,-		repo = r,-		gitconfig = gc,-		localpath = Nothing,-		readonly = False,-		availability = GloballyAvailable,-		remotetype = remote,-		mkUnavailable = return Nothing,-		getInfo = return []-	}+	return $ Just $ Remote+		{ uuid = u+		, cost = cst+		, name = Git.repoDescribe r+		, storeKey = store u hdl+		, retrieveKeyFile = retrieve u hdl+		, retrieveKeyFileCheap = \_ _ -> return False+		, removeKey = remove+		, checkPresent = checkKey u hdl+		, checkPresentCheap = False+		, whereisKey = Nothing+		, remoteFsck = Nothing+		, repairRepo = Nothing+		, config = c+		, repo = r+		, gitconfig = gc+		, localpath = Nothing+		, readonly = False+		, availability = GloballyAvailable+		, remotetype = remote+		, mkUnavailable = return Nothing+		, getInfo = return []+		, claimUrl = Nothing+		, checkUrl = Nothing+		}  tahoeSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) tahoeSetup mu _ c = do
Remote/Web.hs view
@@ -1,4 +1,4 @@-{- Web remotes.+{- Web remote.  -  - Copyright 2011 Joey Hess <joey@kitenet.net>  -@@ -16,6 +16,7 @@ import Annex.Content import Config.Cost import Logs.Web+import Annex.UUID import Types.Key import Utility.Metered import qualified Annex.Url as Url@@ -42,32 +43,34 @@  gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) gen r _ c gc = -	return $ Just Remote {-		uuid = webUUID,-		cost = expensiveRemoteCost,-		name = Git.repoDescribe r,-		storeKey = uploadKey,-		retrieveKeyFile = downloadKey,-		retrieveKeyFileCheap = downloadKeyCheap,-		removeKey = dropKey,-		checkPresent = checkKey,-		checkPresentCheap = False,-		whereisKey = Just getUrls,-		remoteFsck = Nothing,-		repairRepo = Nothing,-		config = c,-		gitconfig = gc,-		localpath = Nothing,-		repo = r,-		readonly = True,-		availability = GloballyAvailable,-		remotetype = remote,-		mkUnavailable = return Nothing,-		getInfo = return []-	}+	return $ Just Remote+		{ uuid = webUUID+		, cost = expensiveRemoteCost+		, name = Git.repoDescribe r+		, storeKey = uploadKey+		, retrieveKeyFile = downloadKey+		, retrieveKeyFileCheap = downloadKeyCheap+		, removeKey = dropKey+		, checkPresent = checkKey+		, checkPresentCheap = False+		, whereisKey = Just getWebUrls+		, remoteFsck = Nothing+		, repairRepo = Nothing+		, config = c+		, gitconfig = gc+		, localpath = Nothing+		, repo = r+		, readonly = True+		, availability = GloballyAvailable+		, remotetype = remote+		, mkUnavailable = return Nothing+		, getInfo = return []+		, claimUrl = Nothing -- implicitly claims all urls+		, checkUrl = Nothing+		}  downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool-downloadKey key _file dest _p = get =<< getUrls key+downloadKey key _file dest _p = get =<< getWebUrls key   where 	get [] = do 		warning "no known url"@@ -85,7 +88,7 @@ 					warning "quvi support needed for this url" 					return False #endif-				DefaultDownloader -> downloadUrl [u'] dest+				_ -> downloadUrl [u'] dest  downloadKeyCheap :: Key -> FilePath -> Annex Bool downloadKeyCheap _ _ = return False@@ -97,12 +100,12 @@  dropKey :: Key -> Annex Bool dropKey k = do-	mapM_ (setUrlMissing k) =<< getUrls k+	mapM_ (setUrlMissing webUUID k) =<< getWebUrls k 	return True  checkKey :: Key -> Annex Bool checkKey key = do-	us <- getUrls key+	us <- getWebUrls key 	if null us 		then return False 		else either error return =<< checkKey' key us@@ -117,7 +120,7 @@ #else 			return $ Left "quvi support needed for this url" #endif-		DefaultDownloader -> do+		_ -> do 			Url.withUrlOptions $ catchMsgIO . 				Url.checkBoth u' (keySize key)   where@@ -127,3 +130,9 @@ 		case r of 			Right _ -> return r 			Left _ -> firsthit rest r a++getWebUrls :: Key -> Annex [URLString]+getWebUrls key = filter supported <$> getUrls key+  where+	supported u = snd (getDownloader u) +		`elem` [WebDownloader, QuviDownloader]
Remote/WebDAV.hs view
@@ -51,30 +51,32 @@ 		(prepareDAV this $ checkKey this chunkconfig) 		this 	  where-		this = Remote {-			uuid = u,-			cost = cst,-			name = Git.repoDescribe r,-			storeKey = storeKeyDummy,-			retrieveKeyFile = retreiveKeyFileDummy,-			retrieveKeyFileCheap = retrieveCheap,-			removeKey = removeKeyDummy,-			checkPresent = checkPresentDummy,-			checkPresentCheap = False,-			whereisKey = Nothing,-			remoteFsck = Nothing,-			repairRepo = Nothing,-			config = c,-			repo = r,-			gitconfig = gc,-			localpath = Nothing,-			readonly = False,-			availability = GloballyAvailable,-			remotetype = remote,-			mkUnavailable = gen r u (M.insert "url" "http://!dne!/" c) gc,-			getInfo = includeCredsInfo c (davCreds u) $+		this = Remote+			{ uuid = u+			, cost = cst+			, name = Git.repoDescribe r+			, storeKey = storeKeyDummy+			, retrieveKeyFile = retreiveKeyFileDummy+			, retrieveKeyFileCheap = retrieveCheap+			, removeKey = removeKeyDummy+			, checkPresent = checkPresentDummy+			, checkPresentCheap = False+			, whereisKey = Nothing+			, remoteFsck = Nothing+			, repairRepo = Nothing+			, config = c+			, repo = r+			, gitconfig = gc+			, localpath = Nothing+			, readonly = False+			, availability = GloballyAvailable+			, remotetype = remote+			, mkUnavailable = gen r u (M.insert "url" "http://!dne!/" c) gc+			, getInfo = includeCredsInfo c (davCreds u) $ 				[("url", fromMaybe "unknown" (M.lookup "url" c))]-		}+			, claimUrl = Nothing+			, checkUrl = Nothing+			} 		chunkconfig = getChunkConfig c  webdavSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
Types/CleanupActions.hs view
@@ -9,9 +9,12 @@  import Types.UUID +import Utility.Url+ data CleanupAction 	= RemoteCleanup UUID 	| StopHook UUID 	| FsckCleanup 	| SshCachingCleanup+	| TorrentCleanup URLString 	deriving (Eq, Ord)
Types/GitConfig.hs view
@@ -42,6 +42,7 @@ 	, annexDebug :: Bool 	, annexWebOptions :: [String] 	, annexQuviOptions :: [String]+	, annexAriaTorrentOptions :: [String] 	, annexWebDownloadCommand :: Maybe String 	, annexCrippledFileSystem :: Bool 	, annexLargeFiles :: Maybe String@@ -77,6 +78,7 @@ 	, annexDebug = getbool (annex "debug") False 	, annexWebOptions = getwords (annex "web-options") 	, annexQuviOptions = getwords (annex "quvi-options")+	, annexAriaTorrentOptions = getwords (annex "aria-torrent-options") 	, annexWebDownloadCommand = getmaybe (annex "web-download-command") 	, annexCrippledFileSystem = getbool (annex "crippledfilesystem") False 	, annexLargeFiles = getmaybe (annex "largefiles")
Types/Remote.hs view
@@ -25,10 +25,12 @@ import Types.GitConfig import Types.Availability import Types.Creds+import Types.UrlContents import Config.Cost import Utility.Metered import Git.Types import Utility.SafeCommand+import Utility.Url  type RemoteConfigKey = String type RemoteConfig = M.Map RemoteConfigKey String@@ -100,7 +102,13 @@ 	-- available for use. All its actions should fail. 	mkUnavailable :: a (Maybe (RemoteA a)), 	-- Information about the remote, for git annex info to display.-	getInfo :: a [(String, String)]+	getInfo :: a [(String, String)],+	-- Some remotes can download from an url (or uri).+	claimUrl :: Maybe (URLString -> a Bool),+	-- Checks that the url is accessible, and gets information about+	-- its contents, without downloading the full content.+	-- Throws an exception if the url is inaccessible.+	checkUrl :: Maybe (URLString -> a UrlContents) }  instance Show (RemoteA a) where
+ Types/UrlContents.hs view
@@ -0,0 +1,47 @@+{- git-annex URL contents+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Types.UrlContents (+	UrlContents(..),+	SafeFilePath,+	mkSafeFilePath,+	fromSafeFilePath+) where++import Utility.Url+import Utility.Path++import System.FilePath++data UrlContents+	-- An URL contains a file, whose size may be known.+	-- There might be a nicer filename to use.+	= UrlContents (Maybe Integer) (Maybe SafeFilePath)+	-- Sometimes an URL points to multiple files, each accessible+	-- by their own URL.+	| UrlMulti [(URLString, Maybe Integer, SafeFilePath)]++-- This is a FilePath, from an untrusted source,+-- sanitized so it doesn't contain any directory traversal tricks+-- and is always relative. It can still contain subdirectories.+-- Any unusual characters are also filtered out.+newtype SafeFilePath = SafeFilePath FilePath+	deriving (Show)++mkSafeFilePath :: FilePath -> SafeFilePath+mkSafeFilePath p = SafeFilePath $ if null p' then "file" else p'+  where+	p' = joinPath $ filter safe $ map sanitizeFilePath $ splitDirectories p+	safe s+		| isDrive s = False+		| s == ".." = False+		| s == ".git" = False+		| null s = False+		| otherwise = True++fromSafeFilePath :: SafeFilePath -> FilePath+fromSafeFilePath (SafeFilePath p) = p
+ Utility/DottedVersion.hs view
@@ -0,0 +1,36 @@+{- dotted versions, such as 1.0.1+ -+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>+ -+ - License: BSD-2-clause+ -}++module Utility.DottedVersion where++import Common++data DottedVersion = DottedVersion String Integer+	deriving (Eq)++instance Ord DottedVersion where+	compare (DottedVersion _ x) (DottedVersion _ y) = compare x y++instance Show DottedVersion where+	show (DottedVersion s _) = s++{- To compare dotted versions like 1.7.7 and 1.8, they are normalized to+ - a somewhat arbitrary integer representation. -}+normalize :: String -> DottedVersion+normalize v = DottedVersion v $ +	sum $ mult 1 $ reverse $ extend precision $ take precision $+		map readi $ split "." v+  where+	extend n l = l ++ replicate (n - length l) 0+	mult _ [] = []+	mult n (x:xs) = (n*x) : mult (n*10^width) xs+	readi :: String -> Integer+	readi s = case reads s of+		((x,_):_) -> x+		_ -> 0+	precision = 10 -- number of segments of the version to compare+	width = length "yyyymmddhhmmss" -- maximum width of a segment
Utility/Metered.hs view
@@ -143,3 +143,36 @@   where 	k = 1024 	chunkOverhead = 2 * sizeOf (undefined :: Int) -- GHC specific++{- Parses the String looking for a command's progress output, and returns+ - Maybe the number of bytes rsynced so far, and any any remainder of the+ - string that could be an incomplete progress output. That remainder+ - should be prepended to future output, and fed back in. This interface+ - allows the command's output to be read in any desired size chunk, or+ - even one character at a time.+ -}+type ProgressParser = String -> (Maybe BytesProcessed, String)++{- Runs a command and runs a ProgressParser on its output, in order+ - to update the meter. The command's output is also sent to stdout. -}+commandMeter :: ProgressParser -> MeterUpdate -> FilePath -> [CommandParam] -> IO Bool+commandMeter progressparser meterupdate cmd params = liftIO $ catchBoolIO $+	withHandle StdoutHandle createProcessSuccess p $+		feedprogress zeroBytesProcessed []+  where+	p = proc cmd (toCommand params)++	feedprogress prev buf h = do+		s <- hGetSomeString h 80+		if null s+			then return True+			else do+				putStr s+				hFlush stdout+				let (mbytes, buf') = progressparser (buf++s)+				case mbytes of+					Nothing -> feedprogress prev buf' h+					(Just bytes) -> do+						when (bytes /= prev) $+							meterupdate bytes+						feedprogress bytes buf' h
Utility/Path.hs view
@@ -267,7 +267,8 @@  - sane FilePath.  -  - All spaces and punctuation and other wacky stuff are replaced- - with '_', except for '.' "../" will thus turn into ".._", which is safe.+ - with '_', except for '.'+ - "../" will thus turn into ".._", which is safe.  -} sanitizeFilePath :: String -> FilePath sanitizeFilePath = map sanitize
Utility/Rsync.hs view
@@ -60,31 +60,6 @@ 	fixup (File f) = File (toCygPath f) 	fixup p = p -{- Runs rsync, but intercepts its progress output and updates a meter.- - The progress output is also output to stdout. - -- - The params must enable rsync's --progress mode for this to work.- -}-rsyncProgress :: MeterUpdate -> [CommandParam] -> IO Bool-rsyncProgress meterupdate params = catchBoolIO $ -	withHandle StdoutHandle createProcessSuccess p (feedprogress 0 [])-  where-	p = proc "rsync" (toCommand $ rsyncParamsFixup params)-	feedprogress prev buf h = do-		s <- hGetSomeString h 80-		if null s-			then return True-			else do-				putStr s-				hFlush stdout-				let (mbytes, buf') = parseRsyncProgress (buf++s)-				case mbytes of-					Nothing -> feedprogress prev buf' h-					(Just bytes) -> do-						when (bytes /= prev) $-							meterupdate $ toBytesProcessed bytes-						feedprogress bytes buf' h- {- Checks if an rsync url involves the remote shell (ssh or rsh).  - Use of such urls with rsync requires additional shell  - escaping. -}@@ -106,14 +81,15 @@ 	| rsyncUrlIsShell s = False 	| otherwise = ':' `notElem` s -{- Parses the String looking for rsync progress output, and returns- - Maybe the number of bytes rsynced so far, and any any remainder of the- - string that could be an incomplete progress output. That remainder- - should be prepended to future output, and fed back in. This interface- - allows the output to be read in any desired size chunk, or even one- - character at a time.+{- Runs rsync, but intercepts its progress output and updates a meter.+ - The progress output is also output to stdout.   -- - Strategy: Look for chunks prefixed with \r (rsync writes a \r before+ - The params must enable rsync's --progress mode for this to work.+ -}+rsyncProgress :: MeterUpdate -> [CommandParam] -> IO Bool+rsyncProgress meterupdate = commandMeter parseRsyncProgress meterupdate "rsync"++{- Strategy: Look for chunks prefixed with \r (rsync writes a \r before  - the first progress output, and each thereafter). The first number  - after the \r is the number of bytes processed. After the number,  - there must appear some whitespace, or we didn't get the whole number,@@ -122,20 +98,23 @@  - In some locales, the number will have one or more commas in the middle  - of it.  -}-parseRsyncProgress :: String -> (Maybe Integer, String)+parseRsyncProgress :: ProgressParser parseRsyncProgress = go [] . reverse . progresschunks   where 	go remainder [] = (Nothing, remainder) 	go remainder (x:xs) = case parsebytes (findbytesstart x) of 		Nothing -> go (delim:x++remainder) xs-		Just b -> (Just b, remainder)+		Just b -> (Just (toBytesProcessed b), remainder)  	delim = '\r'+ 	{- Find chunks that each start with delim. 	 - The first chunk doesn't start with it 	 - (it's empty when delim is at the start of the string). -} 	progresschunks = drop 1 . split [delim] 	findbytesstart s = dropWhile isSpace s++	parsebytes :: String -> Maybe Integer 	parsebytes s = case break isSpace s of 		([], _) -> Nothing 		(_, []) -> Nothing
Utility/Url.hs view
@@ -191,9 +191,18 @@ 	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. -}+	 - support, or need that option.+	 -+	 - When the wget version is new enough, pass options for+	 - a less cluttered download display.+	 -} #ifndef __ANDROID__-	wgetparams = [Params "--clobber -c -O"]+	wgetparams = catMaybes+		[ if Build.SysConfig.wgetquietprogress+			then Just $ Params "-q --show-progress"+			else Nothing+		, Just $ Params "--clobber -c -O"+		] #else 	wgetparams = [Params "-c -O"] #endif
debian/changelog view
@@ -1,3 +1,26 @@+git-annex (5.20141219) unstable; urgency=medium++  * Webapp: When adding a new box.com remote, use the new style chunking.+    Thanks, Jon Ander Peñalba.+  * External special remote protocol now includes commands for setting+    and getting the urls associated with a key.+  * Urls can now be claimed by remotes. This will allow creating,+    for example, a external special remote that handles magnet: and+    *.torrent urls.+  * Use wget -q --show-progress for less verbose wget output,+    when built with wget 1.16.+  * Added bittorrent special remote.+  * addurl behavior change: When downloading an url ending in .torrent,+    it will download files from bittorrent, instead of the old behavior+    of adding the torrent file to the repository.+  * Added Recommends on aria2.+  * When possible, build with the haskell torrent library for parsing+    torrent files. As a fallback, can instead use btshowmetainfo from+    bittornado | bittorrent.+  * Fix build with -f-S3.++ -- Joey Hess <id@joeyh.name>  Fri, 19 Dec 2014 16:53:26 -0400+ git-annex (5.20141203) unstable; urgency=medium    * proxy: New command for direct mode repositories, allows bypassing
debian/control view
@@ -99,6 +99,8 @@ 	quvi, 	git-remote-gcrypt (>= 0.20130908-6), 	nocache,+	aria2,+	bittornado | bittorrent, Suggests: 	graphviz, 	bup,
+ doc/bugs/Attempting_to_repair_repository_almost_every_day.mdwn view
@@ -0,0 +1,5 @@+I'm using the webapp on my two main computers with up-to-date Debian (one has testing and the other one sid) and I have consistency checks scheduled every day.++The problem is that almost every time the check runs I'm getting the "Attempting to repair" message and git-annex starts using 100% CPU for quite a while, but after it it seams to have done no change to the git tree or the files.++The two computers are never on at the same time, but they are constantly syncing files (through box.com), I don't now if downloading files while the check is in progress might have something to do.
+ doc/bugs/Build_error_when_S3_is_disabled.mdwn view
@@ -0,0 +1,39 @@+With release 5.20141203, I'm getting the following build error.++    Remote/Helper/AWS.hs:15:18:+        Could not find module ‘Aws’+        Use -v to see a list of the files searched for.++    Remote/Helper/AWS.hs:16:18:+        Could not find module ‘Aws.S3’+        Use -v to see a list of the files searched for.++I'm installing dependencies with cabal but have disabled S3 support+('-f-S3').  This setup has worked for previous releases (I'm on a machine running Arch Linux).++    _features=(-f-Android+               -f-Assistant+               -fDbus+               -fDNS+               -fInotify+               -fPairing+               -fProduction+               -f-S3+               -fTestSuite+               -fTDFA+               -f-Webapp+               -f-WebDAV+               -fXMPP+               -fFeed+               -fQuvi+               -fCryptoHash)++    cabal update+    cabal install c2hs++    cabal install --user --force-reinstalls --only-dependencies "${_features[@]}"+    cabal configure "${_features[@]}"++    make++> [[fixed|done]] --[[Joey]]
+ doc/bugs/Cannot_set_direct_mode_with_non_default_worktree.mdwn view
@@ -0,0 +1,45 @@+### Please describe the problem.+I am trying to switch to direct mode with the git work tree in a different directory than default much like described in http://git-annex.branchable.com/forum/Detached_git_work_tree__63__/+++### What steps will reproduce the problem?+- Create a new git repo with the GIT_WORK_TREE and GIT_DIR set.+- git annex init test+- git annex direct+++### What version of git-annex are you using? On what operating system?+5.20141125 package in Debian unstable+++### Please provide any additional information below.++[[!format sh """++dbn@loaner:~/annex $ mkdir -p test/worktree++dbn@loaner:~/annex $ cd test/++dbn@loaner:~/annex/test $ git init+Initialized empty Git repository in /home/dbn/annex/test/.git/++dbn@loaner:~/annex/test $ git annex init test+init test ok+(Recording state in git...)++dbn@loaner:~/annex/test $ git annex direct --debug+commit  +[2014-12-08 03:05:45 PST] call: git ["--git-dir=/home/dbn/annex/test/.git","--work-tree=/home/dbn/annex/test/worktree","commit","-a","-m","commit before switching to direct mode"]+On branch master++Initial commit++nothing to commit+ok+[2014-12-08 03:05:45 PST] read: git ["--git-dir=/home/dbn/annex/test/.git","--work-tree=/home/dbn/annex/test/worktree","ls-files","--cached","-z","--","/home/dbn/annex/test/worktree"]+direct  [2014-12-08 03:05:45 PST] read: git ["--git-dir=/home/dbn/annex/test/.git","--work-tree=/home/dbn/annex/test/worktree","symbolic-ref","HEAD"]+[2014-12-08 03:05:45 PST] read: git ["--git-dir=/home/dbn/annex/test/.git","--work-tree=/home/dbn/annex/test/worktree","show-ref","--hash","refs/heads/master"]+[2014-12-08 03:05:45 PST] call: git ["--git-dir=/home/dbn/annex/test/.git","--work-tree=/home/dbn/annex/test/worktree","checkout","-q","-B","annex/direct/master"]+[2014-12-08 03:05:45 PST] call: git ["--git-dir=/home/dbn/annex/test/.git","--work-tree=/home/dbn/annex/test/worktree","config","core.bare","true"]+[2014-12-08 03:05:45 PST] read: git ["config","--null","--list"]+fatal: core.bare and core.worktree do not make sense++git-annex: user error (git ["config","--null","--list"] exited 128)+failed+git-annex: direct: 1 failed+"""]]
+ doc/bugs/Direct_mode_sync_fails_to_transfer_a_10GB_file.mdwn view
@@ -0,0 +1,58 @@+### Please describe the problem.++On Windows, a 10GB file of mine is successfully indexed (``git annex add``'ed), but ``git annex sync --content`` always fails with rsync, saying "recvkey: received key with wrong size". This is the largest file I've tested so far, and the only one that's failed.++### What steps will reproduce the problem?++1. Copy a 10GB file to a working copy (mine is ''PNG_Sequence.rar'', 10 361 629 980 bytes).+2. Run ``git annex add``+3. Run ``git annex sync --content``++### What version of git-annex are you using? On what operating system?++Windows 7 x64 with:++    git-annex version: 5.20141128-g70f997e+    build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV DNS Feed+    s Quvi TDFA CryptoHash+    key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SH+    A256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL+    remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier ddar ho+    ok external++### Please provide any additional information below.++[[!format sh """+# If you can, paste a complete transcript of the problem occurring here.+# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log++commit  (Recording state in git...)+ok+pull origin+ok+copy Art/PlanetPioneers/PNG_Sequence.rar copy Art/PlanetPioneers/PNG_Sequence.ra+r (checking origin...) (to origin...)+  recvkey: received key with wrong size; discarding++sent 39 bytes  received 12 bytes  102.00 bytes/sec+rsync error: syntax or usage error (code 1) at /home/lapo/package/rsync-3.0.9-1/+src/rsync-3.0.9/main.c(1052) [sender=3.0.9]total size is 10361629980  speedup is+ 203169215.29+  rsync failed -- run git annex again to resume file transfer+failed+pull origin+ok+push origin+Counting objects: 24, done.+Delta compression using up to 8 threads.+Compressing objects: 100% (11/11), done.+Writing objects: 100% (13/13), 1.06 KiB | 0 bytes/s, done.+Total 13 (delta 7), reused 0 (delta 0)+To ssh://gitannex@serv-gitannex:/home/gitannex/git-annex-test.git+   f8f70de..41bec92  git-annex -> synced/git-annex+   090ca15..e9e842b  annex/direct/master -> synced/master+ok+git-annex: sync: 1 failed++# End of transcript or log.+"""]]
+ doc/bugs/S3_memory_leaks/comment_7_1ac572b79caa23e3f791e4f8461fcddd._comment view
@@ -0,0 +1,10 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawmUJBh1lYmvfCCiGr3yrdx-QhuLCSRnU5c"+ nickname="Justin"+ subject="comment 7"+ date="2014-12-06T18:15:50Z"+ content="""+The new version works really great for me.  I've been copying to S3 over the past few days with no issues on my raspberry pi.++Thanks a ton for getting this out.+"""]]
doc/bugs/S3_upload_not_using_multipart.mdwn view
@@ -57,6 +57,6 @@ > enough version of the aws library. You need to configure the remote to > use an appropriate value for multipart, eg: > -> git annex enableremote cloud multipart=1GiB+> git annex enableremote cloud partsize=1GiB >  > --[[Joey]]
+ doc/bugs/ssh-options_seems_to_be_ignored.mdwn view
@@ -0,0 +1,45 @@+### Please describe the problem.+The docs say I can set ssh options via `annex.ssh-options` or `remote.NAME.annex-ssh-options`. I tried, and the setting appears to be completely ignored.++Apologies in advance if I've made a stupid typo.++### What steps will reproduce the problem?++I tried all of these:++    git config --local --replace-all annex.ssh-options "-i ~/.ssh/id_git_rsa"+    git config --local --replace-all remote.Watt.annex-ssh-options "-i ~/.ssh/id_git_rsa"++`git config -l | grep Watt` confirms it took:++    remote.Watt.url=ssh://watt.home/home/anthony/Music/+    remote.Watt.fetch=+refs/heads/*:refs/remotes/Watt/*+    remote.Watt.annex-uuid=e74b57e5-e78c-4f3d-bde6-4803a0c33837+    remote.Watt.annex-ssh-options=-i ~/.ssh/id_git_rsa++Then I ran `git annex sync Watt`, and was prompted for a password:++    anthony@Forest:~/Music$ git annex sync Watt+    commit  ok+    pull Watt +    Password: ++Running `ps ww $(pidof ssh)` shows that the `-i` option is missing:++      PID TTY      STAT   TIME COMMAND+    22188 pts/4    S+     0:00 ssh -S .git/annex/ssh/watt.home -o ControlMaster=auto -o ControlPersist=yes watt.home git-upload-pack '/home/anthony/Music/'+++### What version of git-annex are you using? On what operating system?++Debian testing 5.20141125++### Please provide any additional information below.++[[!format sh """+# If you can, paste a complete transcript of the problem occurring here.+# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log+++# End of transcript or log.+"""]]
doc/design/external_special_remote_protocol.mdwn view
@@ -91,14 +91,14 @@ The following requests *must* all be supported by the special remote.  * `INITREMOTE`  -  Request that the remote initialize itself. This is where any one-time+  Requests the remote to initialize itself. This is where any one-time   setup tasks can be done, for example creating an Amazon S3 bucket.     Note: This may be run repeatedly over time, as a remote is initialized in   different repositories, or as the configuration of a remote is changed.   (Both `git annex initremote` and `git-annex enableremote` run this.)   So any one-time setup tasks should be done idempotently. * `PREPARE`  -  Tells the special remote it's time to prepare itself to be used.  +  Tells the remote that it's time to prepare itself to be used.     Only INITREMOTE can come before this. * `TRANSFER STORE|RETRIEVE Key File`     Requests the transfer of a key. For STORE, the File is the file to upload;@@ -110,21 +110,29 @@   Multiple transfers might be requested by git-annex, but it's fine for the    program to serialize them and only do one at a time.   * `CHECKPRESENT Key`  -  Requests the remote check if a key is present in it.+  Requests the remote to check if a key is present in it. * `REMOVE Key`  -  Requests the remote remove a key's contents.+  Requests the remote to remove a key's contents.  The following requests can optionally be supported. If not handled, replying with `UNSUPPORTED-REQUEST` is acceptable.  * `GETCOST`  -  Requests the remote return a use cost. Higher costs are more expensive.+  Requests the remote to return a use cost. Higher costs are more expensive.   (See Config/Cost.hs for some standard costs.) * `GETAVAILABILITY`-  Requests the remote send back an `AVAILABILITY` reply.+  Requests the remote to send back an `AVAILABILITY` reply.   If the remote replies with `UNSUPPORTED-REQUEST`, its availability-  is asssumed to be global. So, only remotes that are only reachable+  is assumed to be global. So, only remotes that are only reachable   locally need to worry about implementing this.+* `CLAIMURL Url`  +  Asks the remote if it wishes to claim responsibility for downloading+  an url. If so, the remote should send back an `CLAIMURL-SUCCESS` reply.+  If not, it can send `CLAIMURL-FAILURE`.+* `CHECKURL Url`  +  Asks the remote to check if the url's content can currently be downloaded+  (without downloading it). The remote replies with one of `CHECKURL-FAILURE`,+  `CHECKURL-CONTENTS`, or `CHECKURL-MULTI`.  More optional requests may be added, without changing the protocol version, so if an unknown request is seen, reply with `UNSUPPORTED-REQUEST`.@@ -167,6 +175,24 @@   Indicates the INITREMOTE succeeded and the remote is ready to use. * `INITREMOTE-FAILURE ErrorMsg`     Indicates that INITREMOTE failed.+* `CLAIMURL-SUCCESS`  +  Indicates that the CLAIMURL url will be handled by this remote.+* `CLAIMURL-FAILURE`  +  Indicates that the CLAIMURL url wil not be handled by this remote.+* `CHECKURL-CONTENTS Size|UNKNOWN Filename`  +  Indicates that the requested url has been verified to exist.  +  The Size is the size in bytes, or use "UNKNOWN" if the size could not be+  determined.  +  The Filename can be empty (in which case a default is used),+  or can specify a filename that is suggested to be used for this url.+* `CHECKURL-MULTI Url Size|UNKNOWN Filename ...`  +  Indicates that the requested url has been verified to exist,+  and contains multiple files, which can each be accessed using+  their own url.  +  Note that since a list is returned, neither the Url nor the Filename+  can contain spaces.+* `CHECKURL-FAILURE`  +  Indicates that the requested url could not be accessed. * `UNSUPPORTED-REQUEST`     Indicates that the special remote does not know how to handle a request. @@ -247,6 +273,17 @@ * `GETSTATE Key`     Gets any state that has been stored for the key.     (git-annex replies with VALUE followed by the state.)+* `SETURLPRESENT Key Url`  +  Records an url (or uri) where the Key can be downloaded from.+* `SETURLMISSING Key Url`  +  Records that the key can no longer be downloaded from the specified+  url (or uri).+* `GETURLS Key Prefix`  +  Gets the recorded urls where a Key can be downloaded from.+  Only urls that start with the Prefix will be returned. The Prefix+  may be empty to get all urls.+  (git-annex replies one or more times with VALUE for each url.+  The final VALUE has an empty value, indicating the end of the url list.) * `DEBUG message`   Tells git-annex to display the message if --debug is enabled. @@ -288,7 +325,5 @@   the remote. However, \n and probably \0 need to be escaped somehow in the   file data, which adds complication. * uuid discovery during INITREMOTE.-* Support for getting and setting the list of urls that can be associated-  with a key. * Hook into webapp. Needs a way to provide some kind of prompt to the user   in the webapp, etc.
+ doc/devblog/day_236__release_day.mdwn view
@@ -0,0 +1,10 @@+Today's release has a month's accumulated changes, including several nice+new features: `git annex undo`, `git annex proxy`, `git annex diffdriver`,+and I was able to land the s3-aws branch in this release too, so lots of+improvements to the S3 support.++Spent several hours getting the autobuilders updated, with the haskell+`aws` library installed. Android and armel builds are still out of date.++Also fixed two Windows bugs related to the location of the bundled ssh+program.
+ doc/devblog/day_237__extending_addurl.mdwn view
@@ -0,0 +1,14 @@+Worked on [[todo/extensible_addurl]] today. When `git annex addurl` is run,+remotes will be asked if they claim the url, and whichever remote does will+be used to download it, and location tracking will indicate that remote+contains the object. This is a masive 1000 line patch touching 30 files,+including follow-on changes in `rmurl` and `whereis` and even `rekey`.++It should now be possible to build an external special remote that handles+*.torrent and magnet: urls and passes them off to a bittorrent client for+download, for example.++Another use for this would be to make an external special remote that+uses youtube-dl or some other program than quvi for downloading web videos.+The builtin quvi support could probably be moved out of the web special+remote, to a separate remote. I haven't tried to do that yet.
+ doc/devblog/day_238__extending_addurl_further.mdwn view
@@ -0,0 +1,67 @@+Some more work on the interface that lets remotes claim urls for `git annex+addurl`. Added support for remotes suggesting a filename to use when+adding an url. Also, added support for urls that result in multiple files+when downloaded. The obvious use case for that is an url to a torrent that+contains multiple files.++Then, got `git annex importfeed` to also check if a remote claims an url.++Finally, I put together a quick demo external remote using this new+interface. [[special_remotes/external/git-annex-remote-torrent]]+adds support for torrent files to git-annex, using [aria2c](http://aria2.sourceforge.net/) to download them.+It supports multi-file torrents, but not magnet links. (I'll probably+rewrite this more robustly and efficiently in haskell sometime soon.)++Here's a demo:++<pre>+# git annex initremote torrent type=external encryption=none externaltype=torrent+initremote torrent ok+(Recording state in git...)+# ls+# git annex addurl  --fast file:///home/joey/my.torrent+  % Total    % Received % Xferd  Average Speed   Time    Time     Time  Current+                                 Dload  Upload   Total   Spent    Left  Speed+100   198  100   198    0     0  3946k      0 --:--:-- --:--:-- --:--:-- 3946k+addurl _home_joey_my.torrent/bar (using torrent) ok+addurl _home_joey_my.torrent/baz (using torrent) ok+addurl _home_joey_my.torrent/foo (using torrent) ok+(Recording state in git...)+# ls _home_joey_my.torrent/+bar@  baz@  foo@+# git annex get _home_joey_my.torrent/baz+get _home_joey_my.torrent/baz (from torrent...) +  % Total    % Received % Xferd  Average Speed   Time    Time     Time  Current+                                 Dload  Upload   Total   Spent    Left  Speed+  0     0    0     0    0     0      0      0 --:--:-- --:--:-- --:--:-100   198  100   198    0     0  3580k      0 --:--:-- --:--:-- --:--:-- 3580k++12/11 18:14:56 [NOTICE] IPv4 DHT: listening on UDP port 6946++12/11 18:14:56 [NOTICE] IPv4 BitTorrent: listening on TCP port 6961++12/11 18:14:56 [NOTICE] IPv6 BitTorrent: listening on TCP port 6961++12/11 18:14:56 [NOTICE] Seeding is over.+12/11 18:14:57 [NOTICE] Download complete: /home/joey/tmp/tmp.Le89hJSXyh/tor++12/11 18:14:57 [NOTICE] Your share ratio was 0.0, uploaded/downloaded=0B/0B+                                                                               +Download Results:+gid   |stat|avg speed  |path/URI+======+====+===========+=======================================================+71f6b6|OK  |       0B/s|/home/joey/tmp/tmp.Le89hJSXyh/tor/baz++Status Legend:+(OK):download completed.+ok                      +(Recording state in git...)+# git annex find+_home_joey_my.torrent/baz+# git annex whereis _home_joey_my.torrent/baz+whereis _home_joey_my.torrent/baz (2 copies) +  	1878241d-ee49-446d-8cce-041c46442d94 -- [torrent]+   	52412020-2bb3-4aa4-ae16-0da22ba48875 -- joey@darkstar:~/tmp/repo [here]++  torrent: file:///home/joey/my.torrent#2+ok+</pre>
+ doc/devblog/day_239-240__bittorrent_remote.mdwn view
@@ -0,0 +1,16 @@+Spent a couple days adding a [[bittorrent_special_remote|special_remotes/bittorrent]]+to git-annex. This is better than the demo external torrent remote I made+on Friday: It's built into git-annex; it supports magnet links; it even+parses aria2c's output so the webapp can display progress bars.++Besides needing `aria2` to download torrents, it also currently depends on+the `btshowmetainfo` command from the original bittorrent client (or+bittornado). I looked into using+<http://hackage.haskell.org/package/torrent> instead,+but that package is out of date and doesn't currently build. I've got a+patch fixing that, but am waiting to hear back from the library's author.++There is a bit of a behavior change here; while before `git annex addurl` of+a torrent file would add the torrent file itself to the repository, it now will+download and add the contents of the torrent. I think/hope this behavior+change is ok..
+ doc/forum/Auto_update_not_working.mdwn view
@@ -0,0 +1,6 @@+Hello,++I've installed to ~/software/ using the prebuilt tarballs. I'm using the assistant with auto updates set to ask. Everytime I start the assistant it claims a new that a new version of git-annex has been installed. I click Finish Upgrade, it does the upgrade and it says to have finished upgrading to version 5.20141105-g8b19598. Next boot / restart everything starts again and it upgrades always to the same version.++Thanks!+Florian
+ doc/forum/Git_Annex_not_dropping_unused_content.mdwn view
@@ -0,0 +1,9 @@+I've deleted some files, but their content remains in the objects directory, and *git annex unused* does not list them.++I've read in this post <http://git-annex.branchable.com/forum/git-annex_unused_not_dropping_deleted_files/> that if other branches contain the files, then it won't count them as unused. My repo appears to have a few branches left over from views I've used.++    remotes/sdrive/views/(added=14_09);(tag=Shared)+    remotes/sdrive/views/(added=14_09);Images_=_+    remotes/sdrive/views/added=_++How can I delete these? Is git annex going to create a new branch for every new view I create?
+ doc/forum/How_to_hide_broken_symlinks.mdwn view
@@ -0,0 +1,45 @@+This is a method for hiding broken links using git-annex views.++Each annex will need it's own name for this system to work. For this example I'll use "localdrive." After getting file content, run:++    git-annex metadata --not --in=here --metadata in=localdrive . -s in-=localdrive+    git-annex metadata --in=here --not --metadata in=localdrive . -s in+=localdrive+    git-annex view /=*+    git-annex vfilter in=localdrive++Unused links will be hidden. Folder structures will remain the same.++To switch back use:++    git-annex vpop 2++Because this is a lot to type, I've placed these in a bash script in the base folder (ignored with .gitignore so it isn't sent to other repos). The local repo name can be changed by editing THISREPO:++    #!/bin/bash+    +    THISREPO='localdrive'+    +    git-annex metadata --not --in=here --metadata in=$THISREPO . -s in-=$THISREPO+    git-annex metadata --in=here --not --metadata in=$THISREPO . -s in+=$THISREPO+    git-annex view /=*+    git-annex vfilter in=$THISREPO+    +    exit 0++## Hiding Broken Links in Preferred Content Repos++If you have a repo with preferred content settings, this can be shortened to a single script which can be run to "refresh" the view:++    #!/bin/bash+    +    THISREPO='pcrepo'+    +    git-annex vpop 2+    git-annex sync+    git-annex get --auto+    git-annex metadata --not --in=here --metadata in=$THISREPO . -s in-=$THISREPO+    git-annex metadata --in=here --not --metadata in=$THISREPO . -s in+=$THISREPO+    git-annex view /=*+    git-annex vfilter in=$THISREPO+    +    exit 0
+ doc/forum/s3_server_side_encryption.mdwn view
@@ -0,0 +1,9 @@+AWS S3 offers a feature to enable server-side encryption of files.  +If I understand correctly, this is enabled by sending a specific HTTP header with the request to upload the file in question.   +So, this header needs to be set every time we want to upload a new file.  ++Is this feature already supported / being considered for future versions?++If not, am I correct in assuming it would have to be implemented in https://github.com/joeyh/git-annex/blob/master/Remote/S3.hs ?++Thank you
doc/git-annex.mdwn view
@@ -225,9 +225,12 @@   alternate locations from which the file can be downloaded. In this mode,   addurl can be used both to add new files, or to add urls to existing files. -  When quvi is installed, urls are automatically tested to see if they+  When `quvi` is installed, urls are automatically tested to see if they   point to a video hosting site, and the video is downloaded instead. +  Urls to torrent files (including magnet links) will cause the content of+  the torrent to be downloaded, using `aria2c`.+ * `rmurl file url`    Record that the file is no longer available at the url.@@ -1727,6 +1730,10 @@    Options to pass to quvi when using it to find the url to download for a   video.++* `annex.aria-torrent-options`++  Options to pass to aria2c when using it to download a torrent.  * `annex.http-headers` 
doc/install/Docker.mdwn view
@@ -15,7 +15,7 @@  So's the armel autobuilder container.  `docker pull joeyh/git-annex-armel-builder`, and its companion container-`docker pull joeyh/git-annex-armel-builder-companion`+`docker pull joeyh/git-annex-armel-companion`  # building autobuilder containers using Propellor 
+ doc/install/fromsource/comment_47_6de25c1e450e1e3b1d18d2c76235ccb8._comment view
@@ -0,0 +1,7 @@+[[!comment format=mdwn+ username="thnetos"+ subject="Where to start reading the source code?"+ date="2014-12-15T22:04:06Z"+ content="""+Do you have any recommendations for the overall haskell architecture of the project? Where to start looking if I want to read through the source code?+"""]]
doc/internals.mdwn view
@@ -17,7 +17,7 @@ Each subdirectory has the [[name_of_a_key|key_format]] in one of the [[key-value_backends|backends]]. The file inside also has the name of the key. This two-level structure is used because it allows the write bit to be removed-from the subdirectories as well as from the files. That prevents accidentially+from the subdirectories as well as from the files. That prevents accidentally deleting or changing the file contents. See [[lockdown]] for details.  In [[direct_mode]], file contents are not stored in here, and instead@@ -158,7 +158,7 @@ ## `group-preferred-content.log`  Contains standard preferred content settings for groups. (Overriding or-supplimenting the ones built into git-annex.)+supplementing the ones built into git-annex.)  The file format is one line per group, staring with a timestamp, then a space, then the group name followed by a space and then the preferred@@ -182,8 +182,9 @@ ## `aaa/bbb/*.log.web`  These log files record urls used by the-[[web_special_remote|special_remotes/web]]. Their format is similar-to the location tracking files, but with urls rather than UUIDs.+[[web_special_remote|special_remotes/web]] and sometimes by other remotes.+Their format is similar to the location tracking files, but with urls+rather than UUIDs.  ## `aaa/bbb/*.log.rmt` @@ -205,7 +206,7 @@ Lines are timestamped, and record when values are added (`field +value`), but also when values are removed (`field -value`). Removed values are retained in the log so that when merging an old line that sets a value-that was later unset, the value is not accidentially added back.+that was later unset, the value is not accidentally added back.  For example: @@ -214,8 +215,8 @@  The value can be completely arbitrary data, although it's typically reasonably short. If the value contains any whitespace-(including \r or \r), it will be base64 encoded. Base64 encoded values-are indicated by prefixing them with "!" +(including \r or \n), it will be base64 encoded. Base64 encoded values+are indicated by prefixing them with "!".  ## `aaa/bbb/*.log.cnk` @@ -237,7 +238,7 @@ The file format is simply one line per repository, with the uuid followed by a space and then its schedule, followed by a timestamp. -There can be multiple events in the schedule, separated by "; "+There can be multiple events in the schedule, separated by "; ".  The format of the scheduled events is the same described in the SCHEDULED JOBS section of the man page.
+ doc/internals/hashing/comment_2_086ea37acf15e2a8694b8386222b73f6._comment view
@@ -0,0 +1,11 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawnx8kHW66N3BqmkVpgtXDlYMvr8TJ5VvfY"+ nickname="Yaroslav"+ subject="comment 2"+ date="2014-12-04T20:26:47Z"+ content="""+1c to support  Péter's statement:++    $> git annex examinekey --format='${hashdirmixed}' \"SHA256E-s0--e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855\"+    pX/ZJ/%  +"""]]
− doc/news/version_5.20141013.mdwn
@@ -1,7 +0,0 @@-git-annex 5.20141013 released with [[!toggle text="these changes"]]-[[!toggleable text="""-   * Adjust cabal file to support building w/o assistant on the hurd.-   * Support building with yesod 1.4.-   * S3: Fix embedcreds=yes handling for the Internet Archive.-   * map: Handle .git prefixed remote repos. Closes: #[614759](http://bugs.debian.org/614759)-   * repair: Prevent auto gc from happening when fetching from a remote."""]]
+ doc/news/version_5.20141219.mdwn view
@@ -0,0 +1,20 @@+git-annex 5.20141219 released with [[!toggle text="these changes"]]+[[!toggleable text="""+   * Webapp: When adding a new box.com remote, use the new style chunking.+     Thanks, Jon Ander Peñalba.+   * External special remote protocol now includes commands for setting+     and getting the urls associated with a key.+   * Urls can now be claimed by remotes. This will allow creating,+     for example, a external special remote that handles magnet: and+     *.torrent urls.+   * Use wget -q --show-progress for less verbose wget output,+     when built with wget 1.16.+   * Added bittorrent special remote.+   * addurl behavior change: When downloading an url ending in .torrent,+     it will download files from bittorrent, instead of the old behavior+     of adding the torrent file to the repository.+   * Added Recommends on aria2.+   * When possible, build with the haskell torrent library for parsing+     torrent files. As a fallback, can instead use btshowmetainfo from+     bittornado | bittorrent.+   * Fix build with -f-S3."""]]
doc/related_software.mdwn view
@@ -15,3 +15,7 @@   [an extension](https://github.com/magit/magit-annex) for git annex. * [DataLad](http://datalad.org/) uses git-annex to provide access to   scientific data available from various sources.+* The [Baobáxia](https://github.com/RedeMocambos/baobaxia) project+  built by the Brazilian [Mocambos network](http://www.mocambos.net/)+  is [using git-annex to connect isolated communities](http://www.modspil.dk/itpolitik/baob_xia.html).+  Repositories sync over satellite internet and/or sneakernet.
doc/special_remotes.mdwn view
@@ -17,6 +17,7 @@ * [[webdav]] * [[tahoe]] * [[web]]+* [[bittorrent]] * [[xmpp]] * [[hook]] 
doc/special_remotes/S3.mdwn view
@@ -60,6 +60,8 @@   but can be enabled or changed at any time.   time. +  NOTE: there is a [[bug|/bugs/S3_upload_not_using_multipart/]] which depends on the AWS library. See [[this comment|http://git-annex.branchable.com/bugs/S3_upload_not_using_multipart/#comment-4c45dac68866d3550c0b32ed466e2c6a]] (the latest as of now).+ * `fileprefix` - By default, git-annex places files in a tree rooted at the   top of the S3 bucket. When this is set, it's prefixed to the filenames   used. For example, you could set it to "foo/" in one special remote,
+ doc/special_remotes/bittorrent.mdwn view
@@ -0,0 +1,29 @@+Similar to the [[web]] special remote, git-annex can use BitTorrent as+a source for files that are added to the git-annex repository.++It supports both `.torrent` files, and `magnet:` links. When you run `git+annex addurl` with either of these, it will download the contents of the+torrent and add it to the git annex repository.++See [[tips/using_the_web_as_a_special_remote]] for usage examples.++git-annex uses [aria2](http://aria2.sourceforge.net/) to download torrents.++If git-annex is not built using the haskell torrent library to parse+torrents, it also needs the needs the `btshowmetainfo` program, from+either bittornado or the original BitTorrent client.++## notes++Currently git-annex only supports downloading content from a torrent; +it cannot upload or remove content.++Multi-file torrents are supported; to handle them, `git annex addurl`+will add a directory containing all the files from the torrent.++It's hard to say if a torrent is healthy enough to let a file be downloaded+from it, and harder to predict if a torrent will stay healthy. So,+git-annex takes a cautious approach and when dropping a file, won't+treat this special remote as one of the required [[copies]]. It's probably+a good idea to configure git-annex to fully distrust this remote, by+running `git annex untrust bittorrent`
+ doc/special_remotes/bup/comment_12_fca579678edde073716f099c767767e1._comment view
@@ -0,0 +1,10 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawkEYZEqLf3Aj_FGV7S0FvsMplmGqqb555M"+ nickname="Sergiusz"+ subject="bup-join local-arch/2014-12-03-235617 "+ date="2014-12-04T19:38:07Z"+ content="""+How can I restore the previous commit from bup archives created with bup-split? Yes, I know I can use bup-join local-arch~1 git notation, but I would like to use bup-join local-arch/2014-12-03-235617 (bup-ls local-arch results) ...but this method does not work ...++s.+"""]]
doc/special_remotes/external.mdwn view
@@ -14,14 +14,18 @@ * Install it in PATH. * When the user runs `git annex initremote foo type=external externaltype=$bar`,   it will use your program.+* See [[design/external_special_remote_protocol]] for what the program+  needs to do. There's an example at the end of this page. * If things don't seem to work, pass `--debug` and you'll see, amoung other   things, a transcript of git-annex's communication with your program. * If you build a new special remote, please add it to the list   of [[special_remotes]]. +Here's an example of using an external special remote to add torrent+support to git-annex: [[external/git-annex-remote-torrent]]+ Here's a simple shell script example, which can easily be adapted to run whatever commands you need. Or better, re-written in some better-language of your choice. See [[design/external_special_remote_protocol]]-for the details.+language of your choice.  [[!inline pages="special_remotes/external/example.sh" feeds=no]]
+ doc/special_remotes/external/git-annex-remote-torrent view
@@ -0,0 +1,203 @@+#!/bin/sh+# This is a demo git-annex external special remote program,+# which adds basic torrent download support to git-annex.+#+# Uses aria2c. Also needs the original bittorrent (or bittornado) for the+# btshowmetainfo command.+# +# Install in PATH as git-annex-remote-torrent+#+# Enable remote by running:+#  git annex initremote torrent type=external encryption=none externaltype=torrent+#  git annex untrust torrent+#+# Copyright 2014 Joey Hess; licenced under the GNU GPL version 3 or higher.++set -e++# This program speaks a line-based protocol on stdin and stdout.+# When running any commands, their stdout should be redirected to stderr+# (or /dev/null) to avoid messing up the protocol.+runcmd () {+	"$@" >&2+}++# Gets a VALUE response and stores it in $RET+getvalue () {+	read resp+	# Tricky POSIX shell code to split first word of the resp,+	# preserving all other whitespace+	case "${resp%% *}" in+		VALUE)+			RET="$(echo "$resp" | sed 's/^VALUE \?//')"+		;;+		*)+		RET=""+		;;+	esac+}++# Get a list of all known torrent urls for a key,+# storing it in a temp file.+geturls () {+	key="$1"+	tmp="$2"++	echo GETURLS "$key"+	getvalue+	while [ -n "$RET" ]; do+		if istorrent "$RET"; then+			echo "$RET" >> "$tmp"+		fi+		getvalue+	done+}++# Does the url end in .torrent?+# Note that we use #N on the url to indicate which file+# from a multi-file torrent is wanted.+istorrent () {+	echo "$1" | egrep -q "\.torrent(#.*)?$"+}++# Download a single file from a torrent.+#+# Note: Does not support resuming interrupted transfers.+# Note: Does not feed progress info back to git-annex, and since+# the destination file is only populated at the end, git-annex will fail+# to display a progress bar for this download.+downloadtorrent () {+	torrent="$1"+	n="$2"+	dest="$3"++	tmpdir="$(mktemp -d)"++	# aria2c will create part of the directory structure+	# contained in the torrent. It may download parts of other files+	# in addition to the one we asked for. So, we need to find+	# out the filename we want, and look for it.+	wantdir="$(btshowmetainfo "$torrent" | grep "^directory name: " | sed "s/^directory name: //" || true)"+	if [ -n "$wantdir" ]; then+		wantfile="$(btshowmetainfo "$torrent" | grep '^   ' | sed 's/^   //' | head -n "$n" | tail -n 1 | sed 's/ ([0-9]*)$//')"+		if ! runcmd aria2c --select-file="$n" "$torrent" -d "$tmpdir"; then+			false+		fi+	else+		wantfile="$(btshowmetainfo "$torrent" | egrep "^file name.*: " | sed "s/^file name.*: //")"+		wantdir=.+		if ! runcmd aria2c "$torrent" -d "$tmpdir"; then+			false+		fi+	fi+	if [ -e "$tmpdir/$wantdir/$wantfile" ]; then+		mv "$tmpdir/$wantdir/$wantfile" "$dest"+		rm -rf "$tmpdir"+	else+		rm -rf "$tmpdir"+		false+	fi+}++# This has to come first, to get the protocol started.+echo VERSION 1++while read line; do+	set -- $line+	case "$1" in+		INITREMOTE)+			echo INITREMOTE-SUCCESS+		;;+		PREPARE)+			echo PREPARE-SUCCESS+		;;+		CLAIMURL)+			url="$2"+			if istorrent "$url"; then+				echo CLAIMURL-SUCCESS+			else+				echo CLAIMURL-FAILURE+			fi+		;;+		CHECKURL)+			url="$2"+			# List contents of torrent.+			tmp=$(mktemp)+			if ! runcmd curl -o "$tmp" "$url"; then+				echo CHECKURL-FAILURE+			else+				oldIFS="$IFS"+			IFS="+"+				printf "CHECKURL-MULTI"+				n=0+				for l in $(btshowmetainfo "$tmp" | grep '^   ' | sed 's/^   //'); do+					# Note that the file cannot contain spaces.+					file="$(echo "$l" | sed 's/ ([0-9]*)$//' | sed 's/ /_/g')"+					size="$(echo "$l" | sed 's/.* (\([0-9]*\))$/\1/')"+					n=$(expr $n + 1)+					printf " $url#$n $size $file"+				done+				if [ "$n" = 0 ]; then+					file="$(btshowmetainfo "$tmp" | egrep "^file name.*: " | sed "s/^file name.*: //")"+					size="$(btshowmetainfo "$tmp" | egrep "^file size.*: " | sed "s/^file size.*: \([0-9]*\).*/\1/")"+					printf " $url $size $file"+				fi+				printf "\n"+				IFS="$oldIFS"+			fi+			rm -f "$tmp"+		;;+		TRANSFER)+			key="$3"+			file="$4"+			case "$2" in+				STORE)+					echo TRANSFER-FAILURE STORE "$key" "upload not supported"+				;;+				RETRIEVE)+					urltmp=$(mktemp)+					geturls "$key" "$urltmp"+					url="$(head "$urltmp")" || true+					rm -f "$urltmp"+					if [ -z "$url" ]; then+						echo TRANSFER-FAILURE RETRIEVE "$key" "no known torrent urls for this key"+					else+						tmp=$(mktemp)+						if ! runcmd curl -o "$tmp" "$url"; then+							echo TRANSFER-FAILURE RETRIEVE "$key" "failed downloading torrent file from $url"+						else+							filenum="$(echo "$url" | sed 's/(.*#\(\d*\)/\1/')"+							if downloadtorrent "$tmp" "$filenum" "$file"; then+								echo TRANSFER-SUCCESS RETRIEVE "$key"+							else+								echo TRANSFER-FAILURE RETRIEVE "$key" "failed to download torrent contents from $url"+							fi+						fi+						rm -f "$tmp"					+					fi+				;;+			esac+		;;+		CHECKPRESENT)+			key="$2"+			# Let's just assume that torrents are never present+			# for simplicity.+			echo CHECKPRESENT-UNKNOWN "$key" "cannot reliably check torrent status"+		;;+		REMOVE)+			key="$2"+			# Remove all torrent urls for the key.+			tmp=$(mktemp)+			geturls "$key" "$tmp"+			for url in $(cat "$tmp"); do+				echo SETURLMISSING "$key" "$url"+			done+			rm -f "$tmp"+			echo REMOVE-SUCCESS "$key"+		;;+		*)+			echo UNSUPPORTED-REQUEST+		;;+	esac	+done
doc/thanks.mdwn view
@@ -14,6 +14,8 @@ [NSF](https://www.nsf.gov/awardsearch/showAward?AWD_ID=1429999) as a part of the [DataLad project](http://datalad.org/). +Thanks also to these folks for their support: martin f. krafft and John Byrnes.+ ## 2013-2014  Continued git-annex development was [crowd funded](https://campaign.joeyh.name/)@@ -132,7 +134,7 @@ Mica Semrick, Paul Staab, Rémi Vanicat, Martin Holtschneider, Jan Ivar Beddari, Peter Simons, Thomas Koch, Justin Geibel, Guillaume DELVIT, Shanti Bouchez, Oliver Brandt, François Deppierraz, Chad Walstrom, Tim Mattison,-Jakub Antoni Tyszko, Casa do Boneco, Florian Tham, martin f. krafft,+Jakub Antoni Tyszko, Casa do Boneco, Florian Tham, and 30 anonymous bitcoin users  With an especial thanks to the WikiMedia foundation,
doc/tips/using_the_web_as_a_special_remote.mdwn view
@@ -104,6 +104,18 @@ More details about youtube feeds at <http://googlesystem.blogspot.com/2008/01/youtube-feeds.html> -- `git-annex importfeed` should handle all of them. +## bittorrent++The [[bittorrent_special_remote|special_remotes/bittorrent]] lets git-annex+also download the content of torrent files, and magnet links to torrents.++You can simply pass the url to a torrent to `git annex addurl`+the same as any other url.++You have to have [aria2](http://aria2.sourceforge.net/) +and bittornado (or the original bittorrent) installed for this+to work.+ ## podcasts  This is done using `git annex importfeed`. See [[downloading podcasts]].
doc/todo/Bittorrent-like_features.mdwn view
@@ -45,3 +45,5 @@ This way, a torrent would just become another source for a specific file. When we `get` the file, it fires up `$YOUR_FAVORITE_TORRENT_CLIENT` to download the file.  That way we avoid the implementation complexity of shoving a complete bittorrent client within the assistant. The `get` operation would block until the torrent is downloaded, i guess... --[[anarcat]]++> This is now [[implemented|special_remotes/bittorrent/]]. Including magnet link support, and multi-file torrent support. Leaving todo item open for the blue-sky stuff at top. --[[Joey]]
+ doc/todo/extensible_addurl.mdwn view
@@ -0,0 +1,88 @@+`git annex addurl` supports regular urls, as well as detecting videos that+quvi can download. We'd like to extend this to support extensible uri+handling. ++Use cases range from torrent download support, to pulling data+from scientific data repositories that use their own APIs.++The basic idea is to have external special remotes (or perhaps built-in+ones in some cases), which addurl can use to download an object, referred+to by some uri-like thing. The uri starts with "$downloader:" to indicate+that it's not a regular url and so is not handled by the web special+remote.++	git annex addurl torrent:$foo+	git annex addurl CERN:$bar++Problem: This requires mapping from the name of the downloader, which is+probably the same as the git-annex-remote-$downloader program implementing+the special remote protocol (but not always), to the UUID of a remote.+That's assuming we want location tracking to be able to know that a file is+both available from CERN and from a torrent, for example.++Solution: Add a new method to remotes:++	claimUrl :: Maybe (URLString -> Annex Bool)++Remotes that implement this method (including special remotes) will+be queried when such an uri is added, to see which claims it.++Once the remote is known, addurl --file will record that the Key is present+on that remote, and record the uri in the url log.++----++What about using addurl to add a new file? In this mode, the Key is not yet+known. addurl currently handles this by generating a dummy Key for the url+(hitting the url to get its size), and running a Transfer using the dummy+key that downloads from the web. Once the download is done, the dummy Key+is upgraded to the final Key. ++Something similar could be done for other remotes, but the url log for the+dummy key would need to have the url added to it, for the remote to know+what to download, and then that could be removed after the download. Which+causes ugly churn in git, and would leave a mess if interrupted.++One option is to add another new method to remotes:++	downloadUrl :: Maybe (URLString -> Annex FilePath)++Or, the url log could have support added for recording temporary key+urls in memory. (done)++Another problem is that the size of the Key isn't known. addurl+could always operate in relaxed mode, where it generates a size-less Key.+Or, yet another method could be added: (done)++	sizeUrl :: URLString -> Annex (Maybe Integer)++----++Retrieval of the Key works more or less as usual. The only+difference being that remotes that support this interface can look+at the url log to find the one with the right "$downloader:" prefix,+and so know where to download from. (Much as the web special remote already+does.)++Prerequisite: Expand the external special remote interface to support+accessing the url log. (done)++----++It would also be nice to be able to easily configure a regexp that normal+urls, if they match, are made to use a particular downloader. So, for+torrents, this would make matching urls have torrent: prefixed to them.++	git config annex.downloader.torrent.regexp '(^magnet:|\.torrent$)'++It might also be useful to allow bypassing the complexity of the external+special remote interface, and let a downloader be specified simply by:++	git config annex.downloader.torrent.command 'aria2c %url $file'++This could be implemented in either the web special remote or even in an+external special remote.++Some other discussion at <https://github.com/datalad/datalad/issues/10>++> [[done]]! --[[Joey]] 
+ doc/todo/inject_on_import.mdwn view
@@ -0,0 +1,21 @@+Would it be possible to add an `--inject` option to import?++Say, for example, I have an annex on computer A which has a subset of files and a directory of files which are potentional duplicates of files in the annex.++I would like to do something like this:++    mkdir ~/annex/import+    cd ~/annex/import+    git annex import --deduplicate --inject ~/directory/of/files++This would do the same as `--deduplicate`, except if the file is not present in the annex, it would be injected. For example:++Annex knows about A and B, A is present but B is not.+$DIR contains A, B and C.++A would be deleted from $DIR due to `--deduplicate`.+B would be injected into the repo (making it present) due to `--inject`, then deleted from $DIR.+C would be added to the annex, resulting in this++    $ ls ~/annex/import+    C
+ doc/todo/parallel_get.mdwn view
@@ -0,0 +1,73 @@+Wish: `git annex get [files] -jN` should run up to N downloads of files+concurrently.++This can already be done by just starting up N separate git-annex+processes all trying to get the same files. They'll coordinate themselves+to avoid downloading the same file twice.++But, the output of concurrent git annex get's in a single teminal is a+mess.++It would be nice to have something similar to docker's output when fetching+layers of an image. Something like:++	get foo1 ok+	get foo2 ok+	get foo3 -> 5% 100 KiB/s+	get foo4 -> 3% 90 KiB/s+	get foo5 -> 20% 1 MiB/s++Where the bottom N lines are progress displays for the downloads that are+currently in progress. When a download finishes, it can scroll up the+screen with "ok".++	get foo1 ok+	get foo2 ok+	get foo5 ok+	get foo3 -> 5% 100 KiB/s+	get foo4 -> 3% 90 KiB/s+	get foo6 -> 0% 110 Kib/S++This display could perhaps be generalized for other concurrent actions.+For example, drop:++	drop foo1 ok+	drop foo2 failed+	  Not enough copies ...+	drop foo3 -> (checking r1...)+	drop foo4 -> (checking r2...)++But, do get first.++Pain points: ++1. Currently, git-annex lets tools like rsync and wget display their own+   progress. This makes sense for the single-file at a time get, because+   rsync can display better output than just a percentage. (This is especially+   the case with aria2c for torrents, which displays seeder/leecher info in+   addition to percentage.)++   But in multi-get mode, the progress display would be simplified. git-annex+   can already get percent done information, either as reported by individiual+   backends, or by falling back to polling the file as it's downloaded.++2. The mechanics of updating the screen for a multi-line progress output+   require some terminal handling code. Using eg, curses, in a mode that+   doesn't take over the whole screen display, but just moves the cursor+   up to the line for the progress that needs updating and redraws that+   line. Doing this portably is probably going to be a pain, especially+   I have no idea if it can be done on Windows.++   An alternative would be a display more like apt uses for concurrent+   downloads, all on one line:++	get foo1 ok+	get foo2 ok+	get [foo3 -> 5% 100 KiB/s] [foo4 -> 3% 90 KiB/s] [foo5 -> 20% 1 MiB/s]++   The problem with that is it has to avoid scrolling off the right+   side, so it probably has to truncate the line. Since filenames+   are often longer than "fooN", it probably has to elipsise the filename.+   This approach is just not as flexible or nice in general.++See also: [[parallel_possibilities]]
git-annex.1 view
@@ -208,9 +208,12 @@ alternate locations from which the file can be downloaded. In this mode, addurl can be used both to add new files, or to add urls to existing files. .IP-When quvi is installed, urls are automatically tested to see if they+When \fBquvi\fP is installed, urls are automatically tested to see if they point to a video hosting site, and the video is downloaded instead. .IP+Urls to torrent files (including magnet links) will cause the content of+the torrent to be downloaded, using \fBaria2c\fP.+.IP .IP "\fBrmurl file url\fP" Record that the file is no longer available at the url. .IP@@ -1552,6 +1555,9 @@ .IP "\fBannex.quvi\-options\fP" Options to pass to quvi when using it to find the url to download for a video.+.IP+.IP "\fBannex.aria\-torrent\-options\fP"+Options to pass to aria2c when using it to download a torrent. .IP .IP "\fBannex.http\-headers\fP" HTTP headers to send when downloading from the web. Multiple lines of
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 5.20141203+Version: 5.20141219 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess <joey@kitenet.net>@@ -93,6 +93,9 @@ Flag DesktopNotify   Description: Enable desktop environment notifications +Flag TorrentParser+  Description: Use haskell torrent library to parse torrent files+ Flag EKG   Description: Enable use of EKG to monitor git-annex as it runs (at http://localhost:4242/)   Default: False@@ -151,7 +154,7 @@     CPP-Options: -DWITH_CRYPTOHASH    if flag(S3)-    Build-Depends: conduit, resourcet, conduit-extra, aws (>= 0.9.2)+    Build-Depends: conduit, resourcet, conduit-extra, aws (>= 0.9.2), http-client     CPP-Options: -DWITH_S3    if flag(WebDAV)@@ -233,6 +236,10 @@   if flag(Tahoe)     Build-Depends: aeson     CPP-Options: -DWITH_TAHOE++  if flag(TorrentParser)+    Build-Depends: torrent (>= 10000.0.0)+    CPP-Options: -DWITH_TORRENTPARSER    if flag(EKG)     Build-Depends: ekg
standalone/android/buildchroot-inchroot view
@@ -16,7 +16,7 @@ apt-get -y install happy alex apt-get -y install llvm-3.4 apt-get -y install ca-certificates curl file m4 autoconf zlib1g-dev-apt-get -y install libgnutls-dev libxml2-dev libgsasl7-dev pkg-config c2hs+apt-get -y install libgnutls28-dev libxml2-dev libgsasl7-dev pkg-config c2hs apt-get -y install ant default-jdk rsync wget gnupg lsof apt-get -y install gettext unzip python apt-get -y install locales automake
standalone/android/install-haskell-packages view
@@ -32,9 +32,9 @@ 		ver="$(grep " $pkg " ../cabal.config | cut -d= -f 3 | sed 's/,$//')" 	fi 	if [ -z "$ver" ]; then-		cabal unpack $pkg+		cabal unpack --pristine $pkg 	else-		cabal unpack $pkg-$ver+		cabal unpack --pristine $pkg-$ver 	fi 	cd $pkg* 	git init
+ standalone/linux/cabal.config view
@@ -0,0 +1,208 @@+constraints: Crypto ==4.2.5.1,+             DAV ==1.0.3,+             HTTP ==4000.2.17,+             HUnit ==1.2.5.2,+             IfElse ==0.85,+             MissingH ==1.2.1.0,+             MonadRandom ==0.1.13,+             QuickCheck ==2.7.6,+             SHA ==1.6.1,+             SafeSemaphore ==0.10.1,+             aeson ==0.7.0.6,+             ansi-terminal ==0.6.1.1,+             ansi-wl-pprint ==0.6.7.1,+             appar ==0.1.4,+             asn1-encoding ==0.8.1.3,+             asn1-parse ==0.8.1,+             asn1-types ==0.2.3,+             async ==2.0.1.5,+             attoparsec ==0.11.3.4,+             attoparsec-conduit ==1.1.0,+             authenticate ==1.3.2.10,+             base-unicode-symbols ==0.2.2.4,+             base16-bytestring ==0.1.1.6,+             base64-bytestring ==1.0.0.1,+             bifunctors ==4.1.1.1,+             bloomfilter ==2.0.0.0,+             byteable ==0.1.1,+             byteorder ==1.0.4,+             case-insensitive ==1.2.0.1,+             cereal ==0.4.0.1,+             cipher-aes ==0.2.8,+             cipher-des ==0.0.6,+             cipher-rc4 ==0.1.4,+             clientsession ==0.9.0.3,+             comonad ==4.2,+             conduit ==1.1.6,+             conduit-extra ==1.1.3,+             connection ==0.2.3,+             contravariant ==0.6.1.1,+             cookie ==0.4.1.2,+             cprng-aes ==0.5.2,+             crypto-api ==0.13.2,+             crypto-cipher-types ==0.0.9,+             crypto-numbers ==0.2.3,+             crypto-pubkey ==0.2.4,+             crypto-pubkey-types ==0.4.2.2,+             crypto-random ==0.0.7,+             cryptohash ==0.11.6,+             cryptohash-conduit ==0.1.1,+             css-text ==0.1.2.1,+             shakespeare-text ==1.0.2,+             data-default ==0.5.3,+             data-default-class ==0.0.1,+             data-default-instances-base ==0.0.1,+             data-default-instances-containers ==0.0.1,+             data-default-instances-dlist ==0.0.1,+             data-default-instances-old-locale ==0.0.1,+             dataenc ==0.14.0.7,+             dbus ==0.10.8,+             distributive ==0.4.4,+             dlist ==0.7.0.1,+             dns ==1.3.0,+             edit-distance ==0.2.1.2,+             either ==4.3,+             email-validate ==1.0.0,+             entropy ==0.2.1,+             errors ==1.4.7,+             exceptions ==0.6.1,+             failure ==0.2.0.3,+             fast-logger ==2.1.5,+             fdo-notify ==0.3.1,+             feed ==0.3.9.2,+             file-embed ==0.0.6,+             fingertree ==0.1.0.0,+             free ==4.9,+             gnuidn ==0.2,+             gnutls ==0.1.4,+             gsasl ==0.3.5,+             hS3 ==0.5.7,+             hamlet ==1.1.9.2,+             hashable ==1.2.1.0,+             hinotify ==0.3.5,+             hjsmin ==0.1.4.7,+             hslogger ==1.2.1,+             http-client ==0.3.8.2,+             http-client-tls ==0.2.2,+             http-conduit ==2.1.2.3,+             http-date ==0.0.2,+             http-types ==0.8.5,+             hxt ==9.3.1.4,+             hxt-charproperties ==9.1.1.1,+             hxt-regex-xmlschema ==9.0.4,+             hxt-unicode ==9.0.2.2,+             idna ==0.2,+             iproute ==1.2.11,+             json ==0.5,+             keys ==3.10.1,+             language-javascript ==0.5.13,+             lens ==4.4.0.2,+             libxml-sax ==0.7.5,+             mime-mail ==0.4.1.2,+             mime-types ==0.1.0.4,+             mmorph ==1.0.3,+             monad-control ==0.3.2.2,+             monad-logger ==0.3.6.1,+             monad-loops ==0.4.2.1,+             monads-tf ==0.1.0.2,+             mtl ==2.1.2,+             nats ==0.1.2,+             network ==2.4.1.2,+             network-conduit ==1.1.0,+             network-info ==0.2.0.5,+             network-multicast ==0.0.10,+             network-protocol-xmpp ==0.4.6,+             network-uri ==2.6.0.1,+             optparse-applicative ==0.10.0,+             parallel ==3.2.0.4,+             path-pieces ==0.1.4,+             pem ==0.2.2,+             persistent ==1.3.3,+             persistent-template ==1.3.2.2,+             pointed ==4.0,+             prelude-extras ==0.4,+             profunctors ==4.0.4,+             publicsuffixlist ==0.1,+             punycode ==2.0,+             random ==1.0.1.1,+             ranges ==0.2.4,+             reducers ==3.10.2.1,+             reflection ==1.2.0.1,+             regex-base ==0.93.2,+             regex-compat ==0.95.1,+             regex-posix ==0.95.2,+             regex-tdfa ==1.2.0,+             resource-pool ==0.2.1.1,+             resourcet ==1.1.2.3,+             safe ==0.3.8,+             securemem ==0.1.3,+             semigroupoids ==4.2,+             semigroups ==0.15.3,+             shakespeare ==1.2.1.1,+             shakespeare-css ==1.0.7.4,+             shakespeare-i18n ==1.0.0.5,+             shakespeare-js ==1.2.0.4,+             silently ==1.2.4.1,+             simple-sendfile ==0.2.14,+             skein ==1.0.9,+             socks ==0.5.4,+             split ==0.2.2,+             stm ==2.4.2,+             stm-chans ==3.0.0.2,+             streaming-commons ==0.1.4.1,+             stringprep ==0.1.5,+             stringsearch ==0.3.6.5,+             syb ==0.4.0,+             system-fileio ==0.3.14,+             system-filepath ==0.4.12,+             tagged ==0.7.2,+             tagsoup ==0.13.1,+             tagstream-conduit ==0.5.5.1,+             tasty ==0.10,+             tasty-hunit ==0.9,+             tasty-quickcheck ==0.8.1,+             tasty-rerun ==1.1.3,+             text ==1.1.1.0,+             text-icu ==0.6.3.7,+             tf-random ==0.5,+             tls ==1.2.9,+             transformers ==0.3.0.0,+             transformers-base ==0.4.1,+             transformers-compat ==0.3.3.3,+             unbounded-delays ==0.1.0.8,+             unix-compat ==0.4.1.3,+             unix-time ==0.2.2,+             unordered-containers ==0.2.5.0,+             utf8-string ==0.3.7,+             uuid ==1.3.3,+             vault ==0.3.0.3,+             vector ==0.10.0.1,+             void ==0.6.1,+             wai ==3.0.1.1,+             wai-app-static ==3.0.0.1,+             wai-extra ==3.0.1.2,+             wai-logger ==2.1.1,+             warp ==3.0.0.5,+             warp-tls ==3.0.0,+             word8 ==0.1.1,+             x509 ==1.4.11,+             x509-store ==1.4.4,+             x509-system ==1.4.5,+             x509-validation ==1.5.0,+             xml ==1.3.13,+             xml-conduit ==1.2.1,+             xml-hamlet ==0.4.0.9,+             xml-types ==0.3.4,+             xss-sanitize ==0.3.5.2,+             yaml ==0.8.9.3,+             yesod ==1.2.6.1,+             yesod-auth ==1.3.4.6,+             yesod-core ==1.2.20.1,+             yesod-default ==1.2.0,+             yesod-form ==1.3.16,+             yesod-persistent ==1.2.3.1,+             yesod-routes ==1.2.0.7,+             yesod-static ==1.2.4,+             zlib ==0.5.4.1,+             bytestring ==0.10.4.0,+             scientific ==0.3.3.1
standalone/linux/install-haskell-packages view
@@ -3,13 +3,10 @@ # to all the necessary haskell packages being installed, with the # necessary patches to work on architectures that lack template haskell. #-# Note that the newest version of packages are installed. -# It attempts to reuse patches for older versions, but -# new versions of packages often break cross-compilation by adding TH, -# etc-#-# Future work: Convert to using the method used here:-# https://github.com/kaoskorobase/ghc-ios-cabal-scripts/+# The cabal.config is used to pin the haskell packages to the last+# versions that have been gotten working. To update, delete the+# cabal.config, run this script with an empty cabal and fix up the broken+# patches, and then use cabal freeze to generate a new cabal.config.  set -e @@ -26,14 +23,22 @@  patched () { 	pkg=$1-	shift 1-	cabal unpack $pkg$1+	ver=$2+        if [ -z "$ver" ]; then+                ver="$(grep " $pkg " ../cabal.config | cut -d= -f 3 | sed 's/,$//')"+        fi+        if [ -z "$ver" ]; then+                cabal unpack --pristine $pkg+        else+                cabal unpack --pristine $pkg-$ver+        fi 	cd $pkg* 	git init 	git config user.name dummy 	git config user.email dummy@example.com 	git add . 	git commit -m "pre-patched state of $pkg"+	ln -sf ../../cabal.config 	for patch in ../../haskell-patches/${pkg}_* ../../../no-th/haskell-patches/${pkg}_*; do 		if [ -e "$patch" ]; then 			echo trying $patch@@ -45,16 +50,19 @@ 		fi 	done 	cabalinstall-	rm -rf $pkg*+	rm -f cabal.config 	cd ..+	rm -rf $pkg* }  installgitannexdeps () { 	pushd ../..+	ln -sf standalone/linux/cabal.config 	echo "cabal install QuickCheck -f-templateHaskell"-	cabal install QuickCheck -f-templateHaskell+	cabal install -j1 QuickCheck -f-templateHaskell 	echo cabal install --only-dependencies "$@"-	cabal install --only-dependencies "$@"+	cabal install -j1 --only-dependencies "$@"+	rm -f cabal.config 	popd } @@ -71,14 +79,12 @@ 	patched yesod-routes 	patched monad-logger 	patched skein+	patched shakespeare-js+	patched hamlet 	patched yesod-core 	patched persistent 	patched persistent-template-	# Newer versions of file-embed cause ghc -ddump-splices-	# to output invalid character codes.-	# Note that the system generating the splices should also-	# use this version of file-embed.-	patched file-embed -0.0.6+	patched file-embed 	patched process-conduit 	patched yesod-static 	patched yesod-persistent