When possible, build with the haskell torrent library for parsing torrent files.

This commit is contained in:
Joey Hess 2014-12-18 14:22:43 -04:00
parent 0e44d95964
commit ef12386924
5 changed files with 53 additions and 14 deletions

View file

@ -86,6 +86,11 @@ buildFlags = filter (not . null)
#else #else
#warning Building without CryptoHash. #warning Building without CryptoHash.
#endif #endif
#ifdef WITH_TORRENTParser
, "TorrentParser"
#else
#warning Building without haskell torrent library; will instead use btshowmetainfo to parse torrent files.
#endif
#ifdef WITH_EKG #ifdef WITH_EKG
, "EKG" , "EKG"
#endif #endif

View file

@ -5,6 +5,8 @@
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
{-# LANGUAGE CPP #-}
module Remote.BitTorrent (remote) where module Remote.BitTorrent (remote) where
import Common.Annex import Common.Annex
@ -14,8 +16,6 @@ import qualified Git
import qualified Git.Construct import qualified Git.Construct
import Config.Cost import Config.Cost
import Logs.Web import Logs.Web
import Logs.Trust.Basic
import Types.TrustLevel
import Types.UrlContents import Types.UrlContents
import Types.CleanupActions import Types.CleanupActions
import Types.Key import Types.Key
@ -26,9 +26,13 @@ import Annex.Perms
import Annex.UUID import Annex.UUID
import qualified Annex.Url as Url import qualified Annex.Url as Url
import qualified Data.Map as M
import Network.URI import Network.URI
#ifdef WITH_TORRENTPARSER
import Data.Torrent
import qualified Data.ByteString.Lazy as B
#endif
remote :: RemoteType remote :: RemoteType
remote = RemoteType { remote = RemoteType {
typename = "bittorrent", typename = "bittorrent",
@ -106,7 +110,7 @@ dropKey k = do
- implemented, it tells us nothing about the later state of the torrent. - implemented, it tells us nothing about the later state of the torrent.
-} -}
checkKey :: Key -> Annex Bool checkKey :: Key -> Annex Bool
checkKey key = error "cannot reliably check torrent status" checkKey = error "cannot reliably check torrent status"
getBitTorrentUrls :: Key -> Annex [URLString] getBitTorrentUrls :: Key -> Annex [URLString]
getBitTorrentUrls key = filter supported <$> getUrls key getBitTorrentUrls key = filter supported <$> getUrls key
@ -266,9 +270,16 @@ downloadTorrentContent k u dest filenum p = do
checkDependencies :: Annex () checkDependencies :: Annex ()
checkDependencies = do checkDependencies = do
missing <- liftIO $ filterM (not <$$> inPath) ["aria2c", "btshowmetainfo"] missing <- liftIO $ filterM (not <$$> inPath) deps
unless (null missing) $ unless (null missing) $
error $ "need to install additional software in order to download from bittorrent: " ++ unwords 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 :: [CommandParam] -> Annex [CommandParam]
ariaParams ps = do ariaParams ps = do
@ -299,9 +310,8 @@ parseAriaProgress totalsize = go [] . reverse . split ['\r']
frompercent p = toBytesProcessed $ totalsize * p `div` 100 frompercent p = toBytesProcessed $ totalsize * p `div` 100
{- It would be better to use http://hackage.haskell.org/package/torrent, {- Used only if the haskell torrent library is not available. -}
- but that package won't currently build. I sent a patch fixing it #ifndef WITH_TORRENTPARSER
- to its author and plan to upload in Jan 2015 if I don't hear back. -}
btshowmetainfo :: FilePath -> String -> IO [String] btshowmetainfo :: FilePath -> String -> IO [String]
btshowmetainfo torrent field = btshowmetainfo torrent field =
findfield [] . lines <$> readProcess "btshowmetainfo" [torrent] findfield [] . lines <$> readProcess "btshowmetainfo" [torrent]
@ -319,12 +329,25 @@ btshowmetainfo torrent field =
multiline c [] = findfield c [] multiline c [] = findfield c []
fieldkey = field ++ take (14 - length field) (repeat '.') ++ ": " fieldkey = field ++ take (14 - length field) (repeat '.') ++ ": "
#endif
{- Examines the torrent file and gets the list of files in it, {- Examines the torrent file and gets the list of files in it,
- and their sizes. - and their sizes.
-} -}
torrentFileSizes :: FilePath -> IO [(FilePath, Integer)] torrentFileSizes :: FilePath -> IO [(FilePath, Integer)]
torrentFileSizes torrent = do 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" files <- getfield "files"
if null files if null files
then do then do
@ -334,13 +357,12 @@ torrentFileSizes torrent = do
((fn:[]), (Just sz:[])) -> return [(scrub fn, sz)] ((fn:[]), (Just sz:[])) -> return [(scrub fn, sz)]
_ -> parsefailed (show (fnl, szl)) _ -> parsefailed (show (fnl, szl))
else do else do
v <- btshowmetainfo torrent "directory name" v <- getfield "directory name"
case v of case v of
(d:[]) -> return $ map (splitsize d) files (d:[]) -> return $ map (splitsize d) files
_ -> parsefailed (show v) _ -> parsefailed (show v)
where where
getfield = btshowmetainfo torrent getfield = btshowmetainfo torrent
parsefailed s = error $ "failed to parse btshowmetainfo output for torrent file: " ++ show s parsefailed s = error $ "failed to parse btshowmetainfo output for torrent file: " ++ show s
-- btshowmetainfo outputs a list of "filename (size)" -- btshowmetainfo outputs a list of "filename (size)"
@ -351,7 +373,7 @@ torrentFileSizes torrent = do
reverse l reverse l
fn = reverse $ drop 2 $ fn = reverse $ drop 2 $
dropWhile (/= '(') $ dropWhile (== ')') $ reverse l dropWhile (/= '(') $ dropWhile (== ')') $ reverse l
#endif
-- a malicious torrent file might try to do directory traversal -- a malicious torrent file might try to do directory traversal
scrub f = if isAbsolute f || any (== "..") (splitPath f) scrub f = if isAbsolute f || any (== "..") (splitPath f)
then error "found unsafe filename in torrent!" then error "found unsafe filename in torrent!"

5
debian/changelog vendored
View file

@ -13,7 +13,10 @@ git-annex (5.20141204) UNRELEASED; urgency=medium
* addurl behavior change: When downloading an url ending in .torrent, * addurl behavior change: When downloading an url ending in .torrent,
it will download files from bittorrent, instead of the old behavior it will download files from bittorrent, instead of the old behavior
of adding the torrent file to the repository. of adding the torrent file to the repository.
* Added Recommends on aria2 and bittornado | bittorrent. * 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.
-- Joey Hess <id@joeyh.name> Fri, 05 Dec 2014 13:42:08 -0400 -- Joey Hess <id@joeyh.name> Fri, 05 Dec 2014 13:42:08 -0400

View file

@ -8,8 +8,10 @@ torrent and add it to the git annex repository.
See [[tips/using_the_web_as_a_special_remote]] for usage examples. See [[tips/using_the_web_as_a_special_remote]] for usage examples.
git-annex uses [aria2](http://aria2.sourceforge.net/) to download torrents. 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. 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 ## notes

View file

@ -93,6 +93,9 @@ Flag CryptoHash
Flag DesktopNotify Flag DesktopNotify
Description: Enable desktop environment notifications Description: Enable desktop environment notifications
Flag TorrentParser
Description: Use haskell torrent library to parse torrent files
Flag EKG Flag EKG
Description: Enable use of EKG to monitor git-annex as it runs (at http://localhost:4242/) Description: Enable use of EKG to monitor git-annex as it runs (at http://localhost:4242/)
Default: False Default: False
@ -234,6 +237,10 @@ Executable git-annex
Build-Depends: aeson Build-Depends: aeson
CPP-Options: -DWITH_TAHOE CPP-Options: -DWITH_TAHOE
if flag(TorrentParser)
Build-Depends: torrent (>= 10000.0.0)
CPP-Options: -DWITH_TORRENTPARSER
if flag(EKG) if flag(EKG)
Build-Depends: ekg Build-Depends: ekg
GHC-Options: -with-rtsopts=-T GHC-Options: -with-rtsopts=-T