[Guile-commits] GNU Guile branch, wip-ethreads, updated. v2.0.5-108-g23f820a

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=23f820abb0a28381c78fb7d38fa091244e406378

The branch, wip-ethreads has been updated
       via  23f820abb0a28381c78fb7d38fa091244e406378 (commit)
       via  68198764a79379af6737d19d0dc3a9c2e26572ed (commit)
      from  5061caf5dd259e373338eee6bbec3e5f913cf6a3 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 23f820abb0a28381c78fb7d38fa091244e406378
Author: Andy Wingo <address@hidden>
Date:   Tue Mar 27 00:14:52 2012 +0200

    refactoring to (web server ethreads) read-http-line
    
    * module/web/server/ethreads.scm (read-http-line): Use
      get-latin1-string-delimited with a limit on the line length.

commit 68198764a79379af6737d19d0dc3a9c2e26572ed
Author: Andy Wingo <address@hidden>
Date:   Tue Mar 27 00:14:08 2012 +0200

    add latin1 chars and strings to eports
    
    * module/ice-9/eports.scm: Add functions that deal in latin1.

-----------------------------------------------------------------------

Summary of changes:
 module/ice-9/eports.scm        |  156 +++++++++++++++++++++++++++++++++------
 module/web/server/ethreads.scm |   23 ++++---
 2 files changed, 145 insertions(+), 34 deletions(-)

diff --git a/module/ice-9/eports.scm b/module/ice-9/eports.scm
index c0280a3..d125612 100644
--- a/module/ice-9/eports.scm
+++ b/module/ice-9/eports.scm
@@ -43,9 +43,19 @@
             get-bytevector-n
             get-bytevector-n!
             get-bytevector-delimited
-            get-u8
             put-u8
-            put-bytevector))
+            put-bytevector
+
+            get-latin1-char
+            putback-latin1-char
+            lookahead-latin1-char
+            get-latin1-string-some
+            putback-latin1-string
+            get-latin1-string-n
+            get-latin1-string-n!
+            get-latin1-string-delimited
+            put-latin1-char
+            put-latin1-string))
 
 (define-record-type <eport>
   (make-eport fd readbuf writebuf file-port)
@@ -312,12 +322,13 @@
             (flush-buffer buf len)
             ret)))))
 
-;; Read bytes from EPORT until the byte DELIMITER is seen.  Return
-;; two values: a bytevector of the bytes read, not including the
-;; delimiter, and the delimiter, or the EOF object if EOF was
+;; Read bytes from EPORT, continuing to read until calling PREDICATE on
+;; the byte returns a true value.  Return two values: a bytevector of
+;; the bytes read, not including the delimiter, and the delimiter, or #f
+;; if the byte limit was reached, or the EOF object if EOF was
 ;; encountered first.
 ;;
-(define* (get-bytevector-delimited eport predicate #:key limit)
+(define* (get-bytevector-delimited eport predicate #:key max-bytes)
   (define (collect-result prev prev-len bv)
     (if (null? prev-len)
         bv
@@ -331,12 +342,10 @@
                 (bytevector-copy! (car prev) 0 out (- prev-len len) len)
                 (lp (cdr prev) (- prev-len len)))))))))
   (define (found-delimiter buf start len delimiter prev prev-len)
-    (when (and limit (> (+ len prev-len) limit))
-      (error "Input too long" limit (+ len prev-len)))
     (let ((ret (make-bytevector len)))
       (bytevector-copy! (buf-bv buf) start ret 0 len)
       ;; Plus one for the delimiter, if present
-      (flush-buffer buf (if (eof-object? delimiter) len (1+ len)))
+      (flush-buffer buf (if (integer? delimiter) (1+ len) len))
       (values (collect-result prev prev-len ret)
               delimiter)))
   (let ((buf (eport-readbuf eport)))
@@ -346,11 +355,11 @@
            (size (bytevector-length bv)))
       (let lp ((prev '()) (prev-len 0))
         (when (= (buf-cur buf) (buf-end buf))
-          (when (and limit (> prev-len limit))
-            (error "Input too long" limit prev-len))
           (fill-input eport))
-        (let ((cur (buf-cur buf))
-              (end (buf-end buf)))
+        (let* ((cur (buf-cur buf))
+               (end (if max-bytes
+                        (min (+ cur (- max-bytes prev-len)) (buf-end buf))
+                        (buf-end buf))))
           (let search ((i cur))
             (if (< i end)
                 (if (predicate (bytevector-u8-ref bv i))
@@ -359,17 +368,21 @@
                                      prev prev-len)
                     (search (1+ i)))
                 (let ((len (- end cur)))
-                  (if (zero? len)
-                      ;; EOF
-                      (if (zero? prev-len)
-                          (values the-eof-object
-                                  the-eof-object)
-                          (found-delimiter buf cur len the-eof-object
-                                           prev prev-len))
-                      (let ((ret (make-bytevector len)))
-                        (bytevector-copy! bv cur ret 0 len)
-                        (flush-buffer buf len)
-                        (lp (cons ret prev) (+ len prev-len))))))))))))
+                  (cond
+                   ((and max-bytes (= (+ len prev-len) max-bytes))
+                    ;; Limit reached
+                    (found-delimiter buf cur len #f
+                                     prev prev-len))
+                   ((zero? len)
+                    ;; EOF
+                    (found-delimiter buf cur len the-eof-object
+                                     prev prev-len))
+                   (else
+                    ;; End of buffered input
+                    (let ((ret (make-bytevector len)))
+                      (bytevector-copy! bv cur ret 0 len)
+                      (flush-buffer buf len)
+                      (lp (cons ret prev) (+ len prev-len)))))))))))))
 
 ;; Read COUNT bytes into bytevector DST, starting at offset START.
 ;; Return the actual number of bytes read, which may be less if EOF was
