Fix doc layer cache misses, failure markers, and query visibility

+6 -1

day10/bin/dir_context.ml

··· 26 26 prefer_oldest : bool; 27 27 doc : bool; (* Whether to filter in {with-doc} deps *) 28 28 post : bool; (* Whether to filter in {post} deps *) 29 + examined_packages : OpamPackage.Name.Set.t ref; 29 30 } 30 31 31 32 let load t pkg = ··· 77 78 | false, true -> -1 78 79 79 80 let candidates t name = 81 + t.examined_packages := OpamPackage.Name.Set.add name !(t.examined_packages); 80 82 match OpamPackage.Name.Map.find_opt name t.pins with 81 83 | Some (version, opam) -> [ (version, Ok opam) ] 82 84 | None -> ··· 117 119 | Unavailable -> Fmt.string f "Availability condition not satisfied" 118 120 119 121 let create ?(prefer_oldest = false) ?(test = OpamPackage.Name.Set.empty) ?(pins = OpamPackage.Name.Map.empty) ?(doc = false) ?(post = true) ~constraints ~env packages_dirs = 120 - { env; packages_dirs; pins; constraints; test; prefer_oldest; doc; post } 122 + { env; packages_dirs; pins; constraints; test; prefer_oldest; doc; post; 123 + examined_packages = ref OpamPackage.Name.Set.empty } 124 + 125 + let examined_packages t = !(t.examined_packages) 121 126 122 127 (** Create a new context with different doc/post settings. 123 128 This is used to compute compile vs link deps separately. *)

+25

day10/bin/doc_tools.ml

··· 43 43 Builds odoc_driver_voodoo, sherlodoc, and odoc-md. 44 44 When [needs_compiler] is true, installs ocaml-base-compiler.5.2.1 first. 45 45 When false (compiler comes from lower layers), skips compiler installation. *) 46 + (** When pinning from a local repo, dune subst runs because version is "dev" 47 + but fails on the read-only bind mount. Returns (copy_cmds, rewritten_pin_cmds) 48 + where copy_cmds creates a writable copy with git init, and pin commands 49 + point to the writable copy instead. *) 50 + let fixup_local_pins ~(config : Config.t) ~packages pin_cmds = 51 + match Local_repo.find_for_packages ~local_repos:config.local_repos packages with 52 + | Some _ -> 53 + let local_mount = "/home/opam/local/odoc" in 54 + let local_rw = "/home/opam/local-rw" in 55 + let copy_cmds = 56 + [ "cp -a " ^ local_mount ^ " " ^ local_rw; 57 + "cd " ^ local_rw ^ " && git init -q && git add -A && git -c user.name=build -c user.email=build@local commit -q -m init" ] 58 + in 59 + let pin_cmds = List.map (fun cmd -> 60 + String.split_on_char ' ' cmd 61 + |> List.map (fun word -> if word = local_mount then local_rw else word) 62 + |> String.concat " " 63 + ) pin_cmds in 64 + (copy_cmds, pin_cmds) 65 + | None -> ([], pin_cmds) 66 + 46 67 let driver_build_script ~(config : Config.t) ~needs_compiler = 47 68 let repo = config.doc_tools_repo in 48 69 let branch = config.doc_tools_branch in ··· 62 83 Printf.sprintf "opam pin add -yn %s %s#%s" pkg repo branch 63 84 ) driver_packages 64 85 in 86 + let (local_copy_cmds, pin_cmds) = fixup_local_pins ~config ~packages:driver_packages pin_cmds in 65 87 let compiler_cmds = if needs_compiler then [ "opam install -y ocaml-base-compiler.5.2.1" ] else [] in 66 88 String.concat " && " 67 89 (compiler_cmds 90 + @ local_copy_cmds 68 91 @ pin_cmds 69 92 @ [ "opam install -y odoc-driver odoc-md sherlodoc"; 70 93 "eval $(opam env) && sherlodoc js > /home/opam/sherlodoc.js"; ··· 132 155 Printf.sprintf "opam pin add -yn %s %s#%s" pkg repo branch 133 156 ) odoc_packages 134 157 in 158 + let (local_copy_cmds, pin_cmds) = fixup_local_pins ~config ~packages:odoc_packages pin_cmds in 135 159 let compiler_cmds = if needs_compiler then [ Printf.sprintf "opam install -y %s" compiler_pkg ] else [] in 136 160 String.concat " && " 137 161 (compiler_cmds 162 + @ local_copy_cmds 138 163 @ pin_cmds 139 164 @ [ "opam install -y odoc"; 140 165 "eval $(opam env) && which odoc && odoc --version" ])

+3

day10/bin/dummy.ml

··· 33 33 let _rootfs = Path.(temp_dir / "fs") in 34 34 0 35 35 36 + let debug ~t:_ ~temp_dir:_ ?command:_ ?keep:_ _pkg _ordered_hashes = 37 + Printf.eprintf "Debug mode not supported in dummy container\n%!"; 1 38 + 36 39 let doc_layer_hash ~t:_ ~build_hash:_ ~dep_doc_hashes:_ ~ocaml_version:_ ~blessed:_ ~compiler_layers:_ = "" 37 40 38 41 (* Documentation generation not supported in dummy container *)

+3

day10/bin/freebsd.ml

··· 252 252 let _ = Os.sudo [ "sh"; "-c"; ("rm -f " ^ Path.(upperdir / "home" / "opam" / ".opam" / "repo" / "state-*.cache")) ] in 253 253 result 254 254 255 + let debug ~t:_ ~temp_dir:_ ?command:_ ?keep:_ _pkg _ordered_hashes = 256 + Printf.eprintf "Debug mode not yet supported on FreeBSD\n%!"; 1 257 + 255 258 let doc_layer_hash ~t:_ ~build_hash:_ ~dep_doc_hashes:_ ~ocaml_version:_ ~blessed:_ ~compiler_layers:_ = "" 256 259 257 260 (* Documentation generation not supported on FreeBSD *)

+133 -7

day10/bin/linux.ml

··· 50 50 51 51 let strings xs = `List (List.map (fun x -> `String x) xs) 52 52 53 - let make ~root ~cwd ~argv ~hostname ~uid ~gid ~env ~mounts ~network : Yojson.Safe.t = 53 + let make ~terminal ~root ~cwd ~argv ~hostname ~uid ~gid ~env ~mounts ~network : Yojson.Safe.t = 54 54 `Assoc 55 55 [ 56 56 ("ociVersion", `String "1.0.1-dev"); 57 57 ( "process", 58 58 `Assoc 59 59 [ 60 - ("terminal", `Bool false); 60 + ("terminal", `Bool terminal); 61 61 ("user", `Assoc [ ("uid", `Int uid); ("gid", `Int gid) ]); 62 62 ("args", strings argv); 63 63 ("env", strings (List.map (fun (k, v) -> Printf.sprintf "%s=%s" k v) env)); ··· 262 262 | None -> mounts 263 263 | Some src -> mounts @ [ { ty = "bind"; src; dst = "/home/opam/src"; options = [ "rw"; "rbind"; "rprivate" ] } ] 264 264 in 265 - let config_runc = make ~root:rootfsdir ~cwd:"/home/opam" ~argv ~hostname ~uid:t.uid ~gid:t.gid ~env ~mounts ~network:true in 265 + let config_runc = make ~terminal:false ~root:rootfsdir ~cwd:"/home/opam" ~argv ~hostname ~uid:t.uid ~gid:t.gid ~env ~mounts ~network:true in 266 266 let () = Os.write_to_file Path.(temp_dir / "config.json") (Yojson.Safe.pretty_to_string config_runc) in 267 267 let container_id = Filename.basename temp_dir in 268 268 (* Clean up any stale container with same ID from previous runs *) ··· 287 287 let _ = Os.sudo [ "sh"; "-c"; ("rm -f " ^ Path.(upperdir / "home" / "opam" / ".opam" / "repo" / "state-*.cache")) ] in 288 288 result 289 289 290 + let debug_env = 291 + List.map (fun (k, v) -> 292 + if k = "PATH" then (k, "/home/opam/.opam/default/bin:" ^ v) 293 + else (k, v) 294 + ) env 295 + @ [ ("OPAM_SWITCH_PREFIX", "/home/opam/.opam/default") ] 296 + 297 + (** Set up the debug overlay filesystem. Returns 0 on success. 298 + If the overlay is already mounted (--keep reuse), skips setup. *) 299 + let debug_setup ~t ~temp_dir ~pkg ordered_hashes = 300 + let config = t.config in 301 + let os_key = Config.os_key ~config in 302 + let lowerdir = Path.(temp_dir / "lower") in 303 + let upperdir = Path.(temp_dir / "fs") in 304 + let workdir = Path.(temp_dir / "work") in 305 + let rootfsdir = Path.(temp_dir / "rootfs") in 306 + (* Skip setup if already mounted (--keep reuse) *) 307 + if Sys.file_exists Path.(rootfsdir / "home") then 0 308 + else begin 309 + let () = List.iter Os.mkdir [ lowerdir; upperdir; workdir; rootfsdir ] in 310 + Printf.printf "Setting up debug container for %s...\n%!" (OpamPackage.to_string pkg); 311 + let copy_failed = ref false in 312 + let () = 313 + List.iter 314 + (fun hash -> 315 + if not !copy_failed then 316 + let src = Path.(config.dir / os_key / hash / "fs") in 317 + let r = Os.sudo ~stderr:"/dev/null" 318 + [ "cp"; "-n"; "--archive"; "--no-dereference"; 319 + "--recursive"; "--link"; "--no-target-directory"; 320 + src; lowerdir ] in 321 + if r <> 0 then copy_failed := true) 322 + ordered_hashes 323 + in 324 + if !copy_failed then (Printf.eprintf "Failed to set up dependency layers\n%!"; 1) 325 + else begin 326 + let () = 327 + let packages_dir = Path.(lowerdir / "home" / "opam" / ".opam" / "default" / ".opam-switch" / "packages") in 328 + let state_file = Path.(upperdir / "home" / "opam" / ".opam" / "default" / ".opam-switch" / "switch-state") in 329 + if Sys.file_exists packages_dir then 330 + Opamh.dump_state packages_dir state_file 331 + in 332 + let () = 333 + let home_dir = Path.(upperdir / "home") in 334 + if Sys.file_exists home_dir then ignore (Os.sudo [ "chown"; "-R"; string_of_int t.uid ^ ":" ^ string_of_int t.gid; home_dir ]) 335 + in 336 + let etc_hosts = Path.(temp_dir / "hosts") in 337 + let () = Os.write_to_file etc_hosts ("127.0.0.1 localhost " ^ hostname) in 338 + let ld = "lowerdir=" ^ String.concat ":" [ lowerdir; Path.(config.dir / os_key / "base" / "fs") ] in 339 + let ud = "upperdir=" ^ upperdir in 340 + let wd = "workdir=" ^ workdir in 341 + let mount_result = Os.sudo ~stderr:"/dev/null" [ "mount"; "-t"; "overlay"; "overlay"; rootfsdir; "-o"; String.concat "," [ ld; ud; wd ] ] in 342 + if mount_result <> 0 then begin 343 + Printf.eprintf "Failed to mount overlay filesystem\n%!"; 344 + 1 345 + end else 0 346 + end 347 + end 348 + 349 + (** Run a command in the debug container. The overlay must already be set up. *) 350 + let debug_run ~t ~temp_dir ~terminal ~argv ?command () = 351 + let config = t.config in 352 + let rootfsdir = Path.(temp_dir / "rootfs") in 353 + let etc_hosts = Path.(temp_dir / "hosts") in 354 + let mounts = 355 + [ { Mount.ty = "bind"; src = Path.(temp_dir / "opam-repository"); dst = "/home/opam/.opam/repo/default"; options = [ "rbind"; "rprivate" ] }; 356 + { ty = "bind"; src = etc_hosts; dst = "/etc/hosts"; options = [ "ro"; "rbind"; "rprivate" ] }; 357 + ] 358 + in 359 + let mounts = 360 + match config.directory with 361 + | None -> mounts 362 + | Some src -> mounts @ [ { ty = "bind"; src; dst = "/home/opam/src"; options = [ "rw"; "rbind"; "rprivate" ] } ] 363 + in 364 + let config_runc = make ~terminal ~root:rootfsdir ~cwd:"/home/opam" ~argv ~hostname ~uid:t.uid ~gid:t.gid ~env:debug_env ~mounts ~network:true in 365 + let () = Os.write_to_file Path.(temp_dir / "config.json") (Yojson.Safe.pretty_to_string config_runc) in 366 + let container_id = "debug-" ^ Filename.basename temp_dir in 367 + let _ = Os.sudo ~stdout:"/dev/null" ~stderr:"/dev/null" [ "runc"; "delete"; "-f"; container_id ] in 368 + let build_log = Path.(temp_dir / "build.log") in 369 + let result = match command with 370 + | Some _ -> Os.sudo ~stdout:build_log ~stderr:build_log [ "runc"; "run"; "-b"; temp_dir; container_id ] 371 + | None -> Os.sudo [ "runc"; "run"; "-b"; temp_dir; container_id ] 372 + in 373 + let _ = Os.sudo ~stdout:"/dev/null" ~stderr:"/dev/null" [ "runc"; "delete"; "-f"; container_id ] in 374 + result 375 + 376 + (** Tear down the debug overlay. *) 377 + let debug_teardown ~temp_dir = 378 + let rootfsdir = Path.(temp_dir / "rootfs") in 379 + let lowerdir = Path.(temp_dir / "lower") in 380 + let workdir = Path.(temp_dir / "work") in 381 + let _ = Os.sudo ~stderr:"/dev/null" [ "umount"; rootfsdir ] in 382 + let _ = Os.sudo [ "rm"; "-rf"; lowerdir; workdir; rootfsdir ] in 383 + () 384 + 385 + let debug ~t ~temp_dir ?command ?(keep=false) pkg ordered_hashes = 386 + let pkg_string = OpamPackage.to_string pkg in 387 + let setup_result = debug_setup ~t ~temp_dir ~pkg ordered_hashes in 388 + if setup_result <> 0 then setup_result 389 + else begin 390 + (* Extract source into the overlay if not already present *) 391 + let src_dir = Path.(temp_dir / "fs" / "home" / "opam" / "src") in 392 + if not (Sys.file_exists src_dir) then begin 393 + Printf.printf "Extracting source for %s...\n%!" pkg_string; 394 + let source_cmd = Printf.sprintf "opam source %s --dir=/home/opam/src" pkg_string in 395 + let _ = debug_run ~t ~temp_dir ~terminal:false 396 + ~argv:[ "/usr/bin/env"; "bash"; "-c"; source_cmd ] 397 + ~command:source_cmd () in 398 + () 399 + end; 400 + (* Run the actual debug command *) 401 + let terminal, argv = match command with 402 + | Some cmd -> 403 + (false, [ "/usr/bin/env"; "bash"; "-c"; cmd ]) 404 + | None -> 405 + let container_cmd = Printf.sprintf 406 + "echo '==> Source: /home/opam/src'; echo '==> Building %s'; cd /home/opam/src && opam-build -v %s; if [ $? -ne 0 ]; then echo; echo '==> Build failed. Dropping to interactive shell.'; echo '==> Run: opam-build -v %s to retry'; echo; exec bash -i; fi" 407 + pkg_string pkg_string pkg_string 408 + in 409 + (true, [ "/usr/bin/env"; "bash"; "-c"; container_cmd ]) 410 + in 411 + let result = debug_run ~t ~temp_dir ~terminal ~argv ?command () in 412 + if not keep then debug_teardown ~temp_dir; 413 + result 414 + end 415 + 290 416 (** Create a merged opam repository from multiple repos. 291 417 When there's only one repo, symlinks directly to it. 292 418 When there are multiple repos, creates a merged directory with ··· 371 497 ] @ extra_mounts 372 498 in 373 499 let config_runc = 374 - make ~root:rootfsdir ~cwd:"/home/opam" ~argv ~hostname ~uid:t.uid 500 + make ~terminal:false ~root:rootfsdir ~cwd:"/home/opam" ~argv ~hostname ~uid:t.uid 375 501 ~gid:t.gid ~env ~mounts ~network:true 376 502 in 377 503 let () = ··· 638 764 env 639 765 in 640 766 let config_runc = 641 - make ~root:rootfsdir ~cwd:Odoc_gen.container_workdir ~argv ~hostname ~uid:t.uid 767 + make ~terminal:false ~root:rootfsdir ~cwd:Odoc_gen.container_workdir ~argv ~hostname ~uid:t.uid 642 768 ~gid:t.gid ~env:odoc_env ~mounts ~network:false 643 769 in 644 770 let () = ··· 797 923 let jtw_env = List.map (fun (k, v) -> 798 924 if k = "PATH" then (k, "/home/opam/.opam/default/bin:" ^ v) else (k, v) 799 925 ) env in 800 - let config_runc = make ~root:rootfsdir ~cwd:"/home/opam" ~argv ~hostname ~uid:t.uid ~gid:t.gid ~env:jtw_env ~mounts ~network:false in 926 + let config_runc = make ~terminal:false ~root:rootfsdir ~cwd:"/home/opam" ~argv ~hostname ~uid:t.uid ~gid:t.gid ~env:jtw_env ~mounts ~network:false in 801 927 let () = Os.write_to_file Path.(temp_dir / "config.json") (Yojson.Safe.pretty_to_string config_runc) in 802 928 let container_id = "jtw-" ^ Filename.basename temp_dir in 803 929 let _ = Os.sudo ~stdout:"/dev/null" ~stderr:"/dev/null" [ "runc"; "delete"; "-f"; container_id ] in ··· 915 1041 if k = "PATH" then (k, "/home/opam/.opam/default/bin:" ^ v) else (k, v) 916 1042 ) env in 917 1043 (* Need network for opam install of jtw tools inside container *) 918 - let config_runc = make ~root:rootfsdir ~cwd:"/home/opam" ~argv ~hostname ~uid:t.uid ~gid:t.gid ~env:jtw_env ~mounts ~network:true in 1044 + let config_runc = make ~terminal:false ~root:rootfsdir ~cwd:"/home/opam" ~argv ~hostname ~uid:t.uid ~gid:t.gid ~env:jtw_env ~mounts ~network:true in 919 1045 let () = Os.write_to_file Path.(temp_dir / "config.json") (Yojson.Safe.pretty_to_string config_runc) in 920 1046 let container_id = "jtw-worker-" ^ Filename.basename temp_dir in 921 1047 let _ = Os.sudo ~stdout:"/dev/null" ~stderr:"/dev/null" [ "runc"; "delete"; "-f"; container_id ] in

+28 -8

day10/bin/local_repo.ml

··· 2 2 3 3 (** Discover opam package names in a local directory. 4 4 Scans for *.opam files at the root (not recursive). *) 5 + let discover_packages_cache : (string, string list) Hashtbl.t = Hashtbl.create 4 6 + 5 7 let discover_packages path = 6 - let entries = Sys.readdir path in 7 - Array.to_list entries 8 - |> List.filter_map (fun name -> 9 - match Filename.extension name with 10 - | ".opam" -> Some (Filename.remove_extension name) 11 - | _ -> None) 8 + match Hashtbl.find_opt discover_packages_cache path with 9 + | Some pkgs -> pkgs 10 + | None -> 11 + let pkgs = 12 + let entries = Sys.readdir path in 13 + Array.to_list entries 14 + |> List.filter_map (fun name -> 15 + match Filename.extension name with 16 + | ".opam" -> Some (Filename.remove_extension name) 17 + | _ -> None) 18 + in 19 + Hashtbl.replace discover_packages_cache path pkgs; 20 + pkgs 12 21 13 22 (** Compute a cache hash for a local repository path. 14 - Uses git HEAD + dirty state if available, otherwise hashes opam file contents. *) 15 - let repo_hash path = 23 + Uses git HEAD + dirty state if available, otherwise hashes opam file contents. 24 + Cached per path to avoid repeated git subprocess calls. *) 25 + let repo_hash_cache : (string, string) Hashtbl.t = Hashtbl.create 4 26 + 27 + let rec repo_hash path = 28 + match Hashtbl.find_opt repo_hash_cache path with 29 + | Some h -> h 30 + | None -> 31 + let h = repo_hash_impl path in 32 + Hashtbl.replace repo_hash_cache path h; 33 + h 34 + 35 + and repo_hash_impl path = 16 36 let git_dir = Filename.concat path ".git" in 17 37 if Sys.file_exists git_dir then begin 18 38 (* Git repo: use HEAD sha + dirty flag *)

