examples/ex5-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 ;;;; Building on ex4-server.lisp, this follows a similar design except
   7 ;;;; it is a threaded line echo server. Each thread handles one client and
   8 ;;;; simply echos the lines the client send back. Each thread performs
   9 ;;;; blocking i/o, but multiple threads can function at the same time.
  10
  11 ;; ex-0b
  12 ;; The special variable used to hold the client socket for the thread
  13 ;; managing it.
  14 (defvar *ex5-tls-client* nil)
  15 ;; ex-0e
  16
  17 ;; Set up a server and handle the connections.
  18 ;; ex-1b
  19 (defun run-ex5-server-helper (port)
  20   (with-open-socket
  21       (server :connect :passive
  22               :address-family :internet
  23               :type :stream
  24               :ipv6 nil
  25               :external-format '(:utf-8 :eol-style :crlf))
  26
  27     (format t "Created socket: ~A[fd=~A]~%" server (socket-os-fd server))
  28
  29     ;; Bind the socket to all interfaces with specified port.
  30     (bind-address server +ipv4-unspecified+ :port port :reuse-addr t)
  31     (format t "Bound socket: ~A~%" server)
  32
  33     ;; start listening on the server socket
  34     (listen-on server :backlog 5)
  35     (format t "Listening on socket bound to: ~A:~A~%"
  36             (local-host server)
  37             (local-port server))
  38     ;; ex-1e
  39
  40     ;; ex-2b
  41     ;; keep accepting connections forever, but if this exits for whatever
  42     ;; reason ensure to destroy any remaining running threads.
  43     (unwind-protect
  44          (loop
  45             (format t "Waiting to accept a connection...~%")
  46             (finish-output)
  47             (let* ((client (accept-connection server :wait t))
  48                    ;; set up the special variable to store the client
  49                    ;; we accepted...
  50                    (*default-special-bindings*
  51                     (acons '*ex5-tls-client* client
  52                            *default-special-bindings*)))
  53
  54               ;; ...and handle the connection!
  55               (when client
  56                 (make-thread #'process-ex5-client-thread
  57                              :name 'process-ex5-client-thread))))
  58       ;; ex-2e
  59
  60       ;; ex-3b
  61       ;; Clean up form for uw-p.
  62       ;; Clean up all of the client threads when done.
  63       ;; This code is here for the benefit of the REPL because it is
  64       ;; intended that this tutorial be worked interactively. In a real
  65       ;; threaded server, the server would just exit--destroying the
  66       ;; server process, and causing all threads to exit which then notifies
  67       ;; the clients.
  68       (format t "Destroying any active client threads....~%")
  69       (mapc #'(lambda (thr)
  70                 (when (and (thread-alive-p thr)
  71                            (string-equal "process-ex5-client-thread"
  72                                          (thread-name thr)))
  73                   (format t "Destroying: ~A~%" thr)
  74                   ;; Ignore any conditions which might arise if a
  75                   ;; thread happened to finish in the race between
  76                   ;; liveness testing and destroying.
  77                   (ignore-errors
  78                     (destroy-thread thr))))
  79             (all-threads)))))
  80 ;; ex-3e
  81
  82 ;; ex-4b
  83 ;; The thread which handles the client connection.
  84 (defun process-ex5-client-thread ()
  85   ;; declared ignorable because this dynamic variable is bound outside
  86   ;; of the context of this function.
  87   (declare (ignorable *ex5-tls-client*))
  88   ;; no matter how we get out of the client processing loop, we always
  89   ;; close the connection.
  90   (unwind-protect
  91        (multiple-value-bind (who port)
  92            (remote-name *ex5-tls-client*)
  93          (format t "A thread is handling the connection from ~A:~A!~%"
  94                  who port)
  95
  96          (handler-case
  97              ;;  perform the actual echoing algorithm
  98              (str-ex5-echo *ex5-tls-client* who port)
  99
 100            (socket-connection-reset-error ()
 101              (format t "Client ~A:~A: connection reset by peer.~%"
 102                      who port))
 103
 104            (end-of-file ()
 105              (format t "Client ~A:~A closed connection for a read.~%"
 106                      who port)
 107              t)
 108
 109            (hangup ()
 110              (format t "Client ~A:~A closed connection for a write.~%"
 111                      who port)
 112              t)))
 113
 114     ;; cleanup form of the unwind-protect
 115     ;; We always close the connection to the client, even if this
 116     ;; thread gets destroyed (at least in SBCL this cleanup form gets
 117     ;; run when this thread is destroyed).
 118     (format t "Closing connection to ~A:~A!~%"
 119             (remote-host *ex5-tls-client*) (remote-port *ex5-tls-client*))
 120     (close *ex5-tls-client*)
 121     t))
 122 ;; ex-4e
 123
 124 ;; ex-5b
 125 ;; The actual function which speaks to the client.
 126 (defun str-ex5-echo (client who port)
 127   ;; here we let signaled conditions on the boundary conditions of the
 128   ;; client (meaning it closes its connection to us on either a read or
 129   ;; a write) bail us out of the infinite loop
 130   (let ((done nil))
 131     (loop until done
 132        do
 133        (let ((line (read-line client)))
 134          (format t "Read line from ~A:~A: ~A~%" who port line)
 135          (format client "~A~%" line)
 136          (finish-output client)
 137          (format t "Wrote line to ~A:~A: ~A~%" who port line)
 138
 139          ;; Exit the thread when the user requests it with 'quit'.
 140          ;; This forces a close to the client socket.
 141          (when (string= line "quit")
 142            (setf done t))
 143          t))))
 144 ;; ex-5e
 145
 146 ;; ex-6b
 147 ;; This just checks for some error conditions so we can print out a nice
 148 ;; message about it.
 149 (defun run-ex5-server (&key (port *port*))
 150   (handler-case
 151
 152       (run-ex5-server-helper port)
 153
 154     ;; handle some common conditions
 155     (socket-address-in-use-error ()
 156       (format t "Bind: Address already in use, forget :reuse-addr t?")))
 157
 158   (finish-output))
 159 ;; ex-6e
 160
 161