REMOVE-BEFORE and GETTIMESTAMP

Only implemented server side, not used client side yet. And not yet implemented for proxies/clusters, for which there's a build warning about unhandled cases. This is P2P protocol version 3. Probably will be the only change in that version.. Added a dependency on clock to access a monotonic clock. On i386-ancient, that is at version 0.2.0.0.
2024-07-03 16:59:22 -04:00 · 2024-07-03 16:59:22 -04:00 · 543c610a31
commit 543c610a31
parent 665d3d66a5
9 changed files with 159 additions and 27 deletions
--- a/4
+++ b/4
@ -2,6 +2,10 @@ git-annex (10.20240702) UNRELEASED; urgency=medium

  * assistant: Fix a race condition that could cause a pointer file to
    get ingested into the annex.
+  * Avoid potential data loss in situations where git-annex-shell or
+    git-annex remotedaemon is killed while locking a key to prevent its
+    removal.
+  * Added a dependency on clock.

 -- Joey Hess <id@joeyh.name>  Tue, 02 Jul 2024 12:14:53 -0400

--- a/P2P/Annex.hs
+++ b/P2P/Annex.hs
@ -110,15 +110,24 @@ runLocal runst runner a = case a of
 		case v of
 			Left e -> return $ Left $ ProtoFailureException e
 			Right result -> runner (next result)
-	RemoveContent k next -> do
+	RemoveContent k mts next -> do
 		let cleanup = do
 			logStatus k InfoMissing
 			return True
+		let checkts = case mts of
+			Nothing -> return True
+			Just ts -> do
+				now <- liftIO getMonotonicTimestampIO
+				return (now < ts)
 		v <- tryNonAsync $
 			ifM (Annex.Content.inAnnex k)
-				( lockContentForRemoval k cleanup $ \contentlock -> do
+				( lockContentForRemoval k cleanup $ \contentlock ->
+					ifM checkts
+						( do
 							removeAnnex contentlock
 							cleanup
+						, return False
+						)
 				, return True
 				)
 		case v of
--- a/P2P/IO.hs
+++ b/P2P/IO.hs
@ -25,6 +25,7 @@ module P2P.IO
 	, describeProtoFailure
 	, runNetProto
 	, runNet
+	, getMonotonicTimestampIO
 	) where

 import Common
@ -53,6 +54,11 @@ import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
 import qualified Network.Socket as S
 import System.PosixCompat.Files (groupReadMode, groupWriteMode, otherReadMode, otherWriteMode)
+#if MIN_VERSION_clock(0,3,0)
+import qualified System.Clock as Clock
+#else
+import qualified System.Posix.Clock as Clock
+#endif

 -- Type of interpreters of the Proto free monad.
 type RunProto m = forall a. Proto a -> m (Either ProtoFailure a)
@ -282,6 +288,8 @@ runNet runst conn runner f = case f of
 		runner next
 	GetProtocolVersion next ->
 		liftIO (readTVarIO versiontvar) >>= runner . next
+	GetMonotonicTimestamp next ->
+		liftIO getMonotonicTimestampIO >>= runner . next
  where
 	-- This is only used for running Net actions when relaying,
 	-- so it's ok to use runNetProto, despite it not supporting
@ -452,3 +460,7 @@ relayReader v hout = loop
 			else getsome (b:bs)
 	
 	chunk = 65536
+
+getMonotonicTimestampIO :: IO MonotonicTimestamp
+getMonotonicTimestampIO = (MonotonicTimestamp . fromIntegral . Clock.sec)
+	<$> Clock.getTime Clock.Monotonic
--- a/P2P/Protocol.hs
+++ b/P2P/Protocol.hs
@ -56,7 +56,7 @@ defaultProtocolVersion :: ProtocolVersion
 defaultProtocolVersion = ProtocolVersion 0

 maxProtocolVersion :: ProtocolVersion
-maxProtocolVersion = ProtocolVersion 2
+maxProtocolVersion = ProtocolVersion 3

 newtype ProtoAssociatedFile = ProtoAssociatedFile AssociatedFile
 	deriving (Show)
@ -71,6 +71,9 @@ data Validity = Valid | Invalid
 newtype Bypass = Bypass (S.Set UUID)
 	deriving (Show, Monoid, Semigroup)

