s3: reject manifest generation rollback via a persisted high-water mark

ober

b061f7a80a233afe919bcf26746ffdd600fdb572

diff --git a/protonstorage/s3/drive.ss b/protonstorage/s3/drive.ss
index 041d2e2..b155e6f 100644
--- a/protonstorage/s3/drive.ss
+++ b/protonstorage/s3/drive.ss
@@ -20,6 +20,8 @@
     jdrive-s3-manifest-add-directory
     jdrive-s3-manifest-add-file
     jdrive-s3-manifest-list
+    jdrive-s3-assert-manifest-generation-fresh!
+    jdrive-s3-record-manifest-generation!
     jdrive-s3-default-chunk-size
     jdrive-s3-default-multipart-part-size
     jdrive-s3-list!
@@ -484,7 +486,8 @@
   (define (jdrive-s3-load-profile profile state-root vault-password yubikey-material)
     (let* ([paths (jdrive-s3-profile-paths profile state-root)]
            [config-file (jref 'jdrive-s3-load-profile paths "ConfigFile")]
-           [vault-file (jref 'jdrive-s3-load-profile paths "VaultFile")])
+           [vault-file (jref 'jdrive-s3-load-profile paths "VaultFile")]
+           [profile-root (jref 'jdrive-s3-load-profile paths "ProfileRoot")])
       (unless (file-exists? config-file)
         (error 'jdrive-s3-load-profile "S3 profile config does not exist" config-file))
       (unless (file-exists? vault-file)
@@ -492,6 +495,8 @@
       (let* ([config (string->json-object (read-file-string config-file))]
              [vault (string->json-object (read-file-string vault-file))]
              [drive-key (unwrap-drive-key vault vault-password yubikey-material)])
+        (hashtable-set! config "GenerationMarkFile"
+                        (path-join profile-root "manifest.generation.json"))
         (values config vault drive-key))))
 
   (define (config-ref config key default)
@@ -994,9 +999,11 @@
       (with-s3-retry
         'load-manifest
         (lambda ()
-          (if (object-exists? client bucket key)
-              (sealed->manifest drive-key (get-object-bytes client bucket key))
-              (jdrive-s3-empty-manifest))))))
+          (assert-and-record-manifest-generation!
+            config
+            (if (object-exists? client bucket key)
+                (sealed->manifest drive-key (get-object-bytes client bucket key))
+                (jdrive-s3-empty-manifest)))))))
 
   (define (header-ref-ci headers name)
     (let loop ([xs headers])
@@ -1041,19 +1048,70 @@
   (define (load-manifest+etag client bucket config drive-key)
     (let ([etag (manifest-head-etag client bucket config)])
       (values
-        (if etag
-            (sealed->manifest
-              drive-key
-              (with-s3-retry
-                'load-manifest+etag
-                (lambda ()
-                  (get-object-bytes client bucket (manifest-object-key config)))))
-            (jdrive-s3-empty-manifest))
+        (assert-and-record-manifest-generation!
+          config
+          (if etag
+              (sealed->manifest
+                drive-key
+                (with-s3-retry
+                  'load-manifest+etag
+                  (lambda ()
+                    (get-object-bytes client bucket (manifest-object-key config)))))
+              (jdrive-s3-empty-manifest)))
         etag)))
 
   (define (manifest-generation manifest)
     (jmaybe manifest "Generation" 0))
 
+  (define (generation-mark-file config)
+    (config-ref config "GenerationMarkFile" #f))
+
+  (define (read-generation-mark mark-file)
+    (and mark-file
+         (file-exists? mark-file)
+         (guard (e [#t #f])
+           (let* ([obj (string->json-object (read-file-string mark-file))]
+                  [generation (jmaybe obj "Generation" #f)])
+             (and (integer? generation) generation)))))
+
+  (define (write-generation-mark! mark-file generation)
+    (when mark-file
+      (ensure-directory! (parent-directory mark-file))
+      (call-with-port
+        (open-file-output-port
+          mark-file
+          (file-options no-fail)
+          (buffer-mode block)
+          (native-transcoder))
+        (lambda (p)
+          (display
+            (json-object->string (json-object "Generation" generation))
+            p)))))
+
+  (define (jdrive-s3-assert-manifest-generation-fresh! mark-file manifest)
+    (let ([stored (read-generation-mark mark-file)]
+          [generation (manifest-generation manifest)])
+      (when (and stored (integer? generation) (< generation stored))
+        (error 'jdrive-s3-assert-manifest-generation-fresh!
+               "encrypted S3 manifest generation rollback detected"
+               generation
+               stored)))
+    manifest)
+
+  (define (jdrive-s3-record-manifest-generation! mark-file manifest)
+    (let ([generation (manifest-generation manifest)])
+      (when (and mark-file (integer? generation))
+        (let ([stored (read-generation-mark mark-file)])
+          (when (or (not stored) (> generation stored))
+            (write-generation-mark! mark-file generation)))))
+    manifest)
+
+  (define (assert-and-record-manifest-generation! config manifest)
+    (let ([mark-file (generation-mark-file config)])
+      (jdrive-s3-assert-manifest-generation-fresh! mark-file manifest)
+      (jdrive-s3-record-manifest-generation! mark-file manifest)
+      manifest))
+
   (define (prepare-manifest-for-store! manifest)
     (hashtable-set! manifest "Generation" (+ (manifest-generation manifest) 1))
     (hashtable-set! manifest "UpdatedAt" (datetime->epoch (datetime-utc-now)))
@@ -1079,6 +1137,9 @@
         (cond
           [(and (>= status 200) (< status 300))
            (request-close req)
+           (jdrive-s3-record-manifest-generation!
+             (generation-mark-file config)
+             manifest)
            (void)]
           [(or (= status 409) (= status 412))
            (let ([body (request-text req)])
@@ -1097,15 +1158,19 @@
 
   (define (store-manifest! client bucket config drive-key manifest . maybe-expected-etag)
     (if (null? maybe-expected-etag)
-        (with-s3-retry
-          'store-manifest!
-          (lambda ()
-            (put-object-bytes
-              client
-              bucket
-              (manifest-object-key config)
-              (manifest->sealed drive-key (prepare-manifest-for-store! manifest))
-              'content-type: file-content-type)))
+        (begin
+          (with-s3-retry
+            'store-manifest!
+            (lambda ()
+              (put-object-bytes
+                client
+                bucket
+                (manifest-object-key config)
+                (manifest->sealed drive-key (prepare-manifest-for-store! manifest))
+                'content-type: file-content-type)))
+          (jdrive-s3-record-manifest-generation!
+            (generation-mark-file config)
+            manifest))
         (store-manifest-conditional!
           client
           bucket