Merge pull request #2040 from OCamlPro/custom-commands

Allow custom commands for solver and downloads through $opam/config or the environment

doc/dev-manual/dev-manual.tex

@@ -210,17 +210,43 @@ \subsubsection{Global Configuration File: {\tt config}}
     opam-version: "1.2"
     repositories: [ STRING+ ]
     switch: STRING
-    cores: INT
+    ?jobs: INT
+    ?solver: <single-command>
+    ?solver-criteria: STRING
+    ?solver-upgrade-criteria: STRING
+    ?solver-fixup-criteria: STRING
+    ?download-command: <single-command>
+    ?download-jobs: INT
+
+<single-command> := [ (<argument> ?{ <filter> })+ ]
 \end{Verbatim}
 
-The field {\tt opam-version} indicates the current \OPAM\ format.
-
-The field {\tt repositories} contains the list of \OPAM\ repositories.
-
-The field {\tt switch} corresponds to the current compiler instance.
-
-The field {\tt cores} is the number of parallel process that
-\OPAM\ will use when trying to build the packages.
+\begin{itemize}
+\item {\tt opam-version} indicates the current \OPAM\ repository format --
+  normally corresponding to the \OPAM\ minor version (\verb+MAJOR.MINOR+)
+\item {\tt repositories} contains the names of the currently configured
+  repositories.
+\item {\tt switch} is the name of the currently active \OPAM\ switch.
+\item {\tt jobs} is the maximum number of build processes that can be run
+  simultaneously.
+\item {\tt solver} is the external solver to call. The value may be either the
+  single identifiers \verb+aspcud+ or \verb+packup+, which have built-in
+  support, or a command. The string variables \verb+input+, \verb+output+ and
+  \verb+criteria+ (only) are defined when evaluating this field.
+\item {\tt solver-criteria}, {\tt solver-upgrade-criteria} and {\tt
+    solver-fixup-criteria} are the optimisation criteria provided to the solver
+  resp. in the default case (install requested packages at their latest version,
+  minimising the impact on other packages), for global upgrades (minimise
+  outdated packages) and for fixup (resolve dependencies while minimising
+  changes).
+\item {\tt download-command} will be called to fetch remote files over http(s)
+  or ftp. The value may be either the single identifiers \verb+curl+ or
+  \verb+wget+, which have built-in support, or a custom command. Only the
+  special variables \verb+url+, \verb+out+, \verb+retries+ (strings) and
+  \verb+compress+ (bool) can be used in this field.
+\item {\tt download-jobs} is the maximum number of simultaneous downloads (all
+  remote hosts included)
+\end{itemize}
 
 \subsubsection{Package Specification files: {\tt opam}}
 \label{file:opam}

src/client/opamArg.ml

@@ -130,11 +130,11 @@ let apply_global_options o =
   OpamGlobals.yes      := !OpamGlobals.yes || o.yes;
   OpamGlobals.strict   := !OpamGlobals.strict || o.strict;
   OpamGlobals.no_base_packages := !OpamGlobals.no_base_packages || o.no_base_packages;
-  OpamGlobals.external_solver :=
-    OpamMisc.Option.Op.(o.external_solver ++ !OpamGlobals.external_solver);
+  OpamGlobals.env_external_solver :=
+    OpamMisc.Option.Op.(o.external_solver ++ !OpamGlobals.env_external_solver);
   OpamGlobals.use_external_solver :=
     !OpamGlobals.use_external_solver && not o.use_internal_solver &&
-    !OpamGlobals.external_solver <> Some "";
+    !OpamGlobals.env_external_solver <> Some "";
   OpamGlobals.cudf_file :=
     OpamMisc.Option.Op.(o.cudf_file ++ !OpamGlobals.cudf_file);
   OpamGlobals.no_self_upgrade := !OpamGlobals.no_self_upgrade || o.no_self_upgrade;
@@ -215,11 +215,15 @@ let help_sections = [
   `P ("$(i,OPAMCRITERIA) specifies user $(i,preferences) for dependency solving.\
       The default value is "^OpamGlobals.default_preferences `Default^". \
       See also option --criteria");
-  `P "$(i,OPAMCURL) can be used to define an alternative for the 'curl' \
-      command-line utility to download files.";
+  `P "$(i,OPAMCURL) can be used to select a given 'curl' program. See \
+      $(i,OPAMFETCH) for more options.";
   `P "$(i,OPAMDEBUG) see options `--debug' and `--debug-level'.";
   `P "$(i,OPAMDOWNLOADJOBS) sets the maximum number of simultaneous downloads.";
   `P "$(i,OPAMEXTERNALSOLVER) see option `--solver'.";
