Libguestfs - Apr 2014 - [PATCH] builder: add per-repository proxy configuration

Add the possibility to configure the proxy in each repository .conf
file, specifying whether use no proxy at all, follow the system
configuration or use a specific proxy.
---
 builder/builder.ml       | 10 +++++-----
 builder/downloader.ml    | 44 ++++++++++++++++++++++++++++++++++++--------
 builder/downloader.mli   | 15 +++++++++++++--
 builder/index_parser.ml  |  4 ++--
 builder/index_parser.mli |  2 +-
 builder/list_entries.ml  |  4 ++--
 builder/list_entries.mli |  2 +-
 builder/sources.ml       | 12 +++++++++++-
 builder/sources.mli      |  1 +
 builder/virt-builder.pod | 25 +++++++++++++++++++++++++
 10 files changed, 97 insertions(+), 22 deletions(-)

diff --git a/builder/builder.ml b/builder/builder.ml
index 81eb2d9..062dbb9 100644
--- a/builder/builder.ml
+++ b/builder/builder.ml
@@ -136,25 +136,25 @@ let main ()    let downloader = Downloader.create ~debug
~curl ~cache in
   let repos = Sources.read_sources ~prog ~debug in
   let repos = List.map (
-    fun { Sources.uri = uri; Sources.gpgkey = gpgkey } ->
+    fun { Sources.uri = uri; Sources.gpgkey = gpgkey; Sources.proxy = proxy }
->
       let gpgkey          match gpgkey with
         | None -> Sigchecker.No_Key
         | Some key -> Sigchecker.KeyFile key in
-      uri, gpgkey
+      uri, gpgkey, proxy
   ) repos in
   let sources = List.map (
     fun (source, fingerprint) ->
-      source, Sigchecker.Fingerprint fingerprint
+      source, Sigchecker.Fingerprint fingerprint, Downloader.SystemProxy
   ) sources in
   let sources = List.append repos sources in
   let index : Index_parser.index      List.concat (
       List.map (
-        fun (source, key) ->
+        fun (source, key, proxy) ->
           let sigchecker              Sigchecker.create ~debug ~gpg
~check_signature ~gpgkey:key in
-          Index_parser.get_index ~prog ~debug ~downloader ~sigchecker source
+          Index_parser.get_index ~prog ~debug ~downloader ~sigchecker ~proxy
source
       ) sources
     ) in
 
diff --git a/builder/downloader.ml b/builder/downloader.ml
index e23cb37..f8cd7ab 100644
--- a/builder/downloader.ml
+++ b/builder/downloader.ml
@@ -37,25 +37,30 @@ type t = {
   cache : string option;                (* cache directory for templates *)
 }
 
+type proxy_mode +  | UnsetProxy
+  | SystemProxy
+  | ForcedProxy of string
+
 let create ~debug ~curl ~cache = {
   debug = debug;
   curl = curl;
   cache = cache;
 }
 
-let rec download ~prog t ?template ?progress_bar uri +let rec download ~prog t
?template ?progress_bar ?(proxy = SystemProxy) uri    match template with
   | None ->                       (* no cache, simple download *)
     (* Create a temporary name. *)
     let tmpfile = Filename.temp_file "vbcache" ".txt" in
-    download_to ~prog t ?progress_bar uri tmpfile;
+    download_to ~prog 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 ~prog ?progress_bar uri
+      download t ~prog ?progress_bar ~proxy uri
 
     | Some cachedir ->
       let filename = cache_of_name cachedir name arch revision in
@@ -64,11 +69,11 @@ let rec download ~prog t ?template ?progress_bar uri        
* If not, download it.
        *)
       if not (Sys.file_exists filename) then
-        download_to ~prog t ?progress_bar uri filename;
+        download_to ~prog t ?progress_bar ~proxy uri filename;
 
       (filename, false)
 
-and download_to ~prog t ?(progress_bar = false) uri filename +and download_to
~prog t ?(progress_bar = false) ~proxy uri filename    let parseduri      try
URI.parse_uri uri
     with Invalid_argument "URI.parse_uri" ->
