Remote.Git removeKey works with annex+http urls
Does not yet handle drop proof lock timestamp checking.
This commit is contained in:
parent
fd3bdb2300
commit
9fa9678585
4 changed files with 38 additions and 36 deletions
|
@ -210,29 +210,26 @@ clientCheckPresent _ = ()
|
|||
|
||||
#ifdef WITH_SERVANT
|
||||
clientRemove
|
||||
:: ClientEnv
|
||||
-> ProtocolVersion
|
||||
-> B64Key
|
||||
-> B64UUID ServerSide
|
||||
-> B64UUID ClientSide
|
||||
-> [B64UUID Bypass]
|
||||
-> Maybe Auth
|
||||
-> IO RemoveResultPlus
|
||||
clientRemove clientenv (ProtocolVersion ver) key su cu bypass auth =
|
||||
withClientM cli clientenv $ \case
|
||||
Left err -> throwM err
|
||||
Right res -> return res
|
||||
:: Maybe SafeDropProof
|
||||
-> Key
|
||||
-> ClientAction RemoveResultPlus
|
||||
clientRemove proof k clientenv (ProtocolVersion ver) su cu bypass auth =
|
||||
liftIO $ withClientM cli clientenv return
|
||||
where
|
||||
bk = B64Key k
|
||||
|
||||
cli = case ver of
|
||||
3 -> v3 su V3 key cu bypass auth
|
||||
2 -> v2 su V2 key cu bypass auth
|
||||
1 -> plus <$> v1 su V1 key cu bypass auth
|
||||
0 -> plus <$> v0 su V0 key cu bypass auth
|
||||
3 -> v3 su V3 bk cu bypass auth
|
||||
2 -> v2 su V2 bk cu bypass auth
|
||||
1 -> plus <$> v1 su V1 bk cu bypass auth
|
||||
0 -> plus <$> v0 su V0 bk cu bypass auth
|
||||
_ -> error "unsupported protocol version"
|
||||
|
||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
||||
v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
||||
#else
|
||||
clientRemove _ _ = ()
|
||||
#endif
|
||||
|
||||
#ifdef WITH_SERVANT
|
||||
|
|
|
@ -475,11 +475,17 @@ dropKey r st proof key = do
|
|||
|
||||
dropKey' :: Git.Repo -> Remote -> State -> Maybe SafeDropProof -> Key -> Annex ()
|
||||
dropKey' repo r st@(State connpool duc _ _ _) proof key
|
||||
| isP2PHttp r = p2pHttpClient r giveup (clientRemove proof key) >>= \case
|
||||
RemoveResultPlus True fanoutuuids ->
|
||||
storefanout fanoutuuids
|
||||
RemoveResultPlus False fanoutuuids -> do
|
||||
storefanout fanoutuuids
|
||||
giveup "removing content from remote failed"
|
||||
| not $ Git.repoIsUrl repo = ifM duc
|
||||
( guardUsable repo (giveup "cannot access remote") removelocal
|
||||
, giveup "remote does not have expected annex.uuid value"
|
||||
)
|
||||
| Git.repoIsHttp repo = giveup "dropping from http remote not supported"
|
||||
| Git.repoIsHttp repo = giveup "dropping from this remote is not supported"
|
||||
| otherwise = P2PHelper.remove (uuid r) p2prunner proof key
|
||||
where
|
||||
p2prunner = Ssh.runProto r connpool (return (Right False, Nothing))
|
||||
|
@ -505,6 +511,8 @@ dropKey' repo r st@(State connpool duc _ _ _) proof key
|
|||
)
|
||||
unless proofunexpired
|
||||
safeDropProofExpired
|
||||
|
||||
storefanout = P2PHelper.storeFanout key InfoMissing (uuid r) . map fromB64UUID
|
||||
|
||||
lockKey :: Remote -> State -> Key -> (VerifiedCopy -> Annex r) -> Annex r
|
||||
lockKey r st key callback = do
|
||||
|
@ -570,7 +578,7 @@ copyFromRemote'' repo r st@(State connpool _ _ _ _) key af dest meterupdate vc
|
|||
(gitconfig r)
|
||||
(Ssh.runProto r connpool (return (False, UnVerified)))
|
||||
key af dest meterupdate vc
|
||||
| otherwise = giveup "copying from non-ssh, non-http remote not supported"
|
||||
| otherwise = giveup "copying from this remote is not supported"
|
||||
where
|
||||
bwlimit = remoteAnnexBwLimitDownload (gitconfig r)
|
||||
<|> remoteAnnexBwLimit (gitconfig r)
|
||||
|
@ -674,14 +682,15 @@ copyToRemote' repo r st@(State connpool duc _ _ _) key af o meterupdate
|
|||
res <- p2pHttpClient r giveup $
|
||||
clientPut p' key (Just offset) af object sz check'
|
||||
case res of
|
||||
PutResultPlus False _ ->
|
||||
PutResultPlus False fanoutuuids -> do
|
||||
storefanout fanoutuuids
|
||||
failedsend
|
||||
PutResultPlus True fanoutuuids ->
|
||||
storefanout fanoutuuids
|
||||
PutOffsetResultAlreadyHavePlus fanoutuuids ->
|
||||
storefanout fanoutuuids
|
||||
|
||||
storefanout = P2PHelper.storeFanout key (uuid r) . map fromB64UUID
|
||||
storefanout = P2PHelper.storeFanout key InfoPresent (uuid r) . map fromB64UUID
|
||||
|
||||
fsckOnRemote :: Git.Repo -> [CommandParam] -> Annex (IO Bool)
|
||||
fsckOnRemote r params
|
||||
|
|
|
@ -43,17 +43,15 @@ store remoteuuid gc runner k af o p = do
|
|||
metered (Just p) sizer bwlimit $ \_ p' ->
|
||||
runner (P2P.put k af p') >>= \case
|
||||
Just (Just fanoutuuids) ->
|
||||
storeFanout k remoteuuid fanoutuuids
|
||||
storeFanout k InfoPresent remoteuuid fanoutuuids
|
||||
Just Nothing -> giveup "Transfer failed"
|
||||
Nothing -> remoteUnavail
|
||||
|
||||
storeFanout :: Key -> UUID -> [UUID] -> Annex ()
|
||||
storeFanout k remoteuuid us =
|
||||
-- Storing on the remote can cause it to be stored on additional UUIDs,
|
||||
-- so record those.
|
||||
storeFanout :: Key -> LogStatus -> UUID -> [UUID] -> Annex ()
|
||||
storeFanout k logstatus remoteuuid us =
|
||||
forM_ us $ \u ->
|
||||
when (u /= remoteuuid) $
|
||||
logChange k u InfoPresent
|
||||
logChange k u logstatus
|
||||
|
||||
retrieve :: RemoteGitConfig -> (ProtoRunner (Bool, Verification)) -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
|
||||
retrieve gc runner k af dest p verifyconfig = do
|
||||
|
@ -67,20 +65,16 @@ retrieve gc runner k af dest p verifyconfig = do
|
|||
|
||||
remove :: UUID -> ProtoRunner (Either String Bool, Maybe [UUID]) -> Maybe SafeDropProof -> Key -> Annex ()
|
||||
remove remoteuuid runner proof k = runner (P2P.remove proof k) >>= \case
|
||||
Just (Right True, alsoremoveduuids) -> note alsoremoveduuids
|
||||
Just (Right True, alsoremoveduuids) ->
|
||||
storeFanout k InfoMissing remoteuuid
|
||||
(fromMaybe [] alsoremoveduuids)
|
||||
Just (Right False, alsoremoveduuids) -> do
|
||||
note alsoremoveduuids
|
||||
storeFanout k InfoMissing remoteuuid
|
||||
(fromMaybe [] alsoremoveduuids)
|
||||
giveup "removing content from remote failed"
|
||||
Just (Left err, _) -> do
|
||||
giveup (safeOutput err)
|
||||
Nothing -> remoteUnavail
|
||||
where
|
||||
-- The remote reports removal from other UUIDs than its own,
|
||||
-- so record those.
|
||||
note alsoremoveduuids =
|
||||
forM_ (fromMaybe [] alsoremoveduuids) $ \u ->
|
||||
when (u /= remoteuuid) $
|
||||
logChange k u InfoMissing
|
||||
|
||||
checkpresent :: ProtoRunner (Either String Bool) -> Key -> Annex Bool
|
||||
checkpresent runner k =
|
||||
|
|
|
@ -28,7 +28,9 @@ Planned schedule of work:
|
|||
|
||||
## work notes
|
||||
|
||||
* Rest of Remote.Git needs implementing: drop, lock
|
||||
* Drop needs to check the proof and use timestamps.
|
||||
|
||||
* Rest of Remote.Git needs implementing: lock
|
||||
|
||||
* A Locker should expire the lock on its own after 10 minutes,
|
||||
initially. Once keeplocked is called, the lock will expire at the end
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue