An example using telnet for remote access to a running application

In this example, an Allegro CL application is running on one machine (machine foo) and an operator, using machine bar, wishes to access the application for some reason. (The reason could be to check the status, to perform remote debugging, or to provide input.) Assuming the application on foo has started an telnet server process using the socket interface, the operator on bar can use telnet to connect to the application, issue forms to be evaluated, and see the value returned by the forms evaluated.

Actually, calling process started in the application a telnet server process is a bit of an exaggeration. The server code running in the application does not implement the complete telnet protocol as described in RFC854 (it essentially just accepts and transmits standard ASCII characters, but those are sufficient for this purpose). We hope to show how to use stream encapsulation to allow scanning for and processing of telnet escape characters in a later Tech Corner entry.

The following table shows the telnet connection in action. The code which implements the connection follows the table. Note that we have taken care to ensure that the command to exit the telnet connection is not interpreted by the application as a request that the application should exit. We do this by fwrapping the function excl:exit to identify calls to excl:exit from telnet and short circuit them.

In the table, action on machine foo is in the left column (for purposes of the example, we show input as if by a user, but in an actual application, loading the telnet-server code and starting the telnet-server process would typically be done as part of the application startup). Action on machine bar is in the right column. Input is in bold.

Application running on the foo machine Operator using the bar machine

foo% mlisp-6.1

International Allegro CL Enterprise Edition
6.1 [Linux (x86)] (Oct 11, 2001 18:14)
;; Current reader case mode: :case-sensitive-lower
cl-user(1): :cl
;;; Compiling file
;;; Writing fasl file telnetter.fasl
;;; Fasl write complete
; Fast loading /usr/apps/telnetter.fasl
cl-user(2): (start-telnet-server :port 9999)
#<multiprocessing:process telnet server @ #x7152d93a>
cl-user(3): :proc
P Dis Sec  dSec  Pri  State   Process Name, ...
*   1   0   0.0    0 waiting  telnet server, ...
*   2   0   0.0    0 runnable Initial Lisp Listener
cl-user(4): (setq *foo* 10)

bar% telnet foo 9999
Connected to foo.
Escape character is '^]'.
WARNING: do not use
:exit or (exit).  Use (quit) to quit.

; Fast loading from bundle code/acldns.fasl.
telnet server: new connection from

cl-user(1): *foo*
cl-user(2): (exit)  ;; note: should have used (quit)
Use (quit) instead of exit. ;; response notes proper usage

cl-user(3): (quit)
Connection closed by foreign host.

telnet server: closing connection from

cl-user(5): (exit)
; killing "Domain Name Server Client"
; killing "telnet server"
; killing "Initial Lisp Listener"
; Exiting Lisp

Again, machine foo is running the example application. We start the telnet server and that process waits for a connection. When it gets a connection, it starts a listener, or top-level, on the socket.

On machine bar, the operator uses the UNIX telnet command to communicate with the Lisp application. Note that the operator mistakenly tries to use (exit) (presumably some time after the instruction not to) to end the connection. If the application had interpreted this as as a standard Lisp form to evaluate, it might have caused the application to exit (a very bad thing if unintended). However, exit has been protected to prevent this, and a new function, quit has been defined to end the connection. (If you wanted the operator to be able to exit the application, it is easy to provide functionality to do it.)

This example works in Allegro CL 6.0 and 6.1 (it uses def-fwrapper which was introduced in Allegro CL 6.0).

Here is the source code.

;; Source code for telnet-server example
(in-package :user)
;; A telnet server for Allegro CL.
;; This source code is in the public domain.

(defun start-telnet-server (&key (port 9999))
  (mp:process-run-function "telnet server" 'start-telnet-server-1 port))

(defun start-telnet-server-1 (port)
    (let ((socket (socket:make-socket :connect :passive :local-port port
                                      :reuse-address t)))
            (let ((connection 
                    (ignore-errors (socket:accept-connection socket)))
                   ;;  The ignore-errors protects against the rare
                   ;;  occurrence of accept-connection signaling
                   ;;  an error (usually Connection Reset by Peer)
              (when connection
                       (setq from (or (socket:ipaddr-to-hostname
                                       (socket:remote-host connection))
                                       (socket:remote-host connection))))
                       (format t "telnet server: new connection from ~a~%"
                       (format connection "
WARNING: do not use :exit or (exit).  Use ~s to quit."
                       (force-output connection)
                           "telnet session"
                         'start-telnet-session connection from))
                   (error ()
                     (ignore-errors (close connection)))))))
        (ignore-errors (close socket))))))

(defvar *in-telnet-session* nil)

(defun start-telnet-session (s from)
      (catch 'end-telnet-session
        (let ((*in-telnet-session* t))
           s 'tpl:top-level-read-eval-print-loop nil)))
    (ignore-errors (close s)))
  (format t "telnet server: closing connection from ~a~%" from))

(defun quit ()
  (throw 'end-telnet-session nil))

(defvar *exit-wrapped* nil)

(when (not *exit-wrapped*)
  (flet ((msg ()
           (format t "Use ~s instead of exit.~%"
    (def-fwrapper exit-wrapper (&optional status &rest args)
      (declare (ignore args))
      (if* *in-telnet-session*
         then (msg)
         else (call-next-fwrapper)))

    (fwrap 'excl:exit :telnet-server 'exit-wrapper)
    (fwrap 'tpl::exit-command :telnet-server 'exit-wrapper))) 

;;  ----------------End of source code-----------------

Return to Tech Corner page.

Copyright © 2020 Franz Inc., All Rights Reserved | Privacy Statement Twitter Google+