A couple of weeks ago, synack on lobste.rs shared https://protohackers.com, a “server programming challenge” which asks you to implement servers responding to some protocol, and can run automated tests against your solutions.

I got nerd-sniped pretty hard, and with my current copious free-time, I decided to use it as an excuse to practice writing actual “software” in common lisp, exploring the package ecosystem some, and at least seeing the parts I’d need to make something more significant than the messing around with the language I’ve done in the past.

Problem 0: Infrastructure & Smoke Test

Our first task: a simple echo server, with the following requirements:

accept tcp connections;
whenever a client sends data, send it back unmodified;
don’t mangle binary data,
and handle at least 5 simultaneous clients.

Honestly, these requirements sort of form the “platonic abstract tcp server”; let clients connect over TCP, read data from the client, do something with that data (actually nothing in this case, but you get the point), and then respond in some way.

Also all that must be handled concurrently per-client.

Something like this:

(ql:quickload :usocket)
    
(defvar *host* "0.0.0.0")
(defvar *port* 7000)
    
(let ((server-socket (usocket:socket-listen *host* *port*)))
  (let ((client-socket (usocket:socket-accept server-socket)))
    ;; do something with the client connection
    (usocket:socket-close client-socket))
  (usocket:socket-close server-socket))

Except that only accepts a single client connection; we have to that part in a loop; additionally, we’ll need to handle multiple simultaneous clients.

We can do the latter with bordeaux-threads, a portable common-lisp thread library. I looked into cl-async as well, which implements libuv backed evented servers, but not until after I had a workable threaded solution.

I might come back to that another time, though using a library that provides everything out of the box is a little out of alignment with my goals here.

In fact, my goals sort of have me leaning into building out a little multi-threaded server, so let’s do it. Even with some basic logging and error handling (just to shut things down safely,) it’s not particularly long.

(ql:quickload :alexandria)
(ql:quickload :bordeaux-threads)
(ql:quickload :log4cl)
(ql:quickload :usocket)

(defvar *host* "0.0.0.0")
(defvar *port* 7000)

;; raised when the server wants to stop the worker threads
(define-condition interrupted () ())

(defun handler-wrapper (handlerfn client-socket)
  "Wrap a HANDLERFN such that it automatically closes the socket on completion."
  (unwind-protect
       (handler-case
           (progn
             (log:info "handling client: ~a" client-socket)
             (funcall handlerfn client-socket)
             (log:info "client completed ~a" client-socket))
         (interrupted ()
           ) ; ignore interrupted errors
         (error (e)
           (log:error "client died: ~a" e)))
    ;; finally
    (usocket:socket-close client-socket)))

(defun create-server (handlerfn &key (host *host*) (port *port*) (element-type '(unsigned-byte 8)))
  "Create a TCP server at *HOST* and *PORT*, which runs HANDLERFN in a
      new thread for each connection."
  (let ((conn-threads  ())
        (server-socket (usocket:socket-listen host port :reuse-address t)))
    (log:info "server listening at ~a:~a" host port)
    (unwind-protect
         (loop do
           (let* ((client  (usocket:socket-accept server-socket :element-type element-type))
                  (handler (lambda () (handler-wrapper handlerfn client)))
                  (thread  (bt:make-thread handler :name "worker")))
             (push thread conn-threads)))
      ;; when the loop exists or an error is raised (like ctrl-c)
      (log:info "server shutting down")
      (usocket:socket-close server-socket)
      (dolist (thread conn-threads)
        (when (bt:thread-alive-p thread)
          (bt:interrupt-thread thread (lambda () (signal 'interrupted)))
          (bt:join-thread thread))))))

(defun protohackers/0-echo-handler (client-socket)
  "ProtoHackers 0: Echo Handler
      Echo all input back to the client, once the client has finished writing."
  (let* ((stream (usocket:socket-stream client-socket))
         (input  (alexandria:read-stream-content-into-byte-vector stream)))
    (write-sequence input stream)
    (finish-output stream)))

(defun +main+ ()
  (handler-case
      (create-server #'protohackers/0-echo-handler)
    (error (e)
      (log:error e)
      (log:error "shutting down, bye"))))

Multiple problems with this, but it passes the smoke-test from protohackers;

when a connection is done, the thread dies, but the top-level server doesn’t know it’s done
there’s no backpressure, so we’ll accept requests as fast as we can, creating a thread for each

I may have to come to these issues in the future, but for now, a green check on the protohackers problem!