From 3defc7e357eae652c0d117d48a6bc0e6a3e58017 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 11 Apr 2013 16:14:17 -0400
Subject: addurl: Register transfer so the webapp can see it.

* addurl: Register transfer so the webapp can see it.
* addurl: Automatically retry downloads that fail, as long as some
  additional content was downloaded.
---
 Command/AddUrl.hs | 29 ++++++++++++++++++++++++++---
 1 file changed, 26 insertions(+), 3 deletions(-)

(limited to 'Command')

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
-- 
cgit v1.2.3