@@ -95,9 +100,11 @@ and download_to ~prog t ?(progress_bar = false) uri filename
prog path;
       exit 1
     )
-  | _ -> (* Any other protocol. *)
+  | _ as protocol -> (* Any other protocol. *)
+    let outenv = proxy_envvar protocol proxy in
     (* Get the status code first to ensure the file exists. *)
-    let cmd = sprintf "%s%s -g -o /dev/null -I -w '%%{http_code}'
%s"
+    let cmd = sprintf "%s%s%s -g -o /dev/null -I -w
'%%{http_code}' %s"
+      outenv
       t.curl
       (if t.debug then "" else " -s -S")
       (quote uri) in
@@ -122,7 +129,8 @@ and download_to ~prog t ?(progress_bar = false) uri filename
);
 
     (* Now download the file. *)
-    let cmd = sprintf "%s%s -g -o %s %s"
+    let cmd = sprintf "%s%s%s -g -o %s %s"
+      outenv
       t.curl
       (if t.debug then "" else if progress_bar then " -#"
else " -s -S")
       (quote filename_new) (quote uri) in
@@ -137,3 +145,23 @@ and download_to ~prog t ?(progress_bar = false) uri
filename
   (* 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 = Filename.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 8daa661..4d24a34 100644
--- a/builder/downloader.mli
+++ b/builder/downloader.mli
@@ -29,10 +29,18 @@ 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 : debug:bool -> curl:string -> cache:string option -> t
 (** Create the abstract type. *)
 
-val download : prog:string -> t -> ?template:(string*string*int) ->
?progress_bar:bool -> uri -> (filename * bool)
+val download : prog:string -> t -> ?template:(string*string*int) ->
?progress_bar:bool -> ?proxy:proxy_mode -> 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
@@ -44,4 +52,7 @@ val download : prog:string -> t ->
?template:(string*string*int) -> ?progress_ba
 
     If [~progress_bar:true] then display a progress bar if the file
     doesn't come from the cache.  In debug mode, progress messages
-    are always displayed. *)
+    are always displayed.
+
+    [proxy] specifies the type of proxy to be used in the transfer,
+    if possible. *)
diff --git a/builder/index_parser.ml b/builder/index_parser.ml
index 5d566f9..2040656 100644
--- a/builder/index_parser.ml
+++ b/builder/index_parser.ml
@@ -102,7 +102,7 @@ let print_entry chan (name, { printable_name =
printable_name;
   ) notes;
   if hidden then fp "hidden=true\n"
 
-let get_index ~prog ~debug ~downloader ~sigchecker source +let get_index ~prog
~debug ~downloader ~sigchecker ~proxy source    let corrupt_file ()      eprintf
(f_"\nThe index file downloaded from '%s' is corrupt.\nYou need to
ask the supplier of this file to fix it and upload a fixed version.\n")
       source;
@@ -111,7 +111,7 @@ let get_index ~prog ~debug ~downloader ~sigchecker source  
   let rec get_index ()      (* Get the index page. *)
-    let tmpfile, delete_tmpfile = Downloader.download ~prog downloader source
in
+    let tmpfile, delete_tmpfile = Downloader.download ~prog downloader ~proxy
source in
 
     (* Check index file signature (also verifies it was fully
      * downloaded and not corrupted in transit).
diff --git a/builder/index_parser.mli b/builder/index_parser.mli
index 0575dc4..c2c5d11 100644
--- a/builder/index_parser.mli
+++ b/builder/index_parser.mli
@@ -36,4 +36,4 @@ and entry = {
   sigchecker : Sigchecker.t;
 }
 
-val get_index : prog:string -> debug:bool -> downloader:Downloader.t
-> sigchecker:Sigchecker.t -> string -> index
+val get_index : prog:string -> debug:bool -> downloader:Downloader.t
-> sigchecker:Sigchecker.t -> proxy:Downloader.proxy_mode -> string
-> index
diff --git a/builder/list_entries.ml b/builder/list_entries.ml
index 2c600d5..505a1b9 100644
--- a/builder/list_entries.ml
+++ b/builder/list_entries.ml
@@ -47,7 +47,7 @@ and list_entries_long ~sources index    let langs =
Languages.languages () in
 
   List.iter (
-    fun (source, key) ->
+    fun (source, key, proxy) ->
       printf (f_"Source URI: %s\n") source;
       (match key with
       | Sigchecker.No_Key -> ()
@@ -136,7 +136,7 @@ and list_entries_json ~sources index    printf " 
\"version\": %d,\n" 1;
   printf "  \"sources\": [\n";
   iteri (
-    fun i (source, key) ->
+    fun i (source, key, proxy) ->
       printf "  {\n";
       (match key with
       | Sigchecker.No_Key -> ()
diff --git a/builder/list_entries.mli b/builder/list_entries.mli
index b53ccec..ce012c4 100644
--- a/builder/list_entries.mli
+++ b/builder/list_entries.mli
@@ -16,4 +16,4 @@
  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-val list_entries : list_format:([ `Short | `Long | `Json ]) ->
sources:(string * Sigchecker.gpgkey_type) list -> Index_parser.index ->
unit
+val list_entries : list_format:([ `Short | `Long | `Json ]) ->
sources:(string * Sigchecker.gpgkey_type * Downloader.proxy_mode) list ->
Index_parser.index -> unit
diff --git a/builder/sources.ml b/builder/sources.ml
index 90716bd..e7644a2 100644
--- a/builder/sources.ml
+++ b/builder/sources.ml
@@ -26,6 +26,7 @@ type source = {
   name : string;
   uri : string;
   gpgkey : string option;
+  proxy : Downloader.proxy_mode;
 }
 
 module StringSet = Set.Make (String)
@@ -65,8 +66,17 @@ let parse_conf ~prog ~debug file                );
               None
             ) in
+        let proxy +          try
+            (match (List.assoc ("proxy", None) fields) with
+            | "no" | "off" -> Downloader.UnsetProxy
+            | "system" -> Downloader.SystemProxy
+            | _ as proxy -> Downloader.ForcedProxy proxy
+            )
+          with
+            Not_found -> Downloader.SystemProxy in
         {
-          name = n; uri = uri; gpgkey = gpgkey;
+          name = n; uri = uri; gpgkey = gpgkey; proxy = proxy;
         }
       in
       try (give_source n fields) :: acc
diff --git a/builder/sources.mli b/builder/sources.mli
index 76feeda..0ade536 100644
--- a/builder/sources.mli
+++ b/builder/sources.mli
@@ -20,6 +20,7 @@ type source = {
   name : string;
   uri : string;
   gpgkey : string option;
+  proxy : Downloader.proxy_mode;
 }
 
 val read_sources : prog:string -> debug:bool -> source list
diff --git a/builder/virt-builder.pod b/builder/virt-builder.pod
index 8d27452..ebe6528 100644
--- a/builder/virt-builder.pod
+++ b/builder/virt-builder.pod
@@ -1010,6 +1010,31 @@ This optional field represents the URI (although only
I<file://> URIs
 are accepted) of the key used to sign the index file.
 If not present, the index file referred by I<uri=..> is not signed.
 
+=item C<proxy=MODE>
+
+This optional field specifies the proxy mode, to be used when downloading
+the index file of this repository.  The possible values are:
+
+=over 4
+
+=item B<no>, B<off>
+
+No proxy is being used at all, even overriding the system configuration.
+
+=item B<system>
+
+The proxy used is the system one.
+
+=item I<anything else>
+
+Specifies the actual proxy configuration to be used, overriding the system
+configuration.
+
+=back
+
+If not present, the assumed value is to respect the proxy settings of the
+system (i.e. as if B<system> would be specified).
+
 =back
 
 For serious virt-builder use, you may want to create your own
-- 
1.9.0

ACK.

Thanks, Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
virt-p2v converts physical machines to virtual machines.  Boot with a
live CD or over the network (PXE) and turn machines into KVM guests.
http://libguestfs.org/virt-v2v