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 and bittornado | bittorrent.

This commit was sponsored by Asbjørn Sloth Tønnesen.

12 files changed, 404 insertions, 7 deletions

diff --git a/Logs/Trust.hs b/Logs/Trust.hs
index b880f44de..41ce5a551 100644
--- a/Logs/Trust.hs
+++ b/Logs/Trust.hs
@@ -15,7 +15,6 @@ module Logs.Trust (
 	trustExclude,
 	lookupTrust,
 	trustMapLoad,
-	trustMapRaw,
 ) where
 
 import qualified Data.Map as M
@@ -23,7 +22,6 @@ import Data.Default
 
 import Common.Annex
 import Types.TrustLevel
-import qualified Annex.Branch
 import qualified Annex
 import Logs
 import Remote.List
@@ -77,8 +75,3 @@ trustMapLoad = do
 	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
diff --git a/Logs/Trust/Basic.hs b/Logs/Trust/Basic.hs
index 646e2e037..c356be28f 100644
--- a/Logs/Trust/Basic.hs
+++ b/Logs/Trust/Basic.hs
@@ -8,6 +8,7 @@
 module Logs.Trust.Basic (
 	module X,
 	trustSet,
+	trustMapRaw,
 ) where
 
 import Data.Time.Clock.POSIX
@@ -30,3 +31,8 @@ trustSet uuid@(UUID _) level = do
 				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
diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs
new file mode 100644
index 000000000..aaedcd0ef
--- /dev/null
+++ b/Remote/BitTorrent.hs
@@ -0,0 +1,342 @@
+{- BitTorrent remote.
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+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 Logs.Trust.Basic
+import Types.TrustLevel
+import Types.UrlContents
+import Types.CleanupActions
+import Utility.Metered
+import Utility.Tmp
+import Backend.URL
+import Annex.Perms
+import qualified Annex.Url as Url
+
+import qualified Data.Map as M
+import Network.URI
+
+-- Dummy uuid for bittorrent. Do not alter.
+bitTorrentUUID :: UUID
+bitTorrentUUID = UUID "00000000-0000-0000-0000-000000000002"
+
+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 = do
+	defaultUnTrusted
+	get . map (torrentUrlNum . fst . getDownloader) =<< getBitTorrentUrls key
+  where
+	get [] = do
+		warning "no known torrent url"
+		return False
+	get urls = do
+		showOutput -- make way for download progress bar
+		untilTrue urls $ \(u, filenum) -> do
+			registerTorrentCleanup u
+			checkDependencies
+			unlessM (downloadTorrentFile u) $
+				error "could not download torrent file"
+			downloadTorrentContent u dest filenum p
+
+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
+
+{- This is a very poor check, but checking if a torrent has enough seeders
+ - with all the pieces etc is quite hard.. and even if implemented, it
+ - tells us nothing about the later state of the torrent.
+ -
+ - This is why this remote needs to default to untrusted!
+ -}
+checkKey :: Key -> Annex Bool
+checkKey key = not . null <$> getBitTorrentUrls key
+
+-- Makes this remote UnTrusted, unless it already has a trust set.
+defaultUnTrusted :: Annex ()
+defaultUnTrusted = whenM (isNothing . M.lookup bitTorrentUUID <$> trustMapRaw) $
+	trustSet bitTorrentUUID UnTrusted
+
+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 =
+	let (n, ru) = separate (== '#') (reverse u)
+	in (reverse ru, fromMaybe 1 $ readish $ reverse n)
+
+{- 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 "-d"
+		, File metadir
+		]
+
+downloadTorrentContent :: URLString -> FilePath -> Int -> MeterUpdate -> Annex Bool
+downloadTorrentContent 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
+	-- TODO parse aria's output and update progress meter
+	download torrent tmpdir = runAria
+		[ Param $ "--select-file=" ++ show filenum
+		, File torrent
+		, Param "-d"
+		, File tmpdir
+		, Param "--seed-time=0"
+		]
+	
+	{- 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)
+			else error "Number of files in torrent seems to have changed."
+
+checkDependencies :: Annex ()
+checkDependencies = do
+	missing <- liftIO $ filterM (not <$$> inPath) ["aria2c", "btshowmetainfo"]
+	unless (null missing) $
+		error $ "need to install additional software in order to download from bittorrent: " ++ unwords missing
+
+runAria :: [CommandParam] -> Annex Bool
+runAria ps = do
+	opts <- map Param . annexAriaTorrentOptions <$> Annex.getGitConfig
+	liftIO $ boolSystem "aria2c" (ps ++ opts)
+
+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 '.') ++ ": "
+
+{- Examines the torrent file and gets the list of files in it,
+ - and their sizes.
+ -}
+torrentFileSizes :: FilePath -> IO [(FilePath, Integer)]
+torrentFileSizes torrent = do
+	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 <- btshowmetainfo torrent "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
+
+	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 fn)
diff --git a/Remote/List.hs b/Remote/List.hs
index 1ec2c32b4..a4d18c7c8 100644
--- a/Remote/List.hs
+++ b/Remote/List.hs
@@ -30,6 +30,7 @@ import qualified Remote.Bup
 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 @@ remoteTypes =
 	, Remote.Directory.remote
 	, Remote.Rsync.remote
 	, Remote.Web.remote
