iolib-test-case.lisp

(defpackage #:iolib-test-case
  (:use #:cl)
  (:use #:iolib))

(in-package :iolib-test-case)

;; The special variable used to hold the client socket for the thread
;; managing it.
(defvar *ex5-tls-client* nil)

;; The actual function which speaks to the client.
(defun str-ex5-echo (client)
  (let ((done nil))
    (loop until done
          do
          (let ((line (read-line client)))
            (format t "Read line from ~A~%" line)
            (format client "~A~%" line)
            (finish-output client)
            (format t "Wrote line to ~A~%" line)
            (when (string= line "quit")
              (setf done t))
            t))))

;; The thread which handles the client connection.
(defun process-ex5-client-thread ()
  (declare (ignorable *ex5-tls-client*))
  (unwind-protect
    (format t "A thread is handling the connection!~%")
    (handler-case
     ;;  perform the actual echoing algorithm
     (str-ex5-echo *ex5-tls-client*)
     (socket-connection-reset-error () (format t "Client: connection reset by peer.~%"))
     (end-of-file () (format t "Client closed connection for a read.~%")
                  t)
     (hangup () (format t "Client closed connection for a write.~%")
             t))
    (format t "Closing connection to!~%")
    (close *ex5-tls-client*)
    t))

(defun run-ex5-server-helper (socket-path)
  (with-open-socket
      (server :connect :passive
              :address-family :local
              :type :stream
              :external-format '(:utf-8 :eol-style :crlf)
              :reuse-address t
              :local-filename socket-path)

    (format t "Created socket: ~A[fd=~A]~%" server (socket-os-fd server))
    (listen-on server :backlog 5)
    (unwind-protect   
        (loop
         (format t "Waiting to accept a connection...~%")
         (finish-output)
         (let* ((client (accept-connection server :wait t))
                (bordeaux-threads:*default-special-bindings*
                 (acons '*ex5-tls-client* client
                        bordeaux-threads:*default-special-bindings*)))
           (when client
             (bordeaux-threads:make-thread #'process-ex5-client-thread
                                           :name "process-ex5-client-thread"))))
      (format t "Destroying any active client threads....~%")
      (mapc #'(lambda (thr)
                (when (and (bordeaux-threads:thread-alive-p thr)
                           (string-equal "process-ex5-client-thread"
                                         (bordeaux-threads:thread-name thr)))
                  (format t "Destroying: ~A~%" thr)
                  (ignore-errors
                    (bordeaux-threads:destroy-thread thr))))
            (bordeaux-threads:all-threads)))))

;; This just checks for some error conditions so we can print out a nice
;; message about it.
(defun run-ex5-server (socket-path)
  (handler-case
      (run-ex5-server-helper socket-path)
    (socket-address-in-use-error ()
      (format t "Bind: Address already in use, forget :reuse-addr t?")))
  (finish-output))

;;; client

;; This will be an instance of the multiplexer.
(defvar *ex5a-event-base*)

(defun run-ex5a-client-helper (socket-path)
  (let ((socket (make-socket :connect :active
                             :address-family :local
                             :type :stream
                             :external-format '(:utf-8 :eol-style :crlf)
                             :remote-filename socket-path)))
    (unwind-protect
        (progn
          ;; set up the handler for read
          (set-io-handler *ex5a-event-base*
                          (socket-os-fd socket)
                          :read
                          (make-ex5a-str-cli-read
                           socket
                           (make-ex5a-client-disconnector socket)))

          ;; instead of setting up a write handler, write directly to
          ;; the socket and force the output, as in death/dbus
          (write-line "." socket)
          (force-output socket)
          (write-line "." socket) ; we should now expect to get two dots back
          (force-output socket)

          ;; death/dbus doesn't actually write twice, but, it does
          ;; receive multiple times due to signal messages as well as
          ;; method returns arriving on the bus
          
          (handler-case
           (progn
             ;; the dbus lib sets up a loop, but this is enough for
             ;; the purpose of demonstration
             (event-dispatch *ex5a-event-base* :one-shot t) ; collect the first dot, then the second
             (event-dispatch *ex5a-event-base* :one-shot t))           

           ;; We'll notify the user of the client if a handler missed
           ;; catching common conditions.
           (hangup ()
                   (format t "Uncaught hangup. Server closed connection on write!%"))
           (end-of-file ()
                        (format t "Uncaught end-of-file. Server closed connection on read!%"))))
      (close socket))))

(defun make-ex5a-str-cli-read (socket disconnector)
  ;; When this next function gets called it is because the event dispatcher
  ;; knows the socket from the server is readable.
  (lambda (fd event exception)
    ;; get a line from the server, and send it to *standard-output*
    (handler-case
     ;; If we send "quit" to the server, it will close its connection to
     ;; us and we'll notice that with an end-of-file.
     (let ((line (read-line socket)))
       (format t "~A" line)
       (finish-output))

     (end-of-file () (funcall disconnector :close)))))

(defun make-ex5a-client-disconnector (socket)
  ;; as in death/dbus, this remove-fd-handlers is never called
  (lambda (&rest events)
    (let ((fd (socket-os-fd socket)))
      (if (not (intersection '(:read :write :error) events))
          (remove-fd-handlers *ex5a-event-base* fd :read t :write t :error t)
        (progn
          (when (member :read events)
            (remove-fd-handlers *ex5a-event-base* fd :read t))
          (when (member :write events)
            (remove-fd-handlers *ex5a-event-base* fd :write t))
          (when (member :error events)
            (remove-fd-handlers *ex5a-event-base* fd :error t)))))
    ;; and finally if were asked to close the socket, we do so here
    (when (member :close events)
      (close socket :abort t))))

;; This is the entry point for this example.
(defun run-ex5a-client (socket-path)
  (let ((*ex5a-event-base* nil))
    (unwind-protect
        (progn
          ;; death/dbus does not use exit-when-empty, though making it
          ;; so does not prevent the problem
          (setf *ex5a-event-base*
                (make-instance 'iomux:event-base))
          (handler-case
           (run-ex5a-client-helper socket-path)

           ;; handle a commonly signaled error...
           (socket-connection-refused-error ()
                                            (format t "Connection refused to. Maybe the server isn't running?~%"))))
      (when *ex5a-event-base*
        (close *ex5a-event-base*))
      ;; (format t "Client Exited.~%")
      (finish-output))))

;;; usage and commentary:

;; The client sequence is as follows:
;; 1. make an event base
;; 2. make an active local stream socket
;; 3. set a read handler on the event base to monitor the socket fd
;; 4. write onto the socket twice, forcing output each time
;; 5. run (event-dispatch one-shot t) twice, hoping to read back both dots
;;    (the read handler reads one line at a time)
;; 6. close the socket

;; The server is the unmodified ex5 echo server

(defun run-test-case (socket-path)
  ;; expect this to hang the thread after a short time

  (unwind-protect
      (progn 
        ;; start the server (may have to delete old socket file first)
        (bordeaux-threads:make-thread (lambda () (run-ex5-server socket-path)) :name "ex5-server-thread")

        ;; kludge to wait for the server
        (iolib.syscalls:usleep 500000)
        
        (loop (run-ex5a-client socket-path) (iolib.syscalls:usleep 500000)))
    (ignore-errors (bordeaux-threads:destroy-thread
                    (find-if (lambda (thr) (string= (bordeaux-threads:thread-name thr) "ex5-server-thread"))
                             (bordeaux-threads:all-threads))))))