Ignore:
Timestamp:
07/05/09 16:50:12 (12 years ago)
Author:
sjamaan
Message:

Add authenticate unparser

File:
1 edited

Legend:

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

    r15161 r15162  
    696696                           (unparse-params (get-params (car headers)) '()))))))
    697697         (loop (cdr headers) (cons contents result))))))
     698
     699(define (authenticate-unparser header-name header-contents)
     700  (let loop ((headers (reverse header-contents))
     701             (result '()))
     702    (if (null? headers)
     703        (string-join result ", ")  ; XXX will this work?
     704        (let ((contents
     705               (sprintf "~A ~A"
     706                        (symbol->http-name (get-value (car headers)))
     707                        (let* ((old (get-params (car headers)))
     708                               ;; A quick hack to get presence of "stale"
     709                               ;; coded as TRUE instead of value-less param
     710                               ;; false value is coded by its absense
     711                               (params (if (alist-ref 'stale old)
     712                                           (alist-update! 'stale 'TRUE old)
     713                                           (alist-delete 'stale old))))
     714                         (unparse-params params
     715                                         `((domain . ,(lambda (u)
     716                                                        (string-join
     717                                                         (map uri->string u))))
     718                                           (qop . ,(lambda (q)
     719                                                     (string-join
     720                                                      (map symbol->string q)
     721                                                      ",")))
     722                                           (algorithm . ,symbol->string))
     723                                         ", "
     724                                         'infix)))))
     725         (loop (cdr headers) (cons contents result))))))
Note: See TracChangeset for help on using the changeset viewer.