Add rerun, rdeps, and notify commands to day10 CLI

+181 -1

day10/bin/main.ml

··· 2212 2212 let disk_info = Cmd.info "disk" ~doc:"Show disk usage breakdown" in 2213 2213 Cmd.v disk_info disk_term 2214 2214 2215 + let run_rerun ~cache_dir ~format ~arch ~os ~os_distribution ~os_family ~os_version ~opam_repositories ~force ~target = 2216 + let os_key = Printf.sprintf "%s-%s-%s" os_distribution os_version arch in 2217 + let packages_dir = Path.(cache_dir / os_key / "packages") in 2218 + (* Determine if target is a build hash or package name *) 2219 + let is_hash = String.length target > 6 && String.sub target 0 6 = "build-" in 2220 + let builds_to_rerun = 2221 + if is_hash then begin 2222 + (* Read layer.json to get package name *) 2223 + let layer_json = Path.(cache_dir / os_key / target / "layer.json") in 2224 + if not (Sys.file_exists layer_json) then begin 2225 + Printf.eprintf "Build layer %s not found\n%!" target; 2226 + Stdlib.exit 1 2227 + end; 2228 + let json = Yojson.Safe.from_file layer_json in 2229 + let pkg_name = Yojson.Safe.Util.(json |> member "package" |> to_string) in 2230 + [(pkg_name, target)] 2231 + end else begin 2232 + (* Package name: find all failing builds *) 2233 + let entries = Day10_lib.History.read_latest ~packages_dir ~pkg_str:target in 2234 + let failing = List.filter (fun (e : Day10_lib.History.entry) -> e.status = "failure") entries in 2235 + if failing = [] then begin 2236 + Printf.eprintf "No failing builds for %s\n%!" target; 2237 + Stdlib.exit 1 2238 + end; 2239 + List.map (fun (e : Day10_lib.History.entry) -> (target, e.build_hash)) failing 2240 + end 2241 + in 2242 + if format = "json" then begin 2243 + let results = List.map (fun (pkg_name, build_hash) -> 2244 + `Assoc [("package", `String pkg_name); ("build_hash", `String build_hash); ("action", `String "rerun")] 2245 + ) builds_to_rerun in 2246 + print_string (Yojson.Safe.pretty_to_string (`List results)); 2247 + print_newline () 2248 + end else begin 2249 + List.iter (fun (pkg_name, build_hash) -> 2250 + Printf.printf "Rerunning %s (build %s)%s\n%!" pkg_name build_hash 2251 + (if force then " [force]" else ""); 2252 + if force then begin 2253 + let layer_dir = Path.(cache_dir / os_key / build_hash) in 2254 + if Sys.file_exists layer_dir then begin 2255 + Printf.printf " Removing cached layer %s\n%!" build_hash; 2256 + let _ = Os.sudo ["rm"; "-rf"; layer_dir] in () 2257 + end 2258 + end; 2259 + (* Re-invoke build via run_health_check *) 2260 + let ocaml_version = None in 2261 + run_health_check { dir = cache_dir; ocaml_version; opam_repositories; package = pkg_name; 2262 + arch; os; os_distribution; os_family; os_version; 2263 + directory = None; md = None; json = None; dot = None; 2264 + with_test = false; with_doc = true; with_jtw = false; 2265 + doc_tools_repo = "https://github.com/ocaml/odoc.git"; doc_tools_branch = "master"; 2266 + jtw_tools_repo = ""; jtw_tools_branch = ""; 2267 + local_repos = []; html_output = None; jtw_output = None; tag = None; 2268 + log = false; dry_run = false; fork = None; prune_layers = false; blessed_map = None } 2269 + ) builds_to_rerun 2270 + end 2271 + 2272 + let rerun_cmd = 2273 + let target_arg = 2274 + let doc = "Build hash or package name to rerun" in 2275 + Arg.(required & pos 0 (some string) None & info [] ~docv:"TARGET" ~doc) 2276 + in 2277 + let force_term = 2278 + let doc = "Force rerun by removing cached layers first" in 2279 + Arg.(value & flag & info [ "force" ] ~doc) 2280 + in 2281 + let rerun_term = 2282 + Term.(const (fun cache_dir format arch os os_distribution os_family os_version opam_repositories force target -> 2283 + run_rerun ~cache_dir ~format ~arch ~os ~os_distribution ~os_family ~os_version ~opam_repositories ~force ~target) 2284 + $ cache_dir_term $ format_term $ arch_term $ os_term $ os_distribution_term $ os_family_term $ os_version_term $ opam_repository_term $ force_term $ target_arg) 2285 + in 2286 + let rerun_info = Cmd.info "rerun" ~doc:"Retry a failed build" in 2287 + Cmd.v rerun_info rerun_term 2288 + 2289 + let run_rdeps ~cache_dir ~format ~arch ~os_distribution ~os_version ~failing_only ~package = 2290 + let os_key = Printf.sprintf "%s-%s-%s" os_distribution os_version arch in 2291 + let packages_dir = Path.(cache_dir / os_key / "packages") in 2292 + let solutions_dir = Path.(cache_dir / "solutions") in 2293 + (* Scan all cached solutions to build reverse dep map *) 2294 + let rdeps = Hashtbl.create 256 in 2295 + (try 2296 + Sys.readdir solutions_dir |> Array.iter (fun sha_dir -> 2297 + let sha_path = Path.(solutions_dir / sha_dir) in 2298 + if Sys.is_directory sha_path then 2299 + try 2300 + Sys.readdir sha_path |> Array.iter (fun sol_file -> 2301 + if Filename.check_suffix sol_file ".json" then 2302 + try 2303 + let json = Yojson.Safe.from_file Path.(sha_path / sol_file) in 2304 + let open Yojson.Safe.Util in 2305 + (* Check if this solution contains the target package as a dependency *) 2306 + let pkg_str = json |> member "package" |> to_string in 2307 + let solution = json |> member "solution" in 2308 + let dep_keys = solution |> keys in 2309 + (* Solution keys are "name.version" format; check if any dep's name matches *) 2310 + let has_dep = List.exists (fun dep_key -> 2311 + (* Extract package name from "name.version" *) 2312 + match OpamPackage.of_string_opt dep_key with 2313 + | Some pkg -> String.equal (OpamPackage.Name.to_string (OpamPackage.name pkg)) package 2314 + | None -> String.equal dep_key package 2315 + ) dep_keys in 2316 + if has_dep then begin 2317 + (* Extract just the package name from pkg_str *) 2318 + let rdep_name = match OpamPackage.of_string_opt pkg_str with 2319 + | Some pkg -> OpamPackage.Name.to_string (OpamPackage.name pkg) 2320 + | None -> pkg_str 2321 + in 2322 + if not (Hashtbl.mem rdeps rdep_name) then 2323 + Hashtbl.add rdeps rdep_name true 2324 + end 2325 + with _ -> () 2326 + ) 2327 + with _ -> () 2328 + ) 2329 + with _ -> ()); 2330 + let rdep_list = Hashtbl.fold (fun k _ acc -> k :: acc) rdeps [] |> List.sort String.compare in 2331 + let rdep_list = 2332 + if failing_only then 2333 + List.filter (fun pkg -> 2334 + let entries = Day10_lib.History.read_latest ~packages_dir ~pkg_str:pkg in 2335 + List.exists (fun (e : Day10_lib.History.entry) -> 2336 + e.status = "failure" && e.category = "dependency_failure" 2337 + ) entries 2338 + ) rdep_list 2339 + else rdep_list 2340 + in 2341 + if format = "json" then begin 2342 + print_string (Yojson.Safe.pretty_to_string (`List (List.map (fun s -> `String s) rdep_list))); 2343 + print_newline () 2344 + end else begin 2345 + Printf.printf "Reverse dependencies of %s: %d\n" package (List.length rdep_list); 2346 + List.iter (fun pkg -> Printf.printf " %s\n" pkg) rdep_list 2347 + end 2348 + 2349 + let rdeps_cmd = 2350 + let package_arg = 2351 + let doc = "Package name to find reverse dependencies for" in 2352 + Arg.(required & pos 0 (some string) None & info [] ~docv:"PACKAGE" ~doc) 2353 + in 2354 + let failing_term = 2355 + let doc = "Only show reverse dependencies currently in dependency_failure" in 2356 + Arg.(value & flag & info [ "failing" ] ~doc) 2357 + in 2358 + let rdeps_term = 2359 + Term.(const (fun cache_dir format arch _os os_distribution os_version failing_only package -> 2360 + run_rdeps ~cache_dir ~format ~arch ~os_distribution ~os_version ~failing_only ~package) 2361 + $ cache_dir_term $ format_term $ arch_term $ os_term $ os_distribution_term $ os_version_term $ failing_term $ package_arg) 2362 + in 2363 + let rdeps_info = Cmd.info "rdeps" ~doc:"Reverse dependency lookup from cached solutions" in 2364 + Cmd.v rdeps_info rdeps_term 2365 + 2366 + let run_notify ~channel ~message = 2367 + let ch = Day10_lib.Notify.channel_of_string channel in 2368 + let result = Day10_lib.Notify.send ~channel:ch ~message in 2369 + if result <> 0 then 2370 + Printf.eprintf "Notification failed (exit %d)\n%!" result; 2371 + Stdlib.exit result 2372 + 2373 + let notify_cmd = 2374 + let channel_term = 2375 + let doc = "Notification channel (slack, zulip, telegram, email, stdout)" in 2376 + Arg.(required & opt (some string) None & info [ "channel" ] ~docv:"CHANNEL" ~doc) 2377 + in 2378 + let message_term = 2379 + let doc = "Message to send" in 2380 + Arg.(required & opt (some string) None & info [ "message" ] ~docv:"TEXT" ~doc) 2381 + in 2382 + let notify_term = 2383 + Term.(const (fun channel message -> run_notify ~channel ~message) 2384 + $ channel_term $ message_term) 2385 + in 2386 + let notify_info = Cmd.info "notify" ~doc:"Send a notification via configured channel" in 2387 + Cmd.v notify_info notify_term 2388 + 2215 2389 let main_info = 2216 2390 let doc = "A tool for running CI and health checks" in 2217 2391 let man = ··· 2230 2404 `P "Use '$(mname) failures' to list failing packages."; 2231 2405 `P "Use '$(mname) changes' to show status transitions since last run."; 2232 2406 `P "Use '$(mname) disk' to show disk usage breakdown."; 2407 + `P "Use '$(mname) rerun TARGET' to retry a failed build (by hash or package name)."; 2408 + `P "Use '$(mname) rdeps PACKAGE' to find reverse dependencies from cached solutions."; 2409 + `P "Use '$(mname) notify --channel CHANNEL --message TEXT' to send a notification."; 2233 2410 `P "Add --md flag to output results in markdown format."; 2234 2411 `S Manpage.s_examples; 2235 2412 `P "$(mname) ci --cache-dir /tmp/cache --opam-repository /tmp/opam-repository /path/to/project"; ··· 2239 2416 `P "$(mname) list --opam-repositories /tmp/opam-repository"; 2240 2417 `P "$(mname) sync-docs --cache-dir /tmp/cache /var/www/docs --index"; 2241 2418 `P "$(mname) sync-docs --cache-dir /tmp/cache user@host:/var/www/docs"; 2419 + `P "$(mname) rerun --cache-dir /tmp/cache --opam-repository /tmp/opam-repository my-package"; 2420 + `P "$(mname) rdeps --cache-dir /tmp/cache my-package"; 2421 + `P "$(mname) notify --channel stdout --message 'Build complete'"; 2242 2422 ] 2243 2423 in 2244 2424 Cmd.info "day10" ~version:"0.0.1" ~doc ~man 2245 2425 2246 2426 let () = 2247 2427 let default_term = Term.(ret (const (`Help (`Pager, None)))) in 2248 - 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 ] in 2428 + 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; notify_cmd ] in 2249 2429 exit (Cmd.eval cmd)

