Added handling of telnet are-you-there, interrupt-process and break.

Pascal J. Bourguignon [2021-05-24 09:25]
Added handling of telnet are-you-there, interrupt-process and break.
Filename
clext/telnet/com.informatimago.clext.telnet.repl.asd
clext/telnet/com.informatimago.clext.telnet.repl.test.asd
clext/telnet/interrupt-test.lisp
clext/telnet/interrupt.lisp
clext/telnet/packages.lisp
clext/telnet/telnet-repl.lisp
clext/telnet/telnet-stream.lisp
clext/telnet/test.lisp
common-lisp/telnet/telnet.lisp
diff --git a/clext/telnet/com.informatimago.clext.telnet.repl.asd b/clext/telnet/com.informatimago.clext.telnet.repl.asd
index 241b859..8ba05c6 100644
--- a/clext/telnet/com.informatimago.clext.telnet.repl.asd
+++ b/clext/telnet/com.informatimago.clext.telnet.repl.asd
@@ -44,7 +44,7 @@ This system implements a Telnet REPL Server.
   :maintainer "Pascal J. Bourguignon <pjb@informatimago.com>"
   :licence "AGPL3"
   ;; component attributes:
-  :version "1.0.1"
+  :version "1.0.2"
   :properties ((#:author-email                   . "pjb@informatimago.com")
                (#:date                           . "Spring 2021")
                ((#:albert #:output-dir)          . "/tmp/documentation/com.informatimago.clext.telnet.repl/")
@@ -60,23 +60,25 @@ This system implements a Telnet REPL Server.
                "usocket"
                "bordeaux-threads"
                "trivial-gray-streams")
-  :components ((:file "packages"
-                :depends-on ())
-               #+(and ccl debug-condition-variables)
-               (:file "bt-patch"
-                :depends-on ("packages"))
-               (:file "telnet-stream"
-                :depends-on ("packages"
-                             #+(and ccl debug-condition-variables) "bt-patch"))
-               (:file "babel-extension"
-                :depends-on ("packages"))
-               (:file "telnet-repl"
-                :depends-on ("packages"
-                             "babel-extension"
-                             "telnet-stream"
-                             #+(and ccl debug-condition-variables) "bt-patch")))
   ;; #+adsf3 :in-order-to #+adsf3 ((asdf:test-op (asdf:test-op "com.informatimago.clext.telnet.repl.test")))
-  )
+  :components
+  ((:file "interrupt" :depends-on ())
+   (:file "packages"  :depends-on ("interrupt"))
+
+   #+(and ccl debug-condition-variables)
+   (:file "bt-patch"
+    :depends-on ("packages"))
+   (:file "telnet-stream"
+    :depends-on ("packages"
+                 "interrupt"
+                 #+(and ccl debug-condition-variables) "bt-patch"))
+   (:file "babel-extension"
+    :depends-on ("packages"))
+   (:file "telnet-repl"
+    :depends-on ("packages"
+                 "babel-extension"
+                 "telnet-stream"
+                 #+(and ccl debug-condition-variables) "bt-patch"))))



diff --git a/clext/telnet/com.informatimago.clext.telnet.repl.test.asd b/clext/telnet/com.informatimago.clext.telnet.repl.test.asd
index fa2b6a2..0c2f003 100644
--- a/clext/telnet/com.informatimago.clext.telnet.repl.test.asd
+++ b/clext/telnet/com.informatimago.clext.telnet.repl.test.asd
@@ -44,7 +44,7 @@ This system tests the Telnet REPL Server.
   :maintainer "Pascal J. Bourguignon <pjb@informatimago.com>"
   :licence "AGPL3"
   ;; component attributes:
-  :version "1.0.0"
+  :version "1.0.2"
   :properties ((#:author-email                   . "pjb@informatimago.com")
                (#:date                           . "Spring 2021")
                ((#:albert #:output-dir)          . "/tmp/documentation/com.informatimago.clext.telnet.repl.test/")
@@ -61,19 +61,24 @@ This system tests the Telnet REPL Server.
                "com.informatimago.common-lisp.interactive"
                "com.informatimago.common-lisp.telnet"
                "com.informatimago.clext.telnet.repl")
-  :components ((:file "packages"        :depends-on ())
+  :components

-               (:file "telnet-stream"   :depends-on ("packages"))
-               (:file "babel-extension" :depends-on ("packages"))
-               (:file "telnet-repl"     :depends-on ("packages"
-                                                     "telnet-stream"
-                                                     "babel-extension"))
+  ((:file  "interrupt"            :depends-on ())
+   (:file  "interrupt-test"       :depends-on ("interrupt"))

-               (:file "babel-extension-test" :depends-on ("packages" "babel-extension"))
-               (:file "test-stub-nvt"        :depends-on ("packages"))
-               (:file "telnet-stream-test"   :depends-on ("packages"
-                                                          "telnet-stream"
-                                                          "test-stub-nvt"))))
+   (:file "packages"              :depends-on ("interrupt"))
+
+   (:file  "telnet-stream"        :depends-on ("packages"))
+   (:file  "babel-extension"      :depends-on ("packages"))
+   (:file  "telnet-repl"          :depends-on ("packages"
+                                               "telnet-stream"
+                                               "babel-extension"))
+
+   (:file  "babel-extension-test" :depends-on ("packages" "babel-extension"))
+   (:file  "test-stub-nvt"        :depends-on ("packages"))
+   (:file  "telnet-stream-test"   :depends-on ("packages"
+                                               "telnet-stream"
+                                               "test-stub-nvt"))))


 ;;;; THE END ;;;;
diff --git a/clext/telnet/interrupt-test.lisp b/clext/telnet/interrupt-test.lisp
new file mode 100644
index 0000000..6c740a4
--- /dev/null
+++ b/clext/telnet/interrupt-test.lisp
@@ -0,0 +1,73 @@
+(define-condition interrupt-condition (condition)
+  ((source :initarg :source
+           :initform nil
+           :reader interrupt-condition-source))
+  (:report (lambda (condition stream)
+             (format stream "Interrupted~@[ from ~A~]"
+                     (interrupt-condition-source condition)))))
+
+(defvar *debug-on-interrupt* nil)
+
+(defun interrupt-handler (condition)
+  (format t "~S ~A ~%~S = ~A~%"
+          'interrupt-handler condition
+          '*debug-on-interrupt* *debug-on-interrupt*)
+  (force-output)
+  (if *debug-on-interrupt*
+      (break "~@[~:(~A~) ~]Interrupt"
+             (interrupt-condition-source condition))
+      (invoke-restart (find-restart 'resume condition))))
+
+(defmacro with-interrupt-handler (&body body)
+  `(handler-bind ((interrupt-condition
+                    (function interrupt-handler)))
+     (macrolet ((with-resume-restart (&body body)
+                  `(with-simple-restart (resume "Resume")
+                     ,@body)))
+       ,@body)))
+
+(defun caller ()
+  #+ccl (third (ccl:backtrace-as-list))
+  #-ccl nil)
+
+(defun signal-interrupt (thread &optional source)
+  (let ((source (or source (caller))))
+   (bt:interrupt-thread thread (function signal)
+                        (make-condition 'interrupt-condition
+                                        :source source))))
+
+
+
+(defun test/interrupt (&optional debug-on-interrupt)
+  ;; we must set the global variable for the benefit of the running thread.
+  (setf *debug-on-interrupt* debug-on-interrupt)
+  (let* ((iota (bt:make-thread (lambda ()
+                                 (unwind-protect
+                                      (with-interrupt-handler
+                                        (loop
+                                          :for i :from 1
+                                          :do (with-resume-restart
+                                                  (sleep 1)
+                                                (princ i) (princ " ")
+                                                (finish-output))))
+                                   (princ "Iota Done") (terpri)
+                                   (finish-output)))
+                               :initial-bindings (list (cons '*standard-output* *standard-output*))
+                               :name "iota runner")))
+    (sleep 10)
+    (signal-interrupt iota "keyboard")
+    (princ "Interrupter Complete.") (terpri) (force-output)
+    (unless *debug-on-interrupt*
+      (sleep 5)
+      (bt:destroy-thread iota)
+      (princ "Killed iota runner.") (terpri) (force-output))))
+
+
+;; #-(and)
+;; (map nil 'print
+;; (sort (map 'list
+;;            (lambda (name)
+;;              (let ((ce (babel::get-character-encoding name)))
+;;                (list (babel::enc-name ce)
+;;                      (babel::enc-max-units-per-char ce))))
+;;            (babel::list-character-encodings))  (function <) :key (function second)))
diff --git a/clext/telnet/interrupt.lisp b/clext/telnet/interrupt.lisp
new file mode 100644
index 0000000..3a8e2d4
--- /dev/null
+++ b/clext/telnet/interrupt.lisp
@@ -0,0 +1,105 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               interrupt.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Manage thread interruption.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2021-05-24 <PJB> Created.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2021 - 2021
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    This program is distributed in the hope that it will be useful,
+;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;;    GNU Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+
+(defpackage "COM.INFORMATIMAGO.CLEXT.INTERRUPT"
+  (:use "COMMON-LISP"
+        "BORDEAUX-THREADS")
+  (:export "INTERRUPT-CONDITION"
+           "INTERRUPT-CONDITION-SOURCE"
+           "*DEBUG-ON-INTERRUPT*"
+           "WITH-INTERRUPT-HANDLER"
+           "WITH-RESUME-RESTART"
+           "SIGNAL-INTERRUPT"))
+(in-package "COM.INFORMATIMAGO.CLEXT.INTERRUPT")
+
+(define-condition interrupt-condition (condition)
+  ((source :initarg :source
+           :initform nil
+           :reader interrupt-condition-source)
+   (action :initarg :action
+           :initform :resume
+           :reader interrupt-condition-action))
+  (:report (lambda (condition stream)
+             (format stream "Interrupted~@[ from ~A~]"
+                     (interrupt-condition-source condition)))))
+
+(defvar *debug-on-interrupt* nil
+  "Whether all interruptions should invoke the debugger
+\(instead of invoking the RESUME restart).")
+
+(defun interrupt-handler (condition)
+  ;; (format t "~S ~A ~%~S = ~A~%"
+  ;;         'interrupt-handler condition
+  ;;         '*debug-on-interrupt* *debug-on-interrupt*)
+  ;; (force-output)
+  (if (or *debug-on-interrupt*
+          (eql :debug (interrupt-condition-action condition)))
+      (break "~@[~:(~A~) ~]Interrupt"
+             (interrupt-condition-source condition))
+      (invoke-restart (find-restart 'resume condition))))
+
+(defmacro with-interrupt-handler (&body body)
+  "Evaluates body in an environment where a handler for the INTERRUPT-CONDITION is set,
+to call the INTERRUPT-HANDLER function,
+and where a WITH-RESUME-RESTART macro is bound to set up a RESUME restart."
+  `(handler-bind ((interrupt-condition
+                    (function interrupt-handler)))
+     (macrolet ((with-resume-restart ((&optional (format-control "Resume")
+                                                 &rest format-arguments)
+                                      &body body)
+                  `(with-simple-restart (resume ,format-control ,@format-arguments)
+                     ,@body)))
+       ,@body)))
+
+(declaim (notinline caller))
+(defun caller ()
+  "Return the name of the function that called the caller of caller."
+  #+ccl (third (ccl:backtrace-as-list))
+  #-ccl nil)
+
+(defun signal-interrupt (thread &key (action :resume) source)
+  "Interrupt the thread with an INTERRUPT-CONDITION initialized with the ACTION and SOURCE.
+If ACTION is :RESUME and *DEBUG-ON-INTERRUPT* is false,
+the INTERRUPT-HANDLER will invoke the RESUME restart.
+If ACTION is :DEBUG or  *DEBUG-ON-INTERRUPT* is true,
+the INTERRUPT-HANDLER will invoke the debugger
+thru a call to BREAK."
+  (check-type action (member :resume :debug))
+  (let ((source (or source (caller))))
+    (bt:interrupt-thread thread (function signal)
+                         (make-condition 'interrupt-condition
+                                         :action action
+                                         :source source))))
+
+;;;; THE END ;;;;
diff --git a/clext/telnet/packages.lisp b/clext/telnet/packages.lisp
index c8f70e4..ee049cf 100644
--- a/clext/telnet/packages.lisp
+++ b/clext/telnet/packages.lisp
@@ -61,12 +61,14 @@
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.ARRAY"
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STRING"
         "COM.INFORMATIMAGO.CLEXT.CHARACTER-SETS"
-        "COM.INFORMATIMAGO.CLEXT.BABEL-EXTENSION")
+        "COM.INFORMATIMAGO.CLEXT.BABEL-EXTENSION"
+        "COM.INFORMATIMAGO.CLEXT.INTERRUPT")
   #+(and ccl debug-condition-variables)
   (:shadowing-import-from "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH"
                           "MAKE-CONDITION-VARIABLE" "WITH-LOCK-HELD")
   (:export "WITH-TELNET-ON-STREAM"
            "TELNET-STREAM"
+           "TELNET-STREAM-THREAD"
            "NAME" "CLIENT" "STOP-CLOSURE"
            "*LOG-OUTPUT*"
            "STREAM-ECHO-MODE"))
@@ -80,7 +82,8 @@
         "COM.INFORMATIMAGO.COMMON-LISP.TELNET"
         ;; "com.informatimago.common-lisp.cesarum"
         "COM.INFORMATIMAGO.COMMON-LISP.INTERACTIVE.INTERACTIVE"
-        "COM.INFORMATIMAGO.CLEXT.TELNET.STREAM")
+        "COM.INFORMATIMAGO.CLEXT.TELNET.STREAM"
+        "COM.INFORMATIMAGO.CLEXT.INTERRUPT")
   #+(and ccl debug-condition-variables)
   (:shadowing-import-from "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH"
                           "MAKE-CONDITION-VARIABLE" "WITH-LOCK-HELD")
diff --git a/clext/telnet/telnet-repl.lisp b/clext/telnet/telnet-repl.lisp
index d0151ba..ea1b93b 100644
--- a/clext/telnet/telnet-repl.lisp
+++ b/clext/telnet/telnet-repl.lisp
@@ -63,27 +63,31 @@
          (package           (make-repl-package   cn))
          (*readtable*       (make-repl-readtable cn))
          (*package*         package)
+         (*debugger-hook*   nil) ; disable swank-debugger-hook.
          (com.informatimago.common-lisp.interactive.interactive::*repl-history*
            (make-array 128 :adjustable t :fill-pointer 0)))
     (catch 'repl
       (unwind-protect
-           (let ((+eof+   (gensym))
-                 (hist    1))
-             (set-macro-character #\! (function repl-history-reader-macro) t)
-             (loop
-                (when (funcall must-stop-it)
-                  (format *terminal-io* "~&Server is shutting down.~%")
-                  (finish-output *terminal-io*)
-                  (throw 'repl nil))
-                (handler-case
-                    (progn
-                      (format *terminal-io* "~%~A[~D]> " (package-name *package*) hist)
+           (with-interrupt-handler
+             (let ((+eof+   (gensym))
+                   (hist    1))
+               (set-macro-character #\! (function repl-history-reader-macro) t)
+               (loop
+                  (with-resume-restart ("Resume REPL")
+                    (when (funcall must-stop-it)
+                      (format *terminal-io* "~&Server is shutting down.~%")
                       (finish-output *terminal-io*)
-                      (com.informatimago.common-lisp.interactive.interactive::%rep +eof+ hist))
-                  (error (err)
-                    (format stream "~%Fatal Error: ~A~%" err)
-                    (finish-output stream)
-                    (throw 'repl nil)))))
+                      (throw 'repl nil))
+                    (handler-case
+                        (progn
+                          (format *terminal-io* "~%~A[~D]> " (package-name *package*) hist)
+                          (finish-output *terminal-io*)
+                          (com.informatimago.common-lisp.interactive.interactive::%rep +eof+ hist))
+                      (error (err)
+                        (format stream "~%Fatal Error: ~A~%" err)
+                        (finish-output stream)
+                        (throw 'repl nil)))))))
+        (close *terminal-io*)
         (delete-package package)))))


@@ -110,6 +114,7 @@
                                  client)
     (setf  *stream* stream)
     (setf (slot-value client 'stream) stream)
+    (setf (telnet-stream-thread stream) (bt:current-thread))
     (format *log-output* "~&client ~D telnet on stream ~S~%" (repl-client-number client) stream)
     (print (list :not-stop (not (stop-closure client))
                  :banner (banner-function client)
diff --git a/clext/telnet/telnet-stream.lisp b/clext/telnet/telnet-stream.lisp
index 167c649..99dd744 100644
--- a/clext/telnet/telnet-stream.lisp
+++ b/clext/telnet/telnet-stream.lisp
@@ -463,6 +463,10 @@ conected to the NVt."

    (nvt                      :reader   nvt
                              :initarg :nvt)
+   (thread                   :accessor telnet-stream-thread
+                             :initarg :thread
+                             :initform nil
+                             :documentation "The target thread for SIGNAL-INTERRUPT (INTERRUPT-PROCESS and BREAK telnet controls).")
    (open                     :reader   open-stream-p            :initform t)
    (lock                     :reader   stream-lock)
    (input-data-present       :reader   for-input-data-present
@@ -926,16 +930,24 @@ we may decode them from the input-buffer.
      ;; if output-buffer contains something,
      ;; then flush it
      ;; else send a nul or a message?
-     )
+     (finish-output up-sender)
+     (format up-sender "~&I am here.~%")
+     (force-output up-sender))
     (:abort-output
      ;; clear-output-buffer
      )
     (:interrupt-process
      ;; signal keyboard-interrupt in the repl thread
-     )
+     (when (telnet-stream-thread up-sender)
+       (signal-interrupt (telnet-stream-thread up-sender)
+                         :action :resume
+                         :source "keyword interrupt-process")))
     (:break
      ;; signal keyboard-interrupt in the repl thread
-     )
+     (when (telnet-stream-thread up-sender)
+       (signal-interrupt (telnet-stream-thread up-sender)
+                         :action :debug
+                         :source "keyword break")))
     (:go-ahead
      ;; we don't do half-duplex.
      ;; flush-output
@@ -947,19 +959,19 @@ we may decode them from the input-buffer.
      ;; find last (non-newline) character in input-buffer and erase it
      (input-buffer-erase-character up-sender))
     (:end-of-record
-     ;; mark an end-fo-file?
+     ;; mark an end-of-file?
      )

     ((:cr :ff :vt :lf :ht :bs :bel :nul)
      (input-buffer-append-octet up-sender (case control
-                                         (:cr CR)
-                                         (:ff FF)
-                                         (:vt VT)
-                                         (:lf LF)
-                                         (:ht HT)
-                                         (:bs BS)
-                                         (:bel BEL)
-                                         (:nul NUL))))
+                                            (:cr CR)
+                                            (:ff FF)
+                                            (:vt VT)
+                                            (:lf LF)
+                                            (:ht HT)
+                                            (:bs BS)
+                                            (:bel BEL)
+                                            (:nul NUL))))
     (otherwise
      ;; log an unknown control
      )))
diff --git a/clext/telnet/test.lisp b/clext/telnet/test.lisp
deleted file mode 100644
index acf66f7..0000000
--- a/clext/telnet/test.lisp
+++ /dev/null
@@ -1,49 +0,0 @@
-(define-condition interrupt-signal-condition (condition)
-  ()
-  (:report "interrupt signal"))
-
-(defvar *debug-on-interrupt* nil)
-
-(defun keyboard-interrupt (condition)
-  ;; (format t "~S ~A ~%~S = ~A~%"
-  ;;         'keyboard-interrupt condition
-  ;;         '*debug-on-interrupt* *debug-on-interrupt*)
-  ;; (finish-output)
-  (if *debug-on-interrupt*
-      (break "Keyboard Interrupt")
-      (invoke-restart (find-restart 'resume condition))))
-
-(defun test/interrupt (&optional debug-on-interrupt)
-  ;; we must set the global variable for the benefit of the running thread.
-  (setf *debug-on-interrupt* debug-on-interrupt)
-  (let* ((iota (bt:make-thread (lambda ()
-                                 (unwind-protect
-                                      (handler-bind ((interrupt-signal-condition
-                                                       (function keyboard-interrupt)))
-                                        (loop
-                                          :for i :from 1
-                                          :do (with-simple-restart (resume "Resume Loop")
-                                                (sleep 1)
-                                                (princ i) (princ " ")
-                                                (finish-output))))
-                                   (princ "Done") (terpri)
-                                   (finish-output)))
-                               :initial-bindings (list (cons '*standard-output* *standard-output*))
-                               :name "iota runner")))
-    (sleep 10)
-    (bt:interrupt-thread iota
-                         (function signal)
-                         (make-condition 'interrupt-signal-condition))
-    (princ "Complete.") (terpri) (finish-output)))
-
-
-
-
-;; #-(and)
-;; (map nil 'print
-;; (sort (map 'list
-;;            (lambda (name)
-;;              (let ((ce (babel::get-character-encoding name)))
-;;                (list (babel::enc-name ce)
-;;                      (babel::enc-max-units-per-char ce))))
-;;            (babel::list-character-encodings))  (function <) :key (function second)))
diff --git a/common-lisp/telnet/telnet.lisp b/common-lisp/telnet/telnet.lisp
index e928595..1eec5e5 100644
--- a/common-lisp/telnet/telnet.lisp
+++ b/common-lisp/telnet/telnet.lisp
@@ -779,60 +779,60 @@ accompanied by a TCP Urgent notification.")


 (defparameter *option-name-map*
-  `((:transmit-binary              ,transmit-binary)
-    (:echo                         ,echo)
-    (:rcp                          ,rcp)
-    (:suppress-go-ahead            ,suppress-go-ahead)
-    (:nams                         ,nams)
-    (:status                       ,status)
-    (:timing-mark                  ,timing-mark)
-    (:rcte                         ,rcte)
-    (:naol                         ,naol)
-    (:naop                         ,naop)
-    (:naocrd                       ,naocrd)
-    (:naohts                       ,naohts)
-    (:naohtd                       ,naohtd)
-    (:naoffd                       ,naoffd)
-    (:naovts                       ,naovts)
-    (:naovtd                       ,naovtd)
-    (:naolfd                       ,naolfd)
-    (:xascii                       ,xascii)
-    (:logout                       ,logout)
-    (:bm                           ,bm)
-    (:det                          ,det)
-    (:supdup                       ,supdup)
-    (:supdupoutput                 ,supdupoutput)
-    (:sndloc                       ,sndloc)
-    (:ttype                        ,ttype)
-    (:end-of-record                ,end-of-record)
-    (:tuid                         ,tuid)
-    (:outmrk                       ,outmrk)
-    (:ttyloc                       ,ttyloc)
-    (:vt3270regime                 ,vt3270regime)
-    (:x3pad                        ,x3pad)
-    (:naws                         ,naws)
-    (:tspeed                       ,tspeed)
-    (:lflow                        ,lflow)
-    (:linemode                     ,linemode)
-    (:xdisploc                     ,xdisploc)
-    (:old-environ                  ,old-environ)
-    (:authentication               ,authentication)
-    (:encrypt                      ,encrypt)
-    (:new-environ                  ,new-environ)
-    (:tn3270e                      ,tn3270e)
-    (:xauth                        ,xauth)
-    (:charset                      ,charset)
-    (:rsp                          ,rsp)
-    (:com-port-option              ,com-port-option)
-    (:suppress-local-echo          ,suppress-local-echo)
-    (:tls                          ,tls)
-    (:kermit                       ,kermit)
-    (:send-url                     ,send-url)
-    (:forward-x                    ,forward-x)
-    (:pragma-logon                 ,pragma-logon)
-    (:sspi-logon                   ,sspi-logon)
-    (:pragma-heartbeat             ,pragma-heartbeat)
-    (:extended-option-list         ,extended-option-list)))
+  `((:transmit-binary          ,transmit-binary)
+    (:echo                     ,echo)
+    (:rcp                      ,rcp)
+    (:suppress-go-ahead        ,suppress-go-ahead)
+    (:nams                     ,nams)
+    (:status                   ,status)
+    (:timing-mark              ,timing-mark)
+    (:rcte                     ,rcte)
+    (:naol                     ,naol)
+    (:naop                     ,naop)
+    (:naocrd                   ,naocrd)
+    (:naohts                   ,naohts)
+    (:naohtd                   ,naohtd)
+    (:naoffd                   ,naoffd)
+    (:naovts                   ,naovts)
+    (:naovtd                   ,naovtd)
+    (:naolfd                   ,naolfd)
+    (:xascii                   ,xascii)
+    (:logout                   ,logout)
+    (:bm                       ,bm)
+    (:det                      ,det)
+    (:supdup                   ,supdup)
+    (:supdupoutput             ,supdupoutput)
+    (:sndloc                   ,sndloc)
+    (:ttype                    ,ttype)
+    (:end-of-record            ,end-of-record)
+    (:tuid                     ,tuid)
+    (:outmrk                   ,outmrk)
+    (:ttyloc                   ,ttyloc)
+    (:vt3270regime             ,vt3270regime)
+    (:x3pad                    ,x3pad)
+    (:naws                     ,naws)
+    (:tspeed                   ,tspeed)
+    (:lflow                    ,lflow)
+    (:linemode                 ,linemode)
+    (:xdisploc                 ,xdisploc)
+    (:old-environ              ,old-environ)
+    (:authentication           ,authentication)
+    (:encrypt                  ,encrypt)
+    (:new-environ              ,new-environ)
+    (:tn3270e                  ,tn3270e)
+    (:xauth                    ,xauth)
+    (:charset                  ,charset)
+    (:rsp                      ,rsp)
+    (:com-port-option          ,com-port-option)
+    (:suppress-local-echo      ,suppress-local-echo)
+    (:tls                      ,tls)
+    (:kermit                   ,kermit)
+    (:send-url                 ,send-url)
+    (:forward-x                ,forward-x)
+    (:pragma-logon             ,pragma-logon)
+    (:sspi-logon               ,sspi-logon)
+    (:pragma-heartbeat         ,pragma-heartbeat)
+    (:extended-option-list     ,extended-option-list)))


 (defparameter *option-name-table*
@@ -849,6 +849,7 @@ accompanied by a TCP Urgent notification.")
   "Maps the option-code to option-name.")


+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; RFC1143: The Q Method of Implementing TELNET Option Negotiation
@@ -1773,9 +1774,12 @@ BUFFER: An adjustable vector with a fill-pointer.


 (defmethod init-option-code ((nvt network-virtual-terminal) option-code &optional option-name)
-  (let ((opt (gethash option-code (slot-value nvt 'options)))
+  (let ((opt         (gethash option-code (slot-value nvt 'options)))
         (option-name (or option-name (option-name-for-code option-code))))
     (typecase opt
+      (null
+       (setf (gethash option-code (slot-value nvt 'options))
+             (make-option option-code option-name)))
       (option
         opt)
       ((or symbol class)
ViewGit