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.

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

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)

Utility/Url.hs

@@ -7,6 +7,7 @@
 
 module Utility.Url (
 	URLString,
+	check,
 	exists,
 	canDownload,
 	download,
@@ -14,6 +15,7 @@ module Utility.Url (
 ) where
 
 import Control.Applicative
+import Control.Monad
 import qualified Network.Browser as Browser
 import Network.HTTP
 import Network.URI
@@ -23,16 +25,28 @@ import Utility.Path
 
 type URLString = String
 
-{- Checks that an url exists and could be successfully downloaded. -}
-exists :: URLString -> IO Bool
+{- Checks that an url exists and could be successfully downloaded,
+ - also checking that its size, if available, matches a specified size. -}
+check :: URLString -> Maybe Integer -> IO Bool
+check url expected_size = handle <$> exists url
+	where
+		handle (False, _) = False
+		handle (True, Nothing) = True
+		handle (True, s) = expected_size == s
+
+{- Checks that an url exists and could be successfully downloaded,
+ - also returning its size if available. -}
+exists :: URLString -> IO (Bool, Maybe Integer)
 exists url =
 	case parseURI url of
-		Nothing -> return False
+		Nothing -> return (False, Nothing)
 		Just u -> do
 			r <- request u HEAD
 			case rspCode r of
-				(2,_,_) -> return True
-				_ -> return False
+				(2,_,_) -> return (True, size r)
+				_ -> return (False, Nothing)
+	where
+		size = liftM read . lookupHeader HdrContentLength . rspHeaders
 
 canDownload :: IO Bool
 canDownload = (||) <$> inPath "wget" <*> inPath "curl"

debian/changelog

@@ -18,6 +18,8 @@ git-annex (3.20120124) UNRELEASED; urgency=low
     location of the file.
   * addurl: Normalize badly encoded urls.
   * Fix teardown of stale cached ssh connections.
+  * When checking that an url has a key, verify that the Content-Length,
+    if available, matches the size of the key.
 
  -- Joey Hess <joeyh@debian.org>  Tue, 24 Jan 2012 16:21:55 -0400
 

git-annex.cabal

@@ -1,5 +1,5 @@
 Name: git-annex
-Version: 3.20120123
+Version: 3.20120124
 Cabal-Version: >= 1.6
 License: GPL
 Maintainer: Joey Hess <joey@kitenet.net>