[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 05/23: http: allow custom read-line / continuation-line?
From: |
Andy Wingo |
Subject: |
[Guile-commits] 05/23: http: allow custom read-line / continuation-line? functions |
Date: |
Thu, 24 Mar 2016 14:26:02 +0000 |
wingo pushed a commit to branch wip-ethreads
in repository guile.
commit 05c6d352a6a5864fc02079421128103d37dff52b
Author: Andy Wingo <address@hidden>
Date: Sun Mar 18 10:41:03 2012 +0100
http: allow custom read-line / continuation-line? functions
* module/web/http.scm (read-line): Rename from read-line*. Just use
string-trim-right instead of our loop; the previous behavior was
always falling through to the "substring" case because of \r.
(continuation-line?): New predicate.
(read-continuation-line): Take read-line and continuation-line? as
arguments.
(read-header, read-headers, read-request-line, read-response-line):
Take optional read-line and (for the first two) continuation-line?
predicates, so that client code can override these if desired.
---
module/web/http.scm | 66 ++++++++++++++++++++++++--------------------------
1 files changed, 32 insertions(+), 34 deletions(-)
diff --git a/module/web/http.scm b/module/web/http.scm
index 8a07f6d..8958805 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -143,43 +143,38 @@ The default writer is ‘display’."
(header-decl-writer decl)
display)))
-(define (read-line* port)
+(define (read-line port)
(let* ((pair (%read-line port))
(line (car pair))
(delim (cdr pair)))
(if (and (string? line) (char? delim))
- (let ((orig-len (string-length line)))
- (let lp ((len orig-len))
- (if (and (> len 0)
- (char-whitespace? (string-ref line (1- len))))
- (lp (1- len))
- (if (= len orig-len)
- line
- (substring line 0 len)))))
+ (string-trim-right line)
(bad-header '%read line))))
-(define (read-continuation-line port val)
- (if (or (eqv? (peek-char port) #\space)
- (eqv? (peek-char port) #\tab))
+(define (continuation-line? port)
+ (case (peek-char port)
+ ((#\space #\tab) #t)
+ (else #f)))
+
+(define (read-continuation-line port val read-line continuation-line?)
+ (if (continuation-line? port)
(read-continuation-line port
- (string-append val
- (begin
- (read-line* port))))
+ (string-append val (read-line port))
+ read-line continuation-line?)
val))
-(define *eof* (call-with-input-string "" read))
-
-(define (read-header port)
- "Read one HTTP header from PORT. Return two values: the header
+(define* (read-header port #:optional
+ (read-line read-line)
+ (continuation-line? continuation-line?))
+ "Reads one HTTP header from @var{port}. Returns two values: the header
name and the parsed Scheme value. May raise an exception if the header
was known but the value was invalid.
Returns the end-of-file object for both values if the end of the message
body was reached (i.e., a blank line)."
- (let ((line (read-line* port)))
- (if (or (string-null? line)
- (string=? line "\r"))
- (values *eof* *eof*)
+ (let ((line (read-line port)))
+ (if (string-null? line)
+ (values the-eof-object the-eof-object)
(let* ((delim (or (string-index line #\:)
(bad-header '%read line)))
(sym (string->header (substring line 0 delim))))
@@ -189,7 +184,8 @@ body was reached (i.e., a blank line)."
sym
(read-continuation-line
port
- (string-trim-both line char-set:whitespace (1+ delim)))))))))
+ (string-trim-both line char-set:whitespace (1+ delim))
+ read-line continuation-line?)))))))
(define (parse-header sym val)
"Parse VAL, a string, with the parser registered for the header
@@ -211,11 +207,13 @@ from ‘header-writer’."
((header-writer sym) val port)
(display "\r\n" port))
-(define (read-headers port)
- "Read the headers of an HTTP message from PORT, returning them
-as an ordered alist."
+(define* (read-headers port #:optional (read-line read-line)
+ (continuation-line? continuation-line?))
+ "Read an HTTP message from @var{port}, returning the headers as an
+ordered alist."
(let lp ((headers '()))
- (call-with-values (lambda () (read-header port))
+ (call-with-values
+ (lambda () (read-header port read-line continuation-line?))
(lambda (k v)
(if (eof-object? k)
(reverse! headers)
@@ -1082,10 +1080,10 @@ not have to have a scheme or host name. The result is
a URI object."
(or (string->uri (substring str start end))
(bad-request "Invalid URI: ~a" (substring str start end))))))
-(define (read-request-line port)
- "Read the first line of an HTTP request from PORT, returning
+(define* (read-request-line port #:optional (read-line read-line))
+ "Read the first line of an HTTP request from @var{port}, returning
three values: the method, the URI, and the version."
- (let* ((line (read-line* port))
+ (let* ((line (read-line port))
(d0 (string-index line char-set:whitespace)) ; "delimiter zero"
(d1 (string-rindex line char-set:whitespace)))
(if (and d0 d1 (< d0 d1))
@@ -1153,11 +1151,11 @@ three values: the method, the URI, and the version."
(write-http-version version port)
(display "\r\n" port))
-(define (read-response-line port)
- "Read the first line of an HTTP response from PORT, returning
+(define* (read-response-line port #:optional (read-line read-line))
+ "Read the first line of an HTTP response from @var{port}, returning
three values: the HTTP version, the response code, and the \"reason
phrase\"."
- (let* ((line (read-line* port))
+ (let* ((line (read-line port))
(d0 (string-index line char-set:whitespace)) ; "delimiter zero"
(d1 (and d0 (string-index line char-set:whitespace
(skip-whitespace line d0)))))
- [Guile-commits] branch wip-ethreads created (now 4dc952f), Andy Wingo, 2016/03/24
- [Guile-commits] 04/23: add (ice-9 ethreads), Andy Wingo, 2016/03/24
- [Guile-commits] 09/23: eports: some more exports, Andy Wingo, 2016/03/24
- [Guile-commits] 12/23: (web server ethreads): Use a large backlog., Andy Wingo, 2016/03/24
- [Guile-commits] 13/23: add latin1 chars and strings to eports, Andy Wingo, 2016/03/24
- [Guile-commits] 18/23: (web server ethreads) TCP_NODELAY tweak, Andy Wingo, 2016/03/24
- [Guile-commits] 05/23: http: allow custom read-line / continuation-line? functions,
Andy Wingo <=
- [Guile-commits] 06/23: setsockopt can take an fd, Andy Wingo, 2016/03/24
- [Guile-commits] 10/23: EOF fix for continuation-line?, Andy Wingo, 2016/03/24
- [Guile-commits] 19/23: nio: add non-blocking connect, Andy Wingo, 2016/03/24
- [Guile-commits] 08/23: add #:limit to get-bytevector-delimited, Andy Wingo, 2016/03/24
- [Guile-commits] 11/23: socket: TCP_CORK, TCP_NODELAY, Andy Wingo, 2016/03/24
- [Guile-commits] 23/23: virtualize read/write/close operations in <eport>, Andy Wingo, 2016/03/24
- [Guile-commits] 15/23: (web server ethreads): more use of latin1 accessors, Andy Wingo, 2016/03/24
- [Guile-commits] 01/23: add (ice-9 nio), Andy Wingo, 2016/03/24
- [Guile-commits] 20/23: eports: nonblocking connect-eport, Andy Wingo, 2016/03/24
- [Guile-commits] 14/23: refactoring to (web server ethreads) read-http-line, Andy Wingo, 2016/03/24