Changeset 10858 in project for release/3/web-unity


Ignore:
Timestamp:
05/17/08 21:30:15 (11 years ago)
Author:
sjamaan
Message:

Make cookies interface more consistent with the rest of web-unity

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/3/web-unity/trunk/web-unity.scm

    r10856 r10858  
    7878
    7979(define (wu:invoke-dispatcher dispatcher)
    80   (parameterize ((wu:headers-sent #f))
     80  (parameterize ((wu:headers-sent #f)
     81                 (wu:cookies (get-request-cookies)))
    8182   (handle-exceptions exn (begin (unless (wu:headers-sent)
    8283                                         (parameterize ((wu:response-code '(500 . "Internal server error")))
     
    107108      (wu:response-headers (alist-cons name value (wu:response-headers)))))
    108109
    109 
    110110;;; Cookie procedures taken from spiffy-utils and ported to WU
    111111(define (wu:cookie-set! name value . args)
     
    127127    (wu:cookie-set! (->string name) "" #f 0 domain path)))
    128128
    129 
    130129; Get "cookie variable" value
    131130; TODO: Implement cookie handling better we can get a cookie's Path/Domain
    132131;        and make the `$Version' cookie disappear to the user.
    133 (define (wu:cookie-ref varname . args)
    134   (apply extract-var (request-cookies) varname args))
    135 
    136 (define (request-cookies)
     132(define (get-request-cookies)
    137133  (let ((cookie-hdr (wu:get-header "cookie")))
    138     (and cookie-hdr
    139          (remove null?
    140                  (map (lambda (x)
    141                         ;; Each cookie is a 'name=value' pair.  Otherwise ignore it.
    142                         (match
    143                          (string-match "[ \t]*([^ \t]+)[ \t]*=[ \t]*\"([^ \t]*)\"[ \t]*" x)
    144                          ((_ name value) (cons name value))
    145                          (_ '())))
     134    (if cookie-hdr
     135        (remove null?
     136                (map (lambda (x)
     137                       ;; Each cookie is a 'name=value' pair.  Otherwise ignore it.
     138                       (match
     139                        (string-match "[ \t]*([^ \t]+)[ \t]*=[ \t]*\"([^ \t]*)\"[ \t]*" x)
     140                        ((_ name value) (cons name value))
     141                        (_ '())))
    146142                                        ; RFC says we should accept `,' and `;' as cookie separators
    147                       (string-split cookie-hdr ",;"))))))
    148 
    149 (define (extract-var alist varname . rest)
    150   (let-optionals rest ((string->type identity)
    151                        (default #f))
    152                  (let ((var (alist-ref (->string varname) alist string=?)))
    153                    (if var
    154                        (string->type var)
    155                        default))))
    156 
    157 
    158 
     143                     (string-split cookie-hdr ",;")))
     144        (list))))
    159145
    160146;; From HTTP egg. TODO: export it
Note: See TracChangeset for help on using the changeset viewer.