suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

protect against errors from early-eof, protect against url objects with no path, ensure method is always passed correctly

Browse Source
This commit is contained in:
Jay McCarthy 2015-10-30 13:49:40 -04:00
parent 342198625e
commit fddd85fa18
2 changed files with 73 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
racket/collects/net/http-client.rkt
View File

@ -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

80
racket/collects/net/url.rkt
View File

@ -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)