Changeset 15151 in project


Ignore:
Timestamp:
07/04/09 17:12:16 (11 years ago)
Author:
sjamaan
Message:

Add basic auth unparser

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

Legend:

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

    r15094 r15151  
    596596              (time->string (get-value (car header-contents))
    597597                            "%a, %d %b %Y %X GMT")))
     598
     599(define (authorization-unparser header-name header-contents)
     600  (let loop ((headers (reverse header-contents))
     601             (result '()))
     602    (if (null? headers)
     603        (string-join result ", ")
     604        (let ((contents               
     605               (case (get-value (car headers))
     606                 ((basic)
     607                  (let ((user (get-param 'username (car headers)))
     608                        (pass (get-param 'password (car headers))))
     609                   (if (string-index user #\:)
     610                       (signal-http-condition "Colon detected in username. This is not supported by basic auth!"
     611                                              'username-with-colon 'value user)
     612                       (sprintf "Basic ~A"
     613                                (base64-encode
     614                                 (sprintf "~A:~A" user pass))))))
     615                 (else
     616                  (sprintf "~A ~A"
     617                           (symbol->http-name (get-value (car headers)))
     618                           (unparse-params (get-params (car headers)) '()))))))
     619         (loop (cdr headers) (cons contents result))))))
  • release/4/intarweb/trunk/intarweb.scm

    r15091 r15151  
    449449     (user-agent . ,product-unparser)
    450450     (server . ,product-unparser)
    451      (cookie . ,cookie-unparser))))
     451     (cookie . ,cookie-unparser)
     452     (authorization . ,authorization-unparser)
     453     (proxy-authorization . ,authorization-unparser))))
    452454
    453455(define (unparse-header header-name header-value)
  • release/4/intarweb/trunk/tests/run.scm

    r15094 r15151  
    482482          "Cookie: foo=bar; $Port\r\n"
    483483          (test-unparse-headers `((cookie #((foo . "bar")
    484                                             ((port . #t) (domain . #f)))))))))
     484                                            ((port . #t) (domain . #f))))))))
     485  (test-group "Authorization unparser"
     486    (test "Basic auth"
     487          "Authorization: Basic Zm9vOmJhcg==\r\n"
     488          (test-unparse-headers `((authorization #(basic
     489                                                   ((username . "foo")
     490                                                    (password . "bar")))))))))
    485491
    486492(define (test-read-request str)
Note: See TracChangeset for help on using the changeset viewer.