Changeset 11829 in project


Ignore:
Timestamp:
08/31/08 14:10:47 (13 years ago)
Author:
sjamaan
Message:

Change tests to expect unknown-header-line and restructure write-response and read-response so they don't need the request object anymore

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

Legend:

Unmodified
Added
Removed
  • release/4/intarweb/trunk/intarweb.scm

    r11815 r11829  
    279279    (let loop ((parsers (request-parsers)))
    280280      (if (null? parsers)
    281           (signal-http-condition "Unknown protocol" 'unknown-protocol-line 'line)
     281          (signal-http-condition "Unknown protocol" 'unknown-protocol-line
     282                                 'line line)
    282283          (or ((car parsers) line inport) (loop (cdr parsers)))))))
    283284
     
    358359(defstruct response code reason major minor (headers '()) port)
    359360
    360 (define (http-0.9-response-unparser request response)
     361(define (http-0.9-response-unparser response)
    361362  response) ;; The response-body will just follow
    362363
    363 (define (write-response-line request response)
     364(define (write-response-line response)
    364365  (fprintf (response-port response)
    365366           "HTTP/~A.~A ~A ~A\r\n"
     
    369370           (response-reason response)))
    370371
    371 (define (http-1.0-response-unparser request response)
     372(define (http-1.0-response-unparser response)
    372373  (and-let* (((= (response-major response) 1))
    373374             ((= (response-major response) 0))
    374375             (o (response-port response)))
    375     (write-response-line request response)
     376    (write-response-line response)
    376377    (unparse-headers (response-headers response) o)
    377378    (display "\r\n" o)
     
    379380
    380381;; XXX This actually unparses anything >= HTTP/1.1
    381 (define (http-1.x-response-unparser request response)
     382(define (http-1.x-response-unparser response)
    382383  (and-let* (((or (> (response-major response) 1)
    383384                  (and (= (response-major response) 1)
    384385                       (> (response-minor response) 0))))
    385386             (o (response-port response)))
    386     (write-response-line request response)
     387    (write-response-line response)
    387388    (unparse-headers (response-headers response) o)
    388389    (display "\r\n" o)
     
    397398                        http-0.9-response-unparser)))
    398399
    399 (define (write-response request response)
     400(define (write-response response)
    400401  ;; Try each unparser in turn to write the response-line.
    401402  ;; An unparser returns either #f or a new response object.
     
    405406                               'major (response-major response)
    406407                               'minor (response-minor response))
    407         (or ((car unparsers) request response) (loop (cdr unparsers))))))
     408        (or ((car unparsers) response) (loop (cdr unparsers))))))
    408409
    409410;;;;;;;;;;;;;;;;;;;;;;;;;;
     
    411412;;;;;;;;;;;;;;;;;;;;;;;;;;
    412413
    413 (define (http-1.x-response-parser request line in)
     414(define (http-1.x-response-parser line in)
    414415  (regex-case line
    415    ("[Hh][Tt][Tt][Pp]/([0-9]+)\\.([0-9]+) +([0-9]{3}) +(.*)"
    416     (_ major minor code reason)
    417     (make-response code: (string->number code) reason: reason
    418                    major: (string->number major)
    419                    minor: (string->number minor)
    420                    headers: (read-headers in)
    421                    port: in))
    422    (else #f)))
     416    ("[Hh][Tt][Tt][Pp]/([0-9]+)\\.([0-9]+) +([0-9]{3}) +(.*)"
     417     (_ major minor code reason)
     418     (make-response code: (string->number code) reason: reason
     419                    major: (string->number major)
     420                    minor: (string->number minor)
     421                    headers: (read-headers in)
     422                    port: in))
     423    (else #f)))
     424
     425;; You can't "detect" a 0.9 response, because there is no response line.
     426;; It will simply output the body directly, so we will just assume that
     427;; if we can't recognise the output string, we just got a 0.9 response.
     428;; If this is not desired, just change response-parsers to exclude this one.
     429(define (http-0.9-response-parser line in)
     430  (make-response code: 200 reason: "OK"
     431                 major: 0
     432                 minor: 9
     433                 port: (call-with-input-string line
     434                         (lambda (str)
     435                           (make-concatenated-port str in)))))
    423436
    424437(define response-parsers ;; order matters here
    425   (make-parameter (list http-1.x-response-parser)))
    426 
    427 (define (read-response request inport)
    428   ;; You can't "detect" a 0.9 response, because there is no response line.
    429   ;; It will simply output the body directly, so we should not even attempt
    430   ;; to read the line and do detection on it.
    431   ;; This gives us one problem: what if we send a 1.x request and receive
    432   ;; a 0.9 response? Nothing we can do against that right now.
    433   (if (and (= (request-major request) 0)
    434            (= (request-minor request) 9))
    435       (make-response code: 200 reason: "OK"
    436                      major: 0
    437                      minor: 9
    438                      port: inport)
    439       (let* ((line (read-line inport (read-line-limit)))
    440              (line (if (eof-object? line) "" line)))
    441         (let loop ((parsers (response-parsers)))
    442           (if (null? parsers)
    443               (signal-http-condition "Unknown protocol" 'unknown-protocol-line
    444                                      'line line)
    445               (or ((car parsers) request line inport) (loop (cdr parsers))))))))
     438  (make-parameter (list http-1.x-response-parser http-0.9-response-parser)))
     439
     440(define (read-response inport)
     441  (let* ((line (read-line inport (read-line-limit)))
     442         (line (if (eof-object? line) "" line)))
     443    (let loop ((parsers (response-parsers)))
     444      (if (null? parsers)
     445          (signal-http-condition "Unknown protocol" 'unknown-protocol-line
     446                                 'line line)
     447          (or ((car parsers) line inport) (loop (cdr parsers)))))))
    446448
    447449)
  • release/4/intarweb/trunk/tests/run.scm

    r11815 r11829  
    293293          (test-unparse-headers `((foo (bar . qux) (mooh . mumble)))))
    294294    (test "URI"
    295           "Foo: http://foo.com/bar"
     295          "Foo: http://foo.com/bar\r\n"
    296296          (test-unparse-headers `((foo ,(uri-reference "http://foo.com/bar")))))
    297297    (test "Parameters"
     
    312312                                    ,(lambda (line in)
    313313                                       (and (string=? line "bar") 'bar)))))
    314     (test-error* (http unknown-protocol) (test-read-request "qux"))
    315     (test-error* (http unknown-protocol) (test-read-request ""))
     314    (test-error* (http unknown-protocol-line) (test-read-request "qux"))
     315    (test-error* (http unknown-protocol-line) (test-read-request ""))
    316316    (test 'foo (test-read-request "foo"))
    317317    (test 'bar (test-read-request "bar")))
     
    410410             "foo" "1234567890")))))
    411411
     412(define (test-write-request req . outputs)
     413  (call-with-output-string
     414    (lambda (out)
     415      (request-port-set! req out)
     416      (let ((r (write-request req)))
     417       (for-each (lambda (output)
     418                   (display output (request-port r)))
     419                 outputs)))))
     420
    412421;; TODO:
    413422;; - Implement comments parsing (better: a sane parsing system!)
Note: See TracChangeset for help on using the changeset viewer.