r5284: *** empty log message ***

[kmrcl.git] / telnet-server.lisp

diff --git a/telnet-server.lisp b/telnet-server.lisp
deleted file mode 100644 (file)
index 210943a..0000000
--- a/telnet-server.lisp
+++ /dev/null
@@ -1,96 +0,0 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          telnet-server.lisp
-;;;; Purpose:       A telnet server
-;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Apr 2000
-;;;;
-;;;; $Id: telnet-server.lisp,v 1.7 2003/07/09 22:12:52 kevin Exp $
-;;;;
-;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; KMRCL users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
-;;;; *************************************************************************
-
-(in-package :kmrcl)
-
-(defconstant +default-telnet-server-port+ 4000)
-
-(defclass telnetd ()
-  ((listener :initarg :listener :accessor listener
-            :initform nil)))
-
-(defun start-telnet-server (&key (port +default-telnet-server-port+)
-                           announce users)
-  (let ((listener (make-instance 'listener :port port
-                                :base-name "telnetd"                    
-                                :function 'telnet-worker
-                                :function-args (list users announce)
-                                :format :text
-                                :wait nil
-                                :catch-errors nil)))
-    (init/listener listener :start)))
-
-
-(defun stop-telnet-server (listener)
-  (init/listener listener :stop))
-
-(defun user-authenticated (user-name password users)
-  (some #'(lambda (user-pass)
-           (and (string= user-name (car user-pass))
-                (string= password (cdr user-pass))))
-       users))
-
-(defun telnet-worker (conn users announce)
-  (when announce
-    (format conn "~A~%" announce)
-    (force-output conn))
-  (when users
-    (let (user-name password)
-      (format conn "login: ")
-      (force-output conn)
-      (setq user-name (read-telnet-line conn))
-      (format conn "password: ")
-      (force-output conn)
-      (setq password (read-telnet-line conn))
-      (unless (user-authenticated user-name password users)
-       (format conn "Invalid login~%")
-       (force-output conn)
-       (return-from telnet-worker))))
-  ;;#+allegro
-  #+ignore
-  (tpl::start-interactive-top-level
-   conn
-   #'tpl::top-level-read-eval-print-loop
-   nil)
-  #+sbcl
-  ;; FIXME -- use aclrepl
-  (telnet-on-stream conn)
-  ;;#-(or sbcl allegro)
-  (telnet-on-stream conn)
-  )
-
-(defun read-telnet-line (stream)
-  (string-right-trim-one-char #\return
-                             (read-line stream nil nil)))
-
-(defun print-prompt (stream)
-  (format stream "~&~A> " (package-name *package*))
-  (force-output stream))
-
-(defvar *telnet-password* "")
-
-(defun telnet-on-stream (stream)
-  (let ((*standard-input* stream)
-       (*standard-output* stream)
-       (*terminal-io* stream)
-       (*debug-io* stream))
-    (loop
-     (print-prompt stream)
-     (let ((form (read stream)))
-       (fresh-line stream)
-       (format stream "~S~%" (eval form))))))