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 ->
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
liftIO $ sendmessage $ PUT_FROM (Offset 0)
withproxytmpfile k $ \tmpfile -> do
let store = tryNonAsync (storeput k af (decodeBS tmpfile)) >>= \case
Right () -> liftIO $ sendmessage SUCCESS
Left err -> liftIO $ propagateerror err
liftIO receivemessage >>= \case
Just (DATA (Len len)) -> do
iv <- startVerifyKeyContentIncrementally Remote.AlwaysVerify k
h <- liftIO $ openFile (fromRawFilePath tmpfile) WriteMode
gotall <- liftIO $ receivetofile iv h len
liftIO $ hClose h
verified <- if gotall
then fst <$> finishVerifyKeyContentIncrementally' True iv
else pure False
if protoversion > ProtocolVersion 1
then liftIO receivemessage >>= \case
Just (VALIDITY Valid)
| verified -> store
| otherwise -> liftIO $ sendmessage FAILURE
Just (VALIDITY Invalid) ->
liftIO receivemessage >>= \case
Just (DATA (Len len)) -> withproxytmpfile k $ \tmpfile -> do
-- Verify the content received from
-- the client, to avoid bad content
-- being stored in the special remote.
iv <- startVerifyKeyContentIncrementally Remote.AlwaysVerify k
h <- liftIO $ openFile (fromRawFilePath tmpfile) WriteMode
let nuketmp = liftIO $ removeWhenExistsWith removeFile (fromRawFilePath tmpfile)
gotall <- liftIO $ receivetofile iv h len
liftIO $ hClose h
verified <- if gotall
then fst <$> finishVerifyKeyContentIncrementally' True iv
else pure False
let store = tryNonAsync (storeput k af (decodeBS tmpfile)) >>= \case
Right () -> liftIO $ sendmessage SUCCESS
Left err -> liftIO $ propagateerror err
if protoversion > ProtocolVersion 1
then liftIO receivemessage >>= \case
Just (VALIDITY Valid)
| verified -> store >> nuketmp
| otherwise -> do
nuketmp
liftIO $ sendmessage FAILURE
_ -> giveup "protocol error"
else store
_ -> giveup "protocol error"
liftIO $ removeWhenExistsWith removeFile (fromRawFilePath tmpfile)
Just (VALIDITY Invalid) -> do
nuketmp
liftIO $ sendmessage FAILURE
_ -> 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
Just exportdb -> liftIO (Export.getExportTree exportdb k) >>= \case