vault: add indirect-block cache with invalidation-on-free

ober

8f0881625c711a9384a2ea5f22bb4827e09b53d0

diff --git a/lib/jerboa-fuse/vault.sls b/lib/jerboa-fuse/vault.sls
index 0feda2c..2ca10de 100644
--- a/lib/jerboa-fuse/vault.sls
+++ b/lib/jerboa-fuse/vault.sls
@@ -5,7 +5,7 @@
 (library (jerboa-fuse vault)
   (export vault-create! vault-open vault-close! vault-lock!
     vault-unlock! vault-locked? vault->fuse-ops vault-mount!
-    vault-unmount!)
+    vault-unmount! vault-state-indirect-read-count)
   (import
     (except (chezscheme) make-hash-table hash-table? sort sort!
      printf fprintf format path-extension path-absolute?
@@ -26,7 +26,8 @@
       (mutable generation) (mutable policy-block) (mutable bitmap)
       (mutable bitmap-dirty?) (mutable next-fh) (mutable open-fhs)
       (mutable access) (mutable header-bv) (mutable mutex)
-      (mutable bitmap-alloc-hint)))
+      (mutable bitmap-alloc-hint) (mutable indirect-cache)
+      (mutable indirect-read-count)))
   (def *zero-block* (make-bytevector BLOCK-PAYLOAD 0))
   (def (read-inode vault block-num)
        (let ([payload (blockstore-read-block
@@ -113,6 +114,7 @@
        (let ([byte (quotient n 8)])
          (when (< byte (vault-state-bitmap-alloc-hint vault))
            (vault-state-bitmap-alloc-hint-set! vault byte)))
+       (indirect-cache-invalidate! vault n)
        (bitmap-set! vault n #f))
   (def (flush-bitmap! vault)
        (when (vault-state-bitmap-dirty? vault)
@@ -170,6 +172,28 @@
              n
              (make-bytevector BLOCK-PAYLOAD 255)))
          n))
+  (def (indirect-cache-get vault blk-num)
+       (let ([cache (vault-state-indirect-cache vault)])
+         (and cache (eq-hashtable-ref cache blk-num #f))))
+  (def (indirect-cache-put! vault blk-num payload)
+       (let ([cache (vault-state-indirect-cache vault)])
+         (when cache (eq-hashtable-set! cache blk-num payload))))
+  (def (indirect-cache-invalidate! vault blk-num)
+       (let ([cache (vault-state-indirect-cache vault)])
+         (when cache (hashtable-delete! cache blk-num))))
+  (def (read-indirect-block vault blk-num)
+       (let ([cached (indirect-cache-get vault blk-num)])
+         (if cached
+             cached
+             (let ([pay (blockstore-read-block
+                          (vault-state-bs vault)
+                          blk-num)])
+               (when pay
+                 (vault-state-indirect-read-count-set!
+                   vault
+                   (+ (vault-state-indirect-read-count vault) 1))
+                 (indirect-cache-put! vault blk-num pay))
+               pay))))
   (def (resolve-data-block vault inode logical-idx)
        (if (< logical-idx DIRECT-BLOCKS)
            (let ([blk (vector-ref
@@ -179,9 +203,7 @@
            (let ([ind-blk (vault-inode-indirect inode)])
              (if (= ind-blk VAULT-BLOCK-INVALID)
                  #f
-                 (let ([ind-pay (blockstore-read-block
-                                  (vault-state-bs vault)
-                                  ind-blk)])
+                 (let ([ind-pay (read-indirect-block vault ind-blk)])
                    (and ind-pay
                         (let ([ptr-idx (- logical-idx DIRECT-BLOCKS)])
                           (if (>= ptr-idx PTRS-PER-BLOCK)
@@ -232,7 +254,10 @@
                                  (blockstore-write-block!
                                    (vault-state-bs vault)
                                    ind-blk
-                                   ind-pay)))))))))
+                                   ind-pay)
+                                 (indirect-cache-invalidate!
+                                   vault
+                                   ind-blk)))))))))
                new-blk))))
   (def (file-read vault inode size offset)
        (let* ([file-sz (vault-inode-size inode)]
@@ -353,7 +378,10 @@
                             (blockstore-write-block!
                               (vault-state-bs vault)
                               ind-blk
-                              ind-pay))))))))
+                              ind-pay)
+                            (indirect-cache-invalidate!
+                              vault
+                              ind-blk))))))))
               (vault-inode-size-set! inode new-size))]
            [else (vault-inode-size-set! inode new-size)])
          (vault-inode-ctime-set! inode (time-second (current-time)))
