11:30 a.m.
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