Changeset 11567 in project


Ignore:
Timestamp:
08/08/08 21:28:51 (13 years ago)
Author:
sjamaan
Message:

Implement parser for cache-control

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

Legend:

Unmodified
Added
Removed
  • release/4/intarweb/trunk/header-parsers.scm

    r11452 r11567  
    1919(define get-value value+params-value)
    2020(define (get-values headers) (map value+params-value headers))
     21(define (header-list-ref value headers #!optional (equal? eq?))
     22  (find (lambda (h) (equal? (car (get-value h)) value)) headers))
    2123
    2224(define (get-param param contents)
     
    106108             (params '()))
    107109    (receive (key pos)
    108       ;; Comma here is a bit of a hack to make the code simpler
    109       ;; for the case of Cookie and cache-control headers.
    110       ;; For regular headers, commas should not occur inside
    111       ;; parameter lists anyway.
    112       (read-token string start-pos (char-set #\; #\= #\,))
     110      (read-token string start-pos (char-set #\; #\=))
    113111      (if key
    114112          (if (char=? (string-ref string pos) #\=)
    115113              (receive (value pos)
    116                 (read-token string (add1 pos) (char-set #\; #\,))
     114                (read-token string (add1 pos) (char-set #\;))
    117115                (let ((key (string->symbol (string-downcase key))))
    118116                  (if value
     
    158156     ((with-params other-parser parameter-parsers) contents)
    159157     headers)))
     158
     159(define (key/values key/value-parsers)
     160  (lambda (k/v)
     161    ;; We're abusing read-parameters here to read value
     162    ;; instead of params.  This is weird, but it works :)
     163    (receive (key+value pos)
     164      (read-parameters k/v 0 key/value-parsers)
     165      (car key+value))))
    160166
    161167(define symbol-parser-ci
     
    230236  (multiple symbol-parser-ci `((q . ,quality-parser))))
    231237
    232 ;; Another header that's a bit weird
    233 ;; Its value is an alist of name/value pairs, with no params
    234 (define (cache-control-parser name contents headers)
     238(define cache-control-parser
    235239  (let ((splitter (lambda (str) ;; Is this correct?
    236240                    (map (compose string->symbol string-trim-both)
    237                          (string-split str ","))))
    238         (old-header (or (get-header-contents name headers)
    239                         (make-value+params '() '()))))
    240    (set-header-contents!
    241     name
    242     ;; We're abusing read-parameters here to read value instead of params.
    243     ;; This is weird, but it works :)
    244     (make-value+params
    245      (append (value+params-value old-header)
    246              (read-parameters contents 0
    247                               `((max-age . ,natnum-parser)
    248                                 (s-maxage . ,natnum-parser)
    249                                 (max-stale . ,natnum-parser)
    250                                 (min-fresh . ,natnum-parser)
    251                                 (private . ,splitter)
    252                                 (no-cache . ,splitter))))
    253      '())
    254     headers)))
     241                         (string-split str ",")))))
     242    (multiple
     243     (key/values `((max-age . ,natnum-parser)
     244                   (s-maxage . ,natnum-parser)
     245                   (max-stale . ,natnum-parser)
     246                   (min-fresh . ,natnum-parser)
     247                   (private . ,splitter)
     248                   (no-cache . ,splitter))))))
    255249
    256250;; Join this with cache-control
  • release/4/intarweb/trunk/intarweb.scm

    r11452 r11567  
    4848   ;; http-header-parsers
    4949   split-multi-header unknown-header-parser single multiple
    50    read-token get-quality get-param get-value get-values
     50   read-token get-quality get-param get-value get-values header-list-ref
    5151   natnum-parser symbol-parser-ci symbol-parser
    5252   value+params? value+params-value value+params-params
  • release/4/intarweb/trunk/tests/run.scm

    r11452 r11567  
    153153    (let ((headers (test-read-headers "Cache-control: max-age=10, private")))
    154154      (test "max-age is a number"
    155             10 (alist-ref 'max-age (get-value (get-header-contents 'cache-control headers))))
     155            '(max-age . 10) (get-value (header-list-ref 'max-age (get-header-contents 'cache-control headers))))
    156156      (test "private without value"
    157             #t (alist-ref 'private (get-value (get-header-contents 'cache-control headers)))))
     157            '(private . #t) (get-value (header-list-ref 'private (get-header-contents 'cache-control headers)))))
    158158    (let ((headers (test-read-headers "Cache-control: private=\"accept-encoding, accept-ranges\"\r\nCache-control: must-revalidate")))
    159159      (test "private with values"
    160             '(accept-encoding accept-ranges)
    161             (alist-ref 'private (get-value (get-header-contents 'cache-control headers))))
     160            '(private . (accept-encoding accept-ranges))
     161            (get-value (header-list-ref 'private (get-header-contents 'cache-control headers))))
    162162      (test "Acts like a multi-header"
    163             #t (alist-ref 'must-revalidate (get-value (get-header-contents 'cache-control headers))))))
     163            '(must-revalidate . #t) (get-value (header-list-ref 'must-revalidate (get-header-contents 'cache-control headers))))))
    164164
    165165  ;; RFC 2616, 14.15
Note: See TracChangeset for help on using the changeset viewer.