mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

url size fixes

Browse source 
addurl: Improve message when adding url with wrong size to existing file.
Before the message suggested the url didn't exist.

Fixed handling of URL keys that have no recorded size. Before, if the key
has no size, the url also had to not declare any size, which was unlikely
and wrong, or it was taken to not exist. This probably would mostly affect
keys that were added to the annex with addurl --relaxed.
This commit is contained in:
Joey Hess 2013-10-11 13:05:00 -04:00
parent 5797364a07
commit 747f5b123c
5 changed files with 22 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

15
Utility/Url.hs
View file

@ -11,6 +11,7 @@ module Utility.Url (
URLString,
UserAgent,
check,
checkBoth,
exists,
download,
downloadQuiet
@ -32,12 +33,18 @@ type UserAgent = String
{- Checks that an url exists and could be successfully downloaded,
- also checking that its size, if available, matches a specified size. -}
check :: URLString -> Headers -> Maybe Integer -> Maybe UserAgent -> IO Bool
checkBoth :: URLString -> Headers -> Maybe Integer -> Maybe UserAgent -> IO Bool
checkBoth url headers expected_size ua = do
v <- check url headers expected_size ua
return (fst v && snd v)
check :: URLString -> Headers -> Maybe Integer -> Maybe UserAgent -> IO (Bool, Bool)
check url headers expected_size = handle <$$> exists url headers
where
handle (False, _) = False
handle (True, Nothing) = True
handle (True, s) = expected_size == s
handle (False, _) = (False, False)
handle (True, Nothing) = (True, True)
handle (True, s) = case expected_size of
Just _ -> (True, expected_size == s)
Nothing -> (True, True)
{- Checks that an url exists and could be successfully downloaded,
- also returning its size if available.