summaryrefslogtreecommitdiff
path: root/Utility
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-02-10 19:17:41 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-02-10 19:23:41 -0400
commit9030f684521ce8db3e9cd6a4e2a10f4edce7bfee (patch)
tree010f0a533899f6c24b24b1840cd9e8ce162f2d1d /Utility
parentfa77d9486dab1348d759722d2f7cbb5232797af7 (diff)
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.
Diffstat (limited to 'Utility')
-rw-r--r--Utility/Url.hs24
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"