diff options
author | Joey Hess <joey@kitenet.net> | 2011-11-28 22:43:51 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-11-28 22:43:51 -0400 |
commit | da9cd315beb03570b96f83063a39e799fe01b166 (patch) | |
tree | 61fdc79dd54dccf1792cf3ccadcc584e0119d077 /Remote/Git.hs | |
parent | 2b3c120506f1f25b4c3d0e19342b9826bde0b3b5 (diff) |
add support for using hashDirLower in addition to hashDirMixed
Supporting multiple directory hash types will allow converting to a
different one, without a flag day.
gitAnnexLocation now checks which of the possible locations have a file.
This means more statting of files. Several places currently use
gitAnnexLocation and immediately check if the returned file exists;
those need to be optimised.
Diffstat (limited to 'Remote/Git.hs')
-rw-r--r-- | Remote/Git.hs | 29 |
1 files changed, 22 insertions, 7 deletions
diff --git a/Remote/Git.hs b/Remote/Git.hs index 541d8e5f6..07afc0274 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -134,7 +134,14 @@ inAnnex r key | Git.repoIsUrl r = checkremote | otherwise = checklocal where - checkhttp = liftIO $ catchMsgIO $ Url.exists $ keyUrl r key + checkhttp = liftIO $ go undefined $ keyUrls r key + where + go e [] = return $ Left e + go _ (u:us) = do + res <- catchMsgIO $ Url.exists u + case res of + Left e -> go e us + v -> return v checkremote = do showAction $ "checking " ++ Git.repoDescribe r onRemote r (check, unknown) "inannex" [Param (show key)] @@ -169,8 +176,10 @@ onLocal r a = do liftIO Git.reap return ret -keyUrl :: Git.Repo -> Key -> String -keyUrl r key = Git.repoLocation r ++ "/" ++ annexLocation key +keyUrls :: Git.Repo -> Key -> [String] +keyUrls r key = map tourl (annexLocations key) + where + tourl l = Git.repoLocation r ++ "/" ++ l dropKey :: Git.Repo -> Key -> Annex Bool dropKey r key @@ -185,16 +194,22 @@ copyFromRemote :: Git.Repo -> Key -> FilePath -> Annex Bool copyFromRemote r key file | not $ Git.repoIsUrl r = do params <- rsyncParams r - rsyncOrCopyFile params (gitAnnexLocation key r) file + loc <- liftIO $ gitAnnexLocation key r + rsyncOrCopyFile params loc file | Git.repoIsSsh r = rsyncHelper =<< rsyncParamsRemote r True key file - | Git.repoIsHttp r = liftIO $ Url.download (keyUrl r key) file + | Git.repoIsHttp r = liftIO $ downloadurls $ keyUrls r key | otherwise = error "copying from non-ssh, non-http repo not supported" + where + downloadurls [] = return False + downloadurls (u:us) = do + ok <- Url.download u file + if ok then return ok else downloadurls us {- Tries to copy a key's content to a remote's annex. -} copyToRemote :: Git.Repo -> Key -> Annex Bool copyToRemote r key | not $ Git.repoIsUrl r = do - keysrc <- fromRepo $ gitAnnexLocation key + keysrc <- inRepo $ gitAnnexLocation key params <- rsyncParams r -- run copy from perspective of remote liftIO $ onLocal r $ do @@ -203,7 +218,7 @@ copyToRemote r key Annex.Content.saveState return ok | Git.repoIsSsh r = do - keysrc <- fromRepo $ gitAnnexLocation key + keysrc <- inRepo $ gitAnnexLocation key rsyncHelper =<< rsyncParamsRemote r False key keysrc | otherwise = error "copying to non-ssh repo not supported" |