Ignore:
Timestamp:
07/05/09 14:41:40 (12 years ago)
Author:
sjamaan
Message:

Add initial digest auth unparser

File:
1 edited

Legend:

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

    r15158 r15159  
    500500
    501501;;; Unparsers ;;;
    502 (define (unparse-params params unparsers)
     502(define (unparse-params params unparsers #!optional (separator "; ") (grammar 'prefix))
    503503  (let loop ((params params)
    504504             (results '()))
    505505    (if (null? params)
    506         (string-join (reverse results) "; " 'prefix)
    507         (let* ((unparser (alist-ref unparsers (caar params) eq?
    508                                     (lambda (attribute value)
    509                                       (case value
    510                                         ;; #t means param is present (no value)
    511                                         ((#t) (symbol->http-name attribute))
    512                                         ;; #f means param is missing
    513                                         ((#f) #f)
    514                                         (else
    515                                          (sprintf "~A=~A"
    516                                                   (symbol->http-name attribute)
    517                                                   value))))))
    518                (str (unparser (caar params) (cdar params))))
     506        (string-join (reverse results) separator grammar)
     507        (let* ((name (caar params))
     508               (val (cdar params))
     509               (str (case val
     510                      ;; #t means param is present (no value)
     511                      ((#t) (symbol->http-name name))
     512                      ;; #f means param is missing
     513                      ((#f) #f)
     514                      (else (let ((unparser (alist-ref name unparsers
     515                                                       eq? identity)))
     516                              (sprintf "~A=~A"
     517                                       (unparse-token (symbol->http-name name))
     518                                       (unparse-token (unparser val))))))))
    519519          (loop (cdr params) (if str (cons str results) results))))))
    520520
     
    641641             (result '()))
    642642    (if (null? headers)
    643         (string-join result ", ")
     643        (string-join result ", ")  ; XXX will this work?
    644644        (let ((contents               
    645645               (case (get-value (car headers))
     
    653653                                (base64-encode
    654654                                 (sprintf "~A:~A" user pass))))))
     655                 ((digest)
     656                  (sprintf "~A ~A"
     657                           (symbol->http-name (get-value (car headers)))
     658                           (unparse-params (get-params (car headers))
     659                                           `((nc . ,(lambda (n)
     660                                                      (string-pad
     661                                                       (number->string n 16)
     662                                                       8 #\0)))
     663                                             (uri . ,uri->string)
     664                                             (qop . ,symbol->string))
     665                                           ", "
     666                                           'infix)))
    655667                 (else
    656668                  (sprintf "~A ~A"
Note: See TracChangeset for help on using the changeset viewer.