Changeset 12511 in project


Ignore:
Timestamp:
11/15/08 17:01:24 (13 years ago)
Author:
sjamaan
Message:

Implement Status header parsing, fix cgi-handler so interpreter is optional - this allows us to run hashbang scripts

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/spiffy/trunk/cgi-handler.scm

    r12478 r12511  
    4141(require-extension spiffy srfi-1 srfi-13 intarweb uri-generic)
    4242
    43 (define (cgi-handler* interp)
     43(define (cgi-handler* #!optional interp)
    4444  (lambda (fn) (cgi-handler fn interp)))
    4545
     
    121121             (loop (read-string (min (or limit bufsize) bufsize) in))))))
    122122
     123(define (status-parser str)
     124  (let ((parts (string-match "([0-9]+) (.+)" str)))
     125    (cons (string->number (second parts)) (third parts))))
     126
    123127(define (cgi-handler fn #!optional interp)
    124128  (let* ((path (make-pathname (root-path) fn))
     
    126130         (len (header-value 'content-length (request-headers req) 0))
    127131         (interp (or interp (make-pathname (root-path)
    128                                            (uri-path (request-uri req)))))
     132                                           (string-join (uri-path (request-uri req)) "/"))))
    129133         (env (cgi-build-env req path)))
    130134    ;; TODO: stderr should be linked to spiffy error log (make log first)
    131     ;; TODO: Actually use create-header-env to pass on client headers
    132135    (if (file-execute-access? interp)
    133136        ;; XXX The script should be called with the query args on the
     
    140143          (close-output-port o)
    141144          ;; TODO: Implement read timeout
    142           (let* ((new-headers (read-headers i))
     145          (let* ((new-headers (parameterize ((header-parsers
     146                                              (cons `(status
     147                                                      . ,(single status-parser))
     148                                                    (header-parsers))))
     149                                (read-headers i)))
    143150                 (loc (header-value 'location new-headers))
    144                  ;; TODO: also check for a 'status' header, which should
    145                  ;; override this "guess" (which is on spec, though)
    146                  (code (if loc 302 (response-code (current-response))))
    147                  (reason (if loc "Found" (response-reason (current-response)))))
     151                 (status (header-value 'status new-headers))
     152                 (code (cond
     153                        (status (car status))
     154                        (loc 302)
     155                        (else (response-code (current-response)))))
     156                 (reason (cond
     157                          (status (cdr status))
     158                          (loc "Found")
     159                          (else (response-reason (current-response))))))
    148160            (parameterize ((current-response
    149161                            (update-response (current-response)
Note: See TracChangeset for help on using the changeset viewer.