1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: A repl server
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Apr 2000
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-repl-server-port+ 4000)
24 ((listener :initarg :listener :accessor listener
27 (defun make-repl (&key (port +default-repl-server-port+)
28 announce user-checker remote-host-checker)
29 (make-instance 'listener
32 :function 'repl-worker
33 :function-args (list user-checker announce)
36 :remote-host-checker remote-host-checker
39 (defun init/repl (repl state)
40 (init/listener repl state))
43 (defun repl-worker (conn user-checker announce)
45 (format conn "~A~%" announce)
49 (format conn "login: ")
51 (setq login (read-socket-line conn))
52 (format conn "password: ")
54 (setq password (read-socket-line conn))
55 (unless (funcall user-checker login password)
56 (format conn "Invalid login~%")
58 (return-from repl-worker))))
60 (tpl::start-interactive-top-level
62 #'tpl::top-level-read-eval-print-loop
68 (defun read-socket-line (stream)
69 (string-right-trim-one-char #\return
70 (read-line stream nil nil)))
72 (defun print-prompt (stream)
73 (format stream "~&~A> " (package-name *package*))
74 (force-output stream))
76 (defun repl-on-stream (stream)
77 (let ((*standard-input* stream)
78 (*standard-output* stream)
79 (*terminal-io* stream)
83 (if (and (find-package 'sb-aclrepl)
84 (fboundp (intern "REPL-FUN" "SB-ACLREPL")))
85 (sb-aclrepl::repl-fun)
93 (print-prompt *standard-output*)
94 (let ((form (read *standard-input*)))
95 (format *standard-output* "~&~S~%" (eval form)))))