Changeset 11947 in project


Ignore:
Timestamp:
09/14/08 15:26:28 (13 years ago)
Author:
sjamaan
Message:

Add host parser/unparser

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

Legend:

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

    r11916 r11947  
    190190  (let ((num (string->number contents)))
    191191    (if num (inexact->exact (max 0 (round num))) 0)))
     192
     193(define (host-parser contents)
     194  (let ((idx (string-index-right contents #\:)))
     195    (if idx
     196        (cons (substring/shared contents 0 idx)
     197              (inexact->exact
     198               (round (or (string->number (substring/shared contents (add1 idx)))
     199                          80))))
     200        (cons contents 80))))
    192201
    193202; base64 of 128 bit hex digest as per RFC1864
     
    383392                 (quote-string (cdr contents))
    384393                 (unparse-token (cdr contents)))))))
     394
     395(define (host-unparser header-name header-contents)
     396  (let ((contents (get-value (car header-contents))))
     397   ;; XXX: urlencode?
     398   (sprintf "~A: ~A\r\n"
     399            (header-name->string header-name)
     400            (if (= (cdr contents) 80)
     401                (car contents)
     402                (conc (car contents) ":" (cdr contents))))))
  • release/4/intarweb/trunk/intarweb.scm

    r11946 r11947  
    227227     (expires . ,(single rfc822-time-parser))
    228228     (from . ,(multiple mailbox-parser))
    229      (host . ,(single identity))
     229     (host . ,(single host-parser))
    230230     (if-match . ,(multiple entity-tag-parser))
    231231     (if-modified-since . ,(single rfc822-time-parser))
     
    352352(define header-unparsers
    353353  (make-parameter
    354    `((etag . ,etag-unparser))))
     354   `((etag . ,etag-unparser)
     355     (host . ,host-unparser))))
    355356
    356357(define (unparse-headers headers out)
  • release/4/intarweb/trunk/tests/run.scm

    r11916 r11947  
    8080
    8181(test-group "Specialized header parsers"
     82  (test-group "Host"
     83    (test "Hostname and port"
     84          '(("foo.example.com" . 8080))
     85          (header-values 'host (test-read-headers "Host: foo.example.com:8080")))
     86    (test "Hostname, no port"
     87          '(("foo.example.com" . 80))
     88          (header-values 'host (test-read-headers "Host: foo.example.com"))))
    8289  (test-group "Quality parameter"
    8390   (let* ((headers (test-read-headers "Accept: text/plain; Q=0.5, text/html, text/plain; q=0.123456, application/pdf; q=1.2345, text/xml; q=-0.234, text/whatever; q="))
     
    336343    (test "Strong tag starting with W/"
    337344          "Etag: \"W/blah\"\r\n"
    338           (test-unparse-headers `((etag (strong . "W/blah")))))))
     345          (test-unparse-headers `((etag (strong . "W/blah"))))))
     346  (test-group "Host unparser"
     347    (test "Default port is 80, left out"
     348          "Host: foo.example.com\r\n"
     349          (test-unparse-headers `((host ("foo.example.com" . 80)))))
     350    (test "Different port"
     351          "Host: foo.example.com:8080\r\n"
     352          (test-unparse-headers `((host ("foo.example.com" . 8080)))))))
    339353
    340354(define (test-read-request str)
Note: See TracChangeset for help on using the changeset viewer.