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:
parent
0690378621
commit
23cf330c86
3 changed files with 50 additions and 3 deletions
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue