Changeset 15155 in project


Ignore:
Timestamp:
07/04/09 19:57:19 (11 years ago)
Author:
sjamaan
Message:

Implement basic auth parsing

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

Legend:

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

    r15154 r15155  
    420420                                   (no-cache . ,splitter)))
    421421       (split-multi-header contents)))))
     422
     423(define (authorization-parser contents)
     424  (let loop ((pos 0)
     425             (result '()))
     426   (receive (authtype pos)
     427     (parse-token contents pos char-set:whitespace)
     428     (if (not authtype)
     429         (reverse result)
     430         (let ((authtype (http-name->symbol authtype)))
     431           (case authtype
     432             ((basic) (receive (secret pos)
     433                        (parse-token contents (add1 pos) (char-set #\,))
     434                        (let* ((decoded (base64-decode secret))
     435                               (colon-idx (string-index decoded #\:))
     436                               (user (string-take decoded colon-idx))
     437                               (pass (string-drop decoded (add1 colon-idx))))
     438                          (loop (add1 pos)
     439                                (cons (vector authtype
     440                                              `((username . ,user)
     441                                                (password . ,pass))) result)))))
     442             (else (receive (params pos)
     443                     (parse-parameters contents (add1 pos) '())
     444                     (loop (add1 pos)
     445                           (cons (vector authtype params) result))))))))))
    422446
    423447(define (pragma-parser contents)
  • release/4/intarweb/trunk/intarweb.scm

    r15154 r15155  
    289289     (age . ,(single natnum-subparser))
    290290     (allow . ,(multiple symbol-subparser))
    291      (authorization . ,(single symbol-subparser-ci))
     291     (authorization . ,authorization-parser)
    292292     (cache-control . ,cache-control-parser)
    293293     (connection . ,(multiple symbol-subparser-ci))
     
    315315     (pragma . ,pragma-parser)
    316316     (proxy-authenticate . ,(multiple symbol-subparser-ci))
    317      (proxy-authorization . ,(single symbol-subparser-ci))
     317     (proxy-authorization . ,authorization-parser)
    318318     (range . ,(multiple range-subparser))
    319319     (referer . ,(single normalized-uri))
  • release/4/intarweb/trunk/tests/run.scm

    r15154 r15155  
    2020
    2121(define (test-read-headers str)
    22   (call-with-input-string str
    23     (lambda (in)
    24       (read-headers in))))
     22  (call-with-input-string str read-headers))
    2523
    2624(test-group "Headers"
     
    153151      (test "Acts like a multi-header"
    154152            '(must-revalidate . #t) (assq 'must-revalidate (header-values 'cache-control headers)))))
     153
     154  (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))))))
    155165 
    156166  (test-group "pragma-parser"
     
    492502
    493503(define (test-read-request str)
    494   (call-with-input-string str
    495     (lambda (in)
    496       (read-request in))))
     504  (call-with-input-string str read-request))
    497505
    498506(test-group "Read-request"
     
    601609
    602610(define (test-read-response input-string)
    603   (call-with-input-string input-string
    604     (lambda (in)
    605       (read-response in))))
     611  (call-with-input-string input-string read-response))
    606612
    607613(test-group "Read response"
Note: See TracChangeset for help on using the changeset viewer.