Ignore:
Timestamp:
10/08/09 21:40:42 (12 years ago)
Author:
sjamaan
Message:

Add some nasty hackage to get www-authenticate output like it is supposed to be... (which is inconsistent with nearly all of the rest of HTTP, even though that's internally inconsistent itself... GRAAHHH!)

File:
1 edited

Legend:

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

    r15327 r16157  
    525525
    526526;;; Unparsers ;;;
    527 (define (unparse-params params unparsers #!optional (separator "; ") (grammar 'prefix))
     527(define (unparse-params params unparsers #!key
     528                        (separator "; ") (grammar 'prefix)
     529                        (keyword-unparser symbol->http-name)
     530                        (value-unparser unparse-token))
    528531  (let loop ((params params)
    529532             (results '()))
     
    534537               (str (case val
    535538                      ;; #t means param is present (no value)
    536                       ((#t) (symbol->http-name name))
     539                      ((#t) (keyword-unparser name))
    537540                      ;; #f means param is missing
    538541                      ((#f) #f)
     
    540543                                                       eq? identity)))
    541544                              (sprintf "~A=~A"
    542                                        (unparse-token (symbol->http-name name))
    543                                        (unparse-token (unparser val))))))))
     545                                       (keyword-unparser name)
     546                                       (value-unparser (unparser val))))))))
    544547          (loop (cdr params) (if str (cons str results) results))))))
    545548
     
    681684                           (symbol->http-name (get-value (car headers)))
    682685                           (unparse-params (get-params (car headers))
    683                                            `((nc . ,(lambda (n)
    684                                                       (string-pad
    685                                                        (number->string n 16)
    686                                                        8 #\0)))
     686                                           `((nc . ,identity) ;; see below
    687687                                             (uri . ,uri->string)
    688688                                             (qop . ,symbol->string)
    689689                                             (algorithm . ,symbol->string))
    690                                            ", "
    691                                            'infix)))
     690                                           separator: ", "
     691                                           grammar: 'infix
     692                                           keyword-unparser: symbol->string
     693                                           value-unparser:
     694                                           ;; Nasty exception for "nc", an
     695                                           ;; an unquoted padded integer...
     696                                           (lambda (x)
     697                                             (if (number? x)
     698                                                 (string-pad
     699                                                  (number->string x 16)
     700                                                  8 #\0)
     701                                                 (quote-string (->string x)))))))
    692702                 (else
    693703                  (sprintf "~A ~A"
     
    720730                                                      ",")))
    721731                                           (algorithm . ,symbol->string))
    722                                          ", "
    723                                          'infix)))))
     732                                         separator: ", "
     733                                         grammar: 'infix
     734                                         keyword-unparser: symbol->string
     735                                         value-unparser:
     736                                         (lambda (x)
     737                                           (if (eq? x 'TRUE)
     738                                               "TRUE"
     739                                               (quote-string (->string x)))))))))
    724740         (loop (cdr headers) (cons contents result))))))
Note: See TracChangeset for help on using the changeset viewer.