examples/ex1-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 example implements an IPV4 TCP blocking i/o iterative date
   7 ;;;; server which handles one connection and then exits.
   8
   9 ;;;; This example is written in a non-conventional style resembling
  10 ;;;; that of C. Later programs will deviate from this style and move
  11 ;;;; more towards the Common Lisp style.
  12
  13 ;;;; This server as it stands has more than a few problems especially
  14 ;;;; due to not cleaning up the server socket if the code exits
  15 ;;;; poorly, suppose returning to the toplevel when you break into the
  16 ;;;; debugger while the server is running.
  17
  18 ;; ex-0b
  19 (defun run-ex1-server (&key (port *port*))
  20   ;; Create a passive (server) TCP socket under IPV4 Sockets meant to
  21   ;; be listened upon *must* be created passively. This is a minor
  22   ;; deviation from the Berkeley socket interface.
  23   (let ((socket
  24          (make-socket
  25           :connect :passive
  26           :address-family :internet
  27           :type :stream
  28           :external-format '(:utf-8 :eol-style :crlf)
  29           :ipv6 nil)))
  30     (format t "Created socket: ~A[fd=~A]~%" socket (socket-os-fd socket))
  31     ;; ex-0e
  32
  33     ;; ex-1b
  34     ;; Bind the socket to all interfaces with specified port.
  35     (bind-address socket
  36                   +ipv4-unspecified+ ; which means INADDR_ANY or 0.0.0.0
  37                   :port port
  38                   :reuse-addr t)
  39     (format t "Bound socket: ~A~%" socket)
  40     ;; ex-1e
  41
  42     ;; ex-2b
  43     ;; Convert the sockxet to a listening socket
  44     (listen-on socket :backlog 5)
  45     (format t "Listening on socket bound to: ~A:~A~%"
  46             (local-host socket) (local-port socket))
  47     ;; ex-2e
  48
  49     ;; ex-3b
  50     ;; Block on accepting a connection
  51     (format t "Waiting to accept a connection...~%")
  52     (let ((client (accept-connection socket :wait t)))
  53       (when client
  54         ;; When we get a new connection, show who it is from.
  55         (multiple-value-bind (who rport)
  56             (remote-name client)
  57           (format t "Got a connection from ~A:~A!~%" who rport))
  58         ;; ex-3e
  59
  60         ;; ex-4b
  61         ;; Since we're using a internet TCP stream, we can use format
  62         ;; with it. However, we should be sure to call finish-output on
  63         ;; the socket in order that all the data is sent. Also, this is
  64         ;; a blocking write.
  65         (multiple-value-bind (s m h d mon y)
  66             (get-decoded-time)
  67           (format t "Sending the time...")
  68           (format client "~A/~A/~A ~A:~A:~A~%" mon d y h m s)
  69           (finish-output client))
  70         ;; ex-4e
  71
  72         ;; ex-5b
  73         ;; We're done talking to the client.
  74         (close client)
  75         (format t "Sent!~%"))
  76       ;; ex-5e
  77
  78       ;; ex-6b
  79       ;; We're done with the server socket too.
  80       (close socket)
  81       (finish-output)
  82       t)))
  83 ;; ex-6e
  84