+  `P "$(i,OPAMFETCH) specifies how to download files: either `wget', `curl' or \
+      a custom command where variables $(b,%{url}%), $(b,%{out}%), \
+      $(b,%{retries}%) and $(b,%{compress}%) will be replaced. Overrides the \
+      'download-command' value from the main config file.";
   `P "$(i,OPAMJOBS) sets the maximum number of parallel workers to run.";
   `P "$(i,OPAMLOCKRETRIES) sets the number of tries after which OPAM gives up \
       acquiring its lock and fails. <= 0 means infinite wait.";
@@ -597,7 +601,9 @@ let global_options =
   let external_solver =
     mk_opt ~section ["solver"] "CMD"
       ("Specify the name of the external dependency $(i,solver). \
-        The default value is "^OpamGlobals.default_external_solver)
+        The default value is "^OpamGlobals.default_external_solver^
+       ". Either 'aspcud', 'packup' or a custom command that may contain \
+        the variables %{input}%, %{output}% and %{criteria}%")
       Arg.(some string) None in
   let solver_preferences =
     mk_opt ~section ["criteria"] "CRITERIA"
@@ -1051,7 +1057,9 @@ let config =
       print "os" "%s" (OpamGlobals.os_string ());
       print "external-solver" "%s"
         (if OpamCudf.external_solver_available () then
-           OpamGlobals.get_external_solver ()
+           String.concat " "
+             (OpamGlobals.external_solver
+                ~input:"$in" ~output:"$out" ~criteria:"$criteria")
          else "no");
       print "criteria" "%s"
         (try List.assoc `Default !OpamGlobals.solver_preferences

src/client/opamClient.ml

@@ -1224,10 +1224,10 @@ module API = struct
                     install the %s command on your system."
                    msg (OpamGlobals.colorise `bold cmd))
                unavailable_repos);
-        if not (check_external_dep (OpamGlobals.get_external_solver())) then
+        if not (check_external_dep (OpamGlobals.default_external_solver)) then
           OpamGlobals.warning
             "Recommended external solver %s not found."
-            (OpamGlobals.colorise `bold (OpamGlobals.get_external_solver ()));
+            (OpamGlobals.colorise `bold (OpamGlobals.default_external_solver));
         let advised_deps = [!OpamGlobals.makecmd(); "m4"; "cc"] in
         (match List.filter (not @* check_external_dep) advised_deps with
          | [] -> ()
@@ -1238,9 +1238,14 @@ module API = struct
              (OpamMisc.itemize (OpamGlobals.colorise `bold) missing));
         let required_deps =
           ["curl or wget",
-           check_external_dep
-             (OpamMisc.Option.default "curl" OpamGlobals.curl_command)
-           || check_external_dep "wget";
+           check_external_dep OpamGlobals.curl_command ||
+           check_external_dep "wget" ||
+           (match !OpamGlobals.download_tool with
+            | Some (`Custom f) ->
+              (match f ~url:"" ~out:"-" ~retry:1 ~compress:false with
+               | cmd::_ -> check_external_dep cmd
+               | [] -> false)
+            | _ -> false);
            "patch", check_external_dep "patch";
            "tar", check_external_dep "tar";
            "unzip", check_external_dep "unzip" ]

src/client/opamState.ml

@@ -1383,13 +1383,9 @@ let upgrade_to_1_1_hook =
 let upgrade_to_1_2_hook =
   ref (fun () -> assert false)
 
-let load_state ?(save_cache=true) call_site =
-  log "LOAD-STATE(%s)" call_site;
-  let chrono = OpamGlobals.timer () in
-  !upgrade_to_1_1_hook ();
-
-  let root = OpamPath.root () in
-
+(* Loads the global config file and update some global references in
+   OpamGlobals *)
+let load_config root =
   let config_p = OpamPath.config root in
   let config =
     let config = OpamFile.Config.read config_p in
@@ -1411,10 +1407,46 @@ let load_state ?(save_cache=true) call_site =
     ) else
       config in
 
