protocols/echo/echo.lisp

   1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; echo.lisp --- Server and client implementations of the ECHO protocol.
   4 ;;;
   5 ;;; Copyright (C) 2007, Luis Oliveira  <loliveira@common-lisp.net>
   6 ;;;
   7 ;;; Permission is hereby granted, free of charge, to any person
   8 ;;; obtaining a copy of this software and associated documentation
   9 ;;; files (the "Software"), to deal in the Software without
  10 ;;; restriction, including without limitation the rights to use, copy,
  11 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
  12 ;;; of the Software, and to permit persons to whom the Software is
  13 ;;; furnished to do so, subject to the following conditions:
  14 ;;;
  15 ;;; The above copyright notice and this permission notice shall be
  16 ;;; included in all copies or substantial portions of the Software.
  17 ;;;
  18 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  19 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  20 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  21 ;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
  22 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
  23 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  24 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  25 ;;; DEALINGS IN THE SOFTWARE.
  26
  27 (in-package #:cl-user)
  28
  29 (defpackage #:net.echo
  30   (:use #:cl #:io.event)
  31   (:export #:echo-server))
  32
  33 (in-package #:net.echo)
  34
  35 ;;;; Echo Server
  36
  37 (defclass echo-server (tcp-server udp-server)
  38   ()
  39   (:default-initargs :protocol 'echo-server-protocol
  40                      :default-local-port 7)
  41   (:documentation "ECHO server."))
  42
  43 (defclass echo-server-protocol (stream-protocol datagram-protocol)
  44   ()
  45   (:documentation "Server implementation of the ECHO protocol. (TCP and UDP)"))
  46
  47 (defmethod on-data-received ((con echo-server-protocol) transport data)
  48   (write-data data transport))
  49
  50 (defmethod on-datagram-received ((con echo-server-protocol)
  51                                  transport datagram address port)
  52   (write-datagram datagram address port transport))
  53
  54 ;;;; Echo Client
  55
  56 (defclass echo-client (tcp-client)
  57   ()
  58   (:default-initargs :protocol 'echo-client-protocol
  59                      :default-remote-port 7)
  60   (:documentation "ECHO client."))
  61
  62 (defvar *default-echo-client* (make-instance 'echo-client))
  63
  64 (defclass echo-client-protocol (stream-protocol deferred)
  65   ((request :initarg :request :accessor request-of))
  66   (:documentation "Client implementation of the ECHO protocol. (TCP and UDP)"))
  67
  68 (defmethod on-connection-made ((con echo-client-protocol) transport)
  69   (write-data (request-of con) transport))
  70
  71 (defmethod on-data-received ((con echo-client-protocol) transport data)
  72   (close-transport transport)
  73   (funcall (result-callback-of con) data))
  74
  75 (defmethod on-connection-lost ((con echo-client) transport reason)
  76   (funcall (result-callback-of con) reason))
  77
  78 (defun get-echo (data host &optional (port 7) (client *default-echo-client*))
  79   (with-deferred-result ()
  80     (let ((protocol (make-instance 'echo-client-protocol :request data)))
  81       (add-connection client protocol :remote-host host :remote-port port)
  82       protocol)))