[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [Chicken-users] Scope problem?
From: |
Matt Gushee |
Subject: |
Re: [Chicken-users] Scope problem? |
Date: |
Sun, 31 May 2009 17:06:37 -0600 |
User-agent: |
Thunderbird 2.0.0.19 (X11/20090213) |
Peter Bex wrote:
On Sun, May 31, 2009 at 04:11:27PM -0600, Matt Gushee wrote:
So, do I need further education, or should I report a bug?
I think we need to see the actual code to your fastcgi port to know more.
By the way, string-length is a R5RS procedure, so you shouldn't
need srfi-13. (which makes it extra-odd that it works when you load
srfi-13)
Sorry, it wasn't string-length, it was string-index. Also, one more
detail that may be relevant: in this exploratory phase of development, I
am running the code script-style, i.e. the script begins w/
#!/usr/local/bin/chicken -script
Anyway, the fastcgi module code follows. I didn't change much:
* Replace the old unit declarations with appropriate module
declarations.
* Changed miscellaneous foreign types as necessary.
* Replaced a define-foreign-record section w/
define-foreign-record-type
* Replaced all instances of make-property-condition with
make-exn-condition
* Replaced the byte-vector in (get-scheme-str) with a u8vector.
I think that's about it. I can't say that I completely understand the
code, though I will certainly learn it better as needed.
-- BEGIN fastcgi.scm ------------------------------------------------
[ copyright notice omitted ]
(module fastcgi
( fcgi-external-server-accept-loop
fcgi-dynamic-server-accept-loop
fcgi-accept-loop
fcgi-get-post-data
*fcgi-slurp-chunk-size* )
( import scheme
chicken
matchable
lolevel
srfi-1
srfi-4
srfi-13
foreign
foreigners
conditions )
;;; Stop the compiler complaining about implicit definitions.
(foreign-declare
"
struct fcgx_request;
struct fcgx_stream;
int FCGX_Init();
int FCGX_OpenSocket(char *, int);
int FCGX_InitRequest(struct fcgx_request *, int, int);
int FCGX_Accept_r(struct fcgx_request *);
int FCGX_Finish_r(struct fcgx_request *);
char *FCGX_GetParam(char *, char **);
int FCGX_PutStr(char *, int, struct fcgx_stream *);
int FCGX_GetStr(char *, int, struct fcgx_stream *);
int FCGX_HasSeenEOF(struct fcgx_stream *);
")
;;;
;;; Low-level bindings for types/functions.
;;;
(define-foreign-type fcgx-stream c-pointer)
(define-foreign-type fcgx-param-array (c-pointer c-string))
;; Apparently define-foreign-record no longer exists
(define-foreign-record-type fcgx_request
(constructor: make-fcgx_request)
(int requestId fcgx_request-requestId)
(int role fcgx_request-role)
(fcgx-stream in fcgx_request-in)
(fcgx-stream out fcgx_request-out)
(fcgx-stream error fcgx_request-error)
(fcgx-param-array env fcgx_request-env)
;; This is private stuff which in theory could change in future
;; (though AFAIK libfcgi hasn't changed significantly for years.)
;; We don't access these fields, but we need to allocate the correct
;; amount of memory when creating an FCGX_Request struct.
(c-pointer params fcgx_request-params)
(int ipcFd fcgx_request-ipcFd)
(int isBeginProcessed fcgx_request-isBeginProcessed)
(int keepConnection fcgx_request-keepConnection)
(int appStatus fcgx_request-appStatus)
(int nWriters fcgx_request-nWriters)
(int flags fcgx_request-flags)
(int listen_sock fcgx_request-listen_sock))
(define fcgx-init
(foreign-lambda int "FCGX_Init"))
(define fcgx-open-socket
(foreign-lambda int "FCGX_OpenSocket" c-string int))
(define fcgx-init-request
(foreign-lambda int "FCGX_InitRequest" fcgx_request int int))
(define fcgx-accept-r
(foreign-lambda int "FCGX_Accept_r" fcgx_request))
(define fcgx-finish-r
(foreign-lambda int "FCGX_Finish_r" fcgx_request))
(define fcgx-get-param
(foreign-lambda
c-string
"FCGX_GetParam"
c-string fcgx-param-array))
(define fcgx-put-str
(foreign-lambda
int
"FCGX_PutStr"
c-string int fcgx-stream))
(define fcgx-get-str
(foreign-lambda
int
"FCGX_GetStr"
c-pointer int fcgx-stream))
(define fcgx-has-seen-eof
(foreign-lambda
bool
"FCGX_HasSeenEOF"
fcgx-stream))
(define fcgi-discard-input
(foreign-lambda*
void
((fcgx-stream s))
"char buf[1024];while(FCGX_GetStr(buf,sizeof buf,s)>0);"))
;;;
;;; The (relatively) high-level Scheme interface.
;;;
(define (wrap-out-stream s)
(lambda (o)
;;; Keep writing until all the characters in o have been written, or
;;; until fcgx-put-str returns < 0, in which case we raise an
exception.
(let loop ((to-write (string-length o)))
(unless (= 0 to-write)
(let ((n (fcgx-put-str o to-write s)))
(if (< n 0)
(abort
(make-exn-condition
'exn
"Error writing to libfcgi stream"
#f))
(loop (- to-write n))))))))
(define *fcgi-slurp-chunk-size* 200)
(define (fcgi-get-scheme-str size s)
(let*(
(buf (make-u8vector size))
(bufsz
((foreign-lambda*
int
((u8vector buf)(int n)(fcgx-stream s))
"
{
unsigned char *i = buf, *ei = buf + n;
int delta = 1;
while(i < ei && delta > 0) i += (delta = FCGX_GetStr((char *)i, ei -
i, s));
if (delta < 0) C_return(delta); //error
C_return(i - buf);
}"
) buf size s))
(str (blob->string (u8vector->blob buf))))
(cond
((< bufsz 0)
(abort
(make-exn-condition
'exn
"Error reading from libfcgi stream"
#f)))
((= bufsz size) str)
(#t (string-drop-right str (- size bufsz))))))
(define (wrap-in-stream s)
(match-lambda*
;; If an integer argument is given, read that
;; number of characters.
;; If #f or a negative integer is given, discard the entire POST input.
;; (Negative integer is allowed as well as #f, since earlier
versions only
;; allowed negative integers.)
((n) (if (or (and (boolean? n) (not n)) (< n 0))
(begin (fcgi-discard-input s) "") ; Discard the entire input.
(fcgi-get-scheme-str n s)))
;; ...otherwise, read the entire stream.
(()
(string-concatenate
(unfold
(lambda(seed) (fcgx-has-seen-eof s))
(lambda(seed) (fcgi-get-scheme-str (inexact->exact(round seed)) s))
(lambda(seed) (* seed 1.33))
*fcgi-slurp-chunk-size*)))))
;;; Utility function for incrementing a char**.
(define sarray-pointer+1
(foreign-lambda*
(c-pointer c-string)
(((c-pointer c-string) p))
"return(p + 1);"))
(define (wrap-env e)
(match-lambda*
((k . alternative)
(let ((r (fcgx-get-param k e)))
(if r
r
(optional alternative #f))))
(()
;; Convert the char ** array into a list of key/value cons pairs.
(let loop ((strlist '()) (p e))
(let ((deref
((foreign-lambda* c-string (((c-pointer c-string) ps))
"return(*ps);")
p)))
(cond
(deref
(loop (cons deref strlist) (sarray-pointer+1 p)))
(else
(map
(lambda (s)
(let ((idx (string-index s #\=)))
(unless idx
(abort
(make-exn-condition
'exn
"Internal error in libfcgi"
#f)))
(cons
(substring s 0 idx)
(substring s (+ 1 idx)))))
strlist))))))))
(define *fcgi-has-been-initialised* #f)
(define (fcgi-accept-loop-proto open-socket callback)
;; Initialise the FCGX library if it hasn't already been initialised.
(unless *fcgi-has-been-initialised*
(unless (fcgx-init)
(abort
(make-exn-condition
'exn
"Unable to initialise libfcgi"
#f)))
(set! *fcgi-has-been-initialised* #t))
;; Open a socket.
(let ((sock (open-socket)))
(unless (>= sock 0)
(abort
(make-exn-condition
'exn
(string-append "Unable to open socket using libfcgi:"
(number->string sock))
#f)))
;; Initialise a request object.
(let* ((req (make-fcgx_request))
(r (fcgx-init-request req sock 0)))
(unless (>= r 0)
(abort
(make-exn-condition
'exn
"Unable to initialise libfcgi request struct"
#f)))
(let loop ()
;; Wait for a connection from the webserver.
(let ((ar (fcgx-accept-r req)))
(cond
((>= ar 0)
;; The connection was successful, so call the callback...
(when
(let
((i
(callback
(wrap-in-stream (fcgx_request-in req))
(wrap-out-stream (fcgx_request-out req))
(wrap-out-stream (fcgx_request-error req))
(wrap-env (fcgx_request-env req)))))
(fcgi-discard-input (fcgx_request-in req))
i)
;; ... and wait for another connection if the callback
didn't
;; return #f.
(loop)))
(else
;; There was an error, so cleanup and raise an exception.
(fcgx-finish-r req)
(make-exn-condition
'exn
"Error while waiting to accept request using libfcgi"
#f))))))))
;;;
;;; Open the brand new listener socket - for external servers
;;;
(define (fcgi-external-server-accept-loop filename/port backlog callback)
(let
((open-socket-closure
(lambda ()
(fcgx-open-socket
(if (string? filename/port)
filename/port
;; To pass a port to FCGX_OpenSocket, you pass it a string
;; of the form ":PORT_NUMBER".
(string-append ":" (number->string filename/port)))
backlog))))
;; body
(fcgi-accept-loop-proto open-socket-closure callback)))
;;;
;;; Open nothing but return FCGI_LISTENSOCK_FILENO - for static
(dynamic) servers
;;; http://fastcgi.com/devkit/doc/fcgi-spec.html#S2.2
;;;
(define (fcgi-dynamic-server-accept-loop callback)
(fcgi-accept-loop-proto (lambda () 0) callback))
;;; For compatibility with earlier versions of this library.
(define fcgi-accept-loop fcgi-external-server-accept-loop)
(define (fcgi-get-post-data in env)
;; Some servers set HTTP_CONTENT_LENGTH, others CONTENT_LENGTH.
(let ((cl (env "HTTP_CONTENT_LENGTH" (env "CONTENT_LENGTH"))))
(if cl
(let ((icl (string->number cl)))
(if icl
(in icl)
(make-exn-condition
'exn
"Value of HTTP_CONTENT_LENGTH or CONTENT_LENGTH is not an
integer!"
#f)))
#f)))
)
-- END fastcgi.scm -----------------------------------------------------
--
Matt Gushee
: Bantam - lightweight file manager : matt.gushee.net/software/bantam/ :
: RASCL's A Simple Configuration Language : matt.gushee.net/rascl/ :