When checking that an url has a key, verify that the Content-Length, if available, matches the size of the key.

If there's no Content-Length, or the key has no size, this check is not
done, but it should happen most of the time, and protect against web
content that has changed.

2 files changed, 8 insertions, 5 deletions

diff --git a/Remote/Git.hs b/Remote/Git.hs
index 829ad1ccb..390524775 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -28,6 +28,7 @@ import qualified Utility.Url as Url
 import Utility.TempFile
 import Config
 import Init
+import Types.Key
 
 remote :: RemoteType
 remote = RemoteType {
@@ -143,7 +144,8 @@ inAnnex r key
 			where
 				go e [] = return $ Left e
 				go _ (u:us) = do
-					res <- catchMsgIO $ Url.exists u
+					res <- catchMsgIO $
+						Url.check u (keySize key)
 					case res of
 						Left e -> go e us
 						v -> return v
diff --git a/Remote/Web.hs b/Remote/Web.hs
index 49c3f43f3..6bd04d4b1 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -15,6 +15,7 @@ import Annex.Content
 import Config
 import Logs.Web
 import qualified Utility.Url as Url
+import Types.Key
 
 remote :: RemoteType
 remote = RemoteType {
@@ -77,8 +78,8 @@ checkKey key = do
 	us <- getUrls key
 	if null us
 		then return $ Right False
-		else return . Right =<< checkKey' us
-checkKey' :: [URLString] -> Annex Bool
-checkKey' us = untilTrue us $ \u -> do
+		else return . Right =<< checkKey' key us
+checkKey' :: Key -> [URLString] -> Annex Bool
+checkKey' key us = untilTrue us $ \u -> do
 	showAction $ "checking " ++ u
-	liftIO $ Url.exists u
+	liftIO $ Url.check u (keySize key)