;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: telnet-server.lisp,v 1.6 2003/07/09 19:19:19 kevin Exp $
+;;;; $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
;;;;
(defclass telnetd ()
((listener :initarg :listener :accessor listener
- :initform nil)
- (users :initarg :users :accessor users
- :initform nil)
- (announce :initarg :announce :accessor announce
- :initform nil)))
+ :initform nil)))
(defun start-telnet-server (&key (port +default-telnet-server-port+)
- announce
- users)
- (let ((telnetd
- (make-instance 'telnetd
- :users users
- :listener
- (make-instance 'listener :port 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 t))))
- telnetd))
+ :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))
+ (format conn "~A~%" announce)
+ (force-output conn))
(when users
(let (user-name password)
- (format conn "user: ")
- (setq user-name (read-line conn))
+ (format conn "login: ")
+ (force-output conn)
+ (setq user-name (read-telnet-line conn))
(format conn "password: ")
- (setq password (read-line conn))
- (unless (and (string= user (car users))
- (string= password (cdr users)))
+ (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
+ ;;#+allegro
+ #+ignore
(tpl::start-interactive-top-level
conn
#'tpl::top-level-read-eval-print-loop
nil)
- #-allegro
+ #+sbcl
+ ;; FIXME -- use aclrepl
+ (telnet-on-stream conn)
+ ;;#-(or sbcl allegro)
(telnet-on-stream conn)
)
(defvar *telnet-password* "")
(defun telnet-on-stream (stream)
- (print-prompt stream)
- (loop for line = (read-telnet-line stream)
- while line
- do
- (ignore-errors
- (format stream "~S" (eval (read-from-string line))))
- (force-output stream)
- (print-prompt 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))))))