@@ -445,3 +458,98 @@
             (when (< written count)
               (wait-for-writable eport)
               (lp (+ start written) (- count written))))))))))
+
+;; Get the next latin1 (ISO-8859-1) character from EPORT, or EOF.
+;;
+(define (get-latin1-char eport)
+  (let ((x (get-u8 eport)))
+    (if (integer? x)
+        (integer->char x)
+        x)))
+
+;; Put a latin1 character back into the buf of the port.  Note that you
+;; are only guaranteed to be able to put back as many bytes as your last
+;; fill-input was able to read.
+;;
+(define (putback-latin1-char eport c)
+  (putback-u8 eport (char->integer c)))
+
+;; Peek at the next latin1 character from EPORT, blocking if necessary.
+;;
+(define (lookahead-latin1-char eport)
+  (let ((x (lookahead-u8 eport)))
+    (if (integer? x)
+        (integer->char x)
+        x)))
+
+(define (get-latin1-string-n eport count)
+  (let* ((bv (get-bytevector-n eport count))
+         (len (bytevector-length bv))
+         (str (make-string len)))
+    (let lp ((n 0))
+      (when (< n len)
+        (string-set! str n (integer->char (bytevector-u8-ref bv n)))
+        (lp (1+ n))))
+    str))
+
+(define (get-latin1-string-n! eport dst start count)
+  (let lp ((start start) (count count) (total 0))
+    (let* ((buf (eport-readbuf eport))
+           (bv (buf-bv buf))
+           (size (bytevector-length bv))
+           (cur (buf-cur buf))
+           (len (- (buf-end buf) cur)))
+      (unless buf
+        (error "not a readable port" eport))
+      (if (<= count len)
+          (begin
+            (let lp ((n 0))
+              (when (< n count)
+                (string-set! dst (+ start n)
+                             (integer->char (bytevector-u8-ref bv (+ n cur))))
+                (lp (1+ n))))
+            (flush-buffer buf count)
+            (+ total count))
+          (begin
+            (let lp ((n 0))
+              (when (< n len)
+                (string-set! dst (+ start n)
+                             (integer->char (bytevector-u8-ref bv (+ n cur))))
+                (lp (1+ n))))
+            (flush-buffer buf len)
+            (if (zero? (fill-input eport))
+                (+ total len)
+                (lp (+ start len) (- count len) (+ total len))))))))
+
+;; Read latin1 (ISO-8859-1) characters from EPORT, continuing to read
+;; until calling PREDICATE on the character returns a true value, or EOF
+;; is reached, or MAX-CHARS is reached.
+;;
+;; Return two values: a string of the characters read, not including the
+;; delimiter, and the delimiter as a character, or #f if MAX-CHARS was
+;; reached, or the EOF object if no more bytes were available.
+;;
+(define* (get-latin1-string-delimited eport predicate #:key max-chars)
+  (call-with-values (lambda ()
+                      (get-bytevector-delimited
+                       eport
+                       (lambda (u8) (predicate (integer->char u8)))
+                       #:max-bytes max-chars))
+    (lambda (bv delimiter)
+      (values (utf8->string bv)
+              (if (integer? delimiter)
+                  (integer->char delimiter)
+                  delimiter)))))
+
+(define (put-latin1-char eport c)
+  (put-u8 eport (char->integer c)))
+
+(define (put-latin1-string eport str)
+  (if (string-every (lambda (c) (< (char->integer c) 128)) str)
+      (put-bytevector eport (string->utf8 eport))
+      ;; Need a string->latin1.
+      (let ((len (string-length str)))
+        (let lp ((n 0))
+          (when (< n len)
+            (put-u8 eport (char->integer (string-ref str n)))
+            (lp (1+ n)))))))
diff --git a/module/web/server/ethreads.scm b/module/web/server/ethreads.scm
index 17ae37c..9445e8a 100644
--- a/module/web/server/ethreads.scm
+++ b/module/web/server/ethreads.scm
@@ -75,20 +75,23 @@
   (throw 'bad-request msg args))
 
 (define (read-http-line eport)
-  ;; 10 and 13 are #\newline and #\return, respectively.
-  (define (end-of-line? u8)
-    (or (eqv? u8 10) (eqv? u8 13)))
-  (call-with-values (lambda ()
-                      (get-bytevector-delimited eport end-of-line?))
-    (lambda (bv delim)
+  (define (end-of-line? c)
+    (or (eqv? c #\newline) (eqv? c #\return)))
+  (call-with-values
+      (lambda ()
+        ;; Restrict to 512 chars to avoid denial of service attacks.
+        (get-latin1-string-delimited eport end-of-line? #:max-chars 512))
+    (lambda (str delim)
       (cond
+       ((not delim)
+        (bad-request "Line too long: ~S" str))
        ((eof-object? delim)
-        (bad-request "EOF while reading line: ~S" bv))
+        (bad-request "EOF while reading line: ~S" str))
        (else
-        (when (and (eqv? delim 13)
-                   (eqv? (lookahead-u8 eport) 10))
+        (when (and (eqv? delim #\return)
+                   (eqv? (lookahead-u8 eport) (char->integer #\newline)))
           (get-u8 eport))
-        (utf8->string bv))))))
+        str)))))
 
 (define (continuation-line? port)
   (let ((c (lookahead-u8 port)))


hooks/post-receive
-- 
GNU Guile