diff --git a/pkgs/net-doc/net/scribblings/url.scrbl b/pkgs/net-doc/net/scribblings/url.scrbl index 9d18a1f64e..96a54259f1 100644 --- a/pkgs/net-doc/net/scribblings/url.scrbl +++ b/pkgs/net-doc/net/scribblings/url.scrbl @@ -2,6 +2,7 @@ @(require "common.rkt" scribble/bnf (for-label net/url net/url-unit net/url-sig racket/list + racket/tcp net/head net/uri-codec net/tcp-sig net/http-client (only-in net/url-connect current-https-protocol) @@ -591,6 +592,15 @@ This function does not support proxies. } +@defproc[(tcp-or-tunnel-connect [scheme string?] + [host string?] + [port (between/c 1 65535)]) + (values input-port? output-port?)]{ + If @racket[(proxy-server-for scheme host)], then the proxy is used to + @racket[http-conn-CONNECT-tunnel] to @racket[host] (on port @racket[port]). + + Otherwise the call is equivalent to @racket[(tcp-connect host port)].} + @section{URL HTTPS mode} @defmodule[net/url-connect] diff --git a/racket/collects/net/git-checkout.rkt b/racket/collects/net/git-checkout.rkt index dc5bfa2126..00dd2b1b50 100644 --- a/racket/collects/net/git-checkout.rkt +++ b/racket/collects/net/git-checkout.rkt @@ -203,15 +203,7 @@ (define (initial-connect transport host verify? port repo status) (case transport [(git) - (define-values (i o) - (let ((proxy (proxy-server-for "git" host))) - (if proxy - (let ((proxy-host (cadr proxy)) - (proxy-port (caddr proxy))) - (let-values (([t:ssl-ctx t:from t:to t:abandon-p] - (http-conn-CONNECT-tunnel proxy-host proxy-port host port #:ssl? #f))) - (values t:from t:to))) - (tcp-connect host port)))) + (define-values (i o) (tcp-or-tunnel-connect "git" host port)) (values i o #f)] [(http https) (define url-str diff --git a/racket/collects/net/http-client.rkt b/racket/collects/net/http-client.rkt index 82198bc29b..ef793781a2 100644 --- a/racket/collects/net/http-client.rkt +++ b/racket/collects/net/http-client.rkt @@ -66,11 +66,11 @@ (cond [(list? ssl?) ;; At this point, we have a tunneled socket to the remote host/port: we do not need to ;; address it; ignore host-bs, only use port for conn-port-usual? - (match-let (((list ssl? (? input-port? t:from) (? output-port? t:to) abandon-p) ssl?)) - (set-http-conn-abandon-p! hc abandon-p) - (set-http-conn-port-usual?! hc (or (and ssl? (= 443 port)) - (and (not ssl?) (= 80 port)))) - (values t:from t:to))] + (match-define (list ssl-ctx? (? input-port? t:from) (? output-port? t:to) abandon-p) ssl?) + (set-http-conn-abandon-p! hc abandon-p) + (set-http-conn-port-usual?! hc (or (and ssl-ctx? (= 443 port)) + (and (not ssl-ctx?) (= 80 port)))) + (values t:from t:to)] [ssl? (set-http-conn-port-usual?! hc (= 443 port)) (cond @@ -129,37 +129,34 @@ #:headers [headers-bs empty] #:content-decode [decodes '(gzip)] #:data [data #f]) - (define (print-to fmt . args) - ;; (eprintf "print-to: ~a~%" (apply format fmt args)) - (apply fprintf to fmt args)) (match-define (http-conn host port port-usual? to from _) hc) - (print-to "~a ~a HTTP/~a\r\n" method-bss url-bs version-bs) + (fprintf to "~a ~a HTTP/~a\r\n" method-bss url-bs version-bs) (unless (regexp-member #rx"^(?i:Host:) +.+$" headers-bs) - (print-to "Host: ~a\r\n" + (fprintf to "Host: ~a\r\n" (if port-usual? host (format "~a:~a" host port)))) (unless (regexp-member #rx"^(?i:User-Agent:) +.+$" headers-bs) - (print-to "User-Agent: Racket/~a (net/http-client)\r\n" + (fprintf to "User-Agent: Racket/~a (net/http-client)\r\n" (version))) (unless (or (not (memq 'gzip decodes)) (regexp-member #rx"^(?i:Accept-Encoding:) +.+$" headers-bs)) - (print-to "Accept-Encoding: gzip\r\n")) + (fprintf to "Accept-Encoding: gzip\r\n")) (define body (->bytes data)) (cond [(procedure? body) - (print-to "Transfer-Encoding: chunked\r\n")] + (fprintf to "Transfer-Encoding: chunked\r\n")] [(and body (not (regexp-member #rx"^(?i:Content-Length:) +.+$" headers-bs))) - (print-to "Content-Length: ~a\r\n" (bytes-length body))]) + (fprintf to "Content-Length: ~a\r\n" (bytes-length body))]) (when close? (unless (regexp-member #rx"^(?i:Connection:) +.+$" headers-bs) - (print-to "Connection: close\r\n"))) + (fprintf to "Connection: close\r\n"))) (for ([h (in-list headers-bs)]) - (print-to "~a\r\n" h)) - (print-to "\r\n") + (fprintf to "~a\r\n" h)) + (fprintf to "\r\n") (cond [(procedure? body) (body (λ (data) (write-chunk to data))) - (print-to "0\r\n\r\n")] + (fprintf to "0\r\n\r\n")] [body (display body to)]) (flush-output to)) @@ -268,11 +265,6 @@ (define abandon-p (lambda (p) ((http-conn-abandon-p hc) p))) (values ssl? t:from t:to abandon-p)] - [(osx-old-openssl?) - (http-conn-close! hc) - ;; osx-old-openssl? doesn't support ports->...ssl-ports - (error 'http-conn-open! "osx-old-openssl? does not support a ports->...ssl-ports function")] - [else ; ssl (define ssl-version (if (boolean? ssl?) 'auto ssl?)) (set-http-conn-port-usual?! hc (= 443 target-port)) diff --git a/racket/collects/net/url.rkt b/racket/collects/net/url.rkt index eb9859cfab..3b393e2a70 100644 --- a/racket/collects/net/url.rkt +++ b/racket/collects/net/url.rkt @@ -5,6 +5,7 @@ racket/list racket/match racket/promise + racket/tcp (prefix-in hc: "http-client.rkt") (only-in "url-connect.rkt" current-https-protocol) "uri-codec.rkt" @@ -547,3 +548,18 @@ #:data (or/c false/c bytes? string? hc:data-procedure/c) #:content-decode (listof symbol?)) (values bytes? (listof bytes?) input-port?))])) + +;; tcp-or-tunnel-connect : string string number -> (values input-port? output-port?) +(define (tcp-or-tunnel-connect scheme host port) + (match (proxy-server-for scheme host) + [(list _ proxy-host proxy-port) + (define-values (t:ssl-ctx t:from t:to t:abandon-p) + (hc:http-conn-CONNECT-tunnel proxy-host proxy-port host port #:ssl? #f)) + (values t:from t:to)] + [_ (tcp-connect host port)])) + +(provide + (contract-out + [tcp-or-tunnel-connect + (-> string? string? (between/c 1 65535) + (values input-port? output-port?))]))