@@ -532,7 +560,7 @@
                 [bm (make-bytevector bm-bytes 0)]
                 [vault (make-vault-state bs #f root-block bitmap-start bitmap-nblks 0
                          VAULT-BLOCK-INVALID bm #f 1 (make-eq-hashtable) #f
-                         #f (make-mutex) 0)])
+                         #f (make-mutex) 0 (make-eq-hashtable) 0)])
            (bitmap-set! vault 0 #t)
            (bitmap-set! vault 1 #t)
            (let loop ([i 0])
@@ -599,8 +627,8 @@
                          (bytevector-fill! pk 0)
                          (make-vault-state bs #f root-block bitmap-start bitmap-nblks
                            generation policy-block bm #f 1
-                           (make-eq-hashtable) #f hdr-bv (make-mutex)
-                           0)))))))))))
+                           (make-eq-hashtable) #f hdr-bv (make-mutex) 0
+                           (make-eq-hashtable) 0)))))))))))
   (def (vault-close! vault)
        (with-mutex (vault-state-mutex vault)
          (when (blockstore-key-live? (vault-state-bs vault))
@@ -619,6 +647,8 @@
            (blockstore-sync! (vault-state-bs vault)))
          (blockstore-clear-key! (vault-state-bs vault))
          (vault-state-master-key-set! vault #f)
+         (let ([cache (vault-state-indirect-cache vault)])
+           (when cache (hashtable-clear! cache)))
          (let ([ac (vault-state-access vault)])
            (when ac (access-controller-lock! ac)))))
   (def (vault-unlock! vault passphrase)
diff --git a/src/jerboa-fuse/vault.ss b/src/jerboa-fuse/vault.ss
index 268788d..37d2a0b 100644
--- a/src/jerboa-fuse/vault.ss
+++ b/src/jerboa-fuse/vault.ss
@@ -9,7 +9,9 @@
     vault->fuse-ops    ;; vault → ops-hashtable (with access gating)
     ;; Shell integration
     vault-mount!       ;; path passphrase mountpoint . opts → (cons vault session)
-    vault-unmount!)    ;; (cons vault session) → void
+    vault-unmount!     ;; (cons vault session) → void
+    ;; Testing
+    vault-state-indirect-read-count)
 
   (import
     (jerboa prelude)
@@ -64,7 +66,9 @@
       (mutable access)          ;; access-controller (or #f)
       (mutable header-bv)       ;; cached raw header (for lock/unlock re-derive)
       (mutable mutex)
-      (mutable bitmap-alloc-hint)))  ;; first-free byte hint for bitmap-alloc!
+      (mutable bitmap-alloc-hint)  ;; first-free byte hint for bitmap-alloc!
+      (mutable indirect-cache)     ;; hashtable: block-num -> decrypted indirect payload
+      (mutable indirect-read-count))) ;; counter: actual blockstore reads for indirect blocks
 
   ;; A shared zero buffer used to zero ranges via bytevector-copy! (Chez's
   ;; bytevector-fill! takes no start/end). Big enough for a full block tail or a
