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