Added bind-prepare-listen-accept-loop.

scsh/network.scm

@@ -48,6 +48,9 @@
           #f))))
 
 (define (bind-listen-accept-loop protocol-family proc arg)
+  (bind-prepare-listen-accept-loop protocol-family (lambda () #t) proc arg))
+
+(define (bind-prepare-listen-accept-loop protocol-family prepare proc arg)
   (let* ((sock (create-socket protocol-family socket-type/stream))
 	 (addr (cond ((= protocol-family
 			 protocol-family/internet)
@@ -68,6 +71,13 @@
 			     protocol-family)))))
     (set-socket-option sock level/socket socket/reuse-address #t)
     (bind-socket sock addr)
+    (with-handler
+     (lambda (condition more)
+       (with-handler
+	(lambda (condition ignore) (more))
+	(lambda () (close-socket sock)))
+       (more))
+     prepare)
     (listen-socket sock 5)
     (with-handler
      (lambda (condition more)

scsh/scsh-interfaces.scm

@@ -695,6 +695,7 @@
 (define-interface scsh-sockets-interface
   (export socket-connect
 	  bind-listen-accept-loop
+	  bind-prepare-listen-accept-loop
 	  socket?
 	  socket:family
 	  socket:inport