1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: telnet-server.lisp
6 ;;;; Purpose: A telnet server
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Apr 2000
10 ;;;; $Id: telnet-server.lisp,v 1.2 2002/10/06 13:30:17 kevin Exp $
12 ;;;; This file, part of Kmrcl, is Copyright (c) 2002 by Kevin M. Rosenberg
14 ;;;; Kmrcl users are granted the rights to distribute and use this software
15 ;;;; as governed by the terms of the GNU General Public License.
16 ;;;; *************************************************************************
20 (defvar *default-telnet-server-port* 4000)
23 (defun start-telnet-server (&optional (port *default-telnet-server-port*))
24 (let ((passive (socket:make-socket :connect :passive
28 (mp:process-run-function
33 (let ((con (socket:accept-connection pass)))
34 (mp:process-run-function
35 (format nil "tel~d" (incf count))
38 (tpl::start-interactive-top-level
40 #'tpl::top-level-read-eval-print-loop
42 (ignore-errors (close con :abort t))))
47 (eval-when (:compile-toplevel :load-toplevel :execute)
51 (defun sts2 (&optional (port *default-telnet-server-port*))
52 (comm:start-up-server :service port :function 'comm::make-stream-and-run-listener))
55 (defun make-telnet-stream (handle)
56 (let ((stream (make-instance 'comm:socket-stream
61 (mp:process-run-function
62 (format nil "telnet-session ~D" handle)
64 'telnet-on-stream stream)))
66 (defun read-telnet-line (stream)
67 (string-right-trim '(#\newline #\linefeed #\return #\space #\tab #\backspace) (read-line stream nil nil)))
69 (defun print-prompt (stream)
70 (format stream "~&~A> " (package-name *package*))
71 (force-output stream))
73 (defvar *telnet-password* "ksec")
75 (defun telnet-on-stream (stream)
78 (let ((password (read-telnet-line stream)))
79 (unless (and (stringp password)
80 (string= password *telnet-password*))
81 (return-from telnet-on-stream)))
83 (loop for line = (read-telnet-line stream)
87 (format stream "~S" (eval (read-from-string line))))
89 (print-prompt stream)))
93 (defun start-telnet-server (&optional (port *default-telnet-server-port*))
94 (comm:start-up-server :service port
95 :process-name (format nil "telnet-~d" port)
96 :function 'gu::make-telnet-stream))