Changeset 16157 in project


Ignore:
Timestamp:
10/08/09 21:40:42 (10 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!)

Location:
release/4/intarweb/trunk
Files:
2 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))))))
  • release/4/intarweb/trunk/tests/run.scm

    r15327 r16157  
    580580                                      (password . "qux")))))))
    581581    (test "Digest auth"
    582           "Authorization: Digest Username=Mufasa, Realm=testrealm@host.com, Nonce=dcd98b7102dd2f0e8b11d0f600bfb0c093, Uri=/dir/index.html, Qop=auth, Cnonce=0a4f113b, Response=6629fae49393a05397450978507c4ef1, Opaque=5ccc069c403ebaf9f0171e9517f40e41, Nc=00000001, Algorithm=md5\r\n"
     582          "Authorization: Digest username=\"Mufasa\", realm=\"testrealm@host.com\", nonce=\"dcd98b7102dd2f0e8b11d0f600bfb0c093\", uri=\"/dir/index.html\", qop=\"auth\", cnonce=\"0a4f113b\", response=\"6629fae49393a05397450978507c4ef1\", opaque=\"5ccc069c403ebaf9f0171e9517f40e41\", nc=00000001, algorithm=\"md5\"\r\n"
    583583          (test-unparse-headers
    584584           `((authorization #(digest
     
    597597    (test-group "basic auth"
    598598      (test "basic"
    599             "Www-Authenticate: Basic Realm=WallyWorld\r\n"
     599            "Www-Authenticate: Basic realm=\"WallyWorld\"\r\n"
    600600            (test-unparse-headers
    601601             `((www-authenticate #(basic
     
    603603    (test-group "digest auth"
    604604      (test "digest"
    605             "Www-Authenticate: Digest Realm=testrealm@host.com, Qop=\"auth,auth-int\", Nonce=dcd98b7102dd2f0e8b11d0f600bfb0c093, Opaque=5ccc069c403ebaf9f0171e9517f40e41\r\n"
     605            "Www-Authenticate: Digest realm=\"testrealm@host.com\", qop=\"auth,auth-int\", nonce=\"dcd98b7102dd2f0e8b11d0f600bfb0c093\", opaque=\"5ccc069c403ebaf9f0171e9517f40e41\"\r\n"
    606606            (test-unparse-headers
    607607             `((www-authenticate #(digest
     
    611611                                    (opaque . "5ccc069c403ebaf9f0171e9517f40e41")))))))
    612612      (test "domains"
    613             "Www-Authenticate: Digest Domain=\"/example http://foo.com/bar\"\r\n"
     613            "Www-Authenticate: Digest domain=\"/example http://foo.com/bar\"\r\n"
    614614            (test-unparse-headers
    615615             `((www-authenticate #(digest
     
    617617                                               ,(uri-reference "http://foo.com/bar")))))))))
    618618      (test "stale"
    619             "Www-Authenticate: Digest Realm=foo, Stale=TRUE\r\n"
     619            "Www-Authenticate: Digest realm=\"foo\", stale=TRUE\r\n"
    620620            (test-unparse-headers
    621621             `((www-authenticate #(digest
     
    623623                                    (stale . #t)))))))
    624624      (test "stale present but false"
    625             "Www-Authenticate: Digest Realm=foo\r\n"
     625            "Www-Authenticate: Digest realm=\"foo\"\r\n"
    626626            (test-unparse-headers
    627627             `((www-authenticate #(digest
Note: See TracChangeset for help on using the changeset viewer.