day11: pin base Docker image digest in profile · jon.recoil.org/monopam-myspace@c74c25a

+86

day11/batch/profile.ml

··· 19 19 driver_compiler : string; 20 20 extra_pins : string list; 21 21 patches_dir : string option; 22 + base_image_digest : string option; 23 + base_image_updated : string option; 24 + (* ISO-8601 timestamp of when base_image_digest was resolved *) 22 25 } 23 26 24 27 let target_mode_to_json = function ··· 59 62 ("driver_compiler", `String t.driver_compiler); 60 63 ("extra_pins", `List (List.map (fun s -> `String s) t.extra_pins)); 61 64 ("patches_dir", opt_to_json t.patches_dir); 65 + ("base_image_digest", opt_to_json t.base_image_digest); 66 + ("base_image_updated", opt_to_json t.base_image_updated); 62 67 ] 63 68 64 69 let of_json json = ··· 91 96 with _ -> "ocaml-base-compiler.5.4.1"); 92 97 extra_pins = (try str_list "extra_pins" with _ -> []); 93 98 patches_dir = str_opt "patches_dir"; 99 + base_image_digest = str_opt "base_image_digest"; 100 + base_image_updated = str_opt "base_image_updated"; 94 101 } 95 102 with exn -> 96 103 Rresult.R.error_msgf "Profile.of_json: %s" (Printexc.to_string exn) ··· 131 138 let os_dir_name t = 132 139 Printf.sprintf "%s-%s-%s" t.os_distribution t.os_version t.arch 133 140 141 + let base_image_tag t = 142 + Printf.sprintf "%s:%s" t.os_distribution t.os_version 143 + 134 144 let default_dir () = 135 145 let home = try Sys.getenv "HOME" with Not_found -> "/tmp" in 136 146 Fpath.v (Filename.concat home ".day11") 137 147 148 + let now_iso8601 () = 149 + let t = Unix.gettimeofday () in 150 + let tm = Unix.gmtime t in 151 + Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ" 152 + (tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday 153 + tm.tm_hour tm.tm_min tm.tm_sec 154 + 155 + (** Resolve the base image digest from the Docker registry. 156 + This calls `docker manifest inspect` which queries the registry 157 + without pulling. Can be slow (~10-15s). *) 158 + let resolve_base_digest t = 159 + let tag = base_image_tag t in 160 + let cmd = Printf.sprintf 161 + "docker manifest inspect %s 2>/dev/null" (Filename.quote tag) in 162 + let ic = Unix.open_process_in cmd in 163 + let buf = Buffer.create 4096 in 164 + (try while true do Buffer.add_char buf (input_char ic) done 165 + with End_of_file -> ()); 166 + ignore (Unix.close_process_in ic); 167 + let json_str = Buffer.contents buf in 168 + try 169 + let json = Yojson.Safe.from_string json_str in 170 + let open Yojson.Safe.Util in 171 + let manifests = json |> member "manifests" |> to_list in 172 + let arch = t.arch in 173 + let docker_arch = match arch with 174 + | "x86_64" | "amd64" -> "amd64" 175 + | "aarch64" -> "arm64" 176 + | a -> a 177 + in 178 + List.find_map (fun m -> 179 + let plat = m |> member "platform" in 180 + let m_arch = plat |> member "architecture" |> to_string in 181 + let m_os = plat |> member "os" |> to_string in 182 + if m_arch = docker_arch && m_os = "linux" then 183 + Some (m |> member "digest" |> to_string) 184 + else None 185 + ) manifests 186 + with _ -> None 187 + 188 + (** Check if the base image digest is older than [max_age_days]. *) 189 + let base_image_stale ?(max_age_days = 30) t = 190 + match t.base_image_updated with 191 + | None -> true (* no timestamp = stale *) 192 + | Some ts -> 193 + (* Parse ISO-8601 timestamp *) 194 + try 195 + Scanf.sscanf ts "%4d-%2d-%2dT%2d:%2d:%2dZ" 196 + (fun year mon day hour min sec -> 197 + let tm = { Unix.tm_sec = sec; tm_min = min; tm_hour = hour; 198 + tm_mday = day; tm_mon = mon - 1; tm_year = year - 1900; 199 + tm_wday = 0; tm_yday = 0; tm_isdst = false } in 200 + let then_t, _ = Unix.mktime tm in 201 + let age_days = (Unix.gettimeofday () -. then_t) /. 86400. in 202 + age_days > float max_age_days) 203 + with _ -> true 204 + 205 + (** Update the profile's base image digest by querying the registry. 206 + Returns the updated profile (caller must save it). *) 207 + let refresh_base_digest t = 208 + match resolve_base_digest t with 209 + | Some digest -> 210 + Ok { t with 211 + base_image_digest = Some digest; 212 + base_image_updated = Some (now_iso8601 ()) } 213 + | None -> 214 + Error (`Msg (Printf.sprintf 215 + "Failed to resolve digest for %s" (base_image_tag t))) 216 + 138 217 let pp fmt t = 139 218 Fmt.pf fmt "@[<v>\ 140 219 Profile: %s@,\ ··· 145 224 Targets: %s@,\ 146 225 Docs: %b@,\ 147 226 Platform: %s-%s-%s@,\ 227 + Base image: %s%s@,\ 148 228 Driver compiler: %s\ 149 229 @]" 150 230 t.name ··· 158 238 | Packages pkgs -> String.concat ", " pkgs) 159 239 t.with_doc 160 240 t.os_distribution t.os_version t.arch 241 + (match t.base_image_digest with 242 + | Some d -> String.sub d 0 (min 20 (String.length d)) ^ "..." 243 + | None -> "(not pinned)") 244 + (match t.base_image_updated with 245 + | Some ts -> Printf.sprintf " (%s)" ts 246 + | None -> "") 161 247 (if t.driver_compiler = "" then "(auto)" else t.driver_compiler)

+17

day11/batch/profile.mli

··· 26 26 driver_compiler : string; 27 27 extra_pins : string list; 28 28 patches_dir : string option; 29 + base_image_digest : string option; 30 + base_image_updated : string option; 29 31 } 30 32 31 33 val save : dir:Fpath.t -> t -> (unit, [> Rresult.R.msg ]) result ··· 53 55 54 56 val default_dir : unit -> Fpath.t 55 57 (** [~/.day11] *) 58 + 59 + val base_image_tag : t -> string 60 + (** E.g. ["debian:bookworm"]. *) 61 + 62 + val resolve_base_digest : t -> string option 63 + (** Query the Docker registry for the current image digest. 64 + Calls [docker manifest inspect] — can take 10-15 seconds. *) 65 + 66 + val refresh_base_digest : t -> (t, [> Rresult.R.msg ]) result 67 + (** Resolve the digest and return an updated profile. 68 + Caller must save the profile. *) 69 + 70 + val base_image_stale : ?max_age_days:int -> t -> bool 71 + (** Returns [true] if the base image digest is older than 72 + [max_age_days] (default 30), or if no digest is recorded. *)