+1 -1

day10/lib/dune

··· 2 2 (name day10_lib) 3 3 (enabled_if (>= %{ocaml_version} 5.3.0)) 4 4 (libraries unix str yojson) 5 - (modules atomic_swap build_lock gc history progress run_log status_index)) 5 + (modules atomic_swap build_lock gc history notify progress run_log status_index))

+66

day10/lib/notify.ml

··· 1 + type channel = Slack | Zulip | Telegram | Email | Stdout 2 + 3 + let channel_of_string = function 4 + | "slack" -> Slack 5 + | "zulip" -> Zulip 6 + | "telegram" -> Telegram 7 + | "email" -> Email 8 + | "stdout" -> Stdout 9 + | s -> failwith (Printf.sprintf "Unknown channel: %s" s) 10 + 11 + let channel_to_string = function 12 + | Slack -> "slack" 13 + | Zulip -> "zulip" 14 + | Telegram -> "telegram" 15 + | Email -> "email" 16 + | Stdout -> "stdout" 17 + 18 + let env key = 19 + try Sys.getenv key 20 + with Not_found -> failwith (Printf.sprintf "Environment variable %s not set" key) 21 + 22 + let run_curl args = 23 + let cmd = String.concat " " ("curl" :: "-s" :: "-o" :: "/dev/null" :: "-w" :: "'%{http_code}'" :: args) in 24 + let ic = Unix.open_process_in cmd in 25 + let output = try input_line ic with End_of_file -> "" in 26 + match Unix.close_process_in ic with 27 + | Unix.WEXITED 0 -> 28 + let code = try int_of_string (String.trim output |> fun s -> 29 + (* Remove surrounding quotes if present *) 30 + if String.length s >= 2 && s.[0] = '\'' then String.sub s 1 (String.length s - 2) else s 31 + ) with _ -> 0 in 32 + if code >= 200 && code < 300 then 0 else 1 33 + | _ -> 1 34 + 35 + let send ~channel ~message = 36 + match channel with 37 + | Stdout -> 38 + print_endline message; 0 39 + | Slack -> 40 + let url = env "SLACK_WEBHOOK_URL" in 41 + let escaped = String.concat "\\\"" (String.split_on_char '"' message) in 42 + run_curl ["-X"; "POST"; "-H"; "'Content-type: application/json'"; 43 + "-d"; Printf.sprintf "'{\"text\":\"%s\"}'" escaped; url] 44 + | Zulip -> 45 + let email = env "ZULIP_BOT_EMAIL" in 46 + let api_key = env "ZULIP_BOT_API_KEY" in 47 + let server = env "ZULIP_SERVER" in 48 + let stream = env "ZULIP_STREAM" in 49 + run_curl ["-u"; Printf.sprintf "%s:%s" email api_key; 50 + "-X"; "POST"; Printf.sprintf "%s/api/v1/messages" server; 51 + "-d"; Printf.sprintf "'type=stream&to=%s&topic=day10&content=%s'" stream message] 52 + | Telegram -> 53 + let token = env "TELEGRAM_BOT_TOKEN" in 54 + let chat_id = env "TELEGRAM_CHAT_ID" in 55 + let escaped = String.concat "\\\"" (String.split_on_char '"' message) in 56 + run_curl ["-X"; "POST"; 57 + Printf.sprintf "'https://api.telegram.org/bot%s/sendMessage'" token; 58 + "-d"; Printf.sprintf "'chat_id=%s&text=%s'" chat_id escaped] 59 + | Email -> 60 + let to_addr = env "EMAIL_TO" in 61 + let from_addr = env "EMAIL_FROM" in 62 + let cmd = Printf.sprintf "echo %s | mail -s 'Day10 Notification' -r %s %s" 63 + (Filename.quote message) from_addr to_addr in 64 + match Unix.system cmd with 65 + | Unix.WEXITED 0 -> 0 66 + | _ -> 1

+15

day10/lib/notify.mli

··· 1 + (** Pluggable notification system. *) 2 + 3 + type channel = Slack | Zulip | Telegram | Email | Stdout 4 + 5 + val channel_of_string : string -> channel 6 + val channel_to_string : channel -> string 7 + 8 + (** Send a message via the given channel. 9 + Channel-specific config from environment variables: 10 + - SLACK_WEBHOOK_URL 11 + - ZULIP_BOT_EMAIL, ZULIP_BOT_API_KEY, ZULIP_SERVER, ZULIP_STREAM 12 + - TELEGRAM_BOT_TOKEN, TELEGRAM_CHAT_ID 13 + - EMAIL_TO, EMAIL_FROM (uses sendmail) 14 + Returns 0 on success, non-zero on failure. *) 15 + val send : channel:channel -> message:string -> int