plumb assicated files through P2P protocol for updating transfer logs

ReadContent can't update the log, since it reads lazily. This part of
the P2P monad will need to be rethought.

Associated files are heavily sanitized when received from a peer;
they could be an exploit vector.

This commit was sponsored by Jochen Bartl on Patreon.
This commit is contained in:
Joey Hess 2016-12-02 16:39:01 -04:00
parent b16a1cee4b
commit a8c868c2e1
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
3 changed files with 98 additions and 45 deletions

View file

@ -15,6 +15,8 @@ module P2P.Annex
import Annex.Common
import Annex.Content
import Annex.Transfer
import Annex.Notification
import P2P.Protocol
import P2P.IO
import Logs.Location
@ -48,8 +50,8 @@ runLocal runmode runner a = case a of
let getsize = liftIO . catchMaybeIO . getFileSize
size <- inAnnex' isJust Nothing getsize k
runner (next (Len <$> size))
-- TODO transfer logs
ReadContent k (Offset o) next -> do
-- TODO transfer log not updated
ReadContent k af (Offset o) next -> do
v <- tryNonAsync $ prepSendAnnex k
case v of
-- The check can detect a problem after the
@ -57,25 +59,26 @@ runLocal runmode runner a = case a of
-- Instead, the receiving peer must AlwaysVerify
-- the content it receives.
Right (Just (f, _check)) -> do
v' <- liftIO $ tryNonAsync $ do
h <- openBinaryFile f ReadMode
when (o /= 0) $
hSeek h AbsoluteSeek o
L.hGetContents h
v' <- tryNonAsync $ -- transfer upload k af $
liftIO $ do
h <- openBinaryFile f ReadMode
when (o /= 0) $
hSeek h AbsoluteSeek o
L.hGetContents h
case v' of
Left _ -> return Nothing
Right b -> runner (next b)
_ -> return Nothing
-- TODO transfer logs
WriteContent k (Offset o) (Len l) b next -> do
WriteContent k af (Offset o) (Len l) b next -> do
ok <- flip catchNonAsync (const $ return False) $
getViaTmp AlwaysVerify k $ \tmp -> liftIO $ do
withBinaryFile tmp WriteMode $ \h -> do
when (o /= 0) $
hSeek h AbsoluteSeek o
L.hPut h b
sz <- getFileSize tmp
return (toInteger sz == l, UnVerified)
transfer download k af $
getViaTmp AlwaysVerify k $ \tmp -> liftIO $ do
withBinaryFile tmp WriteMode $ \h -> do
when (o /= 0) $
hSeek h AbsoluteSeek o
L.hPut h b
sz <- getFileSize tmp
return (toInteger sz == l, UnVerified)
runner (next ok)
SetPresent k u next -> do
v <- tryNonAsync $ logChange k u InfoPresent
@ -107,3 +110,11 @@ runLocal runmode runner a = case a of
protoaction False
next
Right _ -> runner next
where
transfer mk k af a = case runmode of
-- Update transfer logs when serving.
Serving theiruuid ->
mk theiruuid k af noRetry (const a) noNotification
-- Transfer logs are updated higher in the stack when
-- a client.
Client -> a