[Libguestfs] [PATCH v3 2/8] curl: Change the API to use an abstract data type.

[Richard W.M. Jones]

Change the Curl module to use an ADT to store the name of the curl
binary and the arguments.

The callers in virt-v2v are changed accordingly.

This also adds a (currently unused) ?proxy argument to allow callers
to override the proxy.  It also adds some safety arguments implicitly.
---
 mllib/curl.ml        | 50 ++++++++++++++++++++++++++++++++++++++------------
 mllib/curl.mli       | 50 +++++++++++++++++++++++++++++++++++++++++---------
 v2v/copy_to_local.ml | 11 ++++++-----
 v2v/vCenter.ml       | 13 +++++++------
 4 files changed, 92 insertions(+), 32 deletions(-)

diff --git a/mllib/curl.ml b/mllib/curl.ml
index f0af160..d7983ec 100644
--- a/mllib/curl.ml
+++ b/mllib/curl.ml
@@ -20,10 +20,32 @@ open Printf
 
 open Common_utils
 
-type curl_args = (string * string option) list
+let quote = Filename.quote
 
-let run curl_args =
-  let config_file, chan = Filename.open_temp_file "v2vcurl" ".conf" in
+type t = {
+  curl : string;
+  args : args;
+}
+and args = (string * string option) list
+
+let safe_args = [
+  "max-redirs", Some "5";
+  "globoff", None;         (* Don't glob URLs. *)
+]
+
+type proxy = UnsetProxy | SystemProxy | ForcedProxy of string
+
+let args_of_proxy = function
+  | UnsetProxy ->      [ "proxy", Some "" ; "noproxy", Some "*" ]
+  | SystemProxy ->     []
+  | ForcedProxy url -> [ "proxy", Some url; "noproxy", Some "" ]
+
+let create ?(curl = "curl") ?(proxy = SystemProxy) args =
+  let args = safe_args @ args_of_proxy proxy @ args in
+  { curl = curl; args = args }
+
+let run { curl = curl; args = args } =
+  let config_file, chan = Filename.open_temp_file "curl" ".conf" in
   List.iter (
     function
     | name, None -> fprintf chan "%s\n" name
@@ -44,21 +66,25 @@ let run curl_args =
         | c -> output_char chan c
       done;
       fprintf chan "\"\n"
-  ) curl_args;
+  ) args;
   close_out chan;
 
-  let cmd = sprintf "curl -q --config %s" (Filename.quote config_file) in
+  let cmd = sprintf "%s -q --config %s" (quote curl) (quote config_file) in
   let lines = external_command ~echo_cmd:false cmd in
   Unix.unlink config_file;
   lines
 
-let print_curl_command chan curl_args =
-  fprintf chan "curl -q";
+let to_string { curl = curl; args = args } =
+  let b = Buffer.create 128 in
+  bprintf b "%s -q" (quote curl);
   List.iter (
     function
-    | name, None -> fprintf chan " --%s" name
+    | name, None -> bprintf b " --%s" name
     (* Don't print passwords in the debug output. *)
-    | "user", Some _ -> fprintf chan " --user <hidden>"
-    | name, Some value -> fprintf chan " --%s %s" name (Filename.quote value)
-  ) curl_args;
-  fprintf chan "\n";
+    | "user", Some _ -> bprintf b " --user <hidden>"
+    | name, Some value -> bprintf b " --%s %s" name (quote value)
+  ) args;
+  bprintf b "\n";
+  Buffer.contents b
+
+let print chan t = output_string chan (to_string t)
diff --git a/mllib/curl.mli b/mllib/curl.mli
index cd01497..f045572 100644
--- a/mllib/curl.mli
+++ b/mllib/curl.mli
@@ -18,21 +18,53 @@
 
 (** Functions for dealing with [curl]. *)
 
-type curl_args = (string * string option) list
+type t
 
