vault: add d_type to dirents with on-disk format versioning
ober
c92e4d5a7abc54586bfae71e5867893fe8eee398
--- a/lib/jerboa-fuse/vault.sls +++ b/lib/jerboa-fuse/vault.sls @@ -5,7 +5,9 @@ (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-state-indirect-read-count) + vault-unmount! vault-state-indirect-read-count + vault-state-readdir-inode-reads vault-state-dirent-version + vault-state-dirent-version-set!) (import (except (chezscheme) make-hash-table hash-table? sort sort! printf fprintf format path-extension path-absolute? @@ -27,7 +29,8 @@ (mutable bitmap-dirty?) (mutable next-fh) (mutable open-fhs) (mutable access) (mutable header-bv) (mutable mutex) (mutable bitmap-alloc-hint) (mutable indirect-cache) - (mutable indirect-read-count))) + (mutable indirect-read-count) (mutable dirent-version) + (mutable readdir-inode-reads))) (def *zero-block* (make-bytevector BLOCK-PAYLOAD 0)) (def (read-inode vault block-num) (let ([payload (blockstore-read-block @@ -145,7 +148,8 @@ (encode-superblock (vault-state-root-block vault) (vault-state-bitmap-start vault) (vault-state-bitmap-nblocks vault) gen - (vault-state-policy-block vault))))) + (vault-state-policy-block vault) + (vault-state-dirent-version vault))))) (def (alloc-fh! vault block-num) (let ([fh (vault-state-next-fh vault)]) (vault-state-next-fh-set! vault (+ fh 1)) @@ -386,6 +390,11 @@ [else (vault-inode-size-set! inode new-size)]) (vault-inode-ctime-set! inode (time-second (current-time))) (write-inode! vault inode))) + (def (inode-type->d-type type) + (cond + [(= type INODE-TYPE-DIR) DT-DIR] + [(= type INODE-TYPE-SYMLINK) DT-LNK] + [else DT-REG])) (def (dir-lookup vault dir-inode name) (let loop ([lidx 0]) (let ([phys (resolve-data-block vault dir-inode lidx)]) @@ -399,17 +408,29 @@ (let slot-loop ([slot 0]) (if (>= slot DIRENTS-PER-BLOCK) (loop (+ lidx 1)) - (let-values ([(iblk nbv) - (decode-dirent - pay - (* slot DIRENT-SIZE))]) - (cond - [(= iblk 0) (slot-loop (+ slot 1))] - [(string=? (utf8->string nbv) name) iblk] - [else (slot-loop (+ slot 1))])))))))))) + (let ([off (* slot DIRENT-SIZE)]) + (if (dirent-v2? pay off) + (let-values ([(iblk nbv _dt) + (decode-dirent-v2 pay off)]) + (cond + [(= iblk 0) (slot-loop (+ slot 1))] + [(string=? (utf8->string nbv) name) + iblk] + [else (slot-loop (+ slot 1))])) + (let-values ([(iblk nbv) + (decode-dirent pay off)]) + (cond + [(= iblk 0) (slot-loop (+ slot 1))] + [(string=? (utf8->string nbv) name) + iblk] + [else + (slot-loop (+ slot 1))])))))))))))) (def (dir-add! vault dir-block-num dir-inode child-block-num - name) - (let ([name-bv (string->utf8 name)] [done? #f]) + name child-type) + (let ([name-bv (string->utf8 name)] + [done? #f] + [v2? (>= (vault-state-dirent-version vault) + DIRENT-VERSION-V2)]) (let block-loop ([lidx 0]) (unless done? (let ([phys (resolve-data-block vault dir-inode lidx)]) @@ -420,10 +441,16 @@ dir-inode lidx)]) (when new-blk - (let ([pay (make-bytevector BLOCK-PAYLOAD 0)]) - (bytevector-copy! - (encode-dirent child-block-num name-bv) 0 pay 0 - DIRENT-SIZE) + (let ([pay (make-bytevector BLOCK-PAYLOAD 0)] + [enc (if v2? + (encode-dirent-v2 + child-block-num + name-bv + (inode-type->d-type child-type)) + (encode-dirent + child-block-num + name-bv))]) + (bytevector-copy! enc 0 pay 0 DIRENT-SIZE) (blockstore-write-block! (vault-state-bs vault) new-blk @@ -441,13 +468,17 @@ pay (* slot DIRENT-SIZE))]) (if (= iblk 0) - (begin - (bytevector-copy! - (encode-dirent - child-block-num - name-bv) - 0 pay (* slot DIRENT-SIZE) - DIRENT-SIZE) + (let ([enc (if v2? + (encode-dirent-v2 + child-block-num + name-bv + (inode-type->d-type + child-type)) + (encode-dirent + child-block-num + name-bv))]) + (bytevector-copy! enc 0 pay + (* slot DIRENT-SIZE) DIRENT-SIZE) (blockstore-write-block! (vault-state-bs vault) phys @@ -466,16 +497,24 @@ (when pay (let slot-loop ([slot 0]) (when (< slot DIRENTS-PER-BLOCK) - (let-values ([(iblk nbv) - (decode-dirent - pay - (* slot DIRENT-SIZE))]) + (let* ([off (* slot DIRENT-SIZE)] + [nbv (if (dirent-v2? pay off) + (let-values ([(_i n _d) + (decode-dirent-v2 + pay + off)]) + n) + (let-values ([(_i n) + (decode-dirent + pay + off)]) + n))] + [iblk (bv-u64le pay off)]) (if (and (not (= iblk 0)) (string=? (utf8->string nbv) name)) (begin - (let ([off (* slot DIRENT-SIZE)]) - (bytevector-copy! *zero-block* 0 pay off - DIRENT-SIZE)) + (bytevector-copy! *zero-block* 0 pay off + DIRENT-SIZE) (blockstore-write-block! (vault-state-bs vault) phys @@ -495,15 +534,25 @@ (when pay (let slot-loop ([slot 0]) (when (< slot DIRENTS-PER-BLOCK) - (let-values ([(iblk nbv) - (decode-dirent - pay - (* slot DIRENT-SIZE))]) - (when (not (= iblk 0)) - (set! result - (cons - (cons iblk (utf8->string nbv)) - result)))) + (let ([off (* slot DIRENT-SIZE)]) + (if (dirent-v2? pay off) + (let-values ([(iblk nbv dtype) + (decode-dirent-v2 pay off)]) + (when (not (= iblk 0)) + (set! result + (cons + (list iblk (utf8->string nbv) dtype) + result)))) + (let-values ([(iblk nbv) + (decode-dirent pay off)]) + (when (not (= iblk 0)) + (set! result + (cons + (list + iblk + (utf8->string nbv) + DT-UNKNOWN) + result)))))) (slot-loop (+ slot 1))))) (block-loop (+ lidx 1)))))) (reverse result))) @@ -560,7 +609,8 @@ [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 (make-eq-hashtable) 0)]) + #f (make-mutex) 0 (make-eq-hashtable) 0 + DIRENT-VERSION-V2 0)]) (bitmap-set! vault 0 #t) (bitmap-set! vault 1 #t) (let loop ([i 0]) @@ -610,7 +660,7 @@ (let ([sb-pay (blockstore-read-block bs sb-block)]) (unless sb-pay (error 'vault-open "cannot read superblock")) - (let-values ([(root-block bitmap-start bitmap-nblks generation policy-block) + (let-values ([(root-block bitmap-start bitmap-nblks generation policy-block dirent-version) (decode-superblock sb-pay)]) (let* ([bm-bytes (* bitmap-nblks BLOCK-PAYLOAD)] [bm (make-bytevector bm-bytes 0)]) @@ -628,7 +678,8 @@ (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) 0))))))))))) + (make-eq-hashtable) 0 dirent-version + 0))))))))))) (def (vault-close! vault) (with-mutex (vault-state-mutex vault) (when (blockstore-key-live? (vault-state-bs vault)) @@ -754,25 +805,27 @@ (reverse acc) (let* ([e (car es)] [cblk (car e)] - [cname (cdr e)]) + [cname (cadr e)] + [dtype (caddr e)]) (if (<= i offset) (loop (cdr es) (+ i 1) acc) - (let* ([child (read-inode - vault - cblk)] - [dtype (if child - (cond - [(= (vault-inode-type - child) - INODE-TYPE-DIR) - DT-DIR] - [(= (vault-inode-type - child) - INODE-TYPE-SYMLINK) - DT-LNK] - [else - DT-REG]) - DT-UNKNOWN)]) + (let ([final-dtype (if (= dtype + DT-UNKNOWN) + (begin + (vault-state-readdir-inode-reads-set! + vault + (+ (vault-state-readdir-inode-reads + vault) + 1)) + (let ([child (read-inode + vault + cblk)]) + (if child + (inode-type->d-type + (vault-inode-type + child)) + DT-UNKNOWN))) + dtype)]) (loop (cdr es) (+ i 1) @@ -780,7 +833,7 @@ (make-fuse-dirent cblk i - dtype + final-dtype cname) acc)))))))]) (append base children)) @@ -840,7 +893,7 @@ VAULT-BLOCK-INVALID)]) (write-inode! vault inode) (dir-add! vault parent-ino parent - new-blk name) + new-blk name INODE-TYPE-FILE) (write-inode! vault parent) (let ([fh (alloc-fh! vault new-blk)]) (cons @@ -874,7 +927,7 @@ VAULT-BLOCK-INVALID)]) (write-inode! vault inode) (dir-add! vault parent-ino parent - new-blk name) + new-blk name INODE-TYPE-DIR) (vault-inode-nlink-set! parent (+ (vault-inode-nlink parent) 1)) @@ -1004,7 +1057,9 @@ old-name) (dir-add! vault new-parent-ino new-parent child-blk - new-name) + new-name + (vault-inode-type + child-inode)) (when (= (vault-inode-type child-inode) INODE-TYPE-DIR) @@ -1031,8 +1086,9 @@ vault old-parent old-name) - (dir-add! vault new-parent-ino - new-parent child-blk new-name) + (dir-add! vault new-parent-ino new-parent + child-blk new-name + (vault-inode-type child-inode)) (when (= (vault-inode-type child-inode) INODE-TYPE-DIR) --- a/lib/jerboa-fuse/vault/format.sls +++ b/lib/jerboa-fuse/vault/format.sls @@ -9,10 +9,11 @@ VAULT-BLOCK-INVALID VAULT-MAX-FILENAME DIRECT-BLOCKS PTRS-PER-BLOCK DIRENT-SIZE DIRENTS-PER-BLOCK VAULT-MK-ENC-LEN VAULT-SB-ENC-LEN KDF-ITERATIONS - VAULT-KEY-LEN encode-vault-header decode-vault-header - encode-superblock decode-superblock encode-inode - decode-inode encode-dirent decode-dirent bv-u64le - bv-set-u64le! bv-u32le bv-set-u32le! bv-u8 bv-sub) + VAULT-KEY-LEN DIRENT-VERSION-V2 DIRENT-DTYPE-MARKER + encode-vault-header decode-vault-header encode-superblock + decode-superblock encode-inode decode-inode encode-dirent + decode-dirent encode-dirent-v2 decode-dirent-v2 dirent-v2? + bv-u64le bv-set-u64le! bv-u32le bv-set-u32le! bv-u8 bv-sub) (import (except (chezscheme) make-hash-table hash-table? sort sort! printf fprintf format path-extension path-absolute? @@ -42,6 +43,8 @@ (+ BLOCK-NONCE-LEN VAULT-KEY-LEN BLOCK-TAG-LEN)) (def VAULT-SB-ENC-LEN (+ BLOCK-NONCE-LEN 8 BLOCK-TAG-LEN)) (def KDF-ITERATIONS 600000) + (def DIRENT-VERSION-V2 2) + (def DIRENT-DTYPE-MARKER 128) (def (bv-u64le bv off) (let loop ([i 0] [acc 0]) (if (= i 8) @@ -101,18 +104,19 @@ (values magic ver blksz (bv-u64le bv 10) (bv-sub bv 18 32) kdf-iterations (bv-sub bv 58 VAULT-MK-ENC-LEN) (bv-sub bv 118 VAULT-SB-ENC-LEN))))) - (def (encode-superblock root-inode-block bitmap-start - bitmap-blocks generation policy-block) + (def (encode-superblock root-inode-block bitmap-start bitmap-blocks generation + policy-block dirent-version) (let ([bv (make-bytevector BLOCK-PAYLOAD 0)]) (bv-set-u64le! bv 0 root-inode-block) (bv-set-u64le! bv 8 bitmap-start) (bv-set-u64le! bv 16 bitmap-blocks) (bv-set-u64le! bv 24 generation) (bv-set-u64le! bv 32 policy-block) + (bv-set-u64le! bv 40 dirent-version) bv)) (def (decode-superblock bv) (values (bv-u64le bv 0) (bv-u64le bv 8) (bv-u64le bv 16) - (bv-u64le bv 24) (bv-u64le bv 32))) + (bv-u64le bv 24) (bv-u64le bv 32) (bv-u64le bv 40))) (def (encode-inode inode-num type mode uid gid size ctime mtime atime nlink name-bv direct-vec indirect) (let* ([bv (make-bytevector BLOCK-PAYLOAD 0)] @@ -165,4 +169,28 @@ (let* ([iblock (bv-u64le bv slot-offset)] [name-len (bv-u8 bv (+ slot-offset 8))] [name-bv (bv-sub bv (+ slot-offset 9) name-len)]) - (values iblock name-bv)))) + (values iblock name-bv))) + (def (encode-dirent-v2 inode-block name-bv d-type) + (let* ([bv (make-bytevector DIRENT-SIZE 0)] + [name-len (min (bytevector-length name-bv) 254)]) + (bv-set-u64le! bv 0 inode-block) + (bytevector-u8-set! bv 8 name-len) + (bytevector-u8-set! + bv + 9 + (bitwise-ior d-type DIRENT-DTYPE-MARKER)) + (when (> name-len 0) + (bytevector-copy! name-bv 0 bv 10 name-len)) + bv)) + (def (dirent-v2? bv slot-offset) + (and (not (zero? (bv-u64le bv slot-offset))) + (not (zero? + (bitwise-and + (bv-u8 bv (+ slot-offset 9)) + DIRENT-DTYPE-MARKER))))) + (def (decode-dirent-v2 bv slot-offset) + (let* ([iblock (bv-u64le bv slot-offset)] + [name-len (bv-u8 bv (+ slot-offset 8))] + [d-type (bitwise-and (bv-u8 bv (+ slot-offset 9)) 127)] + [name-bv (bv-sub bv (+ slot-offset 10) name-len)]) + (values iblock name-bv d-type)))) --- a/src/jerboa-fuse/vault.ss +++ b/src/jerboa-fuse/vault.ss @@ -11,7 +11,10 @@ vault-mount! ;; path passphrase mountpoint . opts → (cons vault session) vault-unmount! ;; (cons vault session) → void ;; Testing - vault-state-indirect-read-count) + vault-state-indirect-read-count + vault-state-readdir-inode-reads + vault-state-dirent-version + vault-state-dirent-version-set!) (import (jerboa prelude) @@ -68,7 +71,9 @@ (mutable mutex) (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 + (mutable indirect-read-count) ;; counter: actual blockstore reads for indirect blocks + (mutable dirent-version) ;; 0/1 = v1 (no d_type), 2 = v2 (d_type in dirents) + (mutable readdir-inode-reads))) ;; counter: read-inode calls from readdir (for testing) ;; 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 @@ -211,7 +216,8 @@ (vault-state-bitmap-start vault) (vault-state-bitmap-nblocks vault) gen - (vault-state-policy-block vault))))) + (vault-state-policy-block vault) + (vault-state-dirent-version vault))))) ;; ====================================================================== ;; File handle management @@ -422,9 +428,13 @@ ;; Directory operations ;; ====================================================================== + (def (inode-type->d-type type) + (cond + [(= type INODE-TYPE-DIR) DT-DIR] + [(= type INODE-TYPE-SYMLINK) DT-LNK] + [else DT-REG])) + (def (dir-lookup vault dir-inode name) - ;; Scan all directory data blocks for an entry matching name. - ;; Returns child block-num or #f. (let loop ([lidx 0]) (let ([phys (resolve-data-block vault dir-inode lidx)]) (if (not phys) #f @@ -433,26 +443,35 @@ (let slot-loop ([slot 0]) (if (>= slot DIRENTS-PER-BLOCK) (loop (+ lidx 1)) - (let-values ([(iblk nbv) (decode-dirent pay (* slot DIRENT-SIZE))]) - (cond - [(= iblk 0) (slot-loop (+ slot 1))] ;; free slot - [(string=? (utf8->string nbv) name) iblk] - [else (slot-loop (+ slot 1))])))))))))) - - (def (dir-add! vault dir-block-num dir-inode child-block-num name) - ;; Add a directory entry. Finds first free slot in existing blocks, - ;; or allocates a new data block. + (let ([off (* slot DIRENT-SIZE)]) + (if (dirent-v2? pay off) + (let-values ([(iblk nbv _dt) (decode-dirent-v2 pay off)]) + (cond + [(= iblk 0) (slot-loop (+ slot 1))] + [(string=? (utf8->string nbv) name) iblk] + [else (slot-loop (+ slot 1))])) + (let-values ([(iblk nbv) (decode-dirent pay off)]) + (cond + [(= iblk 0) (slot-loop (+ slot 1))] + [(string=? (utf8->string nbv) name) iblk] + [else (slot-loop (+ slot 1))])))))))))))) + + (def (dir-add! vault dir-block-num dir-inode child-block-num name child-type) (let ([name-bv (string->utf8 name)] - [done? #f]) + [done? #f] + [v2? (>= (vault-state-dirent-version vault) DIRENT-VERSION-V2)]) (let block-loop ([lidx 0]) (unless done? (let ([phys (resolve-data-block vault dir-inode lidx)]) (if (not phys) - ;; Need a new data block for the directory (let ([new-blk (ensure-data-block! vault dir-block-num dir-inode lidx)]) (when new-blk - (let ([pay (make-bytevector BLOCK-PAYLOAD 0)]) - (bytevector-copy! (encode-dirent child-block-num name-bv) 0 pay 0 DIRENT-SIZE) + (let ([pay (make-bytevector BLOCK-PAYLOAD 0)] + [enc (if v2? + (encode-dirent-v2 child-block-num name-bv + (inode-type->d-type child-type)) + (encode-dirent child-block-num name-bv))]) + (bytevector-copy! enc 0 pay 0 DIRENT-SIZE) (blockstore-write-block! (vault-state-bs vault) new-blk pay) (set! done? #t)))) (let ([pay (blockstore-read-block (vault-state-bs vault) phys)]) @@ -462,16 +481,16 @@ (block-loop (+ lidx 1)) (let-values ([(iblk nbv) (decode-dirent pay (* slot DIRENT-SIZE))]) (if (= iblk 0) - ;; Free slot - (begin - (bytevector-copy! (encode-dirent child-block-num name-bv) - 0 pay (* slot DIRENT-SIZE) DIRENT-SIZE) + (let ([enc (if v2? + (encode-dirent-v2 child-block-num name-bv + (inode-type->d-type child-type)) + (encode-dirent child-block-num name-bv))]) + (bytevector-copy! enc 0 pay (* slot DIRENT-SIZE) DIRENT-SIZE) (blockstore-write-block! (vault-state-bs vault) phys pay) (set! done? #t)) (slot-loop (+ slot 1)))))))))))))) (def (dir-remove! vault dir-inode name) - ;; Zero out the directory entry for name. Returns #t if found, #f if not. (let ([found? #f]) (let block-loop ([lidx 0]) (unless found? @@ -481,13 +500,15 @@ (when pay (let slot-loop ([slot 0]) (when (< slot DIRENTS-PER-BLOCK) - (let-values ([(iblk nbv) (decode-dirent pay (* slot DIRENT-SIZE))]) + (let* ([off (* slot DIRENT-SIZE)] + [nbv (if (dirent-v2? pay off) + (let-values ([(_i n _d) (decode-dirent-v2 pay off)]) n) + (let-values ([(_i n) (decode-dirent pay off)]) n))] + [iblk (bv-u64le pay off)]) (if (and (not (= iblk 0)) (string=? (utf8->string nbv) name)) - ;; Zero this slot (begin - (let ([off (* slot DIRENT-SIZE)]) - (bytevector-copy! *zero-block* 0 pay off DIRENT-SIZE)) + (bytevector-copy! *zero-block* 0 pay off DIRENT-SIZE) (blockstore-write-block! (vault-state-bs vault) phys pay) (set! found? #t)) (slot-loop (+ slot 1)))))))) @@ -495,7 +516,6 @@ found?)) (def (dir-list vault dir-inode) - ;; Returns list of (child-block-num . name-string) for all entries. (let ([result '()]) (let block-loop ([lidx 0]) (let ([phys (resolve-data-block vault dir-inode lidx)]) @@ -504,9 +524,14 @@ (when pay (let slot-loop ([slot 0]) (when (< slot DIRENTS-PER-BLOCK) - (let-values ([(iblk nbv) (decode-dirent pay (* slot DIRENT-SIZE))]) - (when (not (= iblk 0)) - (set! result (cons (cons iblk (utf8->string nbv)) result)))) + (let ([off (* slot DIRENT-SIZE)]) + (if (dirent-v2? pay off) + (let-values ([(iblk nbv dtype) (decode-dirent-v2 pay off)]) + (when (not (= iblk 0)) + (set! result (cons (list iblk (utf8->string nbv) dtype) result)))) + (let-values ([(iblk nbv) (decode-dirent pay off)]) + (when (not (= iblk 0)) + (set! result (cons (list iblk (utf8->string nbv) DT-UNKNOWN) result)))))) (slot-loop (+ slot 1))))) (block-loop (+ lidx 1)))))) (reverse result))) @@ -578,7 +603,9 @@ (make-mutex) 0 ;; bitmap-alloc-hint (make-eq-hashtable) ;; indirect-cache - 0)]) ;; indirect-read-count + 0 ;; indirect-read-count + DIRENT-VERSION-V2 ;; dirent-version + 0)]) ;; readdir-inode-reads ;; 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 @@ -640,9 +667,8 @@ (unless sb-pay (error 'vault-open "cannot read superblock")) (let-values ([(root-block bitmap-start bitmap-nblks generation - policy-block) + policy-block dirent-version) (decode-superblock sb-pay)]) - ;; Load bitmap into memory (let* ([bm-bytes (* bitmap-nblks BLOCK-PAYLOAD)] [bm (make-bytevector bm-bytes 0)]) (let loop ([i 0]) @@ -652,18 +678,19 @@ (let ([dst-off (* i BLOCK-PAYLOAD)]) (bytevector-copy! blk-pay 0 bm dst-off BLOCK-PAYLOAD)))) (loop (+ i 1)))) - ;; 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 - (make-eq-hashtable) ;; indirect-cache - 0))))))))))) ;; indirect-read-count + 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 + dirent-version ;; dirent-version from superblock + 0))))))))))) ;; readdir-inode-reads ;; ====================================================================== ;; vault-close! @@ -795,9 +822,6 @@ (let ([inode (read-inode vault ino)]) (if (and inode (= (vault-inode-type inode) INODE-TYPE-DIR)) (let* ([entries (dir-list vault inode)] - ;; Honor the readdir offset cookie: skip "." / ".." / children - ;; at or before `offset` while building, instead of building the - ;; whole list and filtering it afterwards. [base (append (if (> 1 offset) (list (make-fuse-dirent ino 1 DT-DIR ".")) '()) (if (> 2 offset) (list (make-fuse-dirent ino 2 DT-DIR "..")) '()))] [children @@ -805,18 +829,22 @@ (if (null? es) (reverse acc) (let* ([e (car es)] [cblk (car e)] - [cname (cdr e)]) + [cname (cadr e)] + [dtype (caddr e)]) (if (<= i offset) (loop (cdr es) (+ i 1) acc) - (let* ([child (read-inode vault cblk)] - [dtype (if child - (cond - [(= (vault-inode-type child) INODE-TYPE-DIR) DT-DIR] - [(= (vault-inode-type child) INODE-TYPE-SYMLINK) DT-LNK] - [else DT-REG]) - DT-UNKNOWN)]) + (let ([final-dtype + (if (= dtype DT-UNKNOWN) + (begin + (vault-state-readdir-inode-reads-set! vault + (+ (vault-state-readdir-inode-reads vault) 1)) + (let ([child (read-inode vault cblk)]) + (if child + (inode-type->d-type (vault-inode-type child)) + DT-UNKNOWN))) + dtype)]) (loop (cdr es) (+ i 1) - (cons (make-fuse-dirent cblk i dtype cname) acc)))))))]) + (cons (make-fuse-dirent cblk i final-dtype cname) acc)))))))]) (append base children)) '()))))) @@ -874,7 +902,7 @@ (make-vector DIRECT-BLOCKS VAULT-BLOCK-INVALID) VAULT-BLOCK-INVALID)]) (write-inode! vault inode) - (dir-add! vault parent-ino parent new-blk name) + (dir-add! vault parent-ino parent new-blk name INODE-TYPE-FILE) (write-inode! vault parent) (let ([fh (alloc-fh! vault new-blk)]) (cons (inode->fuse-entry inode) fh)))))))))))) @@ -902,7 +930,7 @@ (make-vector DIRECT-BLOCKS VAULT-BLOCK-INVALID) VAULT-BLOCK-INVALID)]) (write-inode! vault inode) - (dir-add! vault parent-ino parent new-blk name) + (dir-add! vault parent-ino parent new-blk name INODE-TYPE-DIR) (vault-inode-nlink-set! parent (+ (vault-inode-nlink parent) 1)) (write-inode! vault parent) (inode->fuse-entry inode))))))))))) @@ -987,8 +1015,9 @@ (vault-inode-nlink-set! new-parent (max 2 (- (vault-inode-nlink new-parent) 1)))) (dir-remove! vault new-parent new-name) - (dir-remove! vault old-parent old-name) - (dir-add! vault new-parent-ino new-parent child-blk new-name) + (dir-remove! vault old-parent old-name) + (dir-add! vault new-parent-ino new-parent child-blk new-name + (vault-inode-type child-inode)) (when (= (vault-inode-type child-inode) INODE-TYPE-DIR) (vault-inode-nlink-set! old-parent (max 2 (- (vault-inode-nlink old-parent) 1))) @@ -997,9 +1026,10 @@ (write-inode! vault old-parent) (write-inode! vault new-parent) #t]))) - (begin - (dir-remove! vault old-parent old-name) - (dir-add! vault new-parent-ino new-parent child-blk new-name) + (begin + (dir-remove! vault old-parent old-name) + (dir-add! vault new-parent-ino new-parent child-blk new-name + (vault-inode-type child-inode)) (when (= (vault-inode-type child-inode) INODE-TYPE-DIR) (vault-inode-nlink-set! old-parent (max 2 (- (vault-inode-nlink old-parent) 1))) --- a/src/jerboa-fuse/vault/format.ss +++ b/src/jerboa-fuse/vault/format.ss @@ -6,6 +6,7 @@ VAULT-BLOCK-INVALID VAULT-MAX-FILENAME DIRECT-BLOCKS PTRS-PER-BLOCK DIRENT-SIZE DIRENTS-PER-BLOCK VAULT-MK-ENC-LEN VAULT-SB-ENC-LEN KDF-ITERATIONS VAULT-KEY-LEN + DIRENT-VERSION-V2 DIRENT-DTYPE-MARKER ;; Header codec encode-vault-header decode-vault-header ;; Superblock codec @@ -14,6 +15,7 @@ encode-inode decode-inode ;; DirEntry codec encode-dirent decode-dirent + encode-dirent-v2 decode-dirent-v2 dirent-v2? ;; Binary helpers bv-u64le bv-set-u64le! bv-u32le bv-set-u32le! bv-u8 bv-sub) @@ -43,6 +45,8 @@ (def VAULT-MK-ENC-LEN (+ BLOCK-NONCE-LEN VAULT-KEY-LEN BLOCK-TAG-LEN)) ;; 60 (def VAULT-SB-ENC-LEN (+ BLOCK-NONCE-LEN 8 BLOCK-TAG-LEN)) ;; 36 (def KDF-ITERATIONS 600000) + (def DIRENT-VERSION-V2 2) + (def DIRENT-DTYPE-MARKER #x80) ;; ---- Binary helpers ---- ;; All on-disk multi-byte values are little-endian. @@ -141,27 +145,28 @@ ;; 16 8 bitmap_blocks (u64 LE) ;; 24 8 generation (u64 LE) ;; 32 8 policy_block (u64 LE, VAULT-BLOCK-INVALID = none) - ;; 40 4028 padding + ;; 40 8 dirent_version (u64 LE, 0/1 = v1 no d_type, 2 = v2 with d_type) + ;; 48 4020 padding (def (encode-superblock root-inode-block bitmap-start bitmap-blocks - generation policy-block) + generation policy-block dirent-version) (let ([bv (make-bytevector BLOCK-PAYLOAD 0)]) (bv-set-u64le! bv 0 root-inode-block) (bv-set-u64le! bv 8 bitmap-start) (bv-set-u64le! bv 16 bitmap-blocks) (bv-set-u64le! bv 24 generation) (bv-set-u64le! bv 32 policy-block) + (bv-set-u64le! bv 40 dirent-version) bv)) (def (decode-superblock bv) - ;; Returns: (values root-inode-block bitmap-start bitmap-blocks - ;; generation policy-block) (values (bv-u64le bv 0) (bv-u64le bv 8) (bv-u64le bv 16) (bv-u64le bv 24) - (bv-u64le bv 32))) + (bv-u64le bv 32) + (bv-u64le bv 40))) ;; ---- Inode ---- ;; Encrypted; occupies one BLOCK-PAYLOAD-byte block. @@ -256,11 +261,37 @@ bv)) (def (decode-dirent bv slot-offset) - ;; Reads one dirent from bv at byte offset slot-offset. - ;; Returns: (values inode-block name-bv) - ;; inode-block == 0 means free slot. (let* ([iblock (bv-u64le bv slot-offset)] [name-len (bv-u8 bv (+ slot-offset 8))] [name-bv (bv-sub bv (+ slot-offset 9) name-len)]) (values iblock name-bv))) + ;; ---- DirEntry v2 (with d_type) ---- + ;; Same DIRENT-SIZE = 264 bytes. + ;; Offset Size Field + ;; 0 8 inode_block (u64 LE; 0 = free slot) + ;; 8 1 name_len (u8, max 254) + ;; 9 1 d_type | 0x80 (marker bit distinguishes from v1) + ;; 10 254 name (bytes) + + (def (encode-dirent-v2 inode-block name-bv d-type) + (let* ([bv (make-bytevector DIRENT-SIZE 0)] + [name-len (min (bytevector-length name-bv) 254)]) + (bv-set-u64le! bv 0 inode-block) + (bytevector-u8-set! bv 8 name-len) + (bytevector-u8-set! bv 9 (bitwise-ior d-type DIRENT-DTYPE-MARKER)) + (when (> name-len 0) + (bytevector-copy! name-bv 0 bv 10 name-len)) + bv)) + + (def (dirent-v2? bv slot-offset) + (and (not (zero? (bv-u64le bv slot-offset))) + (not (zero? (bitwise-and (bv-u8 bv (+ slot-offset 9)) DIRENT-DTYPE-MARKER))))) + + (def (decode-dirent-v2 bv slot-offset) + (let* ([iblock (bv-u64le bv slot-offset)] + [name-len (bv-u8 bv (+ slot-offset 8))] + [d-type (bitwise-and (bv-u8 bv (+ slot-offset 9)) #x7f)] + [name-bv (bv-sub bv (+ slot-offset 10) name-len)]) + (values iblock name-bv d-type))) + --- a/tests/test-vault.ss +++ b/tests/test-vault.ss @@ -17,6 +17,11 @@ (begin (set! fail (+ fail 1)) (display " FAIL: ") (display name) (newline)))) +(define (find-entry pred lst) + (cond [(null? lst) #f] + [(pred (car lst)) (car lst)] + [else (find-entry pred (cdr lst))])) + (define test-dir "tests/tmp") (define test-path (string-append test-dir "/jerboa-vault-test.bin")) @@ -292,6 +297,120 @@ (vault-close! v-inv) (cleanup) +(display "=== d_type backward compat (v1 vault) ===") (newline) + +(define v-v1 (vault-create! test-path "secret123" 256)) +(vault-state-dirent-version-set! v-v1 0) +(define ops-v1 (vault->fuse-ops v-v1)) +(define (v1-op key) (eq-hashtable-ref ops-v1 key #f)) + +(define v1-file ((v1-op 'create) FUSE-ROOT-ID "old.txt" #o0644 0 ctx-cache)) +(define v1-file-ino (fuse-entry-nodeid (car v1-file))) +((v1-op 'release) v1-file-ino (cdr v1-file) ctx-cache) +((v1-op 'mkdir) FUSE-ROOT-ID "olddir" #o0755 ctx-cache) + +(vault-close! v-v1) + +(define v-v1-reopen (vault-open test-path "secret123")) +(test-assert "v1 vault: dirent-version persisted as 0" + (= (vault-state-dirent-version v-v1-reopen) 0)) +(define ops-v1r (vault->fuse-ops v-v1-reopen)) +(define (v1r-op key) (eq-hashtable-ref ops-v1r key #f)) + +(define v1-dirents ((v1r-op 'readdir) FUSE-ROOT-ID 0 0 ctx-cache)) +(test-assert "v1 vault: readdir returns entries" + (and (list? v1-dirents) (>= (length v1-dirents) 4))) +(test-assert "v1 vault: readdir uses read-inode fallback (inode reads > 0)" + (> (vault-state-readdir-inode-reads v-v1-reopen) 0)) +(define v1-file-entry + (find-entry (lambda (d) (string=? (fuse-dirent-name d) "old.txt")) v1-dirents)) +(test-assert "v1 vault: file d_type is DT_REG via fallback" + (and v1-file-entry (= (fuse-dirent-type v1-file-entry) DT-REG))) +(define v1-dir-entry + (find-entry (lambda (d) (string=? (fuse-dirent-name d) "olddir")) v1-dirents)) +(test-assert "v1 vault: dir d_type is DT_DIR via fallback" + (and v1-dir-entry (= (fuse-dirent-type v1-dir-entry) DT-DIR))) + +(vault-close! v-v1-reopen) +(cleanup) + +(display "=== d_type new format (v2 vault) ===") (newline) + +(define v-v2 (vault-create! test-path "secret123" 256)) +(define ops-v2 (vault->fuse-ops v-v2)) +(define (v2-op key) (eq-hashtable-ref ops-v2 key #f)) + +(define v2-file ((v2-op 'create) FUSE-ROOT-ID "new.txt" #o0644 0 ctx-cache)) +(define v2-file-ino (fuse-entry-nodeid (car v2-file))) +((v2-op 'release) v2-file-ino (cdr v2-file) ctx-cache) +((v2-op 'mkdir) FUSE-ROOT-ID "newdir" #o0755 ctx-cache) + +(vault-close! v-v2) + +(define v-v2-reopen (vault-open test-path "secret123")) +(test-assert "v2 vault: dirent-version persisted as 2" + (= (vault-state-dirent-version v-v2-reopen) DIRENT-VERSION-V2)) +(define ops-v2r (vault->fuse-ops v-v2-reopen)) +(define (v2r-op key) (eq-hashtable-ref ops-v2r key #f)) + +(define reads-before (vault-state-readdir-inode-reads v-v2-reopen)) +(define v2-dirents ((v2r-op 'readdir) FUSE-ROOT-ID 0 0 ctx-cache)) +(define reads-after (vault-state-readdir-inode-reads v-v2-reopen)) + +(test-assert "v2 vault: readdir returns entries" + (and (list? v2-dirents) (>= (length v2-dirents) 4))) +(test-assert "v2 vault: readdir does NOT call read-inode for d_type" + (= reads-before reads-after)) +(define v2-file-entry + (find-entry (lambda (d) (string=? (fuse-dirent-name d) "new.txt")) v2-dirents)) +(test-assert "v2 vault: file d_type is DT_REG from dirent" + (and v2-file-entry (= (fuse-dirent-type v2-file-entry) DT-REG))) +(define v2-dir-entry + (find-entry (lambda (d) (string=? (fuse-dirent-name d) "newdir")) v2-dirents)) +(test-assert "v2 vault: dir d_type is DT_DIR from dirent" + (and v2-dir-entry (= (fuse-dirent-type v2-dir-entry) DT-DIR))) + +(vault-close! v-v2-reopen) +(cleanup) + +(display "=== d_type migration (v1 -> v2 lazy upgrade) ===") (newline) + +(define v-mig (vault-create! test-path "secret123" 256)) +(vault-state-dirent-version-set! v-mig 0) +(define ops-mig (vault->fuse-ops v-mig)) +(define (mig-op key) (eq-hashtable-ref ops-mig key #f)) + +(define mig-old ((mig-op 'create) FUSE-ROOT-ID "before.txt" #o0644 0 ctx-cache)) +((mig-op 'release) (fuse-entry-nodeid (car mig-old)) (cdr mig-old) ctx-cache) + +(vault-state-dirent-version-set! v-mig DIRENT-VERSION-V2) +(define mig-new ((mig-op 'create) FUSE-ROOT-ID "after.txt" #o0644 0 ctx-cache)) +((mig-op 'release) (fuse-entry-nodeid (car mig-new)) (cdr mig-new) ctx-cache) + +(vault-close! v-mig) + +(define v-mig-reopen (vault-open test-path "secret123")) +(define ops-migr (vault->fuse-ops v-mig-reopen)) +(define (migr-op key) (eq-hashtable-ref ops-migr key #f)) + +(define mig-dirents ((migr-op 'readdir) FUSE-ROOT-ID 0 0 ctx-cache)) +(define mig-old-entry + (find-entry (lambda (d) (string=? (fuse-dirent-name d) "before.txt")) mig-dirents)) +(define mig-new-entry + (find-entry (lambda (d) (string=? (fuse-dirent-name d) "after.txt")) mig-dirents)) +(test-assert "mixed: old v1 dirent still found and has correct d_type via fallback" + (and mig-old-entry (= (fuse-dirent-type mig-old-entry) DT-REG))) +(test-assert "mixed: new v2 dirent found with d_type stored in dirent" + (and mig-new-entry (= (fuse-dirent-type mig-new-entry) DT-REG))) + +(test-assert "mixed: lookup old entry works" + (fuse-entry? ((migr-op 'lookup) FUSE-ROOT-ID "before.txt" ctx-cache))) +(test-assert "mixed: lookup new entry works" + (fuse-entry? ((migr-op 'lookup) FUSE-ROOT-ID "after.txt" ctx-cache))) + +(vault-close! v-mig-reopen) +(cleanup) + (display "=== Summary ===") (newline) (display "PASS: ") (display pass) (newline) (display "FAIL: ") (display fail) (newline)