s3: authenticate generation high-water mark against local reset

ober

13f98f9268b75b9e4cd7737eea9dbe0149076b07

diff --git a/protonstorage/s3/drive.ss b/protonstorage/s3/drive.ss
index b2d371b..ece1f4d 100644
--- a/protonstorage/s3/drive.ss
+++ b/protonstorage/s3/drive.ss
@@ -68,6 +68,7 @@
   (define manifest-magic (string->utf8 "JDRIVE-MANIFEST-V1\n"))
   (define file-magic (string->utf8 "JDRIVE-FILE-V1\n"))
   (define chunk-magic (string->utf8 "JDRIVE-CHUNK-V1\n"))
+  (define generation-mark-magic (string->utf8 "JDRIVE-GENMARK-V1\n"))
   (define file-content-type "application/octet-stream")
   (define s3-retry-count 3)
   (define jdrive-s3-default-chunk-size (* 64 1024 1024))
@@ -426,6 +427,9 @@
   (define (manifest-aad)
     (string->utf8 "jerboa-drive s3 manifest v1"))
 
+  (define (generation-mark-aad)
+    (string->utf8 "jerboa-drive s3 generation mark v1"))
+
   (define (file-aad path object-id)
     (string->utf8 (string-append "jerboa-drive s3 file v1\n" path "\n" object-id)))
 
@@ -1009,6 +1013,7 @@
         (lambda ()
           (assert-and-record-manifest-generation!
             config
+            drive-key
             (if (object-exists? client bucket key)
                 (sealed->manifest drive-key (get-object-bytes client bucket key))
                 (jdrive-s3-empty-manifest)))))))
