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.
This commit is contained in:
Joey Hess 2012-02-10 19:17:41 -04:00
parent fa77d9486d
commit 9030f68452
5 changed files with 30 additions and 11 deletions

View file

@ -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"