[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [PATCH] Add support for HTTP proxies
From: |
Mark H Weaver |
Subject: |
Re: [PATCH] Add support for HTTP proxies |
Date: |
Fri, 07 Jun 2013 02:16:15 -0400 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/24.3 (gnu/linux) |
Here's a much simpler patch that discards the keyword arguments of the
previous version, so that the only new interfaces are:
* The 'http_proxy' environment variable.
* The 'current-http-proxy' parameter.
* The 'http-proxy-port?' object property (only needed if you connect to
a proxy yourself, without using 'open-socket-for-uri').
Given that we'll eventually want to add support for other kinds of
proxies (e.g. https_proxy and ftp_proxy), I guess the keyword argument
approach is not really practical here.
What do you think?
Mark
>From 681daf7311d423408cdc1fd21482c3dabc6fc98c 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 (PRELIMINARY)
* module/web/http.scm (http-proxy-port?): New exported object property.
(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.
(choose-http-proxy): New procedure.
(open-socket-for-uri): If 'choose-http-proxy' returns a true value,
connect to the proxy instead of the URI host, and set the
'http-proxy-port?' object property on the socket.
---
module/web/client.scm | 19 +++++++++++++++++--
module/web/http.scm | 21 ++++++++++++++++++++-
2 files changed, 37 insertions(+), 3 deletions(-)
diff --git a/module/web/client.scm b/module/web/client.scm
index 7d5ea49..c401a80 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,16 @@
http-trace
http-options))
+(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)))))
+
(define (ensure-uri uri-or-string)
(cond
((string? uri-or-string) (string->uri uri-or-string))
@@ -58,7 +70,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 (choose-http-proxy))
+ (define uri (ensure-uri (or http-proxy uri-or-string)))
(define addresses
(let ((port (uri-port uri)))
(delete-duplicates
@@ -84,6 +97,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..a587578 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -66,7 +66,9 @@
write-response-line
make-chunked-input-port
- make-chunked-output-port))
+ make-chunked-output-port
+
+ http-proxy-port?))
(define (string->header name)
@@ -1117,6 +1119,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 +1975,5 @@ 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))
--
1.7.10.4