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

@@ -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
 

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
+    | _ -> ""
+    )

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. *)

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).

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

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 -> ()

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

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

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

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