31e1adc005
P2P protocol version 1 adds VALID|INVALID after DATA; INVALID means the file was detected to change content while it was being sent and so we may not have received the valid content of the file. Added new MustVerify constructor for Verification, which forces verification even when annex.verify=false etc. This is used when INVALID and in protocol version 0. As well as changing git-annex-shell p2psdio, this makes git-annex tor remotes always force verification, since they don't yet use protocol version 1. Previously, annex.verify=false could skip verification when using tor remotes, and let bad data into the repository. This commit was sponsored by Jack Hill on Patreon.
67 lines
2.2 KiB
Haskell
67 lines
2.2 KiB
Haskell
{- Helpers for remotes using the git-annex P2P protocol.
|
|
-
|
|
- Copyright 2016-2018 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE RankNTypes #-}
|
|
|
|
module Remote.Helper.P2P where
|
|
|
|
import Annex.Common
|
|
import qualified P2P.Protocol as P2P
|
|
import P2P.IO
|
|
import Types.Remote
|
|
import Annex.Content
|
|
import Messages.Progress
|
|
import Utility.Metered
|
|
import Types.NumCopies
|
|
|
|
import Control.Concurrent
|
|
|
|
-- Runs a Proto action using a connection it sets up.
|
|
type ProtoRunner a = P2P.Proto a -> Annex (Maybe a)
|
|
|
|
-- Runs a Proto action using a ClosableConnection.
|
|
type ProtoConnRunner c = forall a. P2P.Proto a -> ClosableConnection c -> Annex (ClosableConnection c, Maybe a)
|
|
|
|
-- Runs an Annex action with a connection from the pool, adding it back to
|
|
-- the pool when done.
|
|
type WithConn a c = (ClosableConnection c -> Annex (ClosableConnection c, a)) -> Annex a
|
|
|
|
store :: (MeterUpdate -> ProtoRunner Bool) -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
|
|
store runner k af p = do
|
|
let getsrcfile = fmap fst <$> prepSendAnnex k
|
|
metered (Just p) k getsrcfile $ \_ p' ->
|
|
fromMaybe False
|
|
<$> runner p' (P2P.put k af p')
|
|
|
|
retrieve :: (MeterUpdate -> ProtoRunner (Bool, Verification)) -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
|
|
retrieve runner k af dest p =
|
|
metered (Just p) k (return Nothing) $ \m p' ->
|
|
fromMaybe (False, UnVerified)
|
|
<$> runner p' (P2P.get dest k af m p')
|
|
|
|
remove :: ProtoRunner Bool -> Key -> Annex Bool
|
|
remove runner k = fromMaybe False <$> runner (P2P.remove k)
|
|
|
|
checkpresent :: ProtoRunner Bool -> Key -> Annex Bool
|
|
checkpresent runner k = maybe unavail return =<< runner (P2P.checkPresent k)
|
|
where
|
|
unavail = giveup "can't connect to remote"
|
|
|
|
lock :: WithConn a c -> ProtoConnRunner c -> UUID -> Key -> (VerifiedCopy -> Annex a) -> Annex a
|
|
lock withconn connrunner u k callback = withconn $ \conn -> do
|
|
connv <- liftIO $ newMVar conn
|
|
let runproto d p = do
|
|
c <- liftIO $ takeMVar connv
|
|
(c', mr) <- connrunner p c
|
|
liftIO $ putMVar connv c'
|
|
return (fromMaybe d mr)
|
|
r <- P2P.lockContentWhile runproto k go
|
|
conn' <- liftIO $ takeMVar connv
|
|
return (conn', r)
|
|
where
|
|
go False = giveup "can't lock content"
|
|
go True = withVerifiedCopy LockedCopy u (return True) callback
|