-  OpamGlobals.external_solver :=
-    OpamMisc.Option.Op.(
-      !OpamGlobals.external_solver ++
-      OpamFile.Config.solver config);
+  let command_of_string s =
+    List.map (fun s -> CString s, None) (OpamMisc.split s ' ')
+  in
+  (* Set some globals *)
+  let external_solver_command =
+    let cmd = match !OpamGlobals.env_external_solver with
+      | Some ("aspcud" | "packup" as s) -> [CIdent s, None]
+      | Some s -> command_of_string s
+      | None -> match OpamFile.Config.solver config with
+        | Some f ->
+          OpamGlobals.env_external_solver :=
+            Some (OpamMisc.sconcat_map " "
+                    (function (CIdent i,_) -> "%{"^i^"}%" | (CString s,_) -> s)
+                    f);
+          f
+        | None -> [CIdent OpamGlobals.default_external_solver, None]
+    in
+    let cmd = match cmd with
+      | [CIdent "aspcud", None] ->
+        List.map (fun s -> s, None)
+          [CString "aspcud"; CIdent "input"; CIdent "output"; CIdent "criteria"]
+      | [CIdent "packup", None] ->
+        List.map (fun s -> s, None)
+          [CString "packup"; CIdent "input"; CIdent "output";
+           CString "-u"; CIdent "criteria"]
+      | cmd -> cmd
+    in
+    fun ~input ~output ~criteria ->
+      OpamFilter.single_command (fun v ->
+          if not (is_global_conf v) then None else
+          match OpamVariable.to_string (OpamVariable.Full.variable v) with
+          | "input" -> Some (S input)
+          | "output" -> Some (S output)
+          | "criteria" -> Some (S criteria)
+          | _ -> None)
+        cmd
+  in
+
+  OpamGlobals.external_solver_ref := Some external_solver_command;
+
   let solver_prefs =
     let config_crit =
       !OpamGlobals.solver_preferences @ OpamFile.Config.criteria config in
@@ -1429,6 +1461,43 @@ let load_state ?(save_cache=true) call_site =
   in
   OpamGlobals.solver_preferences := solver_prefs;
 
