;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(library (scgi)
  (export scgi-request-handler handle-scgi-connection run-scgi
	  scgi-headers->bytevector)

  (import (chezscheme)
	  (socket)
	  (netstring)
	  (only (srfi s1 lists) list-index take drop)
	  (only (posix) fork wait-for-pid wait-flag))

  (define (header-get-token l)
................................................................................
	   (fold-right
	    (lambda (x acc)
	      (let ([name (car x)] [value (cdr x)])
		(append (bytevector->u8-list (string->utf8 name)) '(0)
			(bytevector->u8-list (string->utf8 value)) '(0)
			acc)))
	    '() l )))



  (define scgi-request-handler
    (make-parameter
     (lambda (response-port headers content)
       (printf "scgi: headers: ~a~n" headers)
       (printf "scgi: contents: ~a~n" content)
       
................................................................................
  
  (define (handle-scgi-connection sock)
    (define h (read-headers sock))
    (assert (string=? "1" (cdr (assq 'SCGI h))))
    (let* ([len (string->number (cdr (assq 'CONTENT_LENGTH h)))]
	   [content (get-bytevector-n sock len)])
      (assert (= (bytevector-length content) len))
      (let ([port (transcoded-port sock (make-transcoder (utf-8-codec) 'none))])

	((scgi-request-handler) port h content)
	(flush-output-port port))))


  (define (run-scgi addr port)
    (define nchildren 0)
    (define max-children 10)
    (define waitpid (foreign-procedure "waitpid" (int void* int) int))
    (call-with-port
     (socket 'inet 'stream '() 0)
................................................................................
	 (printf "scgi: waiting for connection...~n")
	 (call-with-port
	  (accept sock)
	  (lambda (clifd)
	    (printf "scgi: accepted connection~n")
	    (if (> nchildren max-children)
		(sleep (make-time 'time-duration 0 1)))

	    (printf "scgi: forking..~n")
	    (let ([pid (fork)])
	      (cond
	       [(= pid 0)
		(guard (e [else (display "scgi: handler error: ")
				  (display-condition e)
				  (newline)])			   

;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(library (scgi)
  (export scgi-request-handler handle-scgi-connection run-scgi
	  scgi-headers->bytevector
	  scgi-before-fork-hook)
  (import (chezscheme)
	  (socket)
	  (netstring)
	  (only (srfi s1 lists) list-index take drop)
	  (only (posix) fork wait-for-pid wait-flag))

  (define (header-get-token l)
................................................................................
	   (fold-right
	    (lambda (x acc)
	      (let ([name (car x)] [value (cdr x)])
		(append (bytevector->u8-list (string->utf8 name)) '(0)
			(bytevector->u8-list (string->utf8 value)) '(0)
			acc)))
	    '() l )))
  
  (define scgi-before-fork-hook (make-parameter values))

  (define scgi-request-handler
    (make-parameter
     (lambda (response-port headers content)
       (printf "scgi: headers: ~a~n" headers)
       (printf "scgi: contents: ~a~n" content)
       
................................................................................
  
  (define (handle-scgi-connection sock)
    (define h (read-headers sock))
    (assert (string=? "1" (cdr (assq 'SCGI h))))
    (let* ([len (string->number (cdr (assq 'CONTENT_LENGTH h)))]
	   [content (get-bytevector-n sock len)])
      (assert (= (bytevector-length content) len))
      ;;(let ([port (transcoded-port sock (make-transcoder (utf-8-codec) 'none))])
      (let ([port sock])
	((scgi-request-handler) port h content)
	#;(flush-output-port port)
	#;(close-port port))))

  (define (run-scgi addr port)
    (define nchildren 0)
    (define max-children 10)
    (define waitpid (foreign-procedure "waitpid" (int void* int) int))
    (call-with-port
     (socket 'inet 'stream '() 0)
................................................................................
	 (printf "scgi: waiting for connection...~n")
	 (call-with-port
	  (accept sock)
	  (lambda (clifd)
	    (printf "scgi: accepted connection~n")
	    (if (> nchildren max-children)
		(sleep (make-time 'time-duration 0 1)))
	    ((scgi-before-fork-hook))
	    (printf "scgi: forking..~n")
	    (let ([pid (fork)])
	      (cond
	       [(= pid 0)
		(guard (e [else (display "scgi: handler error: ")
				  (display-condition e)
				  (newline)])