jon.recoil.org
A fork of mtelver's day10 project
Network handling plus improved hardlink copy
+23
-8
bin/main.ml
+23
-8
bin/main.ml
···
10
10
package : string;
11
11
directory : string option;
12
12
md : string option;
13
+
network : string option;
13
14
}
14
15
15
16
let hostname = "builder"
16
-
let network = "35b0b92b-d2a7-429b-92ad-4671880d25f2"
17
+
18
+
let create_network () = match Sys.win32 with
19
+
| true -> Os.run "hcn-namespace create" |> String.trim
20
+
| false -> ""
21
+
22
+
let delete_network = function
23
+
| Some n -> Os.exec ["hcn-namespace"; "delete"; n]
24
+
| None -> 0
17
25
18
26
let env =
19
27
[
···
109
117
let mounts_json = Os.path [ temp_dir; "mounts.json" ] in
110
118
let _ = Os.retry_exec ~stdout:mounts_json [ "ctr"; "snapshot"; "prepare"; "--mounts"; Filename.basename temp_dir; "sha256:6f75278129ccaff6084617218cb8a28e8acc1748beeaae2946dfa92c5ca425ee" ] in
111
119
let layers = Json_layers.read_layers mounts_json in
112
-
let config = Json_config.make_ctr ~layers ~cwd:"c:\\" ~argv ~hostname ~uid:0 ~gid:0 ~env:win_env ~mounts ~network in
120
+
let config = Json_config.make_ctr ~layers ~cwd:"c:\\" ~argv ~hostname ~uid:0 ~gid:0 ~env:win_env ~mounts ~network:(Option.value ~default:"" config.network) in
113
121
let config_json = Os.path [ temp_dir; "config.json" ] in
114
122
let () = Os.write_to_file config_json (Yojson.Safe.pretty_to_string config) in
115
123
let result = Os.exec ~stdout:build_log ~stderr:build_log [ "ctr"; "run"; "--cni"; "--rm"; "--config"; config_json; Filename.basename temp_dir ] in
124
+
let _ = Os.rm (Os.path [ rootfs; "lock" ] ) in
125
+
let _ = Os.rm (Os.path [ rootfs; "conf.lock" ] ) in
126
+
let _ = Os.rm (Os.path [ rootfs; "default"; ".opam-switch"; "lock" ] ) in
116
127
let _ = Os.rm (Os.path [ rootfs; "repo"; "state-33BF9E46.cache" ] ) in
117
-
let _ = Os.rm (Os.path [ rootfs; "default"; ".opam-switch"; "lock" ] ) in
128
+
let _ = Os.rm (Os.path [ rootfs; "repo"; "conf.lock" ] ) in
118
129
let () = Os.write_to_file (Os.path [ temp_dir; "status" ]) (string_of_int result) in
119
130
let _ = Os.exec [ "ctr"; "snapshot"; "rm"; Filename.basename temp_dir ] in
120
131
Unix.rename temp_dir target_dir
···
372
383
let mounts_json = Os.path [ temp_dir; "mounts.json" ] in
373
384
let _ = Os.retry_exec ~stdout:mounts_json [ "ctr"; "snapshot"; "prepare"; "--mounts"; Filename.basename temp_dir; "sha256:6f75278129ccaff6084617218cb8a28e8acc1748beeaae2946dfa92c5ca425ee" ] in
374
385
let layers = Json_layers.read_layers mounts_json in
375
-
let config = Json_config.make_ctr ~layers ~cwd:"c:\\" ~argv ~hostname ~uid:0 ~gid:0 ~env:win_env ~mounts ~network in
386
+
let config = Json_config.make_ctr ~layers ~cwd:"c:\\" ~argv ~hostname ~uid:0 ~gid:0 ~env:win_env ~mounts ~network:(Option.value ~default:"" config.network) in
376
387
let config_json = Os.path [ temp_dir; "config.json" ] in
377
388
let () = Os.write_to_file config_json (Yojson.Safe.pretty_to_string config) in
378
389
let result = Os.exec ~stdout:build_log ~stderr:build_log [ "ctr"; "run"; "--cni"; "--rm"; "--config"; config_json; Filename.basename temp_dir ] in
···
405
416
406
417
let build config ocaml_version package =
407
418
let solution = solve config ocaml_version package in
408
-
let _ = Dot_solution.save ((OpamPackage.to_string package) ^ ".dot") solution in
419
+
(* let _ = Dot_solution.save ((OpamPackage.to_string package) ^ ".dot") solution in *)
409
420
if OpamPackage.Map.is_empty solution then
410
421
[ No_solution ]
411
422
else
412
423
let ordered_installation = topological_sort solution in
413
424
let dependencies = pkg_deps solution ordered_installation in
414
425
let solution = reduce dependencies solution in
415
-
let _ = Dot_solution.save ((OpamPackage.to_string package) ^ ".reduced.dot") solution in
426
+
(* let _ = Dot_solution.save ((OpamPackage.to_string package) ^ ".reduced.dot") solution in *)
416
427
List.fold_left
417
428
(fun lst pkg ->
418
429
match lst with
···
467
478
let run_ci config =
468
479
init config;
469
480
let package = OpamPackage.of_string (config.package ^ ".dev") in
481
+
let config = { config with network = Some (create_network ()) } in
470
482
let results = build config ocaml_version package in
483
+
let _ = delete_network config.network in
471
484
output config results
472
485
473
486
let run_health_check config =
474
487
init config;
475
488
let package = OpamPackage.of_string config.package in
489
+
let config = { config with network = Some (create_network ()) } in
476
490
let results = build config ocaml_version package in
491
+
let _ = delete_network config.network in
477
492
output config results
478
493
479
494
let cache_dir_term =
···
501
516
in
502
517
let ci_term =
503
518
Term.(
504
-
const (fun dir opam_repository directory md -> run_ci { dir; opam_repository; package = List.hd (find_opam_files directory); directory = Some directory; md })
519
+
const (fun dir opam_repository directory md -> run_ci { dir; opam_repository; package = List.hd (find_opam_files directory); directory = Some directory; md; network = None })
505
520
$ cache_dir_term $ opam_repository_term $ directory_arg $ md_term)
506
521
in
507
522
let ci_info = Cmd.info "ci" ~doc:"Run CI tests on a directory" in
···
514
529
in
515
530
let health_check_term =
516
531
Term.(
517
-
const (fun dir opam_repository package md -> run_health_check { dir; opam_repository; package; directory = None; md })
532
+
const (fun dir opam_repository package md -> run_health_check { dir; opam_repository; package; directory = None; md; network = None })
518
533
$ cache_dir_term $ opam_repository_term $ package_arg $ md_term)
519
534
in
520
535
let health_check_info = Cmd.info "health-check" ~doc:"Run health check on a package" in
+63
-5
bin/os.ml
+63
-5
bin/os.ml
···
90
90
try Unix.unlink lock_file with
91
91
| _ -> ()
92
92
93
+
exception Copy_error of string
94
+
95
+
let cp ?(buffer_size = 65536) ?(preserve_permissions = true) ?(preserve_times = true) src dst =
96
+
let safe_close fd = try Unix.close fd with _ -> () in
97
+
let src_stats =
98
+
try Unix.stat src
99
+
with Unix.Unix_error (err, _, _) ->
100
+
raise (Copy_error (Printf.sprintf "Cannot stat source file '%s': %s" src (Unix.error_message err)))
101
+
in
102
+
if src_stats.st_kind <> S_REG then
103
+
raise (Copy_error (Printf.sprintf "Source '%s' is not a regular file" src));
104
+
let src_fd =
105
+
try Unix.openfile src [O_RDONLY] 0
106
+
with Unix.Unix_error (err, _, _) ->
107
+
raise (Copy_error (Printf.sprintf "Cannot open source file '%s': %s" src (Unix.error_message err)))
108
+
in
109
+
let dst_fd =
110
+
try Unix.openfile dst [O_WRONLY; O_CREAT; O_TRUNC] src_stats.st_perm
111
+
with Unix.Unix_error (err, _, _) ->
112
+
safe_close src_fd;
113
+
raise (Copy_error (Printf.sprintf "Cannot open destination file '%s': %s" dst (Unix.error_message err)))
114
+
in
115
+
let buffer = Bytes.create buffer_size in
116
+
let rec copy_loop () =
117
+
try
118
+
match (Unix.read src_fd buffer 0 buffer_size) with
119
+
| 0 -> ()
120
+
| bytes_read ->
121
+
let rec write_all pos remaining =
122
+
if remaining > 0 then
123
+
let bytes_written = Unix.write dst_fd buffer pos remaining in
124
+
write_all (pos + bytes_written) (remaining - bytes_written)
125
+
in
126
+
write_all 0 bytes_read;
127
+
copy_loop ()
128
+
with Unix.Unix_error (err, _, _) ->
129
+
safe_close src_fd;
130
+
safe_close dst_fd;
131
+
raise (Copy_error (Printf.sprintf "Error during copy: %s" (Unix.error_message err)))
132
+
in
133
+
copy_loop ();
134
+
safe_close src_fd;
135
+
safe_close dst_fd;
136
+
if preserve_permissions then begin
137
+
try Unix.chmod dst src_stats.st_perm
138
+
with Unix.Unix_error (err, _, _) ->
139
+
Printf.eprintf "Warning: Could not preserve permissions: %s\n" (Unix.error_message err)
140
+
end;
141
+
if preserve_times then begin
142
+
try Unix.utimes dst src_stats.st_atime src_stats.st_mtime
143
+
with Unix.Unix_error (err, _, _) ->
144
+
Printf.eprintf "Warning: Could not preserve timestamps: %s\n" (Unix.error_message err)
145
+
end
146
+
93
147
let hardlink_tree ~source ~target =
94
148
let rec process_directory current_source current_target =
95
149
let entries = Sys.readdir current_source in
···
97
151
let source = Filename.concat current_source entry in
98
152
let target = Filename.concat current_target entry in
99
153
try
100
-
let stat = Unix.stat source in
154
+
let stat = Unix.lstat source in
101
155
match stat.st_kind with
102
-
| Unix.S_LNK
156
+
| Unix.S_LNK ->
157
+
if not (Sys.file_exists target) then
158
+
Unix.symlink (Unix.readlink source) target
103
159
| Unix.S_REG ->
104
160
if not (Sys.file_exists target) then
105
161
Unix.link source target
106
162
| Unix.S_DIR ->
107
163
mkdir target;
108
164
process_directory source target
109
-
| _ ->
165
+
| S_CHR | S_BLK | S_FIFO | S_SOCK ->
110
166
()
111
167
with
112
-
| Unix.Unix_error _ ->
113
-
()
168
+
| Unix.Unix_error (Unix.EMLINK, _, _) ->
169
+
cp source target
170
+
| Unix.Unix_error (err, _, _) ->
171
+
Printf.eprintf "Warning: %s -> %s = %s\n" source target (Unix.error_message err);
114
172
) entries
115
173
in
116
174
process_directory source target