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.7 2003/07/09 22:12:52 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 (defconstant +default-telnet-server-port+ 4000)
24 ((listener :initarg :listener :accessor listener
27 (defun start-telnet-server (&key (port +default-telnet-server-port+)
29 (let ((listener (make-instance 'listener :port port
31 :function 'telnet-worker
32 :function-args (list users announce)
36 (init/listener listener :start)))
39 (defun stop-telnet-server (listener)
40 (init/listener listener :stop))
42 (defun user-authenticated (user-name password users)
43 (some #'(lambda (user-pass)
44 (and (string= user-name (car user-pass))
45 (string= password (cdr user-pass))))
48 (defun telnet-worker (conn users announce)
50 (format conn "~A~%" announce)
53 (let (user-name password)
54 (format conn "login: ")
56 (setq user-name (read-telnet-line conn))
57 (format conn "password: ")
59 (setq password (read-telnet-line conn))
60 (unless (user-authenticated user-name password users)
61 (format conn "Invalid login~%")
63 (return-from telnet-worker))))
66 (tpl::start-interactive-top-level
68 #'tpl::top-level-read-eval-print-loop
71 ;; FIXME -- use aclrepl
72 (telnet-on-stream conn)
74 (telnet-on-stream conn)
77 (defun read-telnet-line (stream)
78 (string-right-trim-one-char #\return
79 (read-line stream nil nil)))
81 (defun print-prompt (stream)
82 (format stream "~&~A> " (package-name *package*))
83 (force-output stream))
85 (defvar *telnet-password* "")
87 (defun telnet-on-stream (stream)
88 (let ((*standard-input* stream)
89 (*standard-output* stream)
90 (*terminal-io* stream)
94 (let ((form (read stream)))
96 (format stream "~S~%" (eval form))))))