+newtype MonotonicTimestamp = MonotonicTimestamp Integer
+	deriving (Show, Eq, Ord)
+
 -- | Messages in the protocol. The peer that makes the connection
 -- always initiates requests, and the other peer makes responses to them.
 data Message
@ -86,6 +89,8 @@ data Message
 	| LOCKCONTENT Key
 	| UNLOCKCONTENT
 	| REMOVE Key
+	| REMOVE_BEFORE MonotonicTimestamp Key
+	| GETTIMESTAMP
 	| GET Offset ProtoAssociatedFile Key
 	| PUT ProtoAssociatedFile Key
 	| PUT_FROM Offset
@ -98,6 +103,7 @@ data Message
 	| BYPASS Bypass
 	| DATA Len -- followed by bytes of data
 	| VALIDITY Validity
+	| TIMESTAMP MonotonicTimestamp
 	| ERROR String
 	deriving (Show)

@ -114,6 +120,8 @@ instance Proto.Sendable Message where
 	formatMessage (LOCKCONTENT key) = ["LOCKCONTENT", Proto.serialize key]
 	formatMessage UNLOCKCONTENT = ["UNLOCKCONTENT"]
 	formatMessage (REMOVE key) = ["REMOVE", Proto.serialize key]
+	formatMessage (REMOVE_BEFORE ts key) = ["REMOVE-BEFORE", Proto.serialize ts, Proto.serialize key]
+	formatMessage GETTIMESTAMP = ["GETTIMESTAMP"]
 	formatMessage (GET offset af key) = ["GET", Proto.serialize offset, Proto.serialize af, Proto.serialize key]
 	formatMessage (PUT af key) = ["PUT", Proto.serialize af, Proto.serialize key]
 	formatMessage (PUT_FROM offset) = ["PUT-FROM", Proto.serialize offset]
@ -124,9 +132,10 @@ instance Proto.Sendable Message where
 	formatMessage FAILURE = ["FAILURE"]
 	formatMessage (FAILURE_PLUS uuids) = ("FAILURE-PLUS":map Proto.serialize uuids)
 	formatMessage (BYPASS (Bypass uuids)) = ("BYPASS":map Proto.serialize (S.toList uuids))
+	formatMessage (DATA len) = ["DATA", Proto.serialize len]
 	formatMessage (VALIDITY Valid) = ["VALID"]
 	formatMessage (VALIDITY Invalid) = ["INVALID"]
-	formatMessage (DATA len) = ["DATA", Proto.serialize len]
+	formatMessage (TIMESTAMP ts) = ["TIMESTAMP", Proto.serialize ts]
 	formatMessage (ERROR err) = ["ERROR", Proto.serialize err]

 instance Proto.Receivable Message where
@ -142,6 +151,8 @@ instance Proto.Receivable Message where
 	parseCommand "LOCKCONTENT" = Proto.parse1 LOCKCONTENT
 	parseCommand "UNLOCKCONTENT" = Proto.parse0 UNLOCKCONTENT
 	parseCommand "REMOVE" = Proto.parse1 REMOVE
+	parseCommand "REMOVE-BEFORE" = Proto.parse2 REMOVE_BEFORE
+	parseCommand "GETTIMESTAMP" = Proto.parse0 GETTIMESTAMP
 	parseCommand "GET" = Proto.parse3 GET
 	parseCommand "PUT" = Proto.parse2 PUT
 	parseCommand "PUT-FROM" = Proto.parse1 PUT_FROM
@ -153,9 +164,10 @@ instance Proto.Receivable Message where
 	parseCommand "FAILURE-PLUS" = Proto.parseList FAILURE_PLUS
 	parseCommand "BYPASS" = Proto.parseList (BYPASS . Bypass . S.fromList)
 	parseCommand "DATA" = Proto.parse1 DATA
-	parseCommand "ERROR" = Proto.parse1 ERROR
 	parseCommand "VALID" = Proto.parse0 (VALIDITY Valid)
 	parseCommand "INVALID" = Proto.parse0 (VALIDITY Invalid)
