SquashFS compressed filesystem reader in pure OCaml
Port monorepo to latest ocaml-wire (opam pin)
Migrate all consumers to the new wire API:
- wire.c library → wire.3d (Wire_c → Wire_3d)
- Wire.struct_/module_ → Wire.Everparse.struct_/module_
- Wire.Codec: record/|+/seal → Codec.v with Field.v and $
- Wire.bf_uint* → Wire.U8/U16/U16be/U32/U32be
- Wire.UInt32 → Wire.Private.UInt32
- Wire.cases → Wire.lookup, Wire.map now uses labeled args
- Wire.Codec.decode now returns result
- Add wire pin to root.opam.template
+505
-344
+352
-258
lib/squashfs.ml
+352
-258
lib/squashfs.ml
···
17
17
18
18
(* Error helpers *)
19
19
20
+
let decode_exn codec buf off =
21
+
match Wire.Codec.decode codec buf off with
22
+
| Ok v -> v
23
+
| Error e -> failwith (Fmt.str "%a" Wire.pp_parse_error e)
24
+
25
+
let decode_result codec buf off =
26
+
Wire.Codec.decode codec buf off
27
+
|> Result.map_error (Fmt.str "%a" Wire.pp_parse_error)
28
+
20
29
let err_out_of_bounds name = Error (Fmt.str "%s out of bounds" name)
21
30
let err_unknown_compression n = Error (Fmt.str "unknown compression type: %d" n)
22
31
let err_unknown_inode n = Error (Fmt.str "unknown inode type: %d" n)
···
247
256
sb_export_table_start;
248
257
}
249
258
259
+
let f_sb_magic = Wire.Field.v "magic" Wire.uint32
260
+
let f_sb_inode_count = Wire.Field.v "inode_count" Wire.uint32
261
+
let f_sb_modification_time = Wire.Field.v "modification_time" Wire.uint32
262
+
let f_sb_block_size = Wire.Field.v "block_size" Wire.uint32
263
+
let f_sb_fragment_entry_count = Wire.Field.v "fragment_entry_count" Wire.uint32
264
+
let f_sb_compression_id = Wire.Field.v "compression_id" Wire.uint16
265
+
let f_sb_block_log = Wire.Field.v "block_log" Wire.uint16
266
+
let f_sb_flags = Wire.Field.v "flags" Wire.uint16
267
+
let f_sb_id_count = Wire.Field.v "id_count" Wire.uint16
268
+
let f_sb_version_major = Wire.Field.v "version_major" Wire.uint16
269
+
let f_sb_version_minor = Wire.Field.v "version_minor" Wire.uint16
270
+
let f_sb_root_inode_ref = Wire.Field.v "root_inode_ref" Wire.uint64
271
+
let f_sb_bytes_used = Wire.Field.v "bytes_used" Wire.uint64
272
+
let f_sb_id_table_start = Wire.Field.v "id_table_start" Wire.uint64
273
+
let f_sb_xattr_table_start = Wire.Field.v "xattr_table_start" Wire.uint64
274
+
let f_sb_inode_table_start = Wire.Field.v "inode_table_start" Wire.uint64
275
+
276
+
let f_sb_directory_table_start =
277
+
Wire.Field.v "directory_table_start" Wire.uint64
278
+
279
+
let f_sb_fragment_table_start = Wire.Field.v "fragment_table_start" Wire.uint64
280
+
let f_sb_export_table_start = Wire.Field.v "export_table_start" Wire.uint64
281
+
250
282
let superblock_codec =
251
-
let open Wire.Codec in
252
-
record "SquashfsSuperblock" superblock
253
-
|+ field "magic" Wire.uint32 (fun t -> t.sb_magic)
254
-
|+ field "inode_count" Wire.uint32 (fun t -> t.sb_inode_count)
255
-
|+ field "modification_time" Wire.uint32 (fun t -> t.sb_modification_time)
256
-
|+ field "block_size" Wire.uint32 (fun t -> t.sb_block_size)
257
-
|+ field "fragment_entry_count" Wire.uint32 (fun t ->
258
-
t.sb_fragment_entry_count)
259
-
|+ field "compression_id" Wire.uint16 (fun t -> t.sb_compression_id)
260
-
|+ field "block_log" Wire.uint16 (fun t -> t.sb_block_log)
261
-
|+ field "flags" Wire.uint16 (fun t -> t.sb_flags)
262
-
|+ field "id_count" Wire.uint16 (fun t -> t.sb_id_count)
263
-
|+ field "version_major" Wire.uint16 (fun t -> t.sb_version_major)
264
-
|+ field "version_minor" Wire.uint16 (fun t -> t.sb_version_minor)
265
-
|+ field "root_inode_ref" Wire.uint64 (fun t -> t.sb_root_inode_ref)
266
-
|+ field "bytes_used" Wire.uint64 (fun t -> t.sb_bytes_used)
267
-
|+ field "id_table_start" Wire.uint64 (fun t -> t.sb_id_table_start)
268
-
|+ field "xattr_table_start" Wire.uint64 (fun t -> t.sb_xattr_table_start)
269
-
|+ field "inode_table_start" Wire.uint64 (fun t -> t.sb_inode_table_start)
270
-
|+ field "directory_table_start" Wire.uint64 (fun t ->
271
-
t.sb_directory_table_start)
272
-
|+ field "fragment_table_start" Wire.uint64 (fun t ->
273
-
t.sb_fragment_table_start)
274
-
|+ field "export_table_start" Wire.uint64 (fun t -> t.sb_export_table_start)
275
-
|> seal
283
+
Wire.Codec.v "SquashfsSuperblock" superblock
284
+
Wire.Codec.
285
+
[
286
+
(f_sb_magic $ fun t -> t.sb_magic);
287
+
(f_sb_inode_count $ fun t -> t.sb_inode_count);
288
+
(f_sb_modification_time $ fun t -> t.sb_modification_time);
289
+
(f_sb_block_size $ fun t -> t.sb_block_size);
290
+
(f_sb_fragment_entry_count $ fun t -> t.sb_fragment_entry_count);
291
+
(f_sb_compression_id $ fun t -> t.sb_compression_id);
292
+
(f_sb_block_log $ fun t -> t.sb_block_log);
293
+
(f_sb_flags $ fun t -> t.sb_flags);
294
+
(f_sb_id_count $ fun t -> t.sb_id_count);
295
+
(f_sb_version_major $ fun t -> t.sb_version_major);
296
+
(f_sb_version_minor $ fun t -> t.sb_version_minor);
297
+
(f_sb_root_inode_ref $ fun t -> t.sb_root_inode_ref);
298
+
(f_sb_bytes_used $ fun t -> t.sb_bytes_used);
299
+
(f_sb_id_table_start $ fun t -> t.sb_id_table_start);
300
+
(f_sb_xattr_table_start $ fun t -> t.sb_xattr_table_start);
301
+
(f_sb_inode_table_start $ fun t -> t.sb_inode_table_start);
302
+
(f_sb_directory_table_start $ fun t -> t.sb_directory_table_start);
303
+
(f_sb_fragment_table_start $ fun t -> t.sb_fragment_table_start);
304
+
(f_sb_export_table_start $ fun t -> t.sb_export_table_start);
305
+
]
276
306
277
-
let superblock_struct_ = Wire.Codec.to_struct superblock_codec
307
+
let superblock_struct_ = Wire.Everparse.struct_of_codec superblock_codec
278
308
279
309
(* Inode common header: 16 bytes *)
280
310
type inode_header = {
···
286
316
ih_inode_number : int;
287
317
}
288
318
319
+
let f_ih_type_and_mode = Wire.Field.v "type_and_mode" Wire.uint16
320
+
let f_ih_mode = Wire.Field.v "mode" Wire.uint16
321
+
let f_ih_uid_idx = Wire.Field.v "uid_idx" Wire.uint16
322
+
let f_ih_gid_idx = Wire.Field.v "gid_idx" Wire.uint16
323
+
let f_ih_mtime = Wire.Field.v "mtime" Wire.uint32
324
+
let f_ih_inode_number = Wire.Field.v "inode_number" Wire.uint32
325
+
289
326
let inode_header_codec =
290
-
let open Wire.Codec in
291
-
record "SquashfsInodeHeader"
292
-
(fun
293
-
ih_type_and_mode ih_mode ih_uid_idx ih_gid_idx ih_mtime ih_inode_number ->
327
+
Wire.Codec.v "SquashfsInodeHeader"
328
+
(fun ih_type_and_mode ih_mode ih_uid_idx ih_gid_idx ih_mtime ih_inode_number
329
+
->
294
330
{
295
331
ih_type_and_mode;
296
332
ih_mode;
···
299
335
ih_mtime;
300
336
ih_inode_number;
301
337
})
302
-
|+ field "type_and_mode" Wire.uint16 (fun t -> t.ih_type_and_mode)
303
-
|+ field "mode" Wire.uint16 (fun t -> t.ih_mode)
304
-
|+ field "uid_idx" Wire.uint16 (fun t -> t.ih_uid_idx)
305
-
|+ field "gid_idx" Wire.uint16 (fun t -> t.ih_gid_idx)
306
-
|+ field "mtime" Wire.uint32 (fun t -> t.ih_mtime)
307
-
|+ field "inode_number" Wire.uint32 (fun t -> t.ih_inode_number)
308
-
|> seal
338
+
Wire.Codec.
339
+
[
340
+
(f_ih_type_and_mode $ fun t -> t.ih_type_and_mode);
341
+
(f_ih_mode $ fun t -> t.ih_mode);
342
+
(f_ih_uid_idx $ fun t -> t.ih_uid_idx);
343
+
(f_ih_gid_idx $ fun t -> t.ih_gid_idx);
344
+
(f_ih_mtime $ fun t -> t.ih_mtime);
345
+
(f_ih_inode_number $ fun t -> t.ih_inode_number);
346
+
]
309
347
310
348
(* Directory inode body: 16 bytes *)
311
349
type dir_body = {
···
316
354
db_parent_inode : int;
317
355
}
318
356
357
+
let f_db_start_block = Wire.Field.v "start_block" Wire.uint32
358
+
let f_db_nlink = Wire.Field.v "nlink" Wire.uint32
359
+
let f_db_file_size = Wire.Field.v "file_size" Wire.uint16
360
+
let f_db_offset = Wire.Field.v "offset" Wire.uint16
361
+
let f_db_parent_inode = Wire.Field.v "parent_inode" Wire.uint32
362
+
319
363
let dir_body_codec =
320
-
let open Wire.Codec in
321
-
record "SquashfsDirBody"
364
+
Wire.Codec.v "SquashfsDirBody"
322
365
(fun db_start_block db_nlink db_file_size db_offset db_parent_inode ->
323
366
{ db_start_block; db_nlink; db_file_size; db_offset; db_parent_inode })
324
-
|+ field "start_block" Wire.uint32 (fun t -> t.db_start_block)
325
-
|+ field "nlink" Wire.uint32 (fun t -> t.db_nlink)
326
-
|+ field "file_size" Wire.uint16 (fun t -> t.db_file_size)
327
-
|+ field "offset" Wire.uint16 (fun t -> t.db_offset)
328
-
|+ field "parent_inode" Wire.uint32 (fun t -> t.db_parent_inode)
329
-
|> seal
367
+
Wire.Codec.
368
+
[
369
+
(f_db_start_block $ fun t -> t.db_start_block);
370
+
(f_db_nlink $ fun t -> t.db_nlink);
371
+
(f_db_file_size $ fun t -> t.db_file_size);
372
+
(f_db_offset $ fun t -> t.db_offset);
373
+
(f_db_parent_inode $ fun t -> t.db_parent_inode);
374
+
]
330
375
331
376
(* File inode body: 16 bytes *)
332
377
type file_body = {
···
336
381
fb_file_size : int;
337
382
}
338
383
384
+
let f_fb_start_block = Wire.Field.v "start_block" Wire.uint32
385
+
let f_fb_fragment = Wire.Field.v "fragment" Wire.uint32
386
+
let f_fb_offset = Wire.Field.v "offset" Wire.uint32
387
+
let f_fb_file_size = Wire.Field.v "file_size" Wire.uint32
388
+
339
389
let file_body_codec =
340
-
let open Wire.Codec in
341
-
record "SquashfsFileBody"
390
+
Wire.Codec.v "SquashfsFileBody"
342
391
(fun fb_start_block fb_fragment fb_offset fb_file_size ->
343
392
{ fb_start_block; fb_fragment; fb_offset; fb_file_size })
344
-
|+ field "start_block" Wire.uint32 (fun t -> t.fb_start_block)
345
-
|+ field "fragment" Wire.uint32 (fun t -> t.fb_fragment)
346
-
|+ field "offset" Wire.uint32 (fun t -> t.fb_offset)
347
-
|+ field "file_size" Wire.uint32 (fun t -> t.fb_file_size)
348
-
|> seal
393
+
Wire.Codec.
394
+
[
395
+
(f_fb_start_block $ fun t -> t.fb_start_block);
396
+
(f_fb_fragment $ fun t -> t.fb_fragment);
397
+
(f_fb_offset $ fun t -> t.fb_offset);
398
+
(f_fb_file_size $ fun t -> t.fb_file_size);
399
+
]
349
400
350
401
(* Device inode body: 8 bytes *)
351
402
type device_body = { devb_nlink : int; devb_rdev : int }
403
+
404
+
let f_devb_nlink = Wire.Field.v "nlink" Wire.uint32
405
+
let f_devb_rdev = Wire.Field.v "rdev" Wire.uint32
352
406
353
407
let device_body_codec =
354
-
let open Wire.Codec in
355
-
record "SquashfsDeviceBody" (fun devb_nlink devb_rdev ->
356
-
{ devb_nlink; devb_rdev })
357
-
|+ field "nlink" Wire.uint32 (fun t -> t.devb_nlink)
358
-
|+ field "rdev" Wire.uint32 (fun t -> t.devb_rdev)
359
-
|> seal
408
+
Wire.Codec.v "SquashfsDeviceBody"
409
+
(fun devb_nlink devb_rdev -> { devb_nlink; devb_rdev })
410
+
Wire.Codec.
411
+
[
412
+
(f_devb_nlink $ fun t -> t.devb_nlink);
413
+
(f_devb_rdev $ fun t -> t.devb_rdev);
414
+
]
360
415
361
416
(* IPC inode body: 4 bytes *)
362
417
type ipc_body = { ipcb_nlink : int }
363
418
419
+
let f_ipcb_nlink = Wire.Field.v "nlink" Wire.uint32
420
+
364
421
let ipc_body_codec =
365
-
let open Wire.Codec in
366
-
record "SquashfsIpcBody" (fun ipcb_nlink -> { ipcb_nlink })
367
-
|+ field "nlink" Wire.uint32 (fun t -> t.ipcb_nlink)
368
-
|> seal
422
+
Wire.Codec.v "SquashfsIpcBody"
423
+
(fun ipcb_nlink -> { ipcb_nlink })
424
+
Wire.Codec.[ (f_ipcb_nlink $ fun t -> t.ipcb_nlink) ]
369
425
370
426
let no_xattr_id = 0xFFFFFFFF
371
427
372
428
(* Symlink inode body (fixed part): 8 bytes, then variable target *)
373
429
type symlink_body = { slb_nlink : int; slb_target_size : int }
374
430
431
+
let f_slb_nlink = Wire.Field.v "nlink" Wire.uint32
432
+
let f_slb_target_size = Wire.Field.v "target_size" Wire.uint32
433
+
375
434
let symlink_body_codec =
376
-
let open Wire.Codec in
377
-
record "SquashfsSymlinkBody" (fun slb_nlink slb_target_size ->
378
-
{ slb_nlink; slb_target_size })
379
-
|+ field "nlink" Wire.uint32 (fun t -> t.slb_nlink)
380
-
|+ field "target_size" Wire.uint32 (fun t -> t.slb_target_size)
381
-
|> seal
435
+
Wire.Codec.v "SquashfsSymlinkBody"
436
+
(fun slb_nlink slb_target_size -> { slb_nlink; slb_target_size })
437
+
Wire.Codec.
438
+
[
439
+
(f_slb_nlink $ fun t -> t.slb_nlink);
440
+
(f_slb_target_size $ fun t -> t.slb_target_size);
441
+
]
382
442
383
443
(* Extended directory body: 24 bytes *)
384
444
type ext_dir_body = {
···
391
451
edb_xattr_id : int;
392
452
}
393
453
454
+
let f_edb_nlink = Wire.Field.v "nlink" Wire.uint32
455
+
let f_edb_file_size = Wire.Field.v "file_size" Wire.uint32
456
+
let f_edb_start_block = Wire.Field.v "start_block" Wire.uint32
457
+
let f_edb_parent_inode = Wire.Field.v "parent_inode" Wire.uint32
458
+
let f_edb_inodex_count = Wire.Field.v "inodex_count" Wire.uint16
459
+
let f_edb_offset = Wire.Field.v "offset" Wire.uint16
460
+
let f_edb_xattr_id = Wire.Field.v "xattr_id" Wire.uint32
461
+
394
462
let ext_dir_body_codec =
395
-
let open Wire.Codec in
396
-
record "SquashfsExtDirBody"
397
-
(fun
398
-
edb_nlink
399
-
edb_file_size
400
-
edb_start_block
401
-
edb_parent_inode
402
-
edb_inodex_count
403
-
edb_offset
404
-
edb_xattr_id
405
-
->
463
+
Wire.Codec.v "SquashfsExtDirBody"
464
+
(fun edb_nlink edb_file_size edb_start_block edb_parent_inode
465
+
edb_inodex_count edb_offset edb_xattr_id ->
406
466
{
407
467
edb_nlink;
408
468
edb_file_size;
···
412
472
edb_offset;
413
473
edb_xattr_id;
414
474
})
415
-
|+ field "nlink" Wire.uint32 (fun t -> t.edb_nlink)
416
-
|+ field "file_size" Wire.uint32 (fun t -> t.edb_file_size)
417
-
|+ field "start_block" Wire.uint32 (fun t -> t.edb_start_block)
418
-
|+ field "parent_inode" Wire.uint32 (fun t -> t.edb_parent_inode)
419
-
|+ field "inodex_count" Wire.uint16 (fun t -> t.edb_inodex_count)
420
-
|+ field "offset" Wire.uint16 (fun t -> t.edb_offset)
421
-
|+ field "xattr_id" Wire.uint32 (fun t -> t.edb_xattr_id)
422
-
|> seal
475
+
Wire.Codec.
476
+
[
477
+
(f_edb_nlink $ fun t -> t.edb_nlink);
478
+
(f_edb_file_size $ fun t -> t.edb_file_size);
479
+
(f_edb_start_block $ fun t -> t.edb_start_block);
480
+
(f_edb_parent_inode $ fun t -> t.edb_parent_inode);
481
+
(f_edb_inodex_count $ fun t -> t.edb_inodex_count);
482
+
(f_edb_offset $ fun t -> t.edb_offset);
483
+
(f_edb_xattr_id $ fun t -> t.edb_xattr_id);
484
+
]
423
485
424
486
(* Extended regular file body: 40 bytes (block_sizes follow but are ignored here) *)
425
487
type ext_file_body = {
···
432
494
efb_xattr_id : int;
433
495
}
434
496
497
+
let f_efb_start_block = Wire.Field.v "start_block" Wire.uint64
498
+
let f_efb_file_size = Wire.Field.v "file_size" Wire.uint64
499
+
let f_efb_sparse = Wire.Field.v "sparse" Wire.uint64
500
+
let f_efb_nlink = Wire.Field.v "nlink" Wire.uint32
501
+
let f_efb_fragment = Wire.Field.v "fragment" Wire.uint32
502
+
let f_efb_offset = Wire.Field.v "offset" Wire.uint32
503
+
let f_efb_xattr_id = Wire.Field.v "xattr_id" Wire.uint32
504
+
435
505
let ext_file_body_codec =
436
-
let open Wire.Codec in
437
-
record "SquashfsExtFileBody"
438
-
(fun
439
-
efb_start_block
440
-
efb_file_size
441
-
efb_sparse
442
-
efb_nlink
443
-
efb_fragment
444
-
efb_offset
445
-
efb_xattr_id
446
-
->
506
+
Wire.Codec.v "SquashfsExtFileBody"
507
+
(fun efb_start_block efb_file_size efb_sparse efb_nlink efb_fragment
508
+
efb_offset efb_xattr_id ->
447
509
{
448
510
efb_start_block;
449
511
efb_file_size;
···
453
515
efb_offset;
454
516
efb_xattr_id;
455
517
})
456
-
|+ field "start_block" Wire.uint64 (fun t -> t.efb_start_block)
457
-
|+ field "file_size" Wire.uint64 (fun t -> t.efb_file_size)
458
-
|+ field "sparse" Wire.uint64 (fun t -> t.efb_sparse)
459
-
|+ field "nlink" Wire.uint32 (fun t -> t.efb_nlink)
460
-
|+ field "fragment" Wire.uint32 (fun t -> t.efb_fragment)
461
-
|+ field "offset" Wire.uint32 (fun t -> t.efb_offset)
462
-
|+ field "xattr_id" Wire.uint32 (fun t -> t.efb_xattr_id)
463
-
|> seal
518
+
Wire.Codec.
519
+
[
520
+
(f_efb_start_block $ fun t -> t.efb_start_block);
521
+
(f_efb_file_size $ fun t -> t.efb_file_size);
522
+
(f_efb_sparse $ fun t -> t.efb_sparse);
523
+
(f_efb_nlink $ fun t -> t.efb_nlink);
524
+
(f_efb_fragment $ fun t -> t.efb_fragment);
525
+
(f_efb_offset $ fun t -> t.efb_offset);
526
+
(f_efb_xattr_id $ fun t -> t.efb_xattr_id);
527
+
]
464
528
465
529
(* Extended device body: 12 bytes *)
466
530
type ext_device_body = {
···
469
533
edevb_xattr_id : int;
470
534
}
471
535
536
+
let f_edevb_nlink = Wire.Field.v "nlink" Wire.uint32
537
+
let f_edevb_rdev = Wire.Field.v "rdev" Wire.uint32
538
+
let f_edevb_xattr_id = Wire.Field.v "xattr_id" Wire.uint32
539
+
472
540
let ext_device_body_codec =
473
-
let open Wire.Codec in
474
-
record "SquashfsExtDeviceBody" (fun edevb_nlink edevb_rdev edevb_xattr_id ->
541
+
Wire.Codec.v "SquashfsExtDeviceBody"
542
+
(fun edevb_nlink edevb_rdev edevb_xattr_id ->
475
543
{ edevb_nlink; edevb_rdev; edevb_xattr_id })
476
-
|+ field "nlink" Wire.uint32 (fun t -> t.edevb_nlink)
477
-
|+ field "rdev" Wire.uint32 (fun t -> t.edevb_rdev)
478
-
|+ field "xattr_id" Wire.uint32 (fun t -> t.edevb_xattr_id)
479
-
|> seal
544
+
Wire.Codec.
545
+
[
546
+
(f_edevb_nlink $ fun t -> t.edevb_nlink);
547
+
(f_edevb_rdev $ fun t -> t.edevb_rdev);
548
+
(f_edevb_xattr_id $ fun t -> t.edevb_xattr_id);
549
+
]
480
550
481
551
(* Extended IPC body: 8 bytes *)
482
552
type ext_ipc_body = { eipcb_nlink : int; eipcb_xattr_id : int }
483
553
554
+
let f_eipcb_nlink = Wire.Field.v "nlink" Wire.uint32
555
+
let f_eipcb_xattr_id = Wire.Field.v "xattr_id" Wire.uint32
556
+
484
557
let ext_ipc_body_codec =
485
-
let open Wire.Codec in
486
-
record "SquashfsExtIpcBody" (fun eipcb_nlink eipcb_xattr_id ->
487
-
{ eipcb_nlink; eipcb_xattr_id })
488
-
|+ field "nlink" Wire.uint32 (fun t -> t.eipcb_nlink)
489
-
|+ field "xattr_id" Wire.uint32 (fun t -> t.eipcb_xattr_id)
490
-
|> seal
558
+
Wire.Codec.v "SquashfsExtIpcBody"
559
+
(fun eipcb_nlink eipcb_xattr_id -> { eipcb_nlink; eipcb_xattr_id })
560
+
Wire.Codec.
561
+
[
562
+
(f_eipcb_nlink $ fun t -> t.eipcb_nlink);
563
+
(f_eipcb_xattr_id $ fun t -> t.eipcb_xattr_id);
564
+
]
491
565
492
566
(* Directory header: 12 bytes *)
493
567
type dir_header = {
···
496
570
dh_inode_number : int;
497
571
}
498
572
573
+
let f_dh_count = Wire.Field.v "count" Wire.uint32
574
+
let f_dh_start_block = Wire.Field.v "start_block" Wire.uint32
575
+
let f_dh_inode_number = Wire.Field.v "inode_number" Wire.uint32
576
+
499
577
let dir_header_codec =
500
-
let open Wire.Codec in
501
-
record "SquashfsDirHeader" (fun dh_count dh_start_block dh_inode_number ->
578
+
Wire.Codec.v "SquashfsDirHeader"
579
+
(fun dh_count dh_start_block dh_inode_number ->
502
580
{ dh_count; dh_start_block; dh_inode_number })
503
-
|+ field "count" Wire.uint32 (fun t -> t.dh_count)
504
-
|+ field "start_block" Wire.uint32 (fun t -> t.dh_start_block)
505
-
|+ field "inode_number" Wire.uint32 (fun t -> t.dh_inode_number)
506
-
|> seal
581
+
Wire.Codec.
582
+
[
583
+
(f_dh_count $ fun t -> t.dh_count);
584
+
(f_dh_start_block $ fun t -> t.dh_start_block);
585
+
(f_dh_inode_number $ fun t -> t.dh_inode_number);
586
+
]
507
587
508
588
(* Directory entry header: 8 bytes, followed by variable name *)
509
589
type dir_entry_header = {
···
513
593
de_name_size : int;
514
594
}
515
595
596
+
let f_de_inode_offset = Wire.Field.v "inode_offset" Wire.uint16
597
+
let f_de_inode_number = Wire.Field.v "inode_number" Wire.uint16
598
+
let f_de_entry_type = Wire.Field.v "entry_type" Wire.uint16
599
+
let f_de_name_size = Wire.Field.v "name_size" Wire.uint16
600
+
516
601
let dir_entry_header_codec =
517
-
let open Wire.Codec in
518
-
record "SquashfsDirEntryHeader"
602
+
Wire.Codec.v "SquashfsDirEntryHeader"
519
603
(fun de_inode_offset de_inode_number de_entry_type de_name_size ->
520
604
{ de_inode_offset; de_inode_number; de_entry_type; de_name_size })
521
-
|+ field "inode_offset" Wire.uint16 (fun t -> t.de_inode_offset)
522
-
|+ field "inode_number" Wire.uint16 (fun t -> t.de_inode_number)
523
-
|+ field "entry_type" Wire.uint16 (fun t -> t.de_entry_type)
524
-
|+ field "name_size" Wire.uint16 (fun t -> t.de_name_size)
525
-
|> seal
605
+
Wire.Codec.
606
+
[
607
+
(f_de_inode_offset $ fun t -> t.de_inode_offset);
608
+
(f_de_inode_number $ fun t -> t.de_inode_number);
609
+
(f_de_entry_type $ fun t -> t.de_entry_type);
610
+
(f_de_name_size $ fun t -> t.de_name_size);
611
+
]
526
612
527
613
(* Decompress a metadata block using bytesrw.zlib *)
528
614
let decompress_zlib data max_output_size =
···
589
675
if String.length data < superblock_size then
590
676
Error "data too short for superblock"
591
677
else
592
-
let raw =
593
-
Wire.Codec.decode superblock_codec (Bytes.unsafe_of_string data) 0
594
-
in
595
-
if Int32.of_int raw.sb_magic <> magic then
596
-
Error
597
-
(Fmt.str "invalid magic: expected 0x%lx, got 0x%x" magic raw.sb_magic)
598
-
else
599
-
match compression_of_int raw.sb_compression_id with
600
-
| Error e -> Error e
601
-
| Ok compression ->
602
-
(* Security: validate block_size to prevent decompression bombs *)
603
-
if raw.sb_block_size <= 0 || raw.sb_block_size > max_block_size then
604
-
Error
605
-
(Fmt.str "invalid block_size %d (must be 1-%d)" raw.sb_block_size
606
-
max_block_size)
607
-
else if
608
-
(* Security: CVE-2024-46744 - validate inode_count *)
609
-
raw.sb_inode_count < 0 || raw.sb_inode_count > max_inode_count
610
-
then
611
-
Error
612
-
(Fmt.str "invalid inode_count %d (must be 0-%d)"
613
-
raw.sb_inode_count max_inode_count)
614
-
else if
615
-
(* Security: validate id_count *)
616
-
raw.sb_id_count > max_id_count
617
-
then
618
-
Error
619
-
(Fmt.str "invalid id_count %d (must be 0-%d)" raw.sb_id_count
620
-
max_id_count)
621
-
else
622
-
Ok
623
-
{
624
-
inode_count = raw.sb_inode_count;
625
-
modification_time = raw.sb_modification_time;
626
-
block_size = raw.sb_block_size;
627
-
fragment_entry_count = raw.sb_fragment_entry_count;
628
-
compression;
629
-
block_log = raw.sb_block_log;
630
-
flags = raw.sb_flags;
631
-
id_count = raw.sb_id_count;
632
-
version_major = raw.sb_version_major;
633
-
version_minor = raw.sb_version_minor;
634
-
root_inode_ref = raw.sb_root_inode_ref;
635
-
bytes_used = raw.sb_bytes_used;
636
-
}
678
+
match decode_result superblock_codec (Bytes.unsafe_of_string data) 0 with
679
+
| Error e -> Error e
680
+
| Ok raw -> (
681
+
if Int32.of_int raw.sb_magic <> magic then
682
+
Error
683
+
(Fmt.str "invalid magic: expected 0x%lx, got 0x%x" magic
684
+
raw.sb_magic)
685
+
else
686
+
match compression_of_int raw.sb_compression_id with
687
+
| Error e -> Error e
688
+
| Ok compression ->
689
+
(* Security: validate block_size to prevent decompression bombs *)
690
+
if raw.sb_block_size <= 0 || raw.sb_block_size > max_block_size
691
+
then
692
+
Error
693
+
(Fmt.str "invalid block_size %d (must be 1-%d)"
694
+
raw.sb_block_size max_block_size)
695
+
else if
696
+
(* Security: CVE-2024-46744 - validate inode_count *)
697
+
raw.sb_inode_count < 0 || raw.sb_inode_count > max_inode_count
698
+
then
699
+
Error
700
+
(Fmt.str "invalid inode_count %d (must be 0-%d)"
701
+
raw.sb_inode_count max_inode_count)
702
+
else if
703
+
(* Security: validate id_count *)
704
+
raw.sb_id_count > max_id_count
705
+
then
706
+
Error
707
+
(Fmt.str "invalid id_count %d (must be 0-%d)" raw.sb_id_count
708
+
max_id_count)
709
+
else
710
+
Ok
711
+
{
712
+
inode_count = raw.sb_inode_count;
713
+
modification_time = raw.sb_modification_time;
714
+
block_size = raw.sb_block_size;
715
+
fragment_entry_count = raw.sb_fragment_entry_count;
716
+
compression;
717
+
block_log = raw.sb_block_log;
718
+
flags = raw.sb_flags;
719
+
id_count = raw.sb_id_count;
720
+
version_major = raw.sb_version_major;
721
+
version_minor = raw.sb_version_minor;
722
+
root_inode_ref = raw.sb_root_inode_ref;
723
+
bytes_used = raw.sb_bytes_used;
724
+
})
637
725
638
726
(* Parse an inode from metadata *)
639
727
let inode_header_size = Wire.Codec.wire_size inode_header_codec
···
651
739
let parse_dir_inode buf body_off data_len =
652
740
if body_off + dir_body_size > data_len then
653
741
failwith "directory inode truncated";
654
-
let b = Wire.Codec.decode dir_body_codec buf body_off in
742
+
let b = decode_exn dir_body_codec buf body_off in
655
743
( Inode_dir
656
744
{
657
745
start_block = b.db_start_block;
···
665
753
let parse_ext_dir_inode buf body_off data_len =
666
754
if body_off + ext_dir_body_size > data_len then
667
755
failwith "extended directory inode truncated";
668
-
let b = Wire.Codec.decode ext_dir_body_codec buf body_off in
756
+
let b = decode_exn ext_dir_body_codec buf body_off in
669
757
( Inode_dir
670
758
{
671
759
start_block = b.edb_start_block;
···
679
767
let parse_file_inode buf body_off data_len =
680
768
if body_off + file_body_size > data_len then
681
769
failwith "regular file inode truncated";
682
-
let b = Wire.Codec.decode file_body_codec buf body_off in
770
+
let b = decode_exn file_body_codec buf body_off in
683
771
let fragment =
684
772
if b.fb_fragment >= 0x80000000 then b.fb_fragment - 0x100000000
685
773
else b.fb_fragment
···
697
785
let parse_ext_file_inode buf body_off data_len =
698
786
if body_off + ext_file_body_size > data_len then
699
787
failwith "extended regular file inode truncated";
700
-
let b = Wire.Codec.decode ext_file_body_codec buf body_off in
788
+
let b = decode_exn ext_file_body_codec buf body_off in
701
789
let fragment =
702
790
if b.efb_fragment >= 0x80000000 then b.efb_fragment - 0x100000000
703
791
else b.efb_fragment
···
715
803
let parse_symlink_inode data buf body_off data_len ~is_extended =
716
804
if body_off + symlink_body_size > data_len then
717
805
failwith "symlink inode truncated";
718
-
let b = Wire.Codec.decode symlink_body_codec buf body_off in
806
+
let b = decode_exn symlink_body_codec buf body_off in
719
807
let target_size = b.slb_target_size in
720
808
if target_size > max_symlink_target_size then
721
809
Fmt.failwith "symlink target too large: %d" target_size
···
734
822
let parse_device_inode buf body_off data_len =
735
823
if body_off + device_body_size > data_len then
736
824
failwith "device inode truncated";
737
-
let b = Wire.Codec.decode device_body_codec buf body_off in
825
+
let b = decode_exn device_body_codec buf body_off in
738
826
(Inode_device { nlink = b.devb_nlink; rdev = b.devb_rdev }, no_xattr_id)
739
827
740
828
let parse_ext_device_inode buf body_off data_len =
741
829
if body_off + ext_device_body_size > data_len then
742
830
failwith "extended device inode truncated";
743
-
let b = Wire.Codec.decode ext_device_body_codec buf body_off in
831
+
let b = decode_exn ext_device_body_codec buf body_off in
744
832
(Inode_device { nlink = b.edevb_nlink; rdev = b.edevb_rdev }, b.edevb_xattr_id)
745
833
746
834
let parse_ipc_inode buf body_off data_len =
747
835
if body_off + ipc_body_size > data_len then failwith "IPC inode truncated";
748
-
let b = Wire.Codec.decode ipc_body_codec buf body_off in
836
+
let b = decode_exn ipc_body_codec buf body_off in
749
837
(Inode_ipc { nlink = b.ipcb_nlink }, no_xattr_id)
750
838
751
839
let parse_ext_ipc_inode buf body_off data_len =
752
840
if body_off + ext_ipc_body_size > data_len then
753
841
failwith "extended IPC inode truncated";
754
-
let b = Wire.Codec.decode ext_ipc_body_codec buf body_off in
842
+
let b = decode_exn ext_ipc_body_codec buf body_off in
755
843
(Inode_ipc { nlink = b.eipcb_nlink }, b.eipcb_xattr_id)
756
844
757
845
let parse_inode _t data offset =
···
759
847
if offset + inode_header_size > data_len then Error "inode header truncated"
760
848
else
761
849
let buf = Bytes.unsafe_of_string data in
762
-
let hdr = Wire.Codec.decode inode_header_codec buf offset in
763
-
let inode_type_raw = hdr.ih_type_and_mode land 0xf in
764
-
let is_extended = inode_type_raw >= 8 in
765
-
match file_type_of_int inode_type_raw with
850
+
match decode_result inode_header_codec buf offset with
766
851
| Error e -> Error e
767
-
| Ok inode_type -> (
768
-
let body_off = offset + inode_header_size in
769
-
try
770
-
let inode_data, xattr_id =
771
-
match (inode_type, is_extended) with
772
-
| Directory, false -> parse_dir_inode buf body_off data_len
773
-
| Directory, true -> parse_ext_dir_inode buf body_off data_len
774
-
| Regular, false -> parse_file_inode buf body_off data_len
775
-
| Regular, true -> parse_ext_file_inode buf body_off data_len
776
-
| Symlink, _ ->
777
-
parse_symlink_inode data buf body_off data_len ~is_extended
778
-
| (Block_device | Char_device), false ->
779
-
parse_device_inode buf body_off data_len
780
-
| (Block_device | Char_device), true ->
781
-
parse_ext_device_inode buf body_off data_len
782
-
| (Fifo | Socket), false -> parse_ipc_inode buf body_off data_len
783
-
| (Fifo | Socket), true -> parse_ext_ipc_inode buf body_off data_len
784
-
in
785
-
Ok
786
-
{
787
-
inode_type;
788
-
mode = hdr.ih_mode land 0o7777;
789
-
uid_idx = hdr.ih_uid_idx;
790
-
gid_idx = hdr.ih_gid_idx;
791
-
mtime = hdr.ih_mtime;
792
-
inode_number = hdr.ih_inode_number;
793
-
inode_data;
794
-
xattr_id;
795
-
}
796
-
with Failure msg -> Error msg)
852
+
| Ok hdr -> (
853
+
let inode_type_raw = hdr.ih_type_and_mode land 0xf in
854
+
let is_extended = inode_type_raw >= 8 in
855
+
match file_type_of_int inode_type_raw with
856
+
| Error e -> Error e
857
+
| Ok inode_type -> (
858
+
let body_off = offset + inode_header_size in
859
+
try
860
+
let inode_data, xattr_id =
861
+
match (inode_type, is_extended) with
862
+
| Directory, false -> parse_dir_inode buf body_off data_len
863
+
| Directory, true -> parse_ext_dir_inode buf body_off data_len
864
+
| Regular, false -> parse_file_inode buf body_off data_len
865
+
| Regular, true -> parse_ext_file_inode buf body_off data_len
866
+
| Symlink, _ ->
867
+
parse_symlink_inode data buf body_off data_len ~is_extended
868
+
| (Block_device | Char_device), false ->
869
+
parse_device_inode buf body_off data_len
870
+
| (Block_device | Char_device), true ->
871
+
parse_ext_device_inode buf body_off data_len
872
+
| (Fifo | Socket), false ->
873
+
parse_ipc_inode buf body_off data_len
874
+
| (Fifo | Socket), true ->
875
+
parse_ext_ipc_inode buf body_off data_len
876
+
in
877
+
Ok
878
+
{
879
+
inode_type;
880
+
mode = hdr.ih_mode land 0o7777;
881
+
uid_idx = hdr.ih_uid_idx;
882
+
gid_idx = hdr.ih_gid_idx;
883
+
mtime = hdr.ih_mtime;
884
+
inode_number = hdr.ih_inode_number;
885
+
inode_data;
886
+
xattr_id;
887
+
}
888
+
with Failure msg -> Error msg))
797
889
798
890
(* Read the ID table *)
799
891
···
856
948
superblock.version_major superblock.version_minor)
857
949
else
858
950
(* Decode the full raw superblock to get table offsets *)
859
-
let raw =
860
-
Wire.Codec.decode superblock_codec (Bytes.unsafe_of_string data) 0
861
-
in
862
-
match read_id_table data superblock with
951
+
match
952
+
decode_result superblock_codec (Bytes.unsafe_of_string data) 0
953
+
with
863
954
| Error e -> Error e
864
-
| Ok id_table -> (
865
-
let t =
866
-
{
867
-
data;
868
-
superblock;
869
-
id_table;
870
-
root_inode =
871
-
{
872
-
inode_type = Directory;
873
-
mode = 0o755;
874
-
uid_idx = 0;
875
-
gid_idx = 0;
876
-
mtime = 0;
877
-
inode_number = 0;
878
-
inode_data =
879
-
Inode_dir
880
-
{
881
-
start_block = 0;
882
-
nlink = 0;
883
-
file_size = 0;
884
-
offset = 0;
885
-
parent_inode = 0;
886
-
};
887
-
xattr_id = no_xattr_id;
888
-
};
889
-
inode_table_start = raw.sb_inode_table_start;
890
-
directory_table_start = raw.sb_directory_table_start;
891
-
fragment_table_start = raw.sb_fragment_table_start;
892
-
xattr_table_start = raw.sb_xattr_table_start;
893
-
}
894
-
in
895
-
match read_root_inode t with
955
+
| Ok raw -> (
956
+
match read_id_table data superblock with
896
957
| Error e -> Error e
897
-
| Ok root_inode -> Ok { t with root_inode }))
958
+
| Ok id_table -> (
959
+
let t =
960
+
{
961
+
data;
962
+
superblock;
963
+
id_table;
964
+
root_inode =
965
+
{
966
+
inode_type = Directory;
967
+
mode = 0o755;
968
+
uid_idx = 0;
969
+
gid_idx = 0;
970
+
mtime = 0;
971
+
inode_number = 0;
972
+
inode_data =
973
+
Inode_dir
974
+
{
975
+
start_block = 0;
976
+
nlink = 0;
977
+
file_size = 0;
978
+
offset = 0;
979
+
parent_inode = 0;
980
+
};
981
+
xattr_id = no_xattr_id;
982
+
};
983
+
inode_table_start = raw.sb_inode_table_start;
984
+
directory_table_start = raw.sb_directory_table_start;
985
+
fragment_table_start = raw.sb_fragment_table_start;
986
+
xattr_table_start = raw.sb_xattr_table_start;
987
+
}
988
+
in
989
+
match read_root_inode t with
990
+
| Error e -> Error e
991
+
| Ok root_inode -> Ok { t with root_inode })))
898
992
899
993
let of_reader reader =
900
994
(* Read entire image into memory for random access *)
···
966
1060
let pos = ref offset in
967
1061
let remaining = ref file_size in
968
1062
while !remaining > 0 && !pos + dir_header_size <= block_len do
969
-
let dh = Wire.Codec.decode dir_header_codec buf !pos in
1063
+
let dh = decode_exn dir_header_codec buf !pos in
970
1064
let count = dh.dh_count + 1 in
971
1065
pos := !pos + dir_header_size;
972
1066
for _ = 0 to count - 1 do
973
1067
if !pos + dir_entry_header_size <= block_len then begin
974
-
let de = Wire.Codec.decode dir_entry_header_codec buf !pos in
1068
+
let de = decode_exn dir_entry_header_codec buf !pos in
975
1069
let name_size = de.de_name_size + 1 in
976
1070
if !pos + dir_entry_header_size + name_size <= block_len then begin
977
1071
let name =
+1
-1
lib/squashfs.mli
+1
-1
lib/squashfs.mli
···
119
119
val superblock_codec : raw_superblock Wire.Codec.t
120
120
(** Wire codec for the 96-byte little-endian superblock. *)
121
121
122
-
val superblock_struct_ : Wire.struct_
122
+
val superblock_struct_ : Wire.Everparse.struct_
123
123
(** Wire struct definition for the superblock. *)
124
124
125
125
(** {1 Opening and Closing} *)
+147
-84
lib/squashfs_writer.ml
+147
-84
lib/squashfs_writer.ml
···
95
95
ih_inode_number : int;
96
96
}
97
97
98
+
let f_ih_type_and_mode = Wire.Field.v "type_and_mode" Wire.uint16
99
+
let f_ih_mode = Wire.Field.v "mode" Wire.uint16
100
+
let f_ih_uid_idx = Wire.Field.v "uid_idx" Wire.uint16
101
+
let f_ih_gid_idx = Wire.Field.v "gid_idx" Wire.uint16
102
+
let f_ih_mtime = Wire.Field.v "mtime" Wire.uint32
103
+
let f_ih_inode_number = Wire.Field.v "inode_number" Wire.uint32
104
+
98
105
let inode_header_codec =
99
-
let open Wire.Codec in
100
-
record "SquashfsInodeHeader"
101
-
(fun
102
-
ih_type_and_mode ih_mode ih_uid_idx ih_gid_idx ih_mtime ih_inode_number ->
106
+
Wire.Codec.v "SquashfsInodeHeader"
107
+
(fun ih_type_and_mode ih_mode ih_uid_idx ih_gid_idx ih_mtime ih_inode_number
108
+
->
103
109
{
104
110
ih_type_and_mode;
105
111
ih_mode;
···
108
114
ih_mtime;
109
115
ih_inode_number;
110
116
})
111
-
|+ field "type_and_mode" Wire.uint16 (fun t -> t.ih_type_and_mode)
112
-
|+ field "mode" Wire.uint16 (fun t -> t.ih_mode)
113
-
|+ field "uid_idx" Wire.uint16 (fun t -> t.ih_uid_idx)
114
-
|+ field "gid_idx" Wire.uint16 (fun t -> t.ih_gid_idx)
115
-
|+ field "mtime" Wire.uint32 (fun t -> t.ih_mtime)
116
-
|+ field "inode_number" Wire.uint32 (fun t -> t.ih_inode_number)
117
-
|> seal
117
+
Wire.Codec.
118
+
[
119
+
(f_ih_type_and_mode $ fun t -> t.ih_type_and_mode);
120
+
(f_ih_mode $ fun t -> t.ih_mode);
121
+
(f_ih_uid_idx $ fun t -> t.ih_uid_idx);
122
+
(f_ih_gid_idx $ fun t -> t.ih_gid_idx);
123
+
(f_ih_mtime $ fun t -> t.ih_mtime);
124
+
(f_ih_inode_number $ fun t -> t.ih_inode_number);
125
+
]
118
126
119
127
let inode_header_size = Wire.Codec.wire_size inode_header_codec
120
128
···
127
135
db_parent_inode : int;
128
136
}
129
137
138
+
let f_db_start_block = Wire.Field.v "start_block" Wire.uint32
139
+
let f_db_nlink = Wire.Field.v "nlink" Wire.uint32
140
+
let f_db_file_size = Wire.Field.v "file_size" Wire.uint16
141
+
let f_db_offset = Wire.Field.v "offset" Wire.uint16
142
+
let f_db_parent_inode = Wire.Field.v "parent_inode" Wire.uint32
143
+
130
144
let dir_body_codec =
131
-
let open Wire.Codec in
132
-
record "SquashfsDirBody"
145
+
Wire.Codec.v "SquashfsDirBody"
133
146
(fun db_start_block db_nlink db_file_size db_offset db_parent_inode ->
134
147
{ db_start_block; db_nlink; db_file_size; db_offset; db_parent_inode })
135
-
|+ field "start_block" Wire.uint32 (fun t -> t.db_start_block)
136
-
|+ field "nlink" Wire.uint32 (fun t -> t.db_nlink)
137
-
|+ field "file_size" Wire.uint16 (fun t -> t.db_file_size)
138
-
|+ field "offset" Wire.uint16 (fun t -> t.db_offset)
139
-
|+ field "parent_inode" Wire.uint32 (fun t -> t.db_parent_inode)
140
-
|> seal
148
+
Wire.Codec.
149
+
[
150
+
(f_db_start_block $ fun t -> t.db_start_block);
151
+
(f_db_nlink $ fun t -> t.db_nlink);
152
+
(f_db_file_size $ fun t -> t.db_file_size);
153
+
(f_db_offset $ fun t -> t.db_offset);
154
+
(f_db_parent_inode $ fun t -> t.db_parent_inode);
155
+
]
141
156
142
157
let dir_body_size = Wire.Codec.wire_size dir_body_codec
143
158
···
148
163
fb_offset : int;
149
164
fb_file_size : int;
150
165
}
166
+
167
+
let f_fb_start_block = Wire.Field.v "start_block" Wire.uint32
168
+
let f_fb_fragment = Wire.Field.v "fragment" Wire.uint32
169
+
let f_fb_offset = Wire.Field.v "offset" Wire.uint32
170
+
let f_fb_file_size = Wire.Field.v "file_size" Wire.uint32
151
171
152
172
let file_body_codec =
153
-
let open Wire.Codec in
154
-
record "SquashfsFileBody"
173
+
Wire.Codec.v "SquashfsFileBody"
155
174
(fun fb_start_block fb_fragment fb_offset fb_file_size ->
156
175
{ fb_start_block; fb_fragment; fb_offset; fb_file_size })
157
-
|+ field "start_block" Wire.uint32 (fun t -> t.fb_start_block)
158
-
|+ field "fragment" Wire.uint32 (fun t -> t.fb_fragment)
159
-
|+ field "offset" Wire.uint32 (fun t -> t.fb_offset)
160
-
|+ field "file_size" Wire.uint32 (fun t -> t.fb_file_size)
161
-
|> seal
176
+
Wire.Codec.
177
+
[
178
+
(f_fb_start_block $ fun t -> t.fb_start_block);
179
+
(f_fb_fragment $ fun t -> t.fb_fragment);
180
+
(f_fb_offset $ fun t -> t.fb_offset);
181
+
(f_fb_file_size $ fun t -> t.fb_file_size);
182
+
]
162
183
163
184
let file_body_size = Wire.Codec.wire_size file_body_codec
164
185
165
186
(* Device inode body: 8 bytes *)
166
187
type device_body = { devb_nlink : int; devb_rdev : int }
167
188
189
+
let f_devb_nlink = Wire.Field.v "nlink" Wire.uint32
190
+
let f_devb_rdev = Wire.Field.v "rdev" Wire.uint32
191
+
168
192
let device_body_codec =
169
-
let open Wire.Codec in
170
-
record "SquashfsDeviceBody" (fun devb_nlink devb_rdev ->
171
-
{ devb_nlink; devb_rdev })
172
-
|+ field "nlink" Wire.uint32 (fun t -> t.devb_nlink)
173
-
|+ field "rdev" Wire.uint32 (fun t -> t.devb_rdev)
174
-
|> seal
193
+
Wire.Codec.v "SquashfsDeviceBody"
194
+
(fun devb_nlink devb_rdev -> { devb_nlink; devb_rdev })
195
+
Wire.Codec.
196
+
[
197
+
(f_devb_nlink $ fun t -> t.devb_nlink);
198
+
(f_devb_rdev $ fun t -> t.devb_rdev);
199
+
]
175
200
176
201
let device_body_size = Wire.Codec.wire_size device_body_codec
177
202
178
203
(* IPC inode body: 4 bytes *)
179
204
type ipc_body = { ipcb_nlink : int }
205
+
206
+
let f_ipcb_nlink = Wire.Field.v "nlink" Wire.uint32
180
207
181
208
let ipc_body_codec =
182
-
let open Wire.Codec in
183
-
record "SquashfsIpcBody" (fun ipcb_nlink -> { ipcb_nlink })
184
-
|+ field "nlink" Wire.uint32 (fun t -> t.ipcb_nlink)
185
-
|> seal
209
+
Wire.Codec.v "SquashfsIpcBody"
210
+
(fun ipcb_nlink -> { ipcb_nlink })
211
+
Wire.Codec.[ (f_ipcb_nlink $ fun t -> t.ipcb_nlink) ]
186
212
187
213
let ipc_body_size = Wire.Codec.wire_size ipc_body_codec
188
214
189
215
(* Symlink inode body (fixed part): 8 bytes *)
190
216
type symlink_body = { slb_nlink : int; slb_target_size : int }
191
217
218
+
let f_slb_nlink = Wire.Field.v "nlink" Wire.uint32
219
+
let f_slb_target_size = Wire.Field.v "target_size" Wire.uint32
220
+
192
221
let symlink_body_codec =
193
-
let open Wire.Codec in
194
-
record "SquashfsSymlinkBody" (fun slb_nlink slb_target_size ->
195
-
{ slb_nlink; slb_target_size })
196
-
|+ field "nlink" Wire.uint32 (fun t -> t.slb_nlink)
197
-
|+ field "target_size" Wire.uint32 (fun t -> t.slb_target_size)
198
-
|> seal
222
+
Wire.Codec.v "SquashfsSymlinkBody"
223
+
(fun slb_nlink slb_target_size -> { slb_nlink; slb_target_size })
224
+
Wire.Codec.
225
+
[
226
+
(f_slb_nlink $ fun t -> t.slb_nlink);
227
+
(f_slb_target_size $ fun t -> t.slb_target_size);
228
+
]
199
229
200
230
let symlink_body_size = Wire.Codec.wire_size symlink_body_codec
201
231
···
206
236
dh_inode_number : int;
207
237
}
208
238
239
+
let f_dh_count = Wire.Field.v "count" Wire.uint32
240
+
let f_dh_start_block = Wire.Field.v "start_block" Wire.uint32
241
+
let f_dh_inode_number = Wire.Field.v "inode_number" Wire.uint32
242
+
209
243
let dir_header_codec =
210
-
let open Wire.Codec in
211
-
record "SquashfsDirHeader" (fun dh_count dh_start_block dh_inode_number ->
244
+
Wire.Codec.v "SquashfsDirHeader"
245
+
(fun dh_count dh_start_block dh_inode_number ->
212
246
{ dh_count; dh_start_block; dh_inode_number })
213
-
|+ field "count" Wire.uint32 (fun t -> t.dh_count)
214
-
|+ field "start_block" Wire.uint32 (fun t -> t.dh_start_block)
215
-
|+ field "inode_number" Wire.uint32 (fun t -> t.dh_inode_number)
216
-
|> seal
247
+
Wire.Codec.
248
+
[
249
+
(f_dh_count $ fun t -> t.dh_count);
250
+
(f_dh_start_block $ fun t -> t.dh_start_block);
251
+
(f_dh_inode_number $ fun t -> t.dh_inode_number);
252
+
]
217
253
218
254
let dir_header_size = Wire.Codec.wire_size dir_header_codec
219
255
···
225
261
de_name_size : int;
226
262
}
227
263
264
+
let f_de_inode_offset = Wire.Field.v "inode_offset" Wire.uint16
265
+
let f_de_inode_number = Wire.Field.v "inode_number" Wire.uint16
266
+
let f_de_entry_type = Wire.Field.v "entry_type" Wire.uint16
267
+
let f_de_name_size = Wire.Field.v "name_size" Wire.uint16
268
+
228
269
let dir_entry_header_codec =
229
-
let open Wire.Codec in
230
-
record "SquashfsDirEntryHeader"
270
+
Wire.Codec.v "SquashfsDirEntryHeader"
231
271
(fun de_inode_offset de_inode_number de_entry_type de_name_size ->
232
272
{ de_inode_offset; de_inode_number; de_entry_type; de_name_size })
233
-
|+ field "inode_offset" Wire.uint16 (fun t -> t.de_inode_offset)
234
-
|+ field "inode_number" Wire.uint16 (fun t -> t.de_inode_number)
235
-
|+ field "entry_type" Wire.uint16 (fun t -> t.de_entry_type)
236
-
|+ field "name_size" Wire.uint16 (fun t -> t.de_name_size)
237
-
|> seal
273
+
Wire.Codec.
274
+
[
275
+
(f_de_inode_offset $ fun t -> t.de_inode_offset);
276
+
(f_de_inode_number $ fun t -> t.de_inode_number);
277
+
(f_de_entry_type $ fun t -> t.de_entry_type);
278
+
(f_de_name_size $ fun t -> t.de_name_size);
279
+
]
238
280
239
281
let dir_entry_header_size = Wire.Codec.wire_size dir_entry_header_codec
240
282
···
288
330
sb_export_table_start;
289
331
}
290
332
333
+
let f_sb_magic = Wire.Field.v "magic" Wire.uint32
334
+
let f_sb_inode_count = Wire.Field.v "inode_count" Wire.uint32
335
+
let f_sb_modification_time = Wire.Field.v "modification_time" Wire.uint32
336
+
let f_sb_block_size = Wire.Field.v "block_size" Wire.uint32
337
+
let f_sb_fragment_entry_count = Wire.Field.v "fragment_entry_count" Wire.uint32
338
+
let f_sb_compression_id = Wire.Field.v "compression_id" Wire.uint16
339
+
let f_sb_block_log = Wire.Field.v "block_log" Wire.uint16
340
+
let f_sb_flags = Wire.Field.v "flags" Wire.uint16
341
+
let f_sb_id_count = Wire.Field.v "id_count" Wire.uint16
342
+
let f_sb_version_major = Wire.Field.v "version_major" Wire.uint16
343
+
let f_sb_version_minor = Wire.Field.v "version_minor" Wire.uint16
344
+
let f_sb_root_inode_ref = Wire.Field.v "root_inode_ref" Wire.uint64
345
+
let f_sb_bytes_used = Wire.Field.v "bytes_used" Wire.uint64
346
+
let f_sb_id_table_start = Wire.Field.v "id_table_start" Wire.uint64
347
+
let f_sb_xattr_table_start = Wire.Field.v "xattr_table_start" Wire.uint64
348
+
let f_sb_inode_table_start = Wire.Field.v "inode_table_start" Wire.uint64
349
+
350
+
let f_sb_directory_table_start =
351
+
Wire.Field.v "directory_table_start" Wire.uint64
352
+
353
+
let f_sb_fragment_table_start = Wire.Field.v "fragment_table_start" Wire.uint64
354
+
let f_sb_export_table_start = Wire.Field.v "export_table_start" Wire.uint64
355
+
291
356
let superblock_codec =
292
-
let open Wire.Codec in
293
-
record "SquashfsSuperblock" superblock
294
-
|+ field "magic" Wire.uint32 (fun t -> t.sb_magic)
295
-
|+ field "inode_count" Wire.uint32 (fun t -> t.sb_inode_count)
296
-
|+ field "modification_time" Wire.uint32 (fun t -> t.sb_modification_time)
297
-
|+ field "block_size" Wire.uint32 (fun t -> t.sb_block_size)
298
-
|+ field "fragment_entry_count" Wire.uint32 (fun t ->
299
-
t.sb_fragment_entry_count)
300
-
|+ field "compression_id" Wire.uint16 (fun t -> t.sb_compression_id)
301
-
|+ field "block_log" Wire.uint16 (fun t -> t.sb_block_log)
302
-
|+ field "flags" Wire.uint16 (fun t -> t.sb_flags)
303
-
|+ field "id_count" Wire.uint16 (fun t -> t.sb_id_count)
304
-
|+ field "version_major" Wire.uint16 (fun t -> t.sb_version_major)
305
-
|+ field "version_minor" Wire.uint16 (fun t -> t.sb_version_minor)
306
-
|+ field "root_inode_ref" Wire.uint64 (fun t -> t.sb_root_inode_ref)
307
-
|+ field "bytes_used" Wire.uint64 (fun t -> t.sb_bytes_used)
308
-
|+ field "id_table_start" Wire.uint64 (fun t -> t.sb_id_table_start)
309
-
|+ field "xattr_table_start" Wire.uint64 (fun t -> t.sb_xattr_table_start)
310
-
|+ field "inode_table_start" Wire.uint64 (fun t -> t.sb_inode_table_start)
311
-
|+ field "directory_table_start" Wire.uint64 (fun t ->
312
-
t.sb_directory_table_start)
313
-
|+ field "fragment_table_start" Wire.uint64 (fun t ->
314
-
t.sb_fragment_table_start)
315
-
|+ field "export_table_start" Wire.uint64 (fun t -> t.sb_export_table_start)
316
-
|> seal
357
+
Wire.Codec.v "SquashfsSuperblock" superblock
358
+
Wire.Codec.
359
+
[
360
+
(f_sb_magic $ fun t -> t.sb_magic);
361
+
(f_sb_inode_count $ fun t -> t.sb_inode_count);
362
+
(f_sb_modification_time $ fun t -> t.sb_modification_time);
363
+
(f_sb_block_size $ fun t -> t.sb_block_size);
364
+
(f_sb_fragment_entry_count $ fun t -> t.sb_fragment_entry_count);
365
+
(f_sb_compression_id $ fun t -> t.sb_compression_id);
366
+
(f_sb_block_log $ fun t -> t.sb_block_log);
367
+
(f_sb_flags $ fun t -> t.sb_flags);
368
+
(f_sb_id_count $ fun t -> t.sb_id_count);
369
+
(f_sb_version_major $ fun t -> t.sb_version_major);
370
+
(f_sb_version_minor $ fun t -> t.sb_version_minor);
371
+
(f_sb_root_inode_ref $ fun t -> t.sb_root_inode_ref);
372
+
(f_sb_bytes_used $ fun t -> t.sb_bytes_used);
373
+
(f_sb_id_table_start $ fun t -> t.sb_id_table_start);
374
+
(f_sb_xattr_table_start $ fun t -> t.sb_xattr_table_start);
375
+
(f_sb_inode_table_start $ fun t -> t.sb_inode_table_start);
376
+
(f_sb_directory_table_start $ fun t -> t.sb_directory_table_start);
377
+
(f_sb_fragment_table_start $ fun t -> t.sb_fragment_table_start);
378
+
(f_sb_export_table_start $ fun t -> t.sb_export_table_start);
379
+
]
317
380
318
381
let superblock_size = Wire.Codec.wire_size superblock_codec
319
382
···
560
623
else String.length block_data lor 0x1000000
561
624
in
562
625
let hdr = Bytes.create 4 in
563
-
Wire.UInt32.set_le hdr 0 header;
626
+
Wire.Private.UInt32.set_le hdr 0 header;
564
627
Buffer.add_bytes data_blocks hdr;
565
628
Buffer.add_string data_blocks block_data;
566
629
current_data_block :=
···
772
835
Buffer.add_buffer output id_table;
773
836
let id_table_start = Buffer.length output in
774
837
let id_ptr = Bytes.create 8 in
775
-
Wire.UInt32.set_le id_ptr 0
838
+
Wire.Private.UInt32.set_le id_ptr 0
776
839
(Int64.to_int (Int64.logand (Int64.of_int id_data_start) 0xffffffffL));
777
-
Wire.UInt32.set_le id_ptr 4
840
+
Wire.Private.UInt32.set_le id_ptr 4
778
841
(Int64.to_int (Int64.shift_right_logical (Int64.of_int id_data_start) 32));
779
842
Buffer.add_bytes output id_ptr;
780
843
id_table_start
···
832
895
let init_id_table () =
833
896
let buf = Buffer.create 64 in
834
897
let id_buf = Bytes.create 4 in
835
-
Wire.UInt32.set_le id_buf 0 0;
898
+
Wire.Private.UInt32.set_le id_buf 0 0;
836
899
Buffer.add_bytes buf id_buf;
837
900
buf
838
901
+5
-1
test/test_squashfs.ml
+5
-1
test/test_squashfs.ml
···
241
241
let size = Wire.Codec.wire_size Squashfs.superblock_codec in
242
242
let buf = Bytes.create size in
243
243
Wire.Codec.encode Squashfs.superblock_codec sb buf 0;
244
-
let sb' = Wire.Codec.decode Squashfs.superblock_codec buf 0 in
244
+
let sb' =
245
+
match Wire.Codec.decode Squashfs.superblock_codec buf 0 with
246
+
| Ok v -> v
247
+
| Error e -> Alcotest.failf "decode: %a" Wire.pp_parse_error e
248
+
in
245
249
Alcotest.(check int) "magic" sb.sb_magic sb'.sb_magic;
246
250
Alcotest.(check int) "inode_count" sb.sb_inode_count sb'.sb_inode_count;
247
251
Alcotest.(check int)