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 | |
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')
-rw-r--r-- | Remote/Bup.hs | 4 | ||||
-rw-r--r-- | Remote/Directory.hs | 4 | ||||
-rw-r--r-- | Remote/Git.hs | 29 | ||||
-rw-r--r-- | Remote/Hook.hs | 4 | ||||
-rw-r--r-- | Remote/Rsync.hs | 4 | ||||
-rw-r--r-- | Remote/S3real.hs | 4 |
6 files changed, 32 insertions, 17 deletions
diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 4c826498d..589dea91d 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -102,13 +102,13 @@ bupSplitParams r buprepo k src = do store :: Git.Repo -> BupRepo -> Key -> Annex Bool store r buprepo k = do - src <- fromRepo $ gitAnnexLocation k + src <- inRepo $ gitAnnexLocation k params <- bupSplitParams r buprepo k (File src) liftIO $ boolSystem "bup" params storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> Annex Bool storeEncrypted r buprepo (cipher, enck) k = do - src <- fromRepo $ gitAnnexLocation k + src <- inRepo $ gitAnnexLocation k params <- bupSplitParams r buprepo enck (Param "-") liftIO $ catchBoolIO $ withEncryptedHandle cipher (L.readFile src) $ \h -> diff --git a/Remote/Directory.hs b/Remote/Directory.hs index cadd5e759..891a19ef6 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -94,12 +94,12 @@ withStoredFile = withCheckedFile doesFileExist store :: FilePath -> Key -> Annex Bool store d k = do - src <- fromRepo $ gitAnnexLocation k + src <- inRepo $ gitAnnexLocation k liftIO $ catchBoolIO $ storeHelper d k $ copyFileExternal src storeEncrypted :: FilePath -> (Cipher, Key) -> Key -> Annex Bool storeEncrypted d (cipher, enck) k = do - src <- fromRepo $ gitAnnexLocation k + src <- inRepo $ gitAnnexLocation k liftIO $ catchBoolIO $ storeHelper d enck $ encrypt src where encrypt src dest = do 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" diff --git a/Remote/Hook.hs b/Remote/Hook.hs index 03976fc70..ab84533b2 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -97,12 +97,12 @@ runHook hooktype hook k f a = maybe (return False) run =<< lookupHook hooktype h store :: String -> Key -> Annex Bool store h k = do - src <- fromRepo $ gitAnnexLocation k + src <- inRepo $ gitAnnexLocation k runHook h "store" k (Just src) $ return True storeEncrypted :: String -> (Cipher, Key) -> Key -> Annex Bool storeEncrypted h (cipher, enck) k = withTmp enck $ \tmp -> do - src <- fromRepo $ gitAnnexLocation k + src <- inRepo $ gitAnnexLocation k liftIO $ withEncryptedContent cipher (L.readFile src) $ L.writeFile tmp runHook h "store" enck (Just tmp) $ return True diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 5cd27a609..836b93b31 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -95,11 +95,11 @@ rsyncKeyDir :: RsyncOpts -> Key -> String rsyncKeyDir o k = rsyncUrl o </> hashDirMixed k </> rsyncEscape o (keyFile k) store :: RsyncOpts -> Key -> Annex Bool -store o k = rsyncSend o k =<< fromRepo (gitAnnexLocation k) +store o k = rsyncSend o k =<< inRepo (gitAnnexLocation k) storeEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> Annex Bool storeEncrypted o (cipher, enck) k = withTmp enck $ \tmp -> do - src <- fromRepo $ gitAnnexLocation k + src <- inRepo $ gitAnnexLocation k liftIO $ withEncryptedContent cipher (L.readFile src) $ L.writeFile tmp rsyncSend o enck tmp diff --git a/Remote/S3real.hs b/Remote/S3real.hs index 97ac64821..b79939b90 100644 --- a/Remote/S3real.hs +++ b/Remote/S3real.hs @@ -112,7 +112,7 @@ s3Setup u c = handlehost $ M.lookup "host" c store :: Remote Annex -> Key -> Annex Bool store r k = s3Action r False $ \(conn, bucket) -> do - dest <- fromRepo $ gitAnnexLocation k + dest <- inRepo $ gitAnnexLocation k res <- liftIO $ storeHelper (conn, bucket) r k dest s3Bool res @@ -121,7 +121,7 @@ storeEncrypted r (cipher, enck) k = s3Action r False $ \(conn, bucket) -> -- To get file size of the encrypted content, have to use a temp file. -- (An alternative would be chunking to to a constant size.) withTmp enck $ \tmp -> do - f <- fromRepo $ gitAnnexLocation k + f <- inRepo $ gitAnnexLocation k liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s res <- liftIO $ storeHelper (conn, bucket) r enck tmp s3Bool res |