SquashFS compressed filesystem reader in pure OCaml
fix(lint): replace Printf/Format with Fmt across remaining packages
Migrate Printf.sprintf to Fmt.str, Format.fprintf to Fmt.pf, and
Format.pp_print_string to Fmt.string across bundle, gpt, hap, homebrew,
jsonwt, matter, mbr, meross, paseto, precommit, publicsuffix, qemu,
retry, sdnv, slack, sle, space-packet, spake2, sqlite, squashfs, tar,
tc, tcf, tcpcl, tm, tomlt, tty, uslp, vlog, wal, wire, yamlrw, yamlt,
osrelease, space, xdge, and crypto test runner.
+37
-44
+1
-1
lib/dune
+1
-1
lib/dune
+32
-37
lib/squashfs.ml
+32
-37
lib/squashfs.ml
···
19
19
20
20
let check_bounds ~data_len ~offset ~size name =
21
21
if offset < 0 || offset + size > data_len then
22
-
Error (Printf.sprintf "%s out of bounds" name)
22
+
Error (Fmt.str "%s out of bounds" name)
23
23
else Ok ()
24
24
25
25
let is_path_traversal target =
···
39
39
| 4 -> Ok Xz
40
40
| 5 -> Ok Lz4
41
41
| 6 -> Ok Zstd
42
-
| n -> Error (Printf.sprintf "unknown compression type: %d" n)
42
+
| n -> Error (Fmt.str "unknown compression type: %d" n)
43
43
44
44
let pp_compression ppf = function
45
-
| Gzip -> Format.fprintf ppf "gzip"
46
-
| Lzma -> Format.fprintf ppf "lzma"
47
-
| Lzo -> Format.fprintf ppf "lzo"
48
-
| Xz -> Format.fprintf ppf "xz"
49
-
| Lz4 -> Format.fprintf ppf "lz4"
50
-
| Zstd -> Format.fprintf ppf "zstd"
45
+
| Gzip -> Fmt.pf ppf "gzip"
46
+
| Lzma -> Fmt.pf ppf "lzma"
47
+
| Lzo -> Fmt.pf ppf "lzo"
48
+
| Xz -> Fmt.pf ppf "xz"
49
+
| Lz4 -> Fmt.pf ppf "lz4"
50
+
| Zstd -> Fmt.pf ppf "zstd"
51
51
52
52
(* File types *)
53
53
type file_type =
···
75
75
| 12 -> Ok Char_device
76
76
| 13 -> Ok Fifo
77
77
| 14 -> Ok Socket
78
-
| n -> Error (Printf.sprintf "unknown inode type: %d" n)
78
+
| n -> Error (Fmt.str "unknown inode type: %d" n)
79
79
80
80
let pp_file_type ppf = function
81
-
| Directory -> Format.fprintf ppf "directory"
82
-
| Regular -> Format.fprintf ppf "regular"
83
-
| Symlink -> Format.fprintf ppf "symlink"
84
-
| Block_device -> Format.fprintf ppf "block_device"
85
-
| Char_device -> Format.fprintf ppf "char_device"
86
-
| Fifo -> Format.fprintf ppf "fifo"
87
-
| Socket -> Format.fprintf ppf "socket"
81
+
| Directory -> Fmt.pf ppf "directory"
82
+
| Regular -> Fmt.pf ppf "regular"
83
+
| Symlink -> Fmt.pf ppf "symlink"
84
+
| Block_device -> Fmt.pf ppf "block_device"
85
+
| Char_device -> Fmt.pf ppf "char_device"
86
+
| Fifo -> Fmt.pf ppf "fifo"
87
+
| Socket -> Fmt.pf ppf "socket"
88
88
89
89
(* Superblock *)
90
90
type superblock = {
···
103
103
}
104
104
105
105
let pp_superblock ppf sb =
106
-
Format.fprintf ppf
106
+
Fmt.pf ppf
107
107
"@[<v>SquashFS superblock:@,\
108
108
\ version: %d.%d@,\
109
109
\ compression: %a@,\
···
418
418
(* Security: check decompressed size *)
419
419
if String.length result > max_output_size then
420
420
Error
421
-
(Printf.sprintf "decompressed size %d exceeds limit %d"
422
-
(String.length result) max_output_size)
421
+
(Fmt.str "decompressed size %d exceeds limit %d" (String.length result)
422
+
max_output_size)
423
423
else Ok result
424
424
with exn -> Error ("zlib decompression failed: " ^ Printexc.to_string exn)
425
425
···
434
434
(* Security: check decompressed size *)
435
435
if String.length result > max_output_size then
436
436
Error
437
-
(Printf.sprintf "decompressed size %d exceeds limit %d"
438
-
(String.length result) max_output_size)
437
+
(Fmt.str "decompressed size %d exceeds limit %d" (String.length result)
438
+
max_output_size)
439
439
else Ok result
440
440
with exn -> Error ("zstd decompression failed: " ^ Printexc.to_string exn)
441
441
···
450
450
| Zstd -> decompress_zstd data max_output
451
451
| _ ->
452
452
Error
453
-
(Format.asprintf "compression %a not supported" pp_compression
453
+
(Fmt.str "compression %a not supported" pp_compression
454
454
t.superblock.compression)
455
455
456
456
(* Read a metadata block at the given offset *)
···
479
479
in
480
480
if Int32.of_int raw.sb_magic <> magic then
481
481
Error
482
-
(Printf.sprintf "invalid magic: expected 0x%lx, got 0x%x" magic
483
-
raw.sb_magic)
482
+
(Fmt.str "invalid magic: expected 0x%lx, got 0x%x" magic raw.sb_magic)
484
483
else
485
484
match compression_of_int raw.sb_compression_id with
486
485
| Error e -> Error e
···
488
487
(* Security: validate block_size to prevent decompression bombs *)
489
488
if raw.sb_block_size <= 0 || raw.sb_block_size > max_block_size then
490
489
Error
491
-
(Printf.sprintf "invalid block_size %d (must be 1-%d)"
492
-
raw.sb_block_size max_block_size)
490
+
(Fmt.str "invalid block_size %d (must be 1-%d)" raw.sb_block_size
491
+
max_block_size)
493
492
else if
494
493
(* Security: CVE-2024-46744 - validate inode_count *)
495
494
raw.sb_inode_count < 0 || raw.sb_inode_count > max_inode_count
496
495
then
497
496
Error
498
-
(Printf.sprintf "invalid inode_count %d (must be 0-%d)"
497
+
(Fmt.str "invalid inode_count %d (must be 0-%d)"
499
498
raw.sb_inode_count max_inode_count)
500
499
else if
501
500
(* Security: validate id_count *)
502
501
raw.sb_id_count > max_id_count
503
502
then
504
503
Error
505
-
(Printf.sprintf "invalid id_count %d (must be 0-%d)"
506
-
raw.sb_id_count max_id_count)
504
+
(Fmt.str "invalid id_count %d (must be 0-%d)" raw.sb_id_count
505
+
max_id_count)
507
506
else
508
507
Ok
509
508
{
···
579
578
let b = Wire.Codec.decode symlink_body_codec buf body_off in
580
579
let target_size = b.slb_target_size in
581
580
if target_size > max_symlink_target_size then
582
-
failwith
583
-
(Printf.sprintf "symlink target too large: %d" target_size)
581
+
failwith (Fmt.str "symlink target too large: %d" target_size)
584
582
else if body_off + symlink_body_size + target_size > data_len
585
583
then failwith "symlink target extends beyond data"
586
584
else
···
668
666
| Ok superblock -> (
669
667
if superblock.version_major <> 4 then
670
668
Error
671
-
(Printf.sprintf "unsupported version: %d.%d (only 4.0 supported)"
669
+
(Fmt.str "unsupported version: %d.%d (only 4.0 supported)"
672
670
superblock.version_major superblock.version_minor)
673
671
else
674
672
(* Decode the full raw superblock to get table offsets *)
···
847
845
| Inode_file { start_block; file_size; fragment; offset; _ } ->
848
846
(* Security: enforce file size limit to prevent memory exhaustion *)
849
847
if Int64.compare file_size (Int64.of_int max_size) > 0 then
850
-
Error
851
-
(Printf.sprintf "file too large: %Ld bytes (max %d)" file_size
852
-
max_size)
848
+
Error (Fmt.str "file too large: %Ld bytes (max %d)" file_size max_size)
853
849
else if fragment >= 0 then
854
850
(* File is in fragment *)
855
851
Error "fragment reading not yet implemented"
···
892
888
| Inode_symlink { target; _ } ->
893
889
(* Security: check for path traversal attempts *)
894
890
if is_path_traversal target then
895
-
Error
896
-
(Printf.sprintf "symlink target contains path traversal: %s" target)
891
+
Error (Fmt.str "symlink target contains path traversal: %s" target)
897
892
else Ok target
898
893
| _ -> Error "not a symbolic link"
899
894
+4
-6
lib/squashfs_writer.ml
+4
-6
lib/squashfs_writer.ml
···
332
332
let validate_path path =
333
333
if String.length path > max_path_length then
334
334
invalid_arg
335
-
(Printf.sprintf "path too long: %d > %d" (String.length path)
336
-
max_path_length);
335
+
(Fmt.str "path too long: %d > %d" (String.length path) max_path_length);
337
336
if String.length path > 0 && path.[0] = '/' then
338
337
invalid_arg "absolute paths not allowed";
339
338
let components = String.split_on_char '/' path in
···
360
359
(* SquashFS metadata blocks must not exceed 8KB uncompressed *)
361
360
if String.length data > metadata_block_size then
362
361
invalid_arg
363
-
(Printf.sprintf "metadata block too large: %d > %d" (String.length data)
362
+
(Fmt.str "metadata block too large: %d > %d" (String.length data)
364
363
metadata_block_size);
365
364
let compressed = compress t data in
366
365
let original_len = String.length data in
···
415
414
else (n, e))
416
415
current
417
416
| Some _ ->
418
-
invalid_arg
419
-
(Printf.sprintf "path component %s is not a directory" name)
417
+
invalid_arg (Fmt.str "path component %s is not a directory" name)
420
418
| None ->
421
419
let new_dir =
422
420
Dir { mode = 0o755; children = find_or_create_dir t rest [] }
···
462
460
let add_file t path ~mode content =
463
461
let len = String.length content in
464
462
if Int64.of_int len > max_file_size then
465
-
invalid_arg (Printf.sprintf "file too large: %d bytes" len);
463
+
invalid_arg (Fmt.str "file too large: %d bytes" len);
466
464
add_entry t path (File { mode = mode land 0o7777; data = content })
467
465
468
466
let add_symlink t path target =