X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=telnet-server.lisp;h=210943a23c8eed2ea1f9d1e0199c5e0b57ab9960;hp=cf95ad403896f2fc1895d547898100cc67ff414e;hb=5559333472a7a87c0df192897037926a75985c9b;hpb=bf3d36016fc385a78d51d588dbb918599cfbc99a

diff --git a/telnet-server.lisp b/telnet-server.lisp
index cf95ad4..210943a 100644
--- a/telnet-server.lisp
+++ b/telnet-server.lisp
@@ -7,7 +7,7 @@
 ;;;; 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
 ;;;;
@@ -22,48 +22,55 @@
 
 (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)
   )
 
@@ -78,11 +85,12 @@
 (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))))))