+	parseCommand "TIMESTAMP" = Proto.parse1 TIMESTAMP
+	parseCommand "ERROR" = Proto.parse1 ERROR
 	parseCommand _ = Proto.parseFail

 instance Proto.Serializable ProtocolVersion where
@ -170,6 +182,10 @@ instance Proto.Serializable Len where
 	serialize (Len n) = show n
 	deserialize = Len <$$> readish

+instance Proto.Serializable MonotonicTimestamp where
+	serialize (MonotonicTimestamp n) = show n
+	deserialize = MonotonicTimestamp <$$> readish
+
 instance Proto.Serializable Service where
 	serialize UploadPack = "git-upload-pack"
 	serialize ReceivePack = "git-receive-pack"
@ -249,6 +265,7 @@ data NetF c
 	| SetProtocolVersion ProtocolVersion c
 	--- ^ Called when a new protocol version has been negotiated.
 	| GetProtocolVersion (ProtocolVersion -> c)
+	| GetMonotonicTimestamp (MonotonicTimestamp -> c)
 	deriving (Functor)

 type Net = Free NetF
@ -294,9 +311,11 @@ data LocalF c
 	| SetPresent Key UUID c
 	| CheckContentPresent Key (Bool -> c)
 	-- ^ Checks if the whole content of the key is locally present.
-	| RemoveContent Key (Bool -> c)
+	| RemoveContent Key (Maybe MonotonicTimestamp) (Bool -> c)
 	-- ^ If the content is not present, still succeeds.
 	-- May fail if not enough copies to safely drop, etc.
+	-- After locking the content for removal, checks if it's later
+	-- than the MonotonicTimestamp, and fails.
 	| TryLockContent Key (Bool -> Proto ()) c
 	-- ^ Try to lock the content of a key,  preventing it
 	-- from being deleted, while running the provided protocol
@ -488,12 +507,12 @@ serveAuthed servermode myuuid = void $ serverLoop handler
 		sendSuccess =<< local (checkContentPresent key)
 		return ServerContinue
 	handler (REMOVE key) =
-		checkREMOVEServerMode servermode $ \case
-			Nothing -> do
-				sendSuccess =<< local (removeContent key)
-				return ServerContinue			
-			Just notallowed -> do
-				notallowed
+		handleremove key Nothing
+	handler (REMOVE_BEFORE ts key) =
+		handleremove key (Just ts)
+	handler GETTIMESTAMP = do
+		ts <- net getMonotonicTimestamp
+		net $ sendMessage $ TIMESTAMP ts
 		return ServerContinue
 	handler (PUT (ProtoAssociatedFile af) key) =
 		checkPUTServerMode servermode $ \case
@ -537,6 +556,15 @@ serveAuthed servermode myuuid = void $ serverLoop handler
 					local $ setPresent key myuuid
 		return ServerContinue
 		
+	handleremove key mts =
+		checkREMOVEServerMode servermode $ \case
+			Nothing -> do
+				sendSuccess =<< local (removeContent key mts)
+				return ServerContinue			
+			Just notallowed -> do
+				notallowed
+				return ServerContinue
+
 sendReadOnlyError :: Proto ()
 sendReadOnlyError = net $ sendMessage $
 	ERROR "this repository is read-only; write access denied"
--- a/debian/control
+++ b/debian/control
@ -84,6 +84,7 @@ Build-Depends:
 	libghc-filepath-bytestring-dev,
 	libghc-git-lfs-dev (>= 1.2.0),
 	libghc-criterion-dev,
+	libghc-clock-dev,
 	lsof [linux-any],
 	ikiwiki,
 	libimage-magick-perl,
--- a/doc/design/p2p_protocol.mdwn
+++ b/doc/design/p2p_protocol.mdwn
@ -55,7 +55,7 @@ any authentication.

 The client sends the highest protocol version it supports:

-	VERSION 2
+	VERSION 3

 The server responds with the highest protocol version it supports
 that is less than or equal to the version the client sent:
@ -134,6 +134,32 @@ In protocol version 2, the server can optionally reply with SUCCESS-PLUS
 or FAILURE-PLUS. Each has a subsequent list of UUIDs of repositories
 that the content was removed from.

