This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=23cf330c86a56b12525af0fea8ce7da0e0981e45 The branch, stable-2.0 has been updated via 23cf330c86a56b12525af0fea8ce7da0e0981e45 (commit) from 06903786211afd9a554b8f009a37111f729607ee (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 23cf330c86a56b12525af0fea8ce7da0e0981e45 Author: Mark H Weaver <[email protected]> Date: Fri Jun 7 00:47:33 2013 -0400 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'. ----------------------------------------------------------------------- Summary of changes: 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..c59f958 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. +@deffn {Scheme 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. + +@example +(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/"; +@end example +@end 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)) hooks/post-receive -- GNU Guile