-val run : curl_args -> string list
-(** [run curl_args] runs the [curl] command.
+type args = (string * string option) list
 
-    It actually uses the [curl --config] option to pass the arguments
-    securely to curl through an external file.  Thus passwords etc are
-    not exposed to other users on the same machine.
+type proxy =
+  | UnsetProxy            (** The proxy is forced off. *)
+  | SystemProxy           (** Use the system settings. *)
+  | ForcedProxy of string (** The proxy is forced to the specified URL. *)
+
+val create : ?curl:string -> ?proxy:proxy -> args -> t
+(** Create a curl command handle.
 
     The curl arguments are a list of key, value pairs corresponding
     to curl command line parameters, without leading dashes,
     eg. [("user", Some "user:password")].
 
+    The optional [?curl] parameter controls the name of the curl
+    binary (default ["curl"]).
+
+    The optional [?proxy] parameter adds extra arguments to
+    control the proxy.
+
+    Note that some extra arguments are added implicitly:
+
+    - [--max-redirs 5] Only follow 3XX redirects up to 5 times.
+    - [--globoff] Disable URL globbing.
+
+    Note this does {b not} enable redirects.  If you want to follow
+    redirects you have to add the ["location"] parameter yourself. *)
+
+val run : t -> string list
+(** [run t] runs previously constructed the curl command.
+
+    It actually uses the [curl --config] option to pass the arguments
+    securely to curl through an external file.  Thus passwords etc are
+    not exposed to other users on the same machine.
+
     The result is the output of curl as a list of lines. *)
 
-val print_curl_command : out_channel -> curl_args -> unit
-(** Print the curl command line.  This elides any arguments that
-    might contain passwords, so is useful for debugging. *)
+val to_string : t -> string
+(** Convert the curl command line to a string.
+
+    This elides any arguments that might contain passwords, so is
+    useful for debugging. *)
+
+val print : out_channel -> t -> unit
+(** Print the curl command line.
+
+    This elides any arguments that might contain passwords, so is
+    useful for debugging. *)
diff --git a/v2v/copy_to_local.ml b/v2v/copy_to_local.ml
index 717ba50..2e3b59b 100644
--- a/v2v/copy_to_local.ml
+++ b/v2v/copy_to_local.ml
@@ -199,9 +199,9 @@ read the man page virt-v2v-copy-to-local(1).
 
     | ESXi _ ->
        let curl_args = [
-         "url", Some remote_disk;
-         "output", Some local_disk;
-       ] in
+           "url", Some remote_disk;
+           "output", Some local_disk;
+         ] in
        let curl_args =
          if sslverify then curl_args
          else ("insecure", None) :: curl_args in
@@ -213,9 +213,10 @@ read the man page virt-v2v-copy-to-local(1).
          if quiet () then ("silent", None) :: curl_args
          else curl_args in
 
+       let curl_h = Curl.create curl_args in
        if verbose () then
-         Curl.print_curl_command stderr curl_args;
-       ignore (Curl.run curl_args)
+         Curl.print stderr curl_h;
+       ignore (Curl.run curl_h)
 
     | Test ->
        let cmd = [ "cp"; remote_disk; local_disk ] in
diff --git a/v2v/vCenter.ml b/v2v/vCenter.ml
index d41f223..ed4a9b2 100644
--- a/v2v/vCenter.ml
+++ b/v2v/vCenter.ml
@@ -46,10 +46,10 @@ let get_session_cookie password scheme uri sslverify url =
     Some !session_cookie
   else (
     let curl_args = [
-      "head", None;
-      "silent", None;
-      "url", Some url;
-    ] in
+        "head", None;
+        "silent", None;
+        "url", Some url;
+      ] in
     let curl_args =
       match uri.uri_user, password with
       | None, None -> curl_args
@@ -63,10 +63,11 @@ let get_session_cookie password scheme uri sslverify url =
     let curl_args =
       if not sslverify then ("insecure", None) :: curl_args else curl_args in
 
-    let lines = Curl.run curl_args in
+    let curl_h = Curl.create curl_args in
+    let lines = Curl.run curl_h in
 
     let dump_response chan =
-      Curl.print_curl_command chan curl_args;
+      Curl.print chan curl_h;
 
       (* Dump out the output of the command. *)
       List.iter (fun x -> fprintf chan "%s\n" x) lines;
-- 
2.7.4