+## Removing content before a specified time
+
+This is only available in protocol version 3 and above.
+
+To remove a key's content from the server, but only before a specified time,
+the client sends:
+
+    REMOVE-BEFORE Timestamp Key
+
+The server responds to the message in the same way as to REMOVE.
+
+If the server receives the message at a time after the specified timestamp,
+the remove must fail.  This is used to avoid removing content after a point
+in time where it is no longer locked in other repostitories.
+
+## Getting a timestamp
+
+This is only available in protocol version 3 and above.
+
+To get the current timestamp from the server, the client sends:
+
+    GETTIMESTAMP
+
+The server responds with TIMESTAMP followed by its current time, as a
+number of seconds. Note that this uses a monotonic clock.
+
 ## Storing content on the server

 To store content on the server, the client sends:
--- a/doc/design/p2p_protocol_over_http/draft1.mdwn
+++ b/doc/design/p2p_protocol_over_http/draft1.mdwn
@ -24,14 +24,14 @@ may want git-annex to use HTTP in eg a LAN.

 Each request in the protocol is versioned. The versions correspond
 to P2P protocol versions, but for simplicity, the minimum version supported
-over HTTP is version 2. Every implementation of the HTTP protocol must
-support version 2.
+over HTTP is version 3. Every implementation of the HTTP protocol must
+support version 3.

-The protocol version comes before the request. Eg: `/git-annex/v2/put`
+The protocol version comes before the request. Eg: `/git-annex/v3/put`

 If the server does not support a particular protocol version, the
 request will fail with a 404, and the client should fall back to an earlier
-protocol version, eg version 2.
+protocol version.

 ## common request parameters

@ -72,7 +72,7 @@ Checks if a key is currently present on the server.

 Example:

-    > POST /git-annex/v2/checkpresent?key=SHA1--foo&clientuuid=79a5a1f4-07e8-11ef-873d-97f93ca91925&serveruuid=ecf6d4ca-07e8-11ef-8990-9b8c1f696bf6 HTTP/1.1
+    > POST /git-annex/v3/checkpresent?key=SHA1--foo&clientuuid=79a5a1f4-07e8-11ef-873d-97f93ca91925&serveruuid=ecf6d4ca-07e8-11ef-8990-9b8c1f696bf6 HTTP/1.1
    < SUCCESS

 There is one required additional parameter, `key`.
@ -99,13 +99,32 @@ or closes the websocket, the server unlocks the content.
 XXX What happens if the connection times out? Will the client notice that
 in time? How does this work with P2P over ssh?

+### limit-remove
+
+Limit the next requested removal of a key to occur within a specified
+number of seconds.
+
+Example:
+
+    > POST /git-annex/v3/limit-remove?seconds=600&key=SHA1--foo&clientuuid=79a5a1f4-07e8-11ef-873d-97f93ca91925&serveruuid=ecf6d4ca-07e8-11ef-8990-9b8c1f696bf6 HTTP/1.1
+    < SUCCESS
+
+There are two required additional parameters, `key` and `seconds`.
+
+The body of the request is empty.
+
+The server responds with "SUCCESS".
+
+The server will check the next `remove` request, and if it's for the same key,
+and more time has elapsed, it will refuse to remove the key's content.
+
 ### remove

 Remove a key's content from the server.

 Example:

-    > POST /git-annex/v2/remove?key=SHA1--foo&clientuuid=79a5a1f4-07e8-11ef-873d-97f93ca91925&serveruuid=ecf6d4ca-07e8-11ef-8990-9b8c1f696bf6 HTTP/1.1
+    > POST /git-annex/v3/remove?key=SHA1--foo&clientuuid=79a5a1f4-07e8-11ef-873d-97f93ca91925&serveruuid=ecf6d4ca-07e8-11ef-8990-9b8c1f696bf6 HTTP/1.1
    < SUCCESS

 There is one required additional parameter, `key`.
