Minimal bootable disk image builder
fix(uniboot): pass all merlint checks
- Extract assign_lbas/gpt_partitions/write_disk_contents helpers (E005)
- Extract cmdliner arg definitions outside build_cmd (E005)
- Rename main_cmd -> cmd (E330)
- Rename find_in -> locate_in in source.ml (E331)
- Add source.mli exposing only resolve (E331, E505)
- Fix config doc period (E410)
- Restructure tests: test_uniboot.ml exports suite, add test.ml runner (E600)
- Add test_source.ml and test_source.mli (E605)
+127
-102
+33
-36
bin/main.ml
+33
-36
bin/main.ml
···
14
14
15
15
(* Build command *)
16
16
17
+
let output_arg =
18
+
let doc = "Output disk image file path." in
19
+
Arg.(
20
+
required & opt (some string) None & info [ "o"; "output" ] ~docv:"FILE" ~doc)
21
+
22
+
let kernel_arg =
23
+
let doc = "Path to kernel image (e.g., vmlinuz)." in
24
+
Arg.(value & opt (some file) None & info [ "k"; "kernel" ] ~docv:"FILE" ~doc)
25
+
26
+
let initramfs_arg =
27
+
let doc = "Paths to include in initramfs (cpio archive)." in
28
+
Arg.(value & opt_all file [] & info [ "i"; "initramfs" ] ~docv:"PATH" ~doc)
29
+
30
+
let rootfs_arg =
31
+
let doc = "Paths to include in rootfs (squashfs)." in
32
+
Arg.(value & opt_all file [] & info [ "r"; "rootfs" ] ~docv:"PATH" ~doc)
33
+
34
+
let esp_size_arg =
35
+
let doc = "EFI System Partition size in MB." in
36
+
Arg.(value & opt int 64 & info [ "esp-size" ] ~docv:"MB" ~doc)
37
+
38
+
let rootfs_size_arg =
39
+
let doc = "Root filesystem partition size in MB." in
40
+
Arg.(value & opt int 256 & info [ "rootfs-size" ] ~docv:"MB" ~doc)
41
+
42
+
let sector_size_arg =
43
+
let doc = "Disk sector size (512 or 4096)." in
44
+
Arg.(value & opt int 512 & info [ "sector-size" ] ~docv:"BYTES" ~doc)
45
+
17
46
let build_cmd =
18
-
let output =
19
-
let doc = "Output disk image file path." in
20
-
Arg.(
21
-
required
22
-
& opt (some string) None
23
-
& info [ "o"; "output" ] ~docv:"FILE" ~doc)
24
-
in
25
-
let kernel =
26
-
let doc = "Path to kernel image (e.g., vmlinuz)." in
27
-
Arg.(
28
-
value & opt (some file) None & info [ "k"; "kernel" ] ~docv:"FILE" ~doc)
29
-
in
30
-
let initramfs =
31
-
let doc = "Paths to include in initramfs (cpio archive)." in
32
-
Arg.(value & opt_all file [] & info [ "i"; "initramfs" ] ~docv:"PATH" ~doc)
33
-
in
34
-
let rootfs =
35
-
let doc = "Paths to include in rootfs (squashfs)." in
36
-
Arg.(value & opt_all file [] & info [ "r"; "rootfs" ] ~docv:"PATH" ~doc)
37
-
in
38
-
let esp_size =
39
-
let doc = "EFI System Partition size in MB." in
40
-
Arg.(value & opt int 64 & info [ "esp-size" ] ~docv:"MB" ~doc)
41
-
in
42
-
let rootfs_size =
43
-
let doc = "Root filesystem partition size in MB." in
44
-
Arg.(value & opt int 256 & info [ "rootfs-size" ] ~docv:"MB" ~doc)
45
-
in
46
-
let sector_size =
47
-
let doc = "Disk sector size (512 or 4096)." in
48
-
Arg.(value & opt int 512 & info [ "sector-size" ] ~docv:"BYTES" ~doc)
49
-
in
50
47
let build output kernel initramfs rootfs esp_size rootfs_size sector_size () =
51
48
Log.info (fun m -> m "Building disk image: %s" output);
52
49
let partitions =
···
93
90
Cmd.v info
94
91
Term.(
95
92
ret
96
-
(const build $ output $ kernel $ initramfs $ rootfs $ esp_size
97
-
$ rootfs_size $ sector_size $ setup))
93
+
(const build $ output_arg $ kernel_arg $ initramfs_arg $ rootfs_arg
94
+
$ esp_size_arg $ rootfs_size_arg $ sector_size_arg $ setup))
98
95
99
96
(* Inspect command *)
100
97
···
149
146
150
147
(* Main command *)
151
148
152
-
let main_cmd =
149
+
let cmd =
153
150
let doc = "Minimal bootable disk image builder" in
154
151
let man =
155
152
[
···
170
167
let info = Cmd.info "uniboot" ~version:Monopam_info.version ~doc ~man in
171
168
Cmd.group info [ build_cmd; inspect_cmd ]
172
169
173
-
let () = exit (Cmd.eval main_cmd)
170
+
let () = exit (Cmd.eval cmd)
+5
-5
lib/source.ml
+5
-5
lib/source.ml
···
22
22
| _ -> false
23
23
| exception Eio.Io _ -> false
24
24
25
-
let rec find_in fs ~names dir =
25
+
let rec locate_in fs ~names dir =
26
26
let entries =
27
27
try Eio.Path.read_dir Eio.Path.(fs / dir) with Eio.Io _ -> []
28
28
in
···
41
41
if is_dir fs path then Some path else None)
42
42
entries
43
43
in
44
-
List.find_map (find_in fs ~names) subdirs
44
+
List.find_map (locate_in fs ~names) subdirs
45
45
46
46
let xdge env =
47
47
let fs = Eio.Stdenv.fs env in
···
77
77
if is_file fs spec then spec
78
78
(* 2. Local directory — search for named files in it *)
79
79
else if is_dir fs spec then
80
-
match find_in fs ~names spec with
80
+
match locate_in fs ~names spec with
81
81
| Some path -> path
82
82
| None ->
83
83
failwith
···
93
93
let xdge = xdge env in
94
94
let checkout = checkout_dir xdge in
95
95
let image_dir = Filename.concat checkout (Oci.Image.to_string image) in
96
-
match find_in fs ~names image_dir with
96
+
match locate_in fs ~names image_dir with
97
97
| Some path ->
98
98
Fmt.pr " %s (cached)@." path;
99
99
path
···
101
101
let cache = oci_cache xdge in
102
102
oci_fetch ~env ~cache ?platform image;
103
103
oci_checkout ~env ~cache ~checkout_dir:checkout ?platform image;
104
-
match find_in fs ~names image_dir with
104
+
match locate_in fs ~names image_dir with
105
105
| Some path ->
106
106
Fmt.pr " %s@." path;
107
107
path
+19
lib/source.mli
+19
lib/source.mli
···
1
+
(** Resolve component images from local files or OCI registries. *)
2
+
3
+
val resolve :
4
+
env:
5
+
< fs : Eio.Fs.dir_ty Eio.Path.t
6
+
; net : [> [> `Generic ] Eio.Net.ty ] Eio.Net.t
7
+
; clock : [> float Eio.Time.clock_ty ] Eio.Time.clock
8
+
; domain_mgr : Eio.Domain_manager.ty Eio.Domain_manager.t
9
+
; .. > ->
10
+
names:string list ->
11
+
?platform:string ->
12
+
string ->
13
+
string
14
+
(** [resolve ~env ~names ?platform spec] resolves a component spec to a file
15
+
path.
16
+
17
+
[spec] may be a local file path, a local directory to search, or an OCI
18
+
image reference. When [spec] is a directory or OCI image, [names] lists the
19
+
filenames to search for. *)
+34
-48
lib/uniboot.ml
+34
-48
lib/uniboot.ml
···
167
167
Log.warn (fun m -> m "Squashfs building not yet implemented");
168
168
write_zeros writer size_bytes
169
169
170
-
let build config writer =
171
-
let sector_size = config.sector_size in
172
-
let disk_sectors = calculate_disk_size config in
173
-
Log.info (fun m ->
174
-
m "Building disk image: %Ld sectors (%Ld bytes)" disk_sectors
175
-
(Int64.mul disk_sectors (Int64.of_int sector_size)));
176
-
177
-
(* Calculate partition LBAs *)
170
+
let assign_lbas ~sector_size partitions =
178
171
let first_usable_lba = 34L in
179
-
let partitions_with_lba =
180
-
let _, parts =
181
-
List.fold_left
182
-
(fun (lba, acc) p ->
183
-
let size_sectors =
184
-
Int64.of_int (p.Partition.size_mb * 1024 * 1024 / sector_size)
185
-
in
186
-
let end_lba = Int64.sub (Int64.add lba size_sectors) 1L in
187
-
(Int64.add end_lba 1L, (p, lba, end_lba) :: acc))
188
-
(first_usable_lba, []) config.partitions
189
-
in
190
-
List.rev parts
191
-
in
192
-
193
-
(* Create GPT partitions *)
194
-
let* gpt_partitions =
172
+
let _, parts =
195
173
List.fold_left
196
-
(fun acc (p, start_lba, end_lba) ->
197
-
let* parts = acc in
198
-
let* part =
199
-
Gpt.Partition.make ~name:p.Partition.name
200
-
~type_guid:p.Partition.type_guid ~attributes:0L start_lba end_lba
174
+
(fun (lba, acc) p ->
175
+
let size_sectors =
176
+
Int64.of_int (p.Partition.size_mb * 1024 * 1024 / sector_size)
201
177
in
202
-
Ok (part :: parts))
203
-
(Ok []) partitions_with_lba
204
-
|> Result.map List.rev
178
+
let end_lba = Int64.sub (Int64.add lba size_sectors) 1L in
179
+
(Int64.add end_lba 1L, (p, lba, end_lba) :: acc))
180
+
(first_usable_lba, []) partitions
205
181
in
182
+
List.rev parts
206
183
207
-
(* Create GPT *)
208
-
let* gpt = Gpt.v ~disk_sectors ~sector_size gpt_partitions in
209
-
Log.info (fun m ->
210
-
m "Created GPT with %d partitions" (List.length gpt_partitions));
184
+
let gpt_partitions partitions_with_lba =
185
+
List.fold_left
186
+
(fun acc (p, start_lba, end_lba) ->
187
+
let* parts = acc in
188
+
let* part =
189
+
Gpt.Partition.make ~name:p.Partition.name
190
+
~type_guid:p.Partition.type_guid ~attributes:0L start_lba end_lba
191
+
in
192
+
Ok (part :: parts))
193
+
(Ok []) partitions_with_lba
194
+
|> Result.map List.rev
211
195
212
-
(* Write protective MBR (sector 0) *)
196
+
let write_disk_contents writer ~sector_size gpt partitions_with_lba =
213
197
let mbr = Gpt.protective_mbr ~sector_size gpt in
214
198
Mbr.write writer mbr;
215
199
Log.debug (fun m -> m "Wrote protective MBR");
216
-
217
-
(* Write primary GPT header (sector 1) *)
218
200
Gpt.write_header writer ~sector_size ~primary:true gpt;
219
201
Log.debug (fun m -> m "Wrote primary GPT header");
220
-
221
-
(* Write partition table (sectors 2-33) *)
222
202
Gpt.write_partition_table writer ~sector_size gpt;
223
203
Log.debug (fun m -> m "Wrote partition table");
224
-
225
-
(* Write partition contents *)
226
204
List.iter
227
205
(fun (p, _start_lba, _end_lba) ->
228
206
let size_bytes = p.Partition.size_mb * 1024 * 1024 in
···
230
208
m "Writing partition %S (%d MB)" p.Partition.name p.Partition.size_mb);
231
209
build_partition_content writer p size_bytes)
232
210
partitions_with_lba;
233
-
234
-
(* Write backup partition table *)
235
211
Gpt.write_partition_table writer ~sector_size gpt;
236
212
Log.debug (fun m -> m "Wrote backup partition table");
237
-
238
-
(* Write backup GPT header *)
239
213
Gpt.write_header writer ~sector_size ~primary:false gpt;
240
-
Log.debug (fun m -> m "Wrote backup GPT header");
214
+
Log.debug (fun m -> m "Wrote backup GPT header")
241
215
216
+
let build config writer =
217
+
let sector_size = config.sector_size in
218
+
let disk_sectors = calculate_disk_size config in
219
+
Log.info (fun m ->
220
+
m "Building disk image: %Ld sectors (%Ld bytes)" disk_sectors
221
+
(Int64.mul disk_sectors (Int64.of_int sector_size)));
222
+
let partitions_with_lba = assign_lbas ~sector_size config.partitions in
223
+
let* gpt_partitions = gpt_partitions partitions_with_lba in
224
+
let* gpt = Gpt.v ~disk_sectors ~sector_size gpt_partitions in
225
+
Log.info (fun m ->
226
+
m "Created GPT with %d partitions" (List.length gpt_partitions));
227
+
write_disk_contents writer ~sector_size gpt partitions_with_lba;
242
228
Ok ()
243
229
244
230
let build_file config path =
+1
-1
lib/uniboot.mli
+1
-1
lib/uniboot.mli
+3
-2
test/dune
+3
-2
test/dune
+1
test/test.ml
+1
test/test.ml
···
1
+
let () = Alcotest.run "uniboot" [ Test_source.suite; Test_uniboot.suite ]
+16
test/test_source.ml
+16
test/test_source.ml
···
1
+
(** Tests for Source module. *)
2
+
3
+
let test_local_file () =
4
+
Eio_main.run @@ fun env ->
5
+
let tmp = Filename.temp_file "test_source" ".txt" in
6
+
let oc = open_out tmp in
7
+
output_string oc "test";
8
+
close_out oc;
9
+
let result =
10
+
Uniboot.Source.resolve ~env ~names:[ Filename.basename tmp ] tmp
11
+
in
12
+
Alcotest.(check string) "local file resolves to itself" tmp result;
13
+
Sys.remove tmp
14
+
15
+
let suite =
16
+
("source", [ Alcotest.test_case "local file" `Quick test_local_file ])
+4
test/test_source.mli
+4
test/test_source.mli
+7
-10
test/test_uniboot.ml
+7
-10
test/test_uniboot.ml
···
31
31
"Swap type GUID" true
32
32
(Uuidm.equal p.type_guid Uniboot.guid_linux_swap)
33
33
34
-
let () =
35
-
Alcotest.run "uniboot"
34
+
let suite =
35
+
( "uniboot",
36
36
[
37
-
("config", [ Alcotest.test_case "default config" `Quick test_config ]);
38
-
( "partition",
39
-
[
40
-
Alcotest.test_case "ESP partition" `Quick test_partition_esp;
41
-
Alcotest.test_case "Linux partition" `Quick test_partition_linux;
42
-
Alcotest.test_case "Swap partition" `Quick test_partition_swap;
43
-
] );
44
-
]
37
+
Alcotest.test_case "default config" `Quick test_config;
38
+
Alcotest.test_case "ESP partition" `Quick test_partition_esp;
39
+
Alcotest.test_case "Linux partition" `Quick test_partition_linux;
40
+
Alcotest.test_case "Swap partition" `Quick test_partition_swap;
41
+
] )