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:
parent
2b3c120506
commit
da9cd315be
15 changed files with 73 additions and 44 deletions
|
@ -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 ->
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue