Fixed bug in bind-listen-accept-loop.

This commit is contained in:
shivers 2000-06-13 22:08:57 +00:00
parent bae0215386
commit 66b041ddde
1 changed files with 16 additions and 21 deletions

View File

@ -62,31 +62,26 @@
#f)))) #f))))
(define (bind-listen-accept-loop protocol-family proc arg) (define (bind-listen-accept-loop protocol-family proc arg)
(let* ((sock (create-socket protocol-family socket-type/stream)) (let ((sock (create-socket protocol-family socket-type/stream))
(addr (cond ((= protocol-family (addr (cond ((= protocol-family protocol-family/internet)
protocol-family/internet)
(let ((port (cond ((integer? arg) arg)
((string? arg)
(service-info:port
(service-info arg "tcp")))
(else
(error "socket-connect: bad arg ~s"
arg)))))
(internet-address->socket-address internet-address/any (internet-address->socket-address internet-address/any
arg))) (cond ((integer? arg) arg)
((= protocol-family ((string? arg)
protocol-family/unix) (service-info:port (service-info arg "tcp")))
(else (error "socket-connect: bad arg ~s" arg)))))
((= protocol-family protocol-family/unix)
(unix-address->socket-address arg)) (unix-address->socket-address arg))
(else (else
(error "bind-listen-accept-loop: unsupported protocol-family ~s" (error "bind-listen-accept-loop: unsupported protocol-family ~s"
protocol-family))))) protocol-family)))))
(set-socket-option sock level/socket socket/reuse-address #t) (set-socket-option sock level/socket socket/reuse-address #t)
(bind-socket sock addr) (bind-socket sock addr)
(listen-socket sock 5) (listen-socket sock 5)
(let loop () (let loop ()
(call-with-values (call-with-values (lambda () (accept-connection sock)) proc)
(lambda () (accept-connection sock))
proc)
(loop)))) (loop))))
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-