親スレッド終了時に子スレッドも強制終了するように修正

pofo.asd

@@ -3,7 +3,7 @@
 (defsystem pofo
   :name "pofo"
   :author "Takeru Ohta"
-  :version "0.0.1"
+  :version "0.0.2"
   :description "Port Forwarding"
   :serial t
   :depends-on (:sb-bsd-sockets)

pofo.lisp

@@ -1,6 +1,5 @@
 (in-package :pofo)
 
-;; TODO: make-two-way-stream を試してみても良いかも
 (defun forward (in out)
   (while (listen in)
     (write-byte (read-byte in) out))
@@ -52,4 +51,3 @@
     (if thread
         (sb-thread:make-thread (lambda () (main)))
       (main))))
-

socket.lisp

@@ -40,10 +40,20 @@
 ;; NOTE: multi-thread version
 ;; TODO: single-thread版も試したい
 (defmacro do-accept ((client server) &body body)
-  `(loop
-    (let ((,client (sb-bsd-sockets:socket-accept ,server)))
-      (sb-thread:make-thread
-       (lambda ()
-         (unwind-protect
-             (locally ,@body)
-           (sb-bsd-sockets:socket-close ,client)))))))
+  (let ((threads (gensym)))
+    `(let ((,threads '()))
+       (unwind-protect
+           (loop FOR ,client = (sb-bsd-sockets:socket-accept ,server)
+             DO
+             (push
+              (sb-thread:make-thread
+               (lambda ()
+                 (unwind-protect
+                     (locally ,@body)
+                   (sb-bsd-sockets:socket-close ,client))))
+              ,threads)
+             ;; XXX:
+             (setf ,threads (delete-if-not #'sb-thread:thread-alive-p ,threads)))
+         (loop FOR thread IN ,threads
+               WHEN (sb-thread:thread-alive-p thread)
+               DO (sb-thread:terminate-thread thread))))))