Changeset 11809 in project


Ignore:
Timestamp:
08/30/08 14:31:27 (12 years ago)
Author:
sjamaan
Message:

Update to use uri-generic and change defstruct stuff: FOO-copy to update-FOO

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

Legend:

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

    r11738 r11809  
    3535; http://trac.callcc.org
    3636
    37 (require-library srfi-1 srfi-13 regex regex-case base64 defstruct)
    38 
    3937(module intarweb
    4038  (read-line-limit replace-header-contents replace-header-contents!
     
    4947   request-method request-method-set! request-uri request-uri-set!
    5048   request-headers request-headers-set! request-port request-port-set!
    51    request-copy
     49   update-request
    5250   
    5351   request-parsers read-request request-unparsers write-request read-headers
     
    5755   response-code response-code-set! response-reason response-reason-set!
    5856   response-headers response-headers-set! response-port response-port-set!
    59    response-copy
     57   update-response
    6058   
    6159   write-response response-parsers read-response
     
    6967   )
    7068
    71   (import scheme chicken (except extras read-token) ports data-structures
     69  (import scheme chicken)
     70 
     71  (require-library srfi-1 srfi-13 regex regex-case base64 defstruct uri-generic)
     72
     73  (import (except extras read-token) ports data-structures
    7274          srfi-1 srfi-13 srfi-14 regex regex-case (prefix base64 base64:)
    73           defstruct)
     75          defstruct uri-generic)
    7476
    7577(define read-line-limit (make-parameter 1024)) ; #f if you want no limit
     
    162164     (content-language . ,(multiple symbol-parser-ci))
    163165     (content-length . ,(single natnum-parser))
    164      (content-location . ,(single identity))
     166     (content-location . ,(single uri-reference))
    165167     (content-md5 . ,(single md5-parser))
    166168     (content-range . ,(single range-parser))
     
    178180     (if-unmodified-since . ,(single rfc822-time-parser))
    179181     (last-modified . ,(single rfc822-time-parser))
    180      (location . ,(single identity))
     182     (location . ,(single uri-reference))
    181183     (max-forwards . ,(single natnum-parser))
    182184     (pragma . ,pragma-parser)
     
    184186     (proxy-authorization . ,(single symbol-parser-ci))
    185187     (range . ,range-parser)
    186      (referer . ,(single identity))
     188     (referer . ,(single uri-reference))
    187189     (retry-after . ,retry-after-parser)
    188190     (server . ,(single identity))
     
    249251    ("[Gg][Ee][Tt] +([^ \t]+)"
    250252     (_ uri)
    251      (make-request method: 'GET uri: uri
     253     (make-request method: 'GET uri: (uri-reference uri)
    252254                   major: 0 minor: 9
    253255                   port: in))
     
    259261   ("([a-zA-Z]+) +([^ \t]+) +[Hh][Tt][Tt][Pp]/([0-9]+)\\.([0-9]+)"
    260262    (_ method uri major minor)
    261     (make-request method: (string->http-method method) uri: uri
     263    (make-request method: (string->http-method method) uri: (uri-reference uri)
    262264                  major: (string->number major)
    263265                  minor: (string->number minor)
     
    332334    (if (memq 'chunked (header-values 'transfer-coding
    333335                                      (request-headers request)))
    334         (request-copy request port: (chunked-output-port (request-port request)))
     336        (update-request request port: (chunked-output-port (request-port request)))
    335337        request)))
    336338
     
    385387    (if (memq 'chunked (header-values 'transfer-coding
    386388                                      (response-headers response)))
    387         (response-copy response port: (chunked-output-port (response-port response)))
     389        (update-response response port: (chunked-output-port (response-port response)))
    388390        response)))
    389391
  • release/4/intarweb/trunk/tests/run.scm

    r11735 r11809  
    1 (require-extension test extras regex srfi-1)
     1(require-extension test extras regex srfi-1 uri-generic)
    22
    33(load "../intarweb.scm")
     
    322322      (test 9 (request-minor req))
    323323      (test 'GET (request-method req))
    324       (test "/path/to/stuff?arg1=val1&arg2=val2" (request-uri req))
     324      (test (uri-reference "/path/to/stuff?arg1=val1&arg2=val2") (request-uri req))
    325325      (test '() (request-headers req)))
    326326    ; RFC 1945 5.0 does not mention case-sensitivity for the method in HTTP/0.9.
     
    338338      (test 0 (request-minor req))
    339339      (test 'GET (request-method req))
    340       (test "/path/to/stuff?arg1=val1&arg2=val2" (request-uri req))
     340      (test (uri-reference "/path/to/stuff?arg1=val1&arg2=val2") (request-uri req))
    341341      (test '() (request-headers req)))
    342342    (test 'PUT (request-method (test-read-request "PUT /path HTTP/1.0\r\n"))))
     
    371371      (test "Always empty headers"
    372372            "GET /foo/bar.html\r\n"
    373             (test-write-request (request-copy req
    374                                               headers:
    375                                               (make-headers `((foo bar))))
     373            (test-write-request (update-request req
     374                                                headers:
     375                                                (make-headers `((foo bar))))
    376376                                ""))
    377377      (test "Always GET"
    378378            "GET /foo/bar.html\r\n"
    379             (test-write-request (request-copy req method: 'POST)))))
     379            (test-write-request (update-request req method: 'POST)))))
    380380  (test-group "HTTP/1.0"
    381381    (let ((req (make-request major: 1 minor: 0
     
    385385            "GET /foo/bar.html HTTP/1.0\r\nFoo: bar\r\n\r\ntest"
    386386            (test-write-request
    387              (request-copy req
    388                            headers: (make-headers `((foo bar))))
     387             (update-request req
     388                             headers: (make-headers `((foo bar))))
    389389             "test"))
    390390      (test "Chunking ignored"
    391391            "GET /foo/bar.html HTTP/1.0\r\nTransfer-Coding: chunked\r\n\r\nfoobar"
    392392            (test-write-request
    393              (request-copy req
    394                            headers: (make-headers `((transfer-coding chunked))))
     393             (update-request req
     394                             headers: (make-headers `((transfer-coding chunked))))
    395395             "foo" "bar"))))
    396396  (test-group "HTTP/1.1"
     
    401401            "GET /foo/bar.html HTTP/1.1\r\nFoo: bar\r\n\r\ntest"
    402402            (test-write-request
    403              (request-copy req
    404                            headers: (make-headers `((foo bar))))
     403             (update-request req
     404                             headers: (make-headers `((foo bar))))
    405405             "test"))
    406406      (test "Chunking"
    407407            "GET /foo/bar.html HTTP/1.1\r\nTransfer-Coding: chunked\r\n\r\n3\r\nfoo\r\na\r\n1234567890\r\n"
    408408            (test-write-request
    409              (request-copy req
    410                            headers: (make-headers `((transfer-coding chunked))))
     409             (update-request req
     410                             headers: (make-headers `((transfer-coding chunked))))
    411411             "foo" "1234567890")))))
    412412
Note: See TracChangeset for help on using the changeset viewer.