[PATCH 1/2] svn-download: Respect current-http-proxy when downloading.

[Jookia]

When downloading a repository through SVN over HTTP, do it using a proxy if
possible. This is especially useful for people who use Tor to do all their
downloading. This doesn't work with svn:// repositories to my knowledge.

* guix/build/svn.scm (svn-fetch): Pass the "servers:global:http-proxy-host"
  and "servers:global:http-proxy-port" configuration options to SVN if
  current-http-proxy is set. Bail if unable to parse the proxy to avoid leaks.
* guix/svn-download.scm (svn-fetch): Leak the http_proxy environment variable.
---
 guix/build/svn.scm    | 48 +++++++++++++++++++++++++++++++++++-------------
 guix/svn-download.scm |  2 ++
 2 files changed, 37 insertions(+), 13 deletions(-)

diff --git a/guix/build/svn.scm b/guix/build/svn.scm
index 74fe084..2de5abc 100644
--- a/guix/build/svn.scm
+++ b/guix/build/svn.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2014 Sree Harsha Totakura <address@hidden>
+;;; Copyright © 2016 Jookia <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,6 +20,10 @@
 
 (define-module (guix build svn)
   #:use-module (guix build utils)
+  #:use-module (ice-9 format)
+  #:use-module (srfi srfi-2)
+  #:use-module (web uri)
+  #:use-module (web client)
   #:export (svn-fetch))
 
 ;;; Commentary:
@@ -32,18 +37,35 @@
                     #:key (svn-command "svn"))
   "Fetch REVISION from URL into DIRECTORY.  REVISION must be an integer, and a
 valid Subversion revision.  Return #t on success, #f otherwise."
-  (and (zero? (system* svn-command "checkout" "--non-interactive"
-                       ;; Trust the server certificate.  This is OK as we
-                       ;; verify the checksum later.  This can be removed when
-                       ;; ca-certificates package is added.
-                       "--trust-server-cert" "-r" (number->string revision)
-                       url directory))
-       (with-directory-excursion directory
-         (begin
-           ;; The contents of '.svn' vary as a function of the current status
-           ;; of the repo.  Since we want a fixed output, this directory needs
-           ;; to be taken out.
-           (delete-file-recursively ".svn")
-           #t))))
+  (define proxy-config
+    (if (current-http-proxy)
+      (and-let* ((proxy-uri  (string->uri (current-http-proxy)))
+                 (proxy-host (uri-host proxy-uri))
+                 (proxy-port (number->string (uri-port proxy-uri)))
+                 (config-host "servers:global:http-proxy-host=")
+                 (config-port "servers:global:http-proxy-port="))
+        `("--config-option" ,(string-append config-host proxy-host)
+          "--config-option" ,(string-append config-port proxy-port)))
+      '()))
+
+    (if proxy-config
+        (and (zero? (apply system* (append
+                      `(,svn-command "checkout")
+                      proxy-config
+                      `("--non-interactive"
+                      ;; Trust the server certificate.  This is OK as we
+                      ;; verify the checksum later.  This can be removed when
+                      ;; ca-certificates package is added.
+                      "--trust-server-cert" "-r" ,(number->string revision)
+                      ,url ,directory))))
+          (with-directory-excursion directory
+            (begin
+              ;; The contents of '.svn' vary as a function of the current 
status
+              ;; of the repo.  Since we want a fixed output, this directory 
needs
+              ;; to be taken out.
+              (delete-file-recursively ".svn")
+              #t)))
+        (format (current-error-port)
+              "Unable to parse current-http-proxy: ~s~%" 
(current-http-proxy))))
 
 ;;; svn.scm ends here
diff --git a/guix/svn-download.scm b/guix/svn-download.scm
index d6853ca..fbc96df 100644
--- a/guix/svn-download.scm
+++ b/guix/svn-download.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2014 Sree Harsha Totakura <address@hidden>
+;;; Copyright © 2016 Jookia <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -72,6 +73,7 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a 
generic name if #f."
                       #:recursive? #t
                       #:modules '((guix build svn)
                                   (guix build utils))
+                      #:leaked-env-vars '("http_proxy")
                       #:guile-for-build guile
                       #:local-build? #t)))
 
-- 
2.7.0