web: Add 'current-https-proxy' and honor $https_proxy.

* module/web/client.scm (current-https-proxy): New variable.
(setup-http-tunnel): New procedure.
(open-socket-for-uri): Move 'http-proxy', 'uri', and 'addresses' inside
'open-socket'.  Remove 'with-https-proxy' macro.  Add call to
'setup-http-tunnel'.  Honor 'current-https-proxy' in 'open-socket'.
* doc/ref/web.texi (Web Client): Document 'current-https-proxy'.
* doc/ref/guile.texi: Update copyright years.

Based on Guix commit 9bc8175cfa6b23c31f6c43531377d266456e430e.

Co-authored-by: Sou Bunnbu (宋文武) <iyzsong@gmail.com>

doc/ref/web.texi

@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C) 2010, 2011, 2012, 2013, 2015, 2018, 2019 Free Software Foundation, Inc.
+@c Copyright (C) 2010, 2011, 2012, 2013, 2015, 2018, 2019, 2020 Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
 @node Web
@@ -1540,10 +1540,11 @@ Another option, good but not as performant, would be to use threads,
 possibly via par-map or futures.
 
 @deffn {Scheme Parameter} current-http-proxy
+@deffnx {Scheme Parameter} current-https-proxy
 Either @code{#f} or a non-empty string containing the URL of the HTTP
-proxy server to be used by the procedures in the @code{(web client)}
+or HTTPS proxy server to be used by the procedures in the @code{(web client)}
 module, including @code{open-socket-for-uri}.  Its initial value is
-based on the @env{http_proxy} environment variable.
+based on the @env{http_proxy} and @env{https_proxy} environment variables.
 
 @example
 (current-http-proxy) @result{} "http://localhost:8123/"

module/web/client.scm

@@ -45,7 +45,9 @@
   #:use-module (srfi srfi-9 gnu)
   #:use-module ((rnrs io ports)
                 #:prefix rnrs-ports:)
+  #:use-module (ice-9 match)
   #:export (current-http-proxy
+            current-https-proxy
             open-socket-for-uri
             http-request
             http-get
@@ -83,6 +85,11 @@ if it is unavailable."
                     (and (not (equal? proxy ""))
                          proxy))))
 
+(define current-https-proxy
+  (make-parameter (let ((proxy (getenv "https_proxy")))
+                    (and (not (equal? proxy ""))
+                         proxy))))
+
 (define (tls-wrap port server)
   "Return PORT wrapped in a TLS connection to SERVER.  SERVER must be a DNS
 host name without trailing dot."
@@ -159,9 +166,30 @@ host name without trailing dot."
    ((uri-reference? uri-or-string) uri-or-string)
    (else (error "Invalid URI-reference" uri-or-string))))
 
+(define (setup-http-tunnel port uri)
+  "Establish over PORT an HTTP tunnel to the destination server of URI."
+  (define target
+    (string-append (uri-host uri) ":"
+                   (number->string
+                    (or (uri-port uri)
+                        (match (uri-scheme uri)
+                          ('http 80)
+                          ('https 443))))))
+  (format port "CONNECT ~a HTTP/1.1\r\n" target)
+  (format port "Host: ~a\r\n\r\n" target)
+  (force-output port)
+  (read-response port))
+
 (define (open-socket-for-uri uri-or-string)
   "Return an open input/output port for a connection to URI."
-  (define http-proxy (current-http-proxy))
+  (define uri
+    (ensure-uri-reference uri-or-string))
+  (define https?
+    (eq? 'https (uri-scheme uri)))
+
+  (define (open-socket)
+    (define http-proxy
+      (if https? (current-https-proxy) (current-http-proxy)))
     (define uri (ensure-uri-reference (or http-proxy uri-or-string)))
     (define addresses
       (let ((port (uri-port uri)))
@@ -175,9 +203,7 @@ host name without trailing dot."
                           0))
          (lambda (ai1 ai2)
            (equal? (addrinfo:addr ai1) (addrinfo:addr ai2))))))
-  (define https?
-    (eq? 'https (uri-scheme uri)))
-  (define (open-socket)
+
     (let loop ((addresses addresses))
       (let* ((ai (car addresses))
              (s  (with-fluids ((%default-port-encoding #f))
@@ -199,29 +225,16 @@ host name without trailing dot."
                 (apply throw args)
                 (loop (cdr addresses))))))))
 
-  (let-syntax ((with-https-proxy
-                (syntax-rules ()
-                  ((_ exp)
-                   ;; For HTTPS URIs, honor 'https_proxy', not 'http_proxy'.
-                   ;; FIXME: Proxying is not supported for https.
-                   (let ((thunk (lambda () exp)))
-                     (if (and https?
-                              current-http-proxy)
-                         (parameterize ((current-http-proxy #f))
-                           (when (and=> (getenv "https_proxy")
-                                        (negate string-null?))
-                             (format (current-error-port)
-                                     "warning: 'https_proxy' is ignored~%"))
-                           (thunk))
-                         (thunk)))))))
-    (with-https-proxy
   (let ((s (open-socket)))
     ;; Buffer input and output on this port.
     (setvbuf s 'block %http-receive-buffer-size)
 
+    (when (and https? (current-https-proxy))
+      (setup-http-tunnel s uri))
+
     (if https?
         (tls-wrap s (uri-host uri))
-           s)))))
+        s)))
 
 (define (extend-request r k v . additional)
   (let ((r (set-field r (request-headers)