Re: [PATCH] Add support for HTTP proxies

[Mark H Weaver]

Hi Ludovic,

address@hidden (Ludovic Courtès) writes:

>> * The 'http-proxy-port?' object property (only needed if you connect to
>>   a proxy yourself, without using 'open-socket-for-uri').
>
> What about hiding the fact that it’s an object property, by providing a
> ‘set-http-proxy-port?!’ procedure?

Okay.

>> +(define current-http-proxy (make-parameter 'auto))
>> +
>> +(define (choose-http-proxy)
>> +  (let ((proxy (current-http-proxy)))
>> +    (if (not (eq? proxy 'auto))
>> +        proxy
>> +        (let ((proxy (getenv "http_proxy")))
>> +          (and (not (equal? proxy ""))
>> +               proxy)))))
>
> What about just:
>
>   (make-parameter (getenv "http_proxy"))

As Taylan pointed out, http_proxy="" is a widely supported convention
beyond of our control.  However, I agree with you that internally, we
should keep it simple and strict, and not support "" as a valid setting
for (current-http-proxy).  So how about this:

   (define current-http-proxy
     (make-parameter (let ((proxy (getenv "http_proxy")))
                       (and (not (equal? proxy ""))
                            proxy))))

I've attached an updated patch incorporating your suggestions, and
adding documentation for 'current-http-proxy'.  I'm not sure if I want
to bother documenting 'http-proxy-port?' et al.

What do you think?

    Regards,
      Mark


>From 8a2d0fe7c1308848dab30b496fa4dad84b8a0189 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
Date: Fri, 7 Jun 2013 00:47:33 -0400
Subject: [PATCH] Add support for HTTP proxies.

* module/web/http.scm (http-proxy-port?, set-http-proxy-port?!): New
  exported procedures.
  (write-request-line): If we're using an http proxy, write an
  absolute-URI in the request line.

* module/web/client.scm: Import (web http).
  (current-http-proxy): New exported parameter.
  (open-socket-for-uri): If 'current-http-proxy' is not false,
  connect to the proxy instead of the URI host, and use
  'set-http-proxy-port?!' to make note of that fact.

* doc/ref/web.texi (Web Client): Document 'current-http-proxy'.
---
 doc/ref/web.texi      |   14 ++++++++++++++
 module/web/client.scm |   14 ++++++++++++--
 module/web/http.scm   |   25 ++++++++++++++++++++++++-
 3 files changed, 50 insertions(+), 3 deletions(-)

diff --git a/doc/ref/web.texi b/doc/ref/web.texi
index 0d41f9f..00f851f 100644
--- a/doc/ref/web.texi
+++ b/doc/ref/web.texi
@@ -1459,6 +1459,20 @@ fetcher, similar in structure to the web server 
(@pxref{Web Server}).
 Another option, good but not as performant, would be to use threads,
 possibly via par-map or futures.
 
address@hidden {Parameter} current-http-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)}
+module, including @code{open-socket-for-uri}.  Its initial value is
+based on the @env{http_proxy} environment variable.
+
address@hidden
+(current-http-proxy) @result{} "http://localhost:8123/";
+(parameterize ((current-http-proxy #f))
+  (http-get "http://example.com/";))  ; temporarily bypass proxy
+(current-http-proxy) @result{} "http://localhost:8123/";
address@hidden example
address@hidden deffn
+
 
 @node Web Server
 @subsection Web Server
diff --git a/module/web/client.scm b/module/web/client.scm
index 7d5ea49..24132c6 100644
--- a/module/web/client.scm
+++ b/module/web/client.scm
@@ -39,8 +39,10 @@
   #:use-module (web request)
   #:use-module (web response)
   #:use-module (web uri)
+  #:use-module (web http)
   #:use-module (srfi srfi-1)
-  #:export (open-socket-for-uri
+  #:export (current-http-proxy
+            open-socket-for-uri
             http-get
             http-get*
             http-head
@@ -50,6 +52,11 @@
             http-trace
             http-options))
 
+(define current-http-proxy
+  (make-parameter (let ((proxy (getenv "http_proxy")))
+                    (and (not (equal? proxy ""))
+                         proxy))))
+
 (define (ensure-uri uri-or-string)
   (cond
    ((string? uri-or-string) (string->uri uri-or-string))
@@ -58,7 +65,8 @@
 
 (define (open-socket-for-uri uri-or-string)
   "Return an open input/output port for a connection to URI."
-  (define uri (ensure-uri uri-or-string))
+  (define http-proxy (current-http-proxy))
+  (define uri (ensure-uri (or http-proxy uri-or-string)))
   (define addresses
     (let ((port (uri-port uri)))
       (delete-duplicates
@@ -84,6 +92,8 @@
           (setvbuf s _IOFBF)
           ;; Enlarge the receive buffer.
           (setsockopt s SOL_SOCKET SO_RCVBUF (* 12 1024))
+          ;; If we're using a proxy, make a note of that.
+          (when http-proxy (set-http-proxy-port?! s #t))
           s)
         (lambda args
           ;; Connection failed, so try one of the other addresses.
diff --git a/module/web/http.scm b/module/web/http.scm
index 35169ef..21d2964 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -66,7 +66,10 @@
             write-response-line
 
             make-chunked-input-port
-            make-chunked-output-port))
+            make-chunked-output-port
+
+            http-proxy-port?
+            set-http-proxy-port?!))
 
 
 (define (string->header name)
@@ -1117,6 +1120,21 @@ three values: the method, the URI, and the version."
   "Write the first line of an HTTP request to PORT."
   (display method port)
   (display #\space port)
+  (when (http-proxy-port? port)
+    (let ((scheme (uri-scheme uri))
+          (host (uri-host uri))
+          (host-port (uri-port uri)))
+      (when (and scheme host)
+        (display scheme port)
+        (display "://" port)
+        (if (string-index host #\:)
+            (begin (display #\[ port)
+                   (display host port)
+                   (display #\] port))
+            (display host port))
+        (unless ((@@ (web uri) default-port?) scheme host-port)
+          (display #\: port)
+          (display host-port port)))))
   (let ((path (uri-path uri))
         (query (uri-query uri)))
     (if (not (string-null? path))
@@ -1958,3 +1976,8 @@ KEEP-ALIVE? is true."
     (unless keep-alive?
       (close-port port)))
   (make-soft-port (vector put-char put-string flush #f close) "w"))
+
+(define %http-proxy-port? (make-object-property))
+(define (http-proxy-port? port) (%http-proxy-port? port))
+(define (set-http-proxy-port?! port flag)
+  (set! (%http-proxy-port? port) flag))
-- 
1.7.10.4