@ -125,13 +144,46 @@ If the server was prevented from trying to remove the key due to a policy
 (eg due to being read-only or append-only, it will respond with "ERROR",
 followed by a space and an error message.

+## remove-before
+
+Remove a key's content from the server, but only before a specified time.
+
+Example:
+
+    > POST /git-annex/v3/remove-before?timestamp=4949292929&key=SHA1--foo&clientuuid=79a5a1f4-07e8-11ef-873d-97f93ca91925&serveruuid=ecf6d4ca-07e8-11ef-8990-9b8c1f696bf6 HTTP/1.1
+    < SUCCESS
+
+This is the same as the `remove` request, but with an additional parameter,
+`timestamp`.
+
+If the server's clock is past the specified timestamp, the removal will
+fail. This is used to avoid removing content after a point in time where it
+is no longer locked in other repostitories.
+
+## gettimestamp
+
+Gets the current timestamp from the server.
+
+Example:
+
+    > POST /git-annex/v3/gettimestamp?clientuuid=79a5a1f4-07e8-11ef-873d-97f93ca91925&serveruuid=ecf6d4ca-07e8-11ef-8990-9b8c1f696bf6 HTTP/1.1
+    < TIMESTAMP 59459392
+
+The body of the request is empty.
+
+The server responds with "TIMESTAMP" followed by a space and the current
+value of its monotonic clock, as a number of seconds.
+
+Important: If multiple servers are serving this protocol for the same
+repository, they MUST all use the same monotonic clock.
+
 ### put

 Store content on the server.

 Example:

-    > POST /git-annex/v2/put?key=SHA1--foo&associatedfile=bar&clientuuid=79a5a1f4-07e8-11ef-873d-97f93ca91925&serveruuid=ecf6d4ca-07e8-11ef-8990-9b8c1f696bf6 HTTP/1.1
+    > POST /git-annex/v3/put?key=SHA1--foo&associatedfile=bar&clientuuid=79a5a1f4-07e8-11ef-873d-97f93ca91925&serveruuid=ecf6d4ca-07e8-11ef-8990-9b8c1f696bf6 HTTP/1.1
    > Content-Type: application/octet-stream
    > Content-Length: 4
    > foo1
@ -186,7 +238,7 @@ the `put` request failing.

 Example:

-    > POST /git-annex/v2/putoffset?key=SHA1--foo&clientuuid=79a5a1f4-07e8-11ef-873d-97f93ca91925&serveruuid=ecf6d4ca-07e8-11ef-8990-9b8c1f696bf6 HTTP/1.1
+    > POST /git-annex/v3/putoffset?key=SHA1--foo&clientuuid=79a5a1f4-07e8-11ef-873d-97f93ca91925&serveruuid=ecf6d4ca-07e8-11ef-8990-9b8c1f696bf6 HTTP/1.1
    < 10

 There is one required additional parameter, `key`.
@ -211,7 +263,7 @@ Get content from the server.

 Example:

-    > POST /git-annex/v2/get?key=SHA1--foo&associatedfile=bar&clientuuid=79a5a1f4-07e8-11ef-873d-97f93ca91925&serveruuid=ecf6d4ca-07e8-11ef-8990-9b8c1f696bf6 HTTP/1.1
+    > POST /git-annex/v3/get?key=SHA1--foo&associatedfile=bar&clientuuid=79a5a1f4-07e8-11ef-873d-97f93ca91925&serveruuid=ecf6d4ca-07e8-11ef-8990-9b8c1f696bf6 HTTP/1.1
    < Content-Type: application/octet-stream
    < Content-Length: 4
    < foo1
--- a/doc/todo/P2P_locking_connection_drop_safety.mdwn
+++ b/doc/todo/P2P_locking_connection_drop_safety.mdwn
@ -111,4 +111,3 @@ out to each client, by calling GETTIMESTAMP again and applying the offsets
 between the cluster's clock and each node's clock.

 This approach would need to use a monotonic clock!
->>>>>>> master
--- a/git-annex.cabal
+++ b/git-annex.cabal
@ -278,7 +278,8 @@ Executable git-annex
   DAV (>= 1.0),
   network (>= 3.0.0.0),
   network-bsd,
-   git-lfs (>= 1.2.0)
+   git-lfs (>= 1.2.0),
+   clock (>= 0.2.0.0)
  CC-Options: -Wall
  GHC-Options: -Wall -fno-warn-tabs  -Wincomplete-uni-patterns
  Default-Language: Haskell2010