SquashFS compressed filesystem reader in pure OCaml
squashfs: Fix build errors
- Fix decompress library dependency (use decompress.de decompress.zl)
- Rewrite decompression to use correct Zl.Inf API
- Rename inode.data field to inode.inode_data to avoid shadowing
+309
-275
+6
-9
fuzz/fuzz_squashfs.ml
+6
-9
fuzz/fuzz_squashfs.ml
···
5
5
6
6
(** Fuzz tests for SquashFS.
7
7
8
-
Key properties tested:
9
-
1. No crashes on malformed input
10
-
2. Parser handles truncated data gracefully
11
-
*)
8
+
Key properties tested: 1. No crashes on malformed input 2. Parser handles
9
+
truncated data gracefully *)
12
10
13
11
open Crowbar
14
12
···
24
22
(* Create data with valid magic but random rest *)
25
23
let magic = "hsqs" in
26
24
let data = magic ^ input in
27
-
match Squashfs.of_string data with
28
-
| Ok _ -> ()
29
-
| Error _ -> ()
25
+
match Squashfs.of_string data with Ok _ -> () | Error _ -> ()
30
26
31
27
let () =
32
-
add_test ~name:"squashfs: no crash on arbitrary input" [bytes] test_no_crash;
33
-
add_test ~name:"squashfs: handle corrupted data after magic" [bytes] test_corrupted_after_magic
28
+
add_test ~name:"squashfs: no crash on arbitrary input" [ bytes ] test_no_crash;
29
+
add_test ~name:"squashfs: handle corrupted data after magic" [ bytes ]
30
+
test_corrupted_after_magic
+1
-1
lib/dune
+1
-1
lib/dune
+221
-211
lib/squashfs.ml
+221
-211
lib/squashfs.ml
···
8
8
let superblock_size = 96
9
9
10
10
(* Compression types *)
11
-
type compression =
12
-
| Gzip
13
-
| Lzma
14
-
| Lzo
15
-
| Xz
16
-
| Lz4
17
-
| Zstd
11
+
type compression = Gzip | Lzma | Lzo | Xz | Lz4 | Zstd
18
12
19
13
let compression_of_int = function
20
14
| 1 -> Ok Gzip
···
89
83
let pp_superblock ppf sb =
90
84
Format.fprintf ppf
91
85
"@[<v>SquashFS superblock:@,\
92
-
\ \ version: %d.%d@,\
93
-
\ \ compression: %a@,\
94
-
\ \ block_size: %d@,\
95
-
\ \ inode_count: %d@,\
96
-
\ \ bytes_used: %Ld@,\
97
-
\ \ modification_time: %d@]"
98
-
sb.version_major sb.version_minor
99
-
pp_compression sb.compression
86
+
\ version: %d.%d@,\
87
+
\ compression: %a@,\
88
+
\ block_size: %d@,\
89
+
\ inode_count: %d@,\
90
+
\ bytes_used: %Ld@,\
91
+
\ modification_time: %d@]"
92
+
sb.version_major sb.version_minor pp_compression sb.compression
100
93
sb.block_size sb.inode_count sb.bytes_used sb.modification_time
101
94
102
95
(* Inode representation *)
···
115
108
file_size : int64;
116
109
block_sizes : int array;
117
110
}
118
-
| Inode_symlink of {
119
-
nlink : int;
120
-
target : string;
121
-
}
122
-
| Inode_device of {
123
-
nlink : int;
124
-
rdev : int;
125
-
}
126
-
| Inode_ipc of {
127
-
nlink : int;
128
-
}
111
+
| Inode_symlink of { nlink : int; target : string }
112
+
| Inode_device of { nlink : int; rdev : int }
113
+
| Inode_ipc of { nlink : int }
129
114
130
115
type inode = {
131
116
inode_type : file_type;
···
134
119
gid_idx : int;
135
120
mtime : int;
136
121
inode_number : int;
137
-
data : inode_data;
122
+
inode_data : inode_data;
138
123
}
139
124
140
-
type entry = {
141
-
name : string;
142
-
inode : inode;
143
-
file_type : file_type;
144
-
}
125
+
type entry = { name : string; inode : inode; file_type : file_type }
145
126
146
127
(* Filesystem state *)
147
128
type t = {
···
157
138
158
139
(* Binary reading helpers *)
159
140
let get_u8 s off = Char.code (String.get s off)
160
-
let get_u16_le s off =
161
-
get_u8 s off lor (get_u8 s (off + 1) lsl 8)
141
+
let get_u16_le s off = get_u8 s off lor (get_u8 s (off + 1) lsl 8)
142
+
162
143
let get_u32_le s off =
163
-
Int32.to_int (
164
-
Int32.logor
165
-
(Int32.of_int (get_u16_le s off))
166
-
(Int32.shift_left (Int32.of_int (get_u16_le s (off + 2))) 16))
144
+
Int32.to_int
145
+
(Int32.logor
146
+
(Int32.of_int (get_u16_le s off))
147
+
(Int32.shift_left (Int32.of_int (get_u16_le s (off + 2))) 16))
148
+
167
149
let get_i32_le s off =
168
150
let v = get_u32_le s off in
169
151
if v >= 0x80000000 then v - 0x100000000 else v
152
+
170
153
let get_u64_le s off =
171
154
Int64.logor
172
155
(Int64.of_int (get_u32_le s off))
173
156
(Int64.shift_left (Int64.of_int (get_u32_le s (off + 4))) 32)
174
157
158
+
(* Decompress a metadata block using zlib *)
159
+
let decompress_zlib data max_output_size =
160
+
let input_len = String.length data in
161
+
let output_buf = De.bigstring_create max_output_size in
162
+
let window = De.make_window ~bits:15 in
163
+
let allocate _ = window in
164
+
let decoder = Zl.Inf.decoder (`String data) ~o:output_buf ~allocate in
165
+
let rec decode d acc_len =
166
+
match Zl.Inf.decode d with
167
+
| `Await _ -> Error "unexpected await in string source"
168
+
| `Flush d' ->
169
+
let len = De.bigstring_length output_buf - Zl.Inf.dst_rem d' in
170
+
decode (Zl.Inf.flush d') (acc_len + len)
171
+
| `End d' ->
172
+
let len = De.bigstring_length output_buf - Zl.Inf.dst_rem d' in
173
+
let total = acc_len + len in
174
+
let result = Bytes.create total in
175
+
for i = 0 to total - 1 do
176
+
Bytes.set result i (Bigarray.Array1.get output_buf i)
177
+
done;
178
+
Ok (Bytes.to_string result)
179
+
| `Malformed msg -> Error ("zlib decompression failed: " ^ msg)
180
+
in
181
+
ignore input_len;
182
+
decode decoder 0
183
+
175
184
(* Decompress a metadata block *)
176
185
let decompress_block t ~compressed data =
177
-
if not compressed then
178
-
Ok data
186
+
if not compressed then Ok data
179
187
else
180
188
match t.superblock.compression with
181
-
| Gzip ->
182
-
let input = De.bigstring_create (String.length data) in
183
-
for i = 0 to String.length data - 1 do
184
-
Bigarray.Array1.set input i (String.get data i)
185
-
done;
186
-
let output = De.bigstring_create (t.superblock.block_size * 2) in
187
-
(match De.Zl.Inf.Ns.inflate input output with
188
-
| Ok len ->
189
-
let result = Bytes.create len in
190
-
for i = 0 to len - 1 do
191
-
Bytes.set result i (Bigarray.Array1.get output i)
192
-
done;
193
-
Ok (Bytes.to_string result)
194
-
| Error _ -> Error "gzip decompression failed")
189
+
| Gzip -> decompress_zlib data (t.superblock.block_size * 2)
195
190
| Zstd ->
196
191
(* TODO: implement zstd decompression *)
197
192
Error "zstd decompression not yet implemented"
198
193
| _ ->
199
-
Error (Format.asprintf "compression %a not supported"
200
-
pp_compression t.superblock.compression)
194
+
Error
195
+
(Format.asprintf "compression %a not supported" pp_compression
196
+
t.superblock.compression)
201
197
202
198
(* Read a metadata block at the given offset *)
203
199
let read_metadata_block t offset =
···
205
201
Error "metadata block offset out of bounds"
206
202
else
207
203
let header = get_u16_le t.data offset in
208
-
let compressed = (header land 0x8000) = 0 in
204
+
let compressed = header land 0x8000 = 0 in
209
205
let size = header land 0x7fff in
210
206
if offset + 2 + size > String.length t.data then
211
207
Error "metadata block extends beyond image"
···
222
218
else
223
219
let magic_val = get_u32_le data 0 in
224
220
if Int32.of_int magic_val <> magic then
225
-
Error (Printf.sprintf "invalid magic: expected 0x%lx, got 0x%x"
226
-
magic magic_val)
221
+
Error
222
+
(Printf.sprintf "invalid magic: expected 0x%lx, got 0x%x" magic
223
+
magic_val)
227
224
else
228
225
let compression_id = get_u16_le data 20 in
229
226
match compression_of_int compression_id with
230
227
| Error e -> Error e
231
228
| Ok compression ->
232
-
Ok {
233
-
inode_count = get_u32_le data 4;
234
-
modification_time = get_u32_le data 8;
235
-
block_size = get_u32_le data 12;
236
-
fragment_entry_count = get_u32_le data 16;
237
-
compression;
238
-
block_log = get_u16_le data 22;
239
-
flags = get_u16_le data 24;
240
-
id_count = get_u16_le data 26;
241
-
version_major = get_u16_le data 28;
242
-
version_minor = get_u16_le data 30;
243
-
root_inode_ref = get_u64_le data 32;
244
-
bytes_used = get_u64_le data 40;
245
-
}
229
+
Ok
230
+
{
231
+
inode_count = get_u32_le data 4;
232
+
modification_time = get_u32_le data 8;
233
+
block_size = get_u32_le data 12;
234
+
fragment_entry_count = get_u32_le data 16;
235
+
compression;
236
+
block_log = get_u16_le data 22;
237
+
flags = get_u16_le data 24;
238
+
id_count = get_u16_le data 26;
239
+
version_major = get_u16_le data 28;
240
+
version_minor = get_u16_le data 30;
241
+
root_inode_ref = get_u64_le data 32;
242
+
bytes_used = get_u64_le data 40;
243
+
}
246
244
247
245
(* Parse an inode from metadata *)
248
246
let parse_inode _t data offset =
249
-
if offset + 16 > String.length data then
250
-
Error "inode header truncated"
247
+
if offset + 16 > String.length data then Error "inode header truncated"
251
248
else
252
249
let type_and_mode = get_u16_le data offset in
253
250
let inode_type_raw = type_and_mode land 0xf in
···
267
264
let file_size = get_u16_le data (offset + 24) in
268
265
let off = get_u16_le data (offset + 26) in
269
266
let parent = get_u32_le data (offset + 28) in
270
-
(Inode_dir {
271
-
start_block;
272
-
nlink;
273
-
file_size = file_size + 3; (* size includes . and .. *)
274
-
offset = off;
275
-
parent_inode = parent;
276
-
}, offset + 32)
267
+
( Inode_dir
268
+
{
269
+
start_block;
270
+
nlink;
271
+
file_size = file_size + 3;
272
+
(* size includes . and .. *)
273
+
offset = off;
274
+
parent_inode = parent;
275
+
},
276
+
offset + 32 )
277
277
| Regular ->
278
278
let start_block = Int64.of_int (get_u32_le data (offset + 16)) in
279
279
let fragment = get_i32_le data (offset + 20) in
280
280
let off = get_u32_le data (offset + 24) in
281
281
let file_size = Int64.of_int (get_u32_le data (offset + 28)) in
282
-
(Inode_file {
283
-
start_block;
284
-
fragment;
285
-
offset = off;
286
-
file_size;
287
-
block_sizes = [||]; (* TODO: parse block list *)
288
-
}, offset + 32)
282
+
( Inode_file
283
+
{
284
+
start_block;
285
+
fragment;
286
+
offset = off;
287
+
file_size;
288
+
block_sizes = [||];
289
+
(* TODO: parse block list *)
290
+
},
291
+
offset + 32 )
289
292
| Symlink ->
290
293
let nlink = get_u32_le data (offset + 16) in
291
294
let target_size = get_u32_le data (offset + 20) in
···
299
302
let nlink = get_u32_le data (offset + 16) in
300
303
(Inode_ipc { nlink }, offset + 20)
301
304
in
302
-
Ok {
303
-
inode_type;
304
-
mode = mode land 0o7777;
305
-
uid_idx;
306
-
gid_idx;
307
-
mtime;
308
-
inode_number;
309
-
data = inode_data;
310
-
}
305
+
Ok
306
+
{
307
+
inode_type;
308
+
mode = mode land 0o7777;
309
+
uid_idx;
310
+
gid_idx;
311
+
mtime;
312
+
inode_number;
313
+
inode_data;
314
+
}
311
315
312
316
(* Read the ID table *)
313
317
let read_id_table data sb =
314
318
let id_table_start = get_u64_le data 48 in
315
319
let count = sb.id_count in
316
-
if count = 0 then
317
-
Ok [||]
320
+
if count = 0 then Ok [||]
318
321
else
319
322
(* ID table is an array of block pointers, each block contains IDs *)
320
323
let table = Array.make count 0 in
···
323
326
let block_offset = Int64.to_int (get_u64_le data block_ptr_offset) in
324
327
(* Read the block header *)
325
328
let header = get_u16_le data block_offset in
326
-
let compressed = (header land 0x8000) = 0 in
329
+
let compressed = header land 0x8000 = 0 in
327
330
let size = header land 0x7fff in
328
331
if compressed then
329
332
(* For now, just read uncompressed *)
330
333
Error "compressed ID table not yet supported"
331
334
else begin
332
335
for i = 0 to min count (size / 4) - 1 do
333
-
table.(i) <- get_u32_le data (block_offset + 2 + i * 4)
336
+
table.(i) <- get_u32_le data (block_offset + 2 + (i * 4))
334
337
done;
335
338
Ok table
336
339
end
···
344
347
let abs_offset = inode_table_start + block_offset in
345
348
match read_metadata_block t abs_offset with
346
349
| Error e -> Error e
347
-
| Ok (block_data, _) ->
348
-
parse_inode t block_data offset_in_block
350
+
| Ok (block_data, _) -> parse_inode t block_data offset_in_block
349
351
350
352
let of_string data =
351
353
match parse_superblock data with
352
354
| Error e -> Error e
353
-
| Ok superblock ->
355
+
| Ok superblock -> (
354
356
if superblock.version_major <> 4 then
355
-
Error (Printf.sprintf "unsupported version: %d.%d (only 4.0 supported)"
356
-
superblock.version_major superblock.version_minor)
357
+
Error
358
+
(Printf.sprintf "unsupported version: %d.%d (only 4.0 supported)"
359
+
superblock.version_major superblock.version_minor)
357
360
else
358
361
let inode_table_start = get_u64_le data 48 in
359
362
let directory_table_start = get_u64_le data 56 in
···
363
366
let xattr_table_start = get_u64_le data 88 in
364
367
match read_id_table data superblock with
365
368
| Error e -> Error e
366
-
| Ok id_table ->
367
-
let t = {
368
-
data;
369
-
superblock;
370
-
id_table;
371
-
root_inode = {
372
-
inode_type = Directory;
373
-
mode = 0o755;
374
-
uid_idx = 0;
375
-
gid_idx = 0;
376
-
mtime = 0;
377
-
inode_number = 0;
378
-
data = Inode_dir {
379
-
start_block = 0;
380
-
nlink = 0;
381
-
file_size = 0;
382
-
offset = 0;
383
-
parent_inode = 0;
384
-
};
385
-
};
386
-
inode_table_start;
387
-
directory_table_start;
388
-
fragment_table_start;
389
-
xattr_table_start;
390
-
} in
369
+
| Ok id_table -> (
370
+
let t =
371
+
{
372
+
data;
373
+
superblock;
374
+
id_table;
375
+
root_inode =
376
+
{
377
+
inode_type = Directory;
378
+
mode = 0o755;
379
+
uid_idx = 0;
380
+
gid_idx = 0;
381
+
mtime = 0;
382
+
inode_number = 0;
383
+
inode_data =
384
+
Inode_dir
385
+
{
386
+
start_block = 0;
387
+
nlink = 0;
388
+
file_size = 0;
389
+
offset = 0;
390
+
parent_inode = 0;
391
+
};
392
+
};
393
+
inode_table_start;
394
+
directory_table_start;
395
+
fragment_table_start;
396
+
xattr_table_start;
397
+
}
398
+
in
391
399
match read_root_inode t with
392
400
| Error e -> Error e
393
-
| Ok root_inode -> Ok { t with root_inode }
401
+
| Ok root_inode -> Ok { t with root_inode }))
394
402
395
403
let of_reader reader =
396
404
(* Read entire image into memory for random access *)
···
407
415
408
416
let superblock t = t.superblock
409
417
let root t = t.root_inode
410
-
411
418
let inode_type inode = inode.inode_type
412
419
let inode_mode inode = inode.mode
413
420
let inode_mtime inode = inode.mtime
414
421
415
422
let inode_uid t inode =
416
-
if inode.uid_idx < Array.length t.id_table then
417
-
t.id_table.(inode.uid_idx)
423
+
if inode.uid_idx < Array.length t.id_table then t.id_table.(inode.uid_idx)
418
424
else 0
419
425
420
426
let inode_gid t inode =
421
-
if inode.gid_idx < Array.length t.id_table then
422
-
t.id_table.(inode.gid_idx)
427
+
if inode.gid_idx < Array.length t.id_table then t.id_table.(inode.gid_idx)
423
428
else 0
424
429
425
430
let inode_size inode =
426
-
match inode.data with
431
+
match inode.inode_data with
427
432
| Inode_file { file_size; _ } -> file_size
428
433
| Inode_dir { file_size; _ } -> Int64.of_int file_size
429
434
| Inode_symlink { target; _ } -> Int64.of_int (String.length target)
430
435
| _ -> 0L
431
436
432
437
let inode_nlink inode =
433
-
match inode.data with
438
+
match inode.inode_data with
434
439
| Inode_dir { nlink; _ } -> nlink
435
440
| Inode_file _ -> 1
436
441
| Inode_symlink { nlink; _ } -> nlink
···
438
443
| Inode_ipc { nlink } -> nlink
439
444
440
445
let device_major inode =
441
-
match inode.data with
446
+
match inode.inode_data with
442
447
| Inode_device { rdev; _ } -> (rdev lsr 8) land 0xfff
443
448
| _ -> 0
444
449
445
450
let device_minor inode =
446
-
match inode.data with
451
+
match inode.inode_data with
447
452
| Inode_device { rdev; _ } -> rdev land 0xff
448
453
| _ -> 0
449
454
450
455
(* Directory reading *)
451
456
let readdir t inode =
452
-
match inode.data with
453
-
| Inode_dir { start_block; offset; file_size; _ } ->
457
+
match inode.inode_data with
458
+
| Inode_dir { start_block; offset; file_size; _ } -> (
454
459
let dir_table_start = Int64.to_int t.directory_table_start in
455
460
let abs_offset = dir_table_start + start_block in
456
-
(match read_metadata_block t abs_offset with
457
-
| Error e -> Error e
458
-
| Ok (block_data, _) ->
459
-
(* Parse directory entries *)
460
-
let entries = ref [] in
461
-
let pos = ref offset in
462
-
let remaining = ref file_size in
463
-
while !remaining > 0 && !pos + 12 <= String.length block_data do
464
-
let count = get_u32_le block_data !pos + 1 in
465
-
let _start = get_u32_le block_data (!pos + 4) in
466
-
let _inode_number = get_u32_le block_data (!pos + 8) in
467
-
pos := !pos + 12;
468
-
for _ = 0 to count - 1 do
469
-
if !pos + 8 <= String.length block_data then begin
470
-
let _offset = get_u16_le block_data !pos in
471
-
let _inode_off = get_u16_le block_data (!pos + 2) in
472
-
let entry_type = get_u16_le block_data (!pos + 4) in
473
-
let name_size = get_u16_le block_data (!pos + 6) + 1 in
474
-
if !pos + 8 + name_size <= String.length block_data then begin
475
-
let name = String.sub block_data (!pos + 8) name_size in
476
-
(match file_type_of_int entry_type with
477
-
| Ok file_type ->
478
-
entries := {
461
+
match read_metadata_block t abs_offset with
462
+
| Error e -> Error e
463
+
| Ok (block_data, _) ->
464
+
(* Parse directory entries *)
465
+
let entries = ref [] in
466
+
let pos = ref offset in
467
+
let remaining = ref file_size in
468
+
while !remaining > 0 && !pos + 12 <= String.length block_data do
469
+
let count = get_u32_le block_data !pos + 1 in
470
+
let _start = get_u32_le block_data (!pos + 4) in
471
+
let _inode_number = get_u32_le block_data (!pos + 8) in
472
+
pos := !pos + 12;
473
+
for _ = 0 to count - 1 do
474
+
if !pos + 8 <= String.length block_data then begin
475
+
let _offset = get_u16_le block_data !pos in
476
+
let _inode_off = get_u16_le block_data (!pos + 2) in
477
+
let entry_type = get_u16_le block_data (!pos + 4) in
478
+
let name_size = get_u16_le block_data (!pos + 6) + 1 in
479
+
if !pos + 8 + name_size <= String.length block_data then begin
480
+
let name = String.sub block_data (!pos + 8) name_size in
481
+
(match file_type_of_int entry_type with
482
+
| Ok file_type ->
483
+
entries :=
484
+
{
479
485
name;
480
-
inode = t.root_inode; (* placeholder *)
486
+
inode = t.root_inode;
487
+
(* placeholder *)
481
488
file_type;
482
-
} :: !entries
483
-
| Error _ -> ());
484
-
pos := !pos + 8 + name_size
485
-
end else
486
-
remaining := 0
487
-
end else
488
-
remaining := 0
489
-
done;
490
-
remaining := !remaining - (!pos - offset)
491
-
done;
492
-
Ok (List.rev !entries))
489
+
}
490
+
:: !entries
491
+
| Error _ -> ());
492
+
pos := !pos + 8 + name_size
493
+
end
494
+
else remaining := 0
495
+
end
496
+
else remaining := 0
497
+
done;
498
+
remaining := !remaining - (!pos - offset)
499
+
done;
500
+
Ok (List.rev !entries))
493
501
| _ -> Error "not a directory"
494
502
495
503
let lookup t dir name =
496
504
match readdir t dir with
497
505
| Error e -> Error e
498
506
| Ok entries ->
499
-
Ok (List.find_opt (fun e -> e.name = name) entries
500
-
|> Option.map (fun e -> e.inode))
507
+
Ok
508
+
(List.find_opt (fun e -> e.name = name) entries
509
+
|> Option.map (fun e -> e.inode))
501
510
502
511
let resolve t path =
503
512
let components =
504
-
String.split_on_char '/' path
505
-
|> List.filter (fun s -> s <> "" && s <> ".")
513
+
String.split_on_char '/' path |> List.filter (fun s -> s <> "" && s <> ".")
506
514
in
507
515
let rec go inode = function
508
516
| [] -> Ok (Some inode)
509
517
| ".." :: rest ->
510
518
(* TODO: handle parent properly *)
511
519
go inode rest
512
-
| name :: rest ->
520
+
| name :: rest -> (
513
521
match lookup t inode name with
514
522
| Error e -> Error e
515
523
| Ok None -> Ok None
516
-
| Ok (Some child) -> go child rest
524
+
| Ok (Some child) -> go child rest)
517
525
in
518
526
go t.root_inode components
519
527
520
528
(* File reading *)
521
529
let read_file t inode =
522
-
match inode.data with
530
+
match inode.inode_data with
523
531
| Inode_file { start_block; file_size; fragment; offset; _ } ->
524
532
if fragment >= 0 then
525
533
(* File is in fragment *)
526
534
Error "fragment reading not yet implemented"
527
-
else if file_size = 0L then
528
-
Ok ""
535
+
else if file_size = 0L then Ok ""
529
536
else
530
537
(* Read from data blocks *)
531
538
let abs_offset = Int64.to_int start_block in
···
537
544
if abs_offset + size <= String.length t.data then
538
545
(* Try reading as uncompressed first *)
539
546
let header = get_u16_le t.data abs_offset in
540
-
let compressed = (header land 0x8000) = 0 in
547
+
let compressed = header land 0x8000 = 0 in
541
548
let block_size = header land 0x7fff in
542
-
if not compressed && abs_offset + 2 + block_size <= String.length t.data then
543
-
Ok (String.sub t.data (abs_offset + 2) (min block_size size))
549
+
if
550
+
(not compressed)
551
+
&& abs_offset + 2 + block_size <= String.length t.data
552
+
then Ok (String.sub t.data (abs_offset + 2) (min block_size size))
544
553
else if compressed then
545
554
match read_metadata_block t abs_offset with
546
555
| Error e -> Error e
547
-
| Ok (data, _) -> Ok (String.sub data offset (min (String.length data - offset) size))
548
-
else
549
-
Error "file extends beyond image"
550
-
else
551
-
Error "file extends beyond image"
556
+
| Ok (data, _) ->
557
+
Ok
558
+
(String.sub data offset
559
+
(min (String.length data - offset) size))
560
+
else Error "file extends beyond image"
561
+
else Error "file extends beyond image"
552
562
| _ -> Error "not a regular file"
553
563
554
564
let read_link _t inode =
555
-
match inode.data with
565
+
match inode.inode_data with
556
566
| Inode_symlink { target; _ } -> Ok target
557
567
| _ -> Error "not a symbolic link"
558
568
559
569
(* Extended attributes *)
560
-
let has_xattrs t =
561
-
t.xattr_table_start <> 0xffffffffffffffffL
570
+
let has_xattrs t = t.xattr_table_start <> 0xffffffffffffffffL
562
571
563
572
let get_xattr _t _inode _name =
564
573
(* TODO: implement xattr reading *)
···
572
581
let fold f t init =
573
582
let rec traverse path inode acc =
574
583
let acc = f path inode acc in
575
-
match inode.data with
576
-
| Inode_dir _ ->
577
-
(match readdir t inode with
578
-
| Error _ -> acc
579
-
| Ok entries ->
580
-
List.fold_left (fun acc entry ->
581
-
let child_path =
582
-
if path = "/" then "/" ^ entry.name
583
-
else path ^ "/" ^ entry.name
584
-
in
585
-
traverse child_path entry.inode acc
586
-
) acc entries)
584
+
match inode.inode_data with
585
+
| Inode_dir _ -> (
586
+
match readdir t inode with
587
+
| Error _ -> acc
588
+
| Ok entries ->
589
+
List.fold_left
590
+
(fun acc entry ->
591
+
let child_path =
592
+
if path = "/" then "/" ^ entry.name
593
+
else path ^ "/" ^ entry.name
594
+
in
595
+
traverse child_path entry.inode acc)
596
+
acc entries)
587
597
| _ -> acc
588
598
in
589
599
Ok (traverse "/" t.root_inode init)
+28
-36
lib/squashfs.mli
+28
-36
lib/squashfs.mli
···
16
16
{2 References}
17
17
18
18
- {{:https://dr-emann.github.io/squashfs/} SquashFS specification}
19
-
- {{:https://www.kernel.org/doc/html/latest/filesystems/squashfs.html}
20
-
Linux kernel documentation} *)
19
+
- {{:https://www.kernel.org/doc/html/latest/filesystems/squashfs.html} Linux
20
+
kernel documentation} *)
21
21
22
22
(** {1 Types} *)
23
23
···
27
27
| Lzo
28
28
| Xz
29
29
| Lz4
30
-
| Zstd
31
-
(** Compression algorithms supported by SquashFS. *)
30
+
| Zstd (** Compression algorithms supported by SquashFS. *)
32
31
33
32
type t
34
33
(** A SquashFS filesystem image. *)
···
43
42
| Block_device
44
43
| Char_device
45
44
| Fifo
46
-
| Socket
47
-
(** File types in SquashFS. *)
45
+
| Socket (** File types in SquashFS. *)
48
46
49
-
type entry = {
50
-
name : string;
51
-
inode : inode;
52
-
file_type : file_type;
53
-
}
47
+
type entry = { name : string; inode : inode; file_type : file_type }
54
48
(** A directory entry. *)
55
49
56
50
(** {1 Superblock Information} *)
···
80
74
(** [of_string data] opens a SquashFS image from a string. *)
81
75
82
76
val of_reader : Bytesrw.Bytes.Reader.t -> (t, string) result
83
-
(** [of_reader reader] opens a SquashFS image from a byte reader.
84
-
The reader must support random access (seeking). *)
77
+
(** [of_reader reader] opens a SquashFS image from a byte reader. The reader
78
+
must support random access (seeking). *)
85
79
86
80
(** {1 Navigation} *)
87
81
···
104
98
(** [inode_mtime inode] returns the modification time (Unix timestamp). *)
105
99
106
100
val inode_size : inode -> int64
107
-
(** [inode_size inode] returns the file size in bytes.
108
-
For directories, this is the uncompressed directory listing size. *)
101
+
(** [inode_size inode] returns the file size in bytes. For directories, this is
102
+
the uncompressed directory listing size. *)
109
103
110
104
val inode_nlink : inode -> int
111
105
(** [inode_nlink inode] returns the hard link count. *)
···
113
107
(** {1 Directory Operations} *)
114
108
115
109
val readdir : t -> inode -> (entry list, string) result
116
-
(** [readdir t inode] lists entries in a directory.
117
-
Returns [Error] if [inode] is not a directory. *)
110
+
(** [readdir t inode] lists entries in a directory. Returns [Error] if [inode]
111
+
is not a directory. *)
118
112
119
113
val lookup : t -> inode -> string -> (inode option, string) result
120
-
(** [lookup t dir name] looks up an entry by name in a directory.
121
-
Returns [None] if not found, [Error] if [dir] is not a directory. *)
114
+
(** [lookup t dir name] looks up an entry by name in a directory. Returns [None]
115
+
if not found, [Error] if [dir] is not a directory. *)
122
116
123
117
val resolve : t -> string -> (inode option, string) result
124
-
(** [resolve t path] resolves an absolute path to an inode.
125
-
Path components are separated by [/]. Leading [/] is optional.
126
-
Returns [None] if the path does not exist. *)
118
+
(** [resolve t path] resolves an absolute path to an inode. Path components are
119
+
separated by [/]. Leading [/] is optional. Returns [None] if the path does
120
+
not exist. *)
127
121
128
122
(** {1 File Operations} *)
129
123
130
124
val read_file : t -> inode -> (string, string) result
131
-
(** [read_file t inode] reads the entire contents of a regular file.
132
-
Returns [Error] if [inode] is not a regular file. *)
125
+
(** [read_file t inode] reads the entire contents of a regular file. Returns
126
+
[Error] if [inode] is not a regular file. *)
133
127
134
128
val read_link : t -> inode -> (string, string) result
135
-
(** [read_link t inode] reads the target of a symbolic link.
136
-
Returns [Error] if [inode] is not a symlink. *)
129
+
(** [read_link t inode] reads the target of a symbolic link. Returns [Error] if
130
+
[inode] is not a symlink. *)
137
131
138
132
(** {1 Device Operations} *)
139
133
140
134
val device_major : inode -> int
141
-
(** [device_major inode] returns the major device number.
142
-
Only valid for block/char device inodes. *)
135
+
(** [device_major inode] returns the major device number. Only valid for
136
+
block/char device inodes. *)
143
137
144
138
val device_minor : inode -> int
145
-
(** [device_minor inode] returns the minor device number.
146
-
Only valid for block/char device inodes. *)
139
+
(** [device_minor inode] returns the minor device number. Only valid for
140
+
block/char device inodes. *)
147
141
148
142
(** {1 Extended Attributes} *)
149
143
···
151
145
(** [has_xattrs t] returns [true] if the filesystem has extended attributes. *)
152
146
153
147
val get_xattr : t -> inode -> string -> (string option, string) result
154
-
(** [get_xattr t inode name] gets an extended attribute value.
155
-
Returns [None] if the attribute doesn't exist. *)
148
+
(** [get_xattr t inode name] gets an extended attribute value. Returns [None] if
149
+
the attribute doesn't exist. *)
156
150
157
151
val list_xattrs : t -> inode -> (string list, string) result
158
152
(** [list_xattrs t inode] lists all extended attribute names. *)
159
153
160
154
(** {1 Filesystem Traversal} *)
161
155
162
-
val fold :
163
-
(string -> inode -> 'a -> 'a) -> t -> 'a -> ('a, string) result
156
+
val fold : (string -> inode -> 'a -> 'a) -> t -> 'a -> ('a, string) result
164
157
(** [fold f t init] traverses the entire filesystem depth-first.
165
158
[f path inode acc] is called for each entry with its full path. *)
166
159
167
-
val iter :
168
-
(string -> inode -> unit) -> t -> (unit, string) result
160
+
val iter : (string -> inode -> unit) -> t -> (unit, string) result
169
161
(** [iter f t] iterates over all entries in the filesystem. *)
170
162
171
163
(** {1 Pretty Printing} *)
+36
squashfs.opam
+36
squashfs.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "SquashFS compressed filesystem reader in pure OCaml"
4
+
description: """
5
+
Pure OCaml implementation for reading SquashFS compressed filesystems.
6
+
Supports gzip and zstd compression. Useful for reading initramfs images,
7
+
container filesystems, and embedded system images."""
8
+
maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
9
+
authors: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
10
+
license: "MIT"
11
+
homepage: "https://tangled.org/gazagnaire.org/ocaml-squashfs"
12
+
bug-reports: "https://tangled.org/gazagnaire.org/ocaml-squashfs/issues"
13
+
depends: [
14
+
"dune" {>= "3.0"}
15
+
"ocaml" {>= "5.1"}
16
+
"bytesrw" {>= "0.2"}
17
+
"decompress" {>= "1.5"}
18
+
"alcotest" {with-test}
19
+
"crowbar" {with-test}
20
+
"odoc" {with-doc}
21
+
]
22
+
build: [
23
+
["dune" "subst"] {dev}
24
+
[
25
+
"dune"
26
+
"build"
27
+
"-p"
28
+
name
29
+
"-j"
30
+
jobs
31
+
"@install"
32
+
"@runtest" {with-test}
33
+
"@doc" {with-doc}
34
+
]
35
+
]
36
+
dev-repo: "https://tangled.org/gazagnaire.org/ocaml-squashfs"
+17
-18
test/test_squashfs.ml
+17
-18
test/test_squashfs.ml
···
14
14
let data = String.make 50 '\x00' in
15
15
match Squashfs.of_string data with
16
16
| Error msg ->
17
-
Alcotest.(check bool) "error mentions size" true
18
-
(String.length msg > 0)
19
-
| Ok _ ->
20
-
Alcotest.fail "should reject short data"
17
+
Alcotest.(check bool) "error mentions size" true (String.length msg > 0)
18
+
| Ok _ -> Alcotest.fail "should reject short data"
21
19
22
20
(* Test: reject invalid magic *)
23
21
let test_invalid_magic () =
24
22
let data = String.make 100 '\x00' in
25
23
match Squashfs.of_string data with
26
24
| Error msg ->
27
-
Alcotest.(check bool) "error mentions magic" true
28
-
(String.length msg > 0)
29
-
| Ok _ ->
30
-
Alcotest.fail "should reject invalid magic"
25
+
Alcotest.(check bool) "error mentions magic" true (String.length msg > 0)
26
+
| Ok _ -> Alcotest.fail "should reject invalid magic"
31
27
32
28
(* Test: compression pretty printer *)
33
29
let test_pp_compression () =
···
45
41
Format.pp_print_flush ppf ();
46
42
Alcotest.(check string) "directory" "directory" (Buffer.contents buf)
47
43
48
-
let suite = [
49
-
"errors", [
50
-
Alcotest.test_case "too short" `Quick test_too_short;
51
-
Alcotest.test_case "invalid magic" `Quick test_invalid_magic;
52
-
];
53
-
"pretty_print", [
54
-
Alcotest.test_case "compression" `Quick test_pp_compression;
55
-
Alcotest.test_case "file_type" `Quick test_pp_file_type;
56
-
];
57
-
]
44
+
let suite =
45
+
[
46
+
( "errors",
47
+
[
48
+
Alcotest.test_case "too short" `Quick test_too_short;
49
+
Alcotest.test_case "invalid magic" `Quick test_invalid_magic;
50
+
] );
51
+
( "pretty_print",
52
+
[
53
+
Alcotest.test_case "compression" `Quick test_pp_compression;
54
+
Alcotest.test_case "file_type" `Quick test_pp_file_type;
55
+
] );
56
+
]