Common Lisp でサーバプログラム - その 2

昨日のやつをいくつか改善。

1. クライアントのコマンドでサーバを落とす方式をやめた

まぁクライアントのコマンドによってサーバを落とすのはあんまりなので。サーバを起動してる REPL で SIGINT なりを飛ばせば落とせるようになった (前も落とすことはできたが、正しく終了させることはできなかった)。

2. サーバソケットを確実に閉じる

こういう目的には unwind-protect を使うらしい。サーバのメインループの部分を unwind-protect で囲って、protect (必ず実行される処理) でサーバソケットを閉じるようにした。

クライアントから EOF を送ってもコネクションが閉じない件は、telnet の使いかたがまずかっただけだった。^] してから Ctrl-D で EOF を送ることができ、サーバ側でも EOF を検出してクライアントソケットを閉じることができた。

以下は前回からの差分。上に挙げたこと以外に、デバッグ出力を消したりしてる。asd ファイルに変更があるのは次への布石なんだけど、実際に使うのはもうちょい先になりそうな気がしてる。

diff --git a/cl-echo-server/echo-server.asd b/cl-echo-server/echo-server.asd
index d72f682..ac0ae2b 100644
--- a/cl-echo-server/echo-server.asd
+++ b/cl-echo-server/echo-server.asd
@@ -1,4 +1,4 @@
 (defsystem echo-server
   :components ((:file "packages")
                (:file "echo-server" :depends-on ("packages")))
-  :depends-on (:usocket))
+  :depends-on (:usocket :bordeaux-threads))
diff --git a/cl-echo-server/echo-server.lisp b/cl-echo-server/echo-server.lisp
index 25ae9a4..04b620e 100644
--- a/cl-echo-server/echo-server.lisp
+++ b/cl-echo-server/echo-server.lisp
@@ -1,7 +1,5 @@
 (in-package :echo-server)
 
-(define-condition stop-server (condition) ())
-
 (defun make-server-socket (port)
   (usocket:socket-listen "localhost" port :reuseaddress t))
 
@@ -10,14 +8,12 @@
   (usocket:socket-close server))
 
 (defun accept-client (server)
-  (prog1 (usocket:socket-accept server)
-    (format t "accept a client!~%")))
+  (usocket:socket-accept server))
 
 (defun trim-input (input)
   (string-trim " ^M" input))
 
 (defun echo-input (client-stream input)
-  (format t "echo to client!~%")
   (format client-stream "~A~%" (trim-input input))
   (force-output client-stream))
 
@@ -27,17 +23,11 @@
 (defun handle-client (client)
   (with-open-stream (stream (usocket:socket-stream client))
       (loop for input = (read-line stream nil nil)
-         while input
-         if (input= input "stop-server") do
-           (error 'stop-server)
-         else do
-           (echo-input stream input))
-      t))
+         while input do
+           (echo-input stream input))))
 
 (defun start (&key (port 8080))
   (let ((server-sock (make-server-socket port)))
-    (handler-case
-        (loop while (handle-client (accept-client server-sock)))
-      (stop-server () (format t "exit...~%"))
-      (condition () (format t "unexpected exit!~%")))
-    (dispose server-sock)))
+    (unwind-protect
+         (loop (handle-client (accept-client server-sock)))
+      (dispose server-sock))))

以下はプログラム全体。ただしサーバ本体だけ。

(in-package :echo-server)

(defun make-server-socket (port)
  (usocket:socket-listen "localhost" port :reuseaddress t))

(defun dispose (server)
  (format t "close...~%")
  (usocket:socket-close server))

(defun accept-client (server)
  (usocket:socket-accept server))

(defun trim-input (input)
  (string-trim " ^M" input))

(defun echo-input (client-stream input)
  (format client-stream "~A~%" (trim-input input))
  (force-output client-stream))

(defun input= (input expected)
  (string= (trim-input input) expected))

(defun handle-client (client)
  (with-open-stream (stream (usocket:socket-stream client))
      (loop for input = (read-line stream nil nil)
         while input do
           (echo-input stream input))))

(defun start (&key (port 8080))
  (let ((server-sock (make-server-socket port)))
    (unwind-protect
         (loop (handle-client (accept-client server-sock)))
      (dispose server-sock))))