Node.js っておもしろそうなので

Common Lisp でエコーサーバが書けるまで実装してみた。

#+nil
(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload :iolib)
  (ql:quickload :hu.dwim.defclass-star)
  (ql:quickload :anaphora)
  (ql:quickload :quek))

(quek:sdefpackage :node.cl
                  (:use :cl :quek :anaphora)
                  (:import-from :hu.dwim.defclass-star #:defclass*)
                  (:shadow #:close
                           #:listen
                           #:stream
                           #:write
                           #:read)
                  (:export #:serever))

(in-package :node.cl)

(defvar *event-base* nil)

(defmacro with-event-base (&body body)
  `(let ((*event-base* (make-instance 'iolib.multiplex:event-base)))
     ,@body
     (iolib.multiplex:event-dispatch *event-base*)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; event

(defclass* event-emitter ()
  ((max-listeners 10)
   (events (make-hash-table))))

(defmethod emit ((event-emitter event-emitter) type &rest args)
  (awhen (gethash type (events-of event-emitter))
    (iterate ((f (scan (gethash type (events-of event-emitter)))))
      (apply f args))))

(defmethod on ((event-emitter event-emitter) type listener)
  (push listener (gethash type (events-of event-emitter))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; handle

(defclass* handle (event-emitter)
  ((handle)))

(defmethod close ((handle handle))
  (on-close handle))

(defmethod on-close ((handle handle))
  (dispose (handle-of handle))
  (clear (handle-of handle)))

(defmethod dispose (x))
(defmethod clear (x))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; stream

(defclass* stream (handle)
  ((on-read)
   (external-format :utf-8)
   (buffer (make-array 1024 :element-type 'iolib.base:ub8))))

(defmethod read-start ((stream stream))
  (iolib.multiplex:set-io-handler
   *event-base*
   (iolib.streams:fd-of (handle-of stream))
   :read (lambda (fd event exception)
           (declare (ignore fd event exception))
           (on-read stream))))

(defmethod read-stop ((stream stream))
  (iolib.multiplex:remove-fd-handlers *event-base*
                                      (iolib.streams:fd-of (handle-of stream))
                                      :read t))

(defmethod on-read ((stream stream))
  (multiple-value-bind (buffer nread) (iolib.sockets:receive-from (handle-of stream)
                                                                  :buffer (buffer-of stream)
                                                                  :start 0
                                                                  :end (length (buffer-of stream)))
    (funcall (on-read-of stream) buffer 0 nread)))

(defgeneric write (stream buffer &rest args &key &allow-other-keys))

(defmethod write (x buffer &key)
  (iolib.sockets:send-to x buffer))

(defmethod write ((handle handle) buffer &key)
  (write (handle-of handle) buffer))

(defmethod write ((stream stream) (buffer string) &key)
  (write (handle-of stream)
         (sb-ext:string-to-octets buffer :external-format (external-format-of stream))))


(defmethod pipe ((stream stream) dest &rest options)
  (declare (ignore options))
  (on stream :data (lambda (chunk)
                     (write dest chunk))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; TCP

(defclass* tcp (stream)
  ((on-connection)))

(defmethod initialize-instance :after ((tcp tcp) &key port ip)
  (when (and port ip)
    (setf (handle-of tcp) (iolib.sockets:make-socket :address-family :ipv4
                                                     :connect :passive
                                                     :external-format :utf-8
                                                     :local-host ip
                                                     :local-port port))))

(defgeneric listen (x &key &allow-other-keys))

(defmethod listen ((tcp tcp) &key)
  (iolib.sockets:listen-on (handle-of tcp))
  (iolib.multiplex:set-io-handler
   *event-base*
   (iolib.streams:fd-of (handle-of tcp))
   :read (lambda (fd event exception)
           (declare (ignore fd event exception))
           (on-connect tcp (handle-of tcp)))))

(defmethod on-connect ((tcp tcp) handle)
  (let ((client (make-instance 'tcp :handle (iolib.sockets:accept-connection (handle-of tcp)))))
    (funcall (on-connection-of tcp) client)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; socket

(defclass* socket (stream)
  ((server)))

(defmethod initialize-instance :after ((socket socket) &key handle)
  (when handle
    (setf (on-read-of handle)
          (lambda (buffer offset length)
            (emit socket :data
                  (sb-ext:octets-to-string buffer :external-format (external-format-of socket)
                                                  :start offset
                                                  :end (+ offset length)))))))

(defmethod resume ((socket socket))
  (read-start (handle-of socket)))

(defmethod pause ((socket socket))
  (read-stop (handle-of socket)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; serever

(defclass* server (event-emitter)
  ((connections)
   (handle)))

(defmethod initialize-instance :after ((server server) &key connection)
  (on server :connection connection))

(defmethod listen ((server server) &key port ip)
  (with-slots (handle) server
    (setf handle (make-instance 'tcp :port port :ip ip))
    (setf (on-connection-of handle)
          (lambda (client-handle)
            (let ((socket (make-instance 'socket :handle client-handle
                                                 :server server)))
              (resume socket)
              (emit server :connection socket)
              (emit socket :connect))))
    (listen handle)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; echo server

#|
var net = require('net');
var server = net.createServer(function (socket) {
  socket.write("Echo server\r\n");
  socket.pipe(socket);
});
server.listen(1337, "127.0.0.1");

(with-event-base
    (let ((server (make-instance 'server
                                 :connection (lambda (socket)
                                               (write socket "Echo server")
                                               (write socket #(#x0d #x0a))
                                               (pipe socket socket)))))
      (listen server :port 1111 :ip "127.0.0.1")))
|#