r5266: *** empty log message ***

diff --git a/listener.lisp b/listener.lisp
index 59954057c4c98eeb7c3acccac29c89d8187c0d05..d37d72d924c54f51a3c82c948ba149e5d71667d0 100644 (file)
--- a/listener.lisp
+++ b/listener.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Dec 2002
 ;;;;
-;;;; $Id: listener.lisp,v 1.1 2003/07/08 16:12:40 kevin Exp $
+;;;; $Id: listener.lisp,v 1.2 2003/07/09 22:12:52 kevin Exp $
 ;;;; *************************************************************************
 
 (in-package #:kmrcl)
@@ -46,7 +46,14 @@
    (thread-fun :initarg :thread-fun :accessor thread-fun :initform nil)
    (process :initarg :process :accessor process :initform nil)))
 
+(defmethod print-object ((obj listener) s)
+  (print-unreadable-object (obj s :type t :identity nil)
+    (format s "port ~A" (port obj))))
 
+(defmethod print-object ((obj worker) s)
+  (print-unreadable-object (obj s :type t :identity nil)
+    (format s "port ~A" (port (listener obj)))))
+  
 ;; High-level API
 
 (defun init/listener (listener state)
@@ -74,11 +81,15 @@
        (return-from init/listener listener))
      (dolist (worker (workers listener))
        (close-active-socket (connection worker))
-       (destroy-process (process worker)))
+       (destroy-process (process worker))
+       (setf (connection worker) nil)
+       (setf (process worker) nil))
      (setf (workers listener) nil)
      (with-slots (process socket) listener
        (errorset (close-passive-socket socket) t)
-       (errorset (destroy-process process) t))
+       (errorset (destroy-process process) t)
+       (setf process nil)
+       (setf socket nil))
      (setq *active-listeners* (remove listener *active-listeners*)))
     (:restart
      (init/listener listener :stop)

diff --git a/processes.lisp b/processes.lisp
index 0c9175fc8d8579917071789cf708e4546404be49..64921f7692eda5f84a52b4aa081db4cc5ebe254d 100644 (file)
--- a/processes.lisp
+++ b/processes.lisp
@@ -7,18 +7,18 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  June 2003
 ;;;;
-;;;; $Id: processes.lisp,v 1.1 2003/07/08 16:12:40 kevin Exp $
+;;;; $Id: processes.lisp,v 1.2 2003/07/09 22:12:52 kevin Exp $
 ;;;; *************************************************************************
 
 (in-package #:kmrcl)
 
 
 (defun make-process (name func)
-  #+cmu (mp:make-process func :name name)
   #+allegro (mp:process-run-function name func)
+  #+cmu (mp:make-process func :name name)
   #+lispworks (mp:process-run-function name nil func)
   #+sb-thread (sb-thread:make-thread func)
-  #+clisp (funcall func)
+  #-(or allegro cmu lispworks sb-thread) (funcall func)
   )
 
 (defun destroy-process (process)

diff --git a/sockets.lisp b/sockets.lisp
index 116e15537ce2315c7c94bb334128a069136c5f48..a0d4472de2a8d6c334d3389fe0d7e5284e0ca59a 100644 (file)
--- a/sockets.lisp
+++ b/sockets.lisp
@@ -7,12 +7,16 @@
 ;;;; Programmer:    Kevin M. Rosenberg with excerpts from portableaserve
 ;;;; Date Started:  Jun 2003
 ;;;;
-;;;; $Id: sockets.lisp,v 1.1 2003/07/08 16:12:40 kevin Exp $
+;;;; $Id: sockets.lisp,v 1.2 2003/07/09 22:12:52 kevin Exp $
 ;;;; *************************************************************************
 
 (in-package #:kmrcl)
 
-;; Sockets
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  #+sbcl (require :sb-bsd-sockets)
+  #+lispworks (require "comm")
+  #+allegro (require :socket))
+
 
 #+lispworks
 (progn

diff --git a/telnet-server.lisp b/telnet-server.lisp
index cf95ad403896f2fc1895d547898100cc67ff414e..210943a23c8eed2ea1f9d1e0199c5e0b57ab9960 100644 (file)
--- 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))))))