unikernel/duniverse/dune_/bin/pkg/lock.ml

@@ -0,0 +1,380 @@
+open Dune_config
+open Import
+open Pkg_common
+module Package_version = Dune_pkg.Package_version
+module Opam_repo = Dune_pkg.Opam_repo
+module Lock_dir = Dune_pkg.Lock_dir
+module Pin_stanza = Dune_lang.Pin_stanza
+module Pin = Dune_pkg.Pin
+
+module Progress_indicator = struct
+  module Per_lockdir = struct
+    module State = struct
+      module Repository = Dune_pkg.Pkg_workspace.Repository
+
+      type t =
+        | Updating_repos of Repository.Name.t list
+        | Solving
+
+      let pp = function
+        | Updating_repos repo_names ->
+          Pp.textf
+            "Updating package repos %s..."
+            (List.map repo_names ~f:(fun repo_name ->
+               Repository.Name.to_string repo_name |> String.quoted)
+             |> String.enumerate_and)
+        | Solving -> Pp.text "Solving..."
+      ;;
+    end
+
+    type t =
+      { lockdir_path : Path.Source.t
+      ; state : State.t option ref
+      }
+
+    let create lockdir_path = { lockdir_path; state = ref None }
+  end
+
+  (* The progress indicator for the entire lock operation, which may
+     involve generating multiple lockdirs *)
+  type t = Per_lockdir.t list
+
+  let pp (t : t) =
+    (* Only display the first non-done lockdir state, since the status
+       line can only consist of a single line. *)
+    List.find_map t ~f:(fun { Per_lockdir.lockdir_path; state } ->
+      Option.map !state ~f:(fun state ->
+        Pp.concat
+          [ Pp.textf "Locking %s: " (Path.Source.to_string_maybe_quoted lockdir_path)
+          ; Per_lockdir.State.pp state
+          ]))
+    |> Option.value ~default:Pp.nop
+  ;;
+
+  let add_overlay (t : t) = Console.Status_line.add_overlay (Live (fun () -> pp t))
+end
+
+let project_and_package_pins project =
+  let dir = Dune_project.root project in
+  let pins = Dune_project.pins project in
+  let packages = Dune_project.packages project in
+  Pin.DB.add_opam_pins (Pin.DB.of_stanza ~dir pins) packages
+;;
+
+(* For recursive pins, we must traverse the pinned sources. The [project_pins]
+   are the initial pins that we have in our project. *)
+let resolve_project_pins project_pins =
+  let scan_project ~read ~files =
+    let read file = Memo.of_reproducible_fiber (read file) in
+    let open Memo.O in
+    (* Opam files may never contain recursive pins, so don't both reading them *)
+    Dune_project.gen_load
+      ~read
+      ~files
+      ~dir:Path.Source.root
+      ~infer_from_opam_files:false
+      ~load_opam_file_with_contents:Dune_pkg.Opam_file.load_opam_file_with_contents
+    >>| Option.map ~f:(fun project ->
+      let packages = Dune_project.packages project in
+      let pins = project_and_package_pins project in
+      pins, packages)
+    |> Memo.run
+  in
+  Pin.resolve project_pins ~scan_project
+;;
+
+let solve_multiple_platforms
+      base_solver_env
+      version_preference
+      repos
+      ~pins
+      ~local_packages
+      ~constraints
+      ~selected_depopts
+      ~solve_for_platforms
+      ~portable_lock_dir
+  =
+  let open Fiber.O in
+  let solve_for_env env =
+    Dune_pkg.Opam_solver.solve_lock_dir
+      env
+      version_preference
+      repos
+      ~pins
+      ~local_packages
+      ~constraints
+      ~selected_depopts
+      ~portable_lock_dir
+  in
+  let portable_solver_env =
+    Dune_pkg.Solver_env.unset_multi
+      base_solver_env
+      Dune_lang.Package_variable_name.platform_specific
+  in
+  let+ results =
+    Fiber.parallel_map solve_for_platforms ~f:(fun platform_env ->
+      let solver_env = Dune_pkg.Solver_env.extend portable_solver_env platform_env in
+      solve_for_env solver_env)
+  in
+  let solver_results, errors =
+    List.partition_map results ~f:(function
+      | Ok result -> Left result
+      | Error (`Diagnostic_message message) -> Right message)
+  in
+  match solver_results, errors with
+  | [], [] -> Code_error.raise "Solver did not run for any platforms." []
+  | [], errors -> `All_error errors
+  | x :: xs, errors ->
+    let merged_solver_result =
+      List.fold_left xs ~init:x ~f:Dune_pkg.Opam_solver.Solver_result.merge
+    in
+    if List.is_empty errors
+    then `All_ok merged_solver_result
+    else `Partial (merged_solver_result, errors)
+;;
+
+let solve_lock_dir
+      workspace
+      ~local_packages
+      ~project_pins
+      ~print_perf_stats
+      ~portable_lock_dir
+      version_preference
+      solver_env_from_current_system
+      lock_dir_path
+      progress_state
+  =
+  let open Fiber.O in
+  let lock_dir = Workspace.find_lock_dir workspace lock_dir_path in
+  let project_pins, solve_for_platforms =
+    match lock_dir with
+    | None -> project_pins, Dune_pkg.Solver_env.popular_platform_envs
+    | Some lock_dir ->
+      let workspace =
+        Pin.DB.Workspace.of_stanza workspace.pins
+        |> Pin.DB.Workspace.extract ~names:lock_dir.pins
+      in
+      Pin.DB.combine_exn workspace project_pins, lock_dir.solve_for_platforms
+  in
+  let solver_env_from_context =
+    Option.bind lock_dir ~f:(fun lock_dir -> lock_dir.solver_env)
+  in
+  let solver_env =
+    solver_env
+      ~solver_env_from_context
+      ~solver_env_from_current_system
+      ~unset_solver_vars_from_context:
+        (unset_solver_vars_of_workspace workspace ~lock_dir_path)
+  in
+  let solve_for_platforms =
+    match portable_lock_dir with
+    | true ->
+      (match solver_env_from_context with
+       | Some solver_env_from_context ->
+         List.map solve_for_platforms ~f:(fun platform_env ->
+           Dune_pkg.Solver_env.extend solver_env_from_context platform_env)
+       | None -> solve_for_platforms)
+    | false -> [ solver_env ]
+  in
+  let time_start = Unix.gettimeofday () in
+  let* repos =
+    let repo_map = repositories_of_workspace workspace in
+    let repo_names =
+      Dune_pkg.Pkg_workspace.Repository.Name.Map.keys repo_map
+      |> List.sort ~compare:Dune_pkg.Pkg_workspace.Repository.Name.compare
+    in
+    progress_state
+    := Some (Progress_indicator.Per_lockdir.State.Updating_repos repo_names);
+    get_repos repo_map ~repositories:(repositories_of_lock_dir workspace ~lock_dir_path)
+  in
+  let* pins = resolve_project_pins project_pins in
+  let time_solve_start = Unix.gettimeofday () in
+  progress_state := Some Progress_indicator.Per_lockdir.State.Solving;
+  let* result =
+    solve_multiple_platforms
+      solver_env
+      (Pkg_common.Version_preference.choose
+         ~from_arg:version_preference
+         ~from_context:
+           (Option.bind lock_dir ~f:(fun lock_dir -> lock_dir.version_preference)))
+      repos
+      ~pins
+      ~local_packages:
+        (Package_name.Map.map local_packages ~f:Dune_pkg.Local_package.for_solver)
+      ~constraints:(constraints_of_workspace workspace ~lock_dir_path)
+      ~selected_depopts:(depopts_of_workspace workspace ~lock_dir_path)
+      ~solve_for_platforms
+      ~portable_lock_dir
+  in
+  let solver_result =
+    match result with
+    | `All_error messages -> Error messages
+    | `All_ok solver_result -> Ok (solver_result, [])
+    | `Partial (solver_result, errors) ->
+      Log.info errors;
+      Ok
+        ( solver_result
+        , [ Pp.nop
+          ; Pp.text
+              "No solution was found for some platforms. See the log or run with \
+               --verbose for more details."
+            |> Pp.tag User_message.Style.Warning
+          ] )
+  in
+  match solver_result with
+  | Error messages -> Fiber.return (Error (lock_dir_path, messages))
+  | Ok (solver_result, maybe_unsolved_platforms_message) ->
+    let { Dune_pkg.Opam_solver.Solver_result.lock_dir
+        ; files
+        ; pinned_packages
+        ; num_expanded_packages
+        }
+      =
+      solver_result
+    in
+    let time_end = Unix.gettimeofday () in
+    let maybe_perf_stats =
+      if print_perf_stats
+      then
+        [ Pp.nop
+        ; Pp.textf "Expanded packages: %d" num_expanded_packages
+        ; Pp.textf "Updated repos in: %.2fs" (time_solve_start -. time_start)
+        ; Pp.textf "Solved dependencies in: %.2fs" (time_end -. time_solve_start)
+        ]
+      else []
+    in
+    let summary_message =
+      User_message.make
+        ((Pp.tag
+            User_message.Style.Success
+            (Pp.textf
+               "Solution for %s:"
+               (Path.Source.to_string_maybe_quoted lock_dir_path))
+          :: (match Lock_dir.Packages.to_pkg_list lock_dir.packages with
+              | [] ->
+                Pp.tag User_message.Style.Warning @@ Pp.text "(no dependencies to lock)"
+              | packages -> pp_packages packages)
+          :: maybe_perf_stats)
+         @ maybe_unsolved_platforms_message)
+    in
+    progress_state := None;
+    let+ lock_dir = Lock_dir.compute_missing_checksums ~pinned_packages lock_dir in
+    Ok
+      ( Lock_dir.Write_disk.prepare ~portable_lock_dir ~lock_dir_path ~files lock_dir
+      , summary_message )
+;;
+
+let solve
+      workspace
+      ~local_packages
+      ~project_pins
+      ~solver_env_from_current_system
+      ~version_preference
+      ~lock_dirs
+      ~print_perf_stats
+      ~portable_lock_dir
+  =
+  let open Fiber.O in
+  (* a list of thunks that will perform all the file IO side
+     effects after performing validation so that if materializing any
+     lockdir would fail then no side effect takes place. *)
+  (let+ errors, solutions =
+     let progress_indicator =
+       List.map lock_dirs ~f:Progress_indicator.Per_lockdir.create
+     in
+     let overlay = Progress_indicator.add_overlay progress_indicator in
+     let+ result =
+       Fiber.finalize
+         ~finally:(fun () ->
+           Console.Status_line.remove_overlay overlay;
+           Fiber.return ())
+         (fun () ->
+            Fiber.parallel_map progress_indicator ~f:(fun { lockdir_path; state } ->
+              solve_lock_dir
+                workspace
+                ~local_packages
+                ~project_pins
+                ~print_perf_stats
+                ~portable_lock_dir
+                version_preference
+                solver_env_from_current_system
+                lockdir_path
+                state))
+     in
+     List.partition_map result ~f:Result.to_either
+   in
+   match errors with
+   | [] -> Ok solutions
+   | _ -> Error errors)
+  >>| function
+  | Error errors ->
+    User_error.raise
+      ([ Pp.text "Unable to solve dependencies for the following lock directories:" ]
+       @ List.concat_map errors ~f:(fun (path, messages) ->
+         [ Pp.textf "Lock directory %s:" (Path.Source.to_string_maybe_quoted path)
+         ; Pp.hovbox (Pp.concat ~sep:Pp.newline messages)
+         ]))
+  | Ok write_disks_with_summaries ->
+    let write_disk_list, summary_messages = List.split write_disks_with_summaries in
+    List.iter summary_messages ~f:Console.print_user_message;
+    (* All the file IO side effects happen here: *)
+    List.iter write_disk_list ~f:Lock_dir.Write_disk.commit
+;;
+
+let project_pins =
+  let open Memo.O in
+  Dune_rules.Dune_load.projects ()
+  >>| List.fold_left ~init:Pin.DB.empty ~f:(fun acc project ->
+    let pins = project_and_package_pins project in
+    Pin.DB.combine_exn acc pins)
+;;
+
+let lock ~version_preference ~lock_dirs_arg ~print_perf_stats ~portable_lock_dir =
+  let open Fiber.O in
+  let* solver_env_from_current_system =
+    poll_solver_env_from_current_system () >>| Option.some
+  and* workspace, local_packages, project_pins =
+    Memo.run
+    @@
+    let open Memo.O in
+    let+ workspace = Workspace.workspace ()
+    and+ local_packages = find_local_packages
+    and+ project_pins = project_pins in
+    workspace, local_packages, project_pins
+  in
+  let lock_dirs =
+    Pkg_common.Lock_dirs_arg.lock_dirs_of_workspace lock_dirs_arg workspace
+  in
+  solve
+    workspace
+    ~local_packages
+    ~project_pins
+    ~solver_env_from_current_system
+    ~version_preference
+    ~lock_dirs
+    ~print_perf_stats
+    ~portable_lock_dir
+;;
+
+let term =
+  let+ builder = Common.Builder.term
+  and+ version_preference = Version_preference.term
+  and+ lock_dirs_arg = Pkg_common.Lock_dirs_arg.term
+  and+ print_perf_stats = Arg.(value & flag & info [ "print-perf-stats" ]) in
+  let builder = Common.Builder.forbid_builds builder in
+  let common, config = Common.init builder in
+  Scheduler.go_with_rpc_server ~common ~config (fun () ->
+    let portable_lock_dir =
+      match Config.get Dune_rules.Compile_time.portable_lock_dir with
+      | `Enabled -> true
+      | `Disabled -> false
+    in
+    lock ~version_preference ~lock_dirs_arg ~print_perf_stats ~portable_lock_dir)
+;;
+
+let info =
+  let doc = "Create a lockfile" in
+  Cmd.info "lock" ~doc
+;;
+
+let command = Cmd.v info term

unikernel/duniverse/dune_/bin/pkg/lock.mli

@@ -0,0 +1,15 @@
+open Import
+
+val solve
+  :  Workspace.t
+  -> local_packages:Dune_pkg.Local_package.t Package_name.Map.t
+  -> project_pins:Dune_pkg.Pin.DB.t
+  -> solver_env_from_current_system:Dune_pkg.Solver_env.t option
+  -> version_preference:Dune_pkg.Version_preference.t option
+  -> lock_dirs:Path.Source.t list
+  -> print_perf_stats:bool
+  -> portable_lock_dir:bool
+  -> unit Fiber.t
+
+(** Command to create lock directory *)
+val command : unit Cmd.t

unikernel/duniverse/dune_/bin/pkg/outdated.ml

@@ -0,0 +1,103 @@
+open Import
+open Pkg_common
+
+let find_outdated_packages ~transitive ~lock_dirs_arg () =
+  let open Fiber.O in
+  let+ pps, not_founds =
+    let* workspace = Memo.run (Workspace.workspace ()) in
+    Pkg_common.Lock_dirs_arg.lock_dirs_of_workspace lock_dirs_arg workspace
+    |> Fiber.parallel_map ~f:(fun lock_dir_path ->
+      (* updating makes sense when checking for outdated packages *)
+      let* repos =
+        get_repos
+          (repositories_of_workspace workspace)
+          ~repositories:(repositories_of_lock_dir workspace ~lock_dir_path)
+      and+ local_packages = Memo.run find_local_packages
+      and+ platform = solver_env_from_system_and_context ~lock_dir_path in
+      let lock_dir = Dune_pkg.Lock_dir.read_disk_exn lock_dir_path in
+      let packages =
+        Dune_pkg.Lock_dir.Packages.pkgs_on_platform_by_name lock_dir.packages ~platform
+      in
+      let+ results = Dune_pkg.Outdated.find ~repos ~local_packages packages in
+      ( Dune_pkg.Outdated.pp ~transitive ~lock_dir_path results
+      , ( Dune_pkg.Outdated.packages_that_were_not_found results
+          |> Package_name.Set.of_list
+          |> Package_name.Set.to_list
+        , lock_dir_path
+        , repos ) ))
+    >>| List.split
+  in
+  (match pps with
+   | [ _ ] -> Console.print pps
+   | _ -> Console.print [ Pp.enumerate ~f:Fun.id pps ]);
+  let error_messages =
+    List.filter_map not_founds ~f:(function
+      | [], _, _ -> None
+      | packages, lock_dir_path, repos ->
+        Pp.concat
+          ~sep:Pp.space
+          [ Pp.textf
+              "When checking %s, the following packages:"
+              (Path.Source.to_string_maybe_quoted lock_dir_path)
+            |> Pp.hovbox
+          ; Pp.concat
+              ~sep:Pp.space
+              [ Pp.enumerate packages ~f:(fun name ->
+                  Dune_lang.Package_name.to_string name |> Pp.verbatim)
+              ; Pp.text "were not found in the following opam repositories:" |> Pp.hovbox
+              ; Pp.enumerate repos ~f:(fun repo ->
+                  (* CR-rgrinberg: why are we outputting [Dyn.t] in error
+                     messages? *)
+                  Dune_pkg.Opam_repo.serializable repo
+                  |> Dyn.option Dune_pkg.Opam_repo.Serializable.to_dyn
+                  |> Dyn.pp)
+              ]
+            |> Pp.vbox
+          ]
+        |> Pp.hovbox
+        |> Option.some)
+  in
+  match error_messages with
+  | [] -> ()
+  | error_messages ->
+    User_error.raise (Pp.text "Some packages could not be found." :: error_messages)
+;;
+
+let term =
+  let+ builder = Common.Builder.term
+  and+ transitive =
+    Arg.(
+      value
+      & flag
+      & info
+          [ "transitive" ]
+          ~doc:"Check for outdated packages in transitive dependencies")
+  and+ lock_dirs_arg = Pkg_common.Lock_dirs_arg.term in
+  let builder = Common.Builder.forbid_builds builder in
+  let common, config = Common.init builder in
+  Scheduler.go_with_rpc_server ~common ~config
+  @@ find_outdated_packages ~transitive ~lock_dirs_arg
+;;
+
+let info =
+  let doc = "Check for outdated packages" in
+  let man =
+    [ `S "DESCRIPTION"
+    ; `P
+        "List packages in from lock directory that have newer versions available. By \
+         default, only direct dependencies are checked. The $(b,--transitive) flag can \
+         be used to check transitive dependencies as well."
+    ; `P "For example:"
+    ; `Pre "    \\$ dune pkg outdated"
+    ; `Noblank
+    ; `Pre "    1/2 packages in dune.lock are outdated."
+    ; `Noblank
+    ; `Pre "    - ocaml 4.14.1 < 5.1.0"
+    ; `Noblank
+    ; `Pre "    - dune 3.7.1 < 3.11.0"
+    ]
+  in
+  Cmd.info "outdated" ~doc ~man
+;;
+
+let command = Cmd.v info term

unikernel/duniverse/dune_/bin/pkg/outdated.mli

@@ -0,0 +1,4 @@
+open Import
+
+(** Command to print outdated packages *)
+val command : unit Cmd.t

unikernel/duniverse/dune_/bin/pkg/pkg.ml

@@ -0,0 +1,28 @@
+open Import
+
+let man =
+  [ `S "DESCRIPTION"
+  ; `P {|Commands for OCaml package management|}
+  ; `Blocks Common.help_secs
+  ]
+;;
+
+let subcommands =
+  [ Lock.command
+  ; Print_solver_env.command
+  ; Outdated.command
+  ; Validate_lock_dir.command
+  ; Pkg_enabled.command
+  ]
+;;
+
+let info name =
+  let doc = "Experimental package management" in
+  Cmd.info name ~doc ~man
+;;
+
+let group = Cmd.group (info "pkg") subcommands
+
+module Alias = struct
+  let group = Cmd.group (info "package") subcommands
+end

unikernel/duniverse/dune_/bin/pkg/pkg.mli

@@ -0,0 +1,7 @@
+open Import
+
+val group : unit Cmd.t
+
+module Alias : sig
+  val group : unit Cmd.t
+end

unikernel/duniverse/dune_/bin/pkg/pkg_common.ml

@@ -0,0 +1,228 @@
+open Import
+module Lock_dir = Dune_pkg.Lock_dir
+module Solver_env = Dune_pkg.Solver_env
+module Package_variable_name = Dune_lang.Package_variable_name
+module Variable_value = Dune_pkg.Variable_value
+
+let solver_env
+      ~solver_env_from_current_system
+      ~solver_env_from_context
+      ~unset_solver_vars_from_context
+  =
+  let solver_env =
+    [ solver_env_from_current_system; solver_env_from_context ]
+    |> List.filter_opt
+    |> List.fold_left ~init:Solver_env.with_defaults ~f:Solver_env.extend
+  in
+  match unset_solver_vars_from_context with
+  | None -> solver_env
+  | Some unset_solver_vars -> Solver_env.unset_multi solver_env unset_solver_vars
+;;
+
+let poll_solver_env_from_current_system () =
+  Dune_pkg.Sys_poll.make ~path:(Env_path.path Stdune.Env.initial)
+  |> Dune_pkg.Sys_poll.solver_env_from_current_system
+;;
+
+let get_lock_dir_from_context ~lock_dir_path =
+  Memo.run
+  @@
+  let open Memo.O in
+  let+ workspace = Workspace.workspace () in
+  Workspace.find_lock_dir workspace lock_dir_path
+;;
+
+let get_solver_env_from_context ~lock_dir_path =
+  let open Fiber.O in
+  let+ lock_dir = get_lock_dir_from_context ~lock_dir_path in
+  Option.bind lock_dir ~f:(fun lock_dir -> lock_dir.solver_env)
+;;
+
+let get_unset_solver_vars_from_context ~lock_dir_path =
+  let open Fiber.O in
+  let+ lock_dir = get_lock_dir_from_context ~lock_dir_path in
+  Option.bind lock_dir ~f:(fun lock_dir -> lock_dir.unset_solver_vars)
+;;
+
+let solver_env_from_system_and_context ~lock_dir_path =
+  let open Fiber.O in
+  let+ solver_env_from_current_system =
+    poll_solver_env_from_current_system () >>| Option.some
+  and+ solver_env_from_context = get_solver_env_from_context ~lock_dir_path
+  and+ unset_solver_vars_from_context =
+    get_unset_solver_vars_from_context ~lock_dir_path
+  in
+  solver_env
+    ~solver_env_from_current_system
+    ~solver_env_from_context
+    ~unset_solver_vars_from_context
+;;
+
+module Version_preference = struct
+  include Dune_pkg.Version_preference
+
+  let term =
+    let all_strings = List.map all_by_string ~f:fst in
+    let doc =
+      sprintf
+        "Whether to prefer the newest compatible version of a package or the oldest \
+         compatible version of packages while solving dependencies. This overrides any \
+         setting in the current workspace. The default is %s."
+        (to_string default)
+    in
+    let docv = String.concat ~sep:"|" all_strings |> sprintf "(%s)" in
+    Arg.(
+      value
+      & opt (some (enum all_by_string)) None
+      & info [ "version-preference" ] ~doc ~docv)
+  ;;
+
+  let choose ~from_arg ~from_context =
+    match from_arg, from_context with
+    | Some from_arg, _ -> from_arg
+    | None, Some from_context -> from_context
+    | None, None -> default
+  ;;
+end
+
+let repositories_of_workspace (workspace : Workspace.t) =
+  List.map workspace.repos ~f:(fun repo ->
+    Dune_pkg.Pkg_workspace.Repository.name repo, repo)
+  |> Dune_pkg.Pkg_workspace.Repository.Name.Map.of_list_exn
+;;
+
+let constraints_of_workspace (workspace : Workspace.t) ~lock_dir_path =
+  match Workspace.find_lock_dir workspace lock_dir_path with
+  | None -> []
+  | Some lock_dir -> lock_dir.constraints
+;;
+
+let depopts_of_workspace (workspace : Workspace.t) ~lock_dir_path =
+  match Workspace.find_lock_dir workspace lock_dir_path with
+  | None -> []
+  | Some lock_dir -> lock_dir.depopts |> List.map ~f:snd
+;;
+
+let repositories_of_lock_dir workspace ~lock_dir_path =
+  match Workspace.find_lock_dir workspace lock_dir_path with
+  | Some lock_dir -> lock_dir.repositories
+  | None ->
+    List.map workspace.repos ~f:(fun repo ->
+      let name = Dune_pkg.Pkg_workspace.Repository.name repo in
+      let loc = Loc.none in
+      loc, name)
+;;
+
+let unset_solver_vars_of_workspace workspace ~lock_dir_path =
+  let open Option.O in
+  let* lock_dir = Workspace.find_lock_dir workspace lock_dir_path in
+  lock_dir.unset_solver_vars
+;;
+
+let get_repos repos ~repositories =
+  let module Repository = Dune_pkg.Pkg_workspace.Repository in
+  repositories
+  |> Fiber.parallel_map ~f:(fun (loc, name) ->
+    match Repository.Name.Map.find repos name with
+    | None ->
+      User_error.raise
+        ~loc
+        [ Pp.textf "Repository '%s' is not a known repository"
+          @@ Repository.Name.to_string name
+        ]
+    | Some repo ->
+      let loc, opam_url = Repository.opam_url repo in
+      let module Opam_repo = Dune_pkg.Opam_repo in
+      (match Dune_pkg.OpamUrl.classify opam_url loc with
+       | `Git -> Opam_repo.of_git_repo loc opam_url
+       | `Path path -> Fiber.return @@ Opam_repo.of_opam_repo_dir_path loc path
+       | `Archive ->
+         User_error.raise
+           ~loc
+           [ Pp.textf "Repositories stored in archives (%s) are currently unsupported"
+             @@ OpamUrl.to_string opam_url
+           ]))
+;;
+
+let find_local_packages =
+  let open Memo.O in
+  Dune_rules.Dune_load.packages ()
+  >>| Package.Name.Map.map ~f:Dune_pkg.Local_package.of_package
+;;
+
+let pp_package { Lock_dir.Pkg.info = { Lock_dir.Pkg_info.name; version; avoid; _ }; _ } =
+  let warn =
+    if avoid
+    then Pp.tag User_message.Style.Warning (Pp.text " (this version should be avoided)")
+    else Pp.nop
+  in
+  let open Pp.O in
+  Pp.verbatim
+    (Package_name.to_string name ^ "." ^ Dune_pkg.Package_version.to_string version)
+  ++ warn
+;;
+
+let pp_packages packages = Pp.enumerate packages ~f:pp_package
+
+module Lock_dirs_arg = struct
+  type t =
+    | All
+    | Selected of Path.Source.t list
+
+  let all = All
+
+  let term =
+    Common.one_of
+      (let+ arg =
+         Arg.(
+           value
+           & pos_all string []
+           & info
+               []
+               ~docv:"LOCKDIRS"
+               ~doc:
+                 "Lock directories to check for outdated packages. Defaults to dune.lock.")
+       in
+       Selected (List.map arg ~f:Path.Source.of_string))
+      (let+ _all =
+         Arg.(
+           value
+           & flag
+           & info
+               [ "all" ]
+               ~doc:"Check all lock directories in the workspace for outdated packages.")
+       in
+       All)
+  ;;
+
+  let lock_dirs_of_workspace t (workspace : Workspace.t) =
+    let workspace_lock_dirs =
+      Lock_dir.default_path
+      :: List.map workspace.lock_dirs ~f:(fun (lock_dir : Workspace.Lock_dir.t) ->
+        lock_dir.path)
+      |> Path.Source.Set.of_list
+      |> Path.Source.Set.to_list
+    in
+    match t with
+    | All -> workspace_lock_dirs
+    | Selected [] -> [ Lock_dir.default_path ]
+    | Selected chosen_lock_dirs ->
+      let workspace_lock_dirs_set = Path.Source.Set.of_list workspace_lock_dirs in
+      let chosen_lock_dirs_set = Path.Source.Set.of_list chosen_lock_dirs in
+      if Path.Source.Set.is_subset chosen_lock_dirs_set ~of_:workspace_lock_dirs_set
+      then chosen_lock_dirs
+      else (
+        let unknown_lock_dirs =
+          Path.Source.Set.diff chosen_lock_dirs_set workspace_lock_dirs_set
+          |> Path.Source.Set.to_list
+        in
+        let f x = Path.pp (Path.source x) in
+        User_error.raise
+          [ Pp.text
+              "The following directories are not lock directories in this workspace:"
+          ; Pp.enumerate unknown_lock_dirs ~f
+          ; Pp.text "This workspace contains the following lock directories:"
+          ; Pp.enumerate workspace_lock_dirs ~f
+          ])
+  ;;
+end

unikernel/duniverse/dune_/bin/pkg/pkg_common.mli

@@ -0,0 +1,92 @@
+open Import
+
+(** Create a [Dune_pkg.Solver_env.t] by combining variables taken from the
+    current system and variables taken from the current context, with priority
+    being given to the latter. Some variables are initialized to default values
+    (which can be overridden by the arguments to this function):
+    - "with-doc" is set to "false"
+    - "opam-version" is set to the version of opam vendored in dune *)
+val solver_env
+  :  solver_env_from_current_system:Dune_pkg.Solver_env.t option
+  -> solver_env_from_context:Dune_pkg.Solver_env.t option
+  -> unset_solver_vars_from_context:Dune_lang.Package_variable_name.Set.t option
+  -> Dune_pkg.Solver_env.t
+
+val poll_solver_env_from_current_system : unit -> Dune_pkg.Solver_env.t Fiber.t
+
+val solver_env_from_system_and_context
+  :  lock_dir_path:Path.Source.t
+  -> Dune_pkg.Solver_env.t Fiber.t
+
+module Version_preference : sig
+  type t := Dune_pkg.Version_preference.t
+
+  val term : Dune_pkg.Version_preference.t option Term.t
+  val choose : from_arg:t option -> from_context:t option -> t
+end
+
+val unset_solver_vars_of_workspace
+  :  Workspace.t
+  -> lock_dir_path:Path.Source.t
+  -> Dune_lang.Package_variable_name.Set.t option
+
+val repositories_of_workspace
+  :  Workspace.t
+  -> Dune_pkg.Pkg_workspace.Repository.t Dune_pkg.Pkg_workspace.Repository.Name.Map.t
+
+val repositories_of_lock_dir
+  :  Workspace.t
+  -> lock_dir_path:Path.Source.t
+  -> (Loc.t * Dune_pkg.Pkg_workspace.Repository.Name.t) list
+
+val constraints_of_workspace
+  :  Workspace.t
+  -> lock_dir_path:Path.Source.t
+  -> Dune_lang.Package_dependency.t list
+
+val depopts_of_workspace
+  :  Workspace.t
+  -> lock_dir_path:Path.Source.t
+  -> Package_name.t list
+
+val get_repos
+  :  Dune_pkg.Pkg_workspace.Repository.t Dune_pkg.Pkg_workspace.Repository.Name.Map.t
+  -> repositories:(Loc.t * Dune_pkg.Pkg_workspace.Repository.Name.t) list
+  -> Dune_pkg.Opam_repo.t list Fiber.t
+
+val find_local_packages : Dune_pkg.Local_package.t Package_name.Map.t Memo.t
+
+module Lock_dirs_arg : sig
+  (** [Lock_dirs_arg.t] is the type of lock directory arguments. This can be
+      created with [Lock_dirs_arg.term] and used with
+      [Lock_dirs_arg.lock_dirs_of_workspace]. *)
+  type t
+
+  (** Select all lockdirs *)
+  val all : t
+
+  (** [Lock_dirs_arg.term] is a command-line argument that can be used to
+      specify the lock directories to consider. This can then be passed to
+      [Lock_dirs_arg.lock_dirs_of_workspace].
+
+      There are two mutually exclusive cases:
+      - The user passed a list of lick directories as positional
+        arguments.contents
+      - The user passed the ["--all"] flag, in which case all lock directories
+        of the workspace are considered. *)
+  val term : t Term.t
+
+  (** [Lock_dirs_arg.lock_dirs_of_workspace t workspace] returns the list of
+      lock directories that should be considered for various operations.
+
+      The [workspace] argument is used to determine the list of all lock lock
+      directories.
+
+      A user error is raised if the list of positional arguments used when
+      creating [t] is not a subset of the lock directories of the workspace. *)
+  val lock_dirs_of_workspace : t -> Workspace.t -> Path.Source.t list
+end
+
+(** [pp_packages lock_dir] returns a list of pretty-printed packages occurring in
+    [lock_dir]. *)
+val pp_packages : Dune_pkg.Lock_dir.Pkg.t list -> User_message.Style.t Pp.t

unikernel/duniverse/dune_/bin/pkg/pkg_enabled.ml

@@ -0,0 +1,36 @@
+open Import
+
+let term =
+  let+ builder = Common.Builder.term in
+  let common, config = Common.init builder in
+  Scheduler.go_with_rpc_server ~common ~config (fun () ->
+    Memo.run
+    @@
+    let open Memo.O in
+    let+ workspace = Workspace.workspace () in
+    let lock_dir_paths =
+      Pkg_common.Lock_dirs_arg.lock_dirs_of_workspace
+        Pkg_common.Lock_dirs_arg.all
+        workspace
+    in
+    let any_lockdir_exists =
+      List.exists lock_dir_paths ~f:(fun lock_dir_path ->
+        Path.exists (Path.source lock_dir_path))
+    in
+    (* CR-Leonidas-from-XIV: change this logic when we stop detecting lock
+       directories in the source tree *)
+    let enabled = any_lockdir_exists || workspace.config.pkg_enabled in
+    match enabled with
+    | true -> ()
+    | false -> exit 1)
+;;
+
+let info =
+  let doc =
+    "Check if the project indicates that dune's package management features should be \
+     enabled. Exits with 0 if package management is enabled and 1 otherwise."
+  in
+  Cmd.info "enabled" ~doc
+;;
+
+let command = Cmd.v info term

unikernel/duniverse/dune_/bin/pkg/pkg_enabled.mli

@@ -0,0 +1,3 @@
+open Import
+
+val command : unit Cmd.t

unikernel/duniverse/dune_/bin/pkg/print_solver_env.ml

@@ -0,0 +1,56 @@
+open Import
+open Pkg_common
+
+let print_solver_env_for_lock_dir workspace ~solver_env_from_current_system lock_dir_path =
+  let solver_env_from_context =
+    Option.bind (Workspace.find_lock_dir workspace lock_dir_path) ~f:(fun lock_dir ->
+      lock_dir.solver_env)
+  in
+  let solver_env =
+    solver_env
+      ~solver_env_from_current_system
+      ~solver_env_from_context
+      ~unset_solver_vars_from_context:
+        (Pkg_common.unset_solver_vars_of_workspace workspace ~lock_dir_path)
+  in
+  Console.print
+    [ Pp.textf
+        "Solver environment for lock directory %s:"
+        (Path.Source.to_string_maybe_quoted lock_dir_path)
+    ; Dune_pkg.Solver_env.pp solver_env
+    ]
+;;
+
+let print_solver_env ~lock_dirs_arg =
+  let open Fiber.O in
+  let+ workspace = Memo.run (Workspace.workspace ())
+  and+ solver_env_from_current_system =
+    Dune_pkg.Sys_poll.make ~path:(Env_path.path Stdune.Env.initial)
+    |> Dune_pkg.Sys_poll.solver_env_from_current_system
+    >>| Option.some
+  in
+  let lock_dirs = Lock_dirs_arg.lock_dirs_of_workspace lock_dirs_arg workspace in
+  List.iter
+    lock_dirs
+    ~f:(print_solver_env_for_lock_dir workspace ~solver_env_from_current_system)
+;;
+
+let term =
+  let+ builder = Common.Builder.term
+  and+ lock_dirs_arg = Lock_dirs_arg.term in
+  let builder = Common.Builder.forbid_builds builder in
+  let common, config = Common.init builder in
+  Scheduler.go_with_rpc_server ~common ~config (fun () -> print_solver_env ~lock_dirs_arg)
+;;
+
+let info =
+  let doc =
+    "Print a description of the environment that would be used to solve dependencies and \
+     then exit without attempting to solve the dependencies or generate the lockfile. \
+     Intended to be used to debug situations where no solution can be found to a \
+     project's dependencies."
+  in
+  Cmd.info "print-solver-env" ~doc
+;;
+
+let command = Cmd.v info term

unikernel/duniverse/dune_/bin/pkg/print_solver_env.mli

@@ -0,0 +1,4 @@
+open Import
+
+(** Command to print solver environment *)
+val command : unit Cmd.t

unikernel/duniverse/dune_/bin/pkg/validate_lock_dir.ml

@@ -0,0 +1,88 @@
+open! Import
+open Pkg_common
+module Package_universe = Dune_pkg.Package_universe
+module Lock_dir = Dune_pkg.Lock_dir
+module Opam_repo = Dune_pkg.Opam_repo
+module Package_version = Dune_pkg.Package_version
+module Opam_solver = Dune_pkg.Opam_solver
+
+let info =
+  let doc = "Validate that a lockdir contains a solution for local packages" in
+  let man = [ `S "DESCRIPTION"; `P doc ] in
+  Cmd.info "validate-lockdir" ~doc ~man
+;;
+
+(* CR-someday alizter: The logic here is a little more complicated than it needs
+   to be and can be simplified. *)
+
+let enumerate_lock_dirs_by_path ~lock_dirs () =
+  let open Memo.O in
+  let+ per_contexts =
+    Workspace.workspace () >>| Pkg_common.Lock_dirs_arg.lock_dirs_of_workspace lock_dirs
+  in
+  List.filter_map per_contexts ~f:(fun lock_dir_path ->
+    if Path.exists (Path.source lock_dir_path)
+    then (
+      try Some (Ok (lock_dir_path, Lock_dir.read_disk_exn lock_dir_path)) with
+      | User_error.E e -> Some (Error (lock_dir_path, `Parse_error e)))
+    else None)
+;;
+
+let validate_lock_dirs ~lock_dirs () =
+  let open Fiber.O in
+  let* lock_dirs_by_path, local_packages =
+    Memo.both (enumerate_lock_dirs_by_path ~lock_dirs ()) Pkg_common.find_local_packages
+    |> Memo.run
+  in
+  if List.is_empty lock_dirs_by_path
+  then
+    let+ () = Fiber.return () in
+    Console.print [ Pp.text "No lockdirs to validate." ]
+  else
+    let+ universes =
+      Fiber.parallel_map lock_dirs_by_path ~f:(function
+        | Error e -> Fiber.return (Some e)
+        | Ok (lock_dir_path, lock_dir) ->
+          let+ platform = solver_env_from_system_and_context ~lock_dir_path in
+          (match Package_universe.create ~platform local_packages lock_dir with
+           | Ok _ -> None
+           | Error e -> Some (lock_dir_path, `Lock_dir_out_of_sync e)))
+      >>| List.filter_opt
+    in
+    match universes with
+    | [] -> ()
+    | errors_by_path ->
+      List.iter errors_by_path ~f:(fun (path, error) ->
+        match error with
+        | `Parse_error error ->
+          User_message.prerr
+            (User_message.make
+               [ Pp.textf
+                   "Failed to parse lockdir %s:"
+                   (Path.Source.to_string_maybe_quoted path)
+               ; User_message.pp error
+               ])
+        | `Lock_dir_out_of_sync error ->
+          User_message.prerr
+            (User_message.make
+               [ Pp.textf
+                   "Lockdir %s does not contain a solution for local packages:"
+                   (Path.Source.to_string path)
+               ]);
+          User_message.prerr error);
+      User_error.raise
+        [ Pp.text "Some lockdirs do not contain solutions for local packages:"
+        ; Pp.enumerate errors_by_path ~f:(fun (path, _) ->
+            Pp.text (Path.Source.to_string path))
+        ]
+;;
+
+let term =
+  let+ builder = Common.Builder.term
+  and+ lock_dirs = Pkg_common.Lock_dirs_arg.term in
+  let builder = Common.Builder.forbid_builds builder in
+  let common, config = Common.init builder in
+  Scheduler.go_with_rpc_server ~common ~config @@ validate_lock_dirs ~lock_dirs
+;;
+
+let command = Cmd.v info term

unikernel/duniverse/dune_/bin/pkg/validate_lock_dir.mli

@@ -0,0 +1,4 @@
+open Import
+
+(** Command to check if local packages and lockdir agree *)
+val command : unit Cmd.t