+990 -159

day10/bin/main.ml

··· 190 190 else 191 191 solution 192 192 in 193 - Ok solution 194 - | Error problem -> Error (Solver.diagnostics problem) 193 + let examined = Dir_context.examined_packages context in 194 + Ok (solution, examined) 195 + | Error problem -> 196 + let examined = Dir_context.examined_packages context in 197 + Error (Solver.diagnostics problem, examined) 195 198 196 199 (** Get the extra link deps for a package from both post deps and x-extra-doc-deps. 197 200 Returns the set of package names that are needed for linking but not compiling. *) ··· 390 393 let installed_libs = Util.scan_installed_lib_files ~layer_dir:target_dir in 391 394 let installed_docs = Util.scan_installed_doc_files ~layer_dir:target_dir in 392 395 Util.save_layer_info ~installed_libs ~installed_docs layer_json pkg ordered_deps ordered_build_hashes r; 396 + (* Cache disk usage for fast reporting *) 397 + let size = Os.dir_size target_dir in 398 + Os.write_to_file Path.(target_dir / "disk_usage") (string_of_int size); 393 399 (* Create symlink from packages/{pkg} -> ../build-{hash} for easy lookup by package name *) 394 400 Util.ensure_package_layer_symlink ~cache_dir:config.dir ~os_key:(Config.os_key ~config) ~pkg_str ~layer_name:build_layer_name 395 401 in ··· 434 440 Reads installed files from the build layer, runs doc generation, 435 441 and saves doc layer info. 436 442 Returns [Some doc_layer_name] on success, [None] on failure. *) 437 - let doc_layer t pkg build_layer_name dep_doc_hashes ~ocaml_version ~compiler_layers = 443 + let doc_layer t pkg build_layer_name dep_doc_hashes ~ocaml_version ~compiler_layers ?blessed:blessed_override () = 438 444 match ocaml_version with 439 445 | None -> None (* No OCaml version means no docs (e.g., conf-* packages) *) 440 446 | Some ocaml_version -> ··· 444 450 Os.log "doc_layer: starting %s (build=%s, ocaml=%s)" pkg_str build_layer_name (OpamPackage.to_string ocaml_version); 445 451 let config = Container.config ~t in 446 452 let os_key = Config.os_key ~config in 447 - let blessed = match config.blessed_map with 448 - | Some map -> Blessing.is_blessed map pkg 449 - | None -> false 453 + let blessed = match blessed_override with 454 + | Some b -> b 455 + | None -> 456 + match config.blessed_map with 457 + | Some map -> Blessing.is_blessed map pkg 458 + | None -> false 450 459 in 451 460 let doc_hash = Container.doc_layer_hash ~t ~build_hash:build_layer_name ~dep_doc_hashes ~ocaml_version ~blessed ~compiler_layers in 452 461 let doc_layer_name = "doc-" ^ doc_hash in ··· 474 483 let doc_result = 475 484 Container.generate_docs ~t ~build_layer_dir ~doc_layer_dir:target_dir ~dep_doc_hashes ~pkg ~installed_libs ~installed_docs ~phase ~ocaml_version ~compiler_layers 476 485 in 477 - Util.save_doc_layer_info ?doc_result (Path.(target_dir / "layer.json")) pkg ~build_hash:build_layer_name ~dep_doc_hashes 486 + Util.save_doc_layer_info ?doc_result (Path.(target_dir / "layer.json")) pkg ~build_hash:build_layer_name ~dep_doc_hashes; 487 + (* Cache disk usage for fast reporting *) 488 + let size = Os.dir_size target_dir in 489 + Os.write_to_file Path.(target_dir / "disk_usage") (string_of_int size) 478 490 in 479 491 let safe_write_layer ~set_temp_log_path target_dir = 480 492 (* Create directory first so we can write failure marker if needed *) ··· 482 494 try 483 495 write_layer ~set_temp_log_path target_dir 484 496 with exn -> 485 - (* Ensure layer.json is created even on failure, so other workers don't wait forever *) 497 + (* Ensure layer.json is created even on failure, so other workers don't wait forever. 498 + Container cleanup may have removed the directory, so re-create it. *) 486 499 let error_msg = Printf.sprintf "Exception during doc generation: %s" (Printexc.to_string exn) in 487 500 Os.log "doc_layer: FAILED %s - %s" pkg_str error_msg; 488 - let target_layer_json = Path.(target_dir / "layer.json") in 489 - if not (Sys.file_exists target_layer_json) then 490 - Util.save_doc_layer_info ~doc_result:(Odoc_gen.doc_result_to_yojson (Odoc_gen.Doc_failure error_msg)) target_layer_json pkg ~build_hash:build_layer_name ~dep_doc_hashes; 501 + (try 502 + if not (Sys.file_exists target_dir) then Os.mkdir target_dir; 503 + let target_layer_json = Path.(target_dir / "layer.json") in 504 + if not (Sys.file_exists target_layer_json) then 505 + Util.save_doc_layer_info ~doc_result:(Odoc_gen.doc_result_to_yojson (Odoc_gen.Doc_failure error_msg)) target_layer_json pkg ~build_hash:build_layer_name ~dep_doc_hashes 506 + with _ -> Os.log "doc_layer: could not write failure marker for %s" pkg_str); 491 507 raise exn 492 508 in 493 509 let lock_info = Os.{ cache_dir = config.dir; stage = `Doc; package = pkg_name; version = pkg_version; universe = Some universe; layer_name = Some doc_layer_name } in ··· 496 512 Os.create_directory_exclusively ~marker_file:doc_layer_json ~lock_info doc_layer_dir safe_write_layer 497 513 in 498 514 Util.wait_for_layer_json ~layer_json:doc_layer_json ~layer_name:doc_layer_name; 515 + (* Always create symlink so query can find both successful and failed doc layers *) 516 + Util.ensure_package_layer_symlink ~cache_dir:config.dir ~os_key ~pkg_str ~layer_name:doc_layer_name; 499 517 (* Check if doc generation failed *) 500 518 if Util.load_layer_info_doc_failed doc_layer_json then 501 519 None 502 520 else begin 503 - (* Create symlink for this doc layer *) 504 - Util.ensure_package_layer_symlink ~cache_dir:config.dir ~os_key ~pkg_str ~layer_name:doc_layer_name; 505 521 (* If blessed, create blessed-build and blessed-docs symlinks *) 506 522 if blessed then begin 507 523 Util.ensure_package_blessed_symlink ~cache_dir:config.dir ~os_key ~pkg_str ~kind:`Build ~layer_name:build_layer_name; ··· 536 552 let jtw_result = 537 553 Container.generate_jtw ~t ~build_layer_dir ~jtw_layer_dir:target_dir ~dep_build_hashes ~pkg ~installed_libs ~ocaml_version ~compiler_layers 538 554 in 539 - Jtw_gen.save_jtw_layer_info ?jtw_result (Path.(target_dir / "layer.json")) pkg ~build_hash:build_layer_name 555 + Jtw_gen.save_jtw_layer_info ?jtw_result (Path.(target_dir / "layer.json")) pkg ~build_hash:build_layer_name; 556 + (* Cache disk usage for fast reporting *) 557 + let size = Os.dir_size target_dir in 558 + Os.write_to_file Path.(target_dir / "disk_usage") (string_of_int size) 540 559 in 541 560 let safe_write_layer ~set_temp_log_path target_dir = 542 561 if not (Sys.file_exists target_dir) then Os.mkdir target_dir; ··· 563 582 Key: comma-joined package names, Value: hash string. *) 564 583 let layer_hash_global_cache : (string, string) Hashtbl.t = Hashtbl.create 4096 565 584 585 + (* Per-package opam hash cache: avoids re-reading and re-parsing opam files. 586 + Key: package string, Value: hash of effective opam content. *) 587 + let per_pkg_opam_hash_cache : (string, string) Hashtbl.t = Hashtbl.create 4096 588 + 589 + let cached_pkg_opam_hash ~t pkg = 590 + let key = OpamPackage.to_string pkg in 591 + match Hashtbl.find_opt per_pkg_opam_hash_cache key with 592 + | Some h -> h 593 + | None -> 594 + let config = Container.config ~t in 595 + let h = pkg |> Util.opam_file config.opam_repositories |> Option.get 596 + |> OpamFile.OPAM.effective_part |> OpamFile.OPAM.write_to_string 597 + |> OpamHash.compute_from_string |> OpamHash.to_string in 598 + Hashtbl.replace per_pkg_opam_hash_cache key h; 599 + h 600 + 566 601 let cached_layer_hash_global ~t pkgs = 567 602 let key = String.concat "," (List.map OpamPackage.to_string pkgs) in 568 603 match Hashtbl.find_opt layer_hash_global_cache key with 569 604 | Some h -> h 570 605 | None -> 571 - let h = Container.layer_hash ~t pkgs in 606 + let config = Container.config ~t in 607 + let base = Container.base_hash ~config in 608 + let hashes = List.map (fun pkg -> cached_pkg_opam_hash ~t pkg) pkgs in 609 + let h = String.concat " " (base :: hashes) |> Digest.string |> Digest.to_hex in 572 610 Hashtbl.replace layer_hash_global_cache key h; 573 611 h 574 612 575 613 let build config package = 576 614 match solve config package with 577 - | Ok solution -> 615 + | Ok (solution, _examined) -> 578 616 let () = if config.log then Dot_solution.to_string solution |> print_endline in 579 617 let () = Option.iter (fun filename -> Dot_solution.save filename solution) config.dot in 580 618 let t = Container.init ~config in ··· 651 689 match r with 652 690 | Success _ -> 653 691 let dep_doc_hashes = List.filter_map (fun p -> OpamPackage.Map.find_opt p dm) ordered_deps in 654 - (match doc_layer t pkg build_layer_name dep_doc_hashes ~ocaml_version ~compiler_layers:!compiler_layers with 692 + (match doc_layer t pkg build_layer_name dep_doc_hashes ~ocaml_version ~compiler_layers:!compiler_layers () with 655 693 | Some doc_name -> 656 694 (* Track packages with extra link deps (post deps + x-extra-doc-deps) for deferred doc linking *) 657 695 let opamfile = Util.opam_file config.opam_repositories pkg in ··· 783 821 784 822 Container.deinit ~t; 785 823 results @ [ Solution solution ] 786 - | Error s -> 824 + | Error (s, _examined) -> 787 825 let () = if config.log then print_endline s in 788 826 [ No_solution s ] 789 827 ··· 974 1012 (** Run deferred doc link pass for packages with x-extra-doc-deps across all built packages. 975 1013 This is used in batch mode after all targets are built, to link packages whose 976 1014 x-extra-doc-deps were not available during the initial doc generation. *) 977 - let run_global_deferred_doc_link (config : Config.t) = 1015 + let run_global_deferred_doc_link ?(doc_layers : (string * string) list option) (config : Config.t) = 978 1016 if not config.with_doc then () 979 1017 else begin 980 1018 let os_key = Config.os_key ~config in 981 1019 let layer_dir = Path.(config.dir / os_key) in 982 1020 let t = Container.init ~config in 983 1021 984 - (* Build a map of package name -> (package, doc_layer_dir, doc_hash) for all doc layers *) 1022 + (* Build a map of package name -> (package, doc_layer_dir, doc_hash) for known doc layers. 1023 + When doc_layers is provided (fork path), use it directly instead of scanning the filesystem. *) 985 1024 let doc_layers_by_name = 986 1025 let layers = ref OpamPackage.Name.Map.empty in 987 - (try 988 - Sys.readdir layer_dir |> Array.iter (fun name -> 989 - if String.length name > 4 && String.sub name 0 4 = "doc-" then begin 990 - let layer_json = Path.(layer_dir / name / "layer.json") in 991 - if Sys.file_exists layer_json then 992 - try 993 - let json = Yojson.Safe.from_file layer_json in 994 - let open Yojson.Safe.Util in 995 - let pkg_str = json |> member "package" |> to_string in 996 - let pkg = OpamPackage.of_string pkg_str in 997 - layers := OpamPackage.Name.Map.add (OpamPackage.name pkg) (pkg, Path.(layer_dir / name), name) !layers 998 - with _ -> () 999 - end 1000 - ) 1001 - with _ -> ()); 1026 + (match doc_layers with 1027 + | Some known_layers -> 1028 + List.iter (fun (pkg_str, doc_name) -> 1029 + try 1030 + let pkg = OpamPackage.of_string pkg_str in 1031 + layers := OpamPackage.Name.Map.add (OpamPackage.name pkg) (pkg, Path.(layer_dir / doc_name), doc_name) !layers 1032 + with _ -> () 1033 + ) known_layers 1034 + | None -> 1035 + (try 1036 + Sys.readdir layer_dir |> Array.iter (fun name -> 1037 + if String.length name > 4 && String.sub name 0 4 = "doc-" then begin 1038 + let layer_json = Path.(layer_dir / name / "layer.json") in 1039 + if Sys.file_exists layer_json then 1040 + try 1041 + let json = Yojson.Safe.from_file layer_json in 1042 + let open Yojson.Safe.Util in 1043 + let pkg_str = json |> member "package" |> to_string in 1044 + let pkg = OpamPackage.of_string pkg_str in 1045 + layers := OpamPackage.Name.Map.add (OpamPackage.name pkg) (pkg, Path.(layer_dir / name), name) !layers 1046 + with _ -> () 1047 + end 1048 + ) 1049 + with _ -> ())); 1002 1050 !layers 1003 1051 in 1004 1052 ··· 1094 1142 end 1095 1143 end 1096 1144 1097 - (** Collect all layer names that should be kept based on current solutions. 1098 - A layer is referenced if its package is in any of the solutions. *) 1099 - let collect_referenced_layer_names ~config ~solutions = 1145 + (** Collect all layer names that should be kept based on ALL cached solutions. 1146 + Scans every solution file under solutions/<opam-repo-sha>/<package>.json 1147 + to build the full set of referenced packages, not just the current batch. *) 1148 + let collect_referenced_layer_names ~config ~solutions:_ ?known_layers () = 1149 + match known_layers with 1150 + | Some layers -> layers 1151 + | None -> 1100 1152 let os_key = Config.os_key ~config in 1101 1153 let layer_dir = Path.(config.dir / os_key) in 1154 + let solutions_dir = Path.(config.dir / "solutions") in 1102 1155 1103 - (* Collect all packages from all solutions *) 1104 - let all_packages = List.fold_left (fun acc (_target, solution) -> 1105 - OpamPackage.Map.fold (fun pkg _ set -> OpamPackage.Set.add pkg set) solution acc 1106 - ) OpamPackage.Set.empty solutions in 1156 + (* Collect all packages from ALL cached solution files *) 1157 + let all_packages = ref OpamPackage.Set.empty in 1158 + (try 1159 + Sys.readdir solutions_dir |> Array.iter (fun sha_dir -> 1160 + let sha_path = Path.(solutions_dir / sha_dir) in 1161 + if Sys.is_directory sha_path then 1162 + try 1163 + Sys.readdir sha_path |> Array.iter (fun sol_file -> 1164 + if Filename.check_suffix sol_file ".json" then 1165 + try 1166 + let json = Yojson.Safe.from_file Path.(sha_path / sol_file) in 1167 + let open Yojson.Safe.Util in 1168 + (* Skip cached failures *) 1169 + if json |> member "failed" |> to_bool_option <> Some true then begin 1170 + let solution_json = json |> member "solution" in 1171 + (* Solution is a map from "pkg.version" -> deps list *) 1172 + let keys = try keys solution_json with _ -> [] in 1173 + List.iter (fun key -> 1174 + match OpamPackage.of_string_opt key with 1175 + | Some pkg -> all_packages := OpamPackage.Set.add pkg !all_packages 1176 + | None -> () 1177 + ) keys 1178 + end 1179 + with _ -> () 1180 + ) 1181 + with _ -> () 1182 + ) 1183 + with _ -> ()); 1107 1184 1108 1185 (* Scan layer.json files and collect layers whose packages are in solutions *) 1109 1186 let layers = ref [] in ··· 1116 1193 let open Yojson.Safe.Util in 1117 1194 let pkg_str = json |> member "package" |> to_string in 1118 1195 let pkg = OpamPackage.of_string pkg_str in 1119 - if OpamPackage.Set.mem pkg all_packages then 1196 + if OpamPackage.Set.mem pkg !all_packages then 1120 1197 layers := name :: !layers 1121 1198 with _ -> () 1122 1199 ) ··· 1124 1201 !layers 1125 1202 1126 1203 (** Run garbage collection for layers and universes after batch processing. *) 1127 - let run_gc ~config ~solutions = 1204 + let run_gc ~config ~solutions ?known_layers () = 1128 1205 let os_key = Config.os_key ~config in 1129 - let referenced_layer_names = collect_referenced_layer_names ~config ~solutions in 1206 + let referenced_layer_names = collect_referenced_layer_names ~config ~solutions ?known_layers () in 1130 1207 1131 1208 Printf.printf "Phase 4: Running garbage collection...\n%!"; 1132 1209 ··· 1156 1233 deduplicated by build_hash. *) 1157 1234 let build_global_dag ~(config : Config.t) solutions = 1158 1235 let t = Container.init ~config in 1236 + (* Pre-populate per-package opam hash cache for all packages across solutions. 1237 + This reads each unique opam file exactly once. *) 1238 + let all_pkgs = Hashtbl.create 4096 in 1239 + List.iter (fun (_target, solution) -> 1240 + OpamPackage.Map.iter (fun pkg _deps -> 1241 + let key = OpamPackage.to_string pkg in 1242 + if not (Hashtbl.mem all_pkgs key) then begin 1243 + Hashtbl.replace all_pkgs key true; 1244 + ignore (cached_pkg_opam_hash ~t pkg) 1245 + end 1246 + ) solution 1247 + ) solutions; 1159 1248 (* Collect all (build_hash -> build_node) across all solutions *) 1160 1249 let nodes : (string, build_node) Hashtbl.t = Hashtbl.create 1024 in 1161 1250 (* Track dep edges: build_hash -> set of dep build_hashes *) 1162 1251 let edges : (string, string list) Hashtbl.t = Hashtbl.create 1024 in 1252 + (* Cache: (pkg_str, sorted deps string) -> build_hash. 1253 + Avoids redundant extract_dag + topological_sort + hash computation 1254 + for the same package with the same deps across solutions. *) 1255 + let dag_cache : (string, string) Hashtbl.t = Hashtbl.create 4096 in 1256 + (* Cache topological_sort + pkg_deps by solution key (sorted package set). *) 1257 + let solution_cache : (string, OpamPackage.t list * OpamPackage.Set.t OpamPackage.Map.t) Hashtbl.t = Hashtbl.create 256 in 1163 1258 let per_solution_hashes = List.map (fun (_target, solution) -> 1164 - let ordered = topological_sort solution in 1165 - let dependencies = pkg_deps solution ordered in 1259 + let sol_key = OpamPackage.Map.fold (fun pkg _ acc -> OpamPackage.to_string pkg ^ "," ^ acc) solution "" 1260 + |> Digest.string |> Digest.to_hex in 1261 + let ordered, dependencies = match Hashtbl.find_opt solution_cache sol_key with 1262 + | Some cached -> cached 1263 + | None -> 1264 + let ordered = topological_sort solution in 1265 + let dependencies = pkg_deps solution ordered in 1266 + Hashtbl.replace solution_cache sol_key (ordered, dependencies); 1267 + (ordered, dependencies) 1268 + in 1166 1269 (* Map from pkg -> build_hash for this solution *) 1167 1270 let pkg_to_hash : (string, string) Hashtbl.t = Hashtbl.create 64 in 1168 1271 List.iter (fun pkg -> 1169 - let ordered_deps = extract_dag dependencies pkg |> topological_sort |> List.rev |> List.tl in 1170 - let hash = cached_layer_hash_global ~t (pkg :: ordered_deps) in 1171 - let build_hash = "build-" ^ hash in 1172 - let dep_build_hashes = List.filter_map (fun dep -> 1173 - Hashtbl.find_opt pkg_to_hash (OpamPackage.to_string dep) 1174 - ) ordered_deps in 1175 - Hashtbl.replace pkg_to_hash (OpamPackage.to_string pkg) build_hash; 1176 - if not (Hashtbl.mem nodes build_hash) then begin 1177 - Hashtbl.replace nodes build_hash { pkg; build_hash; ordered_deps; dep_build_hashes }; 1178 - Hashtbl.replace edges build_hash dep_build_hashes 1179 - end 1272 + let trans_deps = OpamPackage.Map.find pkg dependencies in 1273 + let dag_key = OpamPackage.to_string pkg ^ ":" ^ 1274 + (OpamPackage.Set.fold (fun p acc -> OpamPackage.to_string p ^ "," ^ acc) trans_deps "") in 1275 + let build_hash = match Hashtbl.find_opt dag_cache dag_key with 1276 + | Some h -> h 1277 + | None -> 1278 + let ordered_deps = extract_dag dependencies pkg |> topological_sort |> List.rev |> List.tl in 1279 + let hash = cached_layer_hash_global ~t (pkg :: ordered_deps) in 1280 + let build_hash = "build-" ^ hash in 1281 + let dep_build_hashes = List.filter_map (fun dep -> 1282 + Hashtbl.find_opt pkg_to_hash (OpamPackage.to_string dep) 1283 + ) ordered_deps in 1284 + if not (Hashtbl.mem nodes build_hash) then begin 1285 + Hashtbl.replace nodes build_hash { pkg; build_hash; ordered_deps; dep_build_hashes }; 1286 + Hashtbl.replace edges build_hash dep_build_hashes 1287 + end; 1288 + Hashtbl.replace dag_cache dag_key build_hash; 1289 + build_hash 1290 + in 1291 + Hashtbl.replace pkg_to_hash (OpamPackage.to_string pkg) build_hash 1180 1292 ) ordered; 1181 1293 (ordered, pkg_to_hash) 1182 1294 ) solutions in ··· 1300 1412 promote_dependents hash 1301 1413 in 1302 1414 let reap_one () = 1303 - let pid, status = Unix.waitpid [] (-1) in 1415 + let rec waitpid_eintr () = 1416 + try Unix.waitpid [] (-1) 1417 + with Unix.Unix_error (Unix.EINTR, _, _) -> waitpid_eintr () 1418 + in 1419 + let pid, status = waitpid_eintr () in 1304 1420 let exit_code = match status with 1305 1421 | Unix.WEXITED c -> c 1306 1422 | _ -> 1 ··· 1425 1541 let cached_count = try Array.length (Sys.readdir solutions_cache_dir) with _ -> 0 in 1426 1542 Printf.printf "Phase 1: Solving %d targets (cache: %s, %d cached)...\n%!" (List.length packages) opam_repo_sha cached_count; 1427 1543 let temp_dir = Os.temp_dir ~perms:0o755 ~parent_dir:config.dir "solve-" "" in 1544 + (* Compute full SHAs for git-based diff *) 1545 + let opam_repo_full_shas = 1546 + List.map 1547 + (fun opam_repository -> 1548 + let cmd = Printf.sprintf "git -C %s rev-parse HEAD" opam_repository in 1549 + Os.run cmd |> String.trim) 1550 + config.opam_repositories 1551 + in 1552 + 1553 + (* Incremental solver reuse: find previous SHA directory and compute changed packages *) 1554 + let _reused_count = 1555 + let solutions_base = Path.(config.dir / "solutions") in 1556 + let prev_sha_dirs = try 1557 + Sys.readdir solutions_base |> Array.to_list 1558 + |> List.filter (fun d -> d <> opam_repo_sha && Sys.is_directory Path.(solutions_base / d)) 1559 + |> List.sort (fun a b -> 1560 + (* Pick most recently modified *) 1561 + let mtime_a = try (Unix.stat Path.(solutions_base / a)).Unix.st_mtime with _ -> 0.0 in 1562 + let mtime_b = try (Unix.stat Path.(solutions_base / b)).Unix.st_mtime with _ -> 0.0 in 1563 + compare mtime_b mtime_a) 1564 + with _ -> [] in 1565 + match prev_sha_dirs with 1566 + | [] -> 0 1567 + | prev_sha :: _ -> 1568 + (* Compute which packages changed between old and new opam-repository commits *) 1569 + let changed_set = 1570 + let prev_short_shas = String.split_on_char '-' prev_sha in 1571 + List.fold_left2 (fun acc prev_short_sha (opam_repository, full_sha) -> 1572 + try 1573 + let prev_full_cmd = Printf.sprintf "git -C %s rev-parse %s" opam_repository prev_short_sha in 1574 + let prev_full_sha = Os.run prev_full_cmd |> String.trim in 1575 + if prev_full_sha = full_sha then acc 1576 + else begin 1577 + let store, _current_commit = Git_utils.get_git_repo_store_and_hash opam_repository in 1578 + let old_hash = Git_utils.resolve_commit_in_store store (Some prev_full_sha) in 1579 + let new_hash = Git_utils.resolve_commit_in_store store (Some full_sha) in 1580 + let changed = Git_packages.diff_packages ~store old_hash new_hash in 1581 + List.fold_left (fun s n -> OpamPackage.Name.Set.add n s) acc changed 1582 + end 1583 + with _ -> acc 1584 + ) OpamPackage.Name.Set.empty prev_short_shas 1585 + (List.combine config.opam_repositories opam_repo_full_shas) 1586 + in 1587 + let prev_solutions_dir = Path.(solutions_base / prev_sha) in 1588 + let reused = ref 0 in 1589 + (* For each package, check if we can reuse its previous solution *) 1590 + List.iter (fun pkg_name -> 1591 + let cache_file = Path.(solutions_cache_dir / pkg_name ^ ".json") in 1592 + if not (Sys.file_exists cache_file) then begin 1593 + let prev_cache = Path.(prev_solutions_dir / pkg_name ^ ".json") in 1594 + if Sys.file_exists prev_cache then 1595 + try 1596 + let json = Yojson.Safe.from_string (Os.read_from_file prev_cache) in 1597 + let open Yojson.Safe.Util in 1598 + let examined_json = json |> member "examined" in 1599 + if examined_json <> `Null then begin 1600 + let examined_names = examined_json |> to_list |> List.map to_string 1601 + |> List.map OpamPackage.Name.of_string 1602 + |> OpamPackage.Name.Set.of_list in 1603 + if OpamPackage.Name.Set.is_empty (OpamPackage.Name.Set.inter examined_names changed_set) then begin 1604 + (* No overlap: hardlink the solution file *) 1605 + (try Unix.link prev_cache cache_file; incr reused 1606 + with _ -> 1607 + (* Hardlink failed (cross-device?), copy instead *) 1608 + try Os.write_to_file cache_file (Os.read_from_file prev_cache); incr reused 1609 + with _ -> ()) 1610 + end 1611 + end 1612 + with _ -> () 1613 + end 1614 + ) packages; 1615 + if !reused > 0 then 1616 + Printf.printf " Incremental reuse: %d solutions reused from %s (%d changed packages)\n%!" 1617 + !reused prev_sha (OpamPackage.Name.Set.cardinal changed_set); 1618 + !reused 1619 + in 1620 + 1621 + let serialize_examined examined = 1622 + `List (OpamPackage.Name.Set.fold (fun n acc -> 1623 + `String (OpamPackage.Name.to_string n) :: acc 1624 + ) examined []) 1625 + in 1428 1626 let serialize (pkg, solution) = 1429 1627 Yojson.Safe.to_string (`Assoc [ 1430 1628 ("package", `String (OpamPackage.to_string pkg)); ··· 1455 1653 (* Cache file corrupted, re-solve *) 1456 1654 let pkg_config = { config with package = pkg_name } in 1457 1655 match solve pkg_config package with 1458 - | Ok solution -> 1459 - Os.write_to_file cache_file (serialize (package, solution)); 1656 + | Ok (solution, examined) -> 1657 + let cache_json = `Assoc [ 1658 + ("package", `String (OpamPackage.to_string package)); 1659 + ("solution", Util.solution_to_json solution); 1660 + ("examined", serialize_examined examined) 1661 + ] in 1662 + Os.write_to_file cache_file (Yojson.Safe.to_string cache_json); 1460 1663 Some (package, solution) 1461 - | Error msg -> 1462 - Os.write_to_file cache_file (Yojson.Safe.to_string (`Assoc [("failed", `Bool true); ("error", `String msg)])); 1664 + | Error (msg, examined) -> 1665 + Os.write_to_file cache_file (Yojson.Safe.to_string (`Assoc [ 1666 + ("failed", `Bool true); ("error", `String msg); 1667 + ("examined", serialize_examined examined) 1668 + ])); 1463 1669 None 1464 1670 end else begin 1465 1671 let pkg_config = { config with package = pkg_name } in 1466 1672 match solve pkg_config package with 1467 - | Ok solution -> 1673 + | Ok (solution, examined) -> 1468 1674 Printf.printf " Solved %s (%d packages)\n%!" pkg_name (OpamPackage.Map.cardinal solution); 1469 - Os.write_to_file cache_file (serialize (package, solution)); 1675 + let cache_json = `Assoc [ 1676 + ("package", `String (OpamPackage.to_string package)); 1677 + ("solution", Util.solution_to_json solution); 1678 + ("examined", serialize_examined examined) 1679 + ] in 1680 + Os.write_to_file cache_file (Yojson.Safe.to_string cache_json); 1470 1681 Some (package, solution) 1471 - | Error msg -> 1472 - Os.write_to_file cache_file (Yojson.Safe.to_string (`Assoc [("failed", `Bool true); ("error", `String msg)])); 1682 + | Error (msg, examined) -> 1683 + Os.write_to_file cache_file (Yojson.Safe.to_string (`Assoc [ 1684 + ("failed", `Bool true); ("error", `String msg); 1685 + ("examined", serialize_examined examined) 1686 + ])); 1473 1687 None 1474 1688 end 1475 1689 in ··· 1565 1779 let items = List.filter_map (fun (target, _solution) -> 1566 1780 List.find_opt (fun (t, _) -> OpamPackage.equal t target) blessing_maps 1567 1781 ) solutions in 1568 - let print_batch_summary ?(per_solution_hashes : (OpamPackage.t list * (string, string) Hashtbl.t) list option) () = 1782 + let print_batch_summary ?(per_solution_hashes : (OpamPackage.t list * (string, string) Hashtbl.t) list option) ?(doc_layers : (string * string) list option) () = 1569 1783 let os_key = Config.os_key ~config in 1570 1784 let layer_dir = Path.(config.dir / os_key) in 1571 1785 let packages_dir = Path.(config.dir / os_key / "packages") in 1572 1786 let run_id = Day10_lib.Run_log.get_id run_info in 1573 1787 let build_success = ref 0 in 1574 1788 let build_fail = ref 0 in 1789 + let build_dep_fail = ref 0 in 1575 1790 let doc_success = ref 0 in 1576 1791 let doc_fail = ref 0 in 1577 1792 let failures = ref [] in ··· 1660 1875 let key = (pkg_str, build_layer_name) in 1661 1876 (* Look up this layer on demand *) 1662 1877 match lookup_build_layer build_layer_name with 1663 - | Some (_, exit_status, compiler, _json) -> 1878 + | Some (_, exit_status, compiler, _json) when exit_status >= 0 -> 1664 1879 Hashtbl.replace built_packages pkg_str true; 1665 1880 Hashtbl.replace build_layer_info pkg_str (build_layer_name, exit_status, compiler); 1666 1881 if not (Hashtbl.mem processed key) then begin ··· 1683 1898 ~status ~category ?error () 1684 1899 end 1685 1900 end 1686 - | None -> 1687 - (* Layer doesn't exist — dep failure, handled in next loop *) 1901 + | _ -> 1902 + (* Layer doesn't exist or is a skeleton (exit_status = -1) — dep failure, handled in next loop *) 1688 1903 () 1689 1904 ) ordered; 1690 1905 ) solution_info; 1691 - (* Process doc layers — only scan doc-* directories modified during this run *) 1692 - let run_start_time = Day10_lib.Run_log.get_start_time run_info in 1693 - (try 1694 - Sys.readdir layer_dir |> Array.iter (fun name -> 1695 - if String.length name > 4 && String.sub name 0 4 = "doc-" then begin 1696 - let layer_json_path = Path.(layer_dir / name / "layer.json") in 1697 - (* Only process layers created/modified during this run *) 1698 - let dominated = try 1699 - let stat = Unix.stat layer_json_path in 1700 - stat.Unix.st_mtime >= run_start_time 1701 - with _ -> false in 1702 - if dominated then 1703 - match lookup_doc_layer name with 1704 - | Some (pkg_name, json) -> 1705 - let open Yojson.Safe.Util in 1706 - let doc = json |> member "doc" in 1707 - if doc <> `Null then begin 1708 - let blessed = doc |> member "blessed" |> to_bool_option |> Option.value ~default:false in 1709 - let status = doc |> member "status" |> to_string_option |> Option.value ~default:"" in 1710 - let layer_hash = String.sub name 4 (String.length name - 4) in 1711 - let doc_log = Path.(layer_dir / name / "odoc-voodoo-all.log") in 1712 - Day10_lib.Run_log.add_doc_log run_info ~package:pkg_name ~source_log:doc_log ~layer_hash (); 1713 - if blessed then begin 1714 - if status = "success" then begin 1715 - incr doc_success; 1716 - record_build_result ~packages_dir ~run_id ~pkg_str:pkg_name 1717 - ~build_hash:name ~compiler:"" ~blessed:true 1718 - ~status:"success" ~category:"success" () 1719 - end else begin 1720 - incr doc_fail; 1721 - let error_msg = doc |> member "error" |> to_string_option |> Option.value ~default:"unknown error" in 1722 - failures := (pkg_name, Printf.sprintf "doc: %s" error_msg) :: !failures; 1723 - let doc_category = 1724 - if matches_any ["link"] (String.lowercase_ascii error_msg) then 1725 - "doc_link_failure" 1726 - else 1727 - "doc_compile_failure" 1728 - in 1729 - record_build_result ~packages_dir ~run_id ~pkg_str:pkg_name 1730 - ~build_hash:name ~compiler:"" ~blessed 1731 - ~status:"failure" ~category:doc_category 1732 - ~error:error_msg () 1733 - end 1734 - end 1735 - end 1736 - | None -> () 1906 + (* Process doc layers. 1907 + When doc_layers is provided (fork path), iterate those directly. 1908 + Otherwise scan doc-* directories modified during this run. *) 1909 + let process_doc_layer name = 1910 + match lookup_doc_layer name with 1911 + | Some (pkg_name, json) -> 1912 + let open Yojson.Safe.Util in 1913 + let doc = json |> member "doc" in 1914 + if doc <> `Null then begin 1915 + let blessed = doc |> member "blessed" |> to_bool_option |> Option.value ~default:false in 1916 + let status = doc |> member "status" |> to_string_option |> Option.value ~default:"" in 1917 + let layer_hash = String.sub name 4 (String.length name - 4) in 1918 + let doc_log = Path.(layer_dir / name / "odoc-voodoo-all.log") in 1919 + Day10_lib.Run_log.add_doc_log run_info ~package:pkg_name ~source_log:doc_log ~layer_hash (); 1920 + if status = "success" then begin 1921 + incr doc_success; 1922 + record_build_result ~packages_dir ~run_id ~pkg_str:pkg_name 1923 + ~build_hash:name ~compiler:"" ~blessed 1924 + ~status:"success" ~category:"success" () 1925 + end else begin 1926 + incr doc_fail; 1927 + let error_msg = doc |> member "error" |> to_string_option |> Option.value ~default:"unknown error" in 1928 + failures := (pkg_name, Printf.sprintf "doc: %s" error_msg) :: !failures; 1929 + let doc_category = 1930 + if matches_any ["link"] (String.lowercase_ascii error_msg) then 1931 + "doc_link_failure" 1932 + else 1933 + "doc_compile_failure" 1934 + in 1935 + record_build_result ~packages_dir ~run_id ~pkg_str:pkg_name 1936 + ~build_hash:name ~compiler:"" ~blessed 1937 + ~status:"failure" ~category:doc_category 1938 + ~error:error_msg () 1939 + end 1940 + end 1941 + | None -> () 1942 + in 1943 + (match doc_layers with 1944 + | Some layers -> 1945 + (* Fork path: we know exactly which doc layers were produced *) 1946 + let seen = Hashtbl.create (List.length layers) in 1947 + List.iter (fun (_pkg_str, doc_name) -> 1948 + if not (Hashtbl.mem seen doc_name) then begin 1949 + Hashtbl.replace seen doc_name true; 1950 + process_doc_layer doc_name 1737 1951 end 1738 - ) 1739 - with _ -> ()); 1952 + ) layers 1953 + | None -> 1954 + (* Sequential path: scan doc-* directories modified during this run *) 1955 + let run_start_time = Day10_lib.Run_log.get_start_time run_info in 1956 + (try 1957 + Sys.readdir layer_dir |> Array.iter (fun name -> 1958 + if String.length name > 4 && String.sub name 0 4 = "doc-" then begin 1959 + let layer_json_path = Path.(layer_dir / name / "layer.json") in 1960 + let dominated = try 1961 + let stat = Unix.stat layer_json_path in 1962 + stat.Unix.st_mtime >= run_start_time 1963 + with _ -> false in 1964 + if dominated then process_doc_layer name 1965 + end 1966 + ) 1967 + with _ -> ())); 1740 1968 (* Record dependency failures: packages in solutions that have no build layer. 1741 1969 Walk the dependency graph to find the root cause — the first dep that 1742 1970 actually failed to build (has a build layer with non-zero exit). *) ··· 1789 2017 | Some (_, map) -> Blessing.is_blessed map pkg 1790 2018 | None -> false 1791 2019 in 2020 + incr build_dep_fail; 1792 2021 record_build_result ~packages_dir ~run_id ~pkg_str 1793 2022 ~build_hash ~compiler:"" ~blessed:is_blessed 1794 2023 ~status:"failure" ~category:"dependency_failure" ··· 1811 2040 if not (Hashtbl.mem universe_hashes_written universe_hash) then begin 1812 2041 Hashtbl.replace universe_hashes_written universe_hash true; 1813 2042 let universe_file = Path.(universes_dir / universe_hash ^ ".json") in 2043 + if not (Sys.file_exists universe_file) then begin 1814 2044 let pkg_list = List.map (fun pkg -> 1815 2045 `String (OpamPackage.to_string pkg) 1816 2046 ) ordered in ··· 1825 2055 output_string oc (Yojson.Safe.pretty_to_string json); 1826 2056 output_char oc '\n'); 1827 2057 Sys.rename tmp universe_file 2058 + end (* if not exists *) 1828 2059 end 1829 2060 ) solution_info; 1830 2061 Printf.printf " Universes written: %d\n%!" (Hashtbl.length universe_hashes_written); ··· 1857 2088 Printf.printf "\nBatch summary:\n%!"; 1858 2089 Printf.printf " Targets requested: %d\n%!" (List.length packages); 1859 2090 Printf.printf " Solutions found: %d (failed to solve: %d)\n%!" (List.length solutions) total_failed; 1860 - Printf.printf " Build layers: %d success, %d failed\n%!" !build_success !build_fail; 1861 - Printf.printf " Doc layers: %d success, %d failed (blessed only)\n%!" !doc_success !doc_fail; 2091 + Printf.printf " Build layers: %d success, %d failed, %d dep-failed\n%!" !build_success !build_fail !build_dep_fail; 2092 + Printf.printf " Doc layers: %d success, %d failed\n%!" !doc_success !doc_fail; 1862 2093 Printf.printf " HTML versions: %d\n%!" html_versions; 1863 2094 (* Generate status.json *) 1864 2095 let previous = Day10_lib.Status_index.read ~dir:(Path.(config.dir / os_key)) in ··· 1887 2118 ~build:!build_count ~doc:!build_count; 1888 2119 Day10_lib.Progress.write ~run_dir:(Day10_lib.Run_log.get_run_dir run_info) !progress_ref 1889 2120 ) items; 1890 - (* Run global deferred doc link pass for x-extra-doc-deps *) 2121 + (* Run global deferred doc link pass for x-extra-doc-deps (non-fork path) *) 1891 2122 run_global_deferred_doc_link config; 1892 2123 (* Assemble JTW output if enabled *) 1893 2124 (match config.with_jtw, config.jtw_output with ··· 1938 2169 progress_ref := Day10_lib.Progress.set_phase !progress_ref Day10_lib.Progress.Gc; 1939 2170 Day10_lib.Progress.write ~run_dir:(Day10_lib.Run_log.get_run_dir run_info) !progress_ref; 1940 2171 (* Run garbage collection *) 1941 - run_gc ~config ~solutions; 2172 + run_gc ~config ~solutions (); 1942 2173 print_batch_summary (); 1943 2174 (* Delete progress.json - summary.json takes over *) 1944 2175 Day10_lib.Progress.delete ~run_dir:(Day10_lib.Run_log.get_run_dir run_info) ··· 1952 2183 let node_by_hash : (string, build_node) Hashtbl.t = Hashtbl.create (List.length dag_nodes) in 1953 2184 List.iter (fun (n : build_node) -> Hashtbl.replace node_by_hash n.build_hash n) dag_nodes; 1954 2185 let last_reported = ref 0 in 2186 + let build_success_set : (string, bool) Hashtbl.t = Hashtbl.create (List.length dag_nodes) in 1955 2187 let on_complete ~total ~completed ~failed hash success = 2188 + Hashtbl.replace build_success_set hash success; 1956 2189 let pkg_str = match Hashtbl.find_opt node_by_hash hash with 1957 2190 | Some n -> OpamPackage.to_string n.pkg 1958 2191 | None -> hash ··· 1991 2224 execute_dag ~np:n ~on_complete ~on_cascade ~cache_dir:config.dir ~os_key dag_nodes build_one; 1992 2225 Container.deinit ~t; 1993 2226 Printf.printf "\n%!"; 1994 - (* Run global deferred doc link pass for x-extra-doc-deps *) 1995 - run_global_deferred_doc_link config; 2227 + let fork_doc_layers = ref [] in 2228 + (* Phase 3b: Generate doc and jtw layers for successful builds. 2229 + The DAG executor only runs build_layer, so doc/jtw generation must happen 2230 + as a separate pass. Process each solution in topological order so that 2231 + dep_doc_hashes are available when processing each package. *) 2232 + if config.with_doc || config.with_jtw then begin 2233 + let phase_label = 2234 + match config.with_doc, config.with_jtw with 2235 + | true, true -> "doc + jtw" 2236 + | true, false -> "doc" 2237 + | false, true -> "jtw" 2238 + | false, false -> "" 2239 + in 2240 + Printf.printf "[Phase 3b] Generating %s layers...\n%!" phase_label; 2241 + (* Compute compiler_layers from the DAG nodes: find the compiler package 2242 + and use its dep_build_hashes + its own build_hash *) 2243 + let compiler_layers = 2244 + let ocaml_version_opt = List.find_map (fun (_target, solution) -> 2245 + extract_ocaml_version solution 2246 + ) solutions in 2247 + match ocaml_version_opt with 2248 + | None -> [] 2249 + | Some ov -> 2250 + let ov_str = OpamPackage.to_string ov in 2251 + match List.find_opt (fun (n : build_node) -> 2252 + OpamPackage.to_string n.pkg = ov_str 2253 + ) dag_nodes with 2254 + | Some node -> 2255 + if Hashtbl.find_opt build_success_set node.build_hash = Some true then 2256 + node.dep_build_hashes @ [ node.build_hash ] 2257 + else [] 2258 + | None -> [] 2259 + in 2260 + (* Iterate over unique DAG nodes (already deduplicated) rather than per-solution. 2261 + Since blessed status is a function of the build hash within a run, 2262 + each DAG node gets a single deterministic doc/jtw layer. *) 2263 + let doc_generated = ref 0 in 2264 + let doc_failed = ref 0 in 2265 + let jtw_generated = ref 0 in 2266 + let last_reported = ref 0 in 2267 + (* Build blessed status per build_hash by correlating per_solution_hashes 2268 + with blessing_maps. For a given build hash, the blessed determination is 2269 + the same across all solutions (same deps → same universe hash). *) 2270 + let blessed_by_build_hash : (string, bool) Hashtbl.t = Hashtbl.create (List.length dag_nodes) in 2271 + List.iter2 (fun (target, _solution) (ordered, pkg_to_hash) -> 2272 + let bless_map = List.find_opt (fun (t, _) -> 2273 + OpamPackage.equal t target 2274 + ) blessing_maps in 2275 + match bless_map with 2276 + | None -> () 2277 + | Some (_, bmap) -> 2278 + List.iter (fun pkg -> 2279 + let pkg_str = OpamPackage.to_string pkg in 2280 + match Hashtbl.find_opt pkg_to_hash pkg_str with 2281 + | None -> () 2282 + | Some build_hash -> 2283 + if not (Hashtbl.mem blessed_by_build_hash build_hash) then 2284 + Hashtbl.replace blessed_by_build_hash build_hash 2285 + (Blessing.is_blessed bmap pkg) 2286 + ) ordered 2287 + ) solutions per_solution_hashes; 2288 + let t = Container.init ~config in 2289 + let ocaml_version = List.find_map (fun (_target, solution) -> 2290 + extract_ocaml_version solution 2291 + ) solutions in 2292 + (* Parallel doc/jtw layer generation using fork-based executor. 2293 + Same DAG dependency structure as the build phase: a node's doc hash 2294 + depends on its deps' doc hashes, so we process in dependency order 2295 + with up to n workers. *) 2296 + (* doc_map: build_hash -> doc_layer_name (populated as nodes complete) *) 2297 + let doc_map_ht : (string, string) Hashtbl.t = Hashtbl.create (List.length dag_nodes) in 2298 + (* Filter to nodes with successful builds (using Phase 3 results, no I/O) *) 2299 + let doc_nodes = List.filter (fun (node : build_node) -> 2300 + Hashtbl.find_opt build_success_set node.build_hash = Some true 2301 + ) dag_nodes in 2302 + (* Remaining dep count and reverse deps (same structure as execute_dag) *) 2303 + let doc_node_of_hash : (string, build_node) Hashtbl.t = Hashtbl.create (List.length doc_nodes) in 2304 + List.iter (fun (n : build_node) -> Hashtbl.replace doc_node_of_hash n.build_hash n) doc_nodes; 2305 + let doc_remaining : (string, int) Hashtbl.t = Hashtbl.create (List.length doc_nodes) in 2306 + let doc_rdeps : (string, string list) Hashtbl.t = Hashtbl.create (List.length doc_nodes) in 2307 + List.iter (fun (node : build_node) -> 2308 + let count = List.fold_left (fun acc dep_hash -> 2309 + if Hashtbl.mem doc_node_of_hash dep_hash then begin 2310 + let existing = try Hashtbl.find doc_rdeps dep_hash with Not_found -> [] in 2311 + Hashtbl.replace doc_rdeps dep_hash (node.build_hash :: existing); 2312 + acc + 1 2313 + end else acc 2314 + ) 0 node.dep_build_hashes in 2315 + Hashtbl.replace doc_remaining node.build_hash count 2316 + ) doc_nodes; 2317 + let doc_ready = Queue.create () in 2318 + List.iter (fun (node : build_node) -> 2319 + if Hashtbl.find doc_remaining node.build_hash = 0 then 2320 + Queue.push node doc_ready 2321 + ) doc_nodes; 2322 + (* running: pid -> (build_hash, doc_layer_name option) *) 2323 + let doc_running : (int, string * string option) Hashtbl.t = Hashtbl.create n in 2324 + let doc_completed : (string, bool) Hashtbl.t = Hashtbl.create (List.length doc_nodes) in 2325 + let doc_total = List.length doc_nodes in 2326 + let doc_completed_count = ref 0 in 2327 + let promote_doc_dependents hash = 2328 + List.iter (fun dep_hash -> 2329 + let count = Hashtbl.find doc_remaining dep_hash - 1 in 2330 + Hashtbl.replace doc_remaining dep_hash count; 2331 + if count = 0 then 2332 + Queue.push (Hashtbl.find doc_node_of_hash dep_hash) doc_ready 2333 + ) (try Hashtbl.find doc_rdeps hash with Not_found -> []) 2334 + in 2335 + let complete_doc_node hash success doc_layer_name_opt = 2336 + Hashtbl.replace doc_completed hash success; 2337 + incr doc_completed_count; 2338 + (match doc_layer_name_opt with 2339 + | Some doc_name when success -> 2340 + Hashtbl.replace doc_map_ht hash doc_name; 2341 + incr doc_generated; 2342 + let node = Hashtbl.find doc_node_of_hash hash in 2343 + let pkg_str = OpamPackage.to_string node.pkg in 2344 + record_build_result ~packages_dir ~run_id ~pkg_str 2345 + ~build_hash:doc_name ~compiler:"" ~blessed:false 2346 + ~status:"success" ~category:"success" () 2347 + | Some doc_name -> 2348 + incr doc_failed; 2349 + let node = Hashtbl.find doc_node_of_hash hash in 2350 + let pkg_str = OpamPackage.to_string node.pkg in 2351 + let doc_layer_json = Path.(config.dir / os_key / doc_name / "layer.json") in 2352 + let error_msg = 2353 + if Sys.file_exists doc_layer_json then 2354 + try 2355 + let json = Yojson.Safe.from_file doc_layer_json in 2356 + let open Yojson.Safe.Util in 2357 + json |> member "doc" |> member "error" |> to_string_option 2358 + |> Option.value ~default:"unknown error" 2359 + with _ -> "unknown error" 2360 + else "no layer.json" 2361 + in 2362 + record_build_result ~packages_dir ~run_id ~pkg_str 2363 + ~build_hash:doc_name ~compiler:"" ~blessed:false 2364 + ~status:"failure" ~category:"doc_compile_failure" 2365 + ~error:error_msg () 2366 + | None -> incr doc_failed); 2367 + let count = !doc_generated + !doc_failed in 2368 + if count - !last_reported >= 25 || !doc_completed_count = doc_total then begin 2369 + Printf.printf "\r%-60s\r" ""; 2370 + Printf.printf "[Phase 3b] %d/%d layers (%d doc ok, %d failed)%!" 2371 + count doc_total !doc_generated !doc_failed; 2372 + last_reported := count 2373 + end; 2374 + promote_doc_dependents hash 2375 + in 2376 + let reap_doc () = 2377 + let rec waitpid_eintr () = 2378 + try Unix.waitpid [] (-1) 2379 + with Unix.Unix_error (Unix.EINTR, _, _) -> waitpid_eintr () 2380 + in 2381 + let pid, status = waitpid_eintr () in 2382 + let exit_code = match status with Unix.WEXITED c -> c | _ -> 1 in 2383 + match Hashtbl.find_opt doc_running pid with 2384 + | Some (hash, doc_name_opt) -> 2385 + Hashtbl.remove doc_running pid; 2386 + complete_doc_node hash (exit_code = 0) doc_name_opt 2387 + | None -> () 2388 + in 2389 + while !doc_completed_count < doc_total do 2390 + while Hashtbl.length doc_running < n && not (Queue.is_empty doc_ready) do 2391 + let node = Queue.pop doc_ready in 2392 + let blessed = match Hashtbl.find_opt blessed_by_build_hash node.build_hash with 2393 + | Some b -> b | None -> false in 2394 + let dep_doc_hashes = List.filter_map (fun dep_hash -> 2395 + Hashtbl.find_opt doc_map_ht dep_hash 2396 + ) node.dep_build_hashes in 2397 + (* Compute doc hash in parent so we know the layer name. 2398 + Must use Container.doc_layer_hash to guarantee consistency with 2399 + what doc_layer computes in the child process. *) 2400 + let doc_layer_name = 2401 + if config.with_doc then 2402 + match ocaml_version with 2403 + | Some ov -> 2404 + let doc_hash = Container.doc_layer_hash ~t ~build_hash:node.build_hash ~dep_doc_hashes ~ocaml_version:ov ~blessed ~compiler_layers in 2405 + Some ("doc-" ^ doc_hash) 2406 + | None -> None 2407 + else None 2408 + in 2409 + (* Check if doc layer already exists (cache hit) *) 2410 + let cached = 2411 + match doc_layer_name with 2412 + | Some name -> 2413 + let doc_layer_json = Path.(config.dir / os_key / name / "layer.json") in 2414 + Sys.file_exists doc_layer_json && not (Util.load_layer_info_doc_failed doc_layer_json) 2415 + | None -> true (* no doc to build *) 2416 + in 2417 + if cached then 2418 + complete_doc_node node.build_hash true doc_layer_name 2419 + else begin 2420 + Os.log "doc_exec: MISS %s (%s) — building" (OpamPackage.to_string node.pkg) (match doc_layer_name with Some n -> n | None -> "none"); 2421 + match Unix.fork () with 2422 + | 0 -> 2423 + Random.init (Unix.getpid () lxor int_of_float (Unix.gettimeofday () *. 1000000.)); 2424 + let success = 2425 + try 2426 + let result = 2427 + if config.with_doc then 2428 + doc_layer t node.pkg node.build_hash dep_doc_hashes ~ocaml_version ~compiler_layers ~blessed () 2429 + else Some "no-doc" 2430 + in 2431 + (* Also do jtw in the child while we're here *) 2432 + if config.with_jtw then begin 2433 + let dep_build_hashes = List.filter (fun dep_hash -> 2434 + let lj = Path.(config.dir / os_key / dep_hash / "layer.json") in 2435 + Sys.file_exists lj && Util.load_layer_info_exit_status lj = 0 2436 + ) node.dep_build_hashes in 2437 + ignore (jtw_layer t node.pkg node.build_hash dep_build_hashes ~ocaml_version ~compiler_layers) 2438 + end; 2439 + result <> None 2440 + with _ -> false 2441 + in 2442 + Unix._exit (if success then 0 else 1) 2443 + | child_pid -> 2444 + Hashtbl.replace doc_running child_pid (node.build_hash, doc_layer_name) 2445 + end 2446 + done; 2447 + if Hashtbl.length doc_running > 0 then 2448 + reap_doc () 2449 + else if Queue.is_empty doc_ready && !doc_completed_count < doc_total then begin 2450 + Printf.eprintf "Doc executor: deadlock detected (%d/%d completed)\n%!" 2451 + !doc_completed_count doc_total; 2452 + List.iter (fun (node : build_node) -> 2453 + if not (Hashtbl.mem doc_completed node.build_hash) then 2454 + complete_doc_node node.build_hash false None 2455 + ) doc_nodes 2456 + end 2457 + done; 2458 + while Hashtbl.length doc_running > 0 do reap_doc () done; 2459 + (* Convert build_hash -> doc_name to OpamPackage -> doc_name for deferred link pass *) 2460 + let doc_map = Hashtbl.fold (fun build_hash doc_name acc -> 2461 + match Hashtbl.find_opt node_by_hash build_hash with 2462 + | Some node -> OpamPackage.Map.add node.pkg doc_name acc 2463 + | None -> acc 2464 + ) doc_map_ht OpamPackage.Map.empty in 2465 + (* Deferred doc link pass: packages with post deps or x-extra-doc-deps 2466 + got Doc_compile_only above. Now run the link+HTML phase. *) 2467 + if config.with_doc then begin 2468 + let doc_map_by_name = 2469 + OpamPackage.Map.fold (fun pkg doc_name acc -> 2470 + OpamPackage.Name.Map.add (OpamPackage.name pkg) (pkg, doc_name) acc 2471 + ) doc_map OpamPackage.Name.Map.empty 2472 + in 2473 + List.iter (fun (node : build_node) -> 2474 + let opamfile = Util.opam_file config.opam_repositories node.pkg in 2475 + let has_extra = match opamfile with 2476 + | None -> false 2477 + | Some opam -> not (OpamPackage.Name.Set.is_empty (get_extra_link_deps opam)) 2478 + in 2479 + if has_extra then 2480 + match OpamPackage.Map.find_opt node.pkg doc_map with 2481 + | Some doc_layer_name -> 2482 + let doc_layer_dir = Path.(config.dir / os_key / doc_layer_name) in 2483 + let link_log = Path.(doc_layer_dir / "odoc-voodoo-link-and-gen.log") in 2484 + let already_linked = 2485 + Sys.file_exists link_log && 2486 + (try (Unix.stat link_log).Unix.st_size > 0 with _ -> false) 2487 + in 2488 + if not already_linked then begin 2489 + let build_layer_dir = Path.(config.dir / os_key / node.build_hash) in 2490 + let dep_doc_hashes = List.filter_map (fun dep_hash -> 2491 + Hashtbl.find_opt doc_map_ht dep_hash 2492 + ) node.dep_build_hashes in 2493 + let extra_doc_dep_hashes = match opamfile with 2494 + | None -> [] 2495 + | Some opam -> 2496 + OpamPackage.Name.Set.fold (fun name acc -> 2497 + match OpamPackage.Name.Map.find_opt name doc_map_by_name with 2498 + | Some (_pkg, doc_hash) -> doc_hash :: acc 2499 + | None -> acc 2500 + ) (Odoc_gen.get_extra_doc_deps opam) [] 2501 + in 2502 + let dep_doc_hashes = dep_doc_hashes @ extra_doc_dep_hashes in 2503 + let build_layer_json = Path.(build_layer_dir / "layer.json") in 2504 + let installed_libs = Util.load_layer_info_installed_libs build_layer_json in 2505 + let installed_docs = Util.load_layer_info_installed_docs build_layer_json in 2506 + Option.iter (fun ocaml_version -> 2507 + ignore (Container.generate_docs ~t ~build_layer_dir ~doc_layer_dir ~dep_doc_hashes ~pkg:node.pkg ~installed_libs ~installed_docs ~phase:S.Doc_link_only ~ocaml_version ~compiler_layers) 2508 + ) ocaml_version 2509 + end 2510 + | None -> () 2511 + ) dag_nodes 2512 + end; 2513 + Container.deinit ~t; 2514 + Printf.printf "\r%-60s\r" ""; 2515 + if config.with_doc then begin 2516 + Printf.printf "[Phase 3b] Doc layers: %d ok, %d failed\n%!" !doc_generated !doc_failed; 2517 + fork_doc_layers := OpamPackage.Map.fold (fun pkg doc_name acc -> 2518 + (OpamPackage.to_string pkg, doc_name) :: acc 2519 + ) doc_map [] 2520 + end; 2521 + if config.with_jtw then 2522 + Printf.printf "[Phase 3b] JTW layers: %d generated\n%!" !jtw_generated 2523 + end; 2524 + (* Run global deferred doc link pass for x-extra-doc-deps (fork path) *) 2525 + run_global_deferred_doc_link ~doc_layers:!fork_doc_layers config; 1996 2526 (* Assemble JTW output if enabled *) 1997 2527 (match config.with_jtw, config.jtw_output with 1998 2528 | true, Some jtw_output -> ··· 2040 2570 (* Update progress: entering GC phase *) 2041 2571 progress_ref := Day10_lib.Progress.set_phase !progress_ref Day10_lib.Progress.Gc; 2042 2572 Day10_lib.Progress.write ~run_dir:(Day10_lib.Run_log.get_run_dir run_info) !progress_ref; 2043 - (* Run garbage collection *) 2044 - run_gc ~config ~solutions; 2045 - print_batch_summary ~per_solution_hashes (); 2573 + (* Run garbage collection — must scan all cached solutions, not just current batch *) 2574 + run_gc ~config ~solutions (); 2575 + print_batch_summary ~per_solution_hashes ~doc_layers:!fork_doc_layers (); 2046 2576 (* Delete progress.json - summary.json takes over *) 2047 2577 Day10_lib.Progress.delete ~run_dir:(Day10_lib.Run_log.get_run_dir run_info) 2048 2578 2579 + let config_dir = 2580 + match Sys.getenv_opt "XDG_CONFIG_HOME" with 2581 + | Some d -> Filename.concat d "day10" 2582 + | None -> Filename.concat (Sys.getenv "HOME") ".config/day10" 2583 + 2584 + let config_file = Filename.concat config_dir "config" 2585 + 2586 + let read_config_value key = 2587 + if Sys.file_exists config_file then 2588 + try 2589 + let ic = open_in config_file in 2590 + Fun.protect ~finally:(fun () -> close_in ic) (fun () -> 2591 + let rec loop () = 2592 + match input_line ic with 2593 + | line -> 2594 + let line = String.trim line in 2595 + if String.length line = 0 || line.[0] = '#' then loop () 2596 + else 2597 + (match String.index_opt line '=' with 2598 + | Some i -> 2599 + let k = String.trim (String.sub line 0 i) in 2600 + let v = String.trim (String.sub line (i + 1) (String.length line - i - 1)) in 2601 + if k = key then Some v else loop () 2602 + | None -> loop ()) 2603 + | exception End_of_file -> None 2604 + in 2605 + loop ()) 2606 + with _ -> None 2607 + else None 2608 + 2049 2609 let cache_dir_term = 2050 - let doc = "Directory to use for caching (required)" in 2051 - Arg.(required & opt (some string) None & info [ "cache-dir" ] ~docv:"DIR" ~doc) 2610 + let default = read_config_value "cache-dir" in 2611 + let doc = Printf.sprintf "Directory to use for caching%s" 2612 + (match default with Some d -> Printf.sprintf " (default: %s from %s)" d config_file | None -> " (required; set in " ^ config_file ^ " as cache-dir=DIR)") in 2613 + match default with 2614 + | Some d -> Arg.(value & opt string d & info [ "cache-dir" ] ~docv:"DIR" ~doc) 2615 + | None -> Arg.(required & opt (some string) None & info [ "cache-dir" ] ~docv:"DIR" ~doc) 2052 2616 2053 2617 let ocaml_version_term = 2054 2618 let doc = "OCaml version to use (if not specified, solver picks compatible version)" in ··· 2410 2974 let os_key = Printf.sprintf "%s-%s-%s" os_distribution os_version arch in 2411 2975 let os_dir = Path.(cache_dir / os_key) in 2412 2976 let packages_dir = Path.(os_dir / "packages") in 2413 - match Day10_lib.Status_index.read ~dir:os_dir with 2977 + let run_id_from_saved = match Day10_lib.Status_index.read ~dir:os_dir with 2978 + | Some s -> Some s.run_id 2979 + | None -> None 2980 + in 2981 + match run_id_from_saved with 2414 2982 | None -> 2415 2983 Printf.eprintf "No status index found. Run a batch build first.\n%!"; 2416 2984 1 2417 - | Some status -> 2985 + | Some saved_run_id -> 2986 + let status = Day10_lib.Status_index.generate ~packages_dir ~run_id:saved_run_id ~previous:None in 2418 2987 let blessed_total = List.fold_left (fun acc (_, v) -> acc + v) 0 status.blessed_totals in 2419 2988 let non_blessed_total = List.fold_left (fun acc (_, v) -> acc + v) 0 status.non_blessed_totals in 2420 2989 if format = "json" then begin ··· 2481 3050 List.iter (fun pkg -> Printf.printf " %s\n" pkg) status.new_packages 2482 3051 end; 2483 3052 if details then begin 3053 + (* Check layer.json for exit_status=-1 (skeleton) and reclassify build_failure as dependency_failure *) 3054 + let effective_category (e : Day10_lib.History.entry) = 3055 + if e.category = "build_failure" && 3056 + String.length e.build_hash > 6 && String.sub e.build_hash 0 6 = "build-" then 3057 + let layer_json = Path.(os_dir / e.build_hash / "layer.json") in 3058 + if Sys.file_exists layer_json then 3059 + try 3060 + let json = Yojson.Safe.from_file layer_json in 3061 + let open Yojson.Safe.Util in 3062 + let exit_status = json |> member "exit_status" |> to_int_option |> Option.value ~default:0 in 3063 + if exit_status = -1 then "dependency_failure" else e.category 3064 + with _ -> e.category 3065 + else e.category 3066 + else e.category 3067 + in 3068 + (* Find which dep failed by reading layer.json's parallel deps/hashes arrays *) 3069 + let find_failed_dep_from_layer (e : Day10_lib.History.entry) = 3070 + if String.length e.build_hash > 6 && String.sub e.build_hash 0 6 = "build-" then 3071 + let layer_json = Path.(os_dir / e.build_hash / "layer.json") in 3072 + if Sys.file_exists layer_json then 3073 + try 3074 + let json = Yojson.Safe.from_file layer_json in 3075 + let open Yojson.Safe.Util in 3076 + let deps = try json |> member "deps" |> to_list |> List.map to_string with _ -> [] in 3077 + let hashes = try json |> member "hashes" |> to_list |> List.map to_string with _ -> [] in 3078 + let rec find_failed ds hs = 3079 + match ds, hs with 3080 + | d :: ds_rest, h :: hs_rest -> 3081 + let dep_layer_json = Path.(os_dir / h / "layer.json") in 3082 + let dep_exit = 3083 + if Sys.file_exists dep_layer_json then 3084 + try 3085 + let dj = Yojson.Safe.from_file dep_layer_json in 3086 + dj |> member "exit_status" |> to_int_option |> Option.value ~default:0 3087 + with _ -> 0 3088 + else -1 3089 + in 3090 + if dep_exit <> 0 then Some d 3091 + else find_failed ds_rest hs_rest 3092 + | _ -> None 3093 + in 3094 + find_failed deps hashes 3095 + with _ -> None 3096 + else None 3097 + else None 3098 + in 2484 3099 (* Collect one failure entry per package (best entry: prefer one with 2485 3100 failed_dep set, then universe- over none, then blessed over not). 2486 - Group by category. *) 3101 + Group by effective category. *) 2487 3102 let failure_by_cat : (string, (string * Day10_lib.History.entry) list) Hashtbl.t = Hashtbl.create 16 in 2488 3103 if Sys.file_exists packages_dir then begin 2489 3104 let pkg_dirs = try Sys.readdir packages_dir |> Array.to_list with _ -> [] in 2490 3105 List.iter (fun pkg_str -> 2491 3106 let entries = Day10_lib.History.read_latest ~packages_dir ~pkg_str in 2492 3107 let failing = List.filter (fun (e : Day10_lib.History.entry) -> e.status = "failure") entries in 2493 - (* Deduplicate: group by category, pick the best entry per category *) 3108 + (* Deduplicate: group by effective category, pick the best entry per category *) 2494 3109 let by_cat : (string, Day10_lib.History.entry list) Hashtbl.t = Hashtbl.create 4 in 2495 3110 List.iter (fun (e : Day10_lib.History.entry) -> 2496 - let existing = try Hashtbl.find by_cat e.category with Not_found -> [] in 2497 - Hashtbl.replace by_cat e.category (e :: existing) 3111 + let cat = effective_category e in 3112 + let existing = try Hashtbl.find by_cat cat with Not_found -> [] in 3113 + Hashtbl.replace by_cat cat (e :: existing) 2498 3114 ) failing; 2499 3115 Hashtbl.iter (fun cat entries_for_cat -> 2500 3116 (* Pick best: prefer entry with failed_dep, then blessed, then universe- over none *) ··· 2511 3127 ) by_cat 2512 3128 ) pkg_dirs 2513 3129 end; 3130 + (* Count how many dep-failures each build_failure root cause blocks *) 3131 + let blocked_count : (string, int) Hashtbl.t = Hashtbl.create 64 in 3132 + (match Hashtbl.find_opt failure_by_cat "dependency_failure" with 3133 + | Some dep_failures -> 3134 + List.iter (fun (_pkg, (e : Day10_lib.History.entry)) -> 3135 + let dep = match find_failed_dep_from_layer e with 3136 + | Some d -> Some d 3137 + | None -> e.failed_dep 3138 + in 3139 + match dep with 3140 + | Some d -> 3141 + let n = try Hashtbl.find blocked_count d with Not_found -> 0 in 3142 + Hashtbl.replace blocked_count d (n + 1) 3143 + | None -> () 3144 + ) dep_failures 3145 + | None -> ()); 2514 3146 let cats = Hashtbl.fold (fun k v acc -> (k, v) :: acc) failure_by_cat [] in 2515 3147 let cats = List.sort (fun (a, _) (b, _) -> String.compare a b) cats in 2516 3148 let print_failure ~blessed_marker (pkg, (e : Day10_lib.History.entry)) = ··· 2518 3150 | Some h -> Printf.sprintf " [universe %s]" (String.sub h 0 (min 12 (String.length h))) 2519 3151 | None -> "" 2520 3152 in 2521 - match e.category with 3153 + let eff_cat = effective_category e in 3154 + match eff_cat with 2522 3155 | "dependency_failure" -> 2523 - (match e.failed_dep with 2524 - | Some dep -> 2525 - Printf.printf " %s%-40s dep: %-30s%s\n" blessed_marker pkg dep universe_str 2526 - | None -> 2527 - Printf.printf " %s%-40s (root cause unknown)%s\n" blessed_marker pkg universe_str) 3156 + let failed_dep_str = 3157 + (* Prefer layer.json lookup (always accurate), fall back to history's 3158 + failed_dep field, and filter out self-references *) 3159 + let from_layer = find_failed_dep_from_layer e in 3160 + let from_history = e.failed_dep in 3161 + let dep = match from_layer with Some d -> Some d | None -> from_history in 3162 + match dep with 3163 + | Some d when d <> pkg -> d 3164 + | _ -> "(root cause unknown)" 3165 + in 3166 + Printf.printf " %s%-40s dep: %-30s%s\n" blessed_marker pkg failed_dep_str universe_str 2528 3167 | _ -> 2529 3168 let detail = match e.error with 2530 3169 | Some err -> err 2531 3170 | None -> e.build_hash 2532 3171 in 2533 - Printf.printf " %s%-40s %s%s\n" blessed_marker pkg detail universe_str 3172 + let blocks = try Hashtbl.find blocked_count pkg with Not_found -> 0 in 3173 + let blocks_str = if blocks > 0 then Printf.sprintf " (blocks %d)" blocks else "" in 3174 + Printf.printf " %s%-40s %s%s%s\n" blessed_marker pkg detail universe_str blocks_str 2534 3175 in 2535 3176 List.iter (fun (cat, failures) -> 2536 3177 let blessed_failures = List.filter (fun (_, (e : Day10_lib.History.entry)) -> e.blessed) failures in 2537 3178 let non_blessed_failures = List.filter (fun (_, (e : Day10_lib.History.entry)) -> not e.blessed) failures in 2538 3179 Printf.printf "\n%s: %d total (%d blessed, %d non-blessed)\n" cat 2539 3180 (List.length failures) (List.length blessed_failures) (List.length non_blessed_failures); 3181 + (* Sort build_failure entries by number of packages they block *) 3182 + let blessed_failures = 3183 + if cat = "build_failure" then 3184 + List.sort (fun (pkg_a, _) (pkg_b, _) -> 3185 + let a = try Hashtbl.find blocked_count pkg_a with Not_found -> 0 in 3186 + let b = try Hashtbl.find blocked_count pkg_b with Not_found -> 0 in 3187 + compare b a 3188 + ) blessed_failures 3189 + else blessed_failures 3190 + in 2540 3191 List.iter (fun f -> print_failure ~blessed_marker:"[blessed] " f) blessed_failures; 2541 3192 let shown = ref 0 in 2542 3193 List.iter (fun f -> ··· 2755 3406 with _ -> 0L 2756 3407 else 0L 2757 3408 in 3409 + (* Sum sizes of layer directories matching a prefix, using cached disk_usage files when available *) 3410 + let sum_layers prefix = 3411 + let entries = try Sys.readdir os_dir with _ -> [||] in 3412 + Array.fold_left (fun acc name -> 3413 + if String.length name > String.length prefix && String.sub name 0 (String.length prefix) = prefix then 3414 + let dir = Path.(os_dir / name) in 3415 + let cached = Path.(dir / "disk_usage") in 3416 + let size = 3417 + if Sys.file_exists cached then 3418 + try Int64.of_string (String.trim (Os.read_from_file cached)) with _ -> du dir 3419 + else 3420 + du dir 3421 + in 3422 + Int64.add acc size 3423 + else acc 3424 + ) 0L entries 3425 + in 2758 3426 let base_size = du Path.(os_dir / "base") in 2759 - let build_cmd = Printf.sprintf "du -sb %s/build-* 2>/dev/null | awk '{s+=$1} END {print s+0}'" os_dir in 2760 - let build_size = try 2761 - let ic = Unix.open_process_in build_cmd in 2762 - let line = try input_line ic with End_of_file -> "0" in 2763 - let _ = Unix.close_process_in ic in 2764 - Int64.of_string (String.trim line) 2765 - with _ -> 0L in 2766 - let doc_cmd = Printf.sprintf "du -sb %s/doc-* 2>/dev/null | awk '{s+=$1} END {print s+0}'" os_dir in 2767 - let doc_size = try 2768 - let ic = Unix.open_process_in doc_cmd in 2769 - let line = try input_line ic with End_of_file -> "0" in 2770 - let _ = Unix.close_process_in ic in 2771 - Int64.of_string (String.trim line) 2772 - with _ -> 0L in 3427 + let build_size = sum_layers "build-" in 3428 + let doc_size = sum_layers "doc-" in 3429 + let jtw_size = sum_layers "jtw-" in 2773 3430 let packages_size = du Path.(os_dir / "packages") in 2774 3431 let logs_size = du Path.(cache_dir / "logs") in 2775 3432 let solutions_size = du Path.(cache_dir / "solutions") in 2776 - let total = Int64.add (Int64.add (Int64.add base_size build_size) (Int64.add doc_size packages_size)) (Int64.add logs_size solutions_size) in 3433 + let total = Int64.add (Int64.add (Int64.add base_size build_size) (Int64.add doc_size jtw_size)) (Int64.add (Int64.add packages_size logs_size) solutions_size) in 2777 3434 let gb n = Int64.to_float n /. 1073741824.0 in 2778 3435 if format = "json" then begin 2779 3436 let json = `Assoc [ 2780 3437 ("base", `Float (gb base_size)); 2781 3438 ("build_layers", `Float (gb build_size)); 2782 3439 ("doc_layers", `Float (gb doc_size)); 3440 + ("jtw_layers", `Float (gb jtw_size)); 2783 3441 ("packages", `Float (gb packages_size)); 2784 3442 ("logs", `Float (gb logs_size)); 2785 3443 ("solutions", `Float (gb solutions_size)); ··· 2792 3450 Printf.printf " Base image: %.1fG\n" (gb base_size); 2793 3451 Printf.printf " Build layers: %.1fG\n" (gb build_size); 2794 3452 Printf.printf " Doc layers: %.1fG\n" (gb doc_size); 3453 + Printf.printf " JTW layers: %.1fG\n" (gb jtw_size); 2795 3454 Printf.printf " Packages: %.1fG\n" (gb packages_size); 2796 3455 Printf.printf " Logs: %.1fG\n" (gb logs_size); 2797 3456 Printf.printf " Solutions: %.1fG\n" (gb solutions_size) ··· 3476 4135 let log_info = Cmd.info "log" ~doc:"Show build or doc log for a layer" in 3477 4136 Cmd.v log_info log_term 3478 4137 4138 + let run_debug ~cache_dir ~arch ~os ~os_distribution ~os_family ~os_version ~target ~command ~keep = 4139 + let os_key = Printf.sprintf "%s-%s-%s" os_distribution os_version arch in 4140 + let packages_dir = Path.(cache_dir / os_key / "packages") in 4141 + (* Resolve target: build hash or package name *) 4142 + let build_hash, pkg_str = 4143 + if String.length target > 6 && String.sub target 0 6 = "build-" then begin 4144 + let layer_json = Path.(cache_dir / os_key / target / "layer.json") in 4145 + if not (Sys.file_exists layer_json) then begin 4146 + Printf.eprintf "Build layer %s not found\n%!" target; 4147 + Stdlib.exit 1 4148 + end; 4149 + let json = Yojson.Safe.from_file layer_json in 4150 + let pkg = Yojson.Safe.Util.(json |> member "package" |> to_string) in 4151 + (target, pkg) 4152 + end else begin 4153 + (* Look up from package history — collect all unique failing builds *) 4154 + let history = Day10_lib.History.read_latest ~packages_dir ~pkg_str:target in 4155 + let failures = List.filter (fun (e : Day10_lib.History.entry) -> 4156 + e.status = "failure" && e.build_hash <> "none" 4157 + ) history in 4158 + (* Deduplicate by build_hash *) 4159 + let seen = Hashtbl.create 8 in 4160 + let unique_failures = List.filter (fun (e : Day10_lib.History.entry) -> 4161 + if Hashtbl.mem seen e.build_hash then false 4162 + else (Hashtbl.replace seen e.build_hash true; true) 4163 + ) failures in 4164 + match unique_failures with 4165 + | [] -> Printf.eprintf "No failed build found for %s\n%!" target; Stdlib.exit 1 4166 + | [e] -> 4167 + let universe = universe_hash_of_layer ~os_dir:(Path.(cache_dir / os_key)) e.build_hash in 4168 + Printf.printf "Using %s%s\n%!" e.build_hash 4169 + (match universe with Some h -> Printf.sprintf " [universe %s]" (String.sub h 0 (min 12 (String.length h))) | None -> ""); 4170 + (e.build_hash, target) 4171 + | _ -> 4172 + (* Prefer blessed, then pick first *) 4173 + let best = match List.find_opt (fun (e : Day10_lib.History.entry) -> e.blessed) unique_failures with 4174 + | Some e -> e | None -> List.hd unique_failures 4175 + in 4176 + let os_dir = Path.(cache_dir / os_key) in 4177 + Printf.printf "Multiple failing builds for %s — using blessed build.\n%!" target; 4178 + Printf.printf "To debug a specific universe, pass the build hash directly:\n%!"; 4179 + List.iter (fun (e : Day10_lib.History.entry) -> 4180 + let marker = if e.build_hash = best.build_hash then "* " else " " in 4181 + let universe = universe_hash_of_layer ~os_dir e.build_hash in 4182 + let blessed_str = if e.blessed then " [blessed]" else "" in 4183 + Printf.printf " %s%s%s%s\n%!" marker e.build_hash 4184 + (match universe with Some h -> Printf.sprintf " [universe %s]" (String.sub h 0 (min 12 (String.length h))) | None -> "") 4185 + blessed_str 4186 + ) unique_failures; 4187 + (best.build_hash, target) 4188 + end 4189 + in 4190 + let layer_json = Path.(cache_dir / os_key / build_hash / "layer.json") in 4191 + if not (Sys.file_exists layer_json) then begin 4192 + Printf.eprintf "Layer %s not found\n%!" build_hash; 4193 + Stdlib.exit 1 4194 + end; 4195 + let json = Yojson.Safe.from_file layer_json in 4196 + let open Yojson.Safe.Util in 4197 + let exit_status = json |> member "exit_status" |> to_int in 4198 + if exit_status = -1 then begin 4199 + Printf.eprintf "%s is a dependency failure (never built). Debug the failing dependency instead.\n%!" pkg_str; 4200 + (* Try to find which dep failed *) 4201 + let deps = try json |> member "deps" |> to_list |> List.map to_string with _ -> [] in 4202 + let hashes = try json |> member "hashes" |> to_list |> List.map to_string with _ -> [] in 4203 + List.iter2 (fun dep hash -> 4204 + let dep_layer = Path.(cache_dir / os_key / hash / "layer.json") in 4205 + try 4206 + let dj = Yojson.Safe.from_file dep_layer in 4207 + let es = dj |> member "exit_status" |> to_int in 4208 + if es > 0 then 4209 + Printf.eprintf " Failing dep: %s (%s) — try: day10 debug %s\n%!" dep hash dep 4210 + with _ -> () 4211 + ) deps hashes; 4212 + Stdlib.exit 1 4213 + end; 4214 + let pkg = match OpamPackage.of_string_opt pkg_str with 4215 + | Some p -> p 4216 + | None -> Printf.eprintf "Invalid package: %s\n%!" pkg_str; Stdlib.exit 1 4217 + in 4218 + let ordered_build_hashes = json |> member "hashes" |> to_list |> List.map to_string in 4219 + (* Use the layer's saved opam-repository if available *) 4220 + let layer_opam_repo = Path.(cache_dir / os_key / build_hash / "opam-repository") in 4221 + let opam_repositories = 4222 + if Sys.file_exists layer_opam_repo then [layer_opam_repo] 4223 + else begin 4224 + Printf.eprintf "Warning: no opam-repository in layer, using build-config.json\n%!"; 4225 + let bc_path = Path.(cache_dir / os_key / "build-config.json") in 4226 + if Sys.file_exists bc_path then 4227 + try 4228 + let bc = Yojson.Safe.from_file bc_path in 4229 + bc |> member "opam_repositories" |> to_list |> List.map to_string 4230 + with _ -> [] 4231 + else [] 4232 + end 4233 + in 4234 + let config : Config.t = { 4235 + dir = cache_dir; ocaml_version = None; opam_repositories; 4236 + package = pkg_str; arch; os; os_distribution; os_family; os_version; 4237 + directory = None; md = None; json = None; dot = None; 4238 + with_test = false; with_doc = false; with_jtw = false; 4239 + doc_tools_repo = ""; doc_tools_branch = ""; 4240 + jtw_tools_repo = ""; jtw_tools_branch = ""; 4241 + local_repos = []; html_output = None; jtw_output = None; tag = None; 4242 + log = false; dry_run = false; fork = None; prune_layers = false; blessed_map = None; 4243 + } in 4244 + let t = Container.init ~config in 4245 + let temp_dir = 4246 + if keep then 4247 + (* Stable name so --keep sessions can be resumed *) 4248 + Path.(cache_dir / Printf.sprintf "debug-%s" (String.sub build_hash 6 12)) 4249 + else 4250 + Path.(cache_dir / Printf.sprintf "debug-%d-%s" 4251 + (Unix.getpid ()) (String.sub (Digest.to_hex (Digest.string pkg_str)) 0 6)) 4252 + in 4253 + let resuming = Sys.file_exists temp_dir in 4254 + Os.mkdir ~parents:true temp_dir; 4255 + (* Set up opam repository in temp dir (skip if resuming a --keep session) *) 4256 + if not resuming then begin 4257 + let opam_repo = Util.create_opam_repository temp_dir in 4258 + let ordered_deps = json |> member "deps" |> to_list |> List.filter_map (fun j -> 4259 + OpamPackage.of_string_opt (to_string j) 4260 + ) in 4261 + Util.populate_opam_repository ~opam_repo ~opam_repositories:config.opam_repositories (pkg :: ordered_deps) 4262 + end; 4263 + if resuming then Printf.printf "Resuming debug session for %s (%s)\n%!" pkg_str build_hash 4264 + else begin 4265 + Printf.printf "Launching debug container for %s (%s)\n%!" pkg_str build_hash; 4266 + Printf.printf "Dependencies: %d packages\n%!" (List.length ordered_build_hashes) 4267 + end; 4268 + let result = Container.debug ~t ~temp_dir ?command ~keep pkg ordered_build_hashes in 4269 + (* Print build log for non-interactive mode *) 4270 + (match command with 4271 + | Some _ -> 4272 + let build_log = Path.(temp_dir / "build.log") in 4273 + if Sys.file_exists build_log then 4274 + In_channel.with_open_text build_log (fun ic -> 4275 + let rec loop () = match In_channel.input_line ic with 4276 + | Some line -> print_endline line; loop () 4277 + | None -> () 4278 + in loop ()) 4279 + | None -> ()); 4280 + Container.deinit ~t; 4281 + if keep then 4282 + Printf.printf "Debug dir kept at: %s\nResume with: day10 debug %s --keep\n%!" temp_dir target 4283 + else 4284 + ignore (Os.sudo ["rm"; "-rf"; temp_dir]); 4285 + if result <> 0 then 4286 + Printf.printf "Debug session exited with code %d\n%!" result 4287 + 4288 + let debug_cmd = 4289 + let target_arg = 4290 + let doc = "Package name or build hash to debug" in 4291 + Arg.(required & pos 0 (some string) None & info [] ~docv:"TARGET" ~doc) 4292 + in 4293 + let command_arg = 4294 + let doc = "Run a command non-interactively instead of dropping to a shell. Output is captured and printed." in 4295 + Arg.(value & opt (some string) None & info [ "command"; "c" ] ~docv:"CMD" ~doc) 4296 + in 4297 + let keep_arg = 4298 + let doc = "Keep the debug directory after exit. Allows resuming the session with the same overlay and source." in 4299 + Arg.(value & flag & info [ "keep" ] ~doc) 4300 + in 4301 + let debug_term = 4302 + Term.(const (fun cache_dir arch os os_distribution os_family os_version target command keep -> 4303 + run_debug ~cache_dir ~arch ~os ~os_distribution ~os_family ~os_version ~target ~command ~keep) 4304 + $ cache_dir_term $ arch_term $ os_term $ os_distribution_term $ os_family_term $ os_version_term $ target_arg $ command_arg $ keep_arg) 4305 + in 4306 + let debug_info = Cmd.info "debug" ~doc:"Launch interactive container to debug a failed build" in 4307 + Cmd.v debug_info debug_term 4308 + 3479 4309 let main_info = 3480 4310 let doc = "A tool for running CI and health checks" in 3481 4311 let man = ··· 3501 4331 `P "Use '$(mname) notify --channel CHANNEL --message TEXT' to send a notification."; 3502 4332 `P "Use '$(mname) universe [HASH]' to look up packages in a universe."; 3503 4333 `P "Use '$(mname) log LAYER' to show build or doc log for a layer."; 4334 + `P "Use '$(mname) debug TARGET' to launch an interactive container to debug a failed build."; 3504 4335 `P "Add --md flag to output results in markdown format."; 3505 4336 `S Manpage.s_examples; 3506 4337 `P "$(mname) ci --cache-dir /tmp/cache --opam-repository /tmp/opam-repository /path/to/project"; ··· 3523 4354 3524 4355 let () = 3525 4356 let default_term = Term.(ret (const (`Help (`Pager, None)))) in 3526 - let cmd = Cmd.group ~default:default_term main_info [ ci_cmd; health_check_cmd; batch_cmd; list_cmd; sync_docs_cmd; combine_docs_cmd; status_cmd; query_cmd; failures_cmd; changes_cmd; disk_cmd; rerun_cmd; rdeps_cmd; cascade_cmd; gc_cli_cmd; notify_cmd; universe_cmd; log_cmd ] in 4357 + let cmd = Cmd.group ~default:default_term main_info [ ci_cmd; health_check_cmd; batch_cmd; list_cmd; sync_docs_cmd; combine_docs_cmd; status_cmd; query_cmd; failures_cmd; changes_cmd; disk_cmd; rerun_cmd; rdeps_cmd; cascade_cmd; gc_cli_cmd; notify_cmd; universe_cmd; log_cmd; debug_cmd ] in 3527 4358 exit (Cmd.eval cmd)

+14

day10/bin/os.ml

··· 1 + let dir_size path = 2 + let rec aux acc dir = 3 + let entries = try Sys.readdir dir with _ -> [||] in 4 + Array.fold_left (fun acc name -> 5 + let full = Filename.concat dir name in 6 + try 7 + let stat = Unix.lstat full in 8 + if stat.Unix.st_kind = Unix.S_DIR then aux (acc + stat.Unix.st_size) full 9 + else acc + stat.Unix.st_size 10 + with _ -> acc 11 + ) (acc + (try (Unix.lstat dir).Unix.st_size with _ -> 0)) entries 12 + in 13 + aux 0 path 14 + 1 15 let read_from_file filename = In_channel.with_open_text filename @@ fun ic -> In_channel.input_all ic 2 16 let write_to_file filename str = Out_channel.with_open_text filename @@ fun oc -> Out_channel.output_string oc str 3 17 let append_to_file filename str = Out_channel.with_open_gen [ Open_text; Open_append; Open_creat ] 0o644 filename @@ fun oc -> Out_channel.output_string oc str

+1

day10/bin/s.ml

··· 13 13 val base_hash : config:Config.t -> string 14 14 val run : t:t -> temp_dir:string -> string -> string -> int 15 15 val build : t:t -> temp_dir:string -> string -> OpamPackage.t -> string list -> int 16 + val debug : t:t -> temp_dir:string -> ?command:string -> ?keep:bool -> OpamPackage.t -> string list -> int 16 17 val layer_hash : t:t -> OpamPackage.t list -> string 17 18 18 19 (** Compute hash for a doc layer.

+2

day10/bin/util.ml

··· 243 243 save_layer_info Path.(layer_dir / "layer.json") pkg ordered_deps dep_build_hashes (-1); 244 244 let opam_repo = create_opam_repository layer_dir in 245 245 populate_opam_repository ~opam_repo ~opam_repositories (pkg :: ordered_deps); 246 + let size = Os.dir_size layer_dir in 247 + Os.write_to_file Path.(layer_dir / "disk_usage") (string_of_int size); 246 248 ensure_package_layer_symlink ~cache_dir ~os_key ~pkg_str:(OpamPackage.to_string pkg) ~layer_name 247 249 end 248 250

+3

day10/bin/windows.ml

··· 176 176 let () = List.iter (fun hash -> Os.clense_tree ~source:Path.(config.dir / os_key / hash / "fs") ~target) sources in 177 177 result 178 178 179 + let debug ~t:_ ~temp_dir:_ ?command:_ ?keep:_ _pkg _ordered_hashes = 180 + Printf.eprintf "Debug mode not yet supported on Windows\n%!"; 1 181 + 179 182 let doc_layer_hash ~t:_ ~build_hash:_ ~dep_doc_hashes:_ ~ocaml_version:_ ~blessed:_ ~compiler_layers:_ = "" 180 183 181 184 (* Documentation generation not supported on Windows *)

+19 -5

day10/lib/status_index.ml

··· 133 133 let non_blessed_totals = ref [] in 134 134 let changes = ref [] in 135 135 let new_packages = ref [] in 136 + let os_dir = Filename.dirname packages_dir in 137 + let effective_category (e : History.entry) = 138 + if e.category = "build_failure" && String.length e.build_hash > 0 && e.build_hash <> "none" then 139 + let layer_json = Filename.concat (Filename.concat os_dir e.build_hash) "layer.json" in 140 + match Yojson.Safe.from_file layer_json with 141 + | `Assoc assoc -> 142 + (match List.assoc_opt "exit_status" assoc with 143 + | Some (`Int (-1)) -> "dependency_failure" 144 + | _ -> e.category) 145 + | _ -> e.category 146 + | exception _ -> e.category 147 + else 148 + e.category 149 + in 136 150 List.iter (fun pkg_str -> 137 151 let latest_entries = History.read_latest ~packages_dir ~pkg_str in 138 152 (* Tally blessed totals: count each package ONCE using its blessed entry. 139 153 Tally non-blessed totals: count each non-blessed build separately. *) 140 154 let blessed_entry = List.find_opt (fun (e : History.entry) -> e.blessed) latest_entries in 141 155 (match blessed_entry with 142 - | Some e -> blessed_totals := incr_totals !blessed_totals e.category 156 + | Some e -> blessed_totals := incr_totals !blessed_totals (effective_category e) 143 157 | None -> ()); 144 158 List.iter (fun (e : History.entry) -> 145 159 if not e.blessed then 146 - non_blessed_totals := incr_totals !non_blessed_totals e.category 160 + non_blessed_totals := incr_totals !non_blessed_totals (effective_category e) 147 161 ) latest_entries; 148 162 (* Detect changes: read full history for this package *) 149 163 let all_entries = History.read ~packages_dir ~pkg_str in ··· 157 171 e2.build_hash = e.build_hash && e2.run <> run_id 158 172 ) all_entries in 159 173 match prev with 160 - | Some prev_entry when prev_entry.category <> e.category -> 174 + | Some prev_entry when (effective_category prev_entry) <> (effective_category e) -> 161 175 changes := { 162 176 package = pkg_str; 163 177 build_hash = e.build_hash; 164 178 blessed = e.blessed; 165 - from_status = prev_entry.category; 166 - to_status = e.category; 179 + from_status = effective_category prev_entry; 180 + to_status = effective_category e; 167 181 } :: !changes 168 182 | _ -> () 169 183 end

+11

day10/patches/lwt_ppx-5.9.1+ox-oxcaml.patch

··· 1 + --- a/src/ppx/ppx_lwt.ml 2 + +++ b/src/ppx/ppx_lwt.ml 3 + @@ -109,7 +109,7 @@ 4 + | Pexp_sequence (lhs, rhs) -> 5 + Some (lwt_sequence mapper ~exp ~lhs ~rhs ~ext_loc) 6 + (* [let%lwt $p$ = $e$ in $e'$] ≡ [Lwt.bind $e$ (fun $p$ -> $e'$)] *) 7 + - | Pexp_let (Nonrecursive, vbl , e) -> 8 + + | Pexp_let (_, Nonrecursive, vbl, e) -> 9 + let new_exp = 10 + pexp_let 11 + ~loc:!default_loc

+115

day10/patches/ppx_deriving_yojson-3.9.1-oxcaml.patch

··· 1 + --- a/src/ppx_deriving_yojson.ml 2 + +++ b/src/ppx_deriving_yojson.ml 3 + @@ -112,7 +112,8 @@ 4 + (* eta-expansion is necessary for let-rec *) 5 + [%expr fun x -> [%e fwd] x] 6 + 7 + - | { ptyp_desc = Ptyp_tuple typs } -> 8 + + | { ptyp_desc = Ptyp_tuple labeled_typs } -> 9 + + let typs = List.map snd labeled_typs in 10 + [%expr fun [%p ptuple (List.mapi (fun i _ -> pvar (argn i)) typs)] -> 11 + `List ([%e 12 + list (List.mapi (fun i typ -> app (ser_expr_of_typ typ) [evar (argn i)]) typs)])]; 13 + @@ -125,7 +126,8 @@ 14 + let name = match Attribute.get rtag_attr_name field with Some s -> s | None -> label in 15 + Exp.case (Pat.variant label None) 16 + [%expr `List [`String [%e str name]]] 17 + - | Rtag(label, false, [{ ptyp_desc = Ptyp_tuple typs }]) -> 18 + + | Rtag(label, false, [{ ptyp_desc = Ptyp_tuple labeled_typs }]) -> 19 + + let typs = List.map snd labeled_typs in 20 + let label = label.txt in 21 + let name = match Attribute.get rtag_attr_name field with Some s -> s | None -> label in 22 + Exp.case (Pat.variant label (Some (ptuple (List.mapi (fun i _ -> pvar (argn i)) typs)))) 23 + @@ -146,11 +148,11 @@ 24 + deriver (Ppx_deriving.string_of_core_type typ)) 25 + in 26 + Exp.function_ cases 27 + - | { ptyp_desc = Ptyp_var name } -> [%expr ([%e evar ("poly_"^name)] : _ -> Yojson.Safe.t)] 28 + - | { ptyp_desc = Ptyp_alias (typ, name) } -> 29 + + | { ptyp_desc = Ptyp_var (name, _) } -> [%expr ([%e evar ("poly_"^name)] : _ -> Yojson.Safe.t)] 30 + + | { ptyp_desc = Ptyp_alias (typ, Some { txt = name; _ }, _) } -> 31 + [%expr fun x -> [%e evar ("poly_"^name)] x; [%e ser_expr_of_typ typ] x] 32 + - | { ptyp_desc = Ptyp_poly (names, typ) } -> 33 + - poly_fun names (ser_expr_of_typ typ) 34 + + | { ptyp_desc = Ptyp_poly (names_with_jkinds, typ) } -> 35 + + let names = List.map fst names_with_jkinds in poly_fun names (ser_expr_of_typ typ) 36 + | { ptyp_loc } -> 37 + raise_errorf ~loc:ptyp_loc "%s cannot be derived for %s" 38 + deriver (Ppx_deriving.string_of_core_type typ) 39 + @@ -222,7 +224,8 @@ 40 + [%expr map_bind [%e desu_expr_of_typ ~path typ] [] xs >|= Array.of_list] 41 + | [%type: Yojson.Safe.t] 42 + | [%type: Yojson.Safe.json] -> [%expr fun x -> Ok x] 43 + - | { ptyp_desc = Ptyp_tuple typs } -> 44 + + | { ptyp_desc = Ptyp_tuple labeled_typs } -> 45 + + let typs = List.map snd labeled_typs in 46 + decode [%pat? `List [%p plist (List.mapi (fun i _ -> pvar (argn i)) typs)]] 47 + (desu_fold ~quoter ~loc ~path tuple typs) 48 + | { ptyp_desc = Ptyp_variant (fields, _, _); ptyp_loc } -> 49 + @@ -238,7 +241,8 @@ 50 + let name = match Attribute.get rtag_attr_name field with Some s -> s | None -> label in 51 + Exp.case [%pat? `List [`String [%p pstr name]]] 52 + [%expr Ok [%e Exp.variant label None]] 53 + - | Rtag(label, false, [{ ptyp_desc = Ptyp_tuple typs }]) -> 54 + + | Rtag(label, false, [{ ptyp_desc = Ptyp_tuple labeled_typs }]) -> 55 + + let typs = List.map snd labeled_typs in 56 + let label = label.txt in 57 + let name = match Attribute.get rtag_attr_name field with Some s -> s | None -> label in 58 + Exp.case [%pat? `List ((`String [%p pstr name]) :: [%p 59 + @@ -276,12 +280,12 @@ 60 + let fwd = app (Ppx_deriving.quote ~quoter desu_fn) (List.map (desu_expr_of_typ ~path) args) in 61 + (* eta-expansion is necessary for recursive groups *) 62 + [%expr fun x -> [%e fwd] x] 63 + - | { ptyp_desc = Ptyp_var name } -> 64 + + | { ptyp_desc = Ptyp_var (name, _) } -> 65 + [%expr ([%e evar ("poly_"^name)] : Yojson.Safe.t -> _ error_or)] 66 + - | { ptyp_desc = Ptyp_alias (typ, name) } -> 67 + + | { ptyp_desc = Ptyp_alias (typ, Some { txt = name; _ }, _) } -> 68 + [%expr fun x -> [%e evar ("poly_"^name)] x; [%e desu_expr_of_typ ~path typ] x] 69 + - | { ptyp_desc = Ptyp_poly (names, typ) } -> 70 + - poly_fun names (desu_expr_of_typ ~path typ) 71 + + | { ptyp_desc = Ptyp_poly (names_with_jkinds, typ) } -> 72 + + let names = List.map fst names_with_jkinds in poly_fun names (desu_expr_of_typ ~path typ) 73 + | { ptyp_loc } -> 74 + raise_errorf ~loc:ptyp_loc "%s cannot be derived for %s" 75 + deriver (Ppx_deriving.string_of_core_type typ) 76 + @@ -394,7 +398,8 @@ 77 + Exp.case 78 + (pconstr name' []) 79 + [%expr `List [`String [%e str json_name]]] 80 + - | Pcstr_tuple(args) -> 81 + + | Pcstr_tuple(args_raw) -> 82 + + let args = List.map (fun (a : constructor_argument) -> a.pca_type) args_raw in 83 + let arg_exprs = 84 + List.mapi (fun i typ -> app (ser_expr_of_typ ~quoter typ) [evar (argn i)]) args 85 + in 86 + @@ -444,7 +449,8 @@ 87 + Exp.case 88 + (pconstr name' []) 89 + [%expr `List [`String [%e str json_name]]] 90 + - | Pcstr_tuple(args) -> 91 + + | Pcstr_tuple(args_raw) -> 92 + + let args = List.map (fun (a : constructor_argument) -> a.pca_type) args_raw in 93 + let arg_exprs = 94 + List.mapi (fun i typ -> app (ser_expr_of_typ ~quoter typ) [evar (argn i)]) args 95 + in 96 + @@ -604,7 +610,8 @@ 97 + | Ptype_variant constrs, _ -> 98 + let cases = List.map (fun ({ pcd_loc = loc; pcd_name = { txt = name' }; pcd_args; _ } as constr') -> 99 + match pcd_args with 100 + - | Pcstr_tuple(args) -> 101 + + | Pcstr_tuple(args_raw) -> 102 + + let args = List.map (fun (a : constructor_argument) -> a.pca_type) args_raw in 103 + let name = match Attribute.get constr_attr_name constr' with Some s -> s | None -> name' in 104 + Exp.case 105 + [%pat? `List ((`String [%p pstr name]) :: 106 + @@ -668,7 +675,8 @@ 107 + | Pext_decl (_, pext_args, _) -> 108 + let case = 109 + match pext_args with 110 + - | Pcstr_tuple(args) -> 111 + + | Pcstr_tuple(args_raw) -> 112 + + let args = List.map (fun (a : constructor_argument) -> a.pca_type) args_raw in 113 + let name = match Attribute.get ext_attr_name ext with Some s -> s | None -> name' in 114 + Exp.case 115 + [%pat? `List ((`String [%p pstr name]) ::

+438

day10/scripts/categorize-failures.sh

··· 1 + #!/usr/bin/env bash 2 + # categorize-failures.sh — Categorize OCaml build failures from a monopam cache. 3 + # 4 + # Usage: 5 + # ./categorize-failures.sh [--cache-dir DIR] [--verbose] [--list-packages] 6 + # 7 + # Options: 8 + # --cache-dir DIR Path to the cache root (default: /home/jjl25/cache-ox) 9 + # --verbose Print each package and its category as it is processed 10 + # --list-packages After the summary, list the packages in each category 11 + # 12 + # The cache is assumed to live under: 13 + # $CACHE_DIR/ubuntu-24.04-x86_64/ 14 + # 15 + # Failure categories (checked in priority order): 16 + # 17 + # dep_failure exit_status=-1, skeleton layer (dependency failed) 18 + # apt_404 apt-get failed with 404 Not Found (stale Ubuntu mirrors) 19 + # missing_system_pkg Command/tool not found; system dep unavailable 20 + # c_header_missing C/C++ fatal error: header file not found 21 + # missing_library C library not found (configure/link error) 22 + # register_alloc OCaml native compiler register-allocation > 50 rounds 23 + # ast_arity OCaml Parsetree AST constructor arity mismatch 24 + # (Ptyp_alias, Pexp_let, Ptyp_arrow, Pexp_array, … gained 25 + # extra arguments in OCaml 5.2) 26 + # locality_type OCaml 5.2 locality/mode type error 27 + # (value is "local" but expected "global"; string @ local …) 28 + # module_mismatch .cmx/.cmo unit-name mismatch (parallel for-pack build) 29 + # api_mismatch OCaml interface / signature mismatch 30 + # (Values/Modules do not match; is not included in; 31 + # does not match the interface) 32 + # type_error Other OCaml type errors (Unbound module/value, wrong 33 + # arity on type constructors, expression type mismatch, etc.) 34 + # c_compile_error C/C++ compiler error (too few args, incompatible pointer…) 35 + # make_error Catch-all: make / dune build tool exited with error 36 + # install_error opam installation step failed (mkdir/cp) 37 + # uncaught_exn opam-build: internal error, uncaught exception 38 + # unknown None of the above patterns matched 39 + 40 + set -euo pipefail 41 + 42 + # --------------------------------------------------------------------------- 43 + # Defaults 44 + # --------------------------------------------------------------------------- 45 + CACHE_DIR="/home/jjl25/cache-ox" 46 + OS_SUBDIR="ubuntu-24.04-x86_64" 47 + VERBOSE=0 48 + LIST_PACKAGES=0 49 + 50 + # --------------------------------------------------------------------------- 51 + # Argument parsing 52 + # --------------------------------------------------------------------------- 53 + while [[ $# -gt 0 ]]; do 54 + case "$1" in 55 + --cache-dir) CACHE_DIR="$2"; shift 2 ;; 56 + --verbose) VERBOSE=1; shift ;; 57 + --list-packages) LIST_PACKAGES=1; shift ;; 58 + -h|--help) 59 + sed -n '2,40p' "$0" 60 + exit 0 61 + ;; 62 + *) echo "Unknown option: $1" >&2; exit 1 ;; 63 + esac 64 + done 65 + 66 + CACHE="$CACHE_DIR/$OS_SUBDIR" 67 + PKG_DIR="$CACHE/packages" 68 + 69 + if [[ ! -d "$PKG_DIR" ]]; then 70 + echo "ERROR: Package directory not found: $PKG_DIR" >&2 71 + echo "Try --cache-dir to specify the cache root." >&2 72 + exit 1 73 + fi 74 + 75 + # --------------------------------------------------------------------------- 76 + # Category counters and package lists 77 + # --------------------------------------------------------------------------- 78 + declare -A COUNT=( 79 + [dep_failure]=0 80 + [apt_404]=0 81 + [missing_system_pkg]=0 82 + [c_header_missing]=0 83 + [missing_library]=0 84 + [register_alloc]=0 85 + [ast_arity]=0 86 + [locality_type]=0 87 + [module_mismatch]=0 88 + [api_mismatch]=0 89 + [type_error]=0 90 + [c_compile_error]=0 91 + [make_error]=0 92 + [install_error]=0 93 + [uncaught_exn]=0 94 + [unknown]=0 95 + ) 96 + 97 + declare -A PKGS=( 98 + [dep_failure]="" 99 + [apt_404]="" 100 + [missing_system_pkg]="" 101 + [c_header_missing]="" 102 + [missing_library]="" 103 + [register_alloc]="" 104 + [ast_arity]="" 105 + [locality_type]="" 106 + [module_mismatch]="" 107 + [api_mismatch]="" 108 + [type_error]="" 109 + [c_compile_error]="" 110 + [make_error]="" 111 + [install_error]="" 112 + [uncaught_exn]="" 113 + [unknown]="" 114 + ) 115 + 116 + TOTAL=0 117 + 118 + record() { 119 + local cat="$1" 120 + local pkg="$2" 121 + COUNT[$cat]=$((COUNT[$cat] + 1)) 122 + if [[ $LIST_PACKAGES -eq 1 ]]; then 123 + PKGS[$cat]="${PKGS[$cat]} $pkg\n" 124 + fi 125 + if [[ $VERBOSE -eq 1 ]]; then 126 + printf "%-55s %s\n" "$pkg" "$cat" 127 + fi 128 + } 129 + 130 + # --------------------------------------------------------------------------- 131 + # Main loop: use Python for fast JSON parsing; categorize log with grep 132 + # 133 + # We delegate the JSON reading to a single Python invocation per package so 134 + # the bash loop doesn't spawn dozens of python3 subprocesses per package. 135 + # --------------------------------------------------------------------------- 136 + 137 + # First, emit a list of "pkg<TAB>exit_status<TAB>log_path" for every blessed 138 + # failure, then categorize each one with grep. 139 + # 140 + # We use Python in a single pass over all history files. 141 + 142 + TMP_LIST=$(mktemp) 143 + python3 - "$PKG_DIR" "$CACHE" > "$TMP_LIST" << 'PYEOF' 144 + import json, os, sys 145 + 146 + pkg_dir = sys.argv[1] 147 + cache = sys.argv[2] 148 + 149 + for entry in sorted(os.scandir(pkg_dir), key=lambda e: e.name): 150 + if not entry.is_dir(): 151 + continue 152 + pkg = entry.name 153 + hfile = os.path.join(entry.path, 'history.jsonl') 154 + if not os.path.exists(hfile): 155 + continue 156 + try: 157 + with open(hfile) as f: 158 + lines = f.readlines() 159 + last = json.loads(lines[-1]) 160 + except Exception: 161 + continue 162 + 163 + if not last.get('blessed', False): 164 + continue 165 + if last.get('status') != 'failure': 166 + continue 167 + 168 + build_hash = last.get('build_hash', '') 169 + if not build_hash: 170 + continue 171 + 172 + layer_json = os.path.join(cache, build_hash, 'layer.json') 173 + if not os.path.exists(layer_json): 174 + continue 175 + 176 + try: 177 + with open(layer_json) as f: 178 + layer = json.load(f) 179 + except Exception: 180 + continue 181 + 182 + exit_status = layer.get('exit_status', 'unknown') 183 + log_path = os.path.join(cache, build_hash, 'build.log') 184 + 185 + print(f"{pkg}\t{exit_status}\t{log_path}") 186 + PYEOF 187 + 188 + # --------------------------------------------------------------------------- 189 + # Categorize each entry 190 + # --------------------------------------------------------------------------- 191 + while IFS=$'\t' read -r pkg exit_status log_path; do 192 + TOTAL=$((TOTAL + 1)) 193 + 194 + # ------------------------------------------------------------------------- 195 + # 1. dep_failure — exit=-1, skeleton layer (a dependency failed first) 196 + # These have an empty build.log. 197 + # ------------------------------------------------------------------------- 198 + if [[ "$exit_status" == "-1" ]]; then 199 + record dep_failure "$pkg" 200 + continue 201 + fi 202 + 203 + # ------------------------------------------------------------------------- 204 + # For remaining categories we read the build log 205 + # ------------------------------------------------------------------------- 206 + if [[ ! -f "$log_path" || ! -s "$log_path" ]]; then 207 + record unknown "$pkg" 208 + continue 209 + fi 210 + 211 + # ------------------------------------------------------------------------- 212 + # 2. apt_404 — apt-get couldn't fetch packages (stale Ubuntu security URLs) 213 + # Pattern: "E: Failed to fetch http://... 404 Not Found" 214 + # exit_status is typically 125 215 + # ------------------------------------------------------------------------- 216 + if grep -qF '404 Not Found' "$log_path"; then 217 + record apt_404 "$pkg" 218 + continue 219 + fi 220 + 221 + # ------------------------------------------------------------------------- 222 + # 3. missing_system_pkg — a required binary or package is not installed 223 + # Covers: conf-zig ("zig": command not found), conf-python-2-7, snoke 224 + # ("dune": command not found), conf-wxwidgets ("wx-config": not found), 225 + # and any opam package where "These packages are still missing:". 226 + # ------------------------------------------------------------------------- 227 + if grep -qE '"[^"]+": command not found|These packages are still missing:' "$log_path"; then 228 + record missing_system_pkg "$pkg" 229 + continue 230 + fi 231 + 232 + # ------------------------------------------------------------------------- 233 + # 4. c_header_missing — C/C++ compiler reports a missing header 234 + # Pattern: "fatal error: foo.h: No such file or directory" 235 + # ------------------------------------------------------------------------- 236 + if grep -qE 'fatal error: [^ ]+\.(h|hpp): No such file or directory' "$log_path"; then 237 + record c_header_missing "$pkg" 238 + continue 239 + fi 240 + 241 + # ------------------------------------------------------------------------- 242 + # 5. missing_library — configure / linker cannot find a C library 243 + # We restrict to configure-style messages (not ocaml tool checks). 244 + # ------------------------------------------------------------------------- 245 + if grep -qE 'configure: error: (Cannot find|[Nn]o |Unable to find)' "$log_path" \ 246 + || grep -qE 'LLVM not found|cannot find the library|library not found|Cannot find (library|header)' "$log_path" \ 247 + || grep -qP 'checking for (?!ocaml)[^\n]+\.\.\. no$' "$log_path" 2>/dev/null; then 248 + record missing_library "$pkg" 249 + continue 250 + fi 251 + 252 + # ------------------------------------------------------------------------- 253 + # 6. register_alloc — OCaml native compiler register-allocation failure 254 + # Happens with very large generated files (atdgen, etc.) 255 + # Pattern: "Fatal error: register allocation was not succesful after 50 rounds" 256 + # ------------------------------------------------------------------------- 257 + if grep -qF 'register allocation was not suc' "$log_path"; then 258 + record register_alloc "$pkg" 259 + continue 260 + fi 261 + 262 + # ------------------------------------------------------------------------- 263 + # 7. ast_arity — OCaml Parsetree AST constructor received wrong # of args 264 + # In OCaml 5.2 several constructors gained extra arguments: 265 + # Ptyp_alias (2→3), Pexp_let (3→4), Ptyp_arrow (3→5), 266 + # Pexp_array (1→2), Ptyp_var (1→2), Tpat_var (4→5), … 267 + # The error in the log (after the "- " prefix) is: 268 + # 'The constructor "Ptyp_alias" expects 3 argument(s),' 269 + # Note: the "but is applied here" part is on the NEXT line (with "- " prefix), 270 + # so we match only on the first line. 271 + # ------------------------------------------------------------------------- 272 + if grep -qE 'The constructor "[^"]+" expects [0-9]+ argument$s$,' "$log_path"; then 273 + record ast_arity "$pkg" 274 + continue 275 + fi 276 + 277 + # ------------------------------------------------------------------------- 278 + # 8. locality_type — OCaml 5.2 locality / mode type errors 279 + # These appear when code uses un-moded function types and the compiler 280 + # expects a moded version (or vice versa). 281 + # 282 + # Distinguishing patterns (all in the context of an OCaml Error:): 283 + # "This value is "local" but is expected to be "global"." 284 + # "This expression has type ... but an expression was expected of type ..." 285 + # where the types differ only in "@ local" 286 + # "Function arguments and returns must be representable. The layout of X is any" 287 + # (missing .cmi — The layout is 'any' because locality is unknown) 288 + # "This expression has type string -> unit 289 + # but an expression was expected of type string @ local -> unit" 290 + # 291 + # We look for locality keywords that appear right before "-> " in a type 292 + # mismatch, or the explicit locality error message. 293 + # ------------------------------------------------------------------------- 294 + if grep -qE 'is "local" but is expected to be "global"' "$log_path" \ 295 + || grep -qF 'Function arguments and returns must be representable' "$log_path" \ 296 + || grep -qE '"[^"]*@ (local|unique|portable|contended)[^"]*"' "$log_path" \ 297 + || grep -qE 'expected of type.*@ (local|unique|portable|contended)' "$log_path" \ 298 + || grep -qE '@ (local|unique|portable|contended) ->' "$log_path"; then 299 + record locality_type "$pkg" 300 + continue 301 + fi 302 + 303 + # ------------------------------------------------------------------------- 304 + # 9. module_mismatch — for-pack unit-name mismatch 305 + # When compiling in parallel, one .cmx may have been built before the 306 + # -for-pack flag was applied, leaving it named differently. 307 + # Pattern: "foo.cmx contains the description for unit Foo when Bar.Foo was expected" 308 + # ------------------------------------------------------------------------- 309 + if grep -qE '\.(cmx|cmo) contains the description for unit' "$log_path"; then 310 + record module_mismatch "$pkg" 311 + continue 312 + fi 313 + 314 + # ------------------------------------------------------------------------- 315 + # 10. api_mismatch — OCaml interface / signature mismatch 316 + # Covers: implementation doesn't match .mli, functor arg wrong, 317 + # signature not a subset. 318 + # ------------------------------------------------------------------------- 319 + if grep -qE 'Values do not match:|Modules do not match:|The implementation .+ does not match the interface' "$log_path" \ 320 + || grep -qE 'is not included in' "$log_path"; then 321 + record api_mismatch "$pkg" 322 + continue 323 + fi 324 + 325 + # ------------------------------------------------------------------------- 326 + # 11. type_error — other OCaml type / unbound errors 327 + # ------------------------------------------------------------------------- 328 + if grep -qE 'Error: Unbound (module|value|constructor|type|identifier)' "$log_path" \ 329 + || grep -qE 'Error: The type constructor .+ expects [0-9]+ argument' "$log_path" \ 330 + || grep -qE 'Error: This expression has type' "$log_path" \ 331 + || grep -qE 'Error: The operator .+ has type' "$log_path" \ 332 + || grep -qE 'is not compatible with (the )?type' "$log_path"; then 333 + record type_error "$pkg" 334 + continue 335 + fi 336 + 337 + # ------------------------------------------------------------------------- 338 + # 12. c_compile_error — C/C++ compiler errors (non-header) 339 + # ------------------------------------------------------------------------- 340 + if grep -qE 'error: (too few arguments|too many arguments|incompatible pointer|no member named|use of undeclared)' "$log_path"; then 341 + record c_compile_error "$pkg" 342 + continue 343 + fi 344 + 345 + # ------------------------------------------------------------------------- 346 + # 13. make_error — build tool exited with error (catch-all before install) 347 + # ------------------------------------------------------------------------- 348 + if grep -qE '\[ERROR\] The (compilation|build) of .+ failed at' "$log_path" \ 349 + || grep -qE 'make(\[[0-9]+\])?: \*\*\*' "$log_path" \ 350 + || grep -qE 'Command exited with code [1-9]' "$log_path"; then 351 + record make_error "$pkg" 352 + continue 353 + fi 354 + 355 + # ------------------------------------------------------------------------- 356 + # 14. install_error — installation step failed 357 + # ------------------------------------------------------------------------- 358 + if grep -qE 'install failed\.\.\.|The installation of .+ failed' "$log_path" \ 359 + || grep -qE "mkdir.*cannot create directory|cp:.*No such file" "$log_path"; then 360 + record install_error "$pkg" 361 + continue 362 + fi 363 + 364 + # ------------------------------------------------------------------------- 365 + # 15. uncaught_exn — opam-build uncaught exception 366 + # ------------------------------------------------------------------------- 367 + if grep -qF 'opam-build: internal error, uncaught exception' "$log_path"; then 368 + record uncaught_exn "$pkg" 369 + continue 370 + fi 371 + 372 + # ------------------------------------------------------------------------- 373 + # Fallback 374 + # ------------------------------------------------------------------------- 375 + record unknown "$pkg" 376 + 377 + done < "$TMP_LIST" 378 + 379 + rm -f "$TMP_LIST" 380 + 381 + # --------------------------------------------------------------------------- 382 + # Output summary 383 + # --------------------------------------------------------------------------- 384 + echo "" 385 + echo "============================================================" 386 + echo " OCaml Build Failure Categories" 387 + echo " Cache: $CACHE" 388 + echo " Total failing blessed builds: $TOTAL" 389 + echo "============================================================" 390 + echo "" 391 + 392 + declare -A LABELS=( 393 + [dep_failure]="Dependency failure (not built) exit=-1" 394 + [apt_404]="apt-get 404 (stale Ubuntu package URLs) exit=125" 395 + [missing_system_pkg]="Missing system package / command not found exit=125" 396 + [c_header_missing]="C/C++ header file not found exit=1" 397 + [missing_library]="C library not found (configure/link) exit=1" 398 + [register_alloc]="OCaml register allocation failure exit=1" 399 + [ast_arity]="OCaml Parsetree AST constructor arity mismatch exit=1" 400 + [locality_type]="OCaml 5.2 locality/mode type error exit=1" 401 + [module_mismatch]="OCaml for-pack unit-name mismatch exit=1" 402 + [api_mismatch]="OCaml interface/signature mismatch exit=1" 403 + [type_error]="OCaml type error (Unbound/arity/expression) exit=1" 404 + [c_compile_error]="C/C++ compilation error exit=1" 405 + [make_error]="Build tool (make/dune) error (catch-all) exit=1" 406 + [install_error]="Install step failure exit=1" 407 + [uncaught_exn]="opam-build uncaught exception exit=125" 408 + [unknown]="Unknown / uncategorized" 409 + ) 410 + 411 + # Print sorted by count descending 412 + printf '%s\n' "${!COUNT[@]}" \ 413 + | while read -r cat; do printf '%d\t%s\n' "${COUNT[$cat]}" "$cat"; done \ 414 + | sort -rn \ 415 + | while IFS=$'\t' read -r count cat; do 416 + pct=0 417 + if [[ $TOTAL -gt 0 ]]; then 418 + pct=$(( count * 100 / TOTAL )) 419 + fi 420 + printf " %-16s %4d (%3d%%) %s\n" "$cat" "$count" "$pct" "${LABELS[$cat]}" 421 + done 422 + 423 + echo "" 424 + 425 + if [[ $LIST_PACKAGES -eq 1 ]]; then 426 + echo "============================================================" 427 + echo " Package lists per category" 428 + echo "============================================================" 429 + for cat in dep_failure apt_404 missing_system_pkg c_header_missing missing_library \ 430 + register_alloc ast_arity locality_type module_mismatch api_mismatch \ 431 + type_error c_compile_error make_error install_error uncaught_exn unknown; do 432 + if [[ -n "${PKGS[$cat]:-}" ]]; then 433 + echo "" 434 + echo "--- ${cat} (${COUNT[$cat]}) ---" 435 + printf '%b' "${PKGS[$cat]}" 436 + fi 437 + done 438 + fi

+181

day10/scripts/failure-impact.py

··· 1 + #!/usr/bin/env python3 2 + """ 3 + failure-impact.py — Find which build failures block the most packages. 4 + 5 + For each skeleton layer (exit_status=-1, i.e. dep_failure), walk its deps/hashes 6 + arrays to find the root-cause failure (the dep with a non-zero exit_status). 7 + Aggregate counts per root-cause package and print sorted by number of packages 8 + blocked, descending. 9 + 10 + Usage: 11 + python3 failure-impact.py [--cache-dir DIR] 12 + 13 + Options: 14 + --cache-dir DIR Path to the cache root (default: /home/jjl25/cache-ox) 15 + """ 16 + 17 + import argparse 18 + import json 19 + import os 20 + import sys 21 + from collections import defaultdict 22 + 23 + 24 + def main(): 25 + parser = argparse.ArgumentParser( 26 + description="Count how many packages each build failure blocks." 27 + ) 28 + parser.add_argument( 29 + "--cache-dir", 30 + default="/home/jjl25/cache-ox", 31 + help="Path to the cache root (default: /home/jjl25/cache-ox)", 32 + ) 33 + parser.add_argument( 34 + "--os-subdir", 35 + default="ubuntu-24.04-x86_64", 36 + help="OS subdirectory under cache root (default: ubuntu-24.04-x86_64)", 37 + ) 38 + args = parser.parse_args() 39 + 40 + cache = os.path.join(args.cache_dir, args.os_subdir) 41 + pkg_dir = os.path.join(cache, "packages") 42 + 43 + if not os.path.isdir(pkg_dir): 44 + print(f"ERROR: Package directory not found: {pkg_dir}", file=sys.stderr) 45 + print("Try --cache-dir to specify the cache root.", file=sys.stderr) 46 + sys.exit(1) 47 + 48 + # Load all blessed build results: pkg -> (status, build_hash) 49 + blessed = {} # pkg -> {"status": ..., "build_hash": ..., "exit_status": ...} 50 + 51 + for entry in sorted(os.scandir(pkg_dir), key=lambda e: e.name): 52 + if not entry.is_dir(): 53 + continue 54 + pkg = entry.name 55 + hfile = os.path.join(entry.path, "history.jsonl") 56 + if not os.path.exists(hfile): 57 + continue 58 + try: 59 + with open(hfile) as f: 60 + lines = f.readlines() 61 + last = json.loads(lines[-1]) 62 + except Exception: 63 + continue 64 + 65 + if not last.get("blessed", False): 66 + continue 67 + 68 + status = last.get("status", "") 69 + if "failure" not in status: 70 + continue 71 + 72 + build_hash = last.get("build_hash", "") 73 + if not build_hash: 74 + continue 75 + 76 + layer_json = os.path.join(cache, build_hash, "layer.json") 77 + if not os.path.exists(layer_json): 78 + continue 79 + 80 + try: 81 + with open(layer_json) as f: 82 + layer = json.load(f) 83 + except Exception: 84 + continue 85 + 86 + exit_status = layer.get("exit_status", None) 87 + deps = layer.get("deps", []) 88 + hashes = layer.get("hashes", []) 89 + 90 + blessed[pkg] = { 91 + "status": status, 92 + "build_hash": build_hash, 93 + "exit_status": exit_status, 94 + "deps": deps, 95 + "hashes": hashes, 96 + "layer": layer, 97 + } 98 + 99 + # Build a map from build_hash -> exit_status for fast lookup 100 + hash_to_exit: dict[str, int] = {} 101 + for info in blessed.values(): 102 + if info["build_hash"]: 103 + hash_to_exit[info["build_hash"]] = info["exit_status"] 104 + 105 + # Also load layer.json for hashes that appear as deps but may not be in blessed 106 + def get_exit_status_for_hash(build_hash: str) -> int | None: 107 + if build_hash in hash_to_exit: 108 + return hash_to_exit[build_hash] 109 + layer_json = os.path.join(cache, build_hash, "layer.json") 110 + if not os.path.exists(layer_json): 111 + return None 112 + try: 113 + with open(layer_json) as f: 114 + layer = json.load(f) 115 + es = layer.get("exit_status", None) 116 + hash_to_exit[build_hash] = es 117 + return es 118 + except Exception: 119 + return None 120 + 121 + # For each skeleton (exit_status=-1), find the root-cause dep 122 + # A dep is the "root cause" if its exit_status != 0 (and != -1, i.e. it actually failed itself) 123 + # or if it's also a skeleton (-1), we recurse to find its root cause. 124 + # For simplicity (and to match the spec), we find the DIRECT dep with non-zero exit_status. 125 + 126 + blocked_count: dict[str, int] = defaultdict(int) 127 + # skeleton packages are those with exit_status=-1 128 + skeletons = {pkg: info for pkg, info in blessed.items() if info["exit_status"] == -1} 129 + 130 + for pkg, info in skeletons.items(): 131 + deps = info["deps"] 132 + hashes = info["hashes"] 133 + 134 + root_cause = None 135 + for dep_pkg, dep_hash in zip(deps, hashes): 136 + if not dep_hash: 137 + continue 138 + es = get_exit_status_for_hash(dep_hash) 139 + if es is not None and es != 0: 140 + # This dep failed (either a real failure or another skeleton) 141 + # Walk down to find the true root cause (non-skeleton failure) 142 + # Do a simple one-level walk: if dep is also a skeleton, try to 143 + # find its failed dep. 144 + if es == -1 and dep_pkg in blessed: 145 + # The dep is itself a skeleton; look for its failed dep 146 + sub_info = blessed[dep_pkg] 147 + sub_root = None 148 + for sub_dep, sub_hash in zip(sub_info["deps"], sub_info["hashes"]): 149 + if not sub_hash: 150 + continue 151 + sub_es = get_exit_status_for_hash(sub_hash) 152 + if sub_es is not None and sub_es != 0 and sub_es != -1: 153 + sub_root = sub_dep 154 + break 155 + if sub_root: 156 + root_cause = sub_root 157 + else: 158 + root_cause = dep_pkg 159 + else: 160 + root_cause = dep_pkg 161 + break 162 + 163 + if root_cause: 164 + blocked_count[root_cause] += 1 165 + 166 + # Sort by count descending 167 + sorted_results = sorted(blocked_count.items(), key=lambda x: x[1], reverse=True) 168 + 169 + print(f"# Root-cause failures and how many packages they block") 170 + print(f"# Cache: {cache}") 171 + print(f"# Skeletons (dep_failure): {len(skeletons)}") 172 + print(f"# Root causes found: {len(sorted_results)}") 173 + print() 174 + print(f"{'count':>6} package") 175 + print(f"{'------':>6} -------") 176 + for pkg_name, count in sorted_results: 177 + print(f"{count:>6} {pkg_name}") 178 + 179 + 180 + if __name__ == "__main__": 181 + main()

Configure Feed

Configure Feed