昨日の続き (Common Lisp の IOLib でとても簡単な Web サーバを書く)

一年の最後に書くのも最初に書くのも Common Lisp でありたい。

Common Lisp の IOLib でとても簡単な Web サーバを書く。昨日との違いはコンパイラマクロを入れ、コンパイラが note をはからないように適当に最適化したたくらい。

ab してみる。マシンは Intel(R) Core(TM)2 Duo CPU T7100 @ 1.80GHz で。何もしないと秒間 4,000 リクエスト以上さばけるんだ。なんとなく Rails の遅さと nginx の速さに納得した。

ところで、受信イベントが2回発生し、2回目の receive-from は 0 バイトになる。そういうものなんだろうか?

outis:~% /usr/bin/ab -n 10000 -c 10 'http://localhost:8888/hello'
This is ApacheBench, Version 2.3 <$Revision: 655654 $>
Copyright 1996 Adam Twiss, Zeus Technology Ltd, http://www.zeustech.net/
Licensed to The Apache Software Foundation, http://www.apache.org/

Benchmarking localhost (be patient)
Completed 1000 requests
Completed 2000 requests
Completed 3000 requests
Completed 4000 requests
Completed 5000 requests
Completed 6000 requests
Completed 7000 requests
Completed 8000 requests
Completed 9000 requests
Completed 10000 requests
Finished 10000 requests


Server Software:
Server Hostname:        localhost
Server Port:            8888

Document Path:          /hello
Document Length:        40 bytes

Concurrency Level:      10
Time taken for tests:   2.282 seconds
Complete requests:      10000
Failed requests:        0
Write errors:           0
Total transferred:      970000 bytes
HTML transferred:       400000 bytes
Requests per second:    4382.89 [#/sec] (mean)
Time per request:       2.282 [ms] (mean)
Time per request:       0.228 [ms] (mean, across all concurrent requests)
Transfer rate:          415.18 [Kbytes/sec] received

Connection Times (ms)
              min  mean[+/-sd] median   max
Connect:        0    0  17.3      0    1002
Processing:     0    1  21.4      1    1380
Waiting:        0    1  21.4      1    1380
Total:          0    2  27.5      1    1380

Percentage of the requests served within a certain time (ms)
  50%      1
  66%      1
  75%      1
  80%      1
  90%      2
  95%      3
  98%      4
  99%      5
 100%   1380 (longest request)

#+nil
(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload :iolib)
  (ql:quickload :quek))

(quek:sdefpackage :httpd
                  (:use :cl))

(in-package :httpd)

(named-readtables:in-readtable quek:|#"|)

(defvar *httpd*)

(alexandria:define-constant +crlf+ (format nil "~c~c" #\cr #\lf) :test #'equalp)

(defun start (&key (port 8888))
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (setf *httpd* (make-instance 'iolib.multiplex:event-base))
  (let ((socket (iolib.sockets:make-socket :address-family :ipv4
                                           :type :stream
                                           :connect :passive
                                           :local-host "0.0.0.0"
                                           :local-port port
                                           :reuse-address t)))
    (iolib.sockets::listen-on socket)
    (describe socket)
    (iolib.multiplex::set-io-handler
     *httpd*
     (iolib.streams::fd-of socket)
     :read (lambda (fd event exception)
             (declare (ignore fd event exception))
             (let* ((client-socket (iolib.sockets:accept-connection socket))
                    (fd (iolib.streams:fd-of client-socket)))
               (iolib.multiplex:set-io-handler
                *httpd* fd
                :read (lambda (_fd event exception)
                        (declare (ignore _fd event exception))
                        (unwind-protect
                             (handler client-socket)
                          (iomux:remove-fd-handlers *httpd* fd)
                          (close client-socket)))))))
    (unwind-protect
         (iolib.multiplex:event-dispatch *httpd*)
      (close socket))))

(defun handler (client-socket)
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (let ((buffer (make-array 4096 :element-type '(unsigned-byte 8))))
    (declare (dynamic-extent buffer))
    (multiple-value-bind (buffer nbytes) (iolib.sockets:receive-from client-socket :buffer buffer)
      (declare (type fixnum nbytes))
      ;; イベントが2回発生し、2回目の receive-from は 0 バイトになる。そういうもの?
      (when (plusp nbytes)
          (multiple-value-bind (buffer nbytes) (request buffer nbytes)
            (iolib.sockets:send-to client-socket buffer :end nbytes))))))

(defun request (buffer nbytes)
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (declare (type (simple-array (unsigned-byte 8)) buffer))
  (let* ((start (position #x20 buffer :end nbytes))
         (end (position #x20 buffer :start (+ start 2) :end nbytes))
         (path (sb-ext:octets-to-string buffer
                                        :external-format :utf-8
                                        :start (1+ start)
                                        :end end))
         (symbol-name (prog1 (string-upcase path)
                        #|(format t "~&~a" path)|#))
         (symbol (or (find-symbol symbol-name :httpd) '/404)))
    (funcall (symbol-function symbol))))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun make-response (content)
    (declare (optimize (speed 3) (safety 0) (debug 0)))
    (let* ((response #"""HTTP/1.0 200#,+crlf+,Content-Type: text/html; charset=utf-8;#,+crlf+,#,+crlf+,#,content""")
           (buffer (sb-ext:string-to-octets response :external-format :utf-8)))
      (declare (type (simple-array (unsigned-byte 8)) buffer))
      (values buffer (length buffer)))))

(define-compiler-macro make-response (&whole form content &environment env)
  (if (constantp content env)
      (multiple-value-bind (buffer nbytes) (make-response content)
        `(values ,buffer ,nbytes))
      form))

(defun /hello ()
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (make-response "<html><body><h1>hello</h1></body></html>"))

(defun /404 ()
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (make-response "<html><body><h1>404</h1></body></html>"))