+	, Remote.BitTorrent.remote
 #ifdef WITH_WEBDAV
 	, Remote.WebDAV.remote
 #endif
diff --git a/Types/CleanupActions.hs b/Types/CleanupActions.hs
index 498d5b4d7..fafa2ee00 100644
--- a/Types/CleanupActions.hs
+++ b/Types/CleanupActions.hs
@@ -9,9 +9,12 @@ module Types.CleanupActions where
 
 import Types.UUID
 
+import Utility.Url
+
 data CleanupAction
 	= RemoteCleanup UUID
 	| StopHook UUID
 	| FsckCleanup
 	| SshCachingCleanup
+	| TorrentCleanup URLString
 	deriving (Eq, Ord)
diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs
index deae1df37..3d89b0433 100644
--- a/Types/GitConfig.hs
+++ b/Types/GitConfig.hs
@@ -42,6 +42,7 @@ data GitConfig = GitConfig
 	, annexDebug :: Bool
 	, annexWebOptions :: [String]
 	, annexQuviOptions :: [String]
+	, annexAriaTorrentOptions :: [String]
 	, annexWebDownloadCommand :: Maybe String
 	, annexCrippledFileSystem :: Bool
 	, annexLargeFiles :: Maybe String
@@ -77,6 +78,7 @@ extractGitConfig r = GitConfig
 	, 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")
diff --git a/debian/changelog b/debian/changelog
index 0b21cb4af..f1b8d32e6 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -9,6 +9,11 @@ git-annex (5.20141204) UNRELEASED; urgency=medium
     *.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 and bittornado | bittorrent.
 
  -- Joey Hess <id@joeyh.name>  Fri, 05 Dec 2014 13:42:08 -0400
 
diff --git a/debian/control b/debian/control
index aeb95bf3e..42720f732 100644
--- a/debian/control
+++ b/debian/control
@@ -99,6 +99,8 @@ Recommends:
 	quvi,
 	git-remote-gcrypt (>= 0.20130908-6),
 	nocache,
+	aria2
+	bittornado | bittorrent,
 Suggests:
 	graphviz,
 	bup,
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 7ccb36b5d..8a2633e15 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -1728,6 +1728,10 @@ Here are all the supported configuration settings.
   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`
 
   HTTP headers to send when downloading from the web. Multiple lines of
diff --git a/doc/special_remotes.mdwn b/doc/special_remotes.mdwn
index dd82d23f1..e6c1e6da5 100644
--- a/doc/special_remotes.mdwn
+++ b/doc/special_remotes.mdwn
@@ -17,6 +17,7 @@ They cannot be used by other git commands though.
 * [[webdav]]
 * [[tahoe]]
 * [[web]]
+* [[bittorrent]]
 * [[xmpp]]
 * [[hook]]
 
diff --git a/doc/special_remotes/bittorrent.mdwn b/doc/special_remotes/bittorrent.mdwn
new file mode 100644
index 000000000..c5ef91aca
--- /dev/null
+++ b/doc/special_remotes/bittorrent.mdwn
@@ -0,0 +1,25 @@
+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.
+It also 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.
+
+Torrent swarms tend to come and go, so git-annex defaults to *not*
+trusting the bittorrent special remote.
+
+Multi-file torrents are supported; to handle them, `git annex addurl`
+will add a directory containing all the files from the torrent. To
+specify a single file from a multi-file torrent, append "#n" to its url;
+"#1" is the first file, "#2" is the second, and so on.
diff --git a/doc/tips/using_the_web_as_a_special_remote.mdwn b/doc/tips/using_the_web_as_a_special_remote.mdwn
index 62ef58b69..087d2e24b 100644
--- a/doc/tips/using_the_web_as_a_special_remote.mdwn
+++ b/doc/tips/using_the_web_as_a_special_remote.mdwn
@@ -104,6 +104,18 @@ feed is "http://gdata.youtube.com/feeds/api/playlists/PL4F80C7D2DC8D9B6C"
 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]].