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.5 2002/10/16 03:45:34 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 Lisp Lesser GNU Public License
16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
17 ;;;; *************************************************************************
21 (defvar *default-telnet-server-port* 4000)
24 (defun start-telnet-server (&optional (port *default-telnet-server-port*))
25 (let ((passive (socket:make-socket :connect :passive
29 (mp:process-run-function
34 (let ((con (socket:accept-connection pass)))
35 (mp:process-run-function
36 (format nil "tel~d" (incf count))
39 (tpl::start-interactive-top-level
41 #'tpl::top-level-read-eval-print-loop
43 (ignore-errors (close con :abort t))))
48 (eval-when (:compile-toplevel :load-toplevel :execute)
52 (defun sts2 (&optional (port *default-telnet-server-port*))
53 (comm:start-up-server :service port :function 'comm::make-stream-and-run-listener))
56 (defun make-telnet-stream (handle)
57 (let ((stream (make-instance 'comm:socket-stream
62 (mp:process-run-function
63 (format nil "telnet-session ~D" handle)
65 'telnet-on-stream stream)))
67 (defun read-telnet-line (stream)
68 (string-right-trim '(#\newline #\linefeed #\return #\space #\tab #\backspace) (read-line stream nil nil)))
70 (defun print-prompt (stream)
71 (format stream "~&~A> " (package-name *package*))
72 (force-output stream))
74 (defvar *telnet-password* "")
76 (defun telnet-on-stream (stream)
79 (let ((password (read-telnet-line stream)))
80 (unless (and (stringp password)
81 (string= password *telnet-password*))
82 (return-from telnet-on-stream)))
84 (loop for line = (read-telnet-line stream)
88 (format stream "~S" (eval (read-from-string line))))
90 (print-prompt stream)))
94 (defun start-telnet-server (&optional (port *default-telnet-server-port*))
95 (comm:start-up-server :service port
96 :process-name (format nil "telnet-~d" port)
97 :function 'kmrcl::make-telnet-stream))