+7

day11/bin/cmd_batch.ml

··· 35 35 | Ok x -> x | Error (`Msg e) -> Printf.eprintf "Error: %s\n" e; exit 1 36 36 in 37 37 Common.ensure_paths paths; 38 + (* Warn if base image digest is stale or not pinned *) 39 + if Day11_batch.Profile.base_image_stale profile then 40 + Printf.printf "WARNING: Base image digest is %s. Run 'day11 profile refresh-base --name %s' to update.\n%!" 41 + (match profile.base_image_digest with 42 + | None -> "not pinned" 43 + | Some _ -> "more than 30 days old") 44 + profile_name; 38 45 let cache_dir = paths.cache_dir in 39 46 let os_dir = paths.os_dir in 40 47 let ocaml_version = Common.parse_ocaml_version profile.compiler in

+29 -1

day11/bin/cmd_profile.ml

··· 91 91 driver_compiler; 92 92 extra_pins = []; 93 93 patches_dir = None; 94 + base_image_digest = None; 95 + base_image_updated = None; 94 96 } in 95 97 match Day11_batch.Profile.save ~dir profile with 96 98 | Ok () -> ··· 159 161 let info = Cmd.info "delete" ~doc in 160 162 Cmd.v info Term.(const run_delete $ profile_dir_term $ name_term) 161 163 164 + (* ── refresh-base ──────────────────────────────────────────────── *) 165 + 166 + let run_refresh_base profile_dir name = 167 + let dir = Fpath.(resolve_profile_dir profile_dir / "profiles") in 168 + match Day11_batch.Profile.load ~dir ~name with 169 + | Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1 170 + | Ok profile -> 171 + Printf.printf "Resolving digest for %s (this may take ~15s)...\n%!" 172 + (Day11_batch.Profile.base_image_tag profile); 173 + match Day11_batch.Profile.refresh_base_digest profile with 174 + | Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1 175 + | Ok updated -> 176 + match Day11_batch.Profile.save ~dir updated with 177 + | Ok () -> 178 + Printf.printf "Base image digest updated:\n %s\n%!" 179 + (Option.value ~default:"?" updated.base_image_digest); 180 + 0 181 + | Error (`Msg e) -> 182 + Printf.eprintf "Error saving: %s\n%!" e; 1 183 + 184 + let refresh_base_cmd = 185 + let doc = "Resolve and pin the base Docker image digest from the registry" in 186 + let info = Cmd.info "refresh-base" ~doc in 187 + Cmd.v info Term.(const run_refresh_base $ profile_dir_term $ name_term) 188 + 162 189 (* ── group ─────────────────────────────────────────────────────── *) 163 190 164 191 let cmd = 165 192 let doc = "Manage analysis profiles" in 166 193 let info = Cmd.info "profile" ~doc in 167 - Cmd.group info [ create_cmd; show_cmd; list_cmd; delete_cmd ] 194 + Cmd.group info [ create_cmd; show_cmd; list_cmd; delete_cmd; 195 + refresh_base_cmd ]

