Welcome to the CHICKEN Scheme pasting service

(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))))


(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)
;  (let loop ((messages '()))
;    (if (socket-receive-ready? socket)
;      (receive (type req-id content) (recv-packet socket)
;       (pp (conc ":" content))
;       (assert (= request-id req-id))
;       (let* ((decoder (get-app->ws type))
;	      (content (decoder content))
;	      (msg (or (alist-ref type messages) '())))
;	(loop (alist-update! type (cons content msg) messages))))
;      (map (lambda (msg)
;	     (cons (car msg) (reverse (cdr msg))))
;	   messages))))
(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) '())))
      '()))

(define (fcgi-handler-responder socket req content-length)

 ; this 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 will occur if we let the FCGI script fill up all the buffers and we
 ; neglect to read anything before sending data.
 (define (in-out-dance #!optional (data #f))
  (printf "\nDancing.\n")
   (let ((messages (if data
		     (read/write-socket socket 1 fcgi-stdin data)
		     (read/write-socket socket 1 #f))))
     ; process the messages
     (pp messages)
     ; Quick hack so we can see something working
     (let ((stdout (alist-ref fcgi-stdout messages)))
       (if (and stdout (> (blob-size (car stdout)) 0))
	 (send-response status: 'ok body: (blob->string (car stdout)))))

     ;   when it starts, sort out the headers: remove content-length and close? if content length is not supplied then close?
     ;   transfer it to the spiffy response port or log it to debug-log as it arrives.
     (printf "That dance is over.\n")
     (if (alist-ref fcgi-end-request messages) #t #f)
     )
   )

  ;(read/write-socket socket request-id type . args)

  ; send fcgi-begin-request
  (read/write-socket socket 1 fcgi-begin-request fcgi-responder)
  ; send fcgi-params
  (read/write-socket socket 1 fcgi-params (cgi-build-env req "!!!FIXME!!!"))
  (read/write-socket socket 1 fcgi-params 'close-stream)

  ; stream request data over fcgi-stdin.
  (copy-port (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)))))