+8 -8

fuzz/fuzz_squashfs.ml

reviewed

··· 138 138 139 139 (* Property W1: Finalize never crashes regardless of content *) 140 140 let test_writer_finalize_no_crash content = 141 141 - let fs = Writer.create () in 141 141 + let fs = Writer.v () in 142 142 Writer.add_file fs "test.bin" ~mode:0o644 content; 143 143 let _image = Writer.finalize fs in 144 144 () 145 145 146 146 (* Property W2: Written image is always parseable *) 147 147 let test_writer_roundtrip content = 148 148 - let fs = Writer.create () in 148 148 + let fs = Writer.v () in 149 149 Writer.add_file fs "test.bin" ~mode:0o644 content; 150 150 let image = Writer.finalize fs in 151 151 match Squashfs.of_string image with ··· 154 154 155 155 (* Property W3: Multiple files with arbitrary content *) 156 156 let test_writer_multiple_files content1 content2 content3 = 157 157 - let fs = Writer.create () in 157 157 + let fs = Writer.v () in 158 158 Writer.add_file fs "a.bin" ~mode:0o644 content1; 159 159 Writer.add_file fs "b.bin" ~mode:0o644 content2; 160 160 Writer.add_file fs "c.bin" ~mode:0o644 content3; ··· 168 168 let depth = min depth 10 in 169 169 (* Limit depth to avoid explosion *) 170 170 if depth > 0 then begin 171 171 - let fs = Writer.create () in 171 171 + let fs = Writer.v () in 172 172 let path = 173 173 String.concat "/" (List.init depth (fun i -> Printf.sprintf "d%d" i)) 174 174 in ··· 193 193 (* Empty target should be rejected *) 194 194 () 195 195 else begin 196 196 - let fs = Writer.create () in 196 196 + let fs = Writer.v () in 197 197 Writer.add_symlink fs "link" target; 198 198 let image = Writer.finalize fs in 199 199 match Squashfs.of_string image with ··· 203 203 204 204 (* Property W6: Device nodes with arbitrary major/minor *) 205 205 let test_writer_device major minor = 206 206 - let fs = Writer.create () in 206 206 + let fs = Writer.v () in 207 207 Writer.add_device fs "dev" ~mode:0o666 ~char:true ~major ~minor; 208 208 let image = Writer.finalize fs in 209 209 match Squashfs.of_string image with ··· 216 216 (* Cap at 1MB for fuzzing *) 217 217 if size > 0 then begin 218 218 let content = String.make size 'x' in 219 219 - let fs = Writer.create () in 219 219 + let fs = Writer.v () in 220 220 Writer.add_file fs "large.bin" ~mode:0o644 content; 221 221 let image = Writer.finalize fs in 222 222 match Squashfs.of_string image with ··· 229 229 let size = min size 20000 in 230 230 if size >= 100 then begin 231 231 let compressible = String.make size 'a' in 232 232 - let fs = Writer.create ~compression:Gzip () in 232 232 + let fs = Writer.v ~compression:Gzip () in 233 233 Writer.add_file fs "comp.txt" ~mode:0o644 compressible; 234 234 let image = Writer.finalize fs in 235 235 (* SquashFS has significant block/alignment overhead (16KB minimum).

+14 -14

lib/squashfs.ml

reviewed

··· 164 164 165 165 (* Binary reading helpers — kept for single-field reads at dynamic offsets 166 166 (metadata block headers, ID table entries) *) 167 167 - let get_u16_le s off = 167 167 + let u16_le s off = 168 168 let b0 = Char.code (String.get s off) in 169 169 let b1 = Char.code (String.get s (off + 1)) in 170 170 b0 lor (b1 lsl 8) 171 171 172 172 - let get_u32_le s off = 172 172 + let u32_le s off = 173 173 Int32.to_int 174 174 (Int32.logor 175 175 - (Int32.of_int (get_u16_le s off)) 176 176 - (Int32.shift_left (Int32.of_int (get_u16_le s (off + 2))) 16)) 175 175 + (Int32.of_int (u16_le s off)) 176 176 + (Int32.shift_left (Int32.of_int (u16_le s (off + 2))) 16)) 177 177 178 178 - let get_u64_le s off = 178 178 + let u64_le s off = 179 179 Int64.logor 180 180 - (Int64.of_int (get_u32_le s off)) 181 181 - (Int64.shift_left (Int64.of_int (get_u32_le s (off + 4))) 32) 180 180 + (Int64.of_int (u32_le s off)) 181 181 + (Int64.shift_left (Int64.of_int (u32_le s (off + 4))) 32) 182 182 183 183 (* --- Wire codecs for on-disk structures --- *) 184 184 ··· 462 462 if offset < 0 || offset + 2 > String.length t.data then 463 463 Error "metadata block offset out of bounds" 464 464 else 465 465 - let header = get_u16_le t.data offset in 465 465 + let header = u16_le t.data offset in 466 466 let compressed = header land 0x8000 = 0 in 467 467 let size = header land 0x7fff in 468 468 if offset + 2 + size > String.length t.data then ··· 621 621 with 622 622 | Error e -> Error e 623 623 | Ok () -> ( 624 624 - let header = get_u16_le data block_offset in 624 624 + let header = u16_le data block_offset in 625 625 let compressed = header land 0x8000 = 0 in 626 626 let size = header land 0x7fff in 627 627 if compressed then Error "compressed ID table not yet supported" ··· 634 634 | Ok () -> 635 635 let table = Array.make count 0 in 636 636 for i = 0 to min count (size / 4) - 1 do 637 637 - table.(i) <- get_u32_le data (block_offset + 2 + (i * 4)) 637 637 + table.(i) <- u32_le data (block_offset + 2 + (i * 4)) 638 638 done; 639 639 Ok table) 640 640 ··· 644 644 if count = 0 then Ok [||] 645 645 else if count > 65536 then Error "id_count exceeds maximum (65536)" 646 646 else 647 647 - let block_ptr_offset = Int64.to_int (get_u64_le data 48) in 647 647 + let block_ptr_offset = Int64.to_int (u64_le data 48) in 648 648 match 649 649 check_bounds ~data_len ~offset:block_ptr_offset ~size:8 "ID table pointer" 650 650 with 651 651 | Error e -> Error e 652 652 | Ok () -> 653 653 - let block_offset = Int64.to_int (get_u64_le data block_ptr_offset) in 653 653 + let block_offset = Int64.to_int (u64_le data block_ptr_offset) in 654 654 read_id_table_block data ~data_len ~block_offset ~count 655 655 656 656 (* Read root inode *) ··· 864 864 let size = Int64.to_int file_size in 865 865 if abs_offset + size <= String.length t.data then 866 866 (* Try reading as uncompressed first *) 867 867 - let header = get_u16_le t.data abs_offset in 867 867 + let header = u16_le t.data abs_offset in 868 868 let compressed = header land 0x8000 = 0 in 869 869 let block_size = header land 0x7fff in 870 870 if ··· 902 902 (* Extended attributes *) 903 903 let has_xattrs t = t.xattr_table_start <> 0xffffffffffffffffL 904 904 905 905 - let get_xattr _t _inode _name = 905 905 + let xattr _t _inode _name = 906 906 (* TODO: implement xattr reading *) 907 907 Ok None 908 908

