どうしても最後に Common Lisp のコードを書いておかないと
年が越せない。
#+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))
(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)))
(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)))
(let ((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 :read t)
(close client-socket))))))))
(unwind-protect
(iolib.multiplex:event-dispatch *httpd*)
(close socket))))
(defun handler (client-socket)
(let ((buffer (make-array 4096 :element-type '(unsigned-byte 8))))
(multiple-value-bind (buffer nbytes) (iolib.sockets:receive-from client-socket :buffer buffer)
(multiple-value-bind (buffer nbytes) (request buffer nbytes)
(iolib.sockets:send-to client-socket buffer :end nbytes)))))
(defun request (buffer nbytes)
(declare (ignore nbytes))
(let* ((start (position #x20 buffer))
(end (position #x20 buffer :start (+ start 2)))
(path (sb-ext:octets-to-string buffer
:external-format :utf-8
:start (1+ start)
:end end))
(symbol-name (string-upcase path))
(symbol (or (find-symbol symbol-name :httpd) '/404)))
(funcall symbol)))
(defun /hello ()
(make-response "<html><body><h1>hello</h1></body></html>"))
(defun /404 ()
(make-response "<html><body><h1>404</h1></body></html>"))
(defun make-response (content)
(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)))
(values buffer (length buffer))))
