1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00

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'.
This commit is contained in:
Mark H Weaver 2013-06-07 00:47:33 -04:00
parent 0690378621
commit 23cf330c86
3 changed files with 50 additions and 3 deletions

View file

@ -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, Another option, good but not as performant, would be to use threads,
possibly via par-map or futures. 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 @node Web Server
@subsection Web Server @subsection Web Server

View file

@ -39,8 +39,10 @@
#:use-module (web request) #:use-module (web request)
#:use-module (web response) #:use-module (web response)
#:use-module (web uri) #:use-module (web uri)
#:use-module (web http)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:export (open-socket-for-uri #:export (current-http-proxy
open-socket-for-uri
http-get http-get
http-get* http-get*
http-head http-head
@ -50,6 +52,11 @@
http-trace http-trace
http-options)) http-options))
(define current-http-proxy
(make-parameter (let ((proxy (getenv "http_proxy")))
(and (not (equal? proxy ""))
proxy))))
(define (ensure-uri uri-or-string) (define (ensure-uri uri-or-string)
(cond (cond
((string? uri-or-string) (string->uri uri-or-string)) ((string? uri-or-string) (string->uri uri-or-string))
@ -58,7 +65,8 @@
(define (open-socket-for-uri uri-or-string) (define (open-socket-for-uri uri-or-string)
"Return an open input/output port for a connection to URI." "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 (define addresses
(let ((port (uri-port uri))) (let ((port (uri-port uri)))
(delete-duplicates (delete-duplicates
@ -84,6 +92,8 @@
(setvbuf s _IOFBF) (setvbuf s _IOFBF)
;; Enlarge the receive buffer. ;; Enlarge the receive buffer.
(setsockopt s SOL_SOCKET SO_RCVBUF (* 12 1024)) (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) s)
(lambda args (lambda args
;; Connection failed, so try one of the other addresses. ;; Connection failed, so try one of the other addresses.

View file

@ -66,7 +66,10 @@
write-response-line write-response-line
make-chunked-input-port make-chunked-input-port
make-chunked-output-port)) make-chunked-output-port
http-proxy-port?
set-http-proxy-port?!))
(define (string->header name) (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." "Write the first line of an HTTP request to PORT."
(display method port) (display method port)
(display #\space 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)) (let ((path (uri-path uri))
(query (uri-query uri))) (query (uri-query uri)))
(if (not (string-null? path)) (if (not (string-null? path))
@ -1958,3 +1976,8 @@ KEEP-ALIVE? is true."
(unless keep-alive? (unless keep-alive?
(close-port port))) (close-port port)))
(make-soft-port (vector put-char put-string flush #f close) "w")) (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))