diff --git a/lib/chibi/net/server.scm b/lib/chibi/net/server.scm new file mode 100644 index 00000000..fbfa341e --- /dev/null +++ b/lib/chibi/net/server.scm @@ -0,0 +1,61 @@ +;; Copyright (c) 2012 Alex Shinn. All rights reserved. +;; BSD-style license: http://synthcode.com/license.txt + +(define default-max-requests 10000) + +(define (run-net-server listener-or-addr handler . o) + (let* ((listener (if (integer? listener-or-addr) + listener-or-addr + (make-listener-socket listener-or-addr))) + (max-requests (if (pair? o) (car o) default-max-requests)) + (debug? (and (pair? o) (pair? (cdr o))))) + (define (log-error msg . args) + (display msg (current-error-port)) + (for-each + (lambda (x) + (write-char #\space (current-error-port)) + (display x (current-error-port))) + args) + (newline (current-error-port))) + (define (log-debug msg . args) + (if debug? (apply log-error msg args))) + (define (run sock addr count) + (log-debug "net-server: accepting request:" count) + (let ((ports + (guard (exn + (else + (log-error "net-server: couldn't create port:" sock) + (close-file-descriptor sock))) + (cons (open-input-file-descriptor sock) + (open-output-file-descriptor sock))))) + (guard (exn + (else (log-error "net-server: error in request:" count) + (print-exception exn) + (print-stack-trace exn) + (close-input-port (car ports)) + (close-output-port (cdr ports)) + (close-file-descriptor sock))) + (handler (car ports) (cdr ports) sock addr) + (close-input-port (car ports)) + (close-output-port (cdr ports)) + (close-file-descriptor sock))) + (log-debug "net-server: finished: " count)) + (let ((requests 0)) + (let serve ((count 0)) + (if (>= requests max-requests) + (thread-yield!) + (let* ((addr (get-address-info "127.0.0.1" "8000")) + (sock (accept listener + (address-info-address addr) + (address-info-address-length addr)))) + (cond + ((not sock) + (serve count)) + (else + (thread-start! + (make-thread + (lambda () + (set! requests (+ requests 1)) + (run sock addr count) + (set! requests (- requests 1))))) + (serve (+ 1 count)))))))))) diff --git a/lib/chibi/net/server.sld b/lib/chibi/net/server.sld new file mode 100644 index 00000000..de535da2 --- /dev/null +++ b/lib/chibi/net/server.sld @@ -0,0 +1,5 @@ + +(define-library (chibi net server) + (import (scheme) (chibi net) (chibi filesystem) (srfi 18)) + (export run-net-server) + (include "server.scm"))