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")))
|#
