-#+lispworks
-(defun make-telnet-stream (handle)
- (let ((stream (make-instance 'comm:socket-stream
- :socket handle
- :direction :io
- :element-type
- 'base-char)))
- (mp:process-run-function
- (format nil "telnet-session ~D" handle)
- '()
- 'telnet-on-stream stream)))
+(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)
+ )