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

more robustness fixes

Browse source
This commit is contained in:
Joey Hess 2012-02-18 12:08:02 -04:00
parent abd50e01fb
commit 779ec91908
1 changed files with 11 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

18
Command/AddUrl.hs
View file

@ -44,20 +44,24 @@ start optfile pathdepth s = notBareRepo $ go $ fromMaybe bad $ parseURI s
go url = do go url = do
let file = fromMaybe (url2file url pathdepth) optfile let file = fromMaybe (url2file url pathdepth) optfile
showStart "addurl" file showStart "addurl" file
next $ perform s file pathdepth next $ perform s file
perform :: String -> FilePath -> Maybe Int -> CommandPerform perform :: String -> FilePath -> CommandPerform
perform url file pathdepth = ifAnnexed file addurl geturl perform url file = ifAnnexed file addurl geturl
where where
geturl = do geturl = do
liftIO $ createDirectoryIfMissing True (parentDir file) liftIO $ createDirectoryIfMissing True (parentDir file)
fast <- Annex.getState Annex.fast fast <- Annex.getState Annex.fast
if fast then nodownload url file else download url file if fast then nodownload url file else download url file
addurl (key, _backend) = do addurl (key, _backend) = do
unlessM (liftIO $ Url.check url (keySize key)) $ ok <- liftIO $ Url.check url (keySize key)
error $ "failed to verify url: " ++ url if ok
setUrlPresent key url then do
next $ return True setUrlPresent key url
next $ return True
else do
warning $ "failed to verify url: " ++ url
stop
download :: String -> FilePath -> CommandPerform download :: String -> FilePath -> CommandPerform
download url file = do download url file = do