@@ -174,10 +178,10 @@
                    (bit-loop (+ bit 1))))))]))))
 
   (def (bitmap-free! vault n)
-    ;; Lower the alloc hint so a freed block before it is reconsidered.
     (let ([byte (quotient n 8)])
       (when (< byte (vault-state-bitmap-alloc-hint vault))
         (vault-state-bitmap-alloc-hint-set! vault byte)))
+    (indirect-cache-invalidate! vault n)
     (bitmap-set! vault n #f))
 
   (def (flush-bitmap! vault)
@@ -247,23 +251,43 @@
   ;; Data block resolution (file/dir inode → physical block number)
   ;; ======================================================================
 
+  (def (indirect-cache-get vault blk-num)
+    (let ([cache (vault-state-indirect-cache vault)])
+      (and cache (eq-hashtable-ref cache blk-num #f))))
+
+  (def (indirect-cache-put! vault blk-num payload)
+    (let ([cache (vault-state-indirect-cache vault)])
+      (when cache (eq-hashtable-set! cache blk-num payload))))
+
+  (def (indirect-cache-invalidate! vault blk-num)
+    (let ([cache (vault-state-indirect-cache vault)])
+      (when cache (hashtable-delete! cache blk-num))))
+
+  (def (read-indirect-block vault blk-num)
+    (let ([cached (indirect-cache-get vault blk-num)])
+      (if cached
+        cached
+        (let ([pay (blockstore-read-block (vault-state-bs vault) blk-num)])
+          (when pay
+            (vault-state-indirect-read-count-set! vault
+              (+ (vault-state-indirect-read-count vault) 1))
+            (indirect-cache-put! vault blk-num pay))
+          pay))))
+
   (def (resolve-data-block vault inode logical-idx)
-    ;; Returns physical block number or #f (not allocated).
     (if (< logical-idx DIRECT-BLOCKS)
       (let ([blk (vector-ref (vault-inode-direct inode) logical-idx)])
         (if (= blk VAULT-BLOCK-INVALID) #f blk))
       (let ([ind-blk (vault-inode-indirect inode)])
         (if (= ind-blk VAULT-BLOCK-INVALID) #f
-          (let ([ind-pay (blockstore-read-block (vault-state-bs vault) ind-blk)])
+          (let ([ind-pay (read-indirect-block vault ind-blk)])
             (and ind-pay
-                 (let ([ptr-idx (- logical-idx DIRECT-BLOCKS)]
-                       )
+                 (let ([ptr-idx (- logical-idx DIRECT-BLOCKS)])
                    (if (>= ptr-idx PTRS-PER-BLOCK) #f
                      (let ([blk (bv-u64le ind-pay (* ptr-idx 8))])
                        (if (= blk VAULT-BLOCK-INVALID) #f blk))))))))))
 
   (def (ensure-data-block! vault inode-block-num inode logical-idx)
-    ;; Get existing block or allocate a new one; returns physical block number.
     (let ([existing (resolve-data-block vault inode logical-idx)])
       (if existing existing
         (let ([new-blk (alloc-zero-block! vault)])
@@ -272,7 +296,6 @@
               (begin
                 (vector-set! (vault-inode-direct inode) logical-idx new-blk)
                 (write-inode! vault inode))
-              ;; Need indirect pointer
               (begin
                 (when (= (vault-inode-indirect inode) VAULT-BLOCK-INVALID)
                   (let ([ind (alloc-invalid-indirect-block! vault)])
@@ -285,7 +308,8 @@
                       (when ind-pay
                         (let ([ptr-idx (- logical-idx DIRECT-BLOCKS)])
                           (bv-set-u64le! ind-pay (* ptr-idx 8) new-blk)
-                          (blockstore-write-block! (vault-state-bs vault) ind-blk ind-pay)))))))))
+                          (blockstore-write-block! (vault-state-bs vault) ind-blk ind-pay)
+                          (indirect-cache-invalidate! vault ind-blk)))))))))
           new-blk))))
 
   ;; ======================================================================
@@ -370,22 +394,23 @@
                      (bitmap-free! vault phys)
                      (vector-set! (vault-inode-direct inode) i VAULT-BLOCK-INVALID)))
                  (loop (+ i 1))))
-             (let ([ind-blk (vault-inode-indirect inode)])
-               (when (and (not (= ind-blk VAULT-BLOCK-INVALID))
-                          (>= max-lidx DIRECT-BLOCKS))
-                 (let* ([ptr-lo (max 0 (- free-start DIRECT-BLOCKS))]
-                        [ptr-hi (min (- PTRS-PER-BLOCK 1) (- max-lidx DIRECT-BLOCKS))])
-                   (when (<= ptr-lo ptr-hi)
-                     (let ([ind-pay (blockstore-read-block (vault-state-bs vault) ind-blk)])
-                       (when ind-pay
-                         (let loop ([p ptr-lo])
-                           (when (<= p ptr-hi)
-                             (let ([phys (bv-u64le ind-pay (* p 8))])
-                               (when (not (= phys VAULT-BLOCK-INVALID))
-                                 (bitmap-free! vault phys)
-                                 (bv-set-u64le! ind-pay (* p 8) VAULT-BLOCK-INVALID)))
-                             (loop (+ p 1))))
-                         (blockstore-write-block! (vault-state-bs vault) ind-blk ind-pay))))))))
+              (let ([ind-blk (vault-inode-indirect inode)])
+                (when (and (not (= ind-blk VAULT-BLOCK-INVALID))
+                           (>= max-lidx DIRECT-BLOCKS))
+                  (let* ([ptr-lo (max 0 (- free-start DIRECT-BLOCKS))]
+                         [ptr-hi (min (- PTRS-PER-BLOCK 1) (- max-lidx DIRECT-BLOCKS))])
+                    (when (<= ptr-lo ptr-hi)
+                      (let ([ind-pay (blockstore-read-block (vault-state-bs vault) ind-blk)])
+                        (when ind-pay
+                          (let loop ([p ptr-lo])
+                            (when (<= p ptr-hi)
+                              (let ([phys (bv-u64le ind-pay (* p 8))])
+                                (when (not (= phys VAULT-BLOCK-INVALID))
+                                  (bitmap-free! vault phys)
+                                  (bv-set-u64le! ind-pay (* p 8) VAULT-BLOCK-INVALID)))
+                              (loop (+ p 1))))
+                          (blockstore-write-block! (vault-state-bs vault) ind-blk ind-pay)
+                          (indirect-cache-invalidate! vault ind-blk))))))))
            (vault-inode-size-set! inode new-size))]
         [else
          ;; Extend: just update size (data blocks will read as zeros)
@@ -544,14 +569,16 @@
       ;; Build in-memory bitmap: mark reserved blocks as used
       (let* ([bm-bytes (* bitmap-nblks BLOCK-PAYLOAD)]
              [bm       (make-bytevector bm-bytes 0)]
-             [vault    (make-vault-state
-                         bs #f root-block bitmap-start bitmap-nblks 0
-                         VAULT-BLOCK-INVALID  ;; policy-block
-                         bm #f 1 (make-eq-hashtable)
-                         #f       ;; access controller
-                         #f       ;; header-bv (not needed for create)
-                         (make-mutex)
-                         0)])     ;; bitmap-alloc-hint
+            [vault    (make-vault-state
+                          bs #f root-block bitmap-start bitmap-nblks 0
+                          VAULT-BLOCK-INVALID  ;; policy-block
+                          bm #f 1 (make-eq-hashtable)
+                          #f       ;; access controller
+                          #f       ;; header-bv (not needed for create)
+                          (make-mutex)
+                          0        ;; bitmap-alloc-hint
+                          (make-eq-hashtable)  ;; indirect-cache
+                          0)])     ;; indirect-read-count
         ;; Mark blocks 0 (superblock), 1 (root inode), 2...(1+bitmap-nblks) (bitmap)
         (bitmap-set! vault 0 #t)  ;; superblock
         (bitmap-set! vault 1 #t)  ;; root inode
@@ -628,13 +655,15 @@
                       ;; Zero passphrase key
                       (bytevector-fill! pk 0)
                       (make-vault-state
-                        bs #f root-block bitmap-start bitmap-nblks generation
-                        policy-block
-                        bm #f 1 (make-eq-hashtable)
-                        #f       ;; access controller
-                        hdr-bv   ;; cached header for lock/unlock
-                        (make-mutex)
-                        0)))))))))))  ;; bitmap-alloc-hint))
+                         bs #f root-block bitmap-start bitmap-nblks generation
+                         policy-block
+                         bm #f 1 (make-eq-hashtable)
+                         #f       ;; access controller
+                         hdr-bv   ;; cached header for lock/unlock
+                         (make-mutex)
+                         0        ;; bitmap-alloc-hint
+                         (make-eq-hashtable)  ;; indirect-cache
+                         0)))))))))))  ;; indirect-read-count
 
   ;; ======================================================================
   ;; vault-close!
