First check-in of new telnet repl sources (in progress).

Pascal J. Bourguignon [2021-05-15 02:24]
First check-in of new telnet repl sources (in progress).
Filename
clext/telnet/telnet-repl.lisp
clext/telnet/telnet-stream.lisp
clext/telnet/test.lisp
common-lisp/telnet/telnet.lisp
common-lisp/telnet/test.lisp
small-cl-pgms/botvot/Makefile
small-cl-pgms/botvot/botvot.lisp
small-cl-pgms/botvot/generate-application.lisp
diff --git a/clext/telnet/telnet-repl.lisp b/clext/telnet/telnet-repl.lisp
new file mode 100644
index 0000000..3516905
--- /dev/null
+++ b/clext/telnet/telnet-repl.lisp
@@ -0,0 +1,254 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               telnet-repl.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Implements a Telnet REPL server.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2021-05-13 <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/>.
+;;;;**************************************************************************
+
+(in-package "COM.INFORMATIMAGO.CLEXT.TELNET.REPL")
+
+
+
+
+;;;
+;;; The REPL:
+;;;
+
+
+;; TODO: Securize the *readtable* and the *package* (cf. something like ibcl)
+
+(defun make-repl-readtable (cn)
+  (copy-readtable))
+
+(defun make-repl-package   (cn)
+  (mkupack :name (format nil "USER-~D" cn)
+           :use '("COMMON-LISP")))
+
+(defun telnet-repl (stream cn must-stop-it)
+  (let ((*terminal-io*     stream)
+        (*debug-io*        (make-synonym-stream '*terminal-io*))
+        (*query-io*        (make-synonym-stream '*terminal-io*))
+        (*standard-input*  (stream-input-stream  stream))
+        (*standard-output* (stream-output-stream stream))
+        (*trace-output*    (stream-output-stream stream))
+        (*error-output*    (stream-output-stream stream))
+        (package           (make-repl-package   cn))
+        (*readtable*       (make-repl-readtable cn))
+        (*package*         package)
+        (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
+                (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)))))
+        (delete-package package)))))
+
+
+;;;
+;;; Client
+;;;
+
+(defclass repl-client ()
+  ((name              :initarg  :name            :reader name)
+   (thread            :initarg  :thread          :reader repl-client-thread
+                      :initform nil)
+   (number            :initarg  :number          :reader repl-client-number)
+   (socket            :initarg  :socket          :reader repl-client-socket)
+   (banner-function   :initarg  :banner-function :reader banner-function)
+   (login-function    :initarg  :login-function  :reader login-function)
+   (repl-function     :initarg  :repl-function   :reader repl-function)
+   (stop-closure      :initform nil              :reader stop-closure)
+   (terminate-closure :initform nil              :reader terminate-closure)))
+
+(defun run-client-loop (client)
+  (with-telnet-on-stream (stream (socket-stream (repl-client-socket client)))
+    (when (and (not (stop-closure client))
+               (banner-function client))
+      (funcall (banner-function client) stream (repl-client-number client) (name client)))
+    (when (and (not (stop-closure client))
+               (or (null    (login-function client))
+                   (funcall (login-function client) stream)))
+      (funcall (repl-function client) stream (repl-client-number client) (stop-closure client)))))
+
+(defmethod initialize-instance :after ((client repl-client) &key &allow-other-keys)
+  (let ((stop nil))
+    (setf (slot-value server 'thread)
+          (make-thread (lambda ()
+                         (unwind-protect (run-client-loop client)
+                           (funcall (terminate-closure client))))
+                       :name (name client)))))
+
+
+;;;
+;;; Server
+;;;
+
+;;; The server listens on one TCP port (one or multiple interfaces).
+;;; When receiving a connection it creates a new client thread to handle it.
+;;; Once max-clients are active, it waits for clients to stop before
+;;; handling a new client connection.
+
+
+(defclass repl-server ()
+  ((name            :initarg  :name            :reader name)
+   (thread          :initarg  :thread          :reader repl-server-thread
+                    :initform nil)
+   (lock            :initform nil              :reader repl-server-lock)
+   (more-clients    :initform nil              :reader repl-server-more-clients)
+   (stop-closure    :initform nil)
+   (banner-function :initarg  :banner-function :reader banner-function)
+   (login-function  :initarg  :login-function  :reader login-function)
+   (repl-function   :initarg  :repl-function   :reader repl-function)
+   (port            :initarg  :port            :reader repl-server-port)
+   (interface       :initarg  :interface       :reader repl-server-interface)
+   (max-clients     :initarg  :max-clients     :reader repl-server-max-clients)
+   (clients         :initform '())))
+
+(defmethod %clean-up ((server repl-server))
+  (loop :for slot :in '(thread lock more-clients stop-closure)
+        :do (setf (slot-value server slot) nil)))
+
+(defmethod %add-client ((server repl-server) new-client)
+  (push new-client (slot-value server 'clients)))
+
+(defmethod remove-client ((server repl-server) old-client)
+  (with-lock-held ((repl-server-lock server))
+    (socket-close (repl-client-socket old-client))
+    (setf (slot-value server 'clients)
+          (delete old-client (slot-value server 'clients)))
+    (condition-notify (repl-server-more-client server))))
+
+(defmethod wait-for-free-client-slot ((server repl-server))
+  (with-lock-held ((repl-server-lock server))
+    (loop :while (and (< (repl-server-max-clients server)
+                         (length (slot-value server 'clients)))
+                      (not (funcall must-stop-p)))
+          :do
+          :do (condition-wait (repl-server-mode-clients server)
+                              (repl-server-lock server)
+                              1 #| check for stop |#))))
+
+(defun run-server-loop (server)
+  (with-socket-listener (server-socket (repl-server-interface server)
+                                       (repl-server-port server)
+                                       :element-type '(unsigned-byte 8)
+                                       :timeout 1)
+    (loop
+      :for cn :from 1
+      :for client-socket := (socket-accept server-socket)
+      :when client-socket
+        :do (with-lock-held ((repl-server-lock server))
+              (let ((client (make-instance
+                             'repl-client
+                             :name (format nil "~A Client #~D"
+                                           (name server) cn)
+                             :number cn
+                             :socket client-socket
+                             :banner-function (banner-function server)
+                             :login-function (login-function server)
+                             :repl-function  (repl-function server)
+                             :stop-closure   (lambda ()
+                                               (funcall (slot-value server 'stop-closure)))
+                             :terminate-closure (lambda (client)
+                                                  (remove-client server client)))))
+                (%add-client server client)))
+      :do (wait-for-free-client-slot server)
+      :until (funcall must-stop-p)
+      :finally (loop
+                 :while (slot-value server 'clients)
+                 :do (wait-for-free-client-slot server))
+               (return cn))))
+
+(defmethod initialize-instance :after ((server repl-server) &key &allow-other-keys)
+  (let ((stop nil))
+    (setf (slot-value server 'stop-closure)
+          (lambda (&optional stop-it)
+            (when stop-it
+              (setf stop t))
+            stop)
+
+          (slot-value server 'thread)
+          (make-thread (lambda () (run-server-loop server))
+                       :name (format nil "~A Server" (name server))))))
+
+(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)))
+  "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.
+
+The clients will start running the BANNER-FUNCTION which takes a
+stream, a client number and a client name.
+
+Then the LOGIN-FUNCTION is called with a stream. It should return true
+to allow the connection to go on.
+
+If the LOGIN-FUNCTION returns true, then the REPL-FUNCTION is called
+with the stream, the client number, and a stop closure that should be
+called periodically to know when the REPL should be stopped.
+
+
+RETURN: The server instance.  Several servers may be run on different
+ports (with possibly different functions).
+"
+  (make-instance 'repl-server
+                 :name name
+                 :banner-function banner-function
+                 :login-function login-function
+                 :repl-function repl-function
+                 :port port
+                 :interface interface
+                 :max-clients max-clients))
+
+(defun stop-repl-server (server)
+  "Stops the REPL server.  It make take some time top shut down all
+the REPL clients, but the REPL server should not accept new
+connections right away."
+  (when (repl-server-thread server)
+    (funcall (repl-server-stop-closure server) t)
+    (join-thread (repl-server-thread server))
+    (%clean-up server)))
+
+;;;; THE END ;;;;
diff --git a/clext/telnet/telnet-stream.lisp b/clext/telnet/telnet-stream.lisp
new file mode 100644
index 0000000..21969a1
--- /dev/null
+++ b/clext/telnet/telnet-stream.lisp
@@ -0,0 +1,973 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               telnet-stream.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Wraps a socket stream running the telnet protocol in a pair of
+;;;;    bivalent gray-streams.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2021-05-14 <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/>.
+;;;;**************************************************************************
+
+(in-package "COM.INFORMATIMAGO.CLEXT.TELNET.STREAM")
+(declaim (declaration stepper))
+
+#|
+
+# -*- mode:org -*-
+
+** Telnet Controls
+
+These controls may be received from the telnet layer into the
+up:GSTREAM. The telnet-stream must process them.
+
+
+| Controls          | I/O        | Description                                      |
+|-------------------+------------+--------------------------------------------------|
+| are-you-there     | output     | should send an answer                            |
+|                   |            | at the REPL we could send the prompt             |
+|                   |            | when reading, could issue a message or a prompt? |
+|                   |            | when processing, could issue a message about the |
+|                   |            | current function (short backtrace?)              |
+|                   |            |                                                  |
+| abort-output      | output     | clear output buffer (send-buffer, output buffer) |
+|                   |            |                                                  |
+| interrupt-process | interrupt  | enter the debugger, or resume REPL               |
+|                   |            |                                                  |
+| go-ahead          | output     | for half-duplex, resume sending.                 |
+|                   |            |                                                  |
+| erase-line        | input      | erase the input buffer                           |
+|                   |            |                                                  |
+| erase-character   | input      | erase the previous character in the input buffer |
+|                   |            |                                                  |
+| break             | interrupt? | enter the debugger, or resume REPL               |
+|                   |            | at the REPL prompt, break could reissue          |
+|                   |            | the prompt without entering the debugger.        |
+|                   |            |                                                  |
+| end-of-record     | input      | EOF?                                             |
+
+Note: the input buffer may contain multiple lines. ERASE-LINE erase
+back up to the previous newline, but cannot erase the previous line.
+ERASE-CHARACTER cannot erase a newline in the buffer either.
+
+
+** Telnet Options
+
+We may set those options:
+
+| transmit-binary   | output | depending on the encoding US-ASCII or non-US-ASCII. |
+| echo              | input  | echo the character received.                        |
+| suppress-go-ahead | I/O    | half-duplex ; enable this option to go full-duplex. |
+| end-of-record     | output | we may ask this option to send eor on flush.        |
+| end-of-record     | input  | ignore it?                                          |
+
+
+| echo     | suppress-go-ahead | meaning          |
+|----------+-------------------+------------------|
+| enabled  | enabled           | character mode   |
+| enabled  | disabled          | kludge line mode |
+| disabled | enabled           | kludge line mode |
+| disabled | disabled          |                  |
+
+Note: The line mode option (RFC 1116, RFC 1184) is not implemented yet.
+
+(defparameter *default-classes* '((:transmit-binary   . option)
+                                  (:echo              . option)
+                                  (:suppress-go-ahead . option)
+                                  (:end-of-record     . option)
+                                  ;; (:timing-mark       . option)
+                                  (:status            . status))
+
+  ;; NOTE: when the class is OPTION, it means the option has no
+  ;;       specific behavior besides being enabled or disabled (but
+  ;;       the NVT may alter its behavior according to the setting of
+  ;;       the option).
+
+  "An a-list of (option-name . class-name).")
+
+** Threads
+
+The client needs two threads:
+
+- a client input loop thread that waits and read the bytes from the
+  socket.  as soon as some are received, they're transmitted to the
+  NVT, and queued into the Input Buffer of the gray stream.
+
+- a client repl thread reads the data from the Input Buffer, and
+  evaluates it.  Eventually, it may write some data to the thread.
+  Some buffering (if asked) may occur until it's flushed
+  (finish-output) or (terpri).  The data is sent down to the NVT.  The
+  NVT sends the data to the down-sender, which calls write-sequence on
+  the socket.  Since this may block, it will set send-wait-p to false
+  first, so that if send down needs to be called from the other
+  thread, data will be queued instead in the send-buffer.
+
+** Encodings
+
+When using US-ASCII, we can use SEND-TEXT, but when using any other
+encoding, we need to negociate binary and an encoding, and use
+SEND-BINARY.  The user will select the stream-external-format encoding
+himself, so we don't need to negociate it (but we could once RFC 2066
+is implemented, at least for the initial external-format).
+
+** Buffering
+
+Note: we may ask for the EOR option, and send an EOR when flushing
+(automatic or explicit).
+
+We may offer buffering options on the telnet-stream (up:GSTREAM):
+
+| Setting                                                | Description                                                     |
+|--------------------------------------------------------+-----------------------------------------------------------------|
+| (stream-output-buffering stream)                       | the current output-buffering: :CHARACTER :LINE or buffer-size   |
+|                                                        |                                                                 |
+| (setf (stream-output-buffering stream) nil)            | no Output Buffer we send directly to the NVT                    |
+| (setf (stream-output-buffering stream) :character)     | and (send down bytes);                                          |
+|                                                        | we still may have to buffer when (send-wait-p nvt)              |
+|                                                        |                                                                 |
+| (setf (stream-output-buffering stream) :line)          | We write into the Output Buffer until a newline.                |
+|                                                        | Then we automatically flush when a newline is written           |
+|                                                        |                                                                 |
+| (setf (stream-output-buffering stream) buffer-size)    | We write into the Output Buffer up to a buffer-size full        |
+|                                                        | and then flush automatically when we the buffer is full.        |
+|                                                        | We need to call flush-output explicitely.                       |
+|--------------------------------------------------------+-----------------------------------------------------------------|
+| (stream-input-buffering stream)                        | the current input-buffering: :CHARACTER or :LINE                |
+|                                                        |                                                                 |
+| (setf (stream-input-buffering stream) nil)             | Data is still stored in the Input Buffer, but is available      |
+| (setf (stream-input-buffering stream) :character)      | (LISTEN stream) and can be READ/READ-CHAR/READ-SEQUENCE         |
+|                                                        | as soon as received.                                            |
+|                                                        |                                                                 |
+| (setf (stream-input-buffering stream) :line)           | Data is stored in the Input Buffer, but is available            |
+|                                                        | only when a newline (or EOR) is received.                       |
+|                                                        | -> the only difference really is for LISTEN and READ-SEQUENCE   |
+|--------------------------------------------------------+-----------------------------------------------------------------|
+| (stream-echo stream)                                   | he current echo mode: T or NIL                                  |
+| (setf (stream-echo stream) t)                          | Sets the telnet option. Default behavior.                       |
+| (setf (stream-echo stream) nil)                        | Sets the telnet option. We could set this to read passwords.    |
+|--------------------------------------------------------+-----------------------------------------------------------------|
+| (stream-external-format stream)                        | the current external-format.  :default is us-ascii              |
+|                                                        | Note: we use the native external-format values.                 |
+|                                                        |                                                                 |
+| (setf (stream-external-format stream) encoding)        | sets the external-format.                                       |
+|                                                        | This also set the binary mode <=> the encoding is not us-ascii. |
+|--------------------------------------------------------+-----------------------------------------------------------------|
+| (stream-element-type stream)                           | the current element-type of the stream                          |
+|                                                        |                                                                 |
+| (setf (stream-element-type stream) 'character)         | set the text mode stream-external-format is used.               |
+|                                                        |                                                                 |
+| (setf (stream-element-type stream) '(unsigned-byte n)) | set the binary mode, and decode unsigned-byte to octets.        |
+|                                                        | This could be useful to transfer and process binary data.       |
+|--------------------------------------------------------+-----------------------------------------------------------------|
+
+** TODOs
+*** TODO We need to check thread safety of the NVT and the TELNET-STREAM.
+
+#+BEGIN_CODE
+
+-*- mode:text;mode:picture -*-
+
+                                       +------------+
+                                       |    REPL    |
+                                       +------------+
+                                          ^        |
+                                          |       (write stream)
+                              (listen stream)      |
+                                          |        |
+                                (read stream)      |
+client repl thread                        |        |
+..........................................|....    |
+client input loop thread                  |   .    |
+                                          |   .    v
+         +------------------+          +------------+     +-------------------+
+         |   Input Buffer   |<---------| up:GSTREAM |---->|   Output Buffer   |
+         +------------------+          +------------+     +-------------------+
+                                          ^   .    |
+                                          |   .    |
+                                          |   .    |
+                                          |   .    |
+                                          |   .    |
+                           +---------------+  .  (send-binary nvt bytes)
+                           | NVT-UP-SENDER |  .    |
+                           +---------------+  .  (send-text nvt text)
+                                          ^   .    |
+                                          |   .  (send-control nvt control)
+                                          |   .    |
+                    (receive-binary up bytes) .    |
+                                          |   .    |
+                       (reveive-text up text) .    |
+                                          |   .    |
+                 (reveive-control up control) .    |
+                                          |   .    |
+                (want-option-p up option-name).    |
+              (receive-option up option value).    |
+                                          |   .    |                client repl thread
+                                          |   .    |          until (send-buffer nvt) is empty.
+                                          |   .    v                        +-------------+
+                               +--------------------------+                 |             |
+       options --------------->| NETWORK-VIRTUAL-TERMINAL |                 v             |
+                               +--------------------------+          (send-wait-p nvt)/   |
+                                  |       ^   .    |---------------> (send-buffer nvt)    |
+                                  |       |   . (send down bytes)                         |
+                                  |       |   .    |                                      |
+                                  |       |   .    |                                      |
+                                  v       |   .    v                                      |
+                       +------------+     |   .  +-----------------+                      |
+                       | OPTION-MGR |*    |   .  | NVT-DOWN-SENDER |                      |
+                       +------------+     |   .  +-----------------+                      |
+                                          |   .    |                                      |
+                          (receive nvt bytes) .    |                                      |
+                                          |   .    |                                      |
+                                          |   .    v                                      |
+                                      +--------------+                                    |
+                                      | down:GSTREAM |                                    |
+ client input loop thread             +--------------+                                    |
+       +-----------+                      ^   .    |                                      |
+       |           |                      |   . (write-sequence buffer socket)            |
+       |           v                      |   .    |               |                      |
+       |        (read-sequence buffer socket) .....|..........     |                      |
+       |           |                      |        v         .     +----------------------+
+       +-----------+                  +---------------+      .
+                                      | socket-stream |      .
+                                      +---------------+      .
+                                                             .
+#+END_CODE
+|#
+;;
+;; -*- mode:lisp -*-
+
+
+
+
+;;;
+;;; Telnet Streams
+;;;
+
+(defmacro with-telnet-on-stream ((stream-var stream-expr) &body body)
+  `(let ((,stream-var ,stream-expr))
+    ,@body))
+
+(deftype octet () `(unsigned-byte 8))
+
+(defun make-buffer (size)
+  (make-array size :element-type 'octet :adjustable t :fill-pointer 0))
+
+;;
+;; down:GSTREAM
+;;
+
+(defconstant +down-layer-buffer-size+ 1024)
+
+(defclass down-layer ()
+  ((nvt    :reader nvt         :initarg :nvt)
+   (stream :reader down-stream :initarg :stream)
+   (client :reader client      :initarg :client)))
+
+(defgeneric input-loop (down-layer))
+(defgeneric stop-closure (client)) ;; TODO must be imported from telnet.repl
+
+(defmethod input-loop ((self down-layer))
+  (loop
+    :with buffer := (make-buffer +down-layer-buffer-size+)
+    :until (stop-closure (client self))
+    :do (setf (fill-pointer buffer) (array-dimension buffer 0))
+        (let ((last-pos (read-sequence buffer (down-stream self))))
+          (setf (fill-pointer buffer) last-pos))
+        (receive (nvt (client self)) buffer)))
+
+
+;;
+;; up:GSTREAM, NVT-UP-SENDER
+;;
+
+(defgeneric stream-output-buffering (stream)) ; *
+(defgeneric stream-input-buffering  (stream)) ; *
+(defgeneric stream-echo-mode        (stream)) ; *
+(defgeneric stream-external-format  (stream)) ; *
+(defgeneric stream-element-type     (stream)) ; *
+
+(defgeneric (setf stream-output-buffering) (new-buffering       stream))
+(defgeneric (setf stream-input-buffering)  (new-buffering       stream))
+(defgeneric (setf stream-echo-mode)        (new-echo            stream))
+(defgeneric (setf stream-external-format)  (new-external-format stream))
+(defgeneric (setf stream-element-type)     (new-element-type    stream))
+
+
+(defclass telnet-stream (fundamental-character-input-stream
+                         fundamental-character-output-stream
+                         fundamental-binary-input-stream
+                         fundamental-binary-output-stream)
+  ((element-type             :reader   stream-element-type      :initform 'character
+                             :initarg :element-type)
+   (external-format          :reader   stream-external-format   :initform :default)
+   (input-buffering          :reader   stream-input-buffering   :initform :character)
+   (output-buffering         :reader   stream-output-buffering  :initform :line)
+   (echo-mode                :reader   stream-echo-mode         :initform t)
+
+   (nvt                      :reader   nvt
+                             :initarg :nvt)
+   (open                     :reader   open-stream-p            :initform t)
+   (lock                     :reader   stream-lock)
+   (input-data-present       :reader   for-input-data-present
+                             :documentation "A condition variable indicating that the input-buffer is not empty.")
+   (input-free-space         :reader   for-input-free-space
+                             :documentation "A condition variable indicating that the input-buffer has more free space.")
+   (input-buffer             :reader   input-buffer)
+   (output-buffer            :reader   output-buffer)
+   (column                   :accessor column                   :initform 0)
+   (partial-character-octets :reader   partial-character-octets :initform (make-buffer 4))
+   (unread-character         :accessor unread-character         :initform nil)))
+
+
+;; input-buffer is a vector of octet
+;; listen peeks for a character
+;; unread-char puts back a character
+;; Depending on the encoding, a character may require several octets.
+;; Therefore we use a small byte buffer and a character buffer in telnet-stream.
+
+
+
+(defmethod print-object ((stream telnet-stream) output)
+  (declare (stepper disable))
+  (print-unreadable-object (stream output :type t :identity t)
+    (format output "(~@{~<~%  ~1:;~S ~S~>~^ ~})"
+            :open (open-stream-p stream)
+            :element-type (stream-element-type stream)
+            :external-format (stream-external-format stream)
+            :input-buffering (stream-input-buffering stream)
+            :output-buffering (stream-output-buffering stream)
+            :echo-mode (stream-echo-mode stream)
+            :length-input-buffer (length (input-buffer stream))
+            :length-output-buffer (length (output-buffer stream))))
+  stream)
+
+(defconstant +input-buffer-size+  4096)
+(defconstant +output-buffer-size+ 4096)
+
+(defmethod initialize-instance :after ((stream telnet-stream) &key &allow-other-keys)
+  (setf (slot-value stream 'lock)                   (make-lock "telnet-stream")
+        (slot-value stream 'for-input-data-present) (make-condition-variable :name "input-data-present")
+        (slot-value stream 'for-input-free-space)   (make-condition-variable :name "input-free-space")
+        (slot-value stream 'input-buffer)           (make-input-buffer (stream-input-buffering stream))
+        (slot-value stream 'output-buffer)          (make-buffer +output-buffer-size+)))
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; stream methods
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-condition simple-stream-error (stream-error simple-error)
+  ())
+
+(defun check-stream-open (stream where)
+  (unless (open-stream-p stream)
+    (error 'simple-stream-error
+           :stream stream
+           :format-control "~S cannot deal with closed stream ~S"
+           :format-arguments (list where stream))))
+
+(defun check-sequence-arguments (direction stream sequence start end)
+  (assert (<= 0 start end (length sequence))
+          (sequence start end)
+          "START = ~D or END = ~D are not sequence bounding indexes for a ~S of length ~D"
+          start end (type-of sequence) (length sequence))
+  (ecase direction
+    (:read
+     (assert (or (listp sequence)
+                 (and (vectorp sequence)
+                      (subtypep (stream-element-type stream) (array-element-type sequence))))
+             (sequence)
+             "For reading, the sequence element type ~S should be a supertype of the stream element type ~S"
+             (array-element-type sequence) (stream-element-type stream)))
+    (:write
+     (assert (or (listp sequence)
+                 (and (vectorp sequence)
+                      (subtypep (array-element-type sequence) (stream-element-type stream))))
+             (sequence)
+             "For writing, the sequence element type ~S should be a subtype of the stream element type ~S"
+             (array-element-type sequence) (stream-element-type stream)))))
+
+
+;;;
+;;; Input
+;;;
+
+(defstruct (input-buffer
+            (:constructor %make-input-buffer))
+  data
+  (head 0)
+  (tail 0))
+
+(defun make-input-buffer (buffering)
+  (%make-input-buffer
+   :data (make-buffer (if (integerp buffering)
+                          buffering
+                          +input-buffer-size+))))
+
+(defun %input-buffer-free-space (stream)
+  (let* ((buffer (input-buffer stream))
+         (size   (length (input-buffer-data buffer))))
+    (- size 1 (mod (- (input-buffer-tail buffer)
+                      (input-buffer-head buffer))
+                   size))))
+(declaim (inline %input-buffer-free-space))
+
+(defun %input-buffer-length (stream)
+  (let* ((buffer (input-buffer stream))
+         (size   (length (input-buffer-data buffer))))
+    (mod (- (input-buffer-tail buffer)
+            (input-buffer-head buffer))
+         size)))
+(declaim (inline %input-buffer-length))
+
+(defun %input-buffer-ranges (buffer len)
+  (let* ((size (length (input-buffer-data buffer)))
+         (tail (input-buffer-tail buffer))
+         (max1 (- size tail)))
+    (if (<= len max1)
+        (values tail len  nil nil          (mod (+ tail len) size))
+        (values tail max1 0   (- len max1) (mod (+ tail len) size)))))
+(declaim (inline %input-buffer-ranges))
+
+(defun %wait-for-input-free-space (stream required)
+  (loop
+      :while (< (%input-buffer-free-space stream) required)
+      :do (condition-wait (for-input-free-space stream) (stream-lock stream))))
+(declaim (inline %wait-for-input-free-space))
+
+(defun %wait-for-input-data-present (stream required)
+  (loop
+    :while (< (%input-buffer-length stream) required)
+    :do (condition-wait (for-input-data-present stream) (stream-lock stream))))
+(declaim (inline %wait-for-input-data-present))
+
+(defmethod input-buffer-append-octet ((stream telnet-stream) octet)
+  (with-lock-held ((stream-lock stream))
+    (%wait-for-input-free-space stream 1)
+    ;; copy one octet
+    (let ((buffer (input-buffer stream)))
+      (multiple-value-bind (s1 e1 s2 e2 nt) (%input-buffer-ranges buffer 1)
+        (declare (ignore e1 s2 e2))
+        (setf (aref (input-buffer-data buffer) s1) octet)
+        (setf (input-buffer-tail buffer) nt)))
+    (condition-notify (for-input-data-present stream))))
+
+(defmethod input-buffer-append-text ((stream telnet-stream) text)
+  (let* ((end (length text))
+         (len (+ end (count #\newline text))))
+    (when (plusp len)
+      (with-lock-held ((stream-lock stream))
+        (%wait-for-input-free-space stream len)
+        ;; copy the text octets.
+        (let* ((buffer (input-buffer stream))
+               (data   (input-buffer-data buffer)))
+          (multiple-value-bind (s1 e1 s2 e2 nt) (%input-buffer-ranges buffer len)
+            (let ((start2 (nth-value 1 (replace-ascii-bytes data text :newline :crlf :start1 s1 :end1 e1 :start2 0 :end2 end))))
+              (when s2
+                (replace-ascii-bytes data text :newline :crlf :start1 s2 :end1 e2 :start2 start2 :end2 end)))
+            (setf (input-buffer-tail buffer) nt)))
+        (condition-notify (for-input-data-present stream))))))
+
+(defmethod input-buffer-append-octets ((stream telnet-stream) octets start end)
+  (let ((len (- (or end (length octets)) start)))
+    (when (plusp len)
+      (with-lock-held ((stream-lock stream))
+        (%wait-for-input-free-space stream len)
+        ;; copy the binary octets.
+        (let* ((buffer (input-buffer stream))
+               (data   (input-buffer-data buffer)))
+          (multiple-value-bind (s1 e1 s2 e2 nt) (%input-buffer-ranges buffer len)
+            (replace data octets :start1 s1 :end1 e1 :start2 start :end2 (- e1 s1))
+            (when s2
+              (replace data octets :start1 s2 :end1 e2 :start2 (+ start (- e1 s1)) :end2 end))
+            (setf (input-buffer-tail buffer) nt)))
+        (condition-notify (for-input-data-present stream))))))
+
+(defmethod input-buffer-erase-character ((stream telnet-stream))
+  (with-lock-held ((stream-lock stream))
+    (let* ((buffer (input-buffer stream))
+           (data   (input-buffer-data buffer))
+           (tail   (input-buffer-tail buffer)))
+      (when (plusp (%input-buffer-length stream))
+        (let ((last (mod (- tail 1) (length data))))
+          (unless (or (= (aref data last) lf)
+                      (= (aref data last) cr))
+            (setf (input-buffer-tail buffer) last)
+            (condition-notify (for-input-free-space stream))))))))
+
+(defmethod input-buffer-erase-line ((stream telnet-stream))
+  (with-lock-held ((stream-lock stream))
+    (let* ((buffer (input-buffer stream))
+           (data   (input-buffer-data buffer))
+           (head   (input-buffer-head buffer))
+           (tail   (input-buffer-tail buffer))
+           (size   (length data)))
+      (when (plusp (%input-buffer-length stream))
+        (loop
+          :with last := (mod (- tail 1) size)
+          :while (and (/= (aref data last) lf)
+                      (/= (aref data last) cr))
+          :do (setf last (mod (- last 1) size))
+          :until (= last head)
+          :finally (setf (input-buffer-tail buffer) last)
+                   (condition-notify (for-input-free-space stream)))))))
+
+(defmethod input-buffer-peek-octet ((stream telnet-stream))
+  (with-lock-held ((stream-lock stream))
+    (let* ((buffer (input-buffer stream))
+           (data   (input-buffer-data buffer))
+           (head   (input-buffer-head buffer)))
+      (when (plusp (%input-buffer-length stream))
+        (aref data head)))))
+
+(defmethod input-buffer-read-octet ((stream telnet-stream))
+  (with-lock-held ((stream-lock stream))
+    (%wait-for-input-data-present stream 1)
+    (let* ((buffer (input-buffer stream))
+           (data   (input-buffer-data buffer))
+           (head   (input-buffer-head buffer))
+           (size   (length data)))
+      (prog1 (aref data head)
+        (setf (input-buffer-data buffer) (mod (+ data 1) size))))))
+
+;; (defmethod input-buffer-read-octets ((stream telnet-stream) octets &key (start 0) end)
+;;   (with-lock-held ((stream-lock stream))
+;;     (let ((len (- (or end (length octets)) start)))
+;;       (if (< (length (input-buffer-data))))
+;;       (%wait-for-input-data-present stream len)
+;;       (let* ((buffer (input-buffer stream))
+;;              (data   (input-buffer-data buffer))
+;;              (head   (input-buffer-head buffer))
+;;              (size   (length data)))
+;;         (prog1 (aref data head)
+;;           (setf (input-buffer-data buffer) (mod (+ data 1) size)))))))
+
+
+;; Up interface (to up):
+
+(defmethod want-option-p ((up-sender telnet-stream) option-code)
+  (declare (ignore option-code))
+  ;; Asks the upper layer whether the option is wanted.
+  ;; OPTION-NAME: a keyword denoting the option.
+  (warn "~S not implemented yet" 'want-option-p))
+
+(defmethod receive-option  ((up-sender telnet-stream) option value)
+  ;; Receive a result from an option request.
+  ;; OPTION: the option instance.
+  ;; VALUE:  a value the option sends back.
+  (declare (ignore option value))
+  (warn "~S not implemented yet" 'receive-option))
+
+(defmethod receive-binary  ((up-sender telnet-stream) bytes &key (start 0) end)
+  ;; Receive some binary text.
+  ;; BYTE:       a VECTOR of (UNSIGNED-BYTE 8).
+  ;; START, END: bounding index designators of sequence.
+  ;;             The defaults are for START 0 and for END nil.
+  (input-buffer-append-octets up-sender bytes start (or end (length bytes))))
+
+(defmethod receive-text    ((up-sender telnet-stream) text)
+  ;; Receive some ASCII text
+  ;; TEXT: a string containing only printable ASCII characters and #\newline.
+  (input-buffer-append-text up-sender text))
+
+(defmethod receive-control ((up-sender telnet-stream) control)
+  ;; Receive a function code.
+  ;; CONTROL: (member :are-you-there :abort-output :interrupt-process :go-ahead
+  ;;                  :erase-line :erase-character
+  ;;                  :break :cr :ff :vt :lf :ht :bs :bel :nul
+  ;;                  :end-of-record).
+  (case control
+    ;; | Controls          | I/O        | Description                                      |
+    ;; |-------------------+------------+--------------------------------------------------|
+    ;; | are-you-there     | output     | should send an answer                            |
+    ;; |                   |            | at the REPL we could send the prompt             |
+    ;; |                   |            | when reading, could issue a message or a prompt? |
+    ;; |                   |            | when processing, could issue a message about the |
+    ;; |                   |            | current function (short backtrace?)              |
+    ;; |                   |            |                                                  |
+    ;; | abort-output      | output     | clear output buffer (send-buffer, output buffer) |
+    ;; |                   |            |                                                  |
+    ;; | interrupt-process | interrupt  | enter the debugger, or resume REPL               |
+    ;; |                   |            |                                                  |
+    ;; | go-ahead          | output     | for half-duplex, resume sending.                 |
+    ;; |                   |            |                                                  |
+    ;; | erase-line        | input      | erase the input buffer                           |
+    ;; |                   |            |                                                  |
+    ;; | erase-character   | input      | erase the previous character in the input buffer |
+    ;; |                   |            |                                                  |
+    ;; | break             | interrupt? | enter the debugger, or resume REPL               |
+    ;; |                   |            | at the REPL prompt, break could reissue          |
+    ;; |                   |            | the prompt without entering the debugger.        |
+    ;; |                   |            |                                                  |
+    ;; | end-of-record     | input      | EOF?                                             |
+    ;;
+    ;; Note: the input buffer may contain multiple lines. ERASE-LINE erase
+    ;; back up to the previous newline, but cannot erase the previous line.
+    ;; ERASE-CHARACTER cannot erase a newline in the buffer either.
+    (:are-you-there
+     ;; if output-buffer contains something,
+     ;; then flush it
+     ;; else send a nul or a message?
+     )
+    (:abort-output
+     ;; clear-output-buffer
+     )
+    (:interrupt-process
+     ;; signal keyboard-interrupt in the repl thread
+     )
+    (:break
+     ;; signal keyboard-interrupt in the repl thread
+     )
+    (:go-ahead
+     ;; we don't do half-duplex.
+     ;; flush-output
+     )
+    (:erase-line
+     ;; find last line in input-buffer and erase it
+     (input-buffer-erase-line up-sender))
+    (:erase-character
+     ;; 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?
+     )
+
+    ((: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))))
+    (otherwise
+     ;; log an unknown control
+     )))
+
+
+;;; character input
+
+(declaim (inline update-column))
+(defun update-column (stream ch)
+  (when (characterp ch)
+    (if (char= ch #\newline)
+        (setf (column stream) 0)
+        (incf (column stream))))
+  ch)
+
+(defmethod stream-read-char ((stream telnet-stream))
+  (check-stream-open stream 'stream-read-char)
+  (let ((ch (unread-character stream)))
+    (if ch
+        (progn
+          (setf (unread-character stream) nil)
+          (update-column stream ch))
+        ;; if 1-1 encoding
+        ;; then
+        ;;    if there's an octet
+        ;;    then read the octet and convert it to character
+        ;;    else (%wait-for-input-free-space)
+        ;; else
+        ;;    while partial cannot convert
+        ;;        if there's an octet
+        ;;            then read the octet into partial
+        ;;        else (%wait-for-input-free-space)
+        ;;    convert partial to character and reset partial
+
+
+        )))
+
+(defmethod stream-read-char-no-hang ((stream telnet-stream))
+  (check-stream-open stream 'stream-read-char-no-hang)
+  (update-column stream (%peek-or-dequeue (telnet-stream-telnet stream) nil :no-hang)))
+
+ (defmethod stream-peek-char ((stream telnet-stream))
+  (check-stream-open stream 'stream-peek-char)
+  (telnet-peek-element (telnet-stream-telnet stream)))
+
+(defmethod stream-read-line ((stream telnet-stream))
+  (check-stream-open stream 'stream-read-line)
+  (multiple-value-bind (line eof) (telnet-dequeue-until-element (telnet-stream-telnet stream) #\newline)
+    (setf (column stream) 0)
+    (values line eof)))
+
+(defmethod stream-listen ((stream telnet-stream))
+  (check-stream-open stream 'stream-listen)
+
+  ;; if 1-1 encoding then
+  (input-buffer-peek-octet stream)
+
+
+  (%peek-or-dequeue (telnet-stream-telnet stream) :peek :no-hang))
+
+(defmethod stream-unread-char ((stream telnet-stream) ch)
+  (check-stream-open stream 'stream-unread-char)
+  (with-lock-held ((lock stream))
+    (let ((head (head stream)))
+      (if head
+          (let ((blk (car head)))
+            (if (block-full-p blk)
+                (push (make-block (string ch)) (head stream))
+                (block-push-char blk ch)))
+          (setf (tail stream)
+                (setf (head stream) (list (make-block (string ch))))))))
+  (gate-signal (not-empty stream))
+  (setf (column stream) (max 0 (1- (column stream))))
+  ch)
+
+;; binary input
+
+(defmethod stream-read-byte ((stream telnet-stream))
+  (check-stream-open stream 'stream-read-byte)
+  (%peek-or-dequeue (telnet-stream-telnet stream) nil nil))
+
+
+;;; Sequence Input
+
+
+(defmethod stream-read-sequence ((stream telnet-stream) sequence start end &key &allow-other-keys)
+  (check-stream-open stream 'stream-read-sequence)
+  (check-sequence-arguments :read stream sequence start end)
+  (telnet-dequeue-sequence stream sequence start end))
+
+
+;;;
+;;; Output
+;;;
+
+;; ;; Up interface (from up):
+;;
+;; (defgeneric send-binary  (nvt bytes)
+;;   (:documentation "Send the binary text.
+;; NVT:  a NETWORK-VIRTUAL-TERMINAL instance.
+;; BYTE: a VECTOR of (UNSIGNED-BYTE 8)."))
+;;
+;; (defgeneric send-text    (nvt text)
+;;   (:documentation "Send the ASCII text.
+;; NVT:  a NETWORK-VIRTUAL-TERMINAL instance.
+;; TEXT: a string containing only printable ASCII characters and #\newline."))
+;;
+;; (defgeneric send-control (nvt control)
+;;   (:documentation "Send a function control code.
+;; NVT:  a NETWORK-VIRTUAL-TERMINAL instance.
+;; CONTROL: (member :synch :are-you-there :abort-output :interrupt-process :go-ahead
+;;                  :erase-line :erase-character
+;;                  :break :cr :ff :vt :lf :ht :bs :bel :nul
+;;                  :end-of-record)."))
+
+;;; character output
+
+(defmethod stream-write-char ((stream telnet-stream) ch)
+  (check-stream-open stream 'stream-write-char)
+  (let ((telnet (telnet-stream-nvt stream)))
+    (unless (sunk-telnet-p telnet)
+      (telnet-enqueue-element telnet ch)))
+  (if (char= #\newline ch)
+      (setf (column stream) 0)
+      (incf (column stream)))
+  ch)
+
+(defmethod stream-terpri ((stream telnet-stream))
+  (check-stream-open stream 'stream-terpri)
+  (stream-write-char stream #\newline)
+  nil)
+
+(defmethod stream-write-string ((stream telnet-stream) string &optional (start 0) end)
+  (check-stream-open stream 'stream-write-string)
+  (let* ((telnet (telnet-stream-telnet stream))
+         (end  (or end (length string)))
+         (nlp  (position #\newline string :start start :end end :from-end t)))
+    (unless (sunk-telnet-p telnet)
+      (telnet-enqueue-sequence telnet string start end))
+    (if nlp
+        (setf (column stream) (- end nlp))
+        (incf (column stream) (- end start))))
+  string)
+
+(defmethod stream-line-column ((stream telnet-stream))
+  (column stream))
+
+(defmethod stream-start-line-p ((stream telnet-stream))
+  (zerop (column stream)))
+
+(defmethod stream-advance-to-column ((stream telnet-stream) column)
+  (check-stream-open stream 'stream-advance-to-column)
+  (let ((delta (- column (column stream))))
+    (when (plusp delta)
+      (stream-write-string stream (make-string delta :initial-element #\space))
+      delta)))
+
+(defgeneric reopen-telnet (telnet)
+  (:documentation "Reopens the streams of the TELNET."))
+(defmethod reopen-telnet ((stream telnet-stream))
+  (with-lock-held ((lock stream))
+    (setf (slot-value (stream-input-stream stream)  'open) t
+          (slot-value (stream-output-stream stream) 'open) t))
+  (gate-signal (not-empty stream)))
+
+
+(defun sink-stream (stream)
+  (with-lock-held ((lock stream))
+    (setf (slot-value (stream-input-stream stream) 'open) nil)))
+
+
+(defmethod close ((stream telnet-stream) &key abort)
+  (declare (ignore abort))
+  (with-lock-held ((lock stream))
+    (setf (slot-value (stream-output-stream stream) 'open) nil))
+  ;; (gate-signal (not-empty stream))
+  ;; (sink-stream (telnet-stream stream))
+  )
+
+
+
+
+;; binary output
+
+(defmethod stream-write-byte ((stream telnet-stream) byte)
+  (check-stream-open stream 'stream-write-byte)
+  (let ((stream (stream-stream-stream stream)))
+    (unless (sunk-stream-p stream)
+      (stream-enqueue-element stream byte)))
+  byte)
+
+;;; Sequence Output
+
+(defmethod stream-write-sequence ((stream stream-stream) sequence start end &key &allow-other-keys)
+  (check-stream-open stream 'stream-write-sequence)
+  (check-sequence-arguments :write stream sequence start end)
+  (unless (sunk-stream-p stream)
+    (stream-enqueue-sequence stream sequence start end))
+  sequence)
+
+(defmethod stream-finish-output ((stream telnet-stream))
+  ;; Attempts to ensure that all output sent to the stream has reached its
+  ;; destination, and only then returns false. Implements
+  ;; cl:finish-output. The default method does nothing.
+  )
+
+;; We assign the semantics of waiting for the reader process to
+;; have read all the data written so far.
+;;
+;; NO: This could be done with a empty condition, and the writer waiting
+;;     on the empty condition.  The reader would notify it when reaching
+;;     an empty telnet.
+;; This assumes a single writer stream.  While waiting for the
+;; condition another writer stream could further write data.
+;; Therefore we need instead to be able to enqueue tokens into the telnet,
+;; that could be used to message back to the exact writing thread.
+;;
+;; (defmethod stream-finish-output ((stream telnet-stream))
+;;   (with-lock-held ((lock stream
+;;     (loop :until (%telnet-emptyp stream)
+;;           :do (condition-wait (empty stream) (lock stream)))))
+
+
+;; telnet-warning
+;; telnet-error
+
+
+
+;; Down interface (to down):
+
+(defgeneric send (down-sender bytes &key start end)
+  (:documentation "Send the bytes to the remote NVT.
+BYTE: a VECTOR of (UNSIGNED-BYTE 8)."))
+
+
+;; Down interface (from down):
+
+(defgeneric receive (nvt bytes &key start end)
+  (:documentation "Receive bytes from the remote NVT.
+NVT:  a NETWORK-VIRTUAL-TERMINAL instance.
+BYTE: a VECTOR of (UNSIGNED-BYTE 8)."))
+
+
+;; option control:
+
+(defgeneric option-enabled-p (nvt option-name &optional who)
+  (:documentation "Whether the option is currently enabled,
+if WHO is nil, then for either end, otherwise for the indicated end.
+OPTION-NAME: a keyword or fixnum  denoting the option.
+WHO:         (member nil :us :him)."))
+
+(defgeneric option-negotiating-p (nvt option-name &optional who)
+  (:documentation "Whether the option is currently being negotiated,
+if WHO is nil, then for either end, otherwise for the indicated end.
+OPTION-NAME: a keyword or fixnum  denoting the option.
+WHO:         (member nil :us :him)."))
+
+(defgeneric enable-option    (nvt option-name &optional who)
+  (:documentation "Initiate the negotiation to enable the option.
+OPTION-NAME: a keyword or fixnum  denoting the option.
+WHO:         (member nil :us :him)."))
+
+(defgeneric disable-option   (nvt option-name &optional who)
+  (:documentation "Initiate the negotiation to disable the option.
+OPTION-NAME: a keyword or fixnum  denoting the option.
+WHO:         (member nil :us :him)."))
+
+
+(defun (setf option-enabled-p) (flag nvt option-name &optional who)
+  "Enable or disable the option according to the boolean FLAG.
+OPTION-NAME: a keyword or fixnum denoting an option."
+  (if flag
+      (enable-option  nvt option-name who)
+      (disable-option nvt option-name who)))
+
+
+
+(defgeneric option-register-class (nvt option-name option-class)
+  (:documentation "Register OPTION-CLASS as the class for a given OPTION-NAME.
+NOTE:         If the option is already initialized with a different
+              class, then CHANGE-CLASS is called on the instance.
+OPTION-NAME:  a keyword or fixnum denoting an option.
+OPTION-CLASS: a class designator, should be a subclass of OPTION."))
+
+
+(defgeneric option-register-default-classes (nvt option-names)
+  (:documentation "Register the default option-classes for the option given in OPTION-NAMES.
+NOTE:         If the option is already initialized with a different
+              class, then CHANGE-CLASS is called on the instance.
+OPTION-NAMES: a list of keyword or fixnum denoting options.
+RETURN:       The subset of OPTION-NAMES (codes are converted into
+              option-names) for which a specific default class
+              exists."))
+
+
+;; Implemented by subclasses of OPTION:
+
+(defgeneric receive-subnegotiation (option nvt bytes &key start end)
+  (:documentation "Processes the subnegotiation packet (subseq bytes start end)
+starting with IAC SB and ending with IAC SE."))
+
diff --git a/clext/telnet/test.lisp b/clext/telnet/test.lisp
new file mode 100644
index 0000000..fbea18b
--- /dev/null
+++ b/clext/telnet/test.lisp
@@ -0,0 +1,38 @@
+(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)))
+
diff --git a/common-lisp/telnet/telnet.lisp b/common-lisp/telnet/telnet.lisp
index ec6746e..d5aadf3 100644
--- a/common-lisp/telnet/telnet.lisp
+++ b/common-lisp/telnet/telnet.lisp
@@ -96,7 +96,7 @@
 ;;;;
 ;;;;        Describes a method by which a server can query a client about what
 ;;;;        X11 display it is on. This is definitely obsoleted by RFC
-;;;;        1408. Future implementations need to udnerstand this mechanism of
+;;;;        1408. Future implementations need to understand this mechanism of
 ;;;;        transferring X display information, but the protocol specififed in
 ;;;;        RFC 1408 is the preferred method.
 ;;;;
@@ -107,9 +107,9 @@
 ;;;;
 ;;;; v  RFC 1143
 ;;;;
-;;;;        This describes, in detail, option negotion loop problems in the
-;;;;        telnet protocol, and how to avoid them when writing a telnet
-;;;;        implementation.
+;;;;        This describes, in detail, option negotiation loop
+;;;;        problems in the telnet protocol, and how to avoid them
+;;;;        when writing a telnet implementation.
 ;;;;
 ;;;;    RFC 1116, RFC 1184
 ;;;;
@@ -135,8 +135,6 @@
 ;;;;        instead of the terminal type (RFC 1091) and X11 display (RFC 1096)
 ;;;;        protocols.
 ;;;;
-;;;;
-;;;;
 ;;;;        Both of these RFCs are mentioned because the reference
 ;;;;        implementation of RFC 1408 disagreed with the actual
 ;;;;        implementation. RFC 1571 describes a method for resolving the
@@ -402,6 +400,7 @@ CONTROL: (member :are-you-there :abort-output :interrupt-process :go-ahead
   (:documentation "Send the bytes to the remote NVT.
 BYTE: a VECTOR of (UNSIGNED-BYTE 8)."))

+(defgeneric send-urgent-notification  (down-sender))

 ;; Down interface (from down):

@@ -1263,7 +1262,6 @@ and are discarding text bytes till the next IAC DM."))
 ;;       record (CRLF, EOR, FORW1 FORW2, etc) is sent.  On the other
 ;;       hand, this may be done by the terminal layer itself?
 (defgeneric send-raw-bytes  (nvt  bytes))
-(defgeneric send-urgent-notification  (nvt))

 (defmethod send-raw-bytes  ((nvt network-virtual-terminal) bytes)
   "Send the binary bytes.
diff --git a/common-lisp/telnet/test.lisp b/common-lisp/telnet/test.lisp
index f7a0ac3..2b03975 100644
--- a/common-lisp/telnet/test.lisp
+++ b/common-lisp/telnet/test.lisp
@@ -165,3 +165,27 @@
 (send-status (get-option (layer-nvt *ulc*) :status) (layer-nvt *ulc*))

 (get-option (layer-nvt *ulc*) :status)
+
+
+
+(define-condition interrupt-signal-condition (condition)
+  ()
+  (:report "interrupt signal"))
+
+(defun test/interrupt ()
+  (let* ((iota (bt:make-thread (lambda ()
+                                 (unwind-protect
+                                      (loop
+                                        :for i :from 1
+                                        :do (sleep 1)
+                                            (princ i) (princ " ")
+                                            (finish-output))
+                                   (princ "Done") (terpri)
+                                   (finish-output)))
+                               :name "iota runner")))
+    (sleep 10)
+    (bt:interrupt-thread iota
+                         (function invoke-debugger)
+                         (make-condition 'interrupt-signal-condition))
+    (princ "Complete.") (terpri) (finish-output)))
+
diff --git a/small-cl-pgms/botvot/Makefile b/small-cl-pgms/botvot/Makefile
index 2bc8e5f..c38b0da 100644
--- a/small-cl-pgms/botvot/Makefile
+++ b/small-cl-pgms/botvot/Makefile
@@ -4,34 +4,15 @@ doc::
 clean::
 install::

-CSS="/default.css"
-RSTHTMLOPT=\
-	--leave-comments \
-	--link-stylesheet --stylesheet=$(CSS)
-
-
 all::botvot

 botvot: com.informatimago.small-cl-pgms.botvot.asd  botvot.lisp generate-application.lisp
-	ccl -norc < generate-application.lisp
+	ccl --no-init --load generate-application.lisp --eval '(ccl:quit)'

 install::botvot
 	install -m 755 botvot /usr/local/sbin/botvot

-doc::html
-	pandoc -f rst -t asciidoc < botvot.txt > botvot-fr.asc
-
-clean::
-	- rm -f botvot-fr.html botvot-fr.html.in botvot-fr.asc
-
-html::botvot-fr.html
-
-html.in::botvot-fr.html.in
-
-botvot-fr.html.in:botvot.txt
-	rst2html $(RSTHTMLOPT) < botvot.txt | ../../tools/html-unwrap-document.lisp > botvot-fr.html.in
-botvot-fr.html:botvot-fr.html.in
-	../../tools/html-wrap-document.lisp < $< > $@ || rm $@
+# pandoc -f org -t asciidoc < botvot.org > botvot-fr.asc

 .PHONY:doc html
 #### THE END ####
diff --git a/small-cl-pgms/botvot/botvot.lisp b/small-cl-pgms/botvot/botvot.lisp
index a9cd3a4..4bceeee 100644
--- a/small-cl-pgms/botvot/botvot.lisp
+++ b/small-cl-pgms/botvot/botvot.lisp
@@ -129,7 +129,7 @@ Licensed under the AGPL3.
    (password-hash    :reader   ballot-password-hash    :type string                   :initarg %password-hash)
    (secret-seed      :reader   ballot-secret-seed      :type (vector octet)           :initarg %secret-seed)
    (state            :reader   ballot-state            :type ballot-state             :initarg %state            :initform :editing)
-   (last-publication :reader   ballot-last-publication :type universal-time           :initarg %last-publication :initform 0)
+   (last-publication :reader   ballot-last-publication :type universal-time           :initarg %last-publication :initform 0)
    (channels         :reader   ballot-channels         :type list                     :initarg %channels         :initform '())
    (choices          :reader   ballot-choices          :type list                     :initarg %choices          :initform '())
    (votes            :reader   ballot-votes            :type list                     :initarg %votes            :initform '())))
@@ -303,7 +303,7 @@ user.
 ;;;

 (defun sha256-hash (text)
-  (ironclad:byte-array-to-hex-string
+  (ironclad:byte-array-to-hex-string
    (ironclad:digest-sequence :sha256 (babel:string-to-octets text :encoding :utf-8))))

 (defun sha256-hash-bytes (text)
@@ -1077,11 +1077,11 @@ arguments.  The arguments may be:
 (defun next-sunday    (time) (next-dow 6 time))

 (defun parse-deadline (words)
-  ;; in $x days|minutes|seconds
-  ;; on mon|tue|wed|thi|fri|sat|sun at $h [hours|o'clock]
-  ;; on mon|tue|wed|thi|fri|sat|sun at $HH:MM
-  ;; at $h [hours|o'clock]
-  ;; at $HH:MM
+  ;; in $x days|minutes|seconds
+  ;; on mon|tue|wed|thi|fri|sat|sun at $h [hours|o'clock]
+  ;; on mon|tue|wed|thi|fri|sat|sun at $HH:MM
+  ;; at $h [hours|o'clock]
+  ;; at $HH:MM
   (let ((deadline
          (cond ((string= "in" (first words))
                 (let ((n (ignore-errors (parse-integer (second words)))))
@@ -1109,7 +1109,7 @@ arguments.  The arguments may be:
                                                 (member w u :test (function string-equal)))))))
                   (when dow
                     (let ((time (parse-time (subseq words 3))))
-                      (when time
+                      (when time
                         (funcall dow time))))))
                ((string= "at" (first words))
                 (let ((time (parse-time (subseq words 1))))
@@ -1379,7 +1379,7 @@ but with double-quotes escaping them."

 ;;;
 ;;; A little ballot REPL to try out the command processing from the
-;;; lisp REPL instead of thru a IRC connection:
+;;; lisp REPL instead of thru a IRC connection:
 ;;;

 (defun ballot-repl ()
@@ -1421,13 +1421,13 @@ but with double-quotes escaping them."
   #-(and)
   (with-slots (source user host command arguments connection received-time raw-message-string)
       message
-    (format t "~20A = ~S~%" 'source source)
-    (format t "~20A = ~S~%" 'user user)
-    (format t "~20A = ~S~%" 'host host)
-    (format t "~20A = ~S~%" 'command command)
-    (format t "~20A = ~S~%" 'arguments arguments)
-    (format t "~20A = ~S~%" 'connection connection)
-    (format t "~20A = ~S~%" 'received-time received-time)
+    (format t "~20A = ~S~%" 'source source)
+    (format t "~20A = ~S~%" 'user user)
+    (format t "~20A = ~S~%" 'host host)
+    (format t "~20A = ~S~%" 'command command)
+    (format t "~20A = ~S~%" 'arguments arguments)
+    (format t "~20A = ~S~%" 'connection connection)
+    (format t "~20A = ~S~%" 'received-time received-time)
     (format t "~20A = ~S~%" 'raw-message-string
             (map 'string (lambda (ch)
                            (let ((code (char-code ch)))
@@ -1437,15 +1437,20 @@ but with double-quotes escaping them."
                                  ch)))
                  raw-message-string))
     (finish-output))
-  (let ((arguments        (arguments message))
-        (*requester-nick* (source message)))
-    (when (string= *nickname* (first arguments))
-      (dolist (line (split-sequence
-                     #\newline
-                     (with-output-to-string (*standard-output*)
-                       (process-command (parse-words (second arguments))))
-                     :remove-empty-subseqs t))
-        (answer "~A" line))))
+  (handler-bind
+      ((error (lambda (err)
+                (print-backtrace)
+                (format *error-output* "~%~A~%" err)
+                (return-from msg-hook t))))
+    (let ((arguments        (arguments message))
+          (*requester-nick* (source message)))
+      (when (string= *nickname* (first arguments))
+        (dolist (line (split-sequence
+                       #\newline
+                       (with-output-to-string (*standard-output*)
+                         (process-command (parse-words (second arguments))))
+                       :remove-empty-subseqs t))
+          (answer "~A" line)))))
   t)

 (defun call-with-retry (delay thunk)
@@ -1520,7 +1525,7 @@ and join to the *CHANNEL* where HackerNews are published."


 #-(and) (progn
-
+
           (setf *nickname* "botvot-test"
                 *ballot-file* #P"/tmp/ballot.sexp"
                 *ballot-zombie-life* (minutes 10))
@@ -1533,7 +1538,7 @@ and join to the *CHANNEL* where HackerNews are published."
                                     (hostname user)))

           (find-user *connection* *requester-nick*)
-
+
           (channels (find-user *connection* *nickname*))

           )
diff --git a/small-cl-pgms/botvot/generate-application.lisp b/small-cl-pgms/botvot/generate-application.lisp
index 7791adc..cad7e51 100644
--- a/small-cl-pgms/botvot/generate-application.lisp
+++ b/small-cl-pgms/botvot/generate-application.lisp
@@ -39,9 +39,15 @@
 (ql:register-local-projects)

 (progn (format t "~%;;; Loading botvot.~%") (finish-output) (values))
-(push (make-pathname :name nil :type nil :version nil
-                     :defaults *load-truename*)
-      asdf:*central-registry*)
+(setf asdf:*central-registry*
+      (append (mapcar (lambda (path)
+                        (make-pathname :name nil :type nil :version nil
+                                       :defaults path))
+                      (directory (merge-pathnames
+                                  #P"../../**/*.asd"
+                                  *load-truename*)))
+              asdf:*central-registry*))
+;; (format t "~&;;; asdf:*central-registry* = ~S~%" asdf:*central-registry*)

 (ql:quickload :com.informatimago.small-cl-pgms.botvot)
ViewGit