@@ -1058,6 +1063,7 @@
       (values
         (assert-and-record-manifest-generation!
           config
+          drive-key
           (if etag
               (sealed->manifest
                 drive-key
@@ -1074,50 +1080,95 @@
   (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)
+  (define (read-generation-mark mark-file drive-key)
+    (cond
+      [(or (not mark-file) (not (file-exists? mark-file)))
+       (values 'missing #f)]
+      [else
+       (guard (e [#t (values 'tampered #f)])
+         (let* ([obj (string->json-object (read-file-string mark-file))]
+                [encoded (jmaybe obj "Mark" #f)])
+           (unless (and (string? encoded) (> (string-length encoded) 0))
+             (error 'read-generation-mark "missing authenticated generation mark"))
+           (let* ([sealed (base64-string->u8vector encoded)]
+                  [plaintext
+                   (open-sealed-bytes
+                     'read-generation-mark
+                     generation-mark-magic
+                     drive-key
+                     (generation-mark-aad)
+                     sealed)]
+                  [inner (string->json-object (utf8->string plaintext))]
+                  [generation (jmaybe inner "Generation" #f)])
+             (unless (and (integer? generation) (exact? generation))
+               (error 'read-generation-mark "invalid authenticated generation mark"))
+             (values 'valid generation))))]))
+
+  (define (write-generation-mark! mark-file drive-key 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)))
+      (let* ([sealed
+              (seal-bytes
+                generation-mark-magic
+                drive-key
+                (generation-mark-aad)
+                (string->utf8
+                  (json-object->string (json-object "Generation" generation))))]
+             [encoded (u8vector->base64-string sealed)]
+             [handle (secure-directory-open (parent-directory mark-file) #t)]
+             [name (path-basename mark-file)])
+        (dynamic-wind
+          (lambda () (void))
+          (lambda ()
+            (call-with-secure-output-file
+              handle
+              name
+              (lambda (p)
+                (put-bytevector
+                  p
+                  (string->utf8
+                    (json-object->string (json-object "Mark" encoded)))))))
+          (lambda () (secure-directory-close handle))))))
+
+  (define (jdrive-s3-assert-manifest-generation-fresh! mark-file drive-key manifest)
+    (let ([generation (manifest-generation manifest)])
+      (call-with-values
+        (lambda () (read-generation-mark mark-file drive-key))
+        (lambda (state stored)
+          (cond
+            [(eq? state 'tampered)
+             (error 'jdrive-s3-assert-manifest-generation-fresh!
+                    "encrypted S3 generation mark failed authentication; refusing manifest"
+                    mark-file)]
+            [(and (eq? state 'valid) (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)
+  (define (jdrive-s3-record-manifest-generation! mark-file drive-key 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)))))
+        (call-with-values
+          (lambda () (read-generation-mark mark-file drive-key))
+          (lambda (state stored)
+            (case state
+              [(tampered)
+               (error 'jdrive-s3-record-manifest-generation!
+                      "encrypted S3 generation mark failed authentication"
+                      mark-file)]
+              [(missing)
+               (write-generation-mark! mark-file drive-key generation)]
+              [(valid)
+               (when (> generation stored)
+                 (write-generation-mark! mark-file drive-key generation))])))))
     manifest)
 
-  (define (assert-and-record-manifest-generation! config manifest)
+  (define (assert-and-record-manifest-generation! config drive-key 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)
+      (jdrive-s3-assert-manifest-generation-fresh! mark-file drive-key manifest)
+      (jdrive-s3-record-manifest-generation! mark-file drive-key manifest)
       manifest))
 
   (define (prepare-manifest-for-store! manifest)
@@ -1147,6 +1198,7 @@
            (request-close req)
            (jdrive-s3-record-manifest-generation!
              (generation-mark-file config)
+             drive-key
              manifest)
            (void)]
           [(or (= status 409) (= status 412))
@@ -1178,6 +1230,7 @@
                 'content-type: file-content-type)))
           (jdrive-s3-record-manifest-generation!
             (generation-mark-file config)
+            drive-key
             manifest))
         (store-manifest-conditional!
           client
diff --git a/test/test-all.ss b/test/test-all.ss
index 05f0343..8ef5881 100644
--- a/test/test-all.ss
+++ b/test/test-all.ss
@@ -16,7 +16,8 @@
 (import (jerboa-fuse))
 (import (only (proton-bridge api session) proton-session-base-url))
 (import (only (std text json) string->json-object))
-(import (only (std text base64) u8vector->base64-string))
+(import (only (std text base64) u8vector->base64-string base64-string->u8vector))
+(import (only (std os posix) posix-stat stat-mode free-stat))
 
 (define failures 0)
 
@@ -1084,19 +1085,101 @@
               (member "revision-manifest-signature-enforcement" caps)
               (member "storage-url-allowlist-enforcement" caps))))
 
+(define (overwrite-test-file! path text)
+  (when (file-exists? path) (delete-file path))
+  (call-with-output-file path (lambda (p) (display text p))))
+
 (check "S3 manifest generation rollback is rejected against stored high-water mark"
-       (let* ([mark-file (string-append s3-test-root "/generation-mark.json")]
+       (let* ([drive-key (make-bytevector 32 11)]
+              [mark-file (string-append s3-test-root "/generation-mark.json")]
               [fresh (jdrive-s3-empty-manifest)]
               [stale (jdrive-s3-empty-manifest)]
+              [same (jdrive-s3-empty-manifest)]
               [newer (jdrive-s3-empty-manifest)])
          (hashtable-set! fresh "Generation" 7)
-         (jdrive-s3-record-manifest-generation! mark-file fresh)
+         (jdrive-s3-record-manifest-generation! mark-file drive-key fresh)
          (hashtable-set! stale "Generation" 3)
+         (hashtable-set! same "Generation" 7)
          (hashtable-set! newer "Generation" 9)
          (and (test-raises?
                 (lambda ()
-                  (jdrive-s3-assert-manifest-generation-fresh! mark-file stale)))
-              (eq? (jdrive-s3-assert-manifest-generation-fresh! mark-file newer) newer))))
+                  (jdrive-s3-assert-manifest-generation-fresh! mark-file drive-key stale)))
+              (eq? (jdrive-s3-assert-manifest-generation-fresh! mark-file drive-key same) same)
+              (eq? (jdrive-s3-assert-manifest-generation-fresh! mark-file drive-key newer) newer))))
+
+(check "S3 generation mark first load with no mark accepts the manifest"
+       (let* ([drive-key (make-bytevector 32 14)]
+              [mark-file (string-append s3-test-root "/generation-mark-first.json")]
+              [manifest (jdrive-s3-empty-manifest)])
+         (hashtable-set! manifest "Generation" 5)
+         (eq? (jdrive-s3-assert-manifest-generation-fresh! mark-file drive-key manifest)
+              manifest)))
+
+(check "S3 authenticated generation mark with valid HMAC is trusted and advances"
+       (let* ([drive-key (make-bytevector 32 15)]
+              [mark-file (string-append s3-test-root "/generation-mark-valid.json")]
+              [m7 (jdrive-s3-empty-manifest)]
+              [m8 (jdrive-s3-empty-manifest)])
+         (hashtable-set! m7 "Generation" 7)
+         (jdrive-s3-record-manifest-generation! mark-file drive-key m7)
+         (hashtable-set! m8 "Generation" 8)
+         (and (eq? (jdrive-s3-assert-manifest-generation-fresh! mark-file drive-key m8) m8)
+              (eq? (jdrive-s3-record-manifest-generation! mark-file drive-key m8) m8)
+              (test-raises?
+                (lambda ()
+                  (jdrive-s3-assert-manifest-generation-fresh! mark-file drive-key m7))))))
+
+(check "S3 tampered generation mark reset to 0 is rejected and rollback still detected"
+       (let* ([drive-key (make-bytevector 32 12)]
+              [mark-file (string-append s3-test-root "/generation-mark-tamper.json")]
+              [m7 (jdrive-s3-empty-manifest)]
+              [stale (jdrive-s3-empty-manifest)])
+         (hashtable-set! m7 "Generation" 7)
+         (jdrive-s3-record-manifest-generation! mark-file drive-key m7)
+         (overwrite-test-file! mark-file "{\"Generation\":0}")
+         (hashtable-set! stale "Generation" 3)
+         (and (test-raises?
+                (lambda ()
+                  (jdrive-s3-assert-manifest-generation-fresh! mark-file drive-key stale)))
+              (test-raises?
+                (lambda ()
+                  (jdrive-s3-assert-manifest-generation-fresh! mark-file drive-key m7)))
+              (test-raises?
+                (lambda ()
+                  (jdrive-s3-record-manifest-generation! mark-file drive-key stale))))))
+
+(check "S3 generation mark with corrupted authentication tag is rejected"
+       (let* ([drive-key (make-bytevector 32 13)]
+              [mark-file (string-append s3-test-root "/generation-mark-corrupt.json")]
+              [m7 (jdrive-s3-empty-manifest)]
+              [m9 (jdrive-s3-empty-manifest)])
+         (hashtable-set! m7 "Generation" 7)
+         (jdrive-s3-record-manifest-generation! mark-file drive-key m7)
+         (let* ([obj (string->json-object (call-with-input-file mark-file get-string-all))]
+                [sealed (base64-string->u8vector (hashtable-ref obj "Mark" ""))]
+                [last (- (bytevector-length sealed) 1)])
+           (bytevector-u8-set! sealed last
+             (bitwise-xor (bytevector-u8-ref sealed last) #xff))
+           (overwrite-test-file! mark-file
+             (string-append "{\"Mark\":\"" (u8vector->base64-string sealed) "\"}")))
+         (hashtable-set! m9 "Generation" 9)
+         (and (test-raises?
+                (lambda ()
+                  (jdrive-s3-assert-manifest-generation-fresh! mark-file drive-key m9)))
+              (test-raises?
+                (lambda ()
+                  (jdrive-s3-assert-manifest-generation-fresh! mark-file drive-key m7))))))
+
+(check "S3 generation mark file is created with 0600 permissions"
+       (let* ([drive-key (make-bytevector 32 16)]
+              [mark-file (string-append s3-test-root "/generation-mark-mode.json")]
+              [m1 (jdrive-s3-empty-manifest)])
+         (hashtable-set! m1 "Generation" 1)
+         (jdrive-s3-record-manifest-generation! mark-file drive-key m1)
+         (let* ([st (posix-stat mark-file)]
+                [mode (bitwise-and (stat-mode st) #o777)])
+           (free-stat st)
+           (= mode #o600))))
 
 (define sample-child-links
   (hashtable-ref