@@ -660,15 +689,14 @@
   ;; The FUSE mount stays alive — unauthorized processes see an empty dir.
   (def (vault-lock! vault)
     (with-mutex (vault-state-mutex vault)
-      ;; Flush pending state while we still have the key
       (when (blockstore-key-live? (vault-state-bs vault))
         (flush-superblock! vault)
         (flush-bitmap! vault)
         (blockstore-sync! (vault-state-bs vault)))
-      ;; Destroy the master key
       (blockstore-clear-key! (vault-state-bs vault))
       (vault-state-master-key-set! vault #f)
-      ;; Lock the access controller
+      (let ([cache (vault-state-indirect-cache vault)])
+        (when cache (hashtable-clear! cache)))
       (let ([ac (vault-state-access vault)])
         (when ac (access-controller-lock! ac)))))
 
diff --git a/tests/test-vault.ss b/tests/test-vault.ss
index 86e05c4..6ce94db 100644
--- a/tests/test-vault.ss
+++ b/tests/test-vault.ss
@@ -195,6 +195,103 @@
 (vault-close! v-dac)
 (cleanup)
 
+(display "=== indirect block cache ===") (newline)
+
+(define v-cache (vault-create! test-path "secret123" 512))
+(define ops-cache (vault->fuse-ops v-cache))
+(define (cache-op key) (eq-hashtable-ref ops-cache key #f))
+(define ctx-cache (make-fuse-context 1000 1000 0))
+
+(define indirect-data-size (* (+ DIRECT-BLOCKS 2) BLOCK-PAYLOAD))
+(define data-A (make-bytevector indirect-data-size 65))
+(define data-B (make-bytevector indirect-data-size 66))
+
+(define create-A ((cache-op 'create) FUSE-ROOT-ID "fileA.bin" #o0644 0 ctx-cache))
+(define ino-A (fuse-entry-nodeid (car create-A)))
+(define fh-A (cdr create-A))
+((cache-op 'write) ino-A fh-A data-A 0 ctx-cache)
+((cache-op 'release) ino-A fh-A ctx-cache)
+
+(define read-A-before ((cache-op 'read) ino-A 0 indirect-data-size 0 ctx-cache))
+(test-assert "file A read back correctly before delete"
+  (and (bytevector? read-A-before)
+       (= (bytevector-length read-A-before) indirect-data-size)
+       (= (bytevector-u8-ref read-A-before 0) 65)
+       (= (bytevector-u8-ref read-A-before (- indirect-data-size 1)) 65)))
+
+((cache-op 'unlink) FUSE-ROOT-ID "fileA.bin" ctx-cache)
+
+(define create-B ((cache-op 'create) FUSE-ROOT-ID "fileB.bin" #o0644 0 ctx-cache))
+(define ino-B (fuse-entry-nodeid (car create-B)))
+(define fh-B (cdr create-B))
+((cache-op 'write) ino-B fh-B data-B 0 ctx-cache)
+((cache-op 'release) ino-B fh-B ctx-cache)
+
+(define read-B ((cache-op 'read) ino-B 0 indirect-data-size 0 ctx-cache))
+(test-assert "ALIASING: file B returns B's content, not stale A (no data leak)"
+  (and (bytevector? read-B)
+       (= (bytevector-length read-B) indirect-data-size)
+       (= (bytevector-u8-ref read-B 0) 66)
+       (= (bytevector-u8-ref read-B (- indirect-data-size 1)) 66)))
+
+(test-assert "ALIASING: file B content differs from file A content"
+  (not (equal? read-A-before read-B)))
+
+(vault-close! v-cache)
+(cleanup)
+
+(display "=== indirect cache hit ===") (newline)
+
+(define v-hit (vault-create! test-path "secret123" 512))
+(define ops-hit (vault->fuse-ops v-hit))
+(define (hit-op key) (eq-hashtable-ref ops-hit key #f))
+
+(define create-H ((hit-op 'create) FUSE-ROOT-ID "hit.bin" #o0644 0 ctx-cache))
+(define ino-H (fuse-entry-nodeid (car create-H)))
+(define fh-H (cdr create-H))
+((hit-op 'write) ino-H fh-H data-A 0 ctx-cache)
+((hit-op 'release) ino-H fh-H ctx-cache)
+
+(define count-before (vault-state-indirect-read-count v-hit))
+((hit-op 'read) ino-H 0 indirect-data-size 0 ctx-cache)
+(define count-after-first (vault-state-indirect-read-count v-hit))
+((hit-op 'read) ino-H 0 indirect-data-size 0 ctx-cache)
+(define count-after-second (vault-state-indirect-read-count v-hit))
+
+(test-assert "cache hit: second read does not re-decrypt indirect block"
+  (= count-after-first count-after-second))
+(test-assert "cache: first read did decrypt indirect block"
+  (> count-after-first count-before))
+
+(vault-close! v-hit)
+(cleanup)
+
+(display "=== indirect cache invalidation on write ===") (newline)
+
+(define v-inv (vault-create! test-path "secret123" 512))
+(define ops-inv (vault->fuse-ops v-inv))
+(define (inv-op key) (eq-hashtable-ref ops-inv key #f))
+
+(define create-W ((inv-op 'create) FUSE-ROOT-ID "inv.bin" #o0644 0 ctx-cache))
+(define ino-W (fuse-entry-nodeid (car create-W)))
+(define fh-W (cdr create-W))
+((inv-op 'write) ino-W fh-W data-A 0 ctx-cache)
+
+(define read-W1 ((inv-op 'read) ino-W 0 indirect-data-size 0 ctx-cache))
+(test-assert "invalidation: initial read returns original data"
+  (= (bytevector-u8-ref read-W1 0) 65))
+
+(define data-C (make-bytevector indirect-data-size 67))
+((inv-op 'write) ino-W fh-W data-C 0 ctx-cache)
+
+(define read-W2 ((inv-op 'read) ino-W 0 indirect-data-size 0 ctx-cache))
+(test-assert "invalidation: re-read after write returns new data"
+  (and (= (bytevector-u8-ref read-W2 0) 67)
+       (= (bytevector-u8-ref read-W2 (- indirect-data-size 1)) 67)))
+
+(vault-close! v-inv)
+(cleanup)
+
 (display "=== Summary ===") (newline)
 (display "PASS: ") (display pass) (newline)
 (display "FAIL: ") (display fail) (newline)