diff options
| -rw-r--r-- | Assistant/Threads/TransferPoller.hs | 3 | ||||
| -rw-r--r-- | Command/AddUrl.hs | 29 | ||||
| -rw-r--r-- | debian/changelog | 3 |
3 files changed, 31 insertions, 4 deletions
diff --git a/Assistant/Threads/TransferPoller.hs b/Assistant/Threads/TransferPoller.hs index 68075cac8..eff647447 100644 --- a/Assistant/Threads/TransferPoller.hs +++ b/Assistant/Threads/TransferPoller.hs @@ -51,6 +51,7 @@ transferPollerThread = namedThread "TransferPoller" $ do maybe noop (newsize t info . bytesComplete) mi newsize t info sz - | bytesComplete info /= sz && isJust sz = + | bytesComplete info /= sz && isJust sz = do + liftIO $ print ("alterTransferInfo called", sz) alterTransferInfo t $ \i -> i { bytesComplete = sz } | otherwise = noop diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index a8e3588d8..12142fb93 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -25,6 +25,8 @@ import Types.KeySource import Config import Annex.Content.Direct import Logs.Location +import qualified Logs.Transfer as Transfer +import Utility.Daemon (checkDaemon) def :: [Command] def = [notBareRepo $ withOptions [fileOption, pathdepthOption, relaxedOption] $ @@ -81,10 +83,9 @@ perform relaxed url file = ifAnnexed file addurl geturl download :: String -> FilePath -> CommandPerform download url file = do showAction $ "downloading " ++ url ++ " " - let dummykey = Backend.URL.fromUrl url Nothing + dummykey <- genkey tmp <- fromRepo $ gitAnnexTmpLocation dummykey - liftIO $ createDirectoryIfMissing True (parentDir tmp) - stopUnless (downloadUrl [url] tmp) $ do + stopUnless (runtransfer dummykey tmp) $ do backend <- chooseBackend file let source = KeySource { keyFilename = file @@ -95,6 +96,28 @@ download url file = do case k of Nothing -> stop Just (key, _) -> next $ cleanup url file key (Just tmp) + where + {- 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. + - + - If the assistant is running, actually hits the url here, + - to get the size, so it can display a pretty progress bar. + -} + genkey = do + pidfile <- fromRepo gitAnnexPidFile + size <- ifM (liftIO $ isJust <$> checkDaemon pidfile) + ( do + headers <- getHttpHeaders + liftIO $ snd <$> Url.exists url headers + , return Nothing + ) + return $ Backend.URL.fromUrl url size + runtransfer dummykey tmp = + Transfer.download webUUID dummykey (Just file) Transfer.forwardRetry $ do + liftIO $ createDirectoryIfMissing True (parentDir tmp) + downloadUrl [url] tmp + cleanup :: String -> FilePath -> Key -> Maybe FilePath -> CommandCleanup cleanup url file key mtmp = do diff --git a/debian/changelog b/debian/changelog index 4eba8011d..97ac7b295 100644 --- a/debian/changelog +++ b/debian/changelog @@ -23,6 +23,9 @@ git-annex (4.20130406) UNRELEASED; urgency=low * assistant: Bug fix to avoid annexing the files that git uses to stand in for symlinks on FAT and other filesystem not supporting symlinks. + * addurl: Register transfer so the webapp can see it. + * addurl: Automatically retry downloads that fail, as long as some + additional content was downloaded. -- Joey Hess <joeyh@debian.org> Sat, 06 Apr 2013 15:24:15 -0400 |