Corrected INPUT-BUFFER-APPEND-OCTETS and %INPUT-BUFFER-RANGES.

Pascal J. Bourguignon [2021-05-23 16:59]
Corrected INPUT-BUFFER-APPEND-OCTETS and %INPUT-BUFFER-RANGES.
Filename
clext/telnet/bt-patch.lisp
clext/telnet/packages.lisp
clext/telnet/telnet-stream-test.lisp
clext/telnet/telnet-stream.lisp
diff --git a/clext/telnet/bt-patch.lisp b/clext/telnet/bt-patch.lisp
index a14c65d..cbca2df 100644
--- a/clext/telnet/bt-patch.lisp
+++ b/clext/telnet/bt-patch.lisp
@@ -38,26 +38,27 @@

 #-(and)
 (ignore
-
+
  bt:make-condition-variable
  (com.informatimago.common-lisp.cesarum.utility:hash-table-entries *names*)

  (map nil 'print (com.informatimago.common-lisp.cesarum.utility:hash-table-entries *status*))
-
- (#<recursive-lock "down-layer" [ptr @ #x605080] #x3020028D45FD>)
- (#<recursive-lock "Telnet REPL Server Lock" [ptr @ #x10D880] #x30200279729D>)
- (#<recursive-lock "telnet-stream" :status ((:locking
-                                             (funcall "#<STANDARD-METHOD COM.INFORMATIMAGO.CLEXT.TELNET.STREAM::INPUT-BUFFER-FETCH-OCTET (COM.INFORMATIMAGO.CLEXT.TELNET.STREAM:TELNET-STREAM T)>" "#<TELNET-STREAM  #x3020028D75CD>" "NIL")
-                                             #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)
-                                            (:locking
-                                             (com.informatimago.clext.telnet.stream::%stream-read-char "#<TELNET-STREAM #x3020028D75CD>" "NIL")
-                                             #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)) #x3020028D74BD>
-                   (:locking
-                    (funcall "#<STANDARD-METHOD COM.INFORMATIMAGO.CLEXT.TELNET.STREAM::INPUT-BUFFER-FETCH-OCTET (COM.INFORMATIMAGO.CLEXT.TELNET.STREAM:TELNET-STREAM T)>" "#<TELNET-STREAM #x3020028D75CD>" "NIL")
-                    #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)
-                   (:locking
-                    (com.informatimago.clext.telnet.stream::%stream-read-char "#<TELNET-STREAM #x3020028D75CD>" "NIL")
-                    #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)) nil
+ #|
+ (#<recursive-lock "down-layer" [ptr @ #x605080] #x3020028D45FD>)
+ (#<recursive-lock "Telnet REPL Server Lock" [ptr @ #x10D880] #x30200279729D>)
+ (#<recursive-lock "telnet-stream" :status ((:locking
+ (funcall "#<STANDARD-METHOD COM.INFORMATIMAGO.CLEXT.TELNET.STREAM::INPUT-BUFFER-FETCH-OCTET (COM.INFORMATIMAGO.CLEXT.TELNET.STREAM:TELNET-STREAM T)>" "#<TELNET-STREAM  #x3020028D75CD>" "NIL")
+ #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)
+ (:locking
+ (com.informatimago.clext.telnet.stream::%stream-read-char "#<TELNET-STREAM #x3020028D75CD>" "NIL")
+ #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)) #x3020028D74BD>
+ (:locking
+ (funcall "#<STANDARD-METHOD COM.INFORMATIMAGO.CLEXT.TELNET.STREAM::INPUT-BUFFER-FETCH-OCTET (COM.INFORMATIMAGO.CLEXT.TELNET.STREAM:TELNET-STREAM T)>" "#<TELNET-STREAM #x3020028D75CD>" "NIL")
+ #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)
+ (:locking
+ (com.informatimago.clext.telnet.stream::%stream-read-char "#<TELNET-STREAM #x3020028D75CD>" "NIL")
+ #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)) nil
+ |#
  )

 #|
@@ -150,18 +151,18 @@ and WITH-LOCK-HELD to record the locking thread."))
 #+BEGIN_EXAMPLE
  (map nil 'print (com.informatimago.common-lisp.cesarum.utility:hash-table-entries *status*))

- (#<recursive-lock "down-layer" [ptr @ #x605080] #x3020028D45FD>)
- (#<recursive-lock "Telnet REPL Server Lock" [ptr @ #x10D880] #x30200279729D>)
- (#<recursive-lock "telnet-stream" :status ((:locking
+ (#<recursive-lock "down-layer" [ptr @ #x605080] #x3020028D45FD>)
+ (#<recursive-lock "Telnet REPL Server Lock" [ptr @ #x10D880] #x30200279729D>)
+ (#<recursive-lock "telnet-stream" :status ((:locking
                                              (funcall "#<STANDARD-METHOD COM.INFORMATIMAGO.CLEXT.TELNET.STREAM::INPUT-BUFFER-FETCH-OCTET (COM.INFORMATIMAGO.CLEXT.TELNET.STREAM:TELNET-STREAM T)>" "#<TELNET-STREAM  #x3020028D75CD>" "NIL")
                                              #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)
                                             (:locking
                                              (com.informatimago.clext.telnet.stream::%stream-read-char "#<TELNET-STREAM #x3020028D75CD>" "NIL")
-                                             #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)) #x3020028D74BD>
+                                             #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)) #x3020028D74BD>
                    (:locking
                     (funcall "#<STANDARD-METHOD COM.INFORMATIMAGO.CLEXT.TELNET.STREAM::INPUT-BUFFER-FETCH-OCTET (COM.INFORMATIMAGO.CLEXT.TELNET.STREAM:TELNET-STREAM T)>" "#<TELNET-STREAM #x3020028D75CD>" "NIL")
                     #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)
-                   (:locking
+                   (:locking
                     (com.informatimago.clext.telnet.stream::%stream-read-char "#<TELNET-STREAM #x3020028D75CD>" "NIL")
                     #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)) nil
 #+END_EXAMPLE
@@ -172,7 +173,7 @@ and WITH-LOCK-HELD to record the locking thread."))
 ccl condition-variables are not named;
 bordeaux-threads ignores the name parameter.
 So we shadow make-condition-variable and record the name
-of the condition variables in a
+of the condition variables in a

 #+BEGIN_CODE lisp
 (in-package "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH")
@@ -192,3 +193,4 @@ of the condition variables in a
 #+END_CODE

 |#
+
diff --git a/clext/telnet/packages.lisp b/clext/telnet/packages.lisp
index d7642c1..60c7e8c 100644
--- a/clext/telnet/packages.lisp
+++ b/clext/telnet/packages.lisp
@@ -40,6 +40,7 @@


 ;; (push :debug-condition-variables *features*)
+;; (member :debug-condition-variables *features*)

 #+(and ccl debug-condition-variables)
 (defpackage "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH"
@@ -49,6 +50,7 @@
   (:documentation "Implements bt:make-condition-variable on ccl to print the name."))


+
 (defpackage "COM.INFORMATIMAGO.CLEXT.TELNET.STREAM"
   (:use "COMMON-LISP"
         "BORDEAUX-THREADS"
diff --git a/clext/telnet/telnet-stream-test.lisp b/clext/telnet/telnet-stream-test.lisp
index 344fdda..3b7a2fc 100644
--- a/clext/telnet/telnet-stream-test.lisp
+++ b/clext/telnet/telnet-stream-test.lisp
@@ -7,15 +7,22 @@
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.CHARACTER-SETS"
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.ARRAY"
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STRING"
+        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.LIST"
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SIMPLE-TEST"
         "COM.INFORMATIMAGO.CLEXT.CHARACTER-SETS"
         "COM.INFORMATIMAGO.CLEXT.BABEL-EXTENSION"
         "COM.INFORMATIMAGO.CLEXT.TELNET.STREAM"
         "COM.INFORMATIMAGO.CLEXT.TELNET.TEST.STUB-NVT")
   (:import-from "COM.INFORMATIMAGO.CLEXT.TELNET.STREAM"
-                "MAKE-BINARY-BUFFER" "NVT" "OUTPUT-BUFFER"
-                "ENCODE-STRING-TO-OUTPUT-BUFFER"
-                )
+                "OCTET"
+                "MAKE-BINARY-BUFFER" "NVT"
+                "OUTPUT-BUFFER" "ENCODE-STRING-TO-OUTPUT-BUFFER"
+                "INPUT-BUFFER"  "INPUT-BUFFER-APPEND-OCTETS"
+                "INPUT-BUFFER-READ-OCTET"
+                "+INPUT-BUFFER-SIZE+"
+                "INPUT-BUFFER-DATA"
+                "INPUT-BUFFER-HEAD"
+                "INPUT-BUFFER-TAIL")
   (:export "TEST/ALL"))
 (in-package "COM.INFORMATIMAGO.CLEXT.TELNET.STREAM.TEST")

@@ -69,8 +76,79 @@
       (check equalp buffer bytes (buffer bytes)))))


+(define-test test/input-buffer-append-octets ()
+  (let* ((stream (make-instance 'telnet-stream
+                                :element-type 'character))
+         (nvt    (make-instance 'stub-nvt
+                                :name "STUB NVT"
+                                :client nil
+                                :up-sender stream
+                                :down-sender nil)))
+    (setf (slot-value stream 'nvt) nvt)
+    (let* ((smallest 32)
+           (bytes (coerce (iota 95 smallest) '(vector octet))))
+      (assert-true (= +input-buffer-size+
+                      (length (input-buffer-data (input-buffer stream)))))
+      (assert-true (plusp (rem +input-buffer-size+ (length bytes))) ()
+                   "We expected (plusp (rem +input-buffer-size+ ~A)) but it's zero."
+                   (length bytes))
+
+      (loop ; fill the buffer (truncate 4096 95) -> 43 times, remains 11 free.
+            :repeat (truncate (length (input-buffer-data (input-buffer stream)))
+                              (length bytes))
+
+            :for head := (input-buffer-head (input-buffer stream))
+            :for tail := (input-buffer-tail (input-buffer stream))
+            :do (input-buffer-append-octets stream bytes 0 (length bytes))
+                (let* ((buffer (input-buffer stream)))
+                  (check = (input-buffer-head buffer) 0                       (buffer bytes))
+                  (check = (input-buffer-head buffer) head                    (buffer bytes))
+                  (check = (input-buffer-tail buffer) (+ tail (length bytes)) (buffer bytes))
+                  (check equalp
+                         (subseq (input-buffer-data buffer) tail (input-buffer-tail buffer))
+                         bytes (buffer bytes))))
+
+      (let ((size 1000))
+
+        (loop
+          :repeat size
+          :with head := (input-buffer-head (input-buffer stream))
+          :with tail := (input-buffer-tail (input-buffer stream))
+          :for i :from 0
+          :for expected := (+ smallest (mod i (length bytes)))
+          :for byte := (input-buffer-read-octet stream)
+          :do (let* ((buffer (input-buffer stream)))
+                (assert-true (= byte expected) (byte expected))
+                (check = (input-buffer-head buffer) (+ head i 1)   (buffer bytes))
+                (check = (input-buffer-tail buffer) tail           (buffer bytes))))
+
+        (let* ((remains (rem (length (input-buffer-data (input-buffer stream)))
+                             (length bytes)))
+               (head (input-buffer-head (input-buffer stream)))
+               (tail (input-buffer-tail (input-buffer stream))))
+          (input-buffer-append-octets stream bytes 0 (length bytes))
+          (let* ((buffer (input-buffer stream)))
+            (check = (input-buffer-head buffer) size                     (buffer bytes))
+            (check = (input-buffer-head buffer) head                     (buffer bytes))
+            (check = (input-buffer-tail buffer)
+                   (mod (+ tail (length bytes)) (length (input-buffer-data buffer)))
+                   (buffer bytes))
+            (check < (input-buffer-tail buffer) (input-buffer-head buffer)
+                   (buffer bytes))
+            (check equalp
+                   (subseq (input-buffer-data buffer) tail (length (input-buffer-data buffer)))
+                   (subseq bytes 0 remains)
+                   (buffer bytes))
+            (check equalp
+                   (subseq (input-buffer-data buffer) 0 (- (length bytes) remains))
+                   (subseq bytes remains)
+                   (buffer bytes))))))))
+
+
 (define-test test/all ()
   (test/replace-octets-by-string)
-  (test/encode-string-to-output-buffer))
+  (test/encode-string-to-output-buffer)
+  (test/input-buffer-append-octets))

+;; (setf *DEBUG-ON-FAILURE* t)
 (test/all)
diff --git a/clext/telnet/telnet-stream.lisp b/clext/telnet/telnet-stream.lisp
index d6678c2..dae293b 100644
--- a/clext/telnet/telnet-stream.lisp
+++ b/clext/telnet/telnet-stream.lisp
@@ -386,7 +386,10 @@ conected to the NVt."
     :with buffer := (make-binary-buffer +down-layer-buffer-size+)
     :until (funcall (stop-closure (client self)))
       :initially (setf (fill-pointer buffer) 1)
-    :do (setf (aref buffer 0) (read-byte stream))
+    :do (handler-case (setf (aref buffer 0) (read-byte stream))
+          (end-of-file ()
+            (receive (nvt self) :end-of-file)
+            (return-from input-loop)))
         (format-log "~&down-layer received from remote: ~S~%"
                 buffer)
         (force-output *log-output*)
@@ -697,12 +700,13 @@ we may decode them from the input-buffer.
 (declaim (inline %input-buffer-length))

 (defun %input-buffer-ranges (buffer len)
+  "Return the ranges of free bytes in the buffer s1 e1 s2 e2 and the new tail position if len bytes are added."
   (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)))))
+        (values tail (+ tail len)  nil nil          (+ tail len))
+        (values tail (+ tail max1) 0   (- len max1) (mod (+ tail len) size)))))
 (declaim (inline %input-buffer-ranges))

 (defun %wait-for-input-free-space (stream required)
@@ -771,7 +775,8 @@ we may decode them from the input-buffer.
       (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)))
+  (let* ((end (or end (length octets)))
+         (len (- end start)))
     (when (plusp len)
       (with-lock-held ((stream-lock stream))
         (%wait-for-input-free-space stream len)
@@ -779,7 +784,7 @@ we may decode them from the input-buffer.
         (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))
+            (replace data octets :start1 s1 :end1 e1 :start2 start :end2 (+ start (- e1 s1)))
             (when s2
               (replace data octets :start1 s2 :end1 e2 :start2 (+ start (- e1 s1)) :end2 end))
             (setf (input-buffer-tail buffer) nt))))
@@ -830,7 +835,7 @@ we may decode them from the input-buffer.
            (head   (input-buffer-head buffer))
            (size   (length data)))
       (prog1 (aref data head)
-        (setf (input-buffer-data buffer) (mod (+ data 1) size))))))
+        (setf (input-buffer-head buffer) (mod (1+ head) size))))))

 ;; (defmethod input-buffer-read-octets ((stream telnet-stream) octets &key (start 0) end)
 ;;   (with-lock-held ((stream-lock stream))
ViewGit