+236

day11/doc-pages/ocurrent_sketch.ml

··· 1 + (* SKETCH: day11 as an OCurrent pipeline 2 + 3 + This is not compilable code — it's a design sketch showing how 4 + day11's libraries would map onto OCurrent's abstractions. 5 + 6 + The key insight: day11's layer hashes are deterministic from 7 + inputs, so they serve as OCurrent cache keys directly. *) 8 + 9 + open Current.Syntax 10 + 11 + (* ── Cache modules ─────────────────────────────────────────────── *) 12 + 13 + (* Each layer type gets a Current_cache.BUILDER that: 14 + - Uses the pre-computed layer hash as the cache key 15 + - Checks for the layer on disk before building 16 + - Calls the clean Doc_build/Build_layer primitive to do the work *) 17 + 18 + module Build_cache = Current_cache.Make (struct 19 + type t = { 20 + env : Eio_unix.Stdenv.base; 21 + benv : Day11_opam_build.Types.build_env; 22 + } 23 + 24 + module Key = struct 25 + type t = { pkg : OpamPackage.t; hash : string } 26 + let digest t = t.hash 27 + end 28 + 29 + module Value = struct 30 + type t = Fpath.t (* layer dir *) 31 + let marshal p = Fpath.to_string p 32 + let unmarshal s = Fpath.v s 33 + end 34 + 35 + let id = "day11-build" 36 + 37 + let pp f key = Fmt.pf f "build %s" (OpamPackage.to_string key.Key.pkg) 38 + 39 + let auto_cancel = false 40 + 41 + let build ctx job key = 42 + Current.Job.log job "Building %s" (OpamPackage.to_string key.pkg); 43 + let layer_dir = Day11_layer.Dir.path ~os_dir:ctx.benv.os_dir key.hash in 44 + if Sys.file_exists (Fpath.to_string Fpath.(layer_dir / "layer.json")) then 45 + Lwt.return_ok layer_dir 46 + else 47 + (* Call the build primitive *) 48 + match Day11_opam_build.Build_layer.build ctx.env ctx.benv 49 + (* ... build args ... *) 50 + () with 51 + | Day11_opam_build.Types.Success _bl -> Lwt.return_ok layer_dir 52 + | _ -> Lwt.return_error (`Msg "build failed") 53 + end) 54 + 55 + module Compile_cache = Current_cache.Make (struct 56 + type t = { 57 + env : Eio_unix.Stdenv.base; 58 + benv : Day11_opam_build.Types.build_env; 59 + config : Day11_doc.Doc_build.doc_config; 60 + } 61 + 62 + module Key = struct 63 + type t = { 64 + pkg : OpamPackage.t; 65 + hash : string; 66 + build_layer : Fpath.t; 67 + dep_compile_layers : Fpath.t list; 68 + } 69 + let digest t = t.hash (* deterministic from inputs *) 70 + end 71 + 72 + module Value = struct 73 + type t = Fpath.t 74 + let marshal p = Fpath.to_string p 75 + let unmarshal s = Fpath.v s 76 + end 77 + 78 + let id = "day11-compile" 79 + let pp f key = Fmt.pf f "compile %s" (OpamPackage.to_string key.Key.pkg) 80 + let auto_cancel = false 81 + 82 + let build ctx _job key = 83 + match Day11_doc.Doc_build.compile ctx.env ctx.benv 84 + ~config:ctx.config 85 + ~build_layer:key.build_layer 86 + ~dep_compile_layers:key.dep_compile_layers 87 + ~hash:key.hash key.pkg with 88 + | Ok layer_dir -> Lwt.return_ok layer_dir 89 + | Error msg -> Lwt.return_error (`Msg msg) 90 + end) 91 + 92 + module Link_cache = Current_cache.Make (struct 93 + type t = { 94 + env : Eio_unix.Stdenv.base; 95 + benv : Day11_opam_build.Types.build_env; 96 + config : Day11_doc.Doc_build.doc_config; 97 + html_dir : Fpath.t; 98 + } 99 + 100 + module Key = struct 101 + type t = { 102 + pkg : OpamPackage.t; 103 + hash : string; 104 + build_layer : Fpath.t; 105 + compile_layer : Fpath.t; 106 + dep_compile_layers : Fpath.t list; 107 + } 108 + let digest t = t.hash 109 + end 110 + 111 + module Value = Current.Unit 112 + 113 + let id = "day11-link" 114 + let pp f key = Fmt.pf f "link %s" (OpamPackage.to_string key.Key.pkg) 115 + let auto_cancel = false 116 + 117 + let build ctx _job key = 118 + match Day11_doc.Doc_build.link ctx.env ctx.benv 119 + ~config:ctx.config 120 + ~build_layer:key.build_layer 121 + ~compile_layer:key.compile_layer 122 + ~dep_compile_layers:key.dep_compile_layers 123 + ~html_dir:ctx.html_dir 124 + ~hash:key.hash key.pkg with 125 + | Ok () -> Lwt.return_ok () 126 + | Error msg -> Lwt.return_error (`Msg msg) 127 + end) 128 + 129 + (* ── Pipeline ──────────────────────────────────────────────────── *) 130 + 131 + (* The pipeline wires together: 132 + 1. Track opam-repo for changes 133 + 2. Solve all packages 134 + 3. Build all packages (fan out, DAG from deps) 135 + 4. Compile docs (fan out, DAG from compile deps) 136 + 5. Link docs (fan out, DAG from doc deps) 137 + 138 + OCurrent handles scheduling, caching, parallelism, and the web UI. *) 139 + 140 + let pipeline ~opam_repo ~config () = 141 + (* 1. Track opam-repository HEAD *) 142 + let repo = Current_git.Local.head_commit (Current.return opam_repo) in 143 + 144 + (* 2. Solve — produces a map from package to solve result *) 145 + let solutions = 146 + let+ commit = repo in 147 + let packages, repos_with_shas, env = 148 + Day11_opam.Git_packages.of_repositories [ (opam_repo, None) ] in 149 + (* Solve all packages in the small universe *) 150 + let targets = Day11_batch.Targets.resolve ~small:true packages None in 151 + List.filter_map (fun target -> 152 + match Day11_solver.Solve.solve ~packages ~env target with 153 + | Ok result -> Some (target, result) 154 + | Error _ -> None 155 + ) targets 156 + in 157 + 158 + (* 3. Build — each package becomes a Current.t of its build layer path *) 159 + let build_layers = 160 + let+ solutions = solutions in 161 + (* Compute the DAG and build all layers *) 162 + let cache = Day11_opam_build.Hash_cache.create () in 163 + let nodes = Day11_opam_build.Dag.build_dag cache 164 + ~base_hash:"..." solutions in 165 + (* Each node's hash is deterministic — use as cache key *) 166 + List.map (fun (node : Day11_opam_layer.Build.t) -> 167 + (node.pkg, node.hash, Build_cache.get ctx { pkg = node.pkg; hash = node.hash }) 168 + ) nodes 169 + in 170 + 171 + (* 4. Compile — each package's compile depends on its deps' compiles *) 172 + (* This is where the DAG emerges from Current.t dependencies *) 173 + let compile_layers = 174 + let+ build_layers = build_layers in 175 + List.map (fun (pkg, hash, build_layer) -> 176 + let dep_compiles = (* look up deps' compile layers *) in 177 + let+ build = build_layer 178 + and+ deps = Current.list_seq dep_compiles in 179 + Compile_cache.get ctx { 180 + pkg; hash = compile_hash; 181 + build_layer = build; 182 + dep_compile_layers = deps; 183 + } 184 + ) build_layers 185 + in 186 + 187 + (* 5. Link — depends on compile layer + doc-dep compile layers *) 188 + let _links = 189 + let+ compile_layers = compile_layers in 190 + List.map (fun (pkg, compile_layer, doc_dep_compiles) -> 191 + let+ compile = compile_layer 192 + and+ deps = Current.list_seq doc_dep_compiles in 193 + Link_cache.get ctx { 194 + pkg; hash = link_hash; 195 + build_layer = (* ... *); 196 + compile_layer = compile; 197 + dep_compile_layers = deps; 198 + } 199 + ) compile_layers 200 + in 201 + 202 + Current.return () 203 + 204 + 205 + (* ── Notes ─────────────────────────────────────────────────────── *) 206 + 207 + (* What OCurrent gives us for free: 208 + - Reactive: re-runs when opam-repo changes 209 + - Incremental: only rebuilds what changed (via cache key = layer hash) 210 + - Parallel: independent Current.t values run concurrently 211 + - Web UI: shows pipeline status, per-package progress 212 + - Error propagation: failed deps cascade automatically 213 + 214 + What day11 gives OCurrent: 215 + - Clean build primitives (Doc_build.compile/link/doc_all) 216 + - Content-addressed layer caching (layer hash = cache key) 217 + - Overlayfs stacking for efficient dep assembly 218 + - Deterministic hash computation (no post-hoc hash extraction) 219 + 220 + The key architectural win: OCurrent's cache digest IS the layer hash. 221 + No separate caching logic needed — the two systems align perfectly. 222 + 223 + What's NOT needed from day11 in this model: 224 + - dag_executor.ml (OCurrent does scheduling) 225 + - Profile/Snapshot (OCurrent pipeline IS the profile) 226 + - cmd_batch.ml (OCurrent replaces it) 227 + - Summary/Status_index (OCurrent web UI replaces it) 228 + 229 + What IS needed: 230 + - Day11_solver.Solve.solve 231 + - Day11_opam_build.Build_layer.build (or a cleaner primitive) 232 + - Day11_doc.Doc_build.compile/link/doc_all 233 + - Day11_layer.* (on-disk format) 234 + - Day11_container.* (runc execution) 235 + - Day11_runner.Run_in_layers.run (overlayfs assembly) 236 + *)

Configure Feed

Configure Feed