mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

support DATA-PRESENT when proxtying for special remotes

Browse source 
There is a TODO left in the code for exporttree special remotes. If
possible, it should check if one of the export locations contains the
content of the key.
This commit is contained in:
Joey Hess 2024-10-29 14:53:06 -04:00
parent 2fc3fbfed2
commit f19ebabe89
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 45 additions and 25 deletions
Download patch file Download diff file Expand all files Collapse all files

70
Annex/Proxy.hs
View file

@ -179,34 +179,54 @@ proxySpecialRemote protoversion r ihdl ohdl owaitv oclosedv mexportdb = go
withTmpDirIn (fromRawFilePath othertmpdir) "proxy" $ \tmpdir -> withTmpDirIn (fromRawFilePath othertmpdir) "proxy" $ \tmpdir ->
a (toRawFilePath tmpdir P.</> keyFile k) a (toRawFilePath tmpdir P.</> keyFile k)
-- Verify the content received from the client, to avoid bad content
-- being stored in the special remote.
proxyput af k = do proxyput af k = do
liftIO $ sendmessage $ PUT_FROM (Offset 0) liftIO $ sendmessage $ PUT_FROM (Offset 0)
withproxytmpfile k $ \tmpfile -> do liftIO receivemessage >>= \case
let store = tryNonAsync (storeput k af (decodeBS tmpfile)) >>= \case Just (DATA (Len len)) -> withproxytmpfile k $ \tmpfile -> do
Right () -> liftIO $ sendmessage SUCCESS -- Verify the content received from
Left err -> liftIO $ propagateerror err -- the client, to avoid bad content
liftIO receivemessage >>= \case -- being stored in the special remote.
Just (DATA (Len len)) -> do iv <- startVerifyKeyContentIncrementally Remote.AlwaysVerify k
iv <- startVerifyKeyContentIncrementally Remote.AlwaysVerify k h <- liftIO $ openFile (fromRawFilePath tmpfile) WriteMode
h <- liftIO $ openFile (fromRawFilePath tmpfile) WriteMode let nuketmp = liftIO $ removeWhenExistsWith removeFile (fromRawFilePath tmpfile)
gotall <- liftIO $ receivetofile iv h len gotall <- liftIO $ receivetofile iv h len
liftIO $ hClose h liftIO $ hClose h
verified <- if gotall verified <- if gotall
then fst <$> finishVerifyKeyContentIncrementally' True iv then fst <$> finishVerifyKeyContentIncrementally' True iv
else pure False else pure False
if protoversion > ProtocolVersion 1 let store = tryNonAsync (storeput k af (decodeBS tmpfile)) >>= \case
then liftIO receivemessage >>= \case Right () -> liftIO $ sendmessage SUCCESS
Just (VALIDITY Valid) Left err -> liftIO $ propagateerror err
| verified -> store if protoversion > ProtocolVersion 1
| otherwise -> liftIO $ sendmessage FAILURE then liftIO receivemessage >>= \case
Just (VALIDITY Invalid) -> Just (VALIDITY Valid)
| verified -> store >> nuketmp
| otherwise -> do
nuketmp
liftIO $ sendmessage FAILURE liftIO $ sendmessage FAILURE
_ -> giveup "protocol error" Just (VALIDITY Invalid) -> do
else store nuketmp
_ -> giveup "protocol error" liftIO $ sendmessage FAILURE
liftIO $ removeWhenExistsWith removeFile (fromRawFilePath tmpfile) _ -> do
nuketmp
giveup "protocol error"
else store >> nuketmp
Just DATA_PRESENT -> tryNonAsync (verifydatapresent k) >>= \case
Right True -> liftIO $ sendmessage SUCCESS
Right False -> liftIO $ sendmessage FAILURE
Left err -> liftIO $ propagateerror err
_ -> giveup "protocol error"
verifydatapresent k = case mexportdb of
Just exportdb -> liftIO (Export.getExportTree exportdb k) >>= \case
[] -> verifykey
-- XXX TODO check that one of the export locs is populated,
-- or for an annexobjects=yes special remote, the
-- annexobject file could be populated.
locs -> return True
Nothing -> verifykey
where
verifykey = Remote.checkPresent r k
storeput k af tmpfile = case mexportdb of storeput k af tmpfile = case mexportdb of
Just exportdb -> liftIO (Export.getExportTree exportdb k) >>= \case Just exportdb -> liftIO (Export.getExportTree exportdb k) >>= \case