SBCLでUnix-domain socketを使う

はじめに

Common Lispでsocketプログラミングをするには通常usocketを使うのですが、 usocketはUnix-domain socketに対応してなさそうです。 そこで、SBCLでUnix-domain socketを使う方法について調べました。 また、簡単なechoサーバーも書いてみました。

local-socket

SBCLのマニュアル によると、Unix-domain socketにはlocal-socketクラスを使うようです。 また、local-abstract-socketというクラスもあり、こちらを使うと抽象ソケットを作ることができるようです。

これらのクラスからlistenするソケットを次のように生成できます。

(defun socket-listen (socket-name &key use-abstract)
  (let ((socket (make-instance (if use-abstract
                                   'sb-bsd-sockets:local-abstract-socket
                                   'sb-bsd-sockets:local-socket)
                               :type :stream)))
    (handler-case
        (progn
          (sb-bsd-sockets:socket-bind socket socket-name)
          (sb-bsd-sockets:socket-listen socket 100)
          socket)
      (sb-bsd-sockets:address-in-use-error ()
        nil))))

生成したソケットはsb-bsd-sockets:socket-acceptで接続を待ち受けることができます。

接続する側のソケットも同様にlocal-socketを使います。

(defun connect-to (socket-name &key use-abstract)
  (let ((socket (make-instance (if use-abstract
                                   'sb-bsd-sockets:local-abstract-socket
                                   'sb-bsd-sockets:local-socket)
                               :type :stream)))
    (sb-bsd-sockets:socket-connect socket socket-name)
     socket))

echoサーバー

下は、echoサーバーの例です。 (start-server)して接続を待ち受けた後、別ターミナルで(connect-and-send)をすると、サーバーに文字列を送っていることが確認できます。

(ql:quickload :bordeaux-threads)

;;; server側
(defun handle-socket (socket)
  (let ((stream (sb-bsd-sockets:socket-make-stream
                 socket
                 :input t
                 :output t
                 :buffering :full)))
    (bt:make-thread
     (lambda ()
       (format t "Connected")
       (unwind-protect
           (loop for line = (read-line stream nil nil)
                 while line
                 do (progn
                      (print line)
                      (write-line line stream)
                      (force-output stream)))
         (sb-bsd-sockets:socket-close socket))
       (format t "Disconnected")))))

(defun start-server ()
    (let ((threads nil)
          (listen-socket (socket-listen "/tmp/server")))
      (when listen-socket
        (unwind-protect
            (loop do
                (let* ((socket (sb-bsd-sockets:socket-accept listen-socket))
                       (thread (handle-socket socket)))
                  (push thread threads)))
          (mapc #'bt:destroy-thread threads)
          (sb-bsd-sockets:socket-close listen-socket)))))

;;; client側
(defun connect-and-send ()
  (let ((socket (connect-to "/tmp/server")))
    (unwind-protect
        (let ((stream (sb-bsd-sockets:socket-make-stream
                       socket
                       :input t
                       :output t
                       :buffering :full)))
          (write-line "Hello" stream)
          (force-output stream)
          (print (read-line stream))
          (write-line "World" stream)
          (force-output stream)
          (print (read-line stream))
          (values))
      (sb-bsd-sockets:socket-close socket))))