My own OCaml monorepo using monopam
add archive fetching as a specific command
+533
-119
+6
-5
lib/cmd/add.ml
+6
-5
lib/cmd/add.ml
···
6
6
(OpamFormula.string_of_relop op, OpamPackage.Version.to_string ver)
7
7
8
8
let cmd =
9
-
let run () data_dir cache_dir refresh registry with_repos toolchain package
10
-
pkg_spec =
9
+
let run () data_dir cache_dir refresh registry use_registry with_repos
10
+
toolchain package pkg_spec =
11
11
Harness.run @@ fun env ->
12
12
let { Harness.proc_mgr; fs; clock; sys; platform; os_key; cache } =
13
13
Harness.bootstrap env cache_dir
···
44
44
ignore
45
45
(Sync.do_sync ~refresh ~with_repos ~with_deps:[ pkg_spec ] ?toolchain
46
46
~proc_mgr ~fs ~clock ~sys ~platform ~os_key ~cache ~data_dir ~registry
47
-
~cwd ());
47
+
~use_registry ~cwd ());
48
48
(* Phase 2: edit dune-project. Reload in case something touched it
49
49
during the sync (shouldn't, but cheap to be defensive). *)
50
50
let dp = Oi.Project.Dune.load ~fs ~cwd in
···
83
83
ignore
84
84
(Sync.do_sync ~quiet:true ~refresh:false ~with_repos ~with_deps:[]
85
85
?toolchain ~proc_mgr ~fs ~clock ~sys ~platform ~os_key ~cache ~data_dir
86
-
~registry ~cwd ());
86
+
~registry ~use_registry ~cwd ());
87
87
Fmt.pr "Done.@."
88
88
in
89
89
let pkg_spec =
···
130
130
Cmd.v info
131
131
Term.(
132
132
const run $ Terms.log $ Terms.data_dir $ Terms.cache_dir $ Terms.refresh
133
-
$ Terms.registry $ Terms.with_repos $ Terms.toolchain $ package $ pkg_spec)
133
+
$ Terms.registry $ Terms.use_registry $ Terms.with_repos $ Terms.toolchain
134
+
$ package $ pkg_spec)
134
135
135
136
(* -- exec ---------------------------------------------------------------- *)
+144
-25
lib/cmd/build.ml
+144
-25
lib/cmd/build.ml
···
323
323
consumer prefix. Backs [oi build PKG --test] / [oi build @h/PKG
324
324
--test]. *)
325
325
let run_target_test ~target ~fs ~proc_mgr ~clock ~sys ~platform ~os_key ~cache
326
-
~data_dir ~registry ?(refresh = false) ?(with_repos = []) ?(with_deps = [])
327
-
?jobs ?toolchain ?(dry_run = false) () =
326
+
~data_dir ~registry ~use_registry ?(refresh = false) ?(with_repos = [])
327
+
?(with_deps = []) ?jobs ?toolchain ?(dry_run = false) () =
328
328
Oi.Pipeline.init_opam_root ~fs ~data_dir;
329
329
ignore (Oi.Source.Reporepo.ensure_base ~fs ~sys ~data_dir ~refresh ());
330
330
let conf =
331
331
Oi.Pipeline.make_conf ~platform ~ocaml_version:Workspace.ocaml_version
332
332
in
333
-
let remote = Terms.remote_of_registry registry in
333
+
let { Terms.layer_remote; source_remote } =
334
+
Terms.remotes_of ~url:registry ~mode:use_registry
335
+
in
334
336
let target_display = target in
335
337
let target, with_repos, with_deps, target_pin =
336
338
match Target.split_handle_prefix target with
···
395
397
let on_progress = Oi.Say.progress in
396
398
Oi.Pipeline.build ~sys ~proc_mgr ~fs ~clock ~cache ~data_dir ~conf ~os_key
397
399
~extra_repos:all_extras ~pins:url_project.pins ~refresh
398
-
~constraints:extra_constraints ?remote ?jobs ?toolchain
399
-
?local_packages_dir:url_project.packages_dir ~on_phase ~on_progress
400
-
names
400
+
~constraints:extra_constraints ?layer_remote ?source_remote ?jobs
401
+
?toolchain ?local_packages_dir:url_project.packages_dir ~on_phase
402
+
~on_progress names
401
403
in
402
404
match
403
405
find_target_layer ~fs ~cache ~os_key ~pkg_name:target layer_hashes
···
448
450
end
449
451
end
450
452
453
+
(* -- Mirror sync helper (shared by --archives-only and --every-version) -- *)
454
+
455
+
let format_bytes n =
456
+
let f = Int64.to_float n in
457
+
if Int64.compare n 1_073_741_824L >= 0 then
458
+
Fmt.str "%.2fGB" (f /. 1_073_741_824.)
459
+
else if Int64.compare n 1_048_576L >= 0 then Fmt.str "%.1fMB" (f /. 1_048_576.)
460
+
else if Int64.compare n 1_024L >= 0 then Fmt.str "%.1fKB" (f /. 1_024.)
461
+
else Fmt.str "%LdB" n
462
+
463
+
(* Fetch [archives] into the local mirror, with a single throttled
464
+
progress line and a one-line summary. Returns 0 if every fetch
465
+
succeeded (or was already cached), 1 if any failed — the
466
+
warn-and-continue contract documented for [oi build --archives-only]. *)
467
+
let mirror_archives ~fs ~cache ~label archives =
468
+
let archives = Oi.Source.Mirror.dedup_by_url archives in
469
+
let total = List.length archives in
470
+
Oi.Say.step "Mirroring %d source archive(s) (%s)" total label;
471
+
let last_msg = ref "" in
472
+
let on_progress ~fetched ~total ~current =
473
+
let msg =
474
+
match current with
475
+
| None -> Fmt.str "fetched %d/%d" fetched total
476
+
| Some c -> Fmt.str "fetched %d/%d %s" fetched total c
477
+
in
478
+
if msg <> !last_msg then begin
479
+
last_msg := msg;
480
+
Oi.Say.progress msg
481
+
end
482
+
in
483
+
let summary =
484
+
Oi.Source.Mirror.fetch_archives ~fs ~cache ~on_progress archives
485
+
in
486
+
Oi.Say.progress_clear ();
487
+
Oi.Say.step "Mirror sync complete";
488
+
Oi.Say.info "fetched: %d cached: %d failed: %d added: %s" summary.fetched
489
+
summary.cached
490
+
(List.length summary.failed)
491
+
(format_bytes summary.bytes_added);
492
+
List.iter
493
+
(fun (url, msg) -> Oi.Say.warn "fetch failed %s: %s" url msg)
494
+
summary.failed;
495
+
if summary.failed = [] then 0 else 1
496
+
451
497
(* -- oi build dispatcher ------------------------------------------------ *)
452
498
453
499
let cmd =
454
500
let run () data_dir cache_dir refresh skip_local dry_run all only skip
455
-
registry with_repos with_deps jobs toolchain_override depext_only export
456
-
envrc_mode deps_only targets =
501
+
registry use_registry with_repos with_deps jobs toolchain_override
502
+
depext_only export envrc_mode deps_only archives_only every_version
503
+
targets =
457
504
Harness.run @@ fun env ->
458
505
let { Harness.proc_mgr; fs; clock; sys; platform; os_key; cache } =
459
506
Harness.bootstrap env cache_dir
···
484
531
if export <> None && depext_only then
485
532
Oi.Error.config_error
486
533
"oi build: --export and --depext are mutually exclusive";
534
+
if archives_only && (export <> None || depext_only || deps_only) then
535
+
Oi.Error.config_error
536
+
"oi build --archives-only: cannot combine with --export, --depext, or \
537
+
--deps-only (no build runs, so there's nothing to publish, depext, or \
538
+
pre-install)";
487
539
if deps_only && not project_mode then
488
540
Oi.Error.config_error
489
541
"oi build --deps-only: only valid in project mode (cwd has no *.opam, \
···
491
543
let no_spec = targets = [] && (not all) && not project_mode in
492
544
if no_spec && export <> None then needs_spec "--export";
493
545
if no_spec && depext_only then needs_spec "--depext";
546
+
if no_spec && archives_only then needs_spec "--archives-only";
547
+
if every_version && not archives_only then
548
+
Oi.Error.config_error
549
+
"oi build --every-version: only valid with --archives-only (it skips \
550
+
the solver and walks every recorded reporepo opam file)";
551
+
if every_version then begin
552
+
let path = Terms.reporepo_path () in
553
+
Oi.Source.Reporepo.ensure_clone ~fs ~sys ~refresh ~path
554
+
~url:(Terms.reporepo_url ());
555
+
let archives =
556
+
let seen : (string, unit) Hashtbl.t = Hashtbl.create 4096 in
557
+
let acc = ref [] in
558
+
Oi.Source.Reporepo.iter_opam_files ~path ~include_handles:only
559
+
~skip_handles:skip (fun ~handle ~pkg ~version ~opam_path ->
560
+
let pkg_label = Fmt.str "@%s/%s.%s" handle pkg version in
561
+
Oi.Source.Mirror.archives_of_opam_file ~path:opam_path
562
+
~pkg:pkg_label
563
+
|> List.iter (fun (a : Oi.Source.Mirror.archive) ->
564
+
let key = OpamUrl.to_string a.url in
565
+
if not (Hashtbl.mem seen key) then begin
566
+
Hashtbl.add seen key ();
567
+
acc := a :: !acc
568
+
end));
569
+
List.rev !acc
570
+
in
571
+
exit (mirror_archives ~fs ~cache ~label:"every-version" archives)
572
+
end;
494
573
if depext_only && all then begin
495
574
let conf =
496
575
Oi.Pipeline.make_conf ~platform ~ocaml_version:Workspace.ocaml_version
···
518
597
else
519
598
let action = if deps_only then `Deps_only else `Build in
520
599
Project_build.run ~action ~fs ~proc_mgr ~clock ~sys ~platform ~os_key
521
-
~cache ~data_dir ~registry ~refresh ~with_repos ~with_deps ?jobs
522
-
?toolchain:toolchain_override ~envrc_mode ~dry_run ~cwd:cwd_s ()
600
+
~cache ~data_dir ~registry ~use_registry ~refresh ~with_repos
601
+
~with_deps ?jobs ?toolchain:toolchain_override ~envrc_mode ~dry_run
602
+
~cwd:cwd_s ()
523
603
in
524
604
do_export_if_set ~ok:(ec = 0) ();
525
605
exit ec
···
533
613
let conf =
534
614
Oi.Pipeline.make_conf ~platform ~ocaml_version:Workspace.ocaml_version
535
615
in
536
-
let remote = Terms.remote_of_registry registry in
616
+
let { Terms.layer_remote; source_remote } =
617
+
Terms.remotes_of ~url:registry ~mode:use_registry
618
+
in
537
619
(* When [--all] is set, walk every overlay in the reporepo and
538
620
derive targets from each one:
539
621
- skip [default] (ocaml/opam-repository) — its ~10k packages
···
1257
1339
OpamSysPkg.Set.iter (fun p -> Fmt.pr "%s@." (OpamSysPkg.to_string p)) all;
1258
1340
exit 0
1259
1341
end;
1342
+
if archives_only then begin
1343
+
let archives =
1344
+
List.concat_map
1345
+
(fun (_, _, pkg_dirs, pkgs, _, _, _) ->
1346
+
Oi.Source.Mirror.collect_archives ~packages_dirs:pkg_dirs pkgs)
1347
+
solutions
1348
+
in
1349
+
exit (mirror_archives ~fs ~cache ~label:"solved" archives)
1350
+
end;
1260
1351
(* 2. Each solve group is its own build group (no cross-group
1261
1352
merging). Dedup-by-layer-hash already happens inside the layer
1262
1353
cache; merging here would only gain shared plan construction
···
1389
1480
let n_pkgs = n_build + n_cached in
1390
1481
if dry_run then begin
1391
1482
let remote_has =
1392
-
match remote with
1483
+
match layer_remote with
1393
1484
| Some r ->
1394
1485
let idx = D10.Layer.fetch_remote_index d10 ~remote:r in
1395
1486
fun h -> Hashtbl.mem idx h
···
1578
1669
let build_outcome : [ `Ok | `Fail of string * (string * string) list ]
1579
1670
=
1580
1671
let build_plan =
1581
-
Oi.Pipeline.fetch_remote_layers ?jobs ~remote ~d10
1672
+
Oi.Pipeline.fetch_remote_layers ?jobs ~layer_remote ~d10
1582
1673
~packages_dirs:pkg_dirs ~ctx:group_ctx ~pkgs:sorted_pkgs
1583
1674
build_plan
1584
1675
in
···
1589
1680
~os_key ~ocaml_version:conf.ocaml_version build_plan
1590
1681
in
1591
1682
exec_plan_ref := Some exec_plan;
1592
-
let cache_urls = Oi.Pipeline.cache_urls ~cache ~remote in
1683
+
let cache_urls = Oi.Pipeline.cache_urls ~cache ~source_remote in
1593
1684
let audit_base : Oi.Audit.context =
1594
1685
{
1595
1686
(Oi.Audit.default_context ()) with
···
1725
1816
before $(b,dune build). Use after a manifest edit."
1726
1817
[ "deps-only" ])
1727
1818
in
1819
+
let archives_only =
1820
+
Arg.(
1821
+
value & flag
1822
+
& info
1823
+
~doc:
1824
+
"Solve as usual but only fetch source archives into the local \
1825
+
mirror at $(b,\\$OI_CACHE_DIR/mirror/) — no build, no prefix \
1826
+
assembly, no install. Use to seed a server-side source mirror \
1827
+
from any build spec ($(b,PKG), $(b,@HANDLE), $(b,@HANDLE/PKG), \
1828
+
$(b,--all)). Mutually exclusive with $(b,--export), \
1829
+
$(b,--depext), and $(b,--deps-only)."
1830
+
[ "archives-only" ])
1831
+
in
1832
+
let every_version =
1833
+
Arg.(
1834
+
value & flag
1835
+
& info
1836
+
~doc:
1837
+
"Only meaningful with $(b,--archives-only). Skip the solver and \
1838
+
walk every $(b,(handle, pkg, version)) tuple in the reporepo, \
1839
+
fetching every recorded archive into the mirror. Includes the \
1840
+
$(b,default) overlay (opam-repository), so this is the \
1841
+
complete-mirror mode for a server. $(b,--only) / $(b,--skip) \
1842
+
still filter overlays."
1843
+
[ "every-version" ])
1844
+
in
1728
1845
let info =
1729
1846
Cmd.info "build" ~doc:"Build a project, package, overlay, or every overlay"
1730
1847
~man:
···
1767
1884
Term.(
1768
1885
const run $ Terms.log $ Terms.data_dir $ Terms.cache_dir $ Terms.refresh
1769
1886
$ Terms.skip_local $ dry_run $ all $ only $ skip $ Terms.registry
1770
-
$ Terms.with_repos $ Terms.with_deps $ Terms.jobs $ Terms.toolchain
1771
-
$ depext_only $ export $ Sync.envrc_mode_arg $ deps_only $ targets)
1887
+
$ Terms.use_registry $ Terms.with_repos $ Terms.with_deps $ Terms.jobs
1888
+
$ Terms.toolchain $ depext_only $ export $ Sync.envrc_mode_arg $ deps_only
1889
+
$ archives_only $ every_version $ targets)
1772
1890
1773
1891
(* -- oi test ------------------------------------------------------------ *)
1774
1892
1775
1893
let test_cmd =
1776
-
let run () data_dir cache_dir refresh skip_local registry with_repos with_deps
1777
-
jobs toolchain_override envrc_mode dry_run targets =
1894
+
let run () data_dir cache_dir refresh skip_local registry use_registry
1895
+
with_repos with_deps jobs toolchain_override envrc_mode dry_run targets =
1778
1896
Harness.run @@ fun env ->
1779
1897
let { Harness.proc_mgr; fs; clock; sys; platform; os_key; cache } =
1780
1898
Harness.bootstrap env cache_dir
···
1799
1917
cwd_s;
1800
1918
let ec =
1801
1919
Project_build.run ~action:`Test ~fs ~proc_mgr ~clock ~sys ~platform
1802
-
~os_key ~cache ~data_dir ~registry ~refresh ~with_repos ~with_deps
1803
-
?jobs ?toolchain:toolchain_override ~envrc_mode ~dry_run ~cwd:cwd_s
1804
-
()
1920
+
~os_key ~cache ~data_dir ~registry ~use_registry ~refresh
1921
+
~with_repos ~with_deps ?jobs ?toolchain:toolchain_override
1922
+
~envrc_mode ~dry_run ~cwd:cwd_s ()
1805
1923
in
1806
1924
exit ec
1807
1925
| [ target ] ->
1808
1926
let ec =
1809
1927
run_target_test ~target ~fs ~proc_mgr ~clock ~sys ~platform ~os_key
1810
-
~cache ~data_dir ~registry ~refresh ~with_repos ~with_deps ?jobs
1811
-
?toolchain:toolchain_override ~dry_run ()
1928
+
~cache ~data_dir ~registry ~use_registry ~refresh ~with_repos
1929
+
~with_deps ?jobs ?toolchain:toolchain_override ~dry_run ()
1812
1930
in
1813
1931
exit ec
1814
1932
| _ ->
···
1849
1967
Cmd.v info
1850
1968
Term.(
1851
1969
const run $ Terms.log $ Terms.data_dir $ Terms.cache_dir $ Terms.refresh
1852
-
$ Terms.skip_local $ Terms.registry $ Terms.with_repos $ Terms.with_deps
1853
-
$ Terms.jobs $ Terms.toolchain $ Sync.envrc_mode_arg $ dry_run $ targets)
1970
+
$ Terms.skip_local $ Terms.registry $ Terms.use_registry
1971
+
$ Terms.with_repos $ Terms.with_deps $ Terms.jobs $ Terms.toolchain
1972
+
$ Sync.envrc_mode_arg $ dry_run $ targets)
+6
-5
lib/cmd/exec.ml
+6
-5
lib/cmd/exec.ml
···
3
3
let ( / ) = Filename.concat
4
4
5
5
let cmd =
6
-
let run () data_dir cache_dir refresh skip_local registry with_repos with_deps
7
-
jobs toolchain cmd args =
6
+
let run () data_dir cache_dir refresh skip_local registry use_registry
7
+
with_repos with_deps jobs toolchain cmd args =
8
8
Harness.run @@ fun env ->
9
9
let { Harness.proc_mgr; fs; clock; sys; platform; os_key; cache } =
10
10
Harness.bootstrap env cache_dir
···
30
30
let _, tc =
31
31
Sync.do_sync ~quiet:true ~refresh ~skip_local ~with_repos ~with_deps
32
32
?jobs ?toolchain ~proc_mgr ~fs ~clock ~sys ~platform ~os_key ~cache
33
-
~data_dir ~registry ~cwd ()
33
+
~data_dir ~registry ~use_registry ~cwd ()
34
34
in
35
35
tc
36
36
end
···
95
95
Cmd.v info
96
96
Term.(
97
97
const run $ Terms.log $ Terms.data_dir $ Terms.cache_dir $ Terms.refresh
98
-
$ Terms.skip_local $ Terms.registry $ Terms.with_repos $ Terms.with_deps
99
-
$ Terms.jobs $ Terms.toolchain $ cmd $ args)
98
+
$ Terms.skip_local $ Terms.registry $ Terms.use_registry
99
+
$ Terms.with_repos $ Terms.with_deps $ Terms.jobs $ Terms.toolchain $ cmd
100
+
$ args)
100
101
101
102
(* -- config -------------------------------------------------------------- *)
+3
-3
lib/cmd/project_build.ml
+3
-3
lib/cmd/project_build.ml
···
173
173
| `Deps_only -> "Sync"
174
174
175
175
let run ~action ~fs ~proc_mgr ~clock ~sys ~platform ~os_key ~cache ~data_dir
176
-
~registry ?(refresh = false) ?(with_repos = []) ?(with_deps = []) ?jobs
177
-
?toolchain ?envrc_mode ?(dry_run = false) ~cwd () =
176
+
~registry ~use_registry ?(refresh = false) ?(with_repos = [])
177
+
?(with_deps = []) ?jobs ?toolchain ?envrc_mode ?(dry_run = false) ~cwd () =
178
178
let label = action_label action in
179
179
let label_lc = String.lowercase_ascii label in
180
180
let opams = read_opams ~cwd in
···
202
202
let prefix, tc =
203
203
Sync.do_sync ~quiet:false ~refresh ~with_repos ~with_deps ?jobs ?toolchain
204
204
?envrc_mode ~proc_mgr ~fs ~clock ~sys ~platform ~os_key ~cache ~data_dir
205
-
~registry ~cwd ()
205
+
~registry ~use_registry ~cwd ()
206
206
in
207
207
match dune_target action with
208
208
| None -> 0
+1
lib/cmd/project_build.mli
+1
lib/cmd/project_build.mli
+3
-3
lib/cmd/repo.ml
+3
-3
lib/cmd/repo.ml
···
806
806
pkgs
807
807
in
808
808
(match
809
-
Oi.Source.Reporepo.bump ~fs ~sys ~path:reporepo ~handle
810
-
~root_packages:groups ()
811
-
with
809
+
Oi.Source.Reporepo.bump ~fs ~sys ~path:reporepo ~handle
810
+
~root_packages:groups ()
811
+
with
812
812
| `Bumped e ->
813
813
Fmt.pr "Bumped %s to %s (root-packages: %d entr%s)@." e.handle
814
814
e.version
+14
-10
lib/cmd/run.ml
+14
-10
lib/cmd/run.ml
···
3
3
let ( / ) = Filename.concat
4
4
5
5
let run_impl () data_dir cache_dir refresh skip_local dry_run registry
6
-
toolchain_override target with_deps with_repos jobs args =
6
+
use_registry toolchain_override target with_deps with_repos jobs args =
7
7
Harness.run @@ fun env ->
8
8
let { Harness.proc_mgr; fs; clock; sys; platform; os_key; cache } =
9
9
Harness.bootstrap env cache_dir
···
123
123
let conf =
124
124
Oi.Pipeline.make_conf ~platform ~ocaml_version:Workspace.ocaml_version
125
125
in
126
-
let remote = Terms.remote_of_registry registry in
126
+
let { Terms.layer_remote; source_remote } =
127
+
Terms.remotes_of ~url:registry ~mode:use_registry
128
+
in
127
129
(* URL-projects in [--with=…]: clone each URL into the pin cache,
128
130
scan its *.opam files, and merge the contribution as pins +
129
131
solver roots + overlays + extra_repos. *)
···
308
310
let layer_hashes =
309
311
with_preflight_bar @@ fun ~on_phase ~preflight_done ->
310
312
Oi.Pipeline.build ~sys ~proc_mgr ~fs ~clock ~cache ~data_dir ~conf ~os_key
311
-
~dry_run ~extra_repos:all_extras ~pins:project_pins ~refresh ?remote
312
-
?jobs ?toolchain ~constraints:extra_constraints ?local_packages_dir
313
-
~on_phase ~preflight_done names
313
+
~dry_run ~extra_repos:all_extras ~pins:project_pins ~refresh
314
+
?layer_remote ?source_remote ?jobs ?toolchain
315
+
~constraints:extra_constraints ?local_packages_dir ~on_phase
316
+
~preflight_done names
314
317
in
315
318
Logs.info (fun m -> m "Got %d layer hashes" (List.length layer_hashes));
316
319
let prefix =
···
415
418
with_preflight_bar @@ fun ~on_phase ~preflight_done ->
416
419
Oi.Pipeline.build ~sys ~proc_mgr ~fs ~clock ~cache ~data_dir ~conf
417
420
~os_key ~dry_run ~extra_repos:all_extras ~pins:project_pins ~refresh
418
-
?remote ?jobs ?toolchain ~constraints ?local_packages_dir ~on_phase
419
-
~preflight_done dep_opam_names
421
+
?layer_remote ?source_remote ?jobs ?toolchain ~constraints
422
+
?local_packages_dir ~on_phase ~preflight_done dep_opam_names
420
423
in
421
424
if dry_run && dep_opam_names = [] then
422
425
(* No deps to solve, but still in dry-run mode — just exit *)
···
425
428
Oi.Pipeline.assemble_prefix ~sys ~fs ~clock ~cache ~os_key ~layer_hashes
426
429
in
427
430
Script_runner.run ~sys ~fs ~proc_mgr ~clock ~os_key ~prefix ~conf ~cache
428
-
~data_dir ?toolchain ?remote target extra_deps args
431
+
~data_dir ?toolchain ?source_remote target extra_deps args
429
432
end
430
433
else begin
431
434
(* Include --with deps in every solve *)
···
791
794
let term ~skip_local =
792
795
Term.(
793
796
const run_impl $ Terms.log $ Terms.data_dir $ Terms.cache_dir
794
-
$ Terms.refresh $ skip_local $ dry_run $ Terms.registry $ Terms.toolchain
795
-
$ target $ Terms.with_deps $ Terms.with_repos $ Terms.jobs $ args)
797
+
$ Terms.refresh $ skip_local $ dry_run $ Terms.registry $ Terms.use_registry
798
+
$ Terms.toolchain $ target $ Terms.with_deps $ Terms.with_repos $ Terms.jobs
799
+
$ args)
796
800
797
801
let cmd = Cmd.v info_run (term ~skip_local:Terms.skip_local)
798
802
let cmd_x = Cmd.v info_oix (term ~skip_local:(Term.const true))
+2
-2
lib/cmd/script_runner.ml
+2
-2
lib/cmd/script_runner.ml
···
1
1
let ( / ) = Filename.concat
2
2
3
3
let run ~sys ~fs ~proc_mgr ~clock ~os_key ~prefix ~conf ~cache ~data_dir
4
-
?toolchain ?remote script_path cli_deps args =
4
+
?toolchain ?source_remote script_path cli_deps args =
5
5
let file_deps = Oi.Project.Script.parse_deps_from_file ~fs script_path in
6
6
let all_deps = Oi.Project.Script.dedup (file_deps @ cli_deps) in
7
7
if all_deps = [] then
···
53
53
Oi.Plan.resolve ctx ~packages_dirs ~cache_root ~os_key
54
54
~ocaml_version:conf.ocaml_version plan
55
55
in
56
-
let cache_urls = Oi.Pipeline.cache_urls ~cache ~remote in
56
+
let cache_urls = Oi.Pipeline.cache_urls ~cache ~source_remote in
57
57
Oi.Execute.run ~cache_urls ~proc_mgr ~fs
58
58
~clock:(clock :> D10.Config.clk)
59
59
~sys ~os_key exec_plan
+1
-1
lib/cmd/script_runner.mli
+1
-1
lib/cmd/script_runner.mli
+12
-9
lib/cmd/sync.ml
+12
-9
lib/cmd/sync.ml
···
35
35
skipped; other tools still install. Returns the assembled path if
36
36
at least one tool made it in, or [None] if nothing to install. *)
37
37
let install_tools ?(quiet = false) ?refresh ?jobs ~proc_mgr ~fs ~clock ~sys
38
-
~cache ~data_dir ~conf ~os_key ~extra_repos ~pins ?toolchain ?remote ~cwd ()
39
-
=
38
+
~cache ~data_dir ~conf ~os_key ~extra_repos ~pins ?toolchain ?layer_remote
39
+
?source_remote ~cwd () =
40
40
let say_step fmt =
41
41
if quiet then Fmt.kstr (fun s -> Logs.info (fun m -> m "%s" s)) fmt
42
42
else Fmt.kstr (fun s -> Oi.Say.step "%s" s) fmt
···
53
53
try
54
54
let hashes =
55
55
Oi.Pipeline.build ~sys ~proc_mgr ~fs ~clock ~cache ~data_dir ~conf
56
-
~os_key ~extra_repos ~pins ?refresh ?remote ?jobs ?toolchain
57
-
~constraints ~project_root:cwd [ name ]
56
+
~os_key ~extra_repos ~pins ?refresh ?layer_remote ?source_remote ?jobs
57
+
?toolchain ~constraints ~project_root:cwd [ name ]
58
58
in
59
59
match leaf_hash_for ~fs ~cache ~os_key ~want_name:tool_name hashes with
60
60
| None ->
···
184
184
let do_sync ?(quiet = false) ?(refresh = false) ?(skip_local = false)
185
185
?(with_repos = []) ?(with_deps = []) ?jobs ?(toolchain : string option)
186
186
?(envrc_mode = `Detect) ~proc_mgr ~fs ~clock ~sys ~platform ~os_key ~cache
187
-
~data_dir ~registry ~cwd () =
187
+
~data_dir ~registry ~use_registry ~cwd () =
188
188
let toolchain_override = toolchain in
189
189
let say_step fmt =
190
190
if quiet then Fmt.kstr (fun s -> Logs.info (fun m -> m "%s" s)) fmt
···
255
255
Logs.info (fun m -> m "extra-repos: %s" (String.concat ", " labels))
256
256
else Oi.Say.field_list "extra-repos" labels
257
257
end;
258
-
let remote = Terms.remote_of_registry registry in
258
+
let { Terms.layer_remote; source_remote } =
259
+
Terms.remotes_of ~url:registry ~mode:use_registry
260
+
in
259
261
let extra_constraints = Oi.Project.Script.constraints extra_cli in
260
262
let extra_names =
261
263
List.filter_map
···
283
285
Oi.Pipeline.build ~sys ~proc_mgr ~fs ~clock ~cache ~data_dir ~conf ~os_key
284
286
~extra_repos:all_extras
285
287
~pins:(project.pins @ url_project.pins)
286
-
~refresh ~constraints:extra_constraints ~project_root:cwd ?remote ?jobs
287
-
?toolchain ?local_packages_dir ~on_phase ~on_progress names
288
+
~refresh ~constraints:extra_constraints ~project_root:cwd ?layer_remote
289
+
?source_remote ?jobs ?toolchain ?local_packages_dir ~on_phase ~on_progress
290
+
names
288
291
in
289
292
let oi_dir = cwd / "_oi" in
290
293
let prefix = oi_dir / "prefix" in
···
295
298
let tools =
296
299
install_tools ~quiet ?refresh:(Some refresh) ?jobs ~proc_mgr ~fs ~clock ~sys
297
300
~cache ~data_dir ~conf ~os_key ~extra_repos:all_extras ~pins:project.pins
298
-
?toolchain ?remote ~cwd ()
301
+
?toolchain ?layer_remote ?source_remote ~cwd ()
299
302
in
300
303
if envrc_should_write envrc_mode then begin
301
304
let envrc_path = Eio.Path.(fs / cwd / ".envrc") in
+1
lib/cmd/sync.mli
+1
lib/cmd/sync.mli
+39
-3
lib/cmd/terms.ml
+39
-3
lib/cmd/terms.ml
···
114
114
let reporepo_url () =
115
115
getenv_or ~default:Oi.Source.Reporepo.default_url "OI_REPOREPO_URL"
116
116
117
-
let remote_of_registry = function
118
-
| "" -> None
119
-
| url -> Some (`Http_remote url : D10.Layer.remote)
117
+
let use_registry_conv =
118
+
let parser s =
119
+
match Oi.Use_registry.of_string s with
120
+
| Ok v -> Ok v
121
+
| Error msg -> Error (`Msg msg)
122
+
in
123
+
Arg.conv ~docv:"MODE" (parser, Oi.Use_registry.pp)
124
+
125
+
let use_registry =
126
+
let doc =
127
+
"What to consult the remote registry for. $(b,all) (default): binary \
128
+
layers and source archives. $(b,archives): source archives only — every \
129
+
layer is built from scratch (CI registry-build mode). $(b,never): offline \
130
+
w.r.t. the registry; upstream source fetches still happen."
131
+
in
132
+
Arg.(
133
+
value
134
+
& opt use_registry_conv Oi.Use_registry.All
135
+
& info ~docv:"MODE" ~doc [ "use-registry" ])
136
+
137
+
type remotes = {
138
+
layer_remote : D10.Layer.remote option;
139
+
source_remote : D10.Layer.remote option;
140
+
}
141
+
142
+
let remotes_of ~url ~(mode : Oi.Use_registry.t) =
143
+
match mode with
144
+
| Never -> { layer_remote = None; source_remote = None }
145
+
| All | Archives ->
146
+
if url = "" then
147
+
Oi.Error.config_error
148
+
"--use-registry=%s requires a non-empty --registry URL (use \
149
+
--use-registry=never for fully offline)"
150
+
(Oi.Use_registry.to_string mode);
151
+
let r : D10.Layer.remote = `Http_remote url in
152
+
{
153
+
layer_remote = (if mode = All then Some r else None);
154
+
source_remote = Some r;
155
+
}
+12
-3
lib/cmd/terms.mli
+12
-3
lib/cmd/terms.mli
···
54
54
val default_registry : string
55
55
(** [https://oi.ci.dev]. *)
56
56
57
-
val remote_of_registry : string -> D10.Layer.remote option
58
-
(** Convert a registry URL string to a {!D10.Layer.remote}. Empty string returns
59
-
[None] (registry disabled). *)
57
+
val use_registry : Oi.Use_registry.t Cmdliner.Term.t
58
+
(** [--use-registry] term, accepting [all], [archives], or [never]. Defaults to
59
+
{!Oi.Use_registry.All}. *)
60
+
61
+
type remotes = {
62
+
layer_remote : D10.Layer.remote option;
63
+
source_remote : D10.Layer.remote option;
64
+
}
65
+
66
+
val remotes_of : url:string -> mode:Oi.Use_registry.t -> remotes
67
+
(** Split [(url, mode)] into the two remotes the pipeline consumes separately.
68
+
Errors if [url] is empty unless [mode = Never]. *)
+12
-12
lib/oi/pipeline.ml
+12
-12
lib/oi/pipeline.ml
···
153
153
154
154
(* -- Build helpers ------------------------------------------------------- *)
155
155
156
-
let cache_urls ~cache ~remote =
156
+
let cache_urls ~cache ~source_remote =
157
157
let local = Source.Mirror.url ~cache in
158
-
match remote with
158
+
match source_remote with
159
159
| Some (`Http_remote r) -> [ local; Source.Mirror.remote_url ~registry:r ]
160
160
| None | Some _ -> [ local ]
161
161
···
175
175
Fmt.str "%.0fKB" (Int64.to_float n /. 1024.)
176
176
else Fmt.str "%LdB" n
177
177
178
-
let fetch_remote_layers ?on_phase ?on_progress ?jobs ~remote ~d10 ~packages_dirs
179
-
~ctx ~pkgs build_plan =
180
-
match remote with
178
+
let fetch_remote_layers ?on_phase ?on_progress ?jobs ~layer_remote ~d10
179
+
~packages_dirs ~ctx ~pkgs build_plan =
180
+
match layer_remote with
181
181
| None -> build_plan
182
182
| Some r ->
183
183
let source_hashes =
···
289
289
290
290
let build ~sys ~proc_mgr ~fs ~clock ~cache ~data_dir ~conf ~os_key
291
291
?(dry_run = false) ?(extra_repos = []) ?(pins = []) ?(refresh = false)
292
-
?remote ?jobs ?toolchain ?(constraints = OpamPackage.Name.Map.empty)
293
-
?project_root ?local_packages_dir ?on_phase ?on_progress ?preflight_done
294
-
names =
292
+
?layer_remote ?source_remote ?jobs ?toolchain
293
+
?(constraints = OpamPackage.Name.Map.empty) ?project_root
294
+
?local_packages_dir ?on_phase ?on_progress ?preflight_done names =
295
295
let _ = preflight_done in
296
296
let on_phase =
297
297
match on_phase with
···
394
394
let build_plan = Plan.build ctx ~d10 ~packages_dirs pkgs in
395
395
if dry_run then begin
396
396
let remote_has =
397
-
match remote with
397
+
match layer_remote with
398
398
| Some r ->
399
399
let idx = D10.Layer.fetch_remote_index d10 ~remote:r in
400
400
fun h -> Hashtbl.mem idx h
···
404
404
exit 0
405
405
end;
406
406
let build_plan =
407
-
match remote with
407
+
match layer_remote with
408
408
| None -> build_plan
409
409
| Some _ ->
410
410
on_phase "Checking registry for prebuilt layers";
411
-
fetch_remote_layers ~on_phase ?on_progress ?jobs ~remote ~d10
411
+
fetch_remote_layers ~on_phase ?on_progress ?jobs ~layer_remote ~d10
412
412
~packages_dirs ~ctx ~pkgs build_plan
413
413
in
414
414
let hashes = Plan.layer_hashes build_plan in
···
522
522
Plan.resolve ctx ~packages_dirs ~cache_root ~os_key
523
523
~ocaml_version:conf.ocaml_version build_plan
524
524
in
525
-
let urls = cache_urls ~cache ~remote in
525
+
let urls = cache_urls ~cache ~source_remote in
526
526
Execute.run ~cache_urls:urls ~proc_mgr ~fs ?jobs
527
527
~clock:(clock :> D10.Config.clk)
528
528
~sys ~os_key exec_plan;
+8
-7
lib/oi/pipeline.mli
+8
-7
lib/oi/pipeline.mli
···
105
105
(** {1 Build pipeline} *)
106
106
107
107
val cache_urls :
108
-
cache:Cache.t -> remote:D10.Layer.remote option -> OpamUrl.t list
108
+
cache:Cache.t -> source_remote:D10.Layer.remote option -> OpamUrl.t list
109
109
(** [cache_urls] for opam's [pull_tree]/[pull_file] to probe before falling back
110
110
to upstream: always includes the local {!Source.Mirror}; with a remote
111
-
registry, also the registry's [sources/] subtree. *)
111
+
[source_remote], also the registry's [sources/] subtree. *)
112
112
113
113
val fetch_remote_layers :
114
114
?on_phase:(string -> unit) ->
115
115
?on_progress:(string -> unit) ->
116
116
?jobs:int ->
117
-
remote:D10.Layer.remote option ->
117
+
layer_remote:D10.Layer.remote option ->
118
118
d10:D10.Config.t ->
119
119
packages_dirs:string list ->
120
120
ctx:Solver.Ctx.t ->
121
121
pkgs:OpamPackage.t list ->
122
122
Plan.graph ->
123
123
Plan.graph
124
-
(** Try fetching uncached [Source] layers from [remote]. Returns a new plan
125
-
graph with downloaded layers promoted to [Binary]. No-op when
126
-
[remote = None] or every layer is already cached.
124
+
(** Try fetching uncached [Source] layers from [layer_remote]. Returns a new
125
+
plan graph with downloaded layers promoted to [Binary]. No-op when
126
+
[layer_remote = None] or every layer is already cached.
127
127
128
128
Progress reporting is split:
129
129
- [on_phase] receives one-shot milestones (e.g. the final "Fetched N/M
···
147
147
?extra_repos:Project.extra_repo list ->
148
148
?pins:Project.pin list ->
149
149
?refresh:bool ->
150
-
?remote:D10.Layer.remote ->
150
+
?layer_remote:D10.Layer.remote ->
151
+
?source_remote:D10.Layer.remote ->
151
152
?jobs:int ->
152
153
?toolchain:Toolchain.info ->
153
154
?constraints:OpamFormula.version_constraint OpamTypes.name_map ->
+216
-31
lib/oi/source.ml
+216
-31
lib/oi/source.ml
···
146
146
let overlay_packages_dir ~path ~handle =
147
147
overlay_dir ~path ~handle / "packages"
148
148
149
+
let iter_opam_files ~path ?(include_handles = []) ?(skip_handles = []) f =
150
+
let v1 = v1_root ~path in
151
+
if not (Sys.file_exists v1) then ()
152
+
else
153
+
let sorted_subdirs root =
154
+
if not (Sys.file_exists root) then []
155
+
else
156
+
Sys.readdir root |> Array.to_list
157
+
|> List.filter (fun n ->
158
+
(not (String.starts_with ~prefix:"." n))
159
+
&& Sys.is_directory (root / n))
160
+
|> List.sort String.compare
161
+
in
162
+
let handle_ok h =
163
+
(* [v1/reporepo/] is the meta-overlay holding handle-registration
164
+
entries, not an archive-bearing overlay. *)
165
+
h <> "reporepo"
166
+
&& (include_handles = [] || List.mem h include_handles)
167
+
&& not (List.mem h skip_handles)
168
+
in
169
+
let strip_pkg_prefix pkg pkg_ver_dir =
170
+
let prefix = pkg ^ "." in
171
+
if String.starts_with ~prefix pkg_ver_dir then
172
+
String.sub pkg_ver_dir (String.length prefix)
173
+
(String.length pkg_ver_dir - String.length prefix)
174
+
else pkg_ver_dir
175
+
in
176
+
sorted_subdirs v1 |> List.filter handle_ok
177
+
|> List.iter (fun handle ->
178
+
let pkgs_dir = overlay_packages_dir ~path ~handle in
179
+
sorted_subdirs pkgs_dir
180
+
|> List.iter (fun pkg ->
181
+
let pkg_dir = pkgs_dir / pkg in
182
+
sorted_subdirs pkg_dir
183
+
|> List.filter (fun pv -> Sys.file_exists (pkg_dir / pv / "opam"))
184
+
|> List.iter (fun pkg_ver_dir ->
185
+
let opam_path = pkg_dir / pkg_ver_dir / "opam" in
186
+
let version = strip_pkg_prefix pkg pkg_ver_dir in
187
+
f ~handle ~pkg ~version ~opam_path)))
188
+
149
189
type entry = {
150
190
handle : string;
151
191
version : string;
···
938
978
"%s: %s URLs are not supported in v1 materialisation (URL: %s)" where
939
979
name (OpamUrl.to_string u)
940
980
941
-
(* Special-case host rewrite: tangled.org's plain HTTPS clone path is
942
-
flaky in our hands, but the same content is mirrored on
943
-
git.recoil.org without the [.git] suffix. We rewrite up front so
944
-
both the [ls-remote] query and the URL we bake into the opam file
945
-
point at the more reliable host. *)
946
-
let rewrite_host (u : OpamUrl.t) : OpamUrl.t =
947
-
let prefix = "tangled.org/" in
948
-
if u.transport = "https" && String.starts_with ~prefix u.path then
949
-
let after =
950
-
String.sub u.path (String.length prefix)
951
-
(String.length u.path - String.length prefix)
952
-
in
953
-
let after =
954
-
if
955
-
String.length after >= 4
956
-
&& String.sub after (String.length after - 4) 4 = ".git"
957
-
then String.sub after 0 (String.length after - 4)
958
-
else after
959
-
in
960
-
{ u with path = "git.recoil.org/" ^ after }
961
-
else u
962
-
963
981
(* Resolve a single URL into a content-addressed form. The caller maps
964
982
the polymorphic-variant outcome to whatever opam-file mutation it
965
-
needs; the four cases are: keep as-is, replace the URL (sha or host
966
-
rewrite), add a checksum to a tarball that lacked one, or report
967
-
why we couldn't pin it. *)
968
-
let try_resolve_url ~fs ~sys ~where (u_in : OpamUrl.t) ~has_checksum :
983
+
needs; the three cases are: keep as-is, replace the URL (sha pin),
984
+
add a checksum to a tarball that lacked one, or report why we
985
+
couldn't pin it. *)
986
+
let try_resolve_url ~fs ~sys ~where (u : OpamUrl.t) ~has_checksum :
969
987
[ `Keep
970
988
| `Replace_url of OpamUrl.t
971
989
| `Add_checksum of OpamHash.t
972
990
| `Failed of string ] =
973
-
let u = rewrite_host u_in in
974
-
let host_changed = u.path <> u_in.path in
975
991
match classify_url ~where u with
976
992
| `Git ->
977
993
begin match u.hash with
978
-
| Some sha when is_sha_string sha ->
979
-
if host_changed then `Replace_url u else `Keep
994
+
| Some sha when is_sha_string sha -> `Keep
980
995
| ref_opt -> begin
981
996
(* git(1) doesn't understand opam's [git+https://...]
982
997
spelling — strip the [git+] backend prefix and feed it the
···
995
1010
end
996
1011
end
997
1012
| `Tarball ->
998
-
if has_checksum then if host_changed then `Replace_url u else `Keep
1013
+
if has_checksum then `Keep
999
1014
else begin
1000
1015
let url_str = OpamUrl.to_string u in
1001
1016
let tmp = Filename.temp_file "oi-bump-tarball-" ".bin" in
···
1920
1935
put dst
1921
1936
with _ -> ());
1922
1937
!promoted)
1938
+
1939
+
(* -- Bulk fetch into the mirror (used by [oi build --archives-only]) --- *)
1940
+
1941
+
type archive = { url : OpamUrl.t; checksums : OpamHash.t list; pkg : string }
1942
+
1943
+
type fetch_summary = {
1944
+
fetched : int;
1945
+
cached : int;
1946
+
failed : (string * string) list;
1947
+
bytes_added : int64;
1948
+
}
1949
+
1950
+
let read_opam path =
1951
+
try Some (OpamFile.OPAM.read (OpamFile.make (OpamFilename.raw path)))
1952
+
with _ -> None
1953
+
1954
+
let archive_of_url ~pkg u =
1955
+
{ url = OpamFile.URL.url u; checksums = OpamFile.URL.checksum u; pkg }
1956
+
1957
+
(* Drop checksum-less entries: a content-addressed mirror needs a hash
1958
+
to key on. In practice this skips git+ pins (the commit hash takes
1959
+
the place of an integrity check), which are resolved by clone, not
1960
+
by archive download. *)
1961
+
let archives_of_opam ~pkg opam =
1962
+
let main =
1963
+
match OpamFile.OPAM.url opam with None -> [] | Some u -> [ u ]
1964
+
in
1965
+
let extras = List.map snd (OpamFile.OPAM.extra_sources opam) in
1966
+
main @ extras
1967
+
|> List.map (archive_of_url ~pkg)
1968
+
|> List.filter (fun a -> a.checksums <> [])
1969
+
1970
+
let archives_of_opam_file ~path ~pkg =
1971
+
match read_opam path with
1972
+
| None ->
1973
+
Log.info (fun m -> m "skipping unreadable opam file: %s" path);
1974
+
[]
1975
+
| Some opam -> archives_of_opam ~pkg opam
1976
+
1977
+
let dedup_by_url archives =
1978
+
let seen : (string, unit) Hashtbl.t = Hashtbl.create 256 in
1979
+
List.filter
1980
+
(fun a ->
1981
+
let key = OpamUrl.to_string a.url in
1982
+
if Hashtbl.mem seen key then false
1983
+
else (
1984
+
Hashtbl.add seen key ();
1985
+
true))
1986
+
archives
1987
+
1988
+
(* Compact progress label: hostname + final path component. The full URL
1989
+
is too long for a single-line in-place progress sink. *)
1990
+
let label_of_url (u : OpamUrl.t) =
1991
+
let strip_scheme s =
1992
+
match String.index_opt s ':' with
1993
+
| None -> s
1994
+
| Some i ->
1995
+
let rest = String.sub s (i + 1) (String.length s - i - 1) in
1996
+
let rec drop_slashes s =
1997
+
if String.length s > 0 && s.[0] = '/' then
1998
+
drop_slashes (String.sub s 1 (String.length s - 1))
1999
+
else s
2000
+
in
2001
+
drop_slashes rest
2002
+
in
2003
+
let no_scheme = strip_scheme (OpamUrl.to_string u) in
2004
+
let host, rest =
2005
+
match String.index_opt no_scheme '/' with
2006
+
| None -> (no_scheme, "")
2007
+
| Some i ->
2008
+
( String.sub no_scheme 0 i,
2009
+
String.sub no_scheme (i + 1) (String.length no_scheme - i - 1) )
2010
+
in
2011
+
let basename =
2012
+
match String.rindex_opt rest '/' with
2013
+
| None -> rest
2014
+
| Some i -> String.sub rest (i + 1) (String.length rest - i - 1)
2015
+
in
2016
+
if basename = "" then host else host ^ "/" ^ basename
2017
+
2018
+
let collect_archives ~packages_dirs pkgs =
2019
+
let opam_path_for pkg =
2020
+
let name_s = OpamPackage.Name.to_string (OpamPackage.name pkg) in
2021
+
let pkg_s = OpamPackage.to_string pkg in
2022
+
List.find_opt Sys.file_exists
2023
+
(List.map (fun d -> d / name_s / pkg_s / "opam") packages_dirs)
2024
+
in
2025
+
pkgs
2026
+
|> List.concat_map (fun pkg ->
2027
+
match opam_path_for pkg with
2028
+
| None -> []
2029
+
| Some path ->
2030
+
archives_of_opam_file ~path ~pkg:(OpamPackage.to_string pkg))
2031
+
|> dedup_by_url
2032
+
2033
+
let mirror_has ~mirror_dir checksums =
2034
+
List.exists
2035
+
(fun ck ->
2036
+
Sys.file_exists (List.fold_left ( / ) mirror_dir (OpamHash.to_path ck)))
2037
+
checksums
2038
+
2039
+
let fetch_one ~fs ~mirror_dir ~cache_root ~cache_dir ~tmp_dir a =
2040
+
let tmp = tmp_dir / Fmt.str "%d.%d.bin" (Unix.getpid ()) (Random.bits ()) in
2041
+
(try Unix.unlink tmp with Unix.Unix_error _ -> ());
2042
+
let dst_file = OpamFilename.of_string tmp in
2043
+
let result =
2044
+
try
2045
+
OpamRepository.pull_file a.pkg ~cache_dir ~cache_urls:[]
2046
+
~silent_hits:true dst_file a.checksums [ a.url ]
2047
+
|> OpamProcess.Job.run
2048
+
with exn -> OpamTypes.Not_available (None, Printexc.to_string exn)
2049
+
in
2050
+
let outcome =
2051
+
match result with
2052
+
| OpamTypes.Result () | OpamTypes.Up_to_date () -> (
2053
+
try
2054
+
let _ = promote ~fs ~cache_root a.checksums in
2055
+
(* Size lookup goes through the mirror because opam may have
2056
+
served from its download-cache without writing to [tmp]. *)
2057
+
let bytes =
2058
+
match a.checksums with
2059
+
| ck :: _ ->
2060
+
file_size
2061
+
(List.fold_left ( / ) mirror_dir (OpamHash.to_path ck))
2062
+
| [] -> 0L
2063
+
in
2064
+
`Fetched bytes
2065
+
with exn -> `Failed (Printexc.to_string exn))
2066
+
| OpamTypes.Not_available (_, msg) -> `Failed msg
2067
+
in
2068
+
(try Sys.remove tmp with Sys_error _ -> ());
2069
+
outcome
2070
+
2071
+
let fetch_archives ~fs ~cache
2072
+
?(on_progress = fun ~fetched:_ ~total:_ ~current:_ -> ()) archives =
2073
+
let mirror_dir = dir ~cache in
2074
+
let cache_root = Cache.root_s cache in
2075
+
let cache_dir =
2076
+
OpamRepositoryPath.download_cache OpamStateConfig.(!r.root_dir)
2077
+
in
2078
+
let tmp_dir = mirror_dir / ".incoming" in
2079
+
mkdir_p ~fs mirror_dir;
2080
+
mkdir_p ~fs tmp_dir;
2081
+
let total = List.length archives in
2082
+
let fetched = ref 0 and cached = ref 0 and failed = ref [] in
2083
+
let bytes_added = ref 0L in
2084
+
let done_count () = !fetched + !cached + List.length !failed in
2085
+
List.iter
2086
+
(fun a ->
2087
+
on_progress ~fetched:(done_count ()) ~total
2088
+
~current:(Some (label_of_url a.url));
2089
+
if mirror_has ~mirror_dir a.checksums then incr cached
2090
+
else
2091
+
match fetch_one ~fs ~mirror_dir ~cache_root ~cache_dir ~tmp_dir a with
2092
+
| `Fetched bytes ->
2093
+
incr fetched;
2094
+
bytes_added := Int64.add !bytes_added bytes
2095
+
| `Failed msg ->
2096
+
Log.info (fun m ->
2097
+
m "fetch failed: %s -> %s" (OpamUrl.to_string a.url) msg);
2098
+
failed := (OpamUrl.to_string a.url, msg) :: !failed)
2099
+
archives;
2100
+
on_progress ~fetched:total ~total ~current:None;
2101
+
(try Unix.rmdir tmp_dir with Unix.Unix_error _ -> ());
2102
+
{
2103
+
fetched = !fetched;
2104
+
cached = !cached;
2105
+
failed = List.rev !failed;
2106
+
bytes_added = !bytes_added;
2107
+
}
1923
2108
end
+53
lib/oi/source.mli
+53
lib/oi/source.mli
···
138
138
val overlay_dir : path:string -> handle:string -> string
139
139
(** [<reporepo>/v1/<handle>]. *)
140
140
141
+
val iter_opam_files :
142
+
path:string ->
143
+
?include_handles:string list ->
144
+
?skip_handles:string list ->
145
+
(handle:string -> pkg:string -> version:string -> opam_path:string -> unit) ->
146
+
unit
147
+
(** Visit every [<path>/v1/<handle>/packages/<pkg>/<pkg.version>/opam] in the
148
+
reporepo. Empty [include_handles] means every overlay (including
149
+
[default]); [skip_handles] is applied last. The meta-overlay [reporepo] is
150
+
always skipped — it holds handle-registration entries, not archives. *)
151
+
141
152
val overlay_packages_dir : path:string -> handle:string -> string
142
153
(** [<reporepo>/v1/<handle>/packages] — directly consumable as a solver
143
154
[packages_dir]. *)
···
374
385
at [<cache_root>/mirror/<algo>/<XX>/<hash>] for each declared checksum.
375
386
Returns the number of blobs newly added; [0] if nothing was promoted (no
376
387
checksums supplied, or no cached file found). Idempotent. *)
388
+
389
+
type archive = { url : OpamUrl.t; checksums : OpamHash.t list; pkg : string }
390
+
(** One downloadable source entity: either an [url {…}] block or an
391
+
[extra-source] entry. [pkg] is the [name.version] label, only used for
392
+
progress and failure messages. *)
393
+
394
+
val collect_archives :
395
+
packages_dirs:string list -> OpamPackage.t list -> archive list
396
+
(** Resolve each [pkg]'s opam file from the first matching [packages_dirs]
397
+
entry, then extract its archives. Deduped by URL so packages sharing a
398
+
mirror tarball contribute one fetch. Drives [oi build --archives-only]
399
+
against the solver's resolved set. *)
400
+
401
+
val archives_of_opam_file : path:string -> pkg:string -> archive list
402
+
(** Parse the opam file at [path] directly. Returns [[]] for unreadable or
403
+
sourceless files. Drives [oi build --archives-only --every-version], which
404
+
walks the reporepo's filesystem rather than the solver. *)
405
+
406
+
val dedup_by_url : archive list -> archive list
407
+
(** First-occurrence dedup keyed on the URL string. Use after concatenating
408
+
per-group results (e.g. [oi build --archives-only --all]) where the same
409
+
archive is referenced across overlapping solves. *)
410
+
411
+
type fetch_summary = {
412
+
fetched : int;
413
+
cached : int;
414
+
failed : (string * string) list; (** [(url, error_message)]. *)
415
+
bytes_added : int64;
416
+
}
417
+
418
+
val fetch_archives :
419
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
420
+
cache:Cache.t ->
421
+
?on_progress:(fetched:int -> total:int -> current:string option -> unit) ->
422
+
archive list ->
423
+
fetch_summary
424
+
(** Fetch each archive and deposit it into the mirror. Skips entries whose
425
+
first declared checksum is already present (the [cached] tally). On a hard
426
+
failure (after retries), records the URL + message in [failed] and moves
427
+
on — no exception is raised. [on_progress] receives [current=Some label]
428
+
just before each fetch and [current=None] after the last; [label] is the
429
+
host + basename of the URL, suitable for an in-place progress line. *)
377
430
end