url size fixes

addurl: Improve message when adding url with wrong size to existing file.
Before the message suggested the url didn't exist.

Fixed handling of URL keys that have no recorded size. Before, if the key
has no size, the url also had to not declare any size, which was unlikely
and wrong, or it was taken to not exist. This probably would mostly affect
keys that were added to the annex with addurl --relaxed.

5 files changed, 22 insertions, 11 deletions

diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index b90297f27..27ca72d1a 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -124,14 +124,16 @@ perform relaxed url file = ifAnnexed file addurl geturl
 			next $ return True
 		| otherwise = do
 			headers <- getHttpHeaders
-			ifM (Url.withUserAgent $ Url.check url headers $ keySize key)
-				( do
+			(exists, samesize) <- Url.withUserAgent $ Url.check url headers $ keySize key
+			if exists && samesize
+				then do
 					setUrlPresent key url
 					next $ return True
-				, do
-					warning $ "failed to verify url exists: " ++ url
+				else do
+					warning $ 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 Bool
 addUrlFile relaxed url file = do
diff --git a/Remote/Git.hs b/Remote/Git.hs
index e8ab57281..4cdedd064 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -241,7 +241,7 @@ inAnnex r key
   where
 	checkhttp headers = do
 		showChecking r
-		ifM (anyM (\u -> Url.withUserAgent $ Url.check u headers (keySize key)) (keyUrls r key))
+		ifM (anyM (\u -> Url.withUserAgent $ Url.checkBoth u headers (keySize key)) (keyUrls r key))
 			( return $ Right True
 			, return $ Left "not found"
 			)
diff --git a/Remote/Web.hs b/Remote/Web.hs
index af60beee0..ce420b24d 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -118,7 +118,7 @@ checkKey' key us = firsthit us (Right False) $ \u -> do
 #endif
 		DefaultDownloader -> do
 			headers <- getHttpHeaders
-			Right <$> Url.withUserAgent (Url.check u' headers $ keySize key)
+			Right <$> Url.withUserAgent (Url.checkBoth u' headers $ keySize key)
   where
   	firsthit [] miss _ = return miss
 	firsthit (u:rest) _ a = do
diff --git a/Utility/Url.hs b/Utility/Url.hs
index baea0fda1..97296c920 100644
--- a/Utility/Url.hs
+++ b/Utility/Url.hs
@@ -11,6 +11,7 @@ module Utility.Url (
 	URLString,
 	UserAgent,
 	check,
+	checkBoth,
 	exists,
 	download,
 	downloadQuiet
@@ -32,12 +33,18 @@ type UserAgent = String
 
 {- Checks that an url exists and could be successfully downloaded,
  - also checking that its size, if available, matches a specified size. -}
-check :: URLString -> Headers -> Maybe Integer -> Maybe UserAgent -> IO Bool
+checkBoth :: URLString -> Headers -> Maybe Integer -> Maybe UserAgent -> IO Bool
+checkBoth url headers expected_size ua = do
+	v <- check url headers expected_size ua
+	return (fst v && snd v)
+check :: URLString -> Headers -> Maybe Integer -> Maybe UserAgent -> IO (Bool, Bool)
 check url headers expected_size = handle <$$> exists url headers
   where
-	handle (False, _) = False
-	handle (True, Nothing) = True
-	handle (True, s) = expected_size == s
+	handle (False, _) = (False, False)
+	handle (True, Nothing) = (True, True)
+	handle (True, s) = case expected_size of
+		Just _ -> (True, expected_size == s)
+		Nothing -> (True, True)
 
 {- Checks that an url exists and could be successfully downloaded,
  - also returning its size if available. 
diff --git a/debian/changelog b/debian/changelog
index dd02231ff..853f9a854 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -13,6 +13,8 @@ git-annex (4.20131003) UNRELEASED; urgency=low
   * status: Fix space leak in local mode, introduced in version 4.20130920.
   * import: Skip .git directories.
   * Remove bogus runshell loop check.
+  * addurl: Improve message when adding url with wrong size to existing file.
+  * Fixed handling of URL keys that have no recorded size.
 
  -- Joey Hess <joeyh@debian.org>  Thu, 03 Oct 2013 15:41:24 -0400