git-annex 5.20141203 → 5.20141219
raw patch · 89 files changed
+2404/−450 lines, 89 filesdep +torrent
Dependencies added: torrent
Files
- Annex.hs +3/−0
- Annex/UUID.hs +10/−0
- Assistant/Threads/TransferScanner.hs +1/−3
- Assistant/Upgrade.hs +3/−2
- Assistant/WebApp/Configurators/Edit.hs +1/−2
- Assistant/WebApp/Configurators/WebDAV.hs +1/−1
- Build/Configure.hs +16/−0
- BuildFlags.hs +5/−0
- CHANGELOG +23/−0
- Command/AddUrl.hs +140/−59
- Command/ImportFeed.hs +41/−13
- Command/ReKey.hs +4/−2
- Command/RmUrl.hs +7/−1
- Command/Whereis.hs +15/−6
- Git/Version.hs +7/−26
- Logs/Trust.hs +0/−7
- Logs/Trust/Basic.hs +6/−0
- Logs/Web.hs +40/−27
- Remote.hs +12/−1
- Remote/BitTorrent.hs +390/−0
- Remote/Bup.hs +2/−0
- Remote/Ddar.hs +2/−0
- Remote/Directory.hs +26/−24
- Remote/External.hs +58/−22
- Remote/External/Types.hs +37/−0
- Remote/GCrypt.hs +2/−0
- Remote/Git.hs +2/−0
- Remote/Glacier.hs +25/−23
- Remote/Helper/AWS.hs +2/−15
- Remote/Hook.hs +26/−24
- Remote/List.hs +2/−0
- Remote/Rsync.hs +2/−0
- Remote/S3.hs +41/−26
- Remote/Tahoe.hs +25/−23
- Remote/Web.hs +38/−29
- Remote/WebDAV.hs +25/−23
- Types/CleanupActions.hs +3/−0
- Types/GitConfig.hs +2/−0
- Types/Remote.hs +9/−1
- Types/UrlContents.hs +47/−0
- Utility/DottedVersion.hs +36/−0
- Utility/Metered.hs +33/−0
- Utility/Path.hs +2/−1
- Utility/Rsync.hs +13/−34
- Utility/Url.hs +11/−2
- debian/changelog +23/−0
- debian/control +2/−0
- doc/bugs/Attempting_to_repair_repository_almost_every_day.mdwn +5/−0
- doc/bugs/Build_error_when_S3_is_disabled.mdwn +39/−0
- doc/bugs/Cannot_set_direct_mode_with_non_default_worktree.mdwn +45/−0
- doc/bugs/Direct_mode_sync_fails_to_transfer_a_10GB_file.mdwn +58/−0
- doc/bugs/S3_memory_leaks/comment_7_1ac572b79caa23e3f791e4f8461fcddd._comment +10/−0
- doc/bugs/S3_upload_not_using_multipart.mdwn +1/−1
- doc/bugs/ssh-options_seems_to_be_ignored.mdwn +45/−0
- doc/design/external_special_remote_protocol.mdwn +44/−9
- doc/devblog/day_236__release_day.mdwn +10/−0
- doc/devblog/day_237__extending_addurl.mdwn +14/−0
- doc/devblog/day_238__extending_addurl_further.mdwn +67/−0
- doc/devblog/day_239-240__bittorrent_remote.mdwn +16/−0
- doc/forum/Auto_update_not_working.mdwn +6/−0
- doc/forum/Git_Annex_not_dropping_unused_content.mdwn +9/−0
- doc/forum/How_to_hide_broken_symlinks.mdwn +45/−0
- doc/forum/s3_server_side_encryption.mdwn +9/−0
- doc/git-annex.mdwn +8/−1
- doc/install/Docker.mdwn +1/−1
- doc/install/fromsource/comment_47_6de25c1e450e1e3b1d18d2c76235ccb8._comment +7/−0
- doc/internals.mdwn +9/−8
- doc/internals/hashing/comment_2_086ea37acf15e2a8694b8386222b73f6._comment +11/−0
- doc/news/version_5.20141013.mdwn +0/−7
- doc/news/version_5.20141219.mdwn +20/−0
- doc/related_software.mdwn +4/−0
- doc/special_remotes.mdwn +1/−0
- doc/special_remotes/S3.mdwn +2/−0
- doc/special_remotes/bittorrent.mdwn +29/−0
- doc/special_remotes/bup/comment_12_fca579678edde073716f099c767767e1._comment +10/−0
- doc/special_remotes/external.mdwn +6/−2
- doc/special_remotes/external/git-annex-remote-torrent +203/−0
- doc/thanks.mdwn +3/−1
- doc/tips/using_the_web_as_a_special_remote.mdwn +12/−0
- doc/todo/Bittorrent-like_features.mdwn +2/−0
- doc/todo/extensible_addurl.mdwn +88/−0
- doc/todo/inject_on_import.mdwn +21/−0
- doc/todo/parallel_get.mdwn +73/−0
- git-annex.1 +7/−1
- git-annex.cabal +9/−2
- standalone/android/buildchroot-inchroot +1/−1
- standalone/android/install-haskell-packages +2/−2
- standalone/linux/cabal.config +208/−0
- standalone/linux/install-haskell-packages +23/−17
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."""]]
@@ -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