Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-16 09:27:33 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Allowing an abstract thunk interface to run-net-server.

Browse source
This commit is contained in:
Alex Shinn 2013-07-14 14:29:03 +09:00
parent dddc6d1806
commit 1bd9a79e71
2 changed files with 30 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

43
lib/chibi/net/server.scm
View file

@ -3,15 +3,33 @@
(define default-max-requests 10000)
(define (make-socket-listener-thunk listener port)
(lambda ()
(let ((addr (get-address-info "localhost" port)))
(cond
((accept listener
(address-info-address addr)
(address-info-address-length addr))
=> (lambda (sock) (list sock addr)))
(else #f)))))
(define (make-listener-thunk x)
(cond
((integer? x)
(make-socket-listener-thunk
(make-listener-socket (get-address-info "localhost" x))
x))
((address-info? x)
(make-socket-listener-thunk (make-listener-socket x) 80))
((fileno? x)
(make-socket-listener-thunk x 80))
((procedure? x)
x)
(else
(error "expected a listener socket, fileno or thunk" x))))
(define (run-net-server listener-or-addr handler . o)
(let* ((listener (cond
((fileno? listener-or-addr)
listener-or-addr)
((integer? listener-or-addr)
(make-listener-socket
(get-address-info "localhost" listener-or-addr)))
(else
(make-listener-socket listener-or-addr))))
(let* ((listener-thunk (make-listener-thunk 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)
@ -49,19 +67,16 @@
(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))))
(let ((sock+addr (listener-thunk)))
(cond
((not sock)
((not sock+addr)
(serve count))
(else
(thread-start!
(make-thread
(lambda ()
(set! requests (+ requests 1))
(run sock addr count)
(run (car sock+addr) (cadr sock+addr) count)
(set! requests (- requests 1)))
(string-append "net-client-" (number->string count))))
(serve (+ 1 count))))))))))

2
lib/chibi/net/server.sld
View file

@ -1,5 +1,5 @@
(define-library (chibi net server)
(import (chibi) (chibi net) (chibi filesystem) (srfi 18))
(export run-net-server)
(export run-net-server make-listener-thunk)
(include "server.scm"))