Changeset 30001 in project


Ignore:
Timestamp:
11/05/13 22:18:29 (8 years ago)
Author:
sjamaan
Message:

intarweb: Replace miserable read-headers implementation with an even more miserable, slower one to work around the problem with CRLF, CR and LF all being allowed line endings now

File:
1 edited

Legend:

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

    r29915 r30001  
    127127        (form-urldecode data))))
    128128
     129(define (raise-line-limit-exceeded-error line limit port)
     130  (let ((safe-line-prefix
     131         (if (< limit 128)
     132             (sprintf "~A[..and more (was limited to ~A)..]" line limit)
     133             (sprintf "~A[..~A+ more chars (was limited to ~A)..]"
     134               (substring line 0 128) (- limit 128) limit))))
     135    (signal-http-condition "Max allowed line length exceeded"
     136                           (list port safe-line-prefix)
     137                           'line-limit-exceeded 'contents line 'limit limit)))
     138
    129139(define (safe-read-line p)
    130140  (let* ((limit (http-line-limit))
    131141         (line (read-line p (http-line-limit))))
    132142    (if (and (not (eof-object? line)) limit (= limit (string-length line)))
    133         (let ((safe-line-prefix
    134                (if (< limit 128)
    135                    (sprintf "~A[..and more (was limited to ~A)..]" line limit)
    136                    (sprintf "~A[..~A+ more chars (was limited to ~A)..]"
    137                      (substring line 0 128) (- limit 128) limit))))
    138           (signal-http-condition "Max allowed line length exceeded"
    139                                  (list p safe-line-prefix)
    140                                  'line-limit-exceeded 'contents line 'limit limit))
     143        (raise-line-limit-exceeded-error line limit p)
    141144        line)))
    142145
     
    479482
    480483(define (read-headers port)
    481   (let ((first-line (safe-read-line port))
    482         (limit (http-header-limit)))
    483     (if (or (eof-object? first-line) (string-null? first-line))
    484         (make-headers '())
    485         (let loop ((num-lines 2)
    486                    (prev-line first-line)
    487                    (line      (safe-read-line port))
    488                    (headers   (make-headers '())))
    489           (cond
    490            ((or (eof-object? line) (string-null? line))
    491             (if (string-null? prev-line)
    492                 headers
    493                 (parse-header-line prev-line headers)))
    494            ((and limit (> num-lines limit))
    495             (signal-http-condition "Max allowed header count exceeded"
    496                                    (list port)
    497                                    'header-limit-exceeded
    498                                    'contents line 'limit limit))
    499            ((char-whitespace? (string-ref line 0)) ; Continuation char?
    500             ;; This shouldn't count a new header line but add to the read-limit
    501             (loop (add1 num-lines)
    502                   (string-append prev-line line)
    503                   (safe-read-line port)
    504                   headers))
    505            ((string=? (string-take-right prev-line 1) "\\") ; escaped?
    506             ;; XXX Test if this works with all combinations of \r\n
    507             ;; with prepended backslashes. We don't care about
    508             ;; malformed stuff like "foo\\\\\n" or \ with missing "
    509             (loop (add1 num-lines)
    510                   (string-append prev-line "\n" line)
    511                   (safe-read-line port) headers))
    512            (else (loop (add1 num-lines) line (safe-read-line port)
    513                        (parse-header-line prev-line headers))))))))
     484  (if (eof-object? (peek-char port))    ; Yeah, so sue me
     485      (make-headers '())
     486      (let ((header-limit (http-header-limit))
     487            (line-limit (http-line-limit)))
     488        (let lp ((c (read-char port))
     489                 (ln '())
     490                 (headers (make-headers '()))
     491                 (hc 0)
     492                 (len 0))
     493          (cond ((eqv? hc header-limit)
     494                 (signal-http-condition "Max allowed header count exceeded"
     495                                        (list port)
     496                                        'header-limit-exceeded
     497                                        'contents (reverse-list->string ln)
     498                                        'headers headers
     499                                        'limit header-limit))
     500                ((eqv? len line-limit)
     501                 (raise-line-limit-exceeded-error
     502                  (reverse-list->string ln) line-limit port))
     503                ((eof-object? c)
     504                 (if (null? ln)
     505                     headers
     506                     (parse-header-line (reverse-list->string ln) headers)))
     507                ;; Only accept CRLF (we're not this strict everywhere...)
     508                ((and (eqv? c #\return) (eqv? (peek-char port) #\newline))
     509                 (read-char port)       ; Consume and discard NL
     510                 (if (null? ln)         ; Nothing came before: end of headers
     511                     headers
     512                     (let ((pc (peek-char port)))
     513                       (if (and (not (eof-object? pc))
     514                                (or (eqv? pc #\space) (eqv? pc #\tab)))
     515                           ;; If the next line starts with whitespace,
     516                           ;; it's a continuation line of the same
     517                           ;; header.  See section 2.2 of RFC 2616.
     518                           (let skip ((pc (read-char port)) (len len) (ln ln))
     519                             (if (and (not (eqv? len line-limit))
     520                                      (or (eqv? pc #\space) (eqv? pc #\tab)))
     521                                 (skip (read-char port) (add1 len) (cons pc ln))
     522                                 (lp pc ln headers hc len)))
     523                           (let* ((ln (reverse-list->string ln))
     524                                  (headers (parse-header-line ln headers)))
     525                             (lp (read-char port) '() headers (add1 hc) 0))))))
     526                ((or (eqv? c #\") (eqv? c #\())
     527                 (let lp2 ((c2 (read-char port))
     528                           (ln (cons c ln))
     529                           (len len))
     530                   (cond ((or (eqv? 0 len) (eof-object? c2))
     531                          (lp c2 ln headers hc len))
     532                         ((or (and (eqv? c2 #\)) (eqv? c #\())
     533                              (and (eqv? c2 #\") (eqv? c #\")))
     534                          (lp (read-char port) (cons c2 ln)
     535                              headers hc (add1 len)))
     536                         ((eqv? c2 #\\)
     537                          (let ((c3 (read-char port))
     538                                (len len))
     539                            (if (or (eof-object? c3) (eqv? 0 len))
     540                                (lp c3 (cons c2 ln) headers hc len)
     541                                (lp2 (read-char port)
     542                                     (cons c3 (cons c2 ln))
     543                                     (add1 len)))))
     544                         (else
     545                          (lp2 (read-char port) (cons c2 ln) (add1 len))))))
     546                (else
     547                 (lp (read-char port) (cons c ln) headers hc (add1 len))))))))
    514548
    515549(define (signal-http-condition msg args type . more-info)
Note: See TracChangeset for help on using the changeset viewer.