Changeset 11815 in project


Ignore:
Timestamp:
08/30/08 20:37:07 (13 years ago)
Author:
sjamaan
Message:

Add setup and meta file, add more uri-generic usage, fix bug in read-response

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

Legend:

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

    r11735 r11815  
    322322      token))
    323323
     324;; There's no need to make a specific header unparser for every header type.
     325;; Usually, the Scheme value representing a header can unambiguously be
     326;; unparsed into a header just by checking its type.
    324327(define (default-header-unparser header-name header-contents)
    325328  (let loop ((headers (reverse header-contents))
     
    330333                 (string-join result ", "))
    331334        (let* ((contents (get-value (car headers)))
    332                (value (if (pair? contents) ; alist?
    333                           (conc (car contents) "=" (cdr contents))
    334                           (->string contents)))
     335               (value (cond
     336                       ((pair? contents) ; alist?
     337                        (if (eq? (cdr contents) #t)
     338                            (->string (car contents))
     339                            (conc (car contents) "=" (cdr contents))))
     340                       ((uri? contents) (uri->string contents))
     341                       (else (->string contents))))
    335342               (parameter-unparsers '())) ; Maybe we want to make this a param
    336343         (loop (cdr headers)
  • release/4/intarweb/trunk/intarweb.scm

    r11813 r11815  
    122122        headers-to-be))
    123123
    124 (include "../header-parsers") ; Also includes header unparsers
     124(include "header-parsers") ; Also includes header unparsers
    125125
    126126;; Any unknown headers are considered to be multi-headers, always
     
    279279    (let loop ((parsers (request-parsers)))
    280280      (if (null? parsers)
    281           (signal-http-condition "Unknown protocol" 'unknown-protocol)
     281          (signal-http-condition "Unknown protocol" 'unknown-protocol-line 'line)
    282282          (or ((car parsers) line inport) (loop (cdr parsers)))))))
    283283
     
    304304           "~A ~A HTTP/~A.~A\r\n"
    305305           (request-method request)
    306            (request-uri request)
     306           (uri->string (request-uri request))
    307307           (request-major request)
    308308           (request-minor request)))
     
    311311  (fprintf (request-port request)
    312312           "GET ~A\r\n"
    313            (request-uri request))
     313           (uri->string (request-uri request)))
    314314  request)
    315315
     
    347347  (let loop ((unparsers (request-unparsers)))
    348348    (if (null? unparsers)
    349         (signal-http-condition "Unknown protocol" 'unknown-protocol)
     349        (signal-http-condition "Unknown protocol" 'unknown-protocol
     350                               'major (request-major request)
     351                               'minor (request-minor request))
    350352        (or ((car unparsers) request) (loop (cdr unparsers))))))
    351353
     
    400402  (let loop ((unparsers (response-unparsers)))
    401403    (if (null? unparsers)
    402         (signal-http-condition "Unknown protocol" 'unknown-protocol)
     404        (signal-http-condition "Unknown protocol" 'unknown-protocol
     405                               'major (response-major response)
     406                               'minor (response-minor response))
    403407        (or ((car unparsers) request response) (loop (cdr unparsers))))))
    404408
     
    409413(define (http-1.x-response-parser request line in)
    410414  (regex-case line
    411    ("[Hh][Tt][Tt][Pp]/([0-9]+)\\.([0-9]+) ([0-9]{3}) +(.*)"
     415   ("[Hh][Tt][Tt][Pp]/([0-9]+)\\.([0-9]+) +([0-9]{3}) +(.*)"
    412416    (_ major minor code reason)
    413417    (make-response code: (string->number code) reason: reason
     
    433437                     minor: 9
    434438                     port: inport)
    435       (let* ((line (read-line inport (read-line-limit))))
     439      (let* ((line (read-line inport (read-line-limit)))
     440             (line (if (eof-object? line) "" line)))
    436441        (let loop ((parsers (response-parsers)))
    437442          (if (null? parsers)
    438               (signal-http-condition "Unknown protocol" 'unknown-protocol)
     443              (signal-http-condition "Unknown protocol" 'unknown-protocol-line
     444                                     'line line)
    439445              (or ((car parsers) request line inport) (loop (cdr parsers))))))))
    440446
  • release/4/intarweb/trunk/tests/run.scm

    r11810 r11815  
    1 (require-extension test extras regex srfi-1 uri-generic)
    2 
    3 (load "../intarweb.scm")
    4 
    5 (import intarweb)
     1(require-extension test extras regex srfi-1 uri-generic intarweb)
    62
    73(define-syntax test-error*
     
    296292          "Foo: bar=qux, mooh=mumble\r\n"
    297293          (test-unparse-headers `((foo (bar . qux) (mooh . mumble)))))
     294    (test "URI"
     295          "Foo: http://foo.com/bar"
     296          (test-unparse-headers `((foo ,(uri-reference "http://foo.com/bar")))))
    298297    (test "Parameters"
    299298          "Foo: bar; qux=mooh; mumble=mutter; blah\r\n"
     
    368367    (let ((req (make-request major: 0 minor: 9
    369368                             method: 'GET
    370                              uri: "/foo/bar.html")))
     369                             uri: (uri-reference "/foo/bar.html"))))
    371370      (test "Always empty headers"
    372371            "GET /foo/bar.html\r\n"
     
    381380    (let ((req (make-request major: 1 minor: 0
    382381                             method: 'GET
    383                              uri: "/foo/bar.html")))
     382                             uri: (uri-reference "/foo/bar.html"))))
    384383      (test "Headers"
    385384            "GET /foo/bar.html HTTP/1.0\r\nFoo: bar\r\n\r\ntest"
     
    397396    (let ((req (make-request major: 1 minor: 1
    398397                             method: 'GET
    399                              uri: "/foo/bar.html")))
     398                             uri: (uri-reference "/foo/bar.html"))))
    400399      (test "Headers"
    401400            "GET /foo/bar.html HTTP/1.1\r\nFoo: bar\r\n\r\ntest"
Note: See TracChangeset for help on using the changeset viewer.