Changeset 14855 in project


Ignore:
Timestamp:
06/01/09 19:47:57 (10 years ago)
Author:
sjamaan
Message:

Get rid of regex-case dependency which is a little pointless considering how little use we make of it; and that we're only ever using it for simple regexes with one case

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

Legend:

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

    r14361 r14855  
    77 (license "BSD")
    88 (doc-from-wiki)
    9  (depends defstruct regex-case (uri-common 0.2) (base64 3.0))
     9 (depends defstruct (uri-common 0.2) (base64 3.0))
    1010 (test-depends test)
    1111 (files "intarweb.scm" "header-parsers.scm" "intarweb.setup" "intarweb.html"))
  • release/4/intarweb/trunk/intarweb.scm

    r14836 r14855  
    8787  (import scheme chicken foreign)
    8888 
    89   (require-library srfi-1 srfi-13 regex regex-case base64 defstruct
    90                    uri-common posix)
     89  (require-library srfi-1 srfi-13 regex base64 defstruct uri-common posix)
    9190
    9291  (import extras ports data-structures
    93           srfi-1 srfi-13 srfi-14 regex regex-case base64
    94           defstruct uri-common posix)
     92          srfi-1 srfi-13 srfi-14 regex base64 defstruct uri-common posix)
    9593
    9694(define read-line-limit (make-parameter 1024)) ; #f if you want no limit
     
    364362  (method 'GET) uri (major 1) (minor 1) (headers (make-headers '())) port)
    365363
     364;; This removes the dependency on regex-case and is simpler
     365(define-syntax regex-let
     366  (syntax-rules ()
     367    ((regex-let str regex (name ...) body ...)
     368     (let ((values (string-match regex str)))
     369       (and values (apply (lambda (name ...) body ...) values))))))
     370
    366371;; Perhaps we should have header parsers indexed by version or
    367372;; something like that, so you can define the maximum version. Useful
     
    369374;; together, as with request/response unparsers.
    370375(define (http-0.9-request-parser line in)
    371   (regex-case line
    372     ("[Gg][Ee][Tt] +([^ \t]+)"
    373      (_ uri)
    374      (make-request method: 'GET uri: (normalized-uri uri)
    375                    major: 0 minor: 9
    376                    port: in))
    377     (else #f)))
     376  (regex-let
     377   line "[Gg][Ee][Tt] +([^ \t]+)"
     378   (_ uri)
     379   (make-request method: 'GET uri: (normalized-uri uri)
     380                 major: 0 minor: 9
     381                 port: in)))
    378382
    379383;; XXX This actually parses anything >= HTTP/1.0
    380384(define (http-1.x-request-parser line in)
    381   (regex-case line
    382    ("([a-zA-Z]+) +([^ \t]+) +[Hh][Tt][Tt][Pp]/([0-9]+)\\.([0-9]+)"
    383     (_ method uri major minor)
    384     (make-request method: (string->http-method method) uri: (normalized-uri uri)
    385                   major: (string->number major)
    386                   minor: (string->number minor)
    387                   headers: (read-headers in)
    388      port: in))
    389    (else #f)))
     385  (regex-let
     386   line "([a-zA-Z]+) +([^ \t]+) +[Hh][Tt][Tt][Pp]/([0-9]+)\\.([0-9]+)"
     387   (_ method uri major minor)
     388   (make-request method: (string->http-method method) uri: (normalized-uri uri)
     389                 major: (string->number major)
     390                 minor: (string->number minor)
     391                 headers: (read-headers in)
     392                 port: in)))
    390393
    391394(define request-parsers   ; order matters here
     
    549552;; I don't like this code. Clean it up!
    550553(define (http-1.x-response-parser line in)
    551   (regex-case line
    552     ("[Hh][Tt][Tt][Pp]/([0-9]+)\\.([0-9]+) +([0-9]+) +(.*)"
    553      (_ major minor code reason)
    554      (let ((major (string->number major))
    555            (minor (string->number minor)))
    556       (and (or (> major 1)
    557                (and (= major 1)
    558                     (> minor 0)))
    559            (let ((response (make-response code: (string->number code)
    560                                           reason: reason
    561                                           major: major
    562                                           minor: minor
    563                                           headers: (read-headers in)
    564                                           port: in)))
    565              (if (memq 'chunked (header-values 'transfer-encoding
    566                                                (response-headers response)))
    567                  (update-response response
    568                                   port: (chunked-input-port
    569                                          (response-port response)))
    570                  response)))))
    571     (else #f)))
     554  (regex-let
     555   line "[Hh][Tt][Tt][Pp]/([0-9]+)\\.([0-9]+) +([0-9]+) +(.*)"
     556   (_ major minor code reason)
     557   (let ((major (string->number major))
     558         (minor (string->number minor)))
     559     (and (or (> major 1)
     560              (and (= major 1)
     561                   (> minor 0)))
     562          (let ((response (make-response code: (string->number code)
     563                                         reason: reason
     564                                         major: major
     565                                         minor: minor
     566                                         headers: (read-headers in)
     567                                         port: in)))
     568            (if (memq 'chunked (header-values 'transfer-encoding
     569                                              (response-headers response)))
     570                (update-response response
     571                                 port: (chunked-input-port
     572                                        (response-port response)))
     573                response))))))
    572574
    573575(define (http-1.0-response-parser line in)
    574   (regex-case line
    575     ("[Hh][Tt][Tt][Pp]/1\\.0 +([0-9]+) +(.*)"
    576      (_ code reason)
    577      (let ((response (make-response code: (string->number code) reason: reason
    578                                     major: 1 minor: 0
    579                                     headers: (read-headers in)
    580                                     port: in)))
    581        response))
    582     (else #f)))
     576  (regex-let
     577   line "[Hh][Tt][Tt][Pp]/1\\.0 +([0-9]+) +(.*)"
     578   (_ code reason)
     579   (let ((response (make-response code: (string->number code) reason: reason
     580                                  major: 1 minor: 0
     581                                  headers: (read-headers in)
     582                                  port: in)))
     583     response)))
    583584
    584585;; You can't "detect" a 0.9 response, because there is no response line.
Note: See TracChangeset for help on using the changeset viewer.