Changeset 15158 in project


Ignore:
Timestamp:
07/05/09 13:34:10 (11 years ago)
Author:
sjamaan
Message:

Implement digest auth parser

Location:
release/4/intarweb/trunk
Files:
2 edited

Legend:

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

    r15155 r15158  
    2424
    2525;; Get a specific parameter of a header, assuming it has only one value
    26 (define (header-param header-name param-name headers #!optional default)
     26(define (header-param param-name header-name headers #!optional default)
    2727  (alist-ref param-name (header-params header-name headers) eq? default))
    2828
     
    147147        (values #f start-pos))))
    148148
    149 (define (parse-parameters string start-pos param-subparsers)
     149(define (parse-parameters string start-pos param-subparsers #!optional (stop-set (char-set #\;)))
    150150  (let loop ((start-pos start-pos)
    151151             (params '()))
    152152    (receive (attribute-name pos)
    153       (parse-token string start-pos (char-set #\; #\=))
     153      (parse-token string start-pos (char-set-union stop-set (char-set #\=)))
    154154      (if attribute-name
    155155          (let ((attribute (http-name->symbol attribute-name)))
     
    157157                     (char=? (string-ref string pos) #\=))
    158158                (receive (value pos)
    159                   (parse-token string (add1 pos) (char-set #\;))
     159                  (parse-token string (add1 pos) stop-set)
    160160                  ;; In case of no value ("foo="), use the empty string as value
    161161                  (let ((value ((alist-ref attribute param-subparsers
     
    440440                                              `((username . ,user)
    441441                                                (password . ,pass))) result)))))
     442             ((digest) (receive (params pos)
     443                         (parse-parameters contents pos
     444                                           `((nc . ,(lambda (n)
     445                                                      (string->number n 16)))
     446                                             (uri . ,uri-reference)
     447                                             (qop . ,symbol-subparser))
     448                                           (char-set #\,))
     449                         (loop (add1 pos)
     450                               (cons (vector authtype params) result))))
    442451             (else (receive (params pos)
    443452                     (parse-parameters contents (add1 pos) '())
  • release/4/intarweb/trunk/tests/run.scm

    r15155 r15158  
    153153
    154154  (test-group "authorization-parser"
    155     (let ((headers (test-read-headers "Authorization: Basic Zm9vOmJhcg==\r\n")))
    156       (test "basic"
    157             'basic
    158             (header-value 'authorization headers))
    159       (test "username"
    160             "foo"
    161             (get-param 'username (car (header-contents 'authorization headers))))
    162       (test "password"
    163             "bar"
    164             (get-param 'password (car (header-contents 'authorization headers))))))
     155    (test-group "basic auth"
     156     (let ((headers (test-read-headers "Authorization: Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==\r\n")))
     157       (test "basic"
     158             'basic
     159             (header-value 'authorization headers))
     160       (test "username"
     161             "Aladdin"
     162             (header-param 'username 'authorization headers))
     163       (test "password"
     164             "open sesame"
     165             (header-param 'password 'authorization headers))))
     166    (test-group "digest auth"
     167      (let ((headers (test-read-headers "Authorization: Digest username=\"Mufasa\", realm=\"testrealm@host.com\", nonce=\"dcd98b7102dd2f0e8b11d0f600bfb0c093\", uri=\"/dir/index.html\", qop=auth, nc=00000001, cnonce=\"0a4f113b\", response=\"6629fae49393a05397450978507c4ef1\", opaque=\"5ccc069c403ebaf9f0171e9517f40e41\"")))
     168        (test "digest"
     169              'digest
     170              (header-value 'authorization headers))
     171        (test "realm"
     172              "testrealm@host.com"
     173              (header-param 'realm 'authorization headers))
     174        (test "nonce"
     175              "dcd98b7102dd2f0e8b11d0f600bfb0c093"
     176              (header-param 'nonce 'authorization headers))
     177        (test "username"
     178              "Mufasa"
     179              (header-param 'username 'authorization headers))
     180        (test "qop"
     181              'auth
     182              (header-param 'qop 'authorization headers))
     183        (test "digest uri"
     184              "/dir/index.html"
     185              (uri->string (header-param 'uri 'authorization headers)))
     186        (test "nonce count"
     187              1
     188              (header-param 'nc 'authorization headers))
     189        (test "cnonce"
     190              "0a4f113b"
     191              (header-param 'cnonce 'authorization headers))
     192        (test "response"
     193              "6629fae49393a05397450978507c4ef1"
     194              (header-param 'response 'authorization headers))
     195        (test "opaque"
     196              "5ccc069c403ebaf9f0171e9517f40e41"
     197              (header-param 'opaque 'authorization headers)))))
    165198 
    166199  (test-group "pragma-parser"
     
    490523  (test-group "Authorization unparser"
    491524    (test "Basic auth"
    492           "Authorization: Basic Zm9vOmJhcg==\r\n"
     525          "Authorization: Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==\r\n"
    493526          (test-unparse-headers `((authorization #(basic
    494                                                    ((username . "foo")
    495                                                     (password . "bar")))))))
     527                                                   ((username . "Aladdin")
     528                                                    (password . "open sesame")))))))
    496529    (test-error* "Basic auth with colon in username"
    497530                 (http username-with-colon)
Note: See TracChangeset for help on using the changeset viewer.