Simple echo UDP server in Common Lisp, running in a separate thread (usocket and SBCL threads)

udp-echo-server.ros

#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
(progn ;;init forms
  (ros:ensure-asdf)
  #+quicklisp (ql:quickload '(usocket flexi-streams) :silent t)
  )

; BSD 3-Clause License
; 
; Copyright (c) 2018, Sergey Polzunov
; All rights reserved.
; 
; Redistribution and use in source and binary forms, with or without
; modification, are permitted provided that the following conditions are met:
; 
; * Redistributions of source code must retain the above copyright notice, this
;   list of conditions and the following disclaimer.
; 
; * Redistributions in binary form must reproduce the above copyright notice,
;   this list of conditions and the following disclaimer in the documentation
;   and/or other materials provided with the distribution.
; 
; * Neither the name of the copyright holder nor the names of its
;   contributors may be used to endorse or promote products derived from
;   this software without specific prior written permission.
; 
; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(defpackage :ros.script.udp-echo-server.3745744282
  (:use :cl))
(in-package :ros.script.udp-echo-server.3745744282)


; This is working version of a simple UDP echo server, inspired by
; https://gist.github.com/shortsightedsid/71cf34282dfae0dd2528
; https://gist.github.com/shortsightedsid/a760e0d83a9557aaffcc
; http://mihai.bazon.net/blog/howto-multi-threaded-tcp-server-in-common-lisp
;
; To execute the example, download this gist,
; install Roswell (https://github.com/roswell/roswell) and run
;
;   $ ros ./udp-echo-server.ros
;
; To connect to a running server, run
;
;   $ nc -u localhost 8882
;
;
; You can find TCP server example here - https://gist.github.com/traut/6bf71d0da54493e6f22eb3d00671f2a9

(defvar +max-buffer-size+ 32768)


(defun logger (text &rest args)
  "Simple wrapper around format func to simplify logging"
  (apply 'format (append (list t (concatenate 'string text "~%")) args)))


(defun send-text-to-socket (text socket remote-host remote-port)
  (let* ((message (format nil "~a~%" text))  ; adding a line break at the end for prettiness
         (buffer (flexi-streams:string-to-octets message :external-format :utf-8)))
    (usocket:socket-send
      socket
      buffer
      (length message)
      :host remote-host
      :port remote-port)))


(defun trim (str)
  (string-trim '(#\return #\space #\linefeed) str))


(defun process-client-socket (client-socket)
  "Process client socket that got some activity"
  (let ((buffer (make-array +max-buffer-size+
                            :element-type '(unsigned-byte 8)
                            :fill-pointer t)))
    (multiple-value-bind (recv size remote-host remote-port)
      (usocket:socket-receive client-socket buffer nil)
      (declare (ignore recv)) ; it's the same buffer val, so we can ignore it
      (logger "new data from ~a:~a / ~a on socket ~a" remote-host remote-port size client-socket)
      (if (plusp size)
        ; converting buffer to string
        (let* ((message (flexi-streams:octets-to-string buffer :external-format :utf-8 :end size))
               (trimmed-message (trim message)))
          (logger "got a message: ~a" trimmed-message)
          (send-text-to-socket trimmed-message client-socket remote-host remote-port))
        (logger "no data received on udp socket: ~d" size)))))


(defun run-udp-server (host port)
  "Run UDP server in a loop, listening to incoming connections.
  This is single-threaded version. Better approach would be to run
  process-client-socket in a separate thread every time there is activity
  on the client socket"
  (let ((socket (usocket:socket-connect nil nil
                                        :protocol :datagram
                                        :local-host host
                                        :local-port port
                                        :element-type '(unsigned-byte 8))))
    (loop
      (loop for sock in (usocket:wait-for-input `(,socket) :ready-only t)
            do (process-client-socket sock)))))


(defun run-server-in-thread (host port)
  "Run UDP server in a separate thread"
  (let ((thread-name (format nil "udp-server")))
    (logger "starting udp server in a separate thread '~a'" thread-name)
    (sb-thread:make-thread
      (lambda () (run-udp-server host port))
      :name thread-name)))


(defun main (&rest argv)
  (declare (ignorable argv))
  (sb-thread:join-thread 
    (run-server-in-thread "0.0.0.0" 8882))
    :default nil)

;;; vim: set ft=lisp lisp: