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.

1 files changed, 19 insertions, 5 deletions

diff --git a/Utility/Url.hs b/Utility/Url.hs
index e10b8a92a..efd6ad16d 100644
--- a/Utility/Url.hs
+++ b/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"