[Libguestfs] [PATCH 2/3] curl: Change the API to use an abstract data type.
Richard W.M. Jones
rjones at redhat.com
Thu Jul 7 13:18:32 UTC 2016
Change the Curl module to use an ADT to store the name of the curl
binary and the arguments.
Also add Curl.safe_args, a list of arguments that control redirects etc.
The callers in virt-v2v are changed accordingly.
There is also a (currently unused) args_of_proxy function allowing
proxy parameters to be set.
---
mllib/curl.ml | 48 ++++++++++++++++++++++++++++++-----------
mllib/curl.mli | 60 ++++++++++++++++++++++++++++++++++++++++++++--------
v2v/copy_to_local.ml | 14 ++++++------
v2v/vCenter.ml | 16 ++++++++------
4 files changed, 104 insertions(+), 34 deletions(-)
diff --git a/mllib/curl.ml b/mllib/curl.ml
index f0af160..a684fdb 100644
--- a/mllib/curl.ml
+++ b/mllib/curl.ml
@@ -20,10 +20,19 @@ 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 create ?(curl = "curl") args =
+ { 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 +53,36 @@ 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)
+
+type proxy = UnsetProxy | ForcedProxy of string
+
+let args_of_proxy = function
+ | UnsetProxy -> [ "proxy", Some "" ; "noproxy", Some "*" ]
+ | ForcedProxy url -> [ "proxy", Some url; "noproxy", Some "" ]
+
+let safe_args = [
+ "max-redirs", Some "5";
+ "globoff", None; (* Don't glob URLs. *)
+]
diff --git a/mllib/curl.mli b/mllib/curl.mli
index cd01497..31927e5 100644
--- a/mllib/curl.mli
+++ b/mllib/curl.mli
@@ -18,21 +18,63 @@
(** 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.
+val create : ?curl:string -> 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"]). *)
+
+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. *)
+
+type proxy =
+ | UnsetProxy (** The proxy is forced off. *)
+ | ForcedProxy of string (** The proxy is forced to the specified URL. *)
+
+val args_of_proxy : proxy -> args
+(** Convert the proxy setting to the equivalent list of curl arguments.
+
+ To use the system proxy, no additional arguments are required, so
+ if you don't want to control the proxy (but just use the defaults)
+ you do not need to call this function at all.
+
+ Callers should append these arguments to the list of arguments
+ passed to {!create}. *)
+
+val safe_args : args
+(** This returns a list of safe arguments which can (and probably should)
+ be added to any list of arguments passed to {!create}.
+
+ Currently this list includes:
+
+ - Only follow 3XX redirects up to 5 times.
+ - Disable URL globbing.
+
+ Note this does {b not} enable redirects. If you want to follow
+ redirects you have to add the ["location"] parameter. *)
diff --git a/v2v/copy_to_local.ml b/v2v/copy_to_local.ml
index 717ba50..d791293 100644
--- a/v2v/copy_to_local.ml
+++ b/v2v/copy_to_local.ml
@@ -198,10 +198,11 @@ read the man page virt-v2v-copy-to-local(1).
error (f_"ssh copy command failed, see earlier errors");
| ESXi _ ->
- let curl_args = [
- "url", Some remote_disk;
- "output", Some local_disk;
- ] in
+ let curl_args =
+ Curl.safe_args @ [
+ "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 +214,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..dbfdf1a 100644
--- a/v2v/vCenter.ml
+++ b/v2v/vCenter.ml
@@ -45,11 +45,12 @@ let get_session_cookie password scheme uri sslverify url =
if !session_cookie <> "" then
Some !session_cookie
else (
- let curl_args = [
- "head", None;
- "silent", None;
- "url", Some url;
- ] in
+ let curl_args =
+ Curl.safe_args @ [
+ "head", None;
+ "silent", None;
+ "url", Some url;
+ ] in
let curl_args =
match uri.uri_user, password with
| None, None -> curl_args
@@ -63,10 +64,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
More information about the Libguestfs
mailing list