diff --git a/doc/ref/web.texi b/doc/ref/web.texi index 0d41f9f7a..c59f9580d 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 7d5ea4989..24132c674 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 35169ef5c..21d2964b4 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))