summaryrefslogtreecommitdiff
path: root/Remote/Git.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-11-28 22:43:51 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-11-28 22:43:51 -0400
commitda9cd315beb03570b96f83063a39e799fe01b166 (patch)
tree61fdc79dd54dccf1792cf3ccadcc584e0119d077 /Remote/Git.hs
parent2b3c120506f1f25b4c3d0e19342b9826bde0b3b5 (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.hs29
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"