r5284: *** empty log message ***

[kmrcl.git] / repl.lisp

diff --git a/repl.lisp b/repl.lisp
new file mode 100644 (file)
index 0000000..2675426
--- /dev/null
+++ b/repl.lisp
@@ -0,0 +1,96 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          repl.lisp
+;;;; Purpose:       A repl server
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  Apr 2000
+;;;;
+;;;; $Id: repl.lisp,v 1.1 2003/07/11 06:58:32 kevin Exp $
+;;;;
+;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; KMRCL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(in-package #:kmrcl)
+
+(defconstant +default-repl-server-port+ 4000)
+
+(defclass repl ()
+  ((listener :initarg :listener :accessor listener
+            :initform nil)))
+
+(defun make-repl (&key (port +default-repl-server-port+)
+                      announce user-checker remote-host-checker)
+  (make-instance 'listener 
+    :port port
+    :base-name "repl"                   
+    :function 'repl-worker
+    :function-args (list user-checker announce)
+    :format :text
+    :wait nil
+    :remote-host-checker remote-host-checker
+    :catch-errors nil))
+
+(defun init/repl (repl state)
+  (init/listener repl state))
+
+
+(defun repl-worker (conn user-checker announce)
+  (when announce
+    (format conn "~A~%" announce)
+    (force-output conn))
+  (when user-checker
+    (let (login password)
+      (format conn "login: ")
+      (finish-output conn)
+      (setq login (read-socket-line conn))
+      (format conn "password: ")
+      (finish-output conn)
+      (setq password (read-socket-line conn))
+      (unless (funcall user-checker login password)
+       (format conn "Invalid login~%")
+       (finish-output conn)
+       (return-from repl-worker))))
+  #+allegro
+  (tpl::start-interactive-top-level
+   conn
+   #'tpl::top-level-read-eval-print-loop
+   nil)
+  #-allegro
+  (repl-on-stream conn)
+  )
+
+(defun read-socket-line (stream)
+  (string-right-trim-one-char #\return
+                             (read-line stream nil nil)))
+
+(defun print-prompt (stream)
+  (format stream "~&~A> " (package-name *package*))
+  (force-output stream))
+
+(defun repl-on-stream (stream)
+  (let ((*standard-input* stream)
+       (*standard-output* stream)
+       (*terminal-io* stream)
+       (*debug-io* stream))
+    #|
+    #+sbcl
+    (if (and (find-package 'sb-aclrepl)
+            (fboundp (intern "REPL-FUN" "SB-ACLREPL")))
+       (sb-aclrepl::repl-fun)
+       (%repl))
+    #-sbcl
+    |#
+    (%repl)))
+
+(defun %repl ()
+  (loop
+    (print-prompt *standard-output*)
+    (let ((form (read *standard-input*)))
+      (format *standard-output* "~&~S~%" (eval form)))))
+