Changeset 15091 in project


Ignore:
Timestamp:
06/28/09 20:15:15 (10 years ago)
Author:
sjamaan
Message:

Add a cookie unparser

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

Legend:

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

    r15089 r15091  
    547547        (conc (car contents) ":" (cdr contents)))))
    548548
     549(define (cookie-unparser header-name header-contents)
     550  (let loop ((prefix "")
     551             (headers (reverse header-contents))
     552             (result '()))
     553    (if (null? headers)
     554        (conc prefix (string-join result "; "))
     555        (let* ((version (get-param 'version (car headers) #f))
     556               (params (alist-delete 'version (get-params (car headers))))
     557               (unparsed-params
     558                (map (lambda (p)
     559                       (sprintf "~A=~A"
     560                                (unparse-token
     561                                 (conc "$" (symbol->http-name (car p))))
     562                                (unparse-token (cdr p))))
     563                     params))
     564               (cookie (get-value (car headers)))
     565               (unparsed-cookie (sprintf "~A=~A"
     566                                         (unparse-token (car cookie))
     567                                         (unparse-token (cdr cookie)))))
     568          ;; Doing it like this means we can't unparse cookies of
     569          ;; mixed versions...
     570          (loop (if version (sprintf "$Version: ~A; " version) prefix)
     571                (cdr headers)
     572                (cons (string-join (cons unparsed-cookie unparsed-params) "; ")
     573                      result))))))
     574
    549575(define (product-unparser header-name header-contents)
    550576  (string-join
  • release/4/intarweb/trunk/intarweb.scm

    r15079 r15091  
    8383   unparse-params must-be-quoted-chars quote-string unparse-token
    8484   default-header-unparser entity-tag-unparser host/port-unparser
    85    product-unparser rfc1123-unparser
     85   product-unparser rfc1123-unparser cookie-unparser
    8686   )
    8787
     
    448448     (last-modified . ,rfc1123-unparser)
    449449     (user-agent . ,product-unparser)
    450      (server . ,product-unparser))))
     450     (server . ,product-unparser)
     451     (cookie . ,cookie-unparser))))
    451452
    452453(define (unparse-header header-name header-value)
  • release/4/intarweb/trunk/tests/run.scm

    r15089 r15091  
    469469    (test "Realistic product"
    470470          "User-Agent: Mozilla/5.0 (X11; U; NetBSD amd64; en-US; rv:1.9.0.3) Gecko/2008110501 Minefield/3.0.3\r\n"
    471           (test-unparse-headers `((user-agent (("Mozilla" "5.0" "X11; U; NetBSD amd64; en-US; rv:1.9.0.3") ("Gecko" "2008110501" #f) ("Minefield" "3.0.3" #f))))))))
     471          (test-unparse-headers `((user-agent (("Mozilla" "5.0" "X11; U; NetBSD amd64; en-US; rv:1.9.0.3") ("Gecko" "2008110501" #f) ("Minefield" "3.0.3" #f)))))))
     472  (test-group "Cookie unparser"
     473    (test "Basic cookie"
     474          "Cookie: foo=bar; $Path=/; qux=mooh; $Unknown=something\r\n"
     475          (test-unparse-headers `((cookie #((foo . "bar") ((path . "/")))
     476                                          #((qux . "mooh") ((unknown . "something")))))))))
    472477
    473478(define (test-read-request str)
Note: See TracChangeset for help on using the changeset viewer.