Richard W.M. Jones
2016-Jul-07 13:18 UTC
[Libguestfs] [PATCH 0/3] Move Curl wrapper to mllib and use it for virt-builder.
Move the Curl wrapper module from virt-v2v to mllib. Use the module when virt-builder issues curl calls. Rich.
Richard W.M. Jones
2016-Jul-07 13:18 UTC
[Libguestfs] [PATCH 1/3] v2v: Move Curl wrapper to mllib.
Just code motion, no change.
---
mllib/Makefile.am | 4 +++-
mllib/curl.ml | 64 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
mllib/curl.mli | 38 +++++++++++++++++++++++++++++++++
po/POTFILES-ml | 2 +-
v2v/Makefile.am | 5 ++---
v2v/curl.ml | 64 -------------------------------------------------------
v2v/curl.mli | 38 ---------------------------------
7 files changed, 108 insertions(+), 107 deletions(-)
create mode 100644 mllib/curl.ml
create mode 100644 mllib/curl.mli
delete mode 100644 v2v/curl.ml
delete mode 100644 v2v/curl.mli
diff --git a/mllib/Makefile.am b/mllib/Makefile.am
index 10bbebf..e728d54 100644
--- a/mllib/Makefile.am
+++ b/mllib/Makefile.am
@@ -28,6 +28,7 @@ CLEANFILES = *~ *.annot *.cmi *.cmo *.cmx *.cmxa *.o
SOURCES_MLI = \
common_utils.mli \
+ curl.mli \
dev_t.mli \
fsync.mli \
JSON.mli \
@@ -52,7 +53,8 @@ SOURCES_ML = \
planner.ml \
regedit.ml \
StatVFS.ml \
- JSON.ml
+ JSON.ml \
+ curl.ml
SOURCES_C = \
../fish/progress.c \
diff --git a/mllib/curl.ml b/mllib/curl.ml
new file mode 100644
index 0000000..f0af160
--- /dev/null
+++ b/mllib/curl.ml
@@ -0,0 +1,64 @@
+(* virt-v2v
+ * Copyright (C) 2009-2016 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Printf
+
+open Common_utils
+
+type curl_args = (string * string option) list
+
+let run curl_args + let config_file, chan = Filename.open_temp_file
"v2vcurl" ".conf" in
+ List.iter (
+ function
+ | name, None -> fprintf chan "%s\n" name
+ | name, Some value ->
+ fprintf chan "%s = \"" name;
+ (* Write the quoted value. See 'curl' man page for what is
+ * allowed here.
+ *)
+ let len = String.length value in
+ for i = 0 to len-1 do
+ match value.[i] with
+ | '\\' -> output_string chan "\\\\"
+ | '"' -> output_string chan "\\\""
+ | '\t' -> output_string chan "\\t"
+ | '\n' -> output_string chan "\\n"
+ | '\r' -> output_string chan "\\r"
+ | '\x0b' -> output_string chan "\\v"
+ | c -> output_char chan c
+ done;
+ fprintf chan "\"\n"
+ ) curl_args;
+ close_out chan;
+
+ let cmd = sprintf "curl -q --config %s" (Filename.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";
+ List.iter (
+ function
+ | name, None -> fprintf chan " --%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";
diff --git a/mllib/curl.mli b/mllib/curl.mli
new file mode 100644
index 0000000..cd01497
--- /dev/null
+++ b/mllib/curl.mli
@@ -0,0 +1,38 @@
+(* virt-v2v
+ * Copyright (C) 2009-2016 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+(** Functions for dealing with [curl]. *)
+
+type curl_args = (string * string option) list
+
+val run : curl_args -> string list
+(** [run curl_args] runs 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 curl arguments are a list of key, value pairs corresponding
+ to curl command line parameters, without leading dashes,
+ eg. [("user", Some "user:password")].
+
+ 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. *)
diff --git a/po/POTFILES-ml b/po/POTFILES-ml
index f6bade1..5937ff5 100644
--- a/po/POTFILES-ml
+++ b/po/POTFILES-ml
@@ -43,6 +43,7 @@ mllib/URI.ml
mllib/common_gettext.ml
mllib/common_utils.ml
mllib/common_utils_tests.ml
+mllib/curl.ml
mllib/dev_t.ml
mllib/fsync.ml
mllib/guestfs_config.ml
@@ -104,7 +105,6 @@ v2v/cmdline.ml
v2v/convert_linux.ml
v2v/convert_windows.ml
v2v/copy_to_local.ml
-v2v/curl.ml
v2v/domainxml.ml
v2v/input_disk.ml
v2v/input_libvirt.ml
diff --git a/v2v/Makefile.am b/v2v/Makefile.am
index 05f4611..fedc84d 100644
--- a/v2v/Makefile.am
+++ b/v2v/Makefile.am
@@ -31,7 +31,6 @@ SOURCES_MLI = \
cmdline.mli \
convert_linux.mli \
convert_windows.mli \
- curl.mli \
DOM.mli \
domainxml.mli \
input_disk.mli \
@@ -66,7 +65,6 @@ SOURCES_ML = \
types.ml \
xml.ml \
utils.ml \
- curl.ml \
vCenter.ml \
domainxml.ml \
DOM.ml \
@@ -131,6 +129,7 @@ BOBJECTS = \
$(top_builddir)/mllib/mkdtemp.cmo \
$(top_builddir)/mllib/JSON.cmo \
$(top_builddir)/mllib/StatVFS.cmo \
+ $(top_builddir)/mllib/curl.cmo \
$(top_builddir)/customize/customize_utils.cmo \
$(top_builddir)/customize/firstboot.cmo \
$(SOURCES_ML:.ml=.cmo)
@@ -199,9 +198,9 @@ COPY_TO_LOCAL_BOBJECTS = \
$(top_builddir)/mllib/common_utils.cmo \
$(top_builddir)/mllib/JSON.cmo \
$(top_builddir)/mllib/StatVFS.cmo \
+ $(top_builddir)/mllib/curl.cmo \
xml.cmo \
utils.cmo \
- curl.cmo \
vCenter.cmo \
domainxml.cmo \
copy_to_local.cmo
diff --git a/v2v/curl.ml b/v2v/curl.ml
deleted file mode 100644
index f0af160..0000000
--- a/v2v/curl.ml
+++ /dev/null
@@ -1,64 +0,0 @@
-(* virt-v2v
- * Copyright (C) 2009-2016 Red Hat Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along
- * with this program; if not, write to the Free Software Foundation, Inc.,
- * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- *)
-
-open Printf
-
-open Common_utils
-
-type curl_args = (string * string option) list
-
-let run curl_args - let config_file, chan = Filename.open_temp_file
"v2vcurl" ".conf" in
- List.iter (
- function
- | name, None -> fprintf chan "%s\n" name
- | name, Some value ->
- fprintf chan "%s = \"" name;
- (* Write the quoted value. See 'curl' man page for what is
- * allowed here.
- *)
- let len = String.length value in
- for i = 0 to len-1 do
- match value.[i] with
- | '\\' -> output_string chan "\\\\"
- | '"' -> output_string chan "\\\""
- | '\t' -> output_string chan "\\t"
- | '\n' -> output_string chan "\\n"
- | '\r' -> output_string chan "\\r"
- | '\x0b' -> output_string chan "\\v"
- | c -> output_char chan c
- done;
- fprintf chan "\"\n"
- ) curl_args;
- close_out chan;
-
- let cmd = sprintf "curl -q --config %s" (Filename.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";
- List.iter (
- function
- | name, None -> fprintf chan " --%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";
diff --git a/v2v/curl.mli b/v2v/curl.mli
deleted file mode 100644
index cd01497..0000000
--- a/v2v/curl.mli
+++ /dev/null
@@ -1,38 +0,0 @@
-(* virt-v2v
- * Copyright (C) 2009-2016 Red Hat Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along
- * with this program; if not, write to the Free Software Foundation, Inc.,
- * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- *)
-
-(** Functions for dealing with [curl]. *)
-
-type curl_args = (string * string option) list
-
-val run : curl_args -> string list
-(** [run curl_args] runs 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 curl arguments are a list of key, value pairs corresponding
- to curl command line parameters, without leading dashes,
- eg. [("user", Some "user:password")].
-
- 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. *)
--
2.7.4
Richard W.M. Jones
2016-Jul-07 13:18 UTC
[Libguestfs] [PATCH 2/3] curl: Change the API to use an abstract data type.
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
Richard W.M. Jones
2016-Jul-07 13:18 UTC
[Libguestfs] [PATCH 3/3] builder: Use the new Curl module for passing parameters to curl.
These are now passed using a curl configuration file, which is a
little bit safer than using command lines. virt-builder doesn't need
to pass usernames and passwords to curl, but if it ever does in future
this will be a lot safer.
---
builder/Makefile.am | 1 +
builder/builder.ml | 6 +--
builder/downloader.ml | 94 +++++++++++++++++++++--------------------
builder/downloader.mli | 10 +----
builder/index.ml | 2 +-
builder/index.mli | 2 +-
builder/index_parser.ml | 2 +-
builder/simplestreams_parser.ml | 2 +-
builder/sources.ml | 10 ++---
builder/sources.mli | 2 +-
10 files changed, 63 insertions(+), 68 deletions(-)
diff --git a/builder/Makefile.am b/builder/Makefile.am
index ad32940..5c41cfa 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -144,6 +144,7 @@ BOBJECTS = \
$(top_builddir)/mllib/JSON.cmo \
$(top_builddir)/mllib/URI.cmo \
$(top_builddir)/mllib/mkdtemp.cmo \
+ $(top_builddir)/mllib/curl.cmo \
$(top_builddir)/customize/customize_utils.cmo \
$(top_builddir)/customize/urandom.cmo \
$(top_builddir)/customize/random_seed.cmo \
diff --git a/builder/builder.ml b/builder/builder.ml
index affce10..e95fcd1 100644
--- a/builder/builder.ml
+++ b/builder/builder.ml
@@ -185,7 +185,7 @@ let main () {
Sources.name = source; uri = source;
gpgkey = Utils.Fingerprint fingerprint;
- proxy = Downloader.SystemProxy;
+ proxy = None;
format = Sources.FormatNative;
}
) cmdline.sources in
@@ -249,7 +249,7 @@ let main () message (f_"Downloading:
%s") file_uri;
let progress_bar = not (quiet ()) in
ignore (Downloader.download downloader ~template ~progress_bar
- ~proxy file_uri)
+ ?proxy file_uri)
) index;
exit 0
);
@@ -297,7 +297,7 @@ let main () let template = arg, cmdline.arch,
revision in
message (f_"Downloading: %s") file_uri;
let progress_bar = not (quiet ()) in
- Downloader.download downloader ~template ~progress_bar ~proxy
+ Downloader.download downloader ~template ~progress_bar ?proxy
file_uri in
if delete_on_exit then unlink_on_exit template;
template in
diff --git a/builder/downloader.ml b/builder/downloader.ml
index 8c47bad..de9b404 100644
--- a/builder/downloader.ml
+++ b/builder/downloader.ml
@@ -32,29 +32,24 @@ type t = {
cache : Cache.t option; (* cache for templates *)
}
-type proxy_mode - | UnsetProxy
- | SystemProxy
- | ForcedProxy of string
-
let create ~curl ~cache = {
curl = curl;
cache = cache;
}
-let rec download t ?template ?progress_bar ?(proxy = SystemProxy) uri +let rec
download t ?template ?progress_bar ?proxy uri match template with
| None -> (* no cache, simple download *)
(* Create a temporary name. *)
let tmpfile = Filename.temp_file "vbcache" ".txt" in
- download_to t ?progress_bar ~proxy uri tmpfile;
+ download_to t ?progress_bar ?proxy uri tmpfile;
(tmpfile, true)
| Some (name, arch, revision) ->
match t.cache with
| None ->
(* Not using the cache at all? *)
- download t ?progress_bar ~proxy uri
+ download t ?progress_bar ?proxy uri
| Some cache ->
let filename = Cache.cache_of_name cache name arch revision in
@@ -63,11 +58,11 @@ let rec download t ?template ?progress_bar ?(proxy =
SystemProxy) uri * If not, download it.
*)
if not (Sys.file_exists filename) then
- download_to t ?progress_bar ~proxy uri filename;
+ download_to t ?progress_bar ?proxy uri filename;
(filename, false)
-and download_to t ?(progress_bar = false) ~proxy uri filename +and download_to
t ?(progress_bar = false) ?proxy uri filename let parseduri try
URI.parse_uri uri
with Invalid_argument "URI.parse_uri" ->
@@ -83,6 +78,7 @@ and download_to t ?(progress_bar = false) ~proxy uri filename
unlink_on_exit filename_new;
(match parseduri.URI.protocol with
+ (* Download (ie. copy) from a local file. *)
| "file" ->
let path = parseduri.URI.path in
let cmd = [ "cp" ] @
@@ -91,15 +87,33 @@ and download_to t ?(progress_bar = false) ~proxy uri
filename let r = run_command cmd in
if r <> 0 then
error (f_"cp (download) command failed copying '%s'")
path;
- | _ as protocol -> (* Any other protocol. *)
- let outenv = proxy_envvar protocol proxy in
+
+ (* Any other protocol. *)
+ | _ ->
+ let common_args + Curl.safe_args @
+ [ "location", None ] @ (* Follow 3XX redirects. *)
+ match proxy with
+ | None (* system proxy settings *) -> []
+ | Some proxy -> Curl.args_of_proxy proxy in
+
+ let quiet_args = [ "silent", None; "show-error", None ]
in
+
(* Get the status code first to ensure the file exists. *)
- let cmd = sprintf "%s%s%s -L --max-redirs 5 -g -o /dev/null -I -w
'%%{http_code}' %s"
- outenv
- t.curl
- (if verbose () then "" else " -s -S")
- (quote uri) in
- let lines = external_command cmd in
+ let curl_h + let curl_args + common_args @
+ if verbose () then [] else quiet_args @ [
+ "output", Some "/dev/null"; (* Write output to
/dev/null. *)
+ "head", None; (* Request only HEAD. *)
+ (* Write HTTP status code to stdout. *)
+ "write-out", Some "%{http_code}";
+ "url", Some uri
+ ] in
+
+ Curl.create ~curl:t.curl curl_args in
+
+ let lines = Curl.run curl_h in
if List.length lines < 1 then
error (f_"unexpected output from curl command, enable debug and look
at previous messages");
let status_code = List.hd lines in
@@ -113,35 +127,23 @@ and download_to t ?(progress_bar = false) ~proxy uri
filename error (f_"failed to download %s: HTTP status code %s")
uri status_code;
(* Now download the file. *)
- let cmd = sprintf "%s%s%s -L --max-redirs 5 -g -o %s %s"
- outenv
- t.curl
- (if verbose () then "" else if progress_bar then "
-#" else " -s -S")
- (quote filename_new) (quote uri) in
- let r = shell_command cmd in
- if r <> 0 then
- error (f_"curl (download) command failed downloading
'%s'") uri;
+ let curl_h + let curl_args + common_args @ [
+ "output", Some filename_new;
+ "url", Some uri
+ ] in
+
+ let curl_args + curl_args @
+ if verbose () then []
+ else if progress_bar then [ "progress-bar", None ]
+ else quiet_args in
+
+ Curl.create ~curl:t.curl curl_args in
+
+ ignore (Curl.run curl_h)
);
(* Rename the file if the download was successful. *)
rename filename_new filename
-
-and proxy_envvar protocol = function
- | UnsetProxy ->
- (match protocol with
- | "http" -> "env http_proxy= no_proxy=* "
- | "https" -> "env https_proxy= no_proxy=* "
- | "ftp" -> "env ftp_proxy= no_proxy=* "
- | _ -> "env no_proxy=* "
- )
- | SystemProxy ->
- (* No changes required. *)
- ""
- | ForcedProxy proxy ->
- let proxy = quote proxy in
- (match protocol with
- | "http" -> sprintf "env http_proxy=%s no_proxy= "
proxy
- | "https" -> sprintf "env https_proxy=%s no_proxy= "
proxy
- | "ftp" -> sprintf "env ftp_proxy=%s no_proxy= "
proxy
- | _ -> ""
- )
diff --git a/builder/downloader.mli b/builder/downloader.mli
index 11ec498..c99aee2 100644
--- a/builder/downloader.mli
+++ b/builder/downloader.mli
@@ -24,18 +24,10 @@ type filename = string
type t
(** The abstract data type. *)
-(** Type of proxy. *)
-type proxy_mode - | UnsetProxy (* The proxy is forced off. *)
- | SystemProxy (* The proxy is not changed (follows the
- * system configuration).
- *)
- | ForcedProxy of string (* The proxy is forced to the specified URL. *)
-
val create : curl:string -> cache:Cache.t option -> t
(** Create the abstract type. *)
-val download : t -> ?template:(string*string*Utils.revision) ->
?progress_bar:bool -> ?proxy:proxy_mode -> uri -> (filename * bool)
+val download : t -> ?template:(string*string*Utils.revision) ->
?progress_bar:bool -> ?proxy:Curl.proxy -> uri -> (filename * bool)
(** Download the URI, returning the downloaded filename and a
temporary file flag. The temporary file flag is [true] iff
the downloaded file is temporary and should be deleted by the
diff --git a/builder/index.ml b/builder/index.ml
index 01b4a5f..fa3c34a 100644
--- a/builder/index.ml
+++ b/builder/index.ml
@@ -43,7 +43,7 @@ and entry = {
aliases : string list option;
sigchecker : Sigchecker.t;
- proxy : Downloader.proxy_mode;
+ proxy : Curl.proxy option;
}
let print_entry chan (name, { printable_name = printable_name;
diff --git a/builder/index.mli b/builder/index.mli
index 07cfb9d..8a93ba8 100644
--- a/builder/index.mli
+++ b/builder/index.mli
@@ -35,7 +35,7 @@ and entry = {
aliases : string list option;
sigchecker : Sigchecker.t;
- proxy : Downloader.proxy_mode;
+ proxy : Curl.proxy option;
}
val print_entry : out_channel -> (string * entry) -> unit
diff --git a/builder/index_parser.ml b/builder/index_parser.ml
index d232a3a..4ac66c0 100644
--- a/builder/index_parser.ml
+++ b/builder/index_parser.ml
@@ -32,7 +32,7 @@ let get_index ~downloader ~sigchecker
let rec get_index () (* Get the index page. *)
- let tmpfile, delete_tmpfile = Downloader.download downloader ~proxy uri in
+ let tmpfile, delete_tmpfile = Downloader.download downloader ?proxy uri in
(* Check index file signature (also verifies it was fully
* downloaded and not corrupted in transit).
diff --git a/builder/simplestreams_parser.ml b/builder/simplestreams_parser.ml
index 13e0b5d..808b121 100644
--- a/builder/simplestreams_parser.ml
+++ b/builder/simplestreams_parser.ml
@@ -86,7 +86,7 @@ let get_index ~downloader ~sigchecker
let uri = ensure_trailing_slash uri in
let download_and_parse uri - let tmpfile, delete_tmpfile =
Downloader.download downloader ~proxy uri in
+ let tmpfile, delete_tmpfile = Downloader.download downloader ?proxy uri in
if delete_tmpfile then
unlink_on_exit tmpfile;
let file diff --git a/builder/sources.ml b/builder/sources.ml
index 4c8d6c7..9255702 100644
--- a/builder/sources.ml
+++ b/builder/sources.ml
@@ -26,7 +26,7 @@ type source = {
name : string;
uri : string;
gpgkey : Utils.gpgkey_type;
- proxy : Downloader.proxy_mode;
+ proxy : Curl.proxy option;
format : source_format;
}
and source_format @@ -67,12 +67,12 @@ let parse_conf file let proxy
try
(match (List.assoc ("proxy", None) fields) with
- | "no" | "off" -> Downloader.UnsetProxy
- | "system" -> Downloader.SystemProxy
- | _ as proxy -> Downloader.ForcedProxy proxy
+ | "no" | "off" -> Some Curl.UnsetProxy
+ | "system" -> None
+ | _ as proxy -> Some (Curl.ForcedProxy proxy)
)
with
- Not_found -> Downloader.SystemProxy in
+ Not_found -> None in
let format try
(match (List.assoc ("format", None) fields) with
diff --git a/builder/sources.mli b/builder/sources.mli
index e621a9f..d7f822e 100644
--- a/builder/sources.mli
+++ b/builder/sources.mli
@@ -20,7 +20,7 @@ type source = {
name : string;
uri : string;
gpgkey : Utils.gpgkey_type;
- proxy : Downloader.proxy_mode;
+ proxy : Curl.proxy option;
format : source_format;
}
and source_format --
2.7.4
Richard W.M. Jones
2016-Jul-07 13:28 UTC
Re: [Libguestfs] [PATCH 3/3] builder: Use the new Curl module for passing parameters to curl.
On Thu, Jul 07, 2016 at 02:18:33PM +0100, Richard W.M. Jones wrote:> + let curl_h > + let curl_args > + common_args @ > + if verbose () then [] else quiet_args @ [^^ Needs parens around the (if ...) statement ...> + "output", Some "/dev/null"; (* Write output to /dev/null. *) > + "head", None; (* Request only HEAD. *) > + (* Write HTTP status code to stdout. *) > + "write-out", Some "%{http_code}"; > + "url", Some uri > + ] inRich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com virt-top is 'top' for virtual machines. Tiny program with many powerful monitoring features, net stats, disk stats, logging, etc. http://people.redhat.com/~rjones/virt-top
Reasonably Related Threads
- [PATCH v3 5/8] builder, v2v: Use imperative list functions to simplify curl arg code.
- [PATCH 2/2] builder: consolidate handling of temporary files/dirs
- [PATCH v2 2/2] builder: consolidate handling of temporary files/dirs
- [PATCH v3 2/8] curl: Change the API to use an abstract data type.
- [PATCH 2/2] builder: support for download resume