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

net/head: better error message for bytes/string mismatch

Browse Source
This commit is contained in:
John Clements 2015-11-09 01:33:14 -08:00
parent 04c0c59d27
commit b5e2ae030b
1 changed files with 28 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
racket/collects/net/head.rkt
View File

@ -81,29 +81,35 @@
(define (extract-field field header)
(if (bytes? header)
(let ([m (regexp-match-positions (make-field-start-regexp/bytes field)
header)])
(and m
(let ([s (subbytes header
(cdaddr m)
(bytes-length header))])
(let ([m (regexp-match-positions #rx#"[\r][\n][^: \r\n\"]*:" s)])
(if m
(subbytes s 0 (caar m))
;; Rest of header is this field, but strip trailing CRLFCRLF:
(regexp-replace #rx#"\r\n\r\n$" s ""))))))
(cond
[(bytes? field)
(let ([m (regexp-match-positions (make-field-start-regexp/bytes field)
header)])
(and m
(let ([s (subbytes header
(cdaddr m)
(bytes-length header))])
(let ([m (regexp-match-positions #rx#"[\r][\n][^: \r\n\"]*:" s)])
(if m
(subbytes s 0 (caar m))
;; Rest of header is this field, but strip trailing CRLFCRLF:
(regexp-replace #rx#"\r\n\r\n$" s ""))))))]
[else (raise-argument-error 'extract-field "bytes field for bytes header" 0 field header)])
;; otherwise header & field should be strings:
(let ([m (regexp-match-positions (make-field-start-regexp field)
header)])
(and m
(let ([s (substring header
(cdaddr m)
(string-length header))])
(let ([m (regexp-match-positions #rx"[\r][\n][^: \r\n\"]*:" s)])
(if m
(substring s 0 (caar m))
;; Rest of header is this field, but strip trailing CRLFCRLF:
(regexp-replace #rx"\r\n\r\n$" s ""))))))))
(cond
[(string? field)
(let ([m (regexp-match-positions (make-field-start-regexp field)
header)])
(and m
(let ([s (substring header
(cdaddr m)
(string-length header))])
(let ([m (regexp-match-positions #rx"[\r][\n][^: \r\n\"]*:" s)])
(if m
(substring s 0 (caar m))
;; Rest of header is this field, but strip trailing CRLFCRLF:
(regexp-replace #rx"\r\n\r\n$" s ""))))))]
[else (raise-argument-error 'extract-field "string field for string header" 0 field header)])))
(define (replace-field field data header)
(if (bytes? header)