[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.
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
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
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
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 + ] in
Rich. -- 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
participants (1)
-
Richard W.M. Jones