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.
This commit is contained in:
Joey Hess 2011-11-28 22:43:51 -04:00
parent 2b3c120506
commit da9cd315be
15 changed files with 73 additions and 44 deletions

View file

@ -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 ->

View file

@ -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

View file

@ -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"

View file

@ -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

View file

@ -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

View file

@ -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