scsh-conservatory
/
scsh-0.5
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
scsh/network.scm
View File

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