Changeset 12478 in project for release/4/spiffy/trunk/spiffy.scm


Ignore:
Timestamp:
11/12/08 00:31:50 (11 years ago)
Author:
sjamaan
Message:

Add local and remote IP-addresses to params. Implement more of CGI spec. Up until section 4, most is implemented now

File:
1 edited

Legend:

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

    r12428 r12478  
    3838(module spiffy
    3939  (start-server with-headers send-status send-static-file
    40    current-request current-response current-file current-pathinfo
     40   current-request remote-address local-address
     41   current-response current-file current-pathinfo
    4142   server-software root-path server-port index-files mime-type-map
    4243   default-mime-type file-extension-handlers default-host vhost-map
     
    5657(define current-file     (make-parameter #f))
    5758(define current-pathinfo (make-parameter #f))
     59(define local-address    (make-parameter #f))
     60(define remote-address   (make-parameter #f))
    5861
    5962;;; Configuration
     
    257260
    258261(define (handle-incoming-request in out)
    259   (parameterize ((current-request (read-request in))
    260                  (current-response
    261                   (make-response port: out
    262                                  headers: (headers
    263                                            `((content-type text/html))))))
    264     (let ((path (uri-path (request-uri (current-request)))))
    265       (receive (req cont)
    266         (call/cc (lambda (c) (values (normalize-current-request-uri) c)))
    267         (parameterize ((current-request req)
    268                        (request-restarter cont))
    269           (handle-exceptions exn ((handle-exception) exn
    270                                   (with-output-to-string print-call-chain))
    271             (if (and (uri-host (request-uri (current-request))) (pair? path))
    272                 (let* ((host (uri-host (request-uri (current-request))))
    273                        (handler (alist-ref host
    274                                            (vhost-map)
    275                                            (lambda (h _)
    276                                              (if (not (regexp? h))
    277                                                  (string-match (regexp h #t) host)
    278                                                  (string-match h host))))))
    279                   (if handler
    280                       (handler (lambda () (process-entry "" path)))
    281                       ;; Is this ok?
    282                       (send-status 404 "Not found" "<p>Host not found</p>")))
    283                 ;; No host in the request? That's an error.
    284                 (send-status 400 "Bad request"
    285                              "<p>Your client sent a request that the server did not understand</p>")))))
    286       ;; For now, just close the ports and allow the thread to exit
    287       (close-output-port out)
    288       (close-input-port in))))
     262  (receive (local remote)
     263    (tcp-addresses in)
     264    (parameterize ((remote-address remote)
     265                   (local-address local)
     266                   (current-request (read-request in))
     267                   (current-response
     268                    (make-response port: out
     269                                   headers: (headers
     270                                             `((content-type text/html))))))
     271      (let ((path (uri-path (request-uri (current-request)))))
     272        (receive (req cont)
     273          (call/cc (lambda (c) (values (normalize-current-request-uri) c)))
     274          (parameterize ((current-request req)
     275                         (request-restarter cont))
     276            (handle-exceptions exn ((handle-exception) exn
     277                                    (with-output-to-string print-call-chain))
     278                               (if (and (uri-host (request-uri (current-request))) (pair? path))
     279                                   (let* ((host (uri-host (request-uri (current-request))))
     280                                          (handler (alist-ref host
     281                                                              (vhost-map)
     282                                                              (lambda (h _)
     283                                                                (if (not (regexp? h))
     284                                                                    (string-match (regexp h #t) host)
     285                                                                    (string-match h host))))))
     286                                     (if handler
     287                                         (handler (lambda () (process-entry "" path)))
     288                                         ;; Is this ok?
     289                                         (send-status 404 "Not found" "<p>Host not found</p>")))
     290                                   ;; No host in the request? That's an error.
     291                                   (send-status 400 "Bad request"
     292                                                "<p>Your client sent a request that the server did not understand</p>")))))
     293        ;; For now, just close the ports and allow the thread to exit
     294        (close-output-port out)
     295        (close-input-port in)))))
    289296
    290297(define (htmlize str)
Note: See TracChangeset for help on using the changeset viewer.