let dir_size path =
  let rec aux acc dir =
    let entries = try Sys.readdir dir with _ -> [||] in
    Array.fold_left (fun acc name ->
      let full = Filename.concat dir name in
      try
        let stat = Unix.lstat full in
        if stat.Unix.st_kind = Unix.S_DIR then aux (acc + stat.Unix.st_size) full
        else acc + stat.Unix.st_size
      with _ -> acc
    ) (acc + (try (Unix.lstat dir).Unix.st_size with _ -> 0)) entries
  in
  aux 0 path

let read_from_file filename = In_channel.with_open_text filename @@ fun ic -> In_channel.input_all ic
let write_to_file filename str = Out_channel.with_open_text filename @@ fun oc -> Out_channel.output_string oc str
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

(* Per-PID logging *)
let log_dir = ref None

let set_log_dir dir =
  log_dir := Some dir;
  if not (Sys.file_exists dir) then
    try Sys.mkdir dir 0o755 with _ -> ()

let log fmt =
  Printf.ksprintf (fun msg ->
    match !log_dir with
    | None -> () (* logging disabled *)
    | Some dir ->
        let pid = Unix.getpid () in
        let timestamp = Unix.gettimeofday () in
        let time_str =
          let tm = Unix.localtime timestamp in
          Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d.%03d"
            (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday
            tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec
            (int_of_float ((timestamp -. floor timestamp) *. 1000.))
        in
        let log_file = Filename.concat dir (Printf.sprintf "%d.log" pid) in
        let line = Printf.sprintf "[%s] %s\n" time_str msg in
        append_to_file log_file line
  ) fmt

let sudo ?stdout ?stderr cmd =
  log "exec: sudo %s" (String.concat " " cmd);
  let r = Sys.command (Filename.quote_command ?stdout ?stderr "sudo" cmd) in
  if r <> 0 then log "exec: sudo %s -> exit %d" (String.concat " " (List.filteri (fun i _ -> i < 3) cmd)) r;
  r

let exec ?stdout ?stderr cmd =
  log "exec: %s" (String.concat " " cmd);
  let r = Sys.command (Filename.quote_command ?stdout ?stderr (List.hd cmd) (List.tl cmd)) in
  if r <> 0 then log "exec: %s -> exit %d" (String.concat " " (List.filteri (fun i _ -> i < 3) cmd)) r;
  r

let retry_exec ?stdout ?stderr ?(tries = 10) cmd =
  let rec loop n =
    match (exec ?stdout ?stderr cmd, n) with
    | 0, _ -> 0
    | r, 0 -> r
    | _, n ->
        OpamConsole.note "retry %i: %s" (tries - n + 1) (String.concat " " cmd);
        Unix.sleepf (Random.float 2.0);
        loop (n - 1)
  in
  loop tries

let retry_rename ?(tries = 10) src dst =
  let rec loop n =
    try Unix.rename src dst with
    | Unix.Unix_error (Unix.EACCES, x, y) ->
        let d = tries - n + 1 in
        OpamConsole.note "retry_rename %i: %s -> %s" d src dst;
        Unix.sleep ((d * d) + Random.int d);
        if n = 1 then raise (Unix.Unix_error (Unix.EACCES, x, y)) else loop (n - 1)
  in
  loop tries

let run cmd =
  let inp = Unix.open_process_in cmd in
  let r = In_channel.input_all inp in
  In_channel.close inp;
  r

let nproc () = run "nproc" |> String.trim |> int_of_string

let rec mkdir ?(parents = false) dir =
  if not (Sys.file_exists dir) then (
    (if parents then
       let parent_dir = Filename.dirname dir in
       if parent_dir <> dir then mkdir ~parents:true parent_dir);
    try Sys.mkdir dir 0o755
    with Sys_error _ when Sys.file_exists dir && Sys.is_directory dir -> ())

(** Create a unique temporary directory. Unlike Filename.temp_dir, this includes
    the PID in the name to guarantee uniqueness across forked processes. *)
let temp_dir ?(perms = 0o700) ~parent_dir prefix suffix =
  let pid = Unix.getpid () in
  let rec try_create attempts =
    let rand = Random.int 0xFFFFFF in
    let name = Printf.sprintf "%s%d-%06x%s" prefix pid rand suffix in
    let path = Filename.concat parent_dir name in
    try
      Unix.mkdir path perms;
      path
    with Unix.Unix_error (Unix.EEXIST, _, _) ->
      if attempts > 0 then try_create (attempts - 1)
      else raise (Sys_error (path ^ ": File exists"))
  in
  try_create 100

let rec rm ?(recursive = false) path =
  try
    let stat = Unix.lstat path in
    match stat.st_kind with
    | S_REG
    | S_LNK
    | S_CHR
    | S_BLK
    | S_FIFO
    | S_SOCK -> (
        try Unix.unlink path with
        | Unix.Unix_error (Unix.EACCES, _, _) ->
            Unix.chmod path (stat.st_perm lor 0o222);
            Unix.unlink path)
    | S_DIR ->
        if recursive then Sys.readdir path |> Array.iter (fun f -> rm ~recursive (Filename.concat path f));
        Unix.rmdir path
  with
  | Unix.Unix_error (Unix.ENOENT, _, _) -> (
      try
        match Sys.is_directory path with
        | true -> Sys.rmdir path
        | false -> Sys.remove path
      with
      | _ -> ())

(** Remove a directory, using sudo if needed for root-owned files. *)
let sudo_rm_rf path =
  try rm ~recursive:true path with
  | Unix.Unix_error (Unix.EACCES, _, _)
  | Unix.Unix_error (Unix.EPERM, _, _) ->
      (* Files owned by root from container builds - use sudo *)
      ignore (sudo [ "rm"; "-rf"; path ])

(** Safely rename a temp directory to a target directory.
    Handles ENOTEMPTY which can occur if:
    1. Another worker already completed the target (marker_file exists) - just clean up src
    2. A previous crashed run left a stale target (no marker_file) - delete target and retry

    [marker_file] is the path to check if the target is complete (e.g., layer.json) *)
let safe_rename_dir ~marker_file src dst =
  try Unix.rename src dst with
  | Unix.Unix_error (Unix.ENOTEMPTY, _, _)
  | Unix.Unix_error (Unix.EEXIST, _, _) ->
      let dst_basename = Filename.basename dst in
      if Sys.file_exists marker_file then begin
        (* Target already complete by another worker - clean up our temp dir *)
        log "Target already exists, cleaning up temp: %s" dst_basename;
        sudo_rm_rf src
      end else begin
        (* Stale target from crashed run - remove it and retry *)
        log "Removing stale target: %s" dst_basename;
        sudo_rm_rf dst;
        Unix.rename src dst
      end

module IntSet = Set.Make (Int)

let fork ?np f lst =
  let nproc = Option.value ~default:(nproc ()) np in
  List.fold_left
    (fun acc x ->
      let acc =
        let rec loop acc =
          if IntSet.cardinal acc <= nproc then acc
          else
            let running, finished =
              IntSet.partition
                (fun pid ->
                  (try let c, _ = Unix.waitpid [ WNOHANG ] pid in pid <> c
                   with Unix.Unix_error (Unix.EINTR, _, _) -> true))
                acc
            in
            let () = if IntSet.is_empty finished then Unix.sleepf 0.1 in
            loop running
        in
        loop acc
      in
      match Unix.fork () with
      | 0 ->
          (* Reseed RNG after fork using PID to avoid temp directory collisions *)
          Random.init (Unix.getpid () lxor int_of_float (Unix.gettimeofday () *. 1000000.));
          f x;
          exit 0
      | child -> IntSet.add child acc)
    IntSet.empty lst
  |> IntSet.iter (fun pid -> ignore (Unix.waitpid [] pid))

(** Fork with progress callback. [on_complete status] is called each time a worker finishes.
    [status] is the exit code (0 = success, non-zero = failure). *)
let fork_with_progress ?np ~on_complete f lst =
  let nproc = Option.value ~default:(nproc ()) np in
  let status_of_wait = function
    | Unix.WEXITED c -> c
    | Unix.WSIGNALED _ | Unix.WSTOPPED _ -> -1
  in
  (* Try to reap finished processes, returning (still_running, exit_codes) *)
  let reap_finished pids =
    IntSet.fold (fun pid (running, codes) ->
      match Unix.waitpid [ WNOHANG ] pid with
      | c, status when c = pid -> (running, status_of_wait status :: codes)
      | _ -> (IntSet.add pid running, codes)
      | exception Unix.Unix_error (Unix.EINTR, _, _) -> (IntSet.add pid running, codes)
    ) pids (IntSet.empty, [])
  in
  List.fold_left
    (fun acc x ->
      let acc =
        let rec loop acc =
          if IntSet.cardinal acc <= nproc then acc
          else
            let running, codes = reap_finished acc in
            List.iter on_complete codes;
            let () = if codes = [] then Unix.sleepf 0.1 in
            loop running
        in
        loop acc
      in
      match Unix.fork () with
      | 0 ->
          (* Reseed RNG after fork using PID to avoid temp directory collisions *)
          Random.init (Unix.getpid () lxor int_of_float (Unix.gettimeofday () *. 1000000.));
          (try f x with exn ->
             Printf.eprintf "Worker exception: %s\n%!" (Printexc.to_string exn);
             exit 1);
          exit 0
      | child -> IntSet.add child acc)
    IntSet.empty lst
  |> fun remaining ->
       (* Wait for all remaining processes *)
       IntSet.iter (fun pid ->
         let _, status = Unix.waitpid [] pid in
         on_complete (status_of_wait status)
       ) remaining

(** Fork processes to run function on list items in parallel, collecting results.
    Each process writes its result to a temp file, parent collects after all complete.
    Returns list of (input, result option) pairs in original order. *)
let fork_map ?np ~temp_dir ~serialize ~deserialize f lst =
  let nproc = Option.value ~default:(nproc ()) np in
  let indexed = List.mapi (fun i x -> (i, x)) lst in
  (* Fork processes *)
  let pids = List.fold_left
    (fun acc (i, x) ->
      let acc =
        let rec loop acc =
          if IntSet.cardinal acc <= nproc then acc
          else
            let running, finished =
              IntSet.partition
                (fun pid ->
                  (try let c, _ = Unix.waitpid [ WNOHANG ] pid in pid <> c
                   with Unix.Unix_error (Unix.EINTR, _, _) -> true))
                acc
            in
            let () = if IntSet.is_empty finished then Unix.sleepf 0.1 in
            loop running
        in
        loop acc
      in
      match Unix.fork () with
      | 0 ->
          (* Reseed RNG after fork using PID to avoid temp directory collisions *)
          Random.init (Unix.getpid () lxor int_of_float (Unix.gettimeofday () *. 1000000.));
          let result = f x in
          let result_file = Filename.concat temp_dir (string_of_int i) in
          (match result with
           | Some r -> write_to_file result_file (serialize r)
           | None -> ());
          exit 0
      | child -> IntSet.add child acc)
    IntSet.empty indexed
  in
  IntSet.iter (fun pid ->
    let rec wait () =
      try ignore (Unix.waitpid [] pid)
      with Unix.Unix_error (Unix.EINTR, _, _) -> wait ()
    in
    wait ()
  ) pids;
  (* Collect results *)
  List.map (fun (i, x) ->
    let result_file = Filename.concat temp_dir (string_of_int i) in
    let result =
      if Sys.file_exists result_file then
        Some (deserialize (read_from_file result_file))
      else
        None
    in
    (x, result)
  ) indexed

(** Lock info for tracking active builds/docs/tools.
    When provided, locks are created in a central directory with descriptive names. *)
type lock_info = {
  cache_dir : string;
  stage : [`Build | `Doc | `Tool];
  package : string;
  version : string;
  universe : string option;  (* For Build/Doc: dependency hash. For Tool: OCaml version if applicable *)
  layer_name : string option;  (* The final layer directory name, for finding logs after completion *)
}

(** Generate lock filename from lock info *)
let lock_filename info =
  match info.stage, info.universe with
  | `Build, Some u -> Printf.sprintf "build-%s.%s-%s.lock" info.package info.version u
  | `Build, None -> Printf.sprintf "build-%s.%s.lock" info.package info.version
  | `Doc, Some u -> Printf.sprintf "doc-%s.%s-%s.lock" info.package info.version u
  | `Doc, None -> Printf.sprintf "doc-%s.%s.lock" info.package info.version
  | `Tool, Some ocaml_ver -> Printf.sprintf "tool-%s-%s.lock" info.package ocaml_ver
  | `Tool, None -> Printf.sprintf "tool-%s.lock" info.package

(** Get or create locks directory *)
let locks_dir cache_dir =
  let dir = Path.(cache_dir / "locks") in
  if not (Sys.file_exists dir) then
    (try Unix.mkdir dir 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
  dir

let create_directory_exclusively ?marker_file ?lock_info dir_name write_function =
  (* Determine lock file location based on whether lock_info is provided *)
  let lock_file = match lock_info with
    | Some info -> Path.(locks_dir info.cache_dir / lock_filename info)
    | None -> dir_name ^ ".lock"
  in
  let lock_fd = Unix.openfile lock_file [ O_CREAT; O_RDWR ] 0o644 in
  let dir_basename = Filename.basename dir_name in
  (* Try non-blocking lock first to detect contention *)
  let got_lock_immediately =
    try Unix.lockf lock_fd F_TLOCK 0; true with
    | Unix.Unix_error (Unix.EAGAIN, _, _)
    | Unix.Unix_error (Unix.EACCES, _, _) -> false
    | Unix.Unix_error (Unix.EINTR, _, _) -> false
  in
  if not got_lock_immediately then begin
    log "Waiting for lock: %s" dir_basename;
    (* Retry lockf on EINTR (interrupted by signal) *)
    let rec lock_with_retry () =
      try Unix.lockf lock_fd F_LOCK 0 with
      | Unix.Unix_error (Unix.EINTR, _, _) -> lock_with_retry ()
    in
    lock_with_retry ();
    log "Acquired lock: %s" dir_basename
  end;
  (* Write lock metadata for monitoring:
     Line 1: PID
     Line 2: start time
     Line 3: layer name (for finding logs after completion)
     Line 4: temp log path (updated by write_function for live logs) *)
  let layer_name = match lock_info with
    | Some info -> Option.value ~default:"" info.layer_name
    | None -> ""
  in
  let write_metadata ?temp_log_path () =
    match lock_info with
    | Some _ ->
        let temp_log = Option.value ~default:"" temp_log_path in
        let metadata = Printf.sprintf "%d\n%.0f\n%s\n%s\n" (Unix.getpid ()) (Unix.time ()) layer_name temp_log in
        ignore (Unix.lseek lock_fd 0 Unix.SEEK_SET);
        ignore (Unix.ftruncate lock_fd 0);
        ignore (Unix.write_substring lock_fd metadata 0 (String.length metadata))
    | None -> ()
  in
  write_metadata ();
  (* Callback for write_function to update the temp log path for live viewing *)
  let set_temp_log_path path = write_metadata ~temp_log_path:path () in
  (* Check marker_file if provided, otherwise check directory existence *)
  let already_complete = match marker_file with
    | Some f -> Sys.file_exists f
    | None -> Sys.file_exists dir_name
  in
  if not already_complete then begin
    log "Building: %s" dir_basename;
    write_function ~set_temp_log_path dir_name;
    log "Completed: %s" dir_basename
  end;
  Unix.close lock_fd;
  (* Only delete lock file if no lock_info (old behavior) -
     with lock_info, we keep the file for stale cleanup later *)
  (match lock_info with
   | None -> (try Unix.unlink lock_file with _ -> ())
   | Some _ -> ())

exception Copy_error of string

let cp ?(buffer_size = 65536) ?(preserve_permissions = true) ?(preserve_times = true) src dst =
  let safe_close fd =
    try Unix.close fd with
    | _ -> ()
  in
  let src_stats =
    try Unix.stat src with
    | Unix.Unix_error (err, _, _) -> raise (Copy_error (Printf.sprintf "Cannot stat source file '%s': %s" src (Unix.error_message err)))
  in
  if src_stats.st_kind <> S_REG then raise (Copy_error (Printf.sprintf "Source '%s' is not a regular file" src));
  let src_fd =
    try Unix.openfile src [ O_RDONLY ] 0 with
    | Unix.Unix_error (err, _, _) -> raise (Copy_error (Printf.sprintf "Cannot open source file '%s': %s" src (Unix.error_message err)))
  in
  let dst_fd =
    try Unix.openfile dst [ O_WRONLY; O_CREAT; O_TRUNC ] src_stats.st_perm with
    | Unix.Unix_error (err, _, _) ->
        safe_close src_fd;
        raise (Copy_error (Printf.sprintf "Cannot open destination file '%s': %s" dst (Unix.error_message err)))
  in
  let buffer = Bytes.create buffer_size in
  let rec copy_loop () =
    try
      match Unix.read src_fd buffer 0 buffer_size with
      | 0 -> ()
      | bytes_read ->
          let rec write_all pos remaining =
            if remaining > 0 then
              let bytes_written = Unix.write dst_fd buffer pos remaining in
              write_all (pos + bytes_written) (remaining - bytes_written)
          in
          write_all 0 bytes_read;
          copy_loop ()
    with
    | Unix.Unix_error (err, _, _) ->
        safe_close src_fd;
        safe_close dst_fd;
        raise (Copy_error (Printf.sprintf "Error during copy: %s" (Unix.error_message err)))
  in
  copy_loop ();
  safe_close src_fd;
  safe_close dst_fd;
  (if preserve_permissions then
     try Unix.chmod dst src_stats.st_perm with
     | Unix.Unix_error (err, _, _) -> Printf.eprintf "Warning: Could not preserve permissions: %s\n" (Unix.error_message err));
  if preserve_times then
    try Unix.utimes dst src_stats.st_atime src_stats.st_mtime with
    | Unix.Unix_error (err, _, _) -> Printf.eprintf "Warning: Could not preserve timestamps: %s\n" (Unix.error_message err)

let hardlink_tree ~source ~target =
  let rec process_directory current_source current_target =
    let entries = Sys.readdir current_source in
    Array.iter
      (fun entry ->
        let source = Filename.concat current_source entry in
        let target = Filename.concat current_target entry in
        try
          let stat = Unix.lstat source in
          match stat.st_kind with
          | S_LNK -> if not (Sys.file_exists target) then Unix.symlink (Unix.readlink source) target
          | S_REG -> if not (Sys.file_exists target) then Unix.link source target
          | S_DIR ->
              mkdir target;
              process_directory source target
          | S_CHR
          | S_BLK
          | S_FIFO
          | S_SOCK ->
              ()
        with
        | Unix.Unix_error (Unix.EMLINK, _, _) -> cp source target
        | Unix.Unix_error (err, _, _) -> Printf.eprintf "Warning: %s -> %s = %s\n" source target (Unix.error_message err))
      entries
  in
  process_directory source target

let clense_tree ~source ~target =
  let rec process_directory current_source current_target =
    let entries = Sys.readdir current_source in
    Array.iter
      (fun entry ->
        let source = Filename.concat current_source entry in
        let target = Filename.concat current_target entry in
        try
          let src_stat = Unix.lstat source in
          match src_stat.st_kind with
          | Unix.S_LNK -> if Sys.file_exists target then if Unix.readlink source = Unix.readlink target then Unix.unlink target
          | Unix.S_REG ->
              if Sys.file_exists target then
                let tgt_stat = Unix.lstat target in
                if src_stat.st_mtime = tgt_stat.st_mtime then (
                  try Unix.unlink target with
                  | Unix.Unix_error (Unix.EACCES, _, _) ->
                      Unix.chmod target (src_stat.st_perm lor 0o222);
                      Unix.unlink target)
          | Unix.S_DIR -> (
              process_directory source target;
              try
                if Sys.file_exists target then
                  let target_entries = Sys.readdir target in
                  if Array.length target_entries = 0 then Unix.rmdir target
              with
              | Unix.Unix_error (err, _, _) -> Printf.eprintf "Warning: rmdir %s = %s\n" target (Unix.error_message err))
          | S_CHR
          | S_BLK
          | S_FIFO
          | S_SOCK ->
              ()
        with
        | Unix.Unix_error (err, _, _) -> Printf.eprintf "Warning: unlink %s = %s\n" target (Unix.error_message err))
      entries
  in
  process_directory source target

let copy_tree ~source ~target =
  let rec process_directory current_source current_target =
    let entries = Sys.readdir current_source in
    Array.iter
      (fun entry ->
        let source = Filename.concat current_source entry in
        let target = Filename.concat current_target entry in
        try
          let stat = Unix.lstat source in
          match stat.st_kind with
          | S_LNK -> if not (Sys.file_exists target) then Unix.symlink (Unix.readlink source) target
          | S_REG -> if not (Sys.file_exists target) then cp source target
          | S_DIR ->
              mkdir target;
              process_directory source target
          | S_CHR
          | S_BLK
          | S_FIFO
          | S_SOCK ->
              ()
        with
        | Copy_error _ ->
            Printf.eprintf "Warning: hard linking %s -> %s\n" source target;
            Unix.link source target
        | Unix.Unix_error (err, _, _) -> Printf.eprintf "Warning: %s -> %s = %s\n" source target (Unix.error_message err))
      entries
  in
  process_directory source target

let ls ?extn dir =
  try
    let files = Sys.readdir dir |> Array.to_list |> List.map (Filename.concat dir) in
    match extn with
    | None -> files
    | Some ext ->
        let ext = if ext <> "" && ext.[0] = '.' then ext else "." ^ ext in
        List.filter (fun f -> Filename.check_suffix f ext) files
  with
  | Sys_error _ -> []

(** Atomic directory swap for graceful degradation.

    This module provides atomic swap operations for documentation directories,
    implementing the "fresh docs with graceful degradation" pattern:
    - Write new docs to a staging directory ([dir.new])
    - On success, atomically swap: old -> [.old], new -> current, remove [.old]
    - On failure, leave original docs untouched

    Recovery: On startup, clean up any stale .new or .old directories left
    from interrupted swaps. *)

module Atomic_swap = struct
  (** Clean up stale .new and .old directories from interrupted swaps.
      Call this on startup before processing packages. *)
  let cleanup_stale_dirs ~html_dir =
    let p_dir = Filename.concat html_dir "p" in
    if Sys.file_exists p_dir && Sys.is_directory p_dir then begin
      try
        Sys.readdir p_dir |> Array.iter (fun pkg_name ->
          let pkg_dir = Filename.concat p_dir pkg_name in
          if Sys.is_directory pkg_dir then begin
            try
              Sys.readdir pkg_dir |> Array.iter (fun version_dir ->
                (* Clean up .new directories - incomplete writes *)
                if Filename.check_suffix version_dir ".new" then begin
                  let stale_new = Filename.concat pkg_dir version_dir in
                  log "Cleaning up stale .new directory: %s" stale_new;
                  sudo_rm_rf stale_new
                end
                (* Clean up .old directories - incomplete swap *)
                else if Filename.check_suffix version_dir ".old" then begin
                  let stale_old = Filename.concat pkg_dir version_dir in
                  log "Cleaning up stale .old directory: %s" stale_old;
                  sudo_rm_rf stale_old
                end
              )
            with _ -> ()
          end
        )
      with _ -> ()
    end;
    (* Also clean up universe directories *)
    let u_dir = Filename.concat html_dir "u" in
    if Sys.file_exists u_dir && Sys.is_directory u_dir then begin
      try
        Sys.readdir u_dir |> Array.iter (fun universe_hash ->
          let universe_dir = Filename.concat u_dir universe_hash in
          if Sys.is_directory universe_dir then begin
            try
              Sys.readdir universe_dir |> Array.iter (fun pkg_name ->
                let pkg_dir = Filename.concat universe_dir pkg_name in
                if Sys.is_directory pkg_dir then begin
                  try
                    Sys.readdir pkg_dir |> Array.iter (fun version_dir ->
                      if Filename.check_suffix version_dir ".new" then begin
                        let stale_new = Filename.concat pkg_dir version_dir in
                        log "Cleaning up stale .new directory: %s" stale_new;
                        sudo_rm_rf stale_new
                      end
                      else if Filename.check_suffix version_dir ".old" then begin
                        let stale_old = Filename.concat pkg_dir version_dir in
                        log "Cleaning up stale .old directory: %s" stale_old;
                        sudo_rm_rf stale_old
                      end
                    )
                  with _ -> ()
                end
              )
            with _ -> ()
          end
        )
      with _ -> ()
    end

  (** Get paths for atomic swap operations.
      Returns (staging_dir, final_dir, old_dir) where:
      - staging_dir: {version}.new - where new docs are written
      - final_dir: {version} - the live docs location
      - old_dir: {version}.old - backup during swap *)
  let get_swap_paths ~html_dir ~pkg ~version ~blessed ~universe =
    let base_dir =
      if blessed then
        Filename.concat (Filename.concat html_dir "p") pkg
      else
        Filename.concat (Filename.concat (Filename.concat html_dir "u") universe) pkg
    in
    let final_dir = Filename.concat base_dir version in
    let staging_dir = final_dir ^ ".new" in
    let old_dir = final_dir ^ ".old" in
    (staging_dir, final_dir, old_dir)

  (** Prepare staging directory for a package.
      Creates the .new directory for doc generation.
      Returns the staging path. *)
  let prepare_staging ~html_dir ~pkg ~version ~blessed ~universe =
    let staging_dir, _, _ = get_swap_paths ~html_dir ~pkg ~version ~blessed ~universe in
    (* Remove any existing .new directory from failed previous attempt *)
    if Sys.file_exists staging_dir then sudo_rm_rf staging_dir;
    (* Create the staging directory structure *)
    mkdir ~parents:true staging_dir;
    staging_dir

  (** Commit staging to final location atomically.
      Performs the swap: final -> .old, staging -> final, remove .old
      Returns true on success, false on failure. *)
  let commit ~html_dir ~pkg ~version ~blessed ~universe =
    let staging_dir, final_dir, old_dir = get_swap_paths ~html_dir ~pkg ~version ~blessed ~universe in
    if not (Sys.file_exists staging_dir) then begin
      log "commit: staging directory does not exist: %s" staging_dir;
      false
    end else begin
      log "commit: swapping %s -> %s" staging_dir final_dir;
      (* Step 1: If final exists, move to .old *)
      let has_existing = Sys.file_exists final_dir in
      (if has_existing then begin
        (* Remove any stale .old first *)
        if Sys.file_exists old_dir then sudo_rm_rf old_dir;
        try Unix.rename final_dir old_dir with
        | Unix.Unix_error (err, _, _) ->
            log "commit: failed to rename %s to %s: %s" final_dir old_dir (Unix.error_message err);
            raise Exit
      end);
      (* Step 2: Move staging to final *)
      (try Unix.rename staging_dir final_dir with
       | Unix.Unix_error (err, _, _) ->
           log "commit: failed to rename %s to %s: %s" staging_dir final_dir (Unix.error_message err);
           (* Try to restore old if we moved it *)
           if has_existing && Sys.file_exists old_dir then begin
             try Unix.rename old_dir final_dir with _ -> ()
           end;
           raise Exit);
      (* Step 3: Remove .old backup *)
      if has_existing && Sys.file_exists old_dir then
        sudo_rm_rf old_dir;
      log "commit: successfully swapped docs for %s/%s" pkg version;
      true
    end

  (** Rollback staging on failure.
      Removes the .new directory, leaving original docs intact. *)
  let rollback ~html_dir ~pkg ~version ~blessed ~universe =
    let staging_dir, _, _ = get_swap_paths ~html_dir ~pkg ~version ~blessed ~universe in
    if Sys.file_exists staging_dir then begin
      log "rollback: removing staging directory %s" staging_dir;
      sudo_rm_rf staging_dir
    end
end