d2b27ca136
This allows lockContentShared to lock content for eg, 10 minutes and if the process then gets terminated before it can unlock, the content will remain locked for that amount of time. The Windows implementation is not yet tested. In P2P.Annex, a duration of 10 minutes is used. This way, when p2pstdio or remotedaemon is serving the P2P protocol, and is asked to LOCKCONTENT, and that process gets killed, the content will not be subject to deletion. This is not a perfect solution to doc/todo/P2P_locking_connection_drop_safety.mdwn yet, but it gets most of the way there, without needing any P2P protocol changes. This is only done in v10 and higher repositories (or on Windows). It might be possible to backport it to v8 or earlier, but it would complicate locking even further, and without a separate lock file, might be hard. I think that by the time this fix reaches a given user, they will probably have been running git-annex 10.x long enough that their v8 repositories will have upgraded to v10 after the 1 year wait. And it's not as if git-annex hasn't already been subject to this problem (though I have not heard of any data loss caused by it) for 6 years already, so waiting another fraction of a year on top of however long it takes this fix to reach users is unlikely to be a problem.
111 lines
3.9 KiB
Haskell
111 lines
3.9 KiB
Haskell
{- Helpers for remotes using the git-annex P2P protocol.
|
|
-
|
|
- Copyright 2016-2024 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL 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 Utility.Tuple
|
|
import Types.NumCopies
|
|
import Annex.Verify
|
|
import Logs.Location
|
|
import Utility.SafeOutput
|
|
|
|
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 :: UUID -> RemoteGitConfig -> ProtoRunner (Maybe [UUID]) -> Key -> AssociatedFile -> Maybe FilePath -> MeterUpdate -> Annex ()
|
|
store remoteuuid gc runner k af o p = do
|
|
let sizer = KeySizer k (fmap (toRawFilePath . fst3) <$> prepSendAnnex k o)
|
|
let bwlimit = remoteAnnexBwLimitUpload gc <|> remoteAnnexBwLimit gc
|
|
metered (Just p) sizer bwlimit $ \_ p' ->
|
|
runner (P2P.put k af p') >>= \case
|
|
Just (Just fanoutuuids) -> do
|
|
-- Storing on the remote can cause it
|
|
-- to be stored on additional UUIDs,
|
|
-- so record those.
|
|
forM_ fanoutuuids $ \u ->
|
|
when (u /= remoteuuid) $
|
|
logChange k u InfoPresent
|
|
Just Nothing -> giveup "Transfer failed"
|
|
Nothing -> remoteUnavail
|
|
|
|
retrieve :: RemoteGitConfig -> (ProtoRunner (Bool, Verification)) -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
|
|
retrieve gc runner k af dest p verifyconfig = do
|
|
iv <- startVerifyKeyContentIncrementally verifyconfig k
|
|
let bwlimit = remoteAnnexBwLimitDownload gc <|> remoteAnnexBwLimit gc
|
|
metered (Just p) k bwlimit $ \m p' ->
|
|
runner (P2P.get dest k iv af m p') >>= \case
|
|
Just (True, v) -> return v
|
|
Just (False, _) -> giveup "Transfer failed"
|
|
Nothing -> remoteUnavail
|
|
|
|
remove :: UUID -> ProtoRunner (Either String Bool, Maybe [UUID]) -> Key -> Annex ()
|
|
remove remoteuuid runner k = runner (P2P.remove k) >>= \case
|
|
Just (Right True, alsoremoveduuids) -> note alsoremoveduuids
|
|
Just (Right False, alsoremoveduuids) -> do
|
|
note 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 =
|
|
runner (P2P.checkPresent k)
|
|
>>= \case
|
|
Nothing -> remoteUnavail
|
|
Just (Right b) -> return b
|
|
Just (Left err) -> giveup (safeOutput err)
|
|
|
|
{- Locks the content on the remote while running an action with a
|
|
- LockedCopy.
|
|
-
|
|
- Note that this only guarantees that the content is locked as long as the
|
|
- connection to the peer remains up. If the connection is unexpectededly
|
|
- dropped, the peer will then unlock the content.
|
|
-}
|
|
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
|
|
|
|
remoteUnavail :: a
|
|
remoteUnavail = giveup "can't connect to remote"
|