examples/ex4-server.lisp

   1 (in-package :iolib.examples)
   2
   3 ;;;; This file was originally written by Peter Keller (psilord@cs.wisc.edu)
   4 ;;;; and this code is released under the same license as IOLib.
   5
   6 ;;;; This is a concurrent daytime server made with threads instead of
   7 ;;;; forked processes.  The special variable *ex4-tlss-client* is a
   8 ;;;; global variable which is rebound to be the client socket in the
   9 ;;;; context of the newly created thread.
  10
  11 ;; ex-0b
  12 ;; This variable is the means by which we transmit the client socket from
  13 ;; the initial thread to the particular thread which will handle that client.
  14 (defvar *ex4-tls-client* nil)
  15 ;; ex-0e
  16
  17 ;; ex-1b
  18 (defun run-ex4-server-helper (port)
  19   (with-open-socket
  20       (server :connect :passive
  21               :address-family :internet
  22               :type :stream
  23               :ipv6 nil
  24               :external-format '(:utf-8 :eol-style :crlf))
  25
  26     (format t "Created socket: ~A[fd=~A]~%" server (socket-os-fd server))
  27
  28     ;; Bind the socket to all interfaces with specified port.
  29     (bind-address server +ipv4-unspecified+ :port port :reuse-addr t)
  30     (format t "Bound socket: ~A~%" server)
  31
  32     ;; start listening on the server socket
  33     (listen-on server :backlog 5)
  34     (format t "Listening on socket bound to: ~A:~A~%"
  35             (local-host server)
  36             (local-port server))
  37     ;; ex-1e
  38
  39     ;; ex-2b
  40     ;; Here we introduce unwind-protect to ensure we properly clean up
  41     ;; any leftover threads when the server exits for whatever reason.
  42     ;; keep accepting connections forever, but if this exits for
  43     ;; whatever reason ensure to destroy any remaining running
  44     ;; threads.
  45     (unwind-protect
  46          (loop                         ; keep accepting connections...
  47             (format t "Waiting to accept a connection...~%")
  48             (finish-output)
  49             (let* ((client (accept-connection server :wait t))
  50                    ;; set up the special variable according to the
  51                    ;; needs of the Bordeaux Threads package to pass in
  52                    ;; the client socket we accepted to the about to be
  53                    ;; created thread.  *default-special-bindings* must
  54                    ;; not be modified, so here we just push a new scope
  55                    ;; onto it.
  56                    (*default-special-bindings*
  57                     (acons '*ex4-tls-client* client
  58                            *default-special-bindings*)))
  59
  60               ;; ...and handle the connection!
  61               (when client
  62                 (make-thread #'process-ex4-client-thread
  63                              :name 'process-ex4-client-thread))))
  64
  65       ;; Clean up form for uw-p.
  66       ;; Clean up all of the client threads when done.
  67       ;; This code is here for the benefit of the REPL because it is
  68       ;; intended that this tutorial be worked interactively. In a real
  69       ;; threaded server, the server would just exit--destroying the
  70       ;; server process, and causing all threads to exit which then notifies
  71       ;; the clients.
  72       (format t "Destroying any active client threads....~%")
  73       (mapc #'(lambda (thr)
  74                 (when (and (thread-alive-p thr)
  75                            (string-equal "process-ex4-client-thread"
  76                                          (thread-name thr)))
  77                   (format t "Destroying: ~A~%" thr)
  78                   ;; Ignore any conditions which might arise if a
  79                   ;; thread happened to finish in the race between
  80                   ;; liveness testing and destroying.
  81                   (ignore-errors
  82                     (destroy-thread thr))))
  83             (all-threads)))))
  84 ;; ex-2e
  85
  86 ;; ex-3b
  87 ;;; The thread which handles the client connection.
  88 (defun process-ex4-client-thread ()
  89   ;; This variable is set outside of the context of this thread.
  90   (declare (ignorable *ex4-tls-client*))
  91   ;; ex-3e
  92   ;; ex-4b
  93   ;; We ensure the client socket is always closed!
  94   (unwind-protect
  95        (multiple-value-bind (who port)
  96            (remote-name *ex4-tls-client*)
  97          (format t "A thread is handling the connection from ~A:~A!~%"
  98                  who port)
  99
 100          ;; Prepare the time and send it to the client.
 101          (multiple-value-bind (s m h d mon y)
 102              (get-decoded-time)
 103            (handler-case
 104                (progn
 105                  (format t "Sending the time to ~A:~A..." who port)
 106                  (format *ex4-tls-client*
 107                          "~A/~A/~A ~A:~A:~A~%"
 108                          mon d y h m s)
 109                  (finish-output *ex4-tls-client*)
 110                  (format t "Sent!~%"))
 111
 112              (socket-connection-reset-error ()
 113                (format t "Client ~A:~A reset the connection!~%" who port))
 114
 115              (hangup ()
 116                (format t "Client ~A:~A closed connection.~%" who port)))))
 117
 118     ;; Cleanup form for uw-p.
 119     (format t "Closing connection to ~A:~A!~%"
 120             (remote-host *ex4-tls-client*) (remote-port *ex4-tls-client*))
 121     (close *ex4-tls-client*)))
 122 ;; ex-4e
 123
 124
 125 ;; ex-5b
 126 ;; The entry point into this example.
 127 (defun run-ex4-server (&key (port *port*))
 128   (handler-case
 129
 130       (run-ex4-server-helper port)
 131
 132     ;; handle some common signals
 133     (socket-address-in-use-error ()
 134       (format t "Bind: Address already in use, forget :reuse-addr t?")))
 135
 136   (finish-output))
 137 ;; ex-5e
 138
 139