+  let dl_tool =
+    match !OpamGlobals.download_tool_env with
+    | Some ("curl" | "wget" as s) -> Some [CIdent s, None]
+    | Some s -> Some (command_of_string s)
+    | None -> OpamFile.Config.dl_tool config
+  in
+  let dl_command cmd =
+    fun ~url ~out ~retry ~compress ->
+      OpamFilter.single_command (fun v ->
+          if not (is_global_conf v) then None else
+          match OpamVariable.to_string (OpamVariable.Full.variable v) with
+          | "url" -> Some (S url)
+          | "out" -> Some (S out)
+          | "retry" -> Some (S (string_of_int retry))
+          | "compress" -> Some (B compress)
+          | _ -> None)
+        cmd
+  in
+  let download_tool = match dl_tool with
+    | Some [CIdent "curl", None] -> Some `Curl
+    | Some [CIdent "wget", None] -> Some `Wget
+    | Some cmd -> Some (`Custom (dl_command cmd))
+    | None -> None
+  in
+  OpamGlobals.download_tool := download_tool;
+
+  config
+
+let load_state ?(save_cache=true) call_site =
+  log "LOAD-STATE(%s)" call_site;
+  let chrono = OpamGlobals.timer () in
+  !upgrade_to_1_1_hook ();
+
+  let root = OpamPath.root () in
+
+  let config = load_config root in
+
   let opams =
     let file = OpamPath.state_cache root in
     if OpamFilename.exists file then marshal_from_file file
@@ -1470,7 +1539,7 @@ let load_state ?(save_cache=true) call_site =
             (OpamSwitch.to_string switch)
             (OpamSwitch.to_string new_switch);
           let config = OpamFile.Config.with_switch config new_switch in
-          OpamFile.Config.write config_p config;
+          OpamFile.Config.write (OpamPath.config root) config;
           new_switch, new_compiler;
         ) else
           OpamGlobals.error_and_exit

src/core/opamFile.ml

@@ -730,9 +730,10 @@ module X = struct
       repositories  : repository_name list ;
       switch        : switch;
       jobs          : int;
+      dl_tool       : arg list option;
       dl_jobs       : int;
       criteria      : (solver_criteria * string) list;
-      solver        : string option;
+      solver        : arg list option;
     }
 
     let with_repositories t repositories = { t with repositories }
@@ -745,20 +746,22 @@ module X = struct
     let repositories t = t.repositories
     let switch t = t.switch
     let jobs t = t.jobs
+    let dl_tool t = t.dl_tool
     let dl_jobs t = t.dl_jobs
     let criteria t = t.criteria
     let solver t = t.solver
 
-    let create switch repositories ?(criteria=[]) ?solver jobs dl_jobs =
+    let create switch repositories ?(criteria=[]) ?solver jobs ?download_tool dl_jobs =
       { opam_version = OpamVersion.current;
-        repositories ; switch ; jobs ; dl_jobs ;
+        repositories ; switch ; jobs ; dl_tool = download_tool; dl_jobs ;
         criteria ; solver }
 
     let empty = {
       opam_version = OpamVersion.current;
       repositories = [];
       switch = OpamSwitch.of_string "<empty>";
       jobs = OpamGlobals.default_jobs;
+      dl_tool = None;
       dl_jobs = OpamGlobals.default_dl_jobs;
       criteria = [];
       solver = None;
@@ -771,6 +774,7 @@ module X = struct
     let s_switch2 = "ocaml-version"
 
     let s_jobs = "jobs"
+    let s_dl_tool = "download-command"
     let s_dl_jobs = "download-jobs"
     let s_criteria = "solver-criteria"
     let s_upgrade_criteria = "solver-upgrade-criteria"
@@ -787,6 +791,7 @@ module X = struct
       s_repositories;
       s_switch;
       s_jobs;
+      s_dl_tool;
       s_dl_jobs;
       s_criteria;
       s_upgrade_criteria;
@@ -821,23 +826,29 @@ module X = struct
       let switch1 = mk_switch s_switch1 in
       let switch2 = mk_switch s_switch2 in
       let switch =
-        match switch, switch1, switch2 with
-        | Some v, _     , _
-        | _     , Some v, _
-        | _     , _     , Some v -> v
-        | None  , None  , None   -> OpamGlobals.error_and_exit
-                                      "No current switch defined." in
+        match OpamMisc.Option.Op.(switch ++ switch1 ++ switch2) with
+        | Some v -> v
+        | None -> OpamGlobals.error_and_exit
+                    "No current switch defined in %s."
+                    (OpamFilename.to_string filename) in
       let jobs =
         try
-        let mk str = OpamFormat.assoc_option s.file_contents str OpamFormat.parse_int in
-        match mk s_jobs, mk s_cores with
-        | Some i, _      -> i
-        | _     , Some i -> i
-        | _              -> 1
+        let mk str =
+          OpamFormat.assoc_option s.file_contents str OpamFormat.parse_int in
+        match OpamMisc.Option.Op.(mk s_jobs ++ mk s_cores) with
+        | Some i -> i
+        | None -> OpamGlobals.default_jobs
         with OpamFormat.Bad_format _ when permissive ->
           OpamGlobals.default_jobs
       in
 
+      let dl_tool =
+        try
+          OpamFormat.assoc_option s.file_contents s_dl_tool
+            OpamFormat.parse_single_command
+        with OpamFormat.Bad_format _ when permissive -> None
+      in
+
       let dl_jobs =
         try
         match OpamFormat.assoc_option s.file_contents s_dl_jobs
@@ -862,9 +873,12 @@ module X = struct
       in
 
       let solver =
-        OpamFormat.assoc_option s.file_contents s_solver OpamFormat.parse_string
+        try
+          OpamFormat.assoc_option s.file_contents s_solver
+            OpamFormat.parse_single_command
+        with OpamFormat.Bad_format _ when permissive -> None
       in
-      { opam_version; repositories; switch; jobs; dl_jobs;
+      { opam_version; repositories; switch; jobs; dl_tool; dl_jobs;
         criteria; solver }
 
     let to_string filename t =
@@ -882,7 +896,14 @@ module X = struct
       let solver = match t.solver with
         | None -> []
         | Some s ->
-          [OpamFormat.make_variable (s_solver, OpamFormat.make_string s)]
+          [OpamFormat.make_variable
+             (s_solver, OpamFormat.make_single_command s)]
+      in
+      let download_tool = match t.dl_tool with
+        | None -> []
+        | Some dlt ->
+          [OpamFormat.make_variable
+             (s_dl_tool, OpamFormat.make_single_command dlt)]
       in
       let s = {
         file_format   = OpamVersion.current;
@@ -899,6 +920,7 @@ module X = struct
           OpamFormat.make_variable (s_switch, OpamFormat.make_string (OpamSwitch.to_string t.switch))
         ] @ criteria
           @ solver
+          @ download_tool
       } in
       Syntax.to_string s
   end