+3 -3

lib/squashfs.mli

reviewed

··· 226 226 val has_xattrs : t -> bool 227 227 (** [has_xattrs t] returns [true] if the filesystem has extended attributes. *) 228 228 229 229 - val get_xattr : t -> inode -> string -> (string option, string) result 230 230 - (** [get_xattr t inode name] gets an extended attribute value. Returns [None] if 231 231 - the attribute doesn't exist. *) 229 229 + val xattr : t -> inode -> string -> (string option, string) result 230 230 + (** [xattr t inode name] gets an extended attribute value. Returns [None] if the 231 231 + attribute doesn't exist. *) 232 232 233 233 val list_xattrs : t -> inode -> (string list, string) result 234 234 (** [list_xattrs t inode] lists all extended attribute names. *)

+7 -10

lib/squashfs_writer.ml

reviewed

··· 359 359 | _ -> failwith "only gzip compression is currently supported" 360 360 361 361 (* Create a metadata block - returns (compressed_data, is_compressed) *) 362 362 - let make_metadata_block t data = 362 362 + let metadata_block t data = 363 363 (* SquashFS metadata blocks must not exceed 8KB uncompressed *) 364 364 if String.length data > metadata_block_size then 365 365 invalid_arg ··· 373 373 374 374 (* Write a metadata block with header *) 375 375 let write_metadata_block t buf = 376 376 - let data, compressed = make_metadata_block t (Buffer.contents buf) in 376 376 + let data, compressed = metadata_block t (Buffer.contents buf) in 377 377 let len = String.length data in 378 378 let header = if compressed then len else len lor 0x8000 in 379 379 let result = Bytes.create (2 + len) in ··· 382 382 Bytes.to_string result 383 383 384 384 (* Create filesystem builder *) 385 385 - let create ?(compression = Gzip) ?(block_size = default_block_size) ?(mtime = 0) 386 386 - () = 385 385 + let v ?(compression = Gzip) ?(block_size = default_block_size) ?(mtime = 0) () = 387 386 (* Validate block_size is power of 2 and in range *) 388 387 if block_size < 4096 || block_size > 1048576 then 389 388 invalid_arg "block_size must be between 4096 and 1048576"; ··· 402 401 } 403 402 404 403 (* Find or create path to entry *) 405 405 - let rec find_or_create_dir t components current = 404 404 + let rec ensure_dir t components current = 406 405 match components with 407 406 | [] -> current 408 407 | name :: rest -> ( ··· 411 410 in 412 411 match existing with 413 412 | Some (Dir { mode; children }) -> 414 414 - let new_children = find_or_create_dir t rest children in 413 413 + let new_children = ensure_dir t rest children in 415 414 List.map 416 415 (fun (n, e) -> 417 416 if n = name then (n, Dir { mode; children = new_children }) ··· 420 419 | Some _ -> 421 420 invalid_arg (Fmt.str "path component %s is not a directory" name) 422 421 | None -> 423 423 - let new_dir = 424 424 - Dir { mode = 0o755; children = find_or_create_dir t rest [] } 425 425 - in 422 422 + let new_dir = Dir { mode = 0o755; children = ensure_dir t rest [] } in 426 423 (name, new_dir) :: current) 427 424 428 425 let add_entry t path entry = ··· 439 436 t.root <- (name, entry) :: List.filter (fun (n, _) -> n <> name) t.root 440 437 else begin 441 438 (* Create parent directories if needed *) 442 442 - t.root <- find_or_create_dir t parent_path t.root; 439 439 + t.root <- ensure_dir t parent_path t.root; 443 440 (* Now add the entry *) 444 441 let rec add_to_path components current = 445 442 match components with

+5 -6

lib/squashfs_writer.mli

reviewed

··· 12 12 13 13 {[ 14 14 (* Create a simple squashfs image *) 15 15 - let fs = Squashfs_writer.create () in 15 15 + let fs = Squashfs_writer.v () in 16 16 Squashfs_writer.add_directory fs "/" ~mode:0o755; 17 17 Squashfs_writer.add_directory fs "/bin" ~mode:0o755; 18 18 Squashfs_writer.add_file fs "/bin/hello" ~mode:0o755 ··· 28 28 selected at creation time: 29 29 30 30 {[ 31 31 - let fs = Squashfs_writer.create ~compression:Squashfs.Zstd () in 31 31 + let fs = Squashfs_writer.v ~compression:Squashfs.Zstd () in 32 32 ]} 33 33 34 34 {2 Security Considerations} ··· 65 65 66 66 (** {1 Creation} *) 67 67 68 68 - val create : 69 69 - ?compression:compression -> ?block_size:int -> ?mtime:int -> unit -> t 70 70 - (** [create ?compression ?block_size ?mtime ()] creates a new squashfs 71 71 - filesystem builder. 68 68 + val v : ?compression:compression -> ?block_size:int -> ?mtime:int -> unit -> t 69 69 + (** [v ?compression ?block_size ?mtime ()] creates a new squashfs filesystem 70 70 + builder. 72 71 73 72 @param compression Compression algorithm (default: Gzip). 74 73 @param block_size

+21 -21

test/test_squashfs_writer.ml

reviewed

··· 13 13 14 14 (* Test: empty filesystem has valid structure *) 15 15 let test_empty_fs () = 16 16 - let fs = Writer.create () in 16 16 + let fs = Writer.v () in 17 17 let image = Writer.finalize fs in 18 18 (* Check minimum size - at least superblock *) 19 19 Alcotest.(check bool) "image >= 96 bytes" true (String.length image >= 96); ··· 28 28 29 29 (* Test: add file and verify it roundtrips *) 30 30 let test_add_file () = 31 31 - let fs = Writer.create () in 31 31 + let fs = Writer.v () in 32 32 Writer.add_file fs "hello.txt" ~mode:0o644 "Hello, World!"; 33 33 let image = Writer.finalize fs in 34 34 (* Parse it back *) ··· 45 45 46 46 (* Test: add directory *) 47 47 let test_add_directory () = 48 48 - let fs = Writer.create () in 48 48 + let fs = Writer.v () in 49 49 Writer.add_directory fs "mydir" ~mode:0o755; 50 50 Writer.add_file fs "mydir/file.txt" ~mode:0o644 "content"; 51 51 let image = Writer.finalize fs in ··· 68 68 69 69 (* Test: add symlink *) 70 70 let test_add_symlink () = 71 71 - let fs = Writer.create () in 71 71 + let fs = Writer.v () in 72 72 Writer.add_file fs "target.txt" ~mode:0o644 "target content"; 73 73 Writer.add_symlink fs "link.txt" "target.txt"; 74 74 let image = Writer.finalize fs in ··· 87 87 88 88 (* Test: add device nodes *) 89 89 let test_add_device () = 90 90 - let fs = Writer.create () in 90 90 + let fs = Writer.v () in 91 91 Writer.add_device fs "null" ~mode:0o666 ~char:true ~major:1 ~minor:3; 92 92 Writer.add_device fs "sda" ~mode:0o660 ~char:false ~major:8 ~minor:0; 93 93 let image = Writer.finalize fs in ··· 101 101 102 102 (* Test: add fifo and socket *) 103 103 let test_add_ipc () = 104 104 - let fs = Writer.create () in 104 104 + let fs = Writer.v () in 105 105 Writer.add_fifo fs "myfifo" ~mode:0o644; 106 106 Writer.add_socket fs "mysocket" ~mode:0o644; 107 107 let image = Writer.finalize fs in ··· 115 115 116 116 (* Test: statistics *) 117 117 let test_stats () = 118 118 - let fs = Writer.create () in 118 118 + let fs = Writer.v () in 119 119 Writer.add_directory fs "dir1" ~mode:0o755; 120 120 Writer.add_directory fs "dir2" ~mode:0o755; 121 121 Writer.add_file fs "file1.txt" ~mode:0o644 "content1"; ··· 131 131 132 132 (* Test: path validation - absolute paths rejected *) 133 133 let test_reject_absolute_path () = 134 134 - let fs = Writer.create () in 134 134 + let fs = Writer.v () in 135 135 Alcotest.check_raises "absolute path rejected" 136 136 (Invalid_argument "absolute paths not allowed") (fun () -> 137 137 Writer.add_file fs "/etc/passwd" ~mode:0o644 "bad") 138 138 139 139 (* Test: path validation - traversal rejected *) 140 140 let test_reject_traversal () = 141 141 - let fs = Writer.create () in 141 141 + let fs = Writer.v () in 142 142 Alcotest.check_raises "traversal rejected" 143 143 (Invalid_argument "path traversal (..) not allowed") (fun () -> 144 144 Writer.add_file fs "../etc/passwd" ~mode:0o644 "bad") 145 145 146 146 (* Test: empty symlink target rejected *) 147 147 let test_reject_empty_symlink () = 148 148 - let fs = Writer.create () in 148 148 + let fs = Writer.v () in 149 149 Alcotest.check_raises "empty symlink rejected" 150 150 (Invalid_argument "symlink target cannot be empty") (fun () -> 151 151 Writer.add_symlink fs "link" "") ··· 153 153 (* Test: block size validation *) 154 154 let test_block_size_validation () = 155 155 (* Valid power of 2 *) 156 156 - let _ = Writer.create ~block_size:4096 () in 157 157 - let _ = Writer.create ~block_size:131072 () in 158 158 - let _ = Writer.create ~block_size:1048576 () in 156 156 + let _ = Writer.v ~block_size:4096 () in 157 157 + let _ = Writer.v ~block_size:131072 () in 158 158 + let _ = Writer.v ~block_size:1048576 () in 159 159 (* Invalid: not power of 2 *) 160 160 Alcotest.check_raises "non-power-of-2 rejected" 161 161 (Invalid_argument "block_size must be a power of 2") (fun () -> 162 162 - ignore (Writer.create ~block_size:5000 ())); 162 162 + ignore (Writer.v ~block_size:5000 ())); 163 163 (* Invalid: too small *) 164 164 Alcotest.check_raises "too small rejected" 165 165 (Invalid_argument "block_size must be between 4096 and 1048576") (fun () -> 166 166 - ignore (Writer.create ~block_size:2048 ())); 166 166 + ignore (Writer.v ~block_size:2048 ())); 167 167 (* Invalid: too large *) 168 168 Alcotest.check_raises "too large rejected" 169 169 (Invalid_argument "block_size must be between 4096 and 1048576") (fun () -> 170 170 - ignore (Writer.create ~block_size:2097152 ())) 170 170 + ignore (Writer.v ~block_size:2097152 ())) 171 171 172 172 (* Test: compression types *) 173 173 let test_compression_gzip () = 174 174 - let fs = Writer.create ~compression:Gzip () in 174 174 + let fs = Writer.v ~compression:Gzip () in 175 175 Writer.add_file fs "test.txt" ~mode:0o644 (String.make 10000 'x'); 176 176 (* Compressible content *) 177 177 let image = Writer.finalize fs in ··· 186 186 (* Test: nested directories - verifies structure is created correctly. 187 187 Note: Full path resolution requires reader fix for inode lookup. *) 188 188 let test_nested_directories () = 189 189 - let fs = Writer.create () in 189 189 + let fs = Writer.v () in 190 190 Writer.add_directory fs "a" ~mode:0o755; 191 191 Writer.add_directory fs "a/b" ~mode:0o755; 192 192 Writer.add_directory fs "a/b/c" ~mode:0o755; ··· 209 209 (* Test: implicit parent creation - verifies dirs are auto-created. 210 210 Note: Full path resolution requires reader fix for inode lookup. *) 211 211 let test_implicit_parent () = 212 212 - let fs = Writer.create () in 212 212 + let fs = Writer.v () in 213 213 (* Add file without explicitly creating parent dirs *) 214 214 Writer.add_file fs "x/y/z/file.txt" ~mode:0o644 "content"; 215 215 let image = Writer.finalize fs in ··· 229 229 230 230 (* Test: overwrite existing file *) 231 231 let test_overwrite_file () = 232 232 - let fs = Writer.create () in 232 232 + let fs = Writer.v () in 233 233 Writer.add_file fs "test.txt" ~mode:0o644 "original"; 234 234 Writer.add_file fs "test.txt" ~mode:0o644 "updated"; 235 235 let stats = Writer.stats fs in ··· 237 237 238 238 (* Test: write to bytesrw writer *) 239 239 let test_write_to_writer () = 240 240 - let fs = Writer.create () in 240 240 + let fs = Writer.v () in 241 241 Writer.add_file fs "test.txt" ~mode:0o644 "content"; 242 242 let buf = Buffer.create 1024 in 243 243 let writer = Bytesrw.Bytes.Writer.of_buffer buf in