Changeset 27102 in project


Ignore:
Timestamp:
07/21/12 19:21:03 (9 years ago)
Author:
sjamaan
Message:

intarweb: Properly implement line limits and header count limits

Location:
release/4/intarweb/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/intarweb/trunk/intarweb.scm

    r26949 r27102  
    3636
    3737(module intarweb
    38   (read-line-limit replace-header-contents replace-header-contents!
    39    remove-header remove-header!
     38  (http-line-limit http-header-limit
     39   replace-header-contents replace-header-contents! remove-header remove-header!
    4040   update-header-contents update-header-contents! headers single-headers
    4141   headers? headers->list http-name->symbol symbol->http-name
     
    102102       base64 defstruct uri-common files)
    103103
    104 (define read-line-limit (make-parameter 1024)) ; #f if you want no limit
     104(define http-line-limit (make-parameter 1024))  ; #f if you want no limit
     105(define http-header-limit (make-parameter 256)) ; #f if you want no limit
     106
     107(define (safe-read-line p)
     108  (let* ((line (read-line p (http-line-limit))))
     109    (if (and (not (eof-object? line)) (= (http-line-limit) (string-length line)))
     110        (signal-http-condition "Max allowed line length exceeded" (list p)
     111                               'line-limit-exceeded
     112                               'contents line 'limit (http-line-limit))
     113        line)))
    105114
    106115;; Make headers a new type, to force the use of the HEADERS procedure
     
    221230                           (when (and position (>= position chunk-length))
    222231                             (unless (zero? chunk-length)
    223                                      (read-line port)) ; read \r\n data trailer
    224                              (let* ((line (read-line port)))
     232                                     (safe-read-line port)) ; read \r\n data trailer
     233                             (let* ((line (safe-read-line port)))
    225234                               (if (eof-object? line)
    226235                                   (set! position #f)
     
    412421
    413422(define (read-headers port)
    414   (let ((first-line (read-line port)))
     423  (let ((first-line (safe-read-line port))
     424        (limit (http-header-limit)))
    415425    (if (or (eof-object? first-line) (string-null? first-line))
    416426        (make-headers '())
    417         (let loop ((prev-line first-line)
    418                    (line      (read-line port))
     427        (let loop ((num-lines 2)
     428                   (prev-line first-line)
     429                   (line      (safe-read-line port))
    419430                   (headers   (make-headers '())))
    420           (if (or (eof-object? line) (string-null? line))
    421               (if (string-null? prev-line)
    422                   headers
    423                   (parse-header-line prev-line headers))
    424               (if (char-whitespace? (string-ref line 0)) ; Continuation char?
    425                   (loop (string-append prev-line line)
    426                         (read-line port)
    427                         headers)
    428                   (if (string=? (string-take-right prev-line 1) "\\") ; escaped?
    429                       ;; XXX Test if this works with all combinations of \r\n
    430                       ;; with prepended backslashes. We don't care about
    431                       ;; malformed stuff like "foo\\\\\n" or \ with missing "
    432                       (loop (string-append prev-line "\n" line)
    433                             (read-line port)
    434                             headers)
    435                       (loop line (read-line port)
    436                             (parse-header-line prev-line headers)))))))))
     431          (cond
     432           ((or (eof-object? line) (string-null? line))
     433            (if (string-null? prev-line)
     434                headers
     435                (parse-header-line prev-line headers)))
     436           ((and limit (> num-lines limit))
     437            (signal-http-condition "Max allowed header count exceeded"
     438                                   (list port)
     439                                   'header-limit-exceeded
     440                                   'contents line 'limit limit))
     441           ((char-whitespace? (string-ref line 0)) ; Continuation char?
     442            ;; This shouldn't count a new header line but add to the read-limit
     443            (loop (add1 num-lines)
     444                  (string-append prev-line line)
     445                  (safe-read-line port)
     446                  headers))
     447           ((string=? (string-take-right prev-line 1) "\\") ; escaped?
     448            ;; XXX Test if this works with all combinations of \r\n
     449            ;; with prepended backslashes. We don't care about
     450            ;; malformed stuff like "foo\\\\\n" or \ with missing "
     451            (loop (add1 num-lines)
     452                  (string-append prev-line "\n" line)
     453                  (safe-read-line port) headers))
     454           (else (loop (add1 num-lines) line (safe-read-line port)
     455                       (parse-header-line prev-line headers))))))))
    437456
    438457(define (signal-http-condition msg args type . more-info)
     
    482501
    483502(define (read-request inport)
    484   (let* ((line (read-line inport (read-line-limit)))
     503  (let* ((line (safe-read-line inport))
    485504         ;; A bit ugly, but simpler than the alternatives
    486505         (line (if (eof-object? line) "" line)))
     
    784803                 ;; XXX This is wrong, it re-inserts \r\n, while it may have
    785804                 ;; been a \n only. To work around this, we'd have to write
    786                  ;; a custom read-line procedure.
     805                 ;; a custom (safe-)read-line procedure.
    787806                 ;; However, it does not matter much because HTTP 0.9 is only
    788807                 ;; defined to ever return text/html, no binary or any other
     
    796815
    797816(define (read-response inport)
    798   (let* ((line (read-line inport (read-line-limit)))
     817  (let* ((line (safe-read-line inport))
    799818         (line (if (eof-object? line) "" line)))
    800819    (let loop ((parsers (response-parsers)))
  • release/4/intarweb/trunk/tests/run.scm

    r26947 r27102  
    6868  (test-group "Miscellaneous"
    6969    (parameterize ((header-parsers `((foo . ,(multiple identity))
    70                                      (bar . ,(lambda x (error "bad header"))))))
     70                                     (bar . ,(lambda x (error "bad header")))))
     71                   (http-header-limit 2))
    7172      (test-error "Missing header contents" (test-read-headers "foo\r\n\r\n"))
    7273      (test-error "Bad header w/ handler" (test-read-headers "bar: x\r\n\r\n"))
     
    8586            ;; in "\\\r\n", or whether it should be seen as an embedded \r
    8687            ;; followed by a \n (which is then interpreted as a literal \n?)
    87             (header-values 'foo (test-read-headers "Foo: \"bar\\\r\\\nqux\""))))))
     88            (header-values 'foo (test-read-headers "Foo: \"bar\\\r\\\nqux\"")))
     89      (test-error "Too many headers is an error"
     90                  (test-read-headers "foo: bar\r\nfoo: qux\r\nfoo: hoohoo\r\n")))))
    8891
    8992(test-group "Specialized header parsers"
     
    805808   (test "Method is case-sensitive" 'geT (request-method (test-read-request "geT /path HTTP/1.1\r\n\r\n")))
    806809   ; RFC 2616 3.1 + case-insensitivity BNF rule
    807    (test "Protocol is case-insensitive" '1 (request-minor (test-read-request "GET /path htTP/1.1\r\n\r\n"))))) ;; TODO: Chunking
     810   (test "Protocol is case-insensitive" '1 (request-minor (test-read-request "GET /path htTP/1.1\r\n\r\n")))
     811   ;; TODO: Test chunking
     812   (test-error "Request line limit exceeded gives error"
     813               (parameterize ((http-line-limit 5))
     814                 (test-read-request "GET /path HTTP/1.1\r\n\r\n")))))
    808815
    809816(define (test-write-request req . outputs)
     
    885892            "Contents"
    886893            (read-string #f (response-port res))))
     894    (test-error "Response line limit exceeded gives error"
     895                (parameterize ((http-line-limit 5))
     896                  (test-read-response "HTTP/1.1 200 OK\r\n\r\n")))
    887897    (let ((res (test-read-response "HTTP/1.1 200 OK\r\nTransfer-Encoding: chunked\r\n\r\n3\r\nfoo\r\na\r\n1234567890\r\n")))
    888898      (test "Chunking"
Note: See TracChangeset for help on using the changeset viewer.