diff options
35 files changed, 780 insertions, 288 deletions
diff --git a/Annex/UUID.hs b/Annex/UUID.hs index 5ed887689..ec642a0fe 100644 --- a/Annex/UUID.hs +++ b/Annex/UUID.hs @@ -23,6 +23,8 @@ module Annex.UUID ( storeUUID, storeUUIDIn, setUUID, + webUUID, + bitTorrentUUID, ) where import Common.Annex @@ -98,3 +100,11 @@ setUUID :: Git.Repo -> UUID -> IO Git.Repo 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" diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs index daced8d21..fc2394e62 100644 --- a/Assistant/Threads/TransferScanner.hs +++ b/Assistant/Threads/TransferScanner.hs @@ -19,7 +19,6 @@ import Assistant.Types.UrlRenderer 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 @@ failedTransferScan r = do - 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 @@ expensiveScan urlrenderer rs = unless onlyweb $ batch <~> do 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' diff --git a/Build/Configure.hs b/Build/Configure.hs index 31b7ccd25..0a0e87c3a 100644 --- a/Build/Configure.hs +++ b/Build/Configure.hs @@ -10,10 +10,13 @@ import Control.Monad 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 @@ tests = , 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" @@ -96,6 +100,18 @@ getGitVersion = do 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 <$> boolSystem "sh" [Param "-c", Param "ssh -o ControlPersist=yes -V >/dev/null 2>/dev/null"] diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index f3b4cf130..66a5c4e3d 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -22,6 +22,7 @@ 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 @@ -109,7 +110,7 @@ downloadRemoteFile r relaxed uri file sz = do -- Set temporary url for the urlkey -- so that the remote knows what url it -- should use to download it. - setTempUrl urlkey uri + setTempUrl urlkey loguri let downloader = Remote.retrieveKeyFile r urlkey (Just file) ret <- downloadWith downloader urlkey (Remote.uuid r) loguri file removeTempUrl urlkey @@ -267,7 +268,7 @@ downloadWith downloader dummykey u url file = ) where runtransfer tmp = Transfer.notifyTransfer Transfer.Download (Just file) $ - Transfer.download webUUID dummykey (Just file) Transfer.forwardRetry $ \p -> do + Transfer.download u dummykey (Just file) Transfer.forwardRetry $ \p -> do liftIO $ createDirectoryIfMissing True (parentDir tmp) downloader tmp p diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index d827d549f..c45fad961 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -30,6 +30,7 @@ import qualified Utility.Format import Utility.Tmp import Command.AddUrl (addUrlFile, downloadRemoteFile, relaxedOption) import Annex.Perms +import Annex.UUID import Backend.URL (fromUrl) #ifdef WITH_QUVI import Annex.Quvi diff --git a/Command/RmUrl.hs b/Command/RmUrl.hs index 570004266..514dcc689 100644 --- a/Command/RmUrl.hs +++ b/Command/RmUrl.hs @@ -10,6 +10,7 @@ module Command.RmUrl where import Common.Annex import Command import Logs.Web +import Annex.UUID import qualified Remote cmd :: [Command] diff --git a/Git/Version.hs b/Git/Version.hs index 5c61f859e..1c53b4bfd 100644 --- a/Git/Version.hs +++ b/Git/Version.hs @@ -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 +import Utility.DottedVersion -data GitVersion = GitVersion String Integer - deriving (Eq) - -instance Ord GitVersion where - compare (GitVersion _ x) (GitVersion _ y) = compare x y - -instance Show GitVersion where - show (GitVersion s _) = s +type GitVersion = DottedVersion installed :: IO GitVersion installed = normalize . extract <$> readProcess "git" ["--version"] @@ -24,20 +22,3 @@ installed = normalize . extract <$> readProcess "git" ["--version"] 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 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/Logs/Web.hs b/Logs/Web.hs index c3e5c3432..a728d152b 100644 --- a/Logs/Web.hs +++ b/Logs/Web.hs @@ -7,7 +7,6 @@ module Logs.Web ( URLString, - webUUID, getUrls, getUrlsWithPrefix, setUrlPresent, @@ -35,10 +34,6 @@ import qualified Git import qualified Git.LsFiles import Utility.Url --- Dummy uuid for the whole web. Do not alter. -webUUID :: UUID -webUUID = UUID "00000000-0000-0000-0000-000000000001" - {- Gets all urls that a key might be available from. -} getUrls :: Key -> Annex [URLString] getUrls key = do diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs new file mode 100644 index 000000000..4cb579f15 --- /dev/null +++ b/Remote/BitTorrent.hs @@ -0,0 +1,368 @@ +{- 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 Types.Key +import Utility.Metered +import Utility.Tmp +import Backend.URL +import Annex.Perms +import Annex.UUID +import qualified Annex.Url as Url + +import qualified Data.Map as M +import Network.URI + +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 key = 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) ["aria2c", "btshowmetainfo"] + unless (null missing) $ + error $ "need to install additional software in order to download from bittorrent: " ++ unwords missing + +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 + +{- It would be better to use http://hackage.haskell.org/package/torrent, + - but that package won't currently build. I sent a patch fixing it + - to its author and plan to upload in Jan 2015 if I don't hear back. -} +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 + + -- 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) diff --git a/Remote/Directory.hs b/Remote/Directory.hs index b798ff07c..66a3de49f 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -46,32 +46,32 @@ gen r u c gc = do (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)], - claimUrl = Nothing, - checkUrl = Nothing - } + 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 diff --git a/Remote/External.hs b/Remote/External.hs index 47220c23c..dd8e793c7 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -48,32 +48,32 @@ gen r u c gc = do (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 $ - gc { remoteAnnexExternalType = Just "!dne!" }, - getInfo = return [("externaltype", externaltype)], - claimUrl = Just (claimurl external), - checkUrl = Just (checkurl 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 $ + gc { remoteAnnexExternalType = Just "!dne!" } + , getInfo = return [("externaltype", externaltype)] + , claimUrl = Just (claimurl external) + , checkUrl = Just (checkurl external) + } where externaltype = fromMaybe (error "missing externaltype") (remoteAnnexExternalType gc) diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index 80329b9a9..f24369d52 100644 --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -46,32 +46,32 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost (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) $ - [ ("glacier vault", getVault c) ], - claimUrl = Nothing, - checkUrl = Nothing - } + 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 diff --git a/Remote/Hook.hs b/Remote/Hook.hs index d0b5f7932..5955e51c2 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -39,32 +39,32 @@ gen r u c gc = do (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)], - claimUrl = Nothing, - checkUrl = Nothing - } + 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 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/Remote/S3.hs b/Remote/S3.hs index e0d441292..f2ee8842d 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -65,37 +65,37 @@ gen r u c gc = do (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 - } + ] + , claimUrl = Nothing + , checkUrl = Nothing + } s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) s3Setup mu mcreds c = do diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs index ac7088bea..27bb12884 100644 --- a/Remote/Tahoe.hs +++ b/Remote/Tahoe.hs @@ -64,31 +64,31 @@ gen r u c gc = do 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 [], - claimUrl = Nothing, - checkUrl = Nothing - } + 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 diff --git a/Remote/Web.hs b/Remote/Web.hs index 639eb7e3b..594f90b97 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -16,6 +16,7 @@ import qualified Git.Construct 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,31 +43,31 @@ list = do 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 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 - } + 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 =<< getWebUrls key diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index 27a87a89c..ae1e4b972 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -51,32 +51,32 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost (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) $ - [("url", fromMaybe "unknown" (M.lookup "url" c))], - claimUrl = Nothing, - checkUrl = Nothing - } + 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) 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/Utility/DottedVersion.hs b/Utility/DottedVersion.hs new file mode 100644 index 000000000..14aa16da9 --- /dev/null +++ b/Utility/DottedVersion.hs @@ -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 diff --git a/Utility/Metered.hs b/Utility/Metered.hs index f27eee26d..e4f3b448a 100644 --- a/Utility/Metered.hs +++ b/Utility/Metered.hs @@ -143,3 +143,36 @@ defaultChunkSize = 32 * k - chunkOverhead 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 diff --git a/Utility/Rsync.hs b/Utility/Rsync.hs index 8dee6093c..bbe1a4236 100644 --- a/Utility/Rsync.hs +++ b/Utility/Rsync.hs @@ -60,31 +60,6 @@ rsyncParamsFixup = map fixup 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 @@ rsyncUrlIsPath s | 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 @@ rsyncUrlIsPath s - 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 diff --git a/Utility/Url.hs b/Utility/Url.hs index cb950b824..cc15c82d0 100644 --- a/Utility/Url.hs +++ b/Utility/Url.hs @@ -191,9 +191,18 @@ download' quiet url file uo = wget = go "wget" $ headerparams ++ quietopt "-q" ++ wgetparams {- Regular wget needs --clobber to continue downloading an existing - file. On Android, busybox wget is used, which does not - - support, or need that option. -} + - 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 diff --git a/debian/changelog b/debian/changelog index 39f165d6b..f1b8d32e6 100644 --- a/debian/changelog +++ b/debian/changelog @@ -7,6 +7,13 @@ git-annex (5.20141204) UNRELEASED; urgency=medium * 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 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/devblog/day_239-240__bittorrent_remote.mdwn b/doc/devblog/day_239-240__bittorrent_remote.mdwn new file mode 100644 index 000000000..a5fa164ae --- /dev/null +++ b/doc/devblog/day_239-240__bittorrent_remote.mdwn @@ -0,0 +1,11 @@ +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. 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..36fa1b879 --- /dev/null +++ b/doc/special_remotes/bittorrent.mdwn @@ -0,0 +1,20 @@ +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. + +Multi-file torrents are supported; to handle them, `git annex addurl` +will add a directory containing all the files from the torrent. diff --git a/doc/special_remotes/external/git-annex-remote-torrent b/doc/special_remotes/external/git-annex-remote-torrent index 4f99483bc..4df1f8154 100755 --- a/doc/special_remotes/external/git-annex-remote-torrent +++ b/doc/special_remotes/external/git-annex-remote-torrent @@ -181,9 +181,9 @@ while read line; do ;; CHECKPRESENT) key="$2" - # Let's just assume that torrents are always present + # Let's just assume that torrents are never present # for simplicity. - echo CHECKPRESENT-SUCCESS "$key" + echo CHECKPRESENT-UNKNOWN "$key" "cannot reliably check torrent status" ;; REMOVE) key="$2" 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]]. diff --git a/doc/todo/Bittorrent-like_features.mdwn b/doc/todo/Bittorrent-like_features.mdwn index 1b4dcb391..82e7d8405 100644 --- a/doc/todo/Bittorrent-like_features.mdwn +++ b/doc/todo/Bittorrent-like_features.mdwn @@ -46,4 +46,4 @@ This way, a torrent would just become another source for a specific file. When w 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 somewhat implemented, see [[devblog/day_238__extending_addurl_further/]] for details. +> This is now implemented. Including magnet link support, and multi-file torrent support. Leaving toto item open for the blue-sky stuff at top. --[[Joey]] |