diff -urN spiffy.orig/fastcgi.h spiffy.2012-09-25/fastcgi.h --- spiffy.orig/fastcgi.h 1970-01-01 01:00:00.000000000 +0100 +++ spiffy.2012-09-25/fastcgi.h 2012-09-25 23:43:09.950457670 +0100 @@ -0,0 +1,136 @@ +/* + * fastcgi.h -- + * + * Defines for the FastCGI protocol. + * + * + * Copyright (c) 1995-1996 Open Market, Inc. + * + * See the file "LICENSE.TERMS" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * $Id: fastcgi.h,v 1.1.1.1 1997/09/16 15:36:32 stanleyg Exp $ + */ + +#ifndef _FASTCGI_H +#define _FASTCGI_H + +/* + * Listening socket file number + */ +#define FCGI_LISTENSOCK_FILENO 0 + +typedef struct { + unsigned char version; + unsigned char type; + unsigned char requestIdB1; + unsigned char requestIdB0; + unsigned char contentLengthB1; + unsigned char contentLengthB0; + unsigned char paddingLength; + unsigned char reserved; +} FCGI_Header; + +#define FCGI_MAX_LENGTH 0xffff + +/* + * Number of bytes in a FCGI_Header. Future versions of the protocol + * will not reduce this number. + */ +#define FCGI_HEADER_LEN 8 + +/* + * Value for version component of FCGI_Header + */ +#define FCGI_VERSION_1 1 + +/* + * Values for type component of FCGI_Header + */ +#define FCGI_BEGIN_REQUEST 1 +#define FCGI_ABORT_REQUEST 2 +#define FCGI_END_REQUEST 3 +#define FCGI_PARAMS 4 +#define FCGI_STDIN 5 +#define FCGI_STDOUT 6 +#define FCGI_STDERR 7 +#define FCGI_DATA 8 +#define FCGI_GET_VALUES 9 +#define FCGI_GET_VALUES_RESULT 10 +#define FCGI_UNKNOWN_TYPE 11 +#define FCGI_MAXTYPE (FCGI_UNKNOWN_TYPE) + +/* + * Value for requestId component of FCGI_Header + */ +#define FCGI_NULL_REQUEST_ID 0 + + +typedef struct { + unsigned char roleB1; + unsigned char roleB0; + unsigned char flags; + unsigned char reserved[5]; +} FCGI_BeginRequestBody; + +typedef struct { + FCGI_Header header; + FCGI_BeginRequestBody body; +} FCGI_BeginRequestRecord; + +/* + * Mask for flags component of FCGI_BeginRequestBody + */ +#define FCGI_KEEP_CONN 1 + +/* + * Values for role component of FCGI_BeginRequestBody + */ +#define FCGI_RESPONDER 1 +#define FCGI_AUTHORIZER 2 +#define FCGI_FILTER 3 + + +typedef struct { + unsigned char appStatusB3; + unsigned char appStatusB2; + unsigned char appStatusB1; + unsigned char appStatusB0; + unsigned char protocolStatus; + unsigned char reserved[3]; +} FCGI_EndRequestBody; + +typedef struct { + FCGI_Header header; + FCGI_EndRequestBody body; +} FCGI_EndRequestRecord; + +/* + * Values for protocolStatus component of FCGI_EndRequestBody + */ +#define FCGI_REQUEST_COMPLETE 0 +#define FCGI_CANT_MPX_CONN 1 +#define FCGI_OVERLOADED 2 +#define FCGI_UNKNOWN_ROLE 3 + + +/* + * Variable names for FCGI_GET_VALUES / FCGI_GET_VALUES_RESULT records + */ +#define FCGI_MAX_CONNS "FCGI_MAX_CONNS" +#define FCGI_MAX_REQS "FCGI_MAX_REQS" +#define FCGI_MPXS_CONNS "FCGI_MPXS_CONNS" + + +typedef struct { + unsigned char type; + unsigned char reserved[7]; +} FCGI_UnknownTypeBody; + +typedef struct { + FCGI_Header header; + FCGI_UnknownTypeBody body; +} FCGI_UnknownTypeRecord; + +#endif /* _FASTCGI_H */ + diff -urN spiffy.orig/fcgi-handler.scm spiffy.2012-09-25/fcgi-handler.scm --- spiffy.orig/fcgi-handler.scm 1970-01-01 01:00:00.000000000 +0100 +++ spiffy.2012-09-25/fcgi-handler.scm 2012-09-25 23:37:47.368724053 +0100 @@ -0,0 +1,890 @@ +;;;; fcgi-handler.scm +; +; Copyright (c) 2012, Andy Bennett + +; Based on cgi-handler.scm: +; Copyright (c) 2007-2009, Peter Bex +; Copyright (c) 2000-2005, Felix L. Winkelmann +; All rights reserved. +; +; Redistribution and use in source and binary forms, with or without +; modification, are permitted provided that the following conditions +; are met: +; +; 1. Redistributions of source code must retain the above copyright +; notice, this list of conditions and the following disclaimer. +; 2. Redistributions in binary form must reproduce the above copyright +; notice, this list of conditions and the following disclaimer in the +; documentation and/or other materials provided with the distribution. +; 3. Neither the name of the author nor the names of its +; contributors may be used to endorse or promote products derived +; from this software without specific prior written permission. +; +; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS +; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +; COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, +; INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +; STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED +; OF THE POSSIBILITY OF SUCH DAMAGE. +; +; FCGI file handler +; See the spec at http://www.fastcgi.com/drupal/node/6?q=node/22 +; Also requires the CGI spec: RFC 3875 at http://www.ietf.org/rfc/rfc3875 + +(module fcgi-handler + ;(fcgi-handler fcgi-handler* cgi-default-environment) + * + +(import chicken scheme extras files posix regex data-structures foreign ports) +(use spiffy srfi-1 srfi-4 srfi-13 srfi-18 intarweb uri-common (prefix uri-generic generic:) records socket) + +; for now we support only a single connection carrying one request at a time to each instance. +; this means we don't have to have extra threads to marshall data in and out of the request threads. +; we also don't have to keep track of any request ids or other per-request state. + + +; http://www.toggo.de/fcgi-bin/fcgi_application +; csc -s -O2 -d1 -inline -local fcgi-handler.scm fork-exec.c -J && csc -s -d0 fcgi-handler.import.scm + +(define fcgi-version 1) +(define fcgi-header-len 8) + +; packet types +(define fcgi-begin-request 1) +(define fcgi-abort-request 2) +(define fcgi-end-request 3) +(define fcgi-params 4) +(define fcgi-stdin 5) +(define fcgi-stdout 6) +(define fcgi-stderr 7) +(define fcgi-data 8) +(define fcgi-get-values 9) +(define fcgi-get-values-result 10) +(define fcgi-unknown-type 11) +(define fcgi-maxtype fcgi-unknown-type) + +; roles +(define fcgi-responder 1) +(define fcgi-authorizer 2) +(define fcgi-filter 3) + +; header fields +(define header-version 0) +(define header-type 1) +(define header-request-id-b1 2) +(define header-request-id-b0 3) +(define header-content-length-b1 4) +(define header-content-length-b0 5) +(define header-padding-length 6) +(define header-reserved 7) + +; flags for various records +; FCGI_BEGIN_REQUEST +(define fcgi-keep-conn 1) +; FCGI_END_REQUEST +(define fcgi-request-complete 0) +(define fcgi-cant-mpx-conn 1) +(define fcgi-overloaded 2) +(define fcgi-unknown-role 3) + +(define request-state (make-parameter #f)) ; assumes no more than one simultaneous request per thread + + +(define fcgi-apps '()) ; an alist mapping application names to a vector of application processes (instances). + +(define instance + (make-record-type + 'instance + '(in-use + started + pid + socket + fcgi-max-conns ; The maximum number of concurrent transport connections this application will accept, e.g. "1" or "10". + fcgi-max-reqs ; The maximum number of concurrent requests this application will accept, e.g. "1" or "50". + fcgi-mpxs-conns ; "0" if this application does not multiplex connections (i.e. handle concurrent requests over each connection), "1" otherwise. + curr-conns ; The current number of concurrent transport connections + curr-reqs ; The current number of requests in flight. + max-conns ; The maximum number of concurrent transport connections we have used. + max-reqs ; The maximum number of concurrent requests we have had in flight. + total-conns; The number of times we have opened the socket. + total-reqs ; The number of requests this instance has processed. + ))) +(define make-instance (record-constructor instance)) +(define instance-in-use (record-accessor instance 'in-use)) +(define instance-socket (record-accessor instance 'socket)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; CGI & FCGI Environment Utilities +;;; +(define (alist->envlist alist) + (map (lambda (entry) + (conc (car entry) "=" (or (cdr entry) ""))) + alist)) + +(define (alist->name/value-pairs alist) + (filter-map (lambda (entry) + (and-let* ((name (car entry)) + (value (cdr entry)) + (value (->string value)) + (name-len (string-length name)) + (value-len (string-length value)) + (name-len-size (if (> name-len #x7f) 4 1)) + (value-len-size (if (> value-len #x7f) 4 1)) + (name-len-start 0) + (value-len-start name-len-size) + (name-start (+ value-len-start value-len-size)) + (value-start (+ name-start name-len)) + (blob-len (+ value-start value-len)) + (blob (make-empty-record blob-len))) + (if (> name-len-size 1) + (u32encode blob name-len (+ 3 name-len-start) (+ 2 name-len-start) (+ 1 name-len-start) name-len-start) + (u8vector-set! blob name-len-start name-len)) + (if (> value-len-size 1) + (u32encode blob value-len (+ 3 value-len-start) (+ 2 value-len-start) (+ 1 value-len-start) value-len-start) + (u8vector-set! blob value-len-start value-len)) + (with-input-from-string name (lambda () (read-u8vector! name-len blob (current-input-port) name-start))) + (with-input-from-string value (lambda () (read-u8vector! value-len blob (current-input-port) value-start))) + (u8vector->blob/shared blob))) + alist)) + +(define (environmentize str) + (conc "HTTP_" (string-upcase (string-translate str "-" "_")))) + +(define (create-header-env headers) + (fold + (lambda (h result) + ;; As per RFC 3875, section 4.1.18, remove all redundant information + ;; all information related to authentication. + (if (member (car h) '(content-type content-length authorization)) + result + (append! (map (lambda (x) + (cons (environmentize (symbol->http-name (car h))) x)) + (unparse-header (car h) (cdr h))) result))) + '() (headers->list headers))) + +(define (fcgi-build-request-env req) + (let* ((server-env + `(;; TODO: Enable and find a script that requires auth, then test it! + #;("AUTH_TYPE" . ,(header-value 'authorization + (request-headers req))) + ;; Username MUST be available when AUTH_TYPE is set + #;("REMOTE_USER" . ,(header-value ... )) + ;; We're not supposed to send CONTENT_LENGTH to an Authorizer. + ("CONTENT_LENGTH" . ,(header-value 'content-length + (request-headers req))) + ("CONTENT_TYPE" . ,(and-let* ((contents (header-contents + 'content-type + (request-headers req)))) + (car (unparse-header 'content-type contents)))) + ;; We're not supposed to send PATH_INFO to an Authorizer. + ;; This doesn't seem to work anyway. + ("PATH_INFO" . ,(and (current-pathinfo) + (string-join (current-pathinfo) "/"))) + ; This isn't in the CGI spec, but lots of scripts expect to see it. + ("REQUEST_URI" . ,(string-append "/" (string-join (cdr (uri-path (request-uri (current-request)))) "/"))) + ("QUERY_STRING" . ,(generic:uri-query + (uri->uri-generic (request-uri req)))) + ("REMOTE_ADDR" . ,(remote-address)) + ;; This should really be the FQDN of the remote address + ("REMOTE_HOST" . ,(remote-address)) + ("REQUEST_METHOD" . ,(request-method req)) + ("SERVER_NAME" . ,(uri-host (request-uri (current-request)))) + ("SERVER_PORT" . ,(server-port)) ; OK? + ("SERVER_PROTOCOL" . ,(sprintf "HTTP/~A.~A" ; protocol, NOT scheme + (request-major req) + (request-minor req))) + ("SERVER_SOFTWARE" . ,(and-let* ((contents (header-contents + 'server + (response-headers + (current-response))))) + (car (unparse-header 'server contents)))) + ;; RFC 3875, section 4.1.6: + ;; "The value is derived in this way irrespective of whether + ;; it maps to a valid repository location." + ;; ie, this value does not always make sense + ;; We're not supposed to send PATH_TRANSLATED to an Authorizer. + ;; This doesn't seem to work anyway. + ("PATH_TRANSLATED" . ,(and (current-pathinfo) + (not (null? (current-pathinfo))) + (make-pathname + (root-path) + (string-join (current-pathinfo) "/")))) + ;; PHP _always_ wants the REDIRECT_STATUS "for security", + ;; so just initialize it unconditionally. + ;; See http://php.net/security.cgi-bin + ("REDIRECT_STATUS" . ,(response-code (current-response))) + ;; Nonstandard but reasonably widely used Apache extension + ("HTTPS" . ,(and (secure-connection?) "on")))) + (header-env (create-header-env (request-headers req)))) + (append header-env server-env))) + +(define (fcgi-build-initial-env fn) + (let* ((server-env + ;; We're not supposed to send SCRIPT_NAME to an Authorizer. + `(("SCRIPT_NAME" . ,(if (list? fn) (car fn) fn)) + ("PHP_FCGI_CHILDREN" . "1") + ;; More stuff needed because PHP's CGI is broken + ;; See http://bugs.php.net/28227 + ;; (yes, that's right; it's been broken since 2004) + ("SCRIPT_FILENAME" . ,(if (list? fn) (car fn) fn))))) + (append (fcgi-default-environment) server-env))) + +(define fcgi-default-environment + (make-parameter `(("GATEWAY_INTERFACE" . "CGI/1.1")))) + +;; "the server retains its responsibility to the client to conform to the +;; relevant network protocol even if the CGI script fails to conform to +;; this specification." -- RFC 3875, Section 3.1 +;; The simplest way to ensure that the client conforms to the protocol +;; is to discard any content-length headers and simply close the connection. +(define (sanitize-headers script-headers) + (headers '((connection close)) + (remove-header 'content-length script-headers))) + +(define (status-parser str) + (let ((parts (string-match "([0-9]+) (.+)" str))) + (cons (string->number (second parts)) (third parts)))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (copy-port-to-stream in out #!optional limit) + (assert (port? in)) + (assert (procedure? out)) + (let ((bufsize 65535)) + (let loop ((data (read-string (min (or limit bufsize) bufsize) in))) + (unless (string-null? data) + (out data) + (when limit (set! limit (- limit (string-length data)))) + (loop (read-string (min (or limit bufsize) bufsize) in)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; FCGI Request Handlers +;;; +(define (fcgi-handler app-name #!key (continue #f)) + ; get the content-length header. if there isn't one then tell them to f-off - cgi mandates it: whatever; we don't care + (let* ((app (alist-ref app-name fcgi-apps)) + (handler (car app)) + (instances (cdr app)) + (instance (select-instance instances)) ; FIXME: deal with this returning #f: i.e. no instances are available + (s (socket af/unix sock/stream)) + (continue-param #f)) + (handle-exceptions exn (begin + (release-instance instance) + (socket-close* s) + (abort exn)) + (socket-connect s (unix-address (instance-socket instance))) + (let* ((req (current-request)) + (len (header-value 'content-length (request-headers req) 0))) + (set! continue-param (handler app-name s req len)) + (socket-close s))) + (release-instance instance) + (if (and continue continue-param) + (continue continue-param)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; FCGI Responder Role +;;; +(define (fcgi-handler-responder app-name socket req content-length) + + (let ((headers "")) + + (define (send-body m) + (if (eq? 'HEAD (request-method (current-request))) + #f + (display m (response-port (current-response))))) + + (define (handle-stdout m) + (if headers + (for-each ; we're still collecting headers for sanitization + (lambda (m) + (if (or (string-null? m) (equal? "\r" m)) + (let* ; we've reached the end of the headers + ((_ (set! headers (string-append headers m "\n"))) + (script-headers (with-input-from-string headers + (lambda () + (parameterize + ((header-parsers + `((status . ,(single status-parser)) + ,@(header-parsers)))) + (read-headers (current-input-port)))))) + (loc (header-value 'location script-headers)) + (status (header-value 'status script-headers)) + (code (cond + (status (car status)) + (loc 302) + (else (response-code (current-response))))) + (reason (cond + (status (cdr status)) + (loc "Found") + (else (response-reason (current-response))))) + ;; Get rid of our temporary Status "header" again + (script-headers (remove-header 'status script-headers))) + (current-response + (update-response (current-response) + headers: (sanitize-headers script-headers) + code: code + reason: reason)) + (write-logged-response) + (set! headers #f)) + (if headers + (set! headers (string-append headers m "\n")) + (send-body (string-append m "\n")) + ))) + (string-split (blob->string m) "\n")) + (send-body (blob->string m)))) + + + (let ((in-out-dance (make-in-out-dance app-name socket + stdout-handler: handle-stdout))) + + (read/write-socket socket 1 fcgi-begin-request fcgi-responder) + (read/write-socket socket 1 fcgi-params (fcgi-build-request-env req)) + (read/write-socket socket 1 fcgi-params 'close-stream) + + ; stream request data over fcgi-stdin. + (copy-port-to-stream (request-port req) in-out-dance content-length) + (let loop ((done? (in-out-dance 'close-stream))) ; wait for all the replies to come back + (if (not done?) (loop (in-out-dance)))) + #f))) ; Responders never continue: we've sent a response. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; FCGI Authorizer Role +;;; +(define (fcgi-handler-authorizer app-name socket req content-length) + + (let ((headers "") + (variables '()) + (success #f)) + + (define (send-body m) + (if (or success (eq? 'HEAD (request-method (current-request)))) + #f + (display m (response-port (current-response))))) + + (define (handle-stdout m) + (if headers + (for-each ; we're still collecting headers for Status, 'Variable-'s and sanitization. + (lambda (m) + (printf "Message:~a\n" m) + (if (or (string-null? m) (equal? "\r" m)) + (let* ; we've reached the end of the headers + ((_ (set! headers (string-append headers m "\n"))) + (script-headers (with-input-from-string headers + (lambda () + (parameterize + ((header-parsers + `((status . ,(single status-parser)) + ,@(header-parsers)))) + (read-headers (current-input-port)))))) + (loc (header-value 'location script-headers)) + (status (header-value 'status script-headers)) + (code (cond + (status (car status)) + (loc 302) + (else (response-code (current-response))))) + (reason (cond + (status (cdr status)) + (loc "Found") + (else (response-reason (current-response))))) + ;; Get rid of our temporary Status "header" again + (script-headers (remove-header 'status script-headers))) + (if (eqv? code 200) + (set! success #t) + (begin ; For Authorizer response status values other than "200" (OK), the Web server denies access and sends the response status, headers, and content back to the HTTP client. + (current-response + (update-response (current-response) + headers: (sanitize-headers script-headers) + code: code + reason: reason)) + (write-logged-response))) + (set! headers #f)) + (if headers + (let ((header (string-match "^Variable-([^ ]+): ([^\r]+)\r?" m))) + (if header ; Is it a Variable- header + (set! variables (cons (cons (second header) (third header)) variables)) + (set! headers (string-append headers m "\n")))) + (send-body (string-append m "\n")) + ))) + (string-split (blob->string m) "\n")) + (send-body (blob->string m)))) + + + (let ((in-out-dance (make-in-out-dance app-name socket + stdout-handler: handle-stdout))) + + (read/write-socket socket 1 fcgi-begin-request fcgi-authorizer) + (read/write-socket socket 1 fcgi-params (fcgi-build-request-env req)) + (read/write-socket socket 1 fcgi-params 'close-stream) + + ; stream request data over fcgi-stdin. + (copy-port-to-stream (request-port req) in-out-dance content-length) + (let loop ((done? (in-out-dance 'close-stream))) ; wait for all the replies to come back + (if (not done?) (loop (in-out-dance)))) + (if success variables #f)))) ; Authorizers continue if they succeed otherwise they send their own response. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; FCGI Filter Role +;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; High Level FCGI Socket Protocol +;;; +(define (read/write-socket socket request-id type . args) + (if type + (let ((messages (read-socket socket request-id))) + (write-socket socket request-id type args) + messages) + (begin + (thread-wait-for-i/o! (socket-fileno socket) #:input) + (read-socket socket request-id)))) + + +; This returns a procedure which does the fcgi dance involving multiplexing the +; stdin, stdout and stderr streams over the socket. We have to make that the +; socket doesn't deadlock. +; Deadlock might occur if we let the FCGI script fill up all the buffers and we +; neglect to read anything before sending data. +; We handle each kind of record that we're interested in and route the replies +; to their destinations. A stdout handler is supplied by the FCGI role handler. +(define (make-in-out-dance app-name socket #!key (stdout-handler #f)) + + (define (in-out-dance #!optional (data #f)) + (let ((messages (if data + (read/write-socket socket 1 fcgi-stdin data) + (read/write-socket socket 1 #f))) + (over #f)) + (map + (lambda (m) + (select (car m) + ((fcgi-end-request) + (set! over #t)) + ((fcgi-stdout) + (if stdout-handler + (map stdout-handler (cdr m)))) + ((fcgi-stderr) + (map (lambda (m) (log-to (error-log) "fcgi: ~a: ~a" app-name (blob->string m))) (cdr m))) + (else + (log-to (error-log) "fcgi: ~a: Unhandled packet type: ~a: ~a" app-name (car m) (cdr m))))) + messages) + over)) + + (assert stdout-handler) + in-out-dance) + + +(define (write-socket socket request-id type args) + + (define (write-record header content) + (assert (blob? content)) + (let ((size (blob-size content))) + (let loop ((start 0)) + (let ((end (+ start (min (- size start) 65535)))) + (send-packet socket header content start end) + ;(printf "Wrote ~a record of ~a bytes\n" type (- end start)) + (if (< end size) (loop end)))))) + + (let* ((header (make-header type request-id)) + (encoder (get-ws->app type)) + (content (if (eqv? (car args) 'close-stream) (make-blob 0) (apply encoder args)))) + (cond + ((list? content) (map (cut write-record header <>) content)) + (else (write-record header content))))) + + +(define (read-socket socket request-id) + (if (socket-receive-ready? socket) + (receive (type req-id content) (recv-packet socket) + (assert (= request-id req-id)) + (let* ((decoder (get-app->ws type)) + (content (decoder content))) + (alist-update! type (list content) '()))) + '())) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Record Definitions +;;; +;;; WS->App : Records of this type can only be sent by the Web server to +;;; the application. Records of other types can only be sent by +;;; the application to the Web server. +;;; +;;; Management : Records of this type contain information that is not specific +;;; to a Web server request, and use the null request ID. Records +;;; of other types contain request-specific information, and +;;; cannot use the null request ID. +;;; +;;; Stream : Records of this type form a stream, terminated by a record +;;; with empty contentData. Records of other types are discrete; +;;; each carries a meaningful unit of data. +;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (u32encode header value b0 b1 b2 b3) + (let ((b1b0 (bitwise-and value #xffff)) + (b3b2 (bitwise-ior + (arithmetic-shift (bitwise-and value #xffff0000) -16) + #x8000))) + (u16encode header b1b0 b0 b1) + (u16encode header b3b2 b2 b3))) + +(define (u32decode header b0 b1 b2 b3) + (let ((b1b0 (u16decode header b0 b1)) + (b3b2 (u16decode header b2 (bitwise-and b3 #x7f)))) + (bitwise-ior (arithmetic-shift b3b2 16) b1b0))) + +(define (u16encode header value b0 b1) + (let ((b0v (bitwise-and value #xff)) + (b1v (arithmetic-shift (bitwise-and value #xff00) -8))) + (u8vector-set! header b0 b0v) + (u8vector-set! header b1 b1v))) + +(define (u16decode header b0 b1) + (let ((b0 (u8vector-ref header b0)) + (b1 (u8vector-ref header b1))) + (bitwise-ior (arithmetic-shift b1 8) b0))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; FCGI_Header + +; allocate a new header +(define (make-header type request-id) + (let ((new-header (u8vector fcgi-version type 0 0 0 0 0 0))) + (header-set! new-header 'request-id request-id) + new-header)) + + +; set a field in the header to value +(define (header-set! header field value) + (select field + (('request-id) + (u16encode header value header-request-id-b0 header-request-id-b1)) + (('content-length) + (u16encode header value header-content-length-b0 header-content-length-b1)) + (('padding-length) + (u8vector-set! header header-padding-length value)) + (else #f)) + ) + +; get a field in the header +(define (get-header header field) + (select field + (('version) + (u8vector-ref header header-version)) + (('type) + (u8vector-ref header header-type)) + (('request-id) + (u16decode header header-request-id-b0 header-request-id-b1)) + (('content-length) + (u16decode header header-content-length-b0 header-content-length-b1)) + (('padding-length) + (u8vector-ref header header-padding-length)) + (else #f))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +; get a procedure that encodes the body for a ws->app record of the given type. +(define (get-ws->app type) + (select type + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; FCGI_GET_VALUES + ;;; WS->App, Management + ;;; + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; FCGI_BEGIN_REQUEST + ;;; WS->App + ;;; + ((fcgi-begin-request) ; 'discrete + (lambda (role) + + (define (set-field content field value) + (select field + (('role) + (u16encode content value 1 0)) + (('flags) + (u8vector-set! content 2 value)))) + + (assert (not (request-state))) ; one simultaneous request per request-id + + (let ((content (make-empty-record 8))) + (set-field content 'role role) + (set-field content 'flags fcgi-keep-conn) + (u8vector->blob/shared content)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; FCGI_ABORT_REQUEST + ;;; WS->App + ;;; + ((fcgi-abort-request) ; 'discrete + (lambda () "")) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; FCGI_PARAMS + ;;; WS->App, Stream + ;;; + ((fcgi-params) ; 'stream + alist->name/value-pairs + ) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; FCGI_STDIN + ;;; WS->App, Stream + ;;; + ((fcgi-stdin) ; 'stream + string->blob) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; FCGI_DATA + ;;; WS->App, Stream + ;;; + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + )) + +; get a procedure that decodes the body for a app->ws record of the given type. +(define (get-app->ws type) + (select type + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; FCGI_GET_VALUES_RESULT + ;;; Management + ;;; + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; FCGI_UNKNOWN_TYPE + ;;; Management + ;;; + ((fcgi-unknown-type) ; 'discrete + (lambda (content) + + (define (get-field content field) + (let ((content (blob->u8vector))) + (select field + (('type) + (u8vector-ref content 0))))) + + (let ((type (get-field content 'type))) + (log-to (error-log) "FCGI_UNKNOWN_TYPE: Application did not understand record type ~a." type)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; FCGI_END_REQUEST + ;;; - + ;;; + ((fcgi-end-request) ; 'discrete + (lambda (content) + + (define (get-field content field) + (let ((content (blob->u8vector content))) + (select field + (('app-status) + (u32decode content 3 2 1 0)) + (('protocol-status) + (u8vector-ref content 4))))) + + (let ((app-status (get-field content 'app-status)) + (protocol-status (get-field content 'protocol-status))) + (if (> protocol-status 0) + (log-to (debug-log) "FCGI_END_REQUEST: Protocol Status: ~a." protocol-status)) + (if (> app-status 0) + (log-to (debug-log "FCGI_END_REQUEST: App Status: ~a." app-status))) + (list app-status protocol-status)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; FCGI_STDOUT + ;;; Stream + ;;; + ((fcgi-stdout) ; 'stream + identity) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; FCGI_STDERR + ;;; Stream + ;;; + ((fcgi-stderr) ; 'stream + identity) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + )) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Socket Record / Packet Transport : Low Level FGI Socket Protocol +;;; +; send a single packet down the socket. +(define (send-packet socket header content #!optional (start 0) (end #f)) + (assert (socket? socket)) + (assert (u8vector? header)) + (assert (blob? content)) + (assert (= fcgi-header-len (u8vector-length header))) + + (let ((content-length (if (and end start) (- end start) (blob-size content))) + (padding-length 0)); (modulo (+ fcgi-header-length content-length) 8)) ; Don't bother with padding. + (assert (< content-length 65536)) + (header-set! header 'content-length content-length) + (header-set! header 'padding-length padding-length) + (socket-send-all socket (u8vector->blob/shared header)) + (socket-send-all socket content start end))) + + +; receive a single packet from the socket. +; returns the type, request id and the content blob. +(define (recv-packet socket) + (assert (socket? socket)) + (thread-wait-for-i/o! (socket-fileno socket) #:input) + ;(printf "Waiting for header...\n") + (let* ((header (make-empty-blob fcgi-header-len)) + (received (socket-receive! socket header 0 fcgi-header-len)) + (header (blob->u8vector/shared header)) + ) + (assert (= 8 received)) + (let* ((version (get-header header 'version)) + (_ (assert (= version fcgi-version))) + (type (get-header header 'type)) + ;(_ (printf "Got a header for a ~a record.\n" type)) + (request-id (get-header header 'request-id)) + (content-length (get-header header 'content-length)) + (padding-length (get-header header 'padding-length)) + (content (make-empty-blob content-length)) + (padding (make-empty-blob padding-length)) + ;(_ (printf "Waiting for ~a bytes of record.\n" content-length)) + (content-received (if (> content-length 0) (socket-receive! socket content 0 content-length) 0)) + ;(_ (printf "Waiting for ~a bytes of padding.\n" padding-length)) + (padding-received (if (> padding-length 0) (socket-receive! socket padding 0 padding-length) 0))) + ;(printf "Finished receiving record.\n") + (assert (= content-length content-received)) + (assert (= padding-length padding-received)) + (values type request-id content)))) + +; allocate a fresh record +(define (make-empty-record X) + (list->u8vector (make-list X 0))) + +; allocate a nice, fresh bit of empty buffer +(define (make-empty-blob X) + (u8vector->blob/shared (make-empty-record X))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; FastCGI Application Process Management +;;; +(define (fcgi-register-application name role filename socket prespawn maxspawn) + (assert (<= prespawn maxspawn)) + (let ((state (make-vector maxspawn #f)) + (handler (select role + ((fcgi-responder) fcgi-handler-responder) + ((fcgi-authorizer) fcgi-handler-authorizer) + ((fcgi-filter) #f)))) + + (do ((i 0 (+ i 1))) ((not (< i prespawn)) #t) + (vector-set! state i (spawn-instance filename (conc socket "-" i)))) + + (set! fcgi-apps (alist-cons name (cons handler state) fcgi-apps)))) + + +(foreign-declare "#include \"fork-exec.h\"") +; char** create_string_list(int n) +(define create-string-list (foreign-lambda (c-pointer c-pointer) "create_string_list" int)) + +; void free_string_list(char** p, int n) +(define free-string-list (foreign-lambda void "free_string_list" (c-pointer c-pointer) int)) + +; void insert_string(char** l, int n, char* s) +(define insert-string (foreign-lambda void "insert_string" (c-pointer c-pointer) int c-string)) + +; void inspect_string_list(char** lv, int n) { +(define inspect-string-list (foreign-lambda void "inspect_string_list" (c-pointer c-pointer) int)) + +; int fork_exec (int fcgi_fd, char* filename, char** args, char** env) +(define fork-exec (foreign-lambda int "fork_exec" int (c-pointer c-pointer) (c-pointer c-pointer))) + +(define (insert-strings string-list strings #!optional (n 0)) + (insert-string string-list n (car strings)) + (if (not (eqv? (cdr strings) '())) + (insert-strings string-list (cdr strings) (+ n 1)))) + + +; filename should be a string or a list of strings +; DOC: we expect to spawn the children. we don't support externally managed sockets. +; TODO: do somthing if the cgi is not present! +(define (spawn-instance filename socket-file) + (if (file-exists? socket-file) + (begin + (log-to (error-log) "Cannot spawn app: ~a already exists!" socket-file) + (printf "Cannot spawn app: ~a already exists!" socket-file) + #f) + (let* ( + (s (socket af/unix sock/stream)) + (nargs (if (list? filename) (length filename) 1)) + (args (create-string-list nargs)) + (envl (alist->envlist (fcgi-build-initial-env filename))) + (nenv (length envl)) + (env (create-string-list nenv)) + ) + (if (list? filename) + (insert-strings args filename) + (insert-string args 0 filename)) + (if (list? envl) + (insert-strings env envl)) + + (set! (so-reuse-address? s) #t) + (socket-bind s (unix-address socket-file)) + (socket-listen s 1024) + (let ((pid (fork-exec (socket-fileno s) args env))) + (if pid + (log-to (debug-log) "Started something: ~a : need to do that waitpid stuff" pid) + (log-to (error-log) "Couldn't start!")) + + (free-string-list args nargs) + (free-string-list env nenv) + (socket-close s) + + (make-instance (make-mutex) (current-seconds) pid socket-file #f #f #f 0 0 0 0 0 0))))) + + +(define (select-instance instances) + (let* ((n (random (vector-length instances))) + (instance (vector-ref instances n))) + (if (not (mutex-lock! (instance-in-use instance) ));0.001)) ; if a request thread goes away then the mutex is abandoned. if someone ends up waiting here then by the time they lock the mutex the request may have gone away + (select-instance instances) + (begin + ; TODO: accounting + instance)))) + + +(define (release-instance instance) + ;TODO : accounting + (mutex-unlock! (instance-in-use instance))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +) + diff -urN spiffy.orig/fork-exec.c spiffy.2012-09-25/fork-exec.c --- spiffy.orig/fork-exec.c 1970-01-01 01:00:00.000000000 +0100 +++ spiffy.2012-09-25/fork-exec.c 2012-09-25 23:37:38.472455592 +0100 @@ -0,0 +1,100 @@ +/* We need this helper because... + * based on mod_fastcgi.c from lighttpd-1.4.31 + */ + +#include +#include +#include +#include +#include +#include +#include "fastcgi.h" +#include "fork-exec.h" + +void* create_string_list(int n) { + if (n > 0) { + return calloc(n+1, sizeof(char*)); /* Extra one for NULL */ + } else { + return NULL; + } + +} + +void free_string_list(void* pv, int n) { + int i; + char** p = (char**)(pv); + + for (i = 0; i <= n; i++) { /* Free the extra one incase it got used. */ + if (p[i]) free(p[i]); + } + free(p); +} + +void insert_string(void* lv, int n, char* s) { + char** l = (char**)(lv); + + l[n] = strdup((const char*)(s)); +} + +void inspect_string_list(void* lv, int n) { + int i; + char** l = (char**)(lv); + + for (i = 0; i < n; i++) { + printf("%d: <%s>\n", i, l[i]); + } + if (l[n]) + printf("Not NULL terminated!\n"); + else + printf("NULL terminated!\n"); + +} + +int fork_exec (int fcgi_fd, void* argsv, void* envv) { + pid_t child; + char** args = (char**)(argsv); + char** env = (char**)(envv); + + switch ((child = fork())) { + case 0: { /* Child */ + size_t i = 0; + + if (fcgi_fd != FCGI_LISTENSOCK_FILENO) { + close(FCGI_LISTENSOCK_FILENO); + dup2(fcgi_fd, FCGI_LISTENSOCK_FILENO); + close(fcgi_fd); + } + + for (i = 3; i < 256; i++) { + close(i); + } + + /* reset signals */ +#ifdef SIGTTOU + signal(SIGTTOU, SIG_DFL); +#endif +#ifdef SIGTTIN + signal(SIGTTIN, SIG_DFL); +#endif +#ifdef SIGTSTP + signal(SIGTSTP, SIG_DFL); +#endif + signal(SIGHUP, SIG_DFL); + signal(SIGPIPE, SIG_DFL); + signal(SIGUSR1, SIG_DFL); + + errno = 0; + execve(args[0], args, env); /* args[0] might not be a basename! */ + exit(errno); + + break; + } + case -1: { /* Error */ + return 0; + } + default: { /* Parent */ + return child; + } + } +} + diff -urN spiffy.orig/fork-exec.h spiffy.2012-09-25/fork-exec.h --- spiffy.orig/fork-exec.h 1970-01-01 01:00:00.000000000 +0100 +++ spiffy.2012-09-25/fork-exec.h 2012-09-25 23:37:38.472455592 +0100 @@ -0,0 +1,7 @@ + +void* create_string_list(int n); +void free_string_list(void* pv, int n); +void insert_string(void* l, int n, char* s); +void free_string_list(void* pv, int n); +int fork_exec (int fcgi_fd, void* args, void* env); + diff -urN spiffy.orig/LICENSE.TERMS.fcgi spiffy.2012-09-25/LICENSE.TERMS.fcgi --- spiffy.orig/LICENSE.TERMS.fcgi 1970-01-01 01:00:00.000000000 +0100 +++ spiffy.2012-09-25/LICENSE.TERMS.fcgi 2012-09-25 23:38:01.829160431 +0100 @@ -0,0 +1,28 @@ +This FastCGI application library source and object code (the +"Software") and its documentation (the "Documentation") are +copyrighted by Open Market, Inc ("Open Market"). The following terms +apply to all files associated with the Software and Documentation +unless explicitly disclaimed in individual files. + +Open Market permits you to use, copy, modify, distribute, and license +this Software and the Documentation for any purpose, provided that +existing copyright notices are retained in all copies and that this +notice is included verbatim in any distributions. No written +agreement, license, or royalty fee is required for any of the +authorized uses. Modifications to this Software and Documentation may +be copyrighted by their authors and need not follow the licensing +terms described here. If modifications to this Software and +Documentation have new licensing terms, the new terms must be clearly +indicated on the first page of each file where they apply. + +OPEN MARKET MAKES NO EXPRESS OR IMPLIED WARRANTY WITH RESPECT TO THE +SOFTWARE OR THE DOCUMENTATION, INCLUDING WITHOUT LIMITATION ANY +WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. IN +NO EVENT SHALL OPEN MARKET BE LIABLE TO YOU OR ANY THIRD PARTY FOR ANY +DAMAGES ARISING FROM OR RELATING TO THIS SOFTWARE OR THE +DOCUMENTATION, INCLUDING, WITHOUT LIMITATION, ANY INDIRECT, SPECIAL OR +CONSEQUENTIAL DAMAGES OR SIMILAR DAMAGES, INCLUDING LOST PROFITS OR +LOST DATA, EVEN IF OPEN MARKET HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. THE SOFTWARE AND DOCUMENTATION ARE PROVIDED "AS IS". +OPEN MARKET HAS NO LIABILITY IN CONTRACT, TORT, NEGLIGENCE OR +OTHERWISE ARISING OUT OF THIS SOFTWARE OR THE DOCUMENTATION. diff -urN spiffy.orig/spiffy.meta spiffy.2012-09-25/spiffy.meta --- spiffy.orig/spiffy.meta 2012-09-25 23:35:35.368740331 +0100 +++ spiffy.2012-09-25/spiffy.meta 2012-09-25 23:39:35.996002081 +0100 @@ -7,6 +7,6 @@ (category web) (license "BSD") (doc-from-wiki) - (depends (intarweb 0.7) uri-common uri-generic (sendfile 1.7)) + (depends (intarweb 0.7) uri-common uri-generic (sendfile 1.7) regex socket records) (test-depends test) - (files "spiffy.release-info" "web-scheme-handler.scm" "spiffy.setup" "simple-directory-handler.scm" "cgi-handler.scm" "spiffy.meta" "ssp-handler.scm" "spiffy.scm" "tests/run.scm" "tests/testweb/secrets/spiffy-access" "tests/testweb/secrets/bank/pin-code.txt" "tests/testweb/secrets/password.txt" "tests/testweb/spiffy-access" "tests/testweb/subdir with space/index.html" "tests/testweb/once.scm" "tests/testweb/data" "tests/testweb/index.html" "tests/testweb/hello.txt" "tests/testweb/ssp/included.ssp" "tests/testweb/ssp/dynamic.ssp" "tests/testweb/ssp/static.html" "tests/testweb/ssp/mixed.ssp" "tests/testweb/ssp/inline.ssp" "tests/testweb/ssp/uninterpreted.txt" "tests/testweb/ssp/ssp-stringize.ssp" "tests/testweb/ssp/exit.ssp" "tests/testweb/ssp/include-ssp.ssp" "tests/testweb/web-scheme/string.ws" "tests/testweb/test.myscript" "tests/testweb/subdir/spiffy-access" "tests/testweb/subdir/index.html" "tests/testweb/subdir/subsubdir/index.html" "tests/testweb/pics/lambda-chicken.gif" "tests/testweb/pics/chicken-logo.png" "tests/testlib.scm")) + (files "spiffy.release-info" "web-scheme-handler.scm" "spiffy.setup" "simple-directory-handler.scm" "cgi-handler.scm" "fcgi-handler.scm" "spiffy.meta" "ssp-handler.scm" "spiffy.scm" "tests/run.scm" "tests/testweb/secrets/spiffy-access" "tests/testweb/secrets/bank/pin-code.txt" "tests/testweb/secrets/password.txt" "tests/testweb/spiffy-access" "tests/testweb/subdir with space/index.html" "tests/testweb/once.scm" "tests/testweb/data" "tests/testweb/index.html" "tests/testweb/hello.txt" "tests/testweb/ssp/included.ssp" "tests/testweb/ssp/dynamic.ssp" "tests/testweb/ssp/static.html" "tests/testweb/ssp/mixed.ssp" "tests/testweb/ssp/inline.ssp" "tests/testweb/ssp/uninterpreted.txt" "tests/testweb/ssp/ssp-stringize.ssp" "tests/testweb/ssp/exit.ssp" "tests/testweb/ssp/include-ssp.ssp" "tests/testweb/web-scheme/string.ws" "tests/testweb/test.myscript" "tests/testweb/subdir/spiffy-access" "tests/testweb/subdir/index.html" "tests/testweb/subdir/subsubdir/index.html" "tests/testweb/pics/lambda-chicken.gif" "tests/testweb/pics/chicken-logo.png" "tests/testlib.scm")) diff -urN spiffy.orig/spiffy.setup spiffy.2012-09-25/spiffy.setup --- spiffy.orig/spiffy.setup 2012-09-25 23:35:35.372740459 +0100 +++ spiffy.2012-09-25/spiffy.setup 2012-09-25 23:40:36.529828644 +0100 @@ -9,6 +9,9 @@ (compile -s -O2 cgi-handler.scm -j cgi-handler) (compile -s -O2 cgi-handler.import.scm) +(compile -s -O2 -d1 -inline -local fcgi-handler.scm fork-exec.c -j fcgi-handler) +(compile -s -O2 fcgi-handler.import.scm) + (compile -s -O2 ssp-handler.scm -j ssp-handler) (compile -s -O2 ssp-handler.import.scm) @@ -20,6 +23,7 @@ '("spiffy.so" "spiffy.import.so" "simple-directory-handler.so" "simple-directory-handler.import.so" "cgi-handler.so" "cgi-handler.import.so" + "fcgi-handler.so" "fcgi-handler.import.so" "ssp-handler.so" "ssp-handler.import.so" "web-scheme-handler.so" "web-scheme-handler.import.so") `((version ,spiffy-version)