;; Example code for using the Chain of Responsibility pattern to
;; implement a dynamically extensible message broker.

(in-package :common-lisp-user)

(require :sb-bsd-sockets)

(defpackage :org.softwarematters.message-broker
  (:use :common-lisp
        :sb-thread
        :sb-bsd-sockets
        :sb-unix
        :sb-ext)
  (:export :make-message-broker
           :add-handler
           :run))

(in-package :org.softwarematters.message-broker)

(defparameter *default-message-broker-port* 8079
  "The default port on which instances of message-broker listen.")

(defclass message-broker ()
  ((port :initarg :port
         :accessor message-broker-port
         :initform *default-message-broker-port*)
   (handlers :accessor message-broker-handlers
             :initform nil))
  (:documentation "The message broker server."))

(defun make-message-broker (&optional (port *default-message-broker-port*))
  "Constructor for message-broker."
  (make-instance 'message-broker :port port))

;; Worry about style warning of implicitly creating generic?
(defmethod add-handler ((broker message-broker) handler)
  "Add a message handling function to the broker."
  (push handler (message-broker-handlers broker)))

(defmethod handle-client ((broker message-broker)
                          (socket inet-socket))
  "Handle a client request.  This function is used only internally by
  instances of message-broker."
  (let* ((handlers (message-broker-handlers broker))
         (client-stream (socket-make-stream socket
                                            :input t
                                            :output t
                                            :element-type 'character
                                            :buffering :none))
         (message (read-line client-stream)))
    (dolist (handler handlers
             (write-line "Unknown message type." client-stream))
      (when (funcall handler message client-stream broker)
        (return t)))
    (socket-close socket)))

(defmacro with-socket (socket &body body)
  "Create and close a socket around the body."
  `(let ((,socket (make-instance 'inet-socket
                                 :type :stream
                                 :protocol :tcp)))
    (unwind-protect (progn ,@body)
      (socket-close ,socket))))

(defparameter *default-server-backlog* 16
  "The default number of simultaneous connections to the server.")

(defmethod run ((broker message-broker))
  "Run the message broker, listening on the specified port and dispatching
  client requests.
  Thanks to Christophe Rhodes for help debugging this."
  (with-socket server-socket
    (setf (sockopt-reuse-address server-socket) t)
    (socket-bind server-socket
                 sb-bsd-sockets::inet-address-any
                 (message-broker-port broker))
    (socket-listen server-socket *default-server-backlog*)
    (write-line "Message broker running.")
    (do ((client-socket
          (socket-accept server-socket)
          (socket-accept server-socket)))  ; ignore peer value
        (nil)  ; infinite loop
      (let ((client-socket client-socket))
        (make-thread (lambda () (handle-client broker client-socket)))))))

(defun echo-message-handler (message stream broker)
  "A message handling function that echoes back the message."
  (declare (muffle-conditions style-warning))  ; broker deliberaty not used
  (when (and (> (length message) 4)
             (string= message "ECHO" :start1 0 :end1 4))
    (write-line message stream :start 5)))

(defun rot13 (string)
  "Apply the default Usenet encryption to the string.
  This implementation is based on a discussion on comp.lang.lisp."
  (labels ((rotate-char (char base-char &optional (index 13) (alphabet 26))
	     (let ((code (char-code char))
		   (base-code (char-code base-char)))
	       (code-char (+ base-code
			     (mod (+ index (- code base-code)) alphabet)))))
	   (rot13-char (char)
	     (cond ((char<= #\a char #\z) (rotate-char char #\a))
		   ((char<= #\A char #\Z) (rotate-char char #\A))
		   (t char))))
    (map 'string #'rot13-char string)))

(defun rot13-message-handler (message stream broker)
  "A message handling function that encrypts the message."
  (declare (muffle-conditions style-warning))  ; broker deliberaty not used
  (when (and (> (length message) 13)
	     (string= message "ENCRYPT.ROT13" :start1 0 :end1 13))
    (write-line (rot13 message) stream :start 14)))

;; Kick it off.
(defvar *message-broker* (make-message-broker))
(add-handler *message-broker* #'echo-message-handler)
(make-thread (lambda () (run *message-broker*)))