Source file opamAdminCommand.ml

(**************************************************************************)
(*                                                                        *)
(*    Copyright 2012-2020 OCamlPro                                        *)
(*    Copyright 2012 INRIA                                                *)
(*                                                                        *)
(*  All rights reserved. This file is distributed under the terms of the  *)
(*  GNU Lesser General Public License version 2.1, with the special       *)
(*  exception on linking described in the file LICENSE.                   *)
(*                                                                        *)
(**************************************************************************)

open OpamTypes
open OpamProcess.Job.Op
open OpamStateTypes
open OpamCmdliner

type command = unit OpamCmdliner.Term.t * OpamCmdliner.Cmd.info

let repo_version_lt repo_root v =
  let v' =
    let open OpamStd.Option.Op in
    (OpamFile.Repo.read_opt
       (OpamRepositoryRoot.Dir.Path.repo repo_root)
     >>= OpamFile.Repo.opam_version)
    +! OpamAdminRepoUpgrade.upgradefrom_version
  in
  if OpamVersion.compare v v' > 0 then Some v' else None

let checked_repo_root ?(check=true) () =
  let repo_root = OpamRepositoryRoot.Dir.cwd () in
  if not (OpamFilename.exists_dir
            (OpamRepositoryRoot.Dir.Path.packages_dir repo_root))
  then
    OpamConsole.error_and_exit `Bad_arguments
      "No repository found in current directory.\n\
       Please make sure there is a \"packages%s\" directory" OpamArg.dir_sep;
  (if check then
     match repo_version_lt repo_root
             OpamAdminRepoUpgrade.upgradeto_version with
     | Some v ->
       OpamConsole.warning
         "The repository is at version %s, \
          please consider upgrading to %s with 'opam admin upgrade'"
         (OpamVersion.to_string v)
         (OpamVersion.to_string OpamAdminRepoUpgrade.upgradeto_version)
     | None -> ());
  repo_root

let global_options cli =
  let apply_cli options = { options with OpamArg.cli = options.OpamArg.cli} in
  Term.(const apply_cli $ OpamArg.global_options cli)

let admin_command_doc =
  "Tools for repository administrators"

let admin_command_man = [
  `S Manpage.s_description;
  `P (Printf.sprintf
       "This command can perform various actions on repositories in the opam \
        format. It is expected to be run from the root of a repository, i.e. a \
        directory containing a 'repo' file and a subdirectory 'packages%s' \
        holding package definition within subdirectories. A 'compilers%s' \
        subdirectory (opam repository format version < 2) will also be used by \
        the $(b,upgrade-format) subcommand."
       OpamArg.dir_sep OpamArg.dir_sep)
]

let index_command_doc =
  "Generate an inclusive index file for serving over HTTP."
let index_command cli =
  let command = "index" in
  let doc = index_command_doc in
  let man = [
    `S Manpage.s_description;
    `P "An opam repository can be served over HTTP or HTTPS using any web \
        server. To that purpose, an inclusive index needs to be generated \
        first: this command generates the files the opam client will expect \
        when fetching from an HTTP remote, and should be run after any changes \
        are done to the contents of the repository."
  ]
  in
  let urls_txt_arg cli =
    OpamArg.mk_vflag ~cli `minimal_urls_txt [
      OpamArg.cli_original, `no_urls_txt, ["no-urls-txt"],
      "Don't generate a 'urls.txt' file. That index file is no longer \
       needed from opam 2.0 on, but is still used by older versions.";
      OpamArg.cli_original, `full_urls_txt, ["full-urls-txt"],
      "Generate an inclusive 'urls.txt', for a repository that will be \
       used by opam versions earlier than 2.0.";
      OpamArg.cli_original, `minimal_urls_txt, ["minimal-urls-txt"],
      "Generate a minimal 'urls.txt' file, that only includes the 'repo' \
       file. This allows opam versions earlier than 2.0 to read that file, \
       and be properly redirected to a repository dedicated to their \
       version, assuming a suitable 'redirect:' field is defined, instead \
       of failing. This is the default.";
    ]
  in
  let cmd global_options urls_txt () =
    OpamArg.apply_global_options cli global_options;
    let repo_root = checked_repo_root () in
    let repo_root_dir = OpamRepositoryRoot.Dir.to_dir repo_root in
    let repo_file = OpamRepositoryRoot.Dir.Path.repo repo_root in
    let repo_def =
      match OpamFile.Repo.read_opt repo_file with
      | None ->
        OpamConsole.warning "No \"repo\" file found. Creating a minimal one.";
        OpamFile.Repo.create ()
      | Some r -> r
    in
    let repo_stamp =
      let date () =
        let t = Unix.gmtime (Unix.time ()) in
        Printf.sprintf "%04d-%02d-%02d %02d:%02d"
          (t.Unix.tm_year + 1900) (t.Unix.tm_mon +1) t.Unix.tm_mday
          t.Unix.tm_hour t.Unix.tm_min
      in
      match
        OpamUrl.guess_version_control
          (OpamRepositoryRoot.Dir.to_string repo_root)
      with
      | None -> date ()
      | Some vcs ->
        let module VCS = (val OpamRepository.find_backend_by_kind vcs) in
        match OpamProcess.Job.run (VCS.revision repo_root_dir) with
        | None -> date ()
        | Some hash -> hash
    in
    let repo_def = OpamFile.Repo.with_stamp repo_stamp repo_def in
    OpamFile.Repo.write repo_file repo_def;
    if urls_txt <> `no_urls_txt then
      (OpamConsole.msg "Generating urls.txt...\n";
       OpamFilename.of_string OpamRepositoryPathName.repo_f ::
       (if urls_txt = `full_urls_txt then
          OpamFilename.rec_files OpamFilename.Op.(repo_root_dir / "compilers") @
          OpamFilename.rec_files
            (OpamRepositoryRoot.Dir.Path.packages_dir repo_root)
        else []) |>
       List.fold_left (fun set f ->
           if not (OpamFilename.exists f) then set else
             let attr = OpamFilename.to_attribute repo_root_dir f in
             OpamFilename.Attribute.Set.add attr set
         ) OpamFilename.Attribute.Set.empty |>
       OpamFile.File_attributes.write
         (OpamFile.make (OpamFilename.of_string "urls.txt")));
    OpamConsole.msg "Generating index.tar.gz...\n";
    OpamHTTP.make_index_tar_gz repo_root;
    OpamConsole.msg "Done.\n";
  in
  OpamArg.mk_command  ~cli OpamArg.cli_original command ~doc ~man
    Term.(const cmd $ global_options cli $ urls_txt_arg cli)

let cache_urls repo_root repo_def =
  let global_dl_cache =
    OpamStd.Option.Op.(OpamStateConfig.(load ~lock_kind:`Lock_read !r.root_dir) +!
                       OpamFile.Config.empty)
    |> OpamFile.Config.dl_cache
  in
  let repo_dl_cache =
    List.filter_map (fun rel ->
        if OpamStd.String.contains ~sub:"://" rel
        then OpamUrl.parse_opt ~handle_suffix:false rel
        else
          Some
            OpamUrl.Op.(OpamUrl.of_string
                          (OpamRepositoryRoot.Dir.to_string repo_root) / rel))
      (OpamFile.Repo.dl_cache repo_def)
  in
  repo_dl_cache @ global_dl_cache

(* Downloads all urls of the given package to the given cache_dir *)
let package_files_to_cache repo_root cache_dir cache_urls
    ~recheck ?link (nv, prefix) =
  match
    OpamFileTools.read_opam
      (OpamRepositoryRoot.Dir.Path.packages repo_root prefix nv)
  with
  | None -> Done (OpamPackage.Map.empty)
  | Some opam ->
    let add_to_cache ?name urlf errors =
      let label =
        OpamPackage.to_string nv ^
        OpamStd.Option.to_string ((^) "/") name
      in
      let checksums =
        OpamHash.sort (OpamFile.URL.checksum urlf)
      in
      match checksums with
      | [] ->
        OpamConsole.warning "[%s] no checksum, not caching"
          (OpamConsole.colorise `green label);
        Done errors
      | _::_ ->
        let cache_files =
          List.map (OpamRepository.cache_file cache_dir) checksums
        in
        let error_opt =
          if not recheck && List.for_all OpamFilename.exists cache_files then
            Done None
          else
            OpamRepository.pull_file_to_cache label
              ~cache_urls ~cache_dir
              checksums
              (OpamFile.URL.url urlf :: OpamFile.URL.mirrors urlf)
            @@| fun r -> match OpamRepository.report_fetch_result nv r with
            | Not_available (_,m) -> Some m
            | Up_to_date () | Result () -> None
        in
        error_opt @@| function
        | Some m ->
          OpamPackage.Map.update nv (fun l -> m::l) [] errors
        | None ->
          Stdlib.Option.iter (fun link_dir ->
              let name =
                OpamStd.Option.default
                  (OpamUrl.basename (OpamFile.URL.url urlf))
                  name
              in
              let link =
                OpamFilename.Op.(link_dir / OpamPackage.to_string nv // name)
              in
              OpamFilename.link ~relative:true ~target:(List.hd cache_files) ~link)
            link;
          errors
    in
    let urls =
      (match OpamFile.OPAM.url opam with
       | None -> []
       | Some urlf -> [add_to_cache urlf]) @
      (List.map (fun (name,urlf) ->
           add_to_cache ~name:(OpamFilename.Base.to_string name) urlf)
          (OpamFile.OPAM.extra_sources opam))
    in
    OpamProcess.Job.seq urls OpamPackage.Map.empty

let cache_command_doc = "Fills a local cache of package archives"
let cache_command cli =
  let command = "cache" in
  let doc = cache_command_doc in
  let man = [
    `S Manpage.s_description;
    `P "Downloads the archives for all packages to fill a local cache, that \
        can be used when serving the repository."
  ]
  in
  let cache_dir_arg =
    Arg.(value & pos 0 OpamArg.dirname (OpamFilename.Dir.of_string "./cache") &
         info [] ~docv:"DIR" ~doc:
           "Name of the cache directory to use.")
  in
  let no_repo_update_arg =
    OpamArg.mk_flag ~cli OpamArg.cli_original ["no-repo-update";"n"]
      "Don't check, create or update the 'repo' file to point to the \
       generated cache ('archive-mirrors:' field)."
  in
  let link_arg =
    OpamArg.mk_opt ~cli OpamArg.cli_original ["link"] "DIR"
      (Printf.sprintf
         "Create reverse symbolic links to the archives within $(i,DIR), in \
          the form $(b,DIR%sPKG.VERSION%sFILENAME)."
         OpamArg.dir_sep OpamArg.dir_sep)
      Arg.(some OpamArg.dirname) None
  in
  let jobs_arg =
    OpamArg.mk_opt ~cli OpamArg.cli_original ["jobs"; "j"]
      "JOBS" "Number of parallel downloads"
      OpamArg.positive_integer 8
  in
  let recheck_arg =
    OpamArg.mk_flag ~cli OpamArg.(cli_from cli2_2) ["check-all"; "c"]
      "Run a full integrity check on the existing cache. If this is not set, \
       only missing cache files are handled."
  in
  let cmd global_options cache_dir no_repo_update link jobs recheck () =
    OpamArg.apply_global_options cli global_options;
    (* this option was the default until 2.1 *)
    let recheck = recheck || OpamCLIVersion.Op.(cli @< OpamArg.cli2_2) in
    let repo_root = checked_repo_root () in
    let repo_file = OpamRepositoryRoot.Dir.Path.repo repo_root in
    let repo_def = OpamFile.Repo.safe_read repo_file in

    let pkg_prefixes = OpamRepository.packages_with_prefixes repo_root in
    let cache_urls = cache_urls repo_root repo_def in

    let errors =
      OpamParallel.reduce ~jobs
        ~nil:OpamPackage.Map.empty
        ~merge:(OpamPackage.Map.union (fun a _ -> a))
        ~command:(package_files_to_cache repo_root cache_dir cache_urls
                    ~recheck ?link)
        (List.sort (fun (nv1,_) (nv2,_) ->
             (* Some pseudo-randomisation to avoid downloading all files from
                the same host simultaneously *)
             match compare (Hashtbl.hash nv1) (Hashtbl.hash nv2) with
             | 0 -> compare nv1 nv2
             | n -> n)
            (OpamPackage.Map.bindings pkg_prefixes))
    in

    let cache_dir_url =
      OpamFilename.remove_prefix_dir
        (OpamRepositoryRoot.Dir.to_dir repo_root) cache_dir
    in
    if not no_repo_update then
      if not (OpamStd.List.mem String.equal
                cache_dir_url (OpamFile.Repo.dl_cache repo_def)) then
        (OpamConsole.msg "Adding %s to %s...\n"
           cache_dir_url (OpamFile.to_string repo_file);
         OpamFile.Repo.write repo_file
           (OpamFile.Repo.with_dl_cache
              (cache_dir_url :: OpamFile.Repo.dl_cache repo_def)
              repo_def));

    if not (OpamPackage.Map.is_empty errors) then (
      OpamConsole.error "Got some errors while processing: %s"
        (OpamStd.List.concat_map ", " OpamPackage.to_string
           (OpamPackage.Map.keys errors));
      OpamConsole.errmsg "%s"
        (OpamStd.Format.itemize (fun (nv,el) ->
             Printf.sprintf "[%s] %s" (OpamPackage.to_string nv)
               (String.concat "\n" el))
            (OpamPackage.Map.bindings errors))
    );

    OpamConsole.msg "Done.\n";
  in
  OpamArg.mk_command  ~cli OpamArg.cli_original command ~doc ~man
    Term.(const cmd $ global_options cli $
          cache_dir_arg $ no_repo_update_arg $ link_arg $ jobs_arg $
          recheck_arg)

let packages_with_prefixes repo_root packages =
  let pkgs_map = OpamRepository.packages_with_prefixes repo_root in
  if packages = [] then pkgs_map else
  let pkgs_map, missing_pkgs =
    List.fold_left (fun (map, missing) (n,vo)->
        match vo with
        | Some v ->
          let nv = OpamPackage.create n v in
          (match OpamPackage.Map.find_opt nv pkgs_map with
           | Some pre ->( OpamPackage.Map.add nv pre map), missing
           | None -> map, (n,vo)::missing)
        | None ->
          let n_map = OpamPackage.packages_of_name_map pkgs_map n in
          if OpamPackage.Map.is_empty n_map then
            map, (n,vo)::missing
          else
            (OpamPackage.Map.union (fun _nv _nv' ->
                 OpamStd.Sys.exit_because `Internal_error)
                n_map map),
            missing
      ) (OpamPackage.Map.empty, []) packages
  in
  if missing_pkgs <> [] then
    OpamConsole.warning "Not found package%s %s. Ignoring them."
      (match missing_pkgs with | [_] -> "" | _ -> "s")
      (OpamStd.Format.pretty_list
         (List.map
            (fun (n,vo) ->
               OpamConsole.colorise `underline
                 (match vo with
                  | Some v -> OpamPackage.to_string (OpamPackage.create n v)
                  | None -> OpamPackage.Name.to_string n))
            (List.rev missing_pkgs)));
  pkgs_map

let update_extrafiles_command_doc =
  "Add extra-files to an opam repository."
let update_extrafiles_command cli =
  let command = "update-extrafiles" in
  let doc = update_extrafiles_command_doc in
  let man = [
    `S Manpage.s_description;
    `P "This command scans through package definitions, and add extrafiles \
        field as requested."
  ]
  in
  let hash_type_arg =
    OpamArg.mk_opt ~cli OpamArg.(cli_from cli2_2) ["hash"]
      "HASH_ALGO" "The hash, or hashes to be added"
      (Arg.some OpamArg.hash_kinds) None
  in
  let packages =
    OpamArg.mk_opt ~cli OpamArg.(cli_from cli2_2) ["p";"packages"]
      "PACKAGES" "Only add extra files for the given packages"
      Arg.(list OpamArg.package) []
  in
  let cmd global_options hash_type packages () =
    OpamArg.apply_global_options cli global_options;
    let repo_root = checked_repo_root () in
    let pkg_prefixes = packages_with_prefixes repo_root packages in
    let compute ?kind file =
      OpamHash.compute ?kind (OpamFilename.to_string file)
    in
    let has_error =
      OpamPackage.Map.fold (fun nv prefix has_error ->
          let opam_file = OpamRepositoryRoot.Dir.Path.opam repo_root prefix nv in
          let opam = OpamFile.OPAM.read opam_file in
          let has_error =
            if OpamFile.exists
                (OpamRepositoryRoot.Dir.Path.url repo_root prefix nv)
            then
              (OpamConsole.warning "Not updating external URL file at %s"
                 (OpamFile.to_string
                    (OpamRepositoryRoot.Dir.Path.url repo_root prefix nv));
               true)
            else has_error
          in
          let files_dir =
            OpamRepositoryRoot.Dir.Path.files repo_root prefix nv
          in
          if OpamFilename.exists_dir files_dir then
            (let files =
               OpamFilename.rec_files files_dir
               |> List.map (fun file ->
                   file,
                   OpamFilename.Base.of_string
                     (OpamFilename.remove_prefix files_dir file))
             in
             let extra_files =
               OpamStd.Option.default [] (OpamFile.OPAM.extra_files opam)
             in
             let extra_files = OpamFilename.Base.Map.of_list extra_files in
             let xfiles =
               List.fold_left (fun extra (file, base) ->
                   match OpamFilename.Base.Map.find_opt base extra_files with
                   | Some hash ->
                     let kind = OpamHash.kind hash in
                     let xhash = compute ~kind file in
                     if OpamHash.compare hash xhash <> 0 then
                       OpamFilename.Base.Map.add base
                         (OpamStd.Option.map_default (fun kind ->
                              compute ~kind file) xhash hash_type)
                         extra
                     else
                       (match hash_type with
                        | Some kind ->
                          OpamFilename.Base.Map.add base (compute ~kind file)
                            extra
                        | None -> extra)
                   | None ->
                     OpamFilename.Base.Map.add base
                       (compute ?kind:hash_type file) extra)
                 extra_files files
             in
             if not (OpamFilename.Base.Map.equal
                       OpamHash.equal extra_files xfiles) then
               let xfiles = OpamFilename.Base.Map.bindings xfiles in
               let opam1 = OpamFile.OPAM.with_extra_files xfiles opam in
               OpamFile.OPAM.write_with_preserved_format opam_file opam1);
          has_error)
        pkg_prefixes false
    in
    if has_error then OpamStd.Sys.exit_because `Sync_error
    else OpamStd.Sys.exit_because `Success
  in
  OpamArg.mk_command  ~cli OpamArg.(cli_from cli2_2) command ~doc ~man
    Term.(const cmd $ global_options cli
          $ hash_type_arg $ packages)

let migrate_extrafiles_command_doc =
  "Move extra-files to extra-source."
let migrate_extrafiles_command cli =
  let command = "migrate-extrafiles" in
  let doc = migrate_extrafiles_command_doc in
  let man = [
    `S Manpage.s_description;
    `P "This command scans through package definitions, and migrates all \
        $(i,extra-files) fields to $(i,extra-source) as requested."
  ] in
  let hash_type_arg =
    OpamArg.mk_opt ~cli OpamArg.(cli_from cli2_4) ["hash"]
      "HASH_ALGO" "The hash, or hashes to be added"
      OpamArg.hash_kinds `SHA256
  in
  let packages =
    OpamArg.mk_opt ~cli OpamArg.(cli_from cli2_4) ["p";"packages"]
      "PACKAGES" "Only add extra files for the given packages"
      Arg.(list OpamArg.package) []
  in
  let local_dir_arg =
    let doc =
      Arg.info ~docv:"DIR"
        ~doc:"Name of the local directory where to put the extra-files. \
              They will be put into \
              DIR/patches/<pkgname>/<pkgname.version>/filenameYY" []
    in
    Arg.(required & pos 0 (some OpamArg.dirname) None & doc)
  and url_prefix_arg =
    let doc =
      Arg.info ~docv:"URL"
        ~doc:"Prefix of the URL to emit into extra-sources." []
    in
    Arg.(required & pos 1 (some OpamArg.url) None & doc)
  in
  let cmd global_options kind packages local_dir url_prefix () =
    OpamArg.apply_global_options cli global_options;
    let repo_root = checked_repo_root () in
    let pkg_prefixes = packages_with_prefixes repo_root packages in
    let compute ?kind file =
      OpamHash.compute ?kind (OpamFilename.to_string file)
    in
    let has_error =
      OpamPackage.Map.fold (fun nv prefix has_error ->
          let opam_file = OpamRepositoryRoot.Dir.Path.opam repo_root prefix nv in
          let opam = OpamFile.OPAM.read opam_file in
          let has_error =
            let urlfile = OpamRepositoryRoot.Dir.Path.url repo_root prefix nv in
            if OpamFile.exists urlfile then
              (OpamConsole.warning
                 "Not updating external URL file at %s, \
                  consider upgrading your repository with 'opam admin upgrade'"
                 (OpamFile.to_string urlfile);
               true)
            else has_error
          in
          let files_dir =
            OpamRepositoryRoot.Dir.Path.files repo_root prefix nv
          in
          if OpamFilename.exists_dir files_dir then
            (let files =
               OpamFilename.rec_files files_dir
               |> List.map (fun file ->
                   file,
                   OpamFilename.Base.of_string
                     (OpamFilename.remove_prefix files_dir file))
             in
             match files with
             | [] -> has_error
             | _ ->
               let hashes =
                 List.map (fun (file, base) ->
                     let xhash = compute ~kind file in
                     file, base, xhash)
                   files
               in
               let patch_prefix = "patches" in
               let extra_sources =
                 List.map (fun (src, base, hash) ->
                     let name = OpamPackage.name_to_string nv in
                     let name_version = OpamPackage.to_string nv in
                     let dst_dir = OpamFilename.Op.(
                         local_dir / patch_prefix / name / name_version
                       ) in
                     let dst = OpamFilename.create dst_dir base in
                     (* copy file to dst, remove from files *)
                     OpamFilename.mkdir dst_dir;
                     OpamFilename.copy ~src ~dst;
                     let url =
                       let file = OpamFilename.Base.to_string base in
                       OpamFile.URL.create ~checksum:[hash]
                         OpamUrl.Op.(url_prefix / patch_prefix
                                     / name / name_version/ file)
                     in
                     base, url)
                   hashes
               in
               OpamFilename.cleandir files_dir;
               OpamFilename.rmdir_cleanup files_dir;
               let my_extra_sources = OpamFile.OPAM.extra_sources opam in
               let opam1 =
                 OpamFile.OPAM.with_extra_sources
                   (my_extra_sources @ extra_sources) opam
               in
               let opam1 = OpamFile.OPAM.with_extra_files_opt None opam1 in
               OpamFile.OPAM.write_with_preserved_format opam_file opam1;
               has_error)
          else
            has_error)
        pkg_prefixes false
    in
    if has_error then OpamStd.Sys.exit_because `Sync_error
    else OpamStd.Sys.exit_because `Success
  in
  OpamArg.mk_command ~cli OpamArg.(cli_from cli2_4) command ~doc ~man
    Term.(const cmd $ global_options cli $ hash_type_arg $ packages
          $ local_dir_arg $ url_prefix_arg)

let add_hashes_command_doc =
  "Add archive hashes to an opam repository."
let add_hashes_command cli =
  let command = "add-hashes" in
  let doc = add_hashes_command_doc in
  let man = [
    `S Manpage.s_description;
    `P "This command scans through package definitions, and add hashes as \
        requested (fetching the archives if required). A cache is generated \
        in <opamroot>/download-cache/hash-cache for subsequent runs.";
  ]
  in
  let hash_types_arg =
    OpamArg.nonempty_arg_list "HASH_ALGO" "The hash, or hashes to be added"
      OpamArg.hash_kinds
  in
  let packages =
    OpamArg.mk_opt ~cli OpamArg.(cli_from cli2_1) ["p";"packages"]
      "PACKAGES" "Only add hashes for the given packages"
      Arg.(list OpamArg.package) []
  in
  let replace_arg =
    OpamArg.mk_flag ~cli OpamArg.cli_original ["replace"]
      "Replace the existing hashes rather than adding to them"
  in
  let create_hash_tables hash_cache_dir =
    let t = Hashtbl.create (List.length OpamHash.all_kinds) in
    List.iter (fun k1 ->
        List.iter (fun k2 ->
            if k1 <> k2 then (
              let cache_file : string list list OpamFile.t =
                OpamFile.make @@ OpamFilename.Op.(
                    hash_cache_dir //
                    (OpamHash.string_of_kind k1 ^ "_to_" ^
                     OpamHash.string_of_kind k2))
              in
              let t_mapping = Hashtbl.create 187 in
              (OpamStd.Option.default [] (OpamFile.Lines.read_opt cache_file)
               |> List.iter @@ function
               | [src; dst] ->
                 Hashtbl.add t_mapping
                   (OpamHash.of_string src) (OpamHash.of_string dst)
               | _ -> failwith ("Bad cache at "^OpamFile.to_string cache_file));
              Hashtbl.add t (k1,k2) (cache_file, t_mapping);
            ))
          OpamHash.all_kinds
      )
      OpamHash.all_kinds;
    t
  in
  let save_hashes hash_tables =
    Hashtbl.iter (fun _ (file, tbl) ->
        Hashtbl.fold
          (fun src dst l -> [OpamHash.to_string src; OpamHash.to_string dst]::l)
          tbl [] |> fun lines ->
        try OpamFile.Lines.write file lines with e ->
          OpamStd.Exn.fatal e;
          OpamConsole.log "ADMIN"
            "Could not write hash cache to %s, skipping (%s)"
            (OpamFile.to_string file)
            (Printexc.to_string e))
      hash_tables
  in
  let additions_count = ref 0 in
  let get_hash hash_tables ~cache_urls ~cache_dir kind known_hashes url =
    let found =
      List.fold_left (fun result hash ->
          match result with
          | None ->
            let known_kind = OpamHash.kind hash in
            let _, tbl = Hashtbl.find hash_tables (known_kind, kind) in
            (try Some (Hashtbl.find tbl hash) with Not_found -> None)
          | some -> some)
        None known_hashes
    in
    match found with
    | Some h -> Some h
    | None ->
      let h =
        OpamProcess.Job.run @@
        OpamFilename.with_tmp_dir_job @@ fun dir ->
        let f = OpamFilename.Op.(dir // OpamUrl.basename url) in
        OpamProcess.Job.ignore_errors ~default:None
          (fun () ->
             OpamRepository.pull_file (OpamUrl.to_string url)
               ~cache_dir ~cache_urls
               f known_hashes [url]
             @@| function
             | Result () | Up_to_date () ->
               OpamHash.compute ~kind (OpamFilename.to_string f)
               |> Stdlib.Option.some
             | Not_available _ -> None)
      in
      (match h with
       | Some h ->
         List.iter (fun h0 ->
             Hashtbl.replace
               (snd (Hashtbl.find hash_tables (OpamHash.kind h0, kind)))
               h0 h
           ) known_hashes;
         incr additions_count;
         if !additions_count mod 20 = 0 then save_hashes hash_tables
       | None -> ());
      h
  in
  let cmd global_options hash_types replace packages () =
    OpamArg.apply_global_options cli global_options;
    let cache_dir =
      OpamRepositoryPath.download_cache OpamStateConfig.(!r.root_dir)
    in
    let hash_cache_dir = OpamFilename.Op.(cache_dir / "hash-cache") in
    let hash_tables = create_hash_tables hash_cache_dir in
    let repo_root = checked_repo_root () in
    let cache_urls =
      cache_urls repo_root
        (OpamFile.Repo.safe_read (OpamRepositoryRoot.Dir.Path.repo repo_root))
    in
    let pkg_prefixes = packages_with_prefixes repo_root packages in
    let has_error =
      OpamPackage.Map.fold (fun nv prefix has_error ->
          let opam_file = OpamRepositoryRoot.Dir.Path.opam repo_root prefix nv in
          let opam = OpamFile.OPAM.read opam_file in
          let has_error =
            if OpamFile.exists
                (OpamRepositoryRoot.Dir.Path.url repo_root prefix nv)
            then
              (OpamConsole.warning "Not updating external URL file at %s"
                 (OpamFile.to_string
                    (OpamRepositoryRoot.Dir.Path.url repo_root prefix nv));
               true)
            else has_error
          in
          let process_url has_error urlf =
            let hashes = OpamFile.URL.checksum urlf in
            let hashes =
              if replace then
                List.filter (fun h ->
                    OpamStd.List.mem OpamHash.equal_kind
                      (OpamHash.kind h) hash_types)
                  hashes
              else hashes
            in
            let has_error, hashes =
              List.fold_left (fun (has_error, hashes) kind ->
                  if List.exists (fun h -> OpamHash.kind h = kind) hashes
                  then has_error, hashes else
                    match get_hash hash_tables ~cache_urls ~cache_dir kind
                            hashes (OpamFile.URL.url urlf) with
                    | Some h -> has_error, hashes @ [h]
                    | None ->
                      OpamConsole.error "Could not get hash for %s: %s"
                        (OpamPackage.to_string nv)
                        (OpamUrl.to_string (OpamFile.URL.url urlf));
                      true, hashes)
                (has_error, hashes)
                hash_types
            in
            has_error, OpamFile.URL.with_checksum hashes urlf
          in
          let has_error, url_opt =
            match OpamFile.OPAM.url opam with
            | None -> has_error, None
            | Some urlf ->
              let has_error, urlf = process_url has_error urlf in
              has_error, Some urlf
          in
          let has_error, extra_sources =
            List.fold_right (fun (basename, urlf) (has_error, acc) ->
                let has_error, urlf = process_url has_error urlf in
                has_error, (basename, urlf) :: acc)
              (OpamFile.OPAM.extra_sources opam)
              (has_error, [])
          in
          let opam1 = OpamFile.OPAM.with_url_opt url_opt opam in
          let opam1 = OpamFile.OPAM.with_extra_sources extra_sources opam1 in
          if opam1 <> opam then
            OpamFile.OPAM.write_with_preserved_format opam_file opam1;
          has_error
        )
        pkg_prefixes false
    in
    save_hashes hash_tables;
    if has_error then OpamStd.Sys.exit_because `Sync_error
    else OpamStd.Sys.exit_because `Success
  in
  OpamArg.mk_command  ~cli OpamArg.cli_original command ~doc ~man
    Term.(const cmd $ global_options cli $
          hash_types_arg $ replace_arg $ packages)

let upgrade_command_doc =
  "Upgrades repository from earlier opam versions."
let upgrade_command cli =
  let command = "upgrade" in
  let doc = upgrade_command_doc in
  let man = [
    `S Manpage.s_description;
    `P (Printf.sprintf
          "This command reads repositories from earlier opam versions, and \
           converts them to repositories suitable for the current opam version. \
           Packages might be created or renamed, and any compilers defined in the \
           old format ('compilers%s' directory) will be turned into packages, \
           using a pre-defined hierarchy that assumes OCaml compilers."
          OpamArg.dir_sep)
  ]
  in
  let clear_cache_arg =
    OpamArg.mk_flag ~cli OpamArg.(cli_between cli2_0 cli2_6) ["clear-cache"]
      "Deprecated"
  in
  let create_mirror_arg =
    OpamArg.mk_opt ~cli OpamArg.cli_original ["m"; "mirror"] "URL"
      "Don't overwrite the current repository, but put an upgraded mirror in \
       place in a subdirectory, with proper redirections. Needs the URL the \
       repository will be served from to put in the redirects (older versions \
       of opam don't understand relative redirects)."
      Arg.(some OpamArg.url) None
  in
  let cmd global_options _clear_cache create_mirror () =
    OpamArg.apply_global_options cli global_options;
    let repo_root = checked_repo_root ~check:false () in
    match create_mirror with
    | None ->
      OpamAdminRepoUpgrade.do_upgrade repo_root;
      if OpamFilename.exists (OpamFilename.of_string "index.tar.gz") ||
         OpamFilename.exists (OpamFilename.of_string "urls.txt")
      then
        OpamConsole.note
          "Indexes need updating: you should now run:\n\
           \n\
          \  opam admin index"
    | Some m -> OpamAdminRepoUpgrade.do_upgrade_mirror repo_root m
  in
  OpamArg.mk_command  ~cli OpamArg.cli_original command ~doc ~man
    Term.(const cmd $ global_options cli $
          clear_cache_arg $ create_mirror_arg)

let lint_command_doc =
  "Runs 'opam lint' and reports on a whole repository"
let lint_command cli =
  let command = "lint" in
  let doc = lint_command_doc in
  let man = [
    `S Manpage.s_description;
    `P "This command gathers linting results on all files in a repository. The \
        warnings and errors to show or hide can be selected"
  ]
  in
  let short_arg =
    OpamArg.mk_flag ~cli OpamArg.cli_original ["s";"short"]
      "Print only packages and warning/error numbers, without explanations"
  in
  let list_arg =
    OpamArg.mk_flag ~cli OpamArg.cli_original ["list";"l"]
      "Only list package names, without warning details"
  in
  let include_arg =
    OpamArg.arg_list "INT" "Show only these warnings"
      OpamArg.positive_integer
  in
  let exclude_arg =
    OpamArg.mk_opt_all ~cli OpamArg.cli_original ["exclude";"x"] "INT"
      "Exclude the given warnings or errors"
      OpamArg.positive_integer
  in
  let ignore_arg =
    OpamArg.mk_opt_all ~cli OpamArg.cli_original ["ignore-packages";"i"] "INT"
      "Ignore any packages having one of these warnings or errors"
      OpamArg.positive_integer
  in
  let warn_error_arg =
    OpamArg.mk_flag ~cli OpamArg.cli_original ["warn-error";"W"]
      "Return failure on any warnings, not only on errors"
  in
  let cmd global_options short list incl excl ign warn_error () =
    OpamArg.apply_global_options cli global_options;
    let repo_root = checked_repo_root () in
    if not (OpamFilename.exists_dir
              OpamFilename.Op.(OpamRepositoryRoot.Dir.to_dir repo_root
                               / OpamRepositoryPathName.packages_d))
    then
        OpamConsole.error_and_exit `Bad_arguments
          "No repository found in current directory.\n\
           Please make sure there is a \"packages\" directory";
    let pkg_prefixes = OpamRepository.packages_with_prefixes repo_root in
    let ret =
      OpamPackage.Map.fold (fun nv prefix ret ->
          let opam_file = OpamRepositoryRoot.Dir.Path.opam repo_root prefix nv in
          let w, _ = OpamFileTools.lint_file ~handle_dirname:true opam_file in
          if List.exists (fun (n,_,_) -> OpamStd.List.mem Int.equal n ign) w then
            ret
          else
          let w =
            List.filter (fun (n,_,_) ->
                (incl = [] || OpamStd.List.mem Int.equal n incl) &&
                not (OpamStd.List.mem Int.equal n excl))
              w
          in
          if w <> [] then
            if list then
              OpamConsole.msg "%s\n" (OpamPackage.to_string nv)
            else if short then
              OpamConsole.msg "%s %s\n" (OpamPackage.to_string nv)
                (OpamStd.List.concat_map " " (fun (n,k,_) ->
                     OpamConsole.colorise
                       (match k with `Warning -> `yellow | `Error -> `red)
                       (string_of_int n))
                    w)
            else begin
              OpamConsole.carriage_delete ();
              OpamConsole.msg "In %s:\n%s\n"
                (OpamPackage.to_string nv)
                (OpamFileTools.warns_to_string w)
            end;
          ret && not (warn_error && w <> [] ||
                      List.exists (fun (_,k,_) -> k = `Error) w))
        pkg_prefixes
        true
    in
    OpamStd.Sys.exit_because (if ret then `Success else `False)
  in
  OpamArg.mk_command  ~cli OpamArg.cli_original command ~doc ~man
    Term.(const cmd $ global_options cli $
          short_arg $ list_arg $ include_arg $ exclude_arg $ ignore_arg $
          warn_error_arg)

let check_command_doc =
  "Runs some consistency checks on a repository"
let check_command cli =
  let command = "check" in
  let doc = check_command_doc in
  let man = [
    `S Manpage.s_description;
    `P "This command runs consistency checks on a repository, and prints a \
        report to stdout. Checks include packages that are not installable \
        (due e.g. to a missing dependency) and dependency cycles. The \
        'available' field is ignored for these checks, that is, all packages \
        are supposed to be available. By default, all checks are run."
  ]
  in
  let print_short_arg =
    OpamArg.mk_flag ~cli OpamArg.cli_original ["s";"short"]
      "Only output a list of uninstallable packages"
  in
  let installability_arg =
    OpamArg.mk_flag ~cli OpamArg.cli_original ["installability"]
      "Do the installability check (and disable the others by default)"
  in
  let cycles_arg =
    OpamArg.mk_flag ~cli OpamArg.cli_original ["cycles"]
      "Do the cycles check (and disable the others by default)"
  in
  let obsolete_arg =
    OpamArg.mk_flag ~cli OpamArg.cli_original ["obsolete"]
      "Analyse for obsolete packages"
  in
  let cmd global_options print_short
      installability cycles obsolete () =
    OpamArg.apply_global_options cli global_options;
    let repo_root = checked_repo_root () in
    let installability, cycles, obsolete =
      if installability || cycles || obsolete
      then installability, cycles, obsolete
      else true, true, false
    in
    let pkgs, unav_roots, uninstallable, cycle_packages, obsolete =
      OpamAdminCheck.check
        ~quiet:print_short ~installability ~cycles ~obsolete
        repo_root
    in
    let all_ok =
      OpamPackage.Set.is_empty uninstallable &&
      OpamPackage.Set.is_empty cycle_packages &&
      OpamPackage.Set.is_empty obsolete
    in
    let open OpamPackage.Set.Op in
    (if print_short then
       OpamConsole.msg "%s\n"
         (OpamStd.List.concat_map "\n" OpamPackage.to_string
            (OpamPackage.Set.elements
               (uninstallable ++ cycle_packages ++ obsolete)))
     else if all_ok then
       OpamConsole.msg "No issues detected on this repository's %d packages\n"
         (OpamPackage.Set.cardinal pkgs)
     else
     let pr set msg =
       if OpamPackage.Set.is_empty set then ""
       else Printf.sprintf "- %d %s\n" (OpamPackage.Set.cardinal set) msg
     in
     OpamConsole.msg "Summary: out of %d packages (%d distinct names)\n\
                      %s%s%s%s\n"
       (OpamPackage.Set.cardinal pkgs)
       (OpamPackage.Name.Set.cardinal (OpamPackage.names_of_packages pkgs))
       (pr unav_roots "uninstallable roots")
       (pr (uninstallable -- unav_roots) "uninstallable dependent packages")
       (pr (cycle_packages -- uninstallable)
          "packages part of dependency cycles")
       (pr obsolete "obsolete packages"));
    OpamStd.Sys.exit_because (if all_ok then `Success else `False)
  in
  OpamArg.mk_command  ~cli OpamArg.cli_original command ~doc ~man
  Term.(const cmd $ global_options cli $ print_short_arg
        $ installability_arg $ cycles_arg $ obsolete_arg)

let compare_versions_command_doc = "Compare two package versions"
let compare_versions_command cli =
  let operator : OpamFormula.relop option Term.t =
     let make_flag (relop : OpamFormula.relop) =
       let flag_name =
         match relop with
         | `Eq -> "eq"
         | `Neq -> "neq"
         | `Geq -> "geq"
         | `Gt -> "gt"
         | `Leq -> "leq"
         | `Lt -> "lt"
       in
       let doc = Printf.sprintf "assert V0 %s V1" (OpamFormula.string_of_relop relop) in
       OpamArg.(cli_from cli2_4), Some relop, [ flag_name ], doc
     in
     OpamArg.mk_vflag ~cli None (List.map make_flag OpamFormula.all_relop)
  in
  let version_arg n =
    let doc =
      Arg.info
        ~docv:(Printf.sprintf "V%d" n)
        ~doc:"Package version to compare" []
    in
    Arg.(required & pos n (some OpamArg.package_version) None & doc)
  in
  let command = "compare-versions" in
  let doc = compare_versions_command_doc in
  let man = [
    `S Manpage.s_description;
    `P "This command compares 2 package versions. By default it outputs 'V0 OP \
        V1' to the console with OP in {<,>,=} such that the equation holds. \
        When an operator is supplied, the output is suppressed and the result \
        of the comparison is checked against the provided operator: the command \
        exits 0 if the comparison holds, and 1 otherwise. For example:";
    `Pre "\n\
          \\$ opam admin compare-versions 0.0.9 0.0.10\n\
          0.0.9 < 0.0.10\n\
          \n\
          \\$ opam admin compare-versions 0.0.9 --lt 0.0.10\n\
          [0]\n\
          \n\
          \\$ opam admin compare-versions 0.0.9 --eq 0.0.10\n\
          [1]";
    `S Manpage.s_arguments;
    `S Manpage.s_options;
  ]
  in
  let cmd v0 v1 operator () =
    match operator with
    | None ->
      let result = OpamPackage.Version.compare v0 v1 in
      OpamConsole.formatted_msg "%s %s %s\n"
        (OpamPackage.Version.to_string v0)
        (if result < 0 then "<" else if result = 0 then "=" else ">")
        (OpamPackage.Version.to_string v1)
    | Some operator ->
      OpamStd.Sys.exit_because
        (if OpamFormula.eval_relop operator v0 v1
         then `Success
         else `False)
  in
  OpamArg.mk_command ~cli OpamArg.(cli_from cli2_4) command ~doc ~man
    Term.(const cmd $ version_arg 0 $ version_arg 1 $ operator)

let pattern_list_arg =
  OpamArg.arg_list "PATTERNS"
    "Package patterns with globs. matching against $(b,NAME) or \
     $(b,NAME.VERSION)"
    Arg.string

let env_arg cli =
  OpamArg.mk_opt ~cli OpamArg.cli_original ["environment"]
    "VAR=VALUE[,VAR=VALUE]"
    (Printf.sprintf
       "Use the given opam environment, in the form of a list of \
        comma-separated 'var=value' bindings, when resolving variables. This \
        is used e.g. when computing available packages: if undefined, \
        availability of packages will be assumed as soon as it can not be \
        resolved purely from globally defined variables. Note that, unless \
        overridden, variables like 'root' or 'opam-version' may be taken \
        from the current opam installation. What is defined in \
        $(i,~%s.opam%sconfig) is always ignored."
       OpamArg.dir_sep OpamArg.dir_sep)
    Arg.(list string) []

let state_selection_arg cli =
  OpamArg.mk_vflag ~cli ~section:OpamArg.order_sensible_selector_section
    OpamListCommand.Available [
    OpamArg.cli_original, OpamListCommand.Any, ["A";"all"],
    "Include all, even uninstalled or unavailable packages";
    OpamArg.cli_original, OpamListCommand.Available, ["a";"available"],
    "List only packages that are available according to the defined \
     $(b,environment). Without $(b,--environment), this will include \
     any packages for which availability is not resolvable at this \
     point.";
    OpamArg.cli_original, OpamListCommand.Installable, ["installable"],
    "List only packages that are installable according to the defined \
     $(b,environment) (this calls the solver and may be more costly; \
     a package depending on an unavailable one may be available, but \
     is never installable)";
    OpamArg.cli_from OpamArg.cli2_3, OpamListCommand.Latests_only,
    ["latests-only"], "List only the latest version of each package.";
  ]

let get_virtual_switch_state repo_root env =
  let env =
    List.map (fun s ->
        match OpamStd.String.cut_at s '=' with
        | Some (var,value) -> OpamVariable.of_string var, S value
        | None -> OpamVariable.of_string s, B true)
      env
  in
  let repo = {
    repo_name = OpamRepositoryName.of_string "local";
    repo_url = OpamUrl.empty;
    repo_trust = None;
  } in
  let repo_file = OpamRepositoryRoot.Dir.Path.repo repo_root in
  let repo_def = OpamFile.Repo.safe_read repo_file in
  let opams =
    OpamRepositoryState.load_opams_from_dir repo.repo_name repo_root
  in
  let gt = {
    global_lock = OpamSystem.lock_none;
    lock = OpamSystem.lock_none;
    root = OpamStateConfig.(!r.root_dir);
    config = OpamStd.Option.Op.(OpamStateConfig.(
        load ~lock_kind:`Lock_read !r.root_dir) +!
                                OpamFile.Config.empty);
    global_variables = OpamVariable.Map.empty;
    global_state_to_upgrade = { gtc_repo = false; gtc_switch = false; };
  } in
  let singl x = OpamRepositoryName.Map.singleton repo.repo_name x in
  let rt = {
    repos_global = gt;
    repos_lock = OpamSystem.lock_none;
    repositories = singl repo;
    repos_definitions = singl repo_def;
    repo_opams = singl opams;
    repos_syspkgs_available = None;
  } in
  let gt =
    {gt with global_variables =
               OpamVariable.Map.of_list @@
               List.map (fun (var, value) ->
                   var, (lazy (Some value), "Manually defined"))
                 env }
  in
  OpamSwitchState.load_virtual
    ~repos_list:[repo.repo_name]
    ~avail_default:(env = [])
    gt rt

let or_arg cli =
  OpamArg.mk_flag ~cli OpamArg.cli_original ~section:OpamArg.package_selection_section ["or"]
    "Instead of selecting packages that match $(i,all) the \
     criteria, select packages that match $(i,any) of them"

let list_command_doc = "Lists packages from a repository"
let list_command cli =
  let command = "list" in
  let doc = list_command_doc in
  let man = [
    `S Manpage.s_description;
    `P "This command is similar to 'opam list', but allows listing packages \
        directly from a repository instead of what is available in a given \
        opam installation.";
    `S Manpage.s_arguments;
    `S Manpage.s_options;
    `S OpamArg.order_sensible_selector_section;
    `P "These options are sensible to the order they are given to the command. \
        For example: $(b,--available --latests-only) will first list all the \
        available packages, then choose only the latest packages in that set; \
        while $(b,--latests-only --available) will first lists all the latest \
        packages, then only show the ones that are available in that set.";
    `S OpamArg.package_selection_section;
    `P "These options will always be given to the command in the same order, \
        regardless of the order they have been given to the command.";
    `S OpamArg.package_listing_section;
  ]
  in
  let cmd
      global_options package_selection disjunction state_selection
      package_listing env packages () =
    OpamArg.apply_global_options cli global_options;
    let repo_root = checked_repo_root () in
    let format =
      let force_all_versions =
        match packages with
        | [single] ->
          let nameglob =
            match OpamStd.String.cut_at single '.' with
            | None -> single
            | Some (n, _v) -> n
          in
          (try
             let _ : name = OpamPackage.Name.of_string nameglob in
             true
           with Failure _ -> false)
        | _ -> false
      in
      package_listing ~force_all_versions
    in
    let pattern_selector = OpamListCommand.pattern_selector packages in
    let join =
      if disjunction then OpamFormula.ors else OpamFormula.ands
    in
    let filter =
      OpamFormula.ands [
        Atom state_selection;
        join (pattern_selector ::
              List.map (fun x -> Atom x) package_selection);
      ]
    in
    let st = get_virtual_switch_state repo_root env in
    if not format.OpamListCommand.short && filter <> OpamFormula.Empty then
      OpamConsole.msg "# Packages matching: %s\n"
        (OpamListCommand.string_of_formula filter);
    let results =
      OpamListCommand.filter ~base:st.packages st filter
    in
    OpamListCommand.display st format results
  in
  OpamArg.mk_command  ~cli OpamArg.cli_original command ~doc ~man
  Term.(const cmd $ global_options cli $ OpamArg.package_selection cli $
        or_arg cli $ state_selection_arg cli $ OpamArg.package_listing cli $
        env_arg cli $ pattern_list_arg)

let filter_command_doc = "Filters a repository to only keep selected packages"
let filter_command cli =
  let command = "filter" in
  let doc = filter_command_doc in
  let man = [
    `S Manpage.s_description;
    `P "This command removes all package definitions that don't match the \
        search criteria (specified similarly to 'opam admin list') from a \
        repository.";
    `S Manpage.s_arguments;
    `S Manpage.s_options;
    `S OpamArg.package_selection_section;
  ]
  in
  let remove_arg =
    OpamArg.mk_flag ~cli OpamArg.cli_original ["remove"]
      "Invert the behaviour and remove the matching packages, keeping the ones \
       that don't match."
  in
  let dryrun_arg =
    OpamArg.mk_flag ~cli OpamArg.cli_original ["dry-run"]
      "List the removal commands, without actually performing them"
  in
  let cmd
      global_options package_selection disjunction state_selection env
      remove dryrun packages () =
    OpamArg.apply_global_options cli global_options;
    let repo_root = checked_repo_root () in
    let pattern_selector = OpamListCommand.pattern_selector packages in
    let join =
      if disjunction then OpamFormula.ors else OpamFormula.ands
    in
    let filter =
      OpamFormula.ands [
        Atom state_selection;
        join
          (pattern_selector ::
           List.map (fun x -> Atom x) package_selection)
      ]
    in
    let st = get_virtual_switch_state repo_root env in
    let packages = OpamListCommand.filter ~base:st.packages st filter in
    if OpamPackage.Set.is_empty packages then
      if remove then
        (OpamConsole.warning "No packages match the selection criteria";
         OpamStd.Sys.exit_because `Success)
      else
        OpamConsole.error_and_exit `Not_found
          "No packages match the selection criteria";
    let num_total = OpamPackage.Set.cardinal st.packages in
    let num_selected = OpamPackage.Set.cardinal packages in
    if remove then
      OpamConsole.formatted_msg
        "The following %d packages will be REMOVED from the repository (%d \
         packages will be kept):\n%s\n"
        num_selected (num_total - num_selected)
        (OpamStd.List.concat_map " " OpamPackage.to_string
           (OpamPackage.Set.elements packages))
    else
      OpamConsole.formatted_msg
        "The following %d packages will be kept in the repository (%d packages \
         will be REMOVED):\n%s\n"
        num_selected (num_total - num_selected)
        (OpamStd.List.concat_map " " OpamPackage.to_string
           (OpamPackage.Set.elements packages));
    let packages =
      if remove then packages else OpamPackage.Set.Op.(st.packages -- packages)
    in
    if not (dryrun || OpamConsole.confirm "Confirm?") then
      OpamStd.Sys.exit_because `Aborted
    else
    let pkg_prefixes = OpamRepository.packages_with_prefixes repo_root in
    OpamPackage.Map.iter (fun nv prefix ->
        if OpamPackage.Set.mem nv packages then
          let d = OpamRepositoryRoot.Dir.Path.packages repo_root prefix nv in
          if dryrun then
            OpamConsole.msg "rm -rf %s\n" (OpamFilename.Dir.to_string d)
          else
            (OpamFilename.cleandir d;
             OpamFilename.rmdir_cleanup d))
      pkg_prefixes
  in
  OpamArg.mk_command  ~cli OpamArg.cli_original command ~doc ~man
  Term.(const cmd $ global_options cli $ OpamArg.package_selection cli $
        or_arg cli $ state_selection_arg cli $ env_arg cli $ remove_arg $
        dryrun_arg $
        pattern_list_arg)

let add_constraint_command_doc =
  "Adds version constraints on all dependencies towards a given package"
let add_constraint_command cli =
  let command = "add-constraint" in
  let doc = add_constraint_command_doc in
  let man = [
    `S Manpage.s_description;
    `P "This command searches to all dependencies towards a given package, and \
        adds a version constraint to them. It is particularly useful to add \
        upper bounds to existing dependencies when a new, incompatible major \
        version of a library is added to a repository. The new version \
        constraint is merged with the existing one, and simplified if \
        possible (e.g. $(b,>=3 & >5) becomes $(b,>5)).";
    `S Manpage.s_arguments;
    `S Manpage.s_options;
  ]
  in
  let atom_arg =
    Arg.(required & pos 0 (some OpamArg.atom) None
         & info [] ~docv:"PACKAGE" ~doc:
           "A package name with a version constraint, e.g. $(b,name>=version). \
            If no version constraint is specified, the command will just \
            simplify existing version constraints on dependencies to the named \
            package.")
  in
  let force_arg =
    OpamArg.mk_flag ~cli OpamArg.cli_original ["force"]
      "Force updating of constraints even if the resulting constraint is \
       unsatisfiable (e.g. when adding $(b,>3) to the constraint \
       $(b,<2)). The default in this case is to print a warning and keep \
       the existing constraint unchanged."
  in
  let packages =
    OpamArg.mk_opt ~cli OpamArg.(cli_from cli2_2) ["p";"packages"]
      "PACKAGES" "Only add constraints for the given packages"
      Arg.(list OpamArg.package) []
  in
  let cmd global_options force atom packages () =
    OpamArg.apply_global_options cli global_options;
    let repo_root = checked_repo_root () in
    let pkg_prefixes = packages_with_prefixes repo_root packages in
    let name, cstr_opt = atom in
    let cstr = match cstr_opt with
      | Some (relop, v) ->
        OpamFormula.Atom
          (Constraint (relop, FString (OpamPackage.Version.to_string v)))
      | None ->
        OpamFormula.Empty
    in
    let add_cstr op cstr nv n c =
      let f = op [ cstr; c] in
      match OpamFilter.simplify_extended_version_formula f with
      | Some f -> f
      | None -> (* conflicting constraint *)
        if force then f
        else
          (OpamConsole.warning
             "In package %s, updated constraint %s cannot be satisfied, not \
              updating (use `--force' to update anyway)"
             (OpamPackage.to_string nv)
             (OpamConsole.colorise `bold
                (OpamFilter.string_of_filtered_formula
                   (Atom (n, f))));
           c)
    in
    OpamPackage.Map.iter (fun nv prefix ->
        let opam_file = OpamRepositoryRoot.Dir.Path.opam repo_root prefix nv in
        let opam = OpamFile.OPAM.read opam_file in
        let deps0 = OpamFile.OPAM.depends opam in
        let deps =
          OpamFormula.map (function
              | (n,c as atom) ->
                if n = name then Atom (n, (add_cstr OpamFormula.ands cstr nv n c))
                else Atom atom)
            deps0
        in
        let depopts0 = OpamFile.OPAM.depopts opam in
        let conflicts0 = OpamFile.OPAM.conflicts opam in
        let contains name =
          OpamFormula.fold_left (fun contains (n,_) ->
              contains || n = name) false
        in
        let conflicts =
          if contains name depopts0 then
            match cstr_opt with
            | Some (relop, v) ->
              let icstr =
                OpamFormula.Atom
                  (Constraint (OpamFormula.neg_relop relop,
                               FString (OpamPackage.Version.to_string v)))
              in
              if contains name conflicts0 then
                OpamFormula.map (function
                    | (n,c as atom) ->
                      if n = name then Atom (n, (add_cstr OpamFormula.ors icstr nv n c))
                      else Atom atom)
                  conflicts0
              else
                OpamFormula.ors [ conflicts0; Atom (name, icstr) ]
            | None -> conflicts0
          else conflicts0
        in
        if deps <> deps0 || conflicts <> conflicts0 then
          OpamFile.OPAM.write_with_preserved_format opam_file
            (OpamFile.OPAM.with_depends deps opam
             |> OpamFile.OPAM.with_conflicts conflicts))
      pkg_prefixes
  in
  OpamArg.mk_command  ~cli OpamArg.cli_original command ~doc ~man
  Term.(const cmd $ global_options cli $ force_arg $ atom_arg $ packages)

(* HELP *)
let help =
  let doc = "Display help about opam admin and opam admin subcommands." in
  let man = [
    `S Manpage.s_description;
    `P "Prints help about opam admin commands.";
    `P "Use `$(mname) help topics' to get the full list of help topics.";
  ] in
  let topic =
    let doc = Arg.info [] ~docv:"TOPIC" ~doc:"The topic to get help on." in
    Arg.(value & pos 0 (some string) None & doc )
  in
  let help man_format cmds topic = match topic with
    | None       -> `Help (`Pager, None)
    | Some topic ->
      let topics = "topics" :: cmds in
      let conv =
        OpamCmdliner.Arg.conv_parser
          (OpamCmdliner.Arg.enum (List.rev_map (fun s -> (s, s)) topics))
      in
      match conv topic with
      | Error (`Msg e) -> `Error (false, e)
      | Ok t when t = "topics" ->
          List.iter (OpamConsole.msg "%s\n") cmds; `Ok ()
      | Ok t -> `Help (man_format, Some t) in

  Term.(ret (const help $Arg.man_format $Term.choice_names $topic)),
  Cmd.info "help" ~doc ~man

let admin_subcommands cli =
  let index_command = index_command cli in
  [
    index_command; OpamArg.make_command_alias ~cli index_command "make";
    cache_command cli;
    upgrade_command cli;
    lint_command cli;
    check_command cli;
    compare_versions_command cli;
    list_command cli;
    filter_command cli;
    add_constraint_command cli;
    add_hashes_command cli;
    update_extrafiles_command cli;
    migrate_extrafiles_command cli;
    help;
  ]

let default_subcommand cli =
  let man =
    admin_command_man @ [
      `S Manpage.s_commands;
      `S "COMMAND ALIASES";
    ] @ OpamArg.help_sections cli
  in
  let usage global_options =
    OpamArg.apply_global_options cli global_options;
    OpamConsole.formatted_msg
      "usage: opam admin [--version]\n\
      \                  [--help]\n\
      \                  <command> [<args>]\n\
       \n\
       The most commonly used opam admin commands are:\n\
      \    index          %s\n\
      \    cache          %s\n\
      \    upgrade-format %s\n\
       \n\
       See 'opam admin <command> --help' for more information on a specific \
       command.\n"
      index_command_doc
      cache_command_doc
      upgrade_command_doc
  in
  Term.(const usage $ global_options cli),
  Cmd.info "opam admin"
    ~version:(OpamVersion.to_string OpamVersion.current)
    ~sdocs:OpamArg.global_option_section
    ~doc:admin_command_doc
    ~man

let get_cmdliner_parser cli =
  default_subcommand cli, admin_subcommands cli