diff --git a/racket/collects/net/http-client.rkt b/racket/collects/net/http-client.rkt index f74553bb11..b243241944 100644 --- a/racket/collects/net/http-client.rkt +++ b/racket/collects/net/http-client.rkt @@ -184,27 +184,34 @@ (define (http-conn-response-port/chunked! hc #:close? [close? #f]) (define (http-pipe-chunk ip op) + (define (done) + (flush-output op) + (close-output-port op)) (define crlf-bytes (make-bytes 2)) (let loop ([last-bytes #f]) - (define size-str (string-trim (read-line ip eol-type))) - (define chunk-size (string->number size-str 16)) - (unless chunk-size - (error 'http-conn-response/chunked - "Could not parse ~S as hexadecimal number" - size-str)) - (define use-last-bytes? - (and last-bytes (<= chunk-size (bytes-length last-bytes)))) - (if (zero? chunk-size) - (begin (flush-output op) - (close-output-port op)) - (let* ([bs (if use-last-bytes? - (begin - (read-bytes! last-bytes ip 0 chunk-size) - last-bytes) - (read-bytes chunk-size ip))] - [crlf (read-bytes! crlf-bytes ip 0 2)]) - (write-bytes bs op 0 chunk-size) - (loop bs))))) + (define in-v (read-line ip eol-type)) + (cond + [(eof-object? in-v) + (done)] + [else + (define size-str (string-trim in-v)) + (define chunk-size (string->number size-str 16)) + (unless chunk-size + (error 'http-conn-response/chunked + "Could not parse ~S as hexadecimal number" + size-str)) + (define use-last-bytes? + (and last-bytes (<= chunk-size (bytes-length last-bytes)))) + (if (zero? chunk-size) + (done) + (let* ([bs (if use-last-bytes? + (begin + (read-bytes! last-bytes ip 0 chunk-size) + last-bytes) + (read-bytes chunk-size ip))] + [crlf (read-bytes! crlf-bytes ip 0 2)]) + (write-bytes bs op 0 chunk-size) + (loop bs)))]))) (define-values (in out) (make-pipe PIPE-SIZE)) (define chunk-t diff --git a/racket/collects/net/url.rkt b/racket/collects/net/url.rkt index 2a39e39085..9564806d8b 100644 --- a/racket/collects/net/url.rkt +++ b/racket/collects/net/url.rkt @@ -79,20 +79,21 @@ (define proxy (assoc (url-scheme url) (current-proxy-servers))) (define hc (make-ports url proxy)) (define access-string - (url->string - (if proxy - url - ;; RFCs 1945 and 2616 say: - ;; Note that the absolute path cannot be empty; if none is present in - ;; the original URI, it must be given as "/" (the server root). - (let-values ([(abs? path) - (if (null? (url-path url)) - (values #t (list (make-path/param "" '()))) - (values (url-path-absolute? url) (url-path url)))]) - (make-url #f #f #f #f abs? path (url-query url) (url-fragment url)))))) + (ensure-non-empty + (url->string + (if proxy + url + ;; RFCs 1945 and 2616 say: + ;; Note that the absolute path cannot be empty; if none is present in + ;; the original URI, it must be given as "/" (the server root). + (let-values ([(abs? path) + (if (null? (url-path url)) + (values #t (list (make-path/param "" '()))) + (values (url-path-absolute? url) (url-path url)))]) + (make-url #f #f #f #f abs? path (url-query url) (url-fragment url))))))) (hc:http-conn-send! hc access-string - #:method (if get? "GET" "POST") + #:method (if get? #"GET" #"POST") #:headers strings #:content-decode '() #:data post-data) @@ -111,16 +112,19 @@ (cond [(not scheme) (schemeless-url url)] [(or (string=? scheme "http") (string=? scheme "https")) - (define hc (http://getpost-impure-port get? url post-data strings make-ports #f)) - (http-conn-impure-port hc)] + (define hc + (http://getpost-impure-port get? url post-data strings make-ports #f)) + (http-conn-impure-port hc + #:method (if get? "GET" "POST"))] [(string=? scheme "file") (url-error "There are no impure file: ports")] [else (url-error "Scheme ~a unsupported" scheme)]))) -(define (http-conn-impure-port hc) +(define (http-conn-impure-port hc + #:method [method-bss #"GET"]) (define-values (in out) (make-pipe 4096)) (define-values (status headers response-port) - (hc:http-conn-recv! hc #:close? #t #:content-decode '())) + (hc:http-conn-recv! hc #:method method-bss #:close? #t #:content-decode '())) (fprintf out "~a\r\n" status) (for ([h (in-list headers)]) (fprintf out "~a\r\n" h)) @@ -155,7 +159,8 @@ (http://getpost-impure-port get? url post-data strings make-ports #f) - #:content-decode '() + #:method (if get? #"GET" #"POST") + #:content-decode '() #:close? #t)) response-port] [else @@ -187,7 +192,7 @@ make-ports) (and conn #t))) (define-values (status headers response-port) - (hc:http-conn-recv! hc #:close? (not conn) #:content-decode '())) + (hc:http-conn-recv! hc #:method #"GET" #:close? (not conn) #:content-decode '())) (define new-url (ormap (λ (h) @@ -323,20 +328,28 @@ [else (url-error "unsupported method: ~a" method)])] [proxy (assoc (url-scheme url) (current-proxy-servers))] [hc (make-ports url proxy)] - [access-string (url->string - (if proxy - url - (make-url #f #f #f #f - (url-path-absolute? url) - (url-path url) - (url-query url) - (url-fragment url))))]) + [access-string + (ensure-non-empty + (url->string + (if proxy + url + (make-url #f #f #f #f + (url-path-absolute? url) + (url-path url) + (url-query url) + (url-fragment url)))))]) (hc:http-conn-send! hc access-string #:method method #:headers strings #:content-decode '() #:data data) - (http-conn-impure-port hc))) + (http-conn-impure-port hc + #:method method))) + +(define (ensure-non-empty s) + (if (string=? "" s) + "/" + s)) (provide (all-from-out "url-string.rkt")) @@ -394,12 +407,13 @@ (error 'http-sendrecv/url "Host required: ~e" u)) (hc:http-sendrecv (url-host u) - (url->string - (make-url #f #f #f #f - (url-path-absolute? u) - (url-path u) - (url-query u) - (url-fragment u))) + (ensure-non-empty + (url->string + (make-url #f #f #f #f + (url-path-absolute? u) + (url-path u) + (url-query u) + (url-fragment u)))) #:ssl? (if (equal? "https" (url-scheme u)) (current-https-protocol)