Added login functoin.

Pascal J. Bourguignon [2021-05-23 17:20]
Added login functoin.
Filename
clext/telnet/packages.lisp
clext/telnet/telnet-repl.lisp
clext/telnet/telnet-stream.lisp
clext/telnet/test.lisp
diff --git a/clext/telnet/packages.lisp b/clext/telnet/packages.lisp
index 60c7e8c..c8f70e4 100644
--- a/clext/telnet/packages.lisp
+++ b/clext/telnet/packages.lisp
@@ -68,7 +68,8 @@
   (:export "WITH-TELNET-ON-STREAM"
            "TELNET-STREAM"
            "NAME" "CLIENT" "STOP-CLOSURE"
-           "*LOG-OUTPUT*"))
+           "*LOG-OUTPUT*"
+           "STREAM-ECHO-MODE"))

 (defpackage "COM.INFORMATIMAGO.CLEXT.TELNET.REPL"
   (:use "COMMON-LISP"
diff --git a/clext/telnet/telnet-repl.lisp b/clext/telnet/telnet-repl.lisp
index 8998116..d0151ba 100644
--- a/clext/telnet/telnet-repl.lisp
+++ b/clext/telnet/telnet-repl.lisp
@@ -231,12 +231,42 @@
           (make-thread (lambda () (run-server-loop server))
                        :name (format nil "~A Server" (name server))))))

+
+(defvar *password* (format nil "~(~36r~)" (random (expt 36 8))))
+
+(defun valid-password-p (user password)
+  (and (string= user     "guest")
+       (string= password *password*)))
+
+(defun simple-login (stream)
+  (format stream "~&User: ")
+  (finish-output stream)
+  (clear-input stream)
+  (let ((user (read-line stream)))
+    (unwind-protect
+         (progn
+           (setf (stream-echo-mode stream) nil)
+           (format stream "~&Password: ")
+           (finish-output stream)
+           (clear-input stream)
+           (let ((password (read-line stream)))
+             (if (valid-password-p user password)
+                 (progn
+                   (format stream "~&Welcome~%")
+                   (force-output stream)
+                   t)
+                 (progn
+                   (format stream "~&Invalid account~%")
+                   (force-output stream)
+                   nil))))
+      (setf (stream-echo-mode stream) t))))
+
 (defun start-repl-server (&key (name "Telnet REPL")
                             (port 10023) (interface "0.0.0.0")
                             (max-clients 10)
                             (banner-function nil)
-                            (login-function nil)
-                            (repl-function (function telnet-repl)))
+                            (login-function (function simple-login))
+                            (repl-function  (function telnet-repl)))
   "Starts a Telnet REPL server thread, listening for incoming
 connections on the specified PORT, and on the specified INTERFACE.
 At most MAX-CLIENTS at a time are allowed connected.
diff --git a/clext/telnet/telnet-stream.lisp b/clext/telnet/telnet-stream.lisp
index dae293b..167c649 100644
--- a/clext/telnet/telnet-stream.lisp
+++ b/clext/telnet/telnet-stream.lisp
@@ -1296,7 +1296,7 @@ we may decode them from the input-buffer.
 (defmethod stream-write-byte ((stream telnet-stream) byte)
   (check-stream-open stream 'stream-write-byte)
   (with-lock-held ((stream-lock stream))
-    ;; TODO
+    ;; TODO implement stream-write-byte
     (vector-push byte (output-buffer stream)))
   byte)

@@ -1305,9 +1305,8 @@ we may decode them from the input-buffer.
 (defmethod stream-write-sequence ((stream telnet-stream) sequence start end &key &allow-other-keys)
   (check-stream-open stream 'stream-write-sequence)
   (check-sequence-arguments :write stream sequence start end)
-  ;; TODO
   (with-lock-held ((stream-lock stream))
-    ;; TODO
+    ;; TODO implement stream-write-sequence
     )
   sequence)

diff --git a/clext/telnet/test.lisp b/clext/telnet/test.lisp
index 2bc84f6..acf66f7 100644
--- a/clext/telnet/test.lisp
+++ b/clext/telnet/test.lisp
@@ -42,9 +42,8 @@
 ;; #-(and)
 ;; (map nil 'print
 ;; (sort (map 'list
-;;            (lambda (name)
+;;            (lambda (name)
 ;;              (let ((ce (babel::get-character-encoding name)))
-;;                (list (babel::enc-name ce)
+;;                (list (babel::enc-name ce)
 ;;                      (babel::enc-max-units-per-char ce))))
 ;;            (babel::list-character-encodings))  (function <) :key (function second)))
-
ViewGit