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.

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

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

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