Goes low-level for fast reading.

loop.lisp

@@ -31,6 +31,15 @@
 (defparameter *months-inactive-allowed* 3)
 (defparameter *months-never-logged-in* 1)
 (defparameter *enable-nntp-repl* t)
+(defstruct nntp-stream-buffer
+  (data (make-array 8192 :element-type '(unsigned-byte 8)))
+  (head 0 :type fixnum)
+  (tail 0 :type fixnum))
+
+(defparameter *network-buffer* (make-nntp-stream-buffer))
+
+(defun nntp-read-line (&optional (s *standard-input*))
+  (nntp-read-line-buffered s *network-buffer*))
 
 (defun table-of-commands ()
   `(("GROUP" ,#'cmd-group "sets the current group") 
@@ -876,9 +885,21 @@
             (content-type (get-header "content-type" headers)))
         (cond 
           ((stringp result) (values nil result))
-          ((not (text/plain? content-type))
+          ;((not (text/plain? content-type))
-           (values nil (format nil "content-type must be plain/text, but it's ~a" content-type)))
+          ; (values nil (format nil "content-type must be plain/text, but it's ~a" content-type)))
-          (t (values t nil)))))))
+          (t 
+           (let ((ngs (newsgroups-header->list (get-header "newsgroups" headers)))
+                 (ngs-dont-exist nil))
+             (dolist (g ngs)
+               (when (or (not (group-name-conforms? g))
+                         (not (group? g)))
+                 (push g ngs-dont-exist)))
+             (if (not (zerop (length ngs-dont-exist)))
+                 (values nil (format nil "the ~a ~a just ~a exist"
+                                     (word-plural (length ngs-dont-exist) "newsgroup")
+                                     (str:join ", " (sort ngs-dont-exist #'string<))
+                                     (word-plural (length ngs-dont-exist) "doesn't")))
+                 (values t nil)))))))))
 
 (defun text/plain? (header-s)
   ;; I say T when S begins with "text/plain" or when S is "".
@@ -953,29 +974,18 @@
                 :code 400 :request r
                 :data (format nil "Sorry. Your article doesn't conform: ~a." error)))
               (t (multiple-value-bind (code reply) (post bs)
+                   (update-last-post-date! (client-username *client*))
                    (make-response :code code :request r :data reply))))))))
 
 (defun post (bs)
   (let ((ngs (newsgroups-header->list 
               (get-header "newsgroups" (parse-headers
-                                        (article-headers
+                                         (article-headers
-                                         (parse-article bs))))))
+                                          (parse-article bs)))))))
-        (ngs-dont-exist))
+    (dolist (ng ngs)
-    (dolist (g ngs)
+      (let ((a (ensure-date (ensure-mid bs))))
-      (if (or (not (group-name-conforms? g))
+        (save-article-insist ng (get-next-article-id ng) a (extract-mid a))))
-              (not (group? g)))
+    (values 240 (data "Thank you! Your article has been saved."))))
-          (push g ngs-dont-exist)))
-    (if (zerop (length ngs-dont-exist))
-        (progn
-          (dolist (ng ngs)
-            (let ((a (ensure-date (ensure-mid bs))))
-              (save-article-insist ng (get-next-article-id ng) a (extract-mid a))
-              (update-last-post-date! (client-username *client*))))
-          (values 240 (data "Thank you! Your article has been saved.")))
-        (values 400 (data "Sorry. We did not post your article to any newsgroup because "
-                          "the " (word-plural (length ngs-dont-exist) "newsgroup") " " 
-                          (str:join ", " (sort ngs-dont-exist #'string<))
-                          " just " (word-plural (length ngs-dont-exist) "doesn't") " exist.")))))
 
 (defun newsgroups-header->list (s)
   (mapcar #'(lambda (n) (str:trim (string-downcase n))) (str:split "," s)))
@@ -1021,19 +1031,172 @@
 
 (defun nntp-read-article (&optional acc)
   ;; Returns List-of Byte.
-  (let* ((ls (ucs-2->ascii (nntp-read-line))))
+  (let* ((ls (nntp-read-line)))
-    (cond ;; 46 == (byte #\.)
+    (stderr "I read: [~A]" ls)
-      ((equal (list 46) ls) (flatten (add-crlf-between acc))) 
+    (cond ;; a single period "." on a line marks the end of the
-      (t (nntp-read-article (append acc (list ls)))))))
+          ;; article.  That is, 46 == (byte #\.)
+      ((and (= 1 (length ls)) 
+            (= 46 (aref ls 0)))
+       (flatten (add-crlf-between acc)))
+      (t 
+       (nntp-read-article 
+        (append acc (list (coerce ls 'list))))))))
 
-(defun nntp-read-line (&optional (s *standard-input*) acc)
+(defun nntp-read-line-buffered (stream buffer)
-  ;; Returns List-of Byte.
+  (if (interactive-stream-p stream)
+      (get-interactive-line stream)
+      (let* ((data (nntp-stream-buffer-data buffer))
+             (capacity (length data)))
+        (labels
+            ((find-lf (start end)
+               (position 10 data :start start :end end))
+             (extract-line (lf-pos)
+               (let* ((start    (nntp-stream-buffer-head buffer))
+                      (end-line (if (and (> lf-pos start)
+                                         (= (aref data (1- lf-pos)) 13))
+                                    (1- lf-pos) ; strip the preceding cr
+                                    lf-pos))
+                      (line     (subseq data start end-line)))
+                 (setf (nntp-stream-buffer-head buffer) (1+ lf-pos))
+                 line))
+             (refill-and-extract-line ()
+               (let* ((head      (nntp-stream-buffer-head buffer))
+                      (tail      (nntp-stream-buffer-tail buffer))
+                      (remaining (- tail head)))
+                 (when (= remaining capacity)
+                   (stderr "line too long in the network buffer: [~A]"
+                           (subseq data head tail))
+                   (error "no space left on the network buffer for the current line"))
+                 ;; There is space for more lines, but there's a
+                 ;; partial line waiting to be completed, so we'll
+                 ;; shift it to the begining of the buffer, so we can
+                 ;; have more space (as %unix-read might produce more
+                 ;; data below).
+                 (when (> remaining 0)
+                   (replace data data :start1 0 :start2 head :end2 tail))
+                 (setf (nntp-stream-buffer-head buffer) 0)
+                 (setf (nntp-stream-buffer-tail buffer) remaining)
+                 ;; Do the actual reading: we'll block until bytes
+                 ;; arrive and return whatever the kernel has for us.
+                 (let* ((n (%unix-read stream data remaining (- capacity remaining)))
+                        (new-tail (+ remaining n)))
+                   (setf (nntp-stream-buffer-tail buffer) new-tail)
+                   (let ((lf-pos (find-lf remaining new-tail)))
+                     (if lf-pos
+                         (extract-line lf-pos)
+                         (refill-and-extract-line))))))) ; still no lf; keep reading
+          ;; the main program
+          (let ((lf-pos (find-lf (nntp-stream-buffer-head buffer)
+                                 (nntp-stream-buffer-tail buffer))))
+            (if lf-pos
+                (extract-line lf-pos) ; line already in buffer; no i/o at all
+                (refill-and-extract-line)))))))
+
+(defun %unix-read (stream buf start max-count)
+  ;;; ──────────────────────────────────────
+  ;;; One POSIX read(2) on STREAM's underlying fd.
+  ;;;
+  ;;; Blocks until at least one byte arrives, then returns immediately with
+  ;;; however many bytes the kernel has buffered (up to MAX-COUNT).
+  ;;; Retries transparently on EINTR (signals can interrupt system calls).
+  ;;; Signals END-OF-FILE when the peer closes the connection.
+  ;;; ──────────────────────────────────────
+  (let ((fd (sb-sys:fd-stream-fd (fd-stream-of stream))))
+    (sb-sys:with-pinned-objects (buf)
+      (loop
+        (multiple-value-bind (n err)
+            (sb-unix:unix-read fd
+                               (sb-sys:sap+ (sb-sys:vector-sap buf) start)
+                               max-count)
+          (cond
+            ((and (null n) (= err sb-unix:eintr)))   ; signal interrupted syscall – retry
+            ((or (null n) (zerop n))
+             (error 'end-of-file :stream stream))     ; error or clean EOF (client closed)
+            (t (return n))))))))                       ; got at least one byte
+
+(defun fd-stream-of (stream)
+  "Peel away SYNONYM-STREAM and TWO-WAY-STREAM wrappers until we reach
+   the underlying FD-STREAM.  Signals a clear error if no FD-STREAM is found."
+  (etypecase stream
+    (sb-sys:fd-stream  stream)
+    (synonym-stream    (fd-stream-of (symbol-value (synonym-stream-symbol stream))))
+    (two-way-stream    (fd-stream-of (two-way-stream-input-stream stream)))))
+
+(defun nntp-read-line-buffered-old (stream buffer)
+  (if (interactive-stream-p stream)
+      (get-interactive-line stream)
+      (let ((data (nntp-stream-buffer-data buffer)))
+        (labels ((find-lf (start end)
+                   (position 10 data :start start :end end))
+                 (extract-line (lf-pos)
+                   (let* ((start (nntp-stream-buffer-head buffer))
+                          ;; if the previous byte is CR, strip it out
+                          (end-line (if (and (> lf-pos start) (= (aref data (1- lf-pos)) 13))
+                                        (1- lf-pos)
+                                        lf-pos))
+                          (line (subseq data start end-line)))
+                     ;; move the pointer past the LF and return the line
+                     (setf (nntp-stream-buffer-head buffer) (1+ lf-pos))
+                     line))
+                 (refill-and-extract-line ()
+                   (let* ((head (nntp-stream-buffer-head buffer))
+                          (tail (nntp-stream-buffer-tail buffer))
+                          (remaining (- tail head)))
+                     ;; first of all, if there's no more space, then
+                     ;; simply give up the entire operation. It's up
+                     ;; to the caller to decide what to do.
+                     (when (= remaining (length data))
+                       (stderr "line too long in the network buffer: [~A]" 
+                               (subseq data head remaining))
+                       (error "no space left on the network buffer for the current line"))
+                     ;; 1. shift remaining bytes to the beginning of the array
+                     (when (> remaining 0)
+                       (replace data data :start1 0 :start2 head :end2 tail))
+                     (setf (nntp-stream-buffer-head buffer) 0)
+                     (setf (nntp-stream-buffer-tail buffer) remaining)
+                     ;; 2. invoke read-sequence to fill the rest of the buffer
+                     (let* ((new-tail-pos (read-sequence data stream :start remaining)))
+                       (if (= new-tail-pos remaining)
+                           ;; no new bytes arrived, so I presume eof has arrived
+                           (if (> remaining 0)
+                               (let ((line (subseq data 0 remaining)))
+                                 (setf (nntp-stream-buffer-tail buffer) 0)
+                                 line)
+                               (error 'end-of-file :stream stream))
+                           (progn ;; new bytes arrived
+                             (setf (nntp-stream-buffer-tail buffer) new-tail-pos)
+                             
+                             (let ((lf-pos (find-lf remaining new-tail-pos)))
+                               (if lf-pos
+                                   (extract-line lf-pos)
+                                   (refill-and-extract-line))))))))) ; very long line
+          ;; --- main program ---
+          (let ((lf-pos (find-lf (nntp-stream-buffer-head buffer) (nntp-stream-buffer-tail buffer))))
+            (if lf-pos
+                (extract-line lf-pos) ; quickly extract a line
+                (refill-and-extract-line))))))) ; get more data from the network
+
+(defun get-interactive-line (stream)
+  (let ((line-bytes 
+         (make-array 0 
+                     :element-type '(unsigned-byte 8) 
+                     :adjustable t :fill-pointer 0)))
+    (loop for byte = (read-byte stream)
+          while byte
+          do (vector-push-extend byte line-bytes)
+          (when (= byte 10) (loop-finish)) ; 10 means LF = \n
+          finally 
+          (return 
+            (if (zerop (length line-bytes)) 
+                nil
+                line-bytes)))))
+
+(defun nntp-read-line-slow (&optional (s *standard-input*) acc) ;; Returns List-of Byte.
   (let ((x (read-byte s)))
     (cond ((or (null x) (= x 10)) 
            (let ((bs (and acc (nreverse (if (= (car acc) 13) (cdr acc) acc)))))
-             (stderr "<<< ~a~%" (bytes->string (ucs-2->ascii bs)))
              bs))
-          (t (nntp-read-line s (cons x acc))))))
+          (t (nntp-read-line-slow s (cons x acc))))))
 
 (defun list->bytes (ls)
   (mapcar #'data->bytes ls))
@@ -1393,7 +1556,8 @@
          (new-passwd (or given-passwd random-passwd)))
     (if (not (get-account username))
         (println "No such account ``~a''." username)
-        (multiple-value-bind (okay? problem) (change-passwd! username new-passwd)          (if okay?
+        (multiple-value-bind (okay? problem) (change-passwd! username new-passwd)          
+          (if okay?
               (println "Okay, account ~a now has password ``~a''." username new-passwd)
               (println "Sorry, could not change password: ~a." problem))))))
 
@@ -1445,12 +1609,18 @@
    :handler #'cli/main-with-handlers))
 
 (defun main-loop ()
-  (loop
+  (handler-case
-    (let* ((bs (nntp-read-line))
+      (loop
-           (ln (bytes->string (ucs-2->ascii bs))))
+       (let* ((bs (nntp-read-line))
-      (let ((r (send-response! (dispatch-line ln))))
+              (ln (bytes->string bs)))
-        (when (response-quit? r)
+         (let ((r (send-response! (dispatch-line ln))))
-          (return))))))
+           (when (response-quit? r)
+             (return)))))
+    (end-of-file (c)
+      (declare (ignore c))
+      (stderr "EOF~%"))
+    (error (e)
+      (stderr "fatal: ~A" e))))
 
 (defun request-quit? (r) (and r (string= 'quit (request-verb r))))
 

loop.nw

@@ -1,5 +1,6 @@
 % -*- mode: poly-noweb; -*-
 \documentclass[a4paper,11pt]{article}
+
 \usepackage[text={6.75in,10in},centering]{geometry}
 
 \usepackage{graphicx}
@@ -608,13 +609,21 @@ itself---so we can cascade actions based on a user's request.
 
 <<Main loop.lisp>>=
 (defun main-loop ()
-  (loop
+  (handler-case
-    (let* ((bs (nntp-read-line))
+      (loop
-           (ln (bytes->string (ucs-2->ascii bs))))
+       (let* ((bs (nntp-read-line))
-      (let ((r (send-response! (dispatch-line ln))))
+              (ln (bytes->string bs)))
-        (when (response-quit? r)
+         (let ((r (send-response! (dispatch-line ln))))
-          (return))))))
+           (when (response-quit? r)
+             (return)))))
+    (end-of-file (c)
+      (declare (ignore c))
+      (stderr "EOF~%"))
+    (error (e)
+      (stderr "fatal: ~A" e))))
+@ %def main-loop
 
+<<Main loop.lisp>>=
 (defun request-quit? (r) (and r (string= 'quit (request-verb r))))
 (defun response-quit? (r) (and r (request-quit? (response-request r))))
 
@@ -632,7 +641,7 @@ itself---so we can cascade actions based on a user's request.
    (make-response 
     :code 200 
     :data "<<Welcome message>>")))
-@ %def main main-loop
+@ %def main
 
 \noindent It's always useful to know which version exactly we're
 dealing with:
@@ -1837,6 +1846,7 @@ of trying to stop them.
                 :code 400 :request r
                 :data (format nil "Sorry. Your article doesn't conform: ~a." error)))
               (t (multiple-value-bind (code reply) (post bs)
+                   (update-last-post-date! (client-username *client*))
                    (make-response :code code :request r :data reply))))))))
 @ 
 
@@ -1853,8 +1863,7 @@ our index.  More to follow.)
                                           (parse-article bs)))))))
     (dolist (ng ngs)
       (let ((a (ensure-date (ensure-mid bs))))
-        (save-article-insist ng (get-next-article-id ng) a (extract-mid a))
+        (save-article-insist ng (get-next-article-id ng) a (extract-mid a))))
-        (update-last-post-date! (client-username *client*))))
     (values 240 (data "Thank you! Your article has been saved."))))
 
 (defun newsgroups-header->list (s)
@@ -1944,42 +1953,303 @@ allocated.  Notice that the argument [[name]] is an integer, so
 @ %def save-article-insist get-next-article-id
 
 {\bf How to read lines in the NNTP protocol?}  We've implemented the
-most trivial strategy possible.  It's also the slowest.  What I think
+most trivial strategy possible in [[nntp-read-line-slow]].  It's also
-we need to do here is to use [[vector-push-extend]].  But this is to
+the slowest, so we don't use it anymore but we keep it here to tell
-be done in [[nntp-read-line]].  I hope to be able to get a faster
+the story.  For speed reasons, life is complicated here, so let's take
-procedure in [[nntp-read-line]] and keep [[nntp-read-article]] as it
+things one at a time. First of all, how do we read an article?  Well,
-is. This is important to speed up posting.  For instance, if we allow
+we read a line and---if that line happens to be a lonely dot, then
-attachments (which we don't), the performance penalty is clearly
+that's the end of the article, so we just return a list of
-noticeable. %%TODO
+lines. Otherwise, we continue by attaching the new line to the end of
+our accumulated list of lines.
 
 <<Command post.lisp>>=
 (defun nntp-read-article (&optional acc)
   ;; Returns List-of Byte.
-  (let* ((ls (ucs-2->ascii (nntp-read-line))))
+  (let* ((ls (nntp-read-line)))
-    (cond ;; 46 == (byte #\.)
+    (stderr "I read: [~A]" ls)
-      ((equal (list 46) ls) (flatten (add-crlf-between acc))) 
+    (cond ;; a single period "." on a line marks the end of the
-      (t (nntp-read-article (append acc (list ls)))))))
+          ;; article.  That is, 46 == (byte #\.)
+      ((and (= 1 (length ls)) 
+            (= 46 (aref ls 0)))
+       (flatten (add-crlf-between acc)))
+      (t 
+       (nntp-read-article 
+        (append acc (list (coerce ls 'list))))))))
 @ %def nntp-read-article
 
-The NNTP protocol establishes that line termination is done with
+Now let's move to the complicated side of life.  This is the very
-\verb|\r\n|, but it's useful to support UNIX line terminations, too,
+heart of \Lp. Our data structure of interest here is a buffer with two
-because we are using the command-line and interacting directly with
+pointers into it, {\tt head} and {\tt tail}.  The head just points to
-the server using tools that will not always send \verb|\r\n| as line
+a place in the buffer where data yet to be consumed begins and {\tt
-termination.  For example, when someone is typing directly from the
+  tail} points to where it ends.  All data coming through the network
-keyboard and insert an empty line, we need the {\tt (and acc ...)}
+(or coming locally from someone's keyboard on standard input) is
-because sometimes the list [[acc]] comes out empty, but an empty line
+stored in this buffer.
-never comes from the NNTP protocol because there's is always a {\tt
+
-  CR} before {\tt LF}.
+<<Global variable to hold the connections spoken lines.lisp>>=
+(defstruct nntp-stream-buffer
+  (data (make-array 8192 :element-type '(unsigned-byte 8)))
+  (head 0 :type fixnum)
+  (tail 0 :type fixnum))
+
+(defparameter *network-buffer* (make-nntp-stream-buffer))
+
+(defun nntp-read-line (&optional (s *standard-input*))
+  (nntp-read-line-buffered s *network-buffer*))
+@ %def *network-buffer*
+
+Why do we need a fast procedure here? Because io is the slowest thing
+in computers.  For instance, if we allow attachments in posts (which
+we don't), the performance penalty is clearly noticeable.
+
+The procedure [[nntp-read-line-buffered]] is pretty much as fast as we
+can get, but it's considerably more complicated. One part of the
+complication is that, because information comes from the network, we
+could get partial lines.  I must also say that I was not able to get a
+general solution for both network and keyboard connections, which is
+why I'm using [[interactive-stream-p]] to detect whether I'm in a
+terminal-interactive session.  The NNTP protocol establishes that line
+termination is done with \verb|\r\n|, but it's useful to support UNIX
+line terminations, too, because we are using the command-line and
+interacting directly with the server using tools that will not always
+send \verb|\r\n| as line termination.
+
+When interactively, I do the slow thing---I read byte by byte and
+collect it up into the line-bytes array, which is the business of
+[[get-interactive-line]].  When not interactively, we'll have to face
+the complications.
+
+We have two important tools to tame the complication. The first is
+[[find-lf]], the procedure responsible to find the position of the
+linefeed in the network buffer.  Now [[extract-line]] returns a line
+stored in the buffer and [[refill-and-extract-line]] gets more data
+from the network and stores it into the buffer, returning a line after
+refilling.  We need to understand their dance in order to be
+comfortable with the main part of io of \Lp.
+
+How to read the procedure [[nntp-read-line-buffered]]? The procedure
+is an entire program and it has a library.  The main program is at the
+bottom.  We begin by trying to find a linefeed in the buffer.  If
+there is one, it's because there's an entire line to be extracted and
+consumed.  If there isn't a newline, it's either because the buffer is
+empty or because there's only a partial line in the buffer. A partial
+line must be joined with its remaining which is still to arrive from
+the network, so we refill the buffer.  Initially, of course, the
+buffer is completely empty, so the very first thing that happens is we
+invoke refill to extract a first line.
+
+What's the work of refilling it?  If the buffer is empty, then we just
+need to read more data and write it out onto the buffer.  The writing
+itself is actually done by [[read-sequence]], so our job is just to do
+the bookkeeping.  The very first thing to be done is to make sure that
+we have enough space for the next [[read-sequence]].  If someone sends
+a very long line, then we might run out of space.  We detect that by
+checking whether [[remaining]] is at the very end of the the buffer.
+This means we have no more space for even a single byte, so we throw
+an error and [[main-loop]] decides what to do.
+
+Another important thing to understand is that a partial line might be
+stored in the buffer after one or a few complete lines.  To view this
+situation properly, we should explain how [[extract-line]]
+works. Suppose the buffer has been filled with 2 lines and a third
+partial line.  (Is this realistic?  Certainly: anything could arrive
+from the network.)  Once [[extract-line]] is invoked, the first line
+is returned and the head of the buffer is moved past the first line.
+Then the subsequent line is returned and the head is moved again to
+the beginning of the third, partial line.  Because the line is now
+partial, more data will have to be read from the network.  That's when
+the check [[(> remaining 0)]] will evaluate to true.  Before we write
+more data into the buffer, we will move that partial line to the
+beginning of the buffer---that's the job of [[replace]].  With that in
+mind, we can close this chapter and open a new mental context having
+invoked [[read-sequence]] and read more bytes or having found eof.
+
+If an eof has been detected and we did have a partial line waiting to
+be completed, we will return that partial line to the caller and it's
+up to the caller to decide what to do with it.  Probably, the best
+thing to do is to log the fact and close the connection.  A partial
+line really indicates a client in trouble---in fact, the client itself
+has already closed the connection, since we read eof.  Nevertheless,
+it is our job to deliver everything we have to the caller, so we must
+do our duty here.
+
+If new bytes arrived, then we just search for a linefeed and extract
+the new line.  We should inquiry here why we're trying to extract a
+line in two places: after refilling the buffer and in the main
+program.  I think it's just trivial to do our jobs that way.  How
+would we do it otherwise?  We would have to redesign the dynamics
+between these procedures.
+
+As you can see, it's complicated.  I do feel uneasy that I am not
+somehow using a solution made in some advanced library.  This could be
+the case that we know so little about what's out there that we might
+need to dive into the work and do it ourselves.  I think understanding
+libraries is a lot of work, so if we are reinventing the wheel here, I
+think it is not bad for our education considering we want complete
+understanding of how our software works.  This is a deep discussion
+about how a programmer should conduct himself in his life, considering
+productivity and education.
 
 <<Command post.lisp>>=
-(defun nntp-read-line (&optional (s *standard-input*) acc)
+(defun nntp-read-line-buffered (stream buffer)
-  ;; Returns List-of Byte.
+  (if (interactive-stream-p stream)
+      (get-interactive-line stream)
+      (let* ((data (nntp-stream-buffer-data buffer))
+             (capacity (length data)))
+        (labels
+            ((find-lf (start end)
+               (position 10 data :start start :end end))
+             (extract-line (lf-pos)
+               (let* ((start    (nntp-stream-buffer-head buffer))
+                      (end-line (if (and (> lf-pos start)
+                                         (= (aref data (1- lf-pos)) 13))
+                                    (1- lf-pos) ; strip the preceding cr
+                                    lf-pos))
+                      (line     (subseq data start end-line)))
+                 (setf (nntp-stream-buffer-head buffer) (1+ lf-pos))
+                 line))
+             (refill-and-extract-line ()
+               (let* ((head      (nntp-stream-buffer-head buffer))
+                      (tail      (nntp-stream-buffer-tail buffer))
+                      (remaining (- tail head)))
+                 (when (= remaining capacity)
+                   (stderr "line too long in the network buffer: [~A]"
+                           (subseq data head tail))
+                   (error "no space left on the network buffer for the current line"))
+                 ;; There is space for more lines, but there's a
+                 ;; partial line waiting to be completed, so we'll
+                 ;; shift it to the begining of the buffer, so we can
+                 ;; have more space (as %unix-read might produce more
+                 ;; data below).
+                 (when (> remaining 0)
+                   (replace data data :start1 0 :start2 head :end2 tail))
+                 (setf (nntp-stream-buffer-head buffer) 0)
+                 (setf (nntp-stream-buffer-tail buffer) remaining)
+                 ;; Do the actual reading: we'll block until bytes
+                 ;; arrive and return whatever the kernel has for us.
+                 (let* ((n (%unix-read stream data remaining (- capacity remaining)))
+                        (new-tail (+ remaining n)))
+                   (setf (nntp-stream-buffer-tail buffer) new-tail)
+                   (let ((lf-pos (find-lf remaining new-tail)))
+                     (if lf-pos
+                         (extract-line lf-pos)
+                         (refill-and-extract-line))))))) ; still no lf; keep reading
+          ;; the main program
+          (let ((lf-pos (find-lf (nntp-stream-buffer-head buffer)
+                                 (nntp-stream-buffer-tail buffer))))
+            (if lf-pos
+                (extract-line lf-pos) ; line already in buffer; no i/o at all
+                (refill-and-extract-line)))))))
+
+(defun %unix-read (stream buf start max-count)
+  ;;; ──────────────────────────────────────
+  ;;; One POSIX read(2) on STREAM's underlying fd.
+  ;;;
+  ;;; Blocks until at least one byte arrives, then returns immediately with
+  ;;; however many bytes the kernel has buffered (up to MAX-COUNT).
+  ;;; Retries transparently on EINTR (signals can interrupt system calls).
+  ;;; Signals END-OF-FILE when the peer closes the connection.
+  ;;; ──────────────────────────────────────
+  (let ((fd (sb-sys:fd-stream-fd (fd-stream-of stream))))
+    (sb-sys:with-pinned-objects (buf)
+      (loop
+        (multiple-value-bind (n err)
+            (sb-unix:unix-read fd
+                               (sb-sys:sap+ (sb-sys:vector-sap buf) start)
+                               max-count)
+          (cond
+            ((and (null n) (= err sb-unix:eintr)))   ; signal interrupted syscall – retry
+            ((or (null n) (zerop n))
+             (error 'end-of-file :stream stream))     ; error or clean EOF (client closed)
+            (t (return n))))))))                       ; got at least one byte
+
+(defun fd-stream-of (stream)
+  "Peel away SYNONYM-STREAM and TWO-WAY-STREAM wrappers until we reach
+   the underlying FD-STREAM.  Signals a clear error if no FD-STREAM is found."
+  (etypecase stream
+    (sb-sys:fd-stream  stream)
+    (synonym-stream    (fd-stream-of (symbol-value (synonym-stream-symbol stream))))
+    (two-way-stream    (fd-stream-of (two-way-stream-input-stream stream)))))
+
+(defun nntp-read-line-buffered-old (stream buffer)
+  (if (interactive-stream-p stream)
+      (get-interactive-line stream)
+      (let ((data (nntp-stream-buffer-data buffer)))
+        (labels ((find-lf (start end)
+                   (position 10 data :start start :end end))
+                 (extract-line (lf-pos)
+                   (let* ((start (nntp-stream-buffer-head buffer))
+                          ;; if the previous byte is CR, strip it out
+                          (end-line (if (and (> lf-pos start) (= (aref data (1- lf-pos)) 13))
+                                        (1- lf-pos)
+                                        lf-pos))
+                          (line (subseq data start end-line)))
+                     ;; move the pointer past the LF and return the line
+                     (setf (nntp-stream-buffer-head buffer) (1+ lf-pos))
+                     line))
+                 (refill-and-extract-line ()
+                   (let* ((head (nntp-stream-buffer-head buffer))
+                          (tail (nntp-stream-buffer-tail buffer))
+                          (remaining (- tail head)))
+                     ;; first of all, if there's no more space, then
+                     ;; simply give up the entire operation. It's up
+                     ;; to the caller to decide what to do.
+                     (when (= remaining (length data))
+                       (stderr "line too long in the network buffer: [~A]" 
+                               (subseq data head remaining))
+                       (error "no space left on the network buffer for the current line"))
+                     ;; 1. shift remaining bytes to the beginning of the array
+                     (when (> remaining 0)
+                       (replace data data :start1 0 :start2 head :end2 tail))
+                     (setf (nntp-stream-buffer-head buffer) 0)
+                     (setf (nntp-stream-buffer-tail buffer) remaining)
+                     ;; 2. invoke read-sequence to fill the rest of the buffer
+                     (let* ((new-tail-pos (read-sequence data stream :start remaining)))
+                       (if (= new-tail-pos remaining)
+                           ;; no new bytes arrived, so I presume eof has arrived
+                           (if (> remaining 0)
+                               (let ((line (subseq data 0 remaining)))
+                                 (setf (nntp-stream-buffer-tail buffer) 0)
+                                 line)
+                               (error 'end-of-file :stream stream))
+                           (progn ;; new bytes arrived
+                             (setf (nntp-stream-buffer-tail buffer) new-tail-pos)
+                             
+                             (let ((lf-pos (find-lf remaining new-tail-pos)))
+                               (if lf-pos
+                                   (extract-line lf-pos)
+                                   (refill-and-extract-line))))))))) ; very long line
+          ;; --- main program ---
+          (let ((lf-pos (find-lf (nntp-stream-buffer-head buffer) (nntp-stream-buffer-tail buffer))))
+            (if lf-pos
+                (extract-line lf-pos) ; quickly extract a line
+                (refill-and-extract-line))))))) ; get more data from the network
+@ %def nntp-read-line-buffered
+
+Phew! That was a lot! Take heart, though: you've just gone through the
+most complicated task of \Lp. All the rest is a total breeze.
+
+<<Command post.lisp>>=
+(defun get-interactive-line (stream)
+  (let ((line-bytes 
+         (make-array 0 
+                     :element-type '(unsigned-byte 8) 
+                     :adjustable t :fill-pointer 0)))
+    (loop for byte = (read-byte stream)
+          while byte
+          do (vector-push-extend byte line-bytes)
+          (when (= byte 10) (loop-finish)) ; 10 means LF = \n
+          finally 
+          (return 
+            (if (zerop (length line-bytes)) 
+                nil
+                line-bytes)))))
+
+(defun nntp-read-line-slow (&optional (s *standard-input*) acc) ;; Returns List-of Byte.
   (let ((x (read-byte s)))
     (cond ((or (null x) (= x 10)) 
            (let ((bs (and acc (nreverse (if (= (car acc) 13) (cdr acc) acc)))))
-             (stderr "<<< ~a~%" (bytes->string (ucs-2->ascii bs)))
              bs))
-          (t (nntp-read-line s (cons x acc))))))
+          (t (nntp-read-line-slow s (cons x acc))))))
 
 (defun list->bytes (ls)
   (mapcar #'data->bytes ls))
@@ -2029,17 +2299,17 @@ So the message here is that if an article is vetted by [[conforms?]],
 then it can be saved.  Any problem with the article must be reported
 by [[conforms?]].
 
-XXX: heads up. We have a [[catch]] here and a [[throw]] in
+Something to think about is that we have a [[catch]] here and a
-[[parse-headers]].  We also have a [[return]] here.  It's getting hard
+[[throw]] in [[parse-headers]].  We also have a [[return]] here.  It's
-to read this procedure because it's not easy to know that a procedure
+getting hard to read this procedure because it's not easy to know that
-has to return a certain value to match the expectation of another
+a procedure has to return a certain value to match the expectation of
-procedure. I don't remember what [[catch]] does.  I need to review
+another procedure. I don't remember what [[catch]] does.  I need to
-this and then add the explanation for myself.  If I don't remember how
+review this and then add the explanation for myself.  If I don't
-this works, other beginners won't know it either.  It's unclear right
+remember how this works, other beginners won't know it either.  It's
-now what the wise measure is, so we'll keep on moving.
+unclear right now what the wise measure is, so we'll keep on moving.
 
 <<Does an article conform?.lisp>>=
-(defun confor ms? (bs)
+(defun conforms? (bs)
   (catch 'article-syntax-error ;; parse-headers might throw
     (let ((headers (parse-headers (article-headers (parse-article bs)))))
       (let ((result (dolist (h (headers-required-from-clients))
@@ -2048,8 +2318,8 @@ now what the wise measure is, so we'll keep on moving.
             (content-type (get-header "content-type" headers)))
         (cond 
           ((stringp result) (values nil result))
-          ((not (text/plain? content-type))
+          ;((not (text/plain? content-type))
-           (values nil (format nil "content-type must be plain/text, but it's ~a" content-type)))
+          ; (values nil (format nil "content-type must be plain/text, but it's ~a" content-type)))
           (t 
            (let ((ngs (newsgroups-header->list (get-header "newsgroups" headers)))
                  (ngs-dont-exist nil))
@@ -2121,7 +2391,7 @@ all or it has been discussed with the community beforehand.
 
 \subsection{{\tt REPL}}
 
-\lp\ is totally {\em hackable}.  Users can say {\tt repl} to have
+\lp\ is {\em totally} hackable.  Users can say {\tt repl} to have
 complete control over their \lxxp\ process.
 
 <<Command repl.lisp>>=
@@ -2431,11 +2701,9 @@ We now implement some of the \hyperref[principles]{principles} exposed
 earlier on page~\pageref{principles}.  The program
 @<<cron-remove-inactive-users.lisp@>> would be run by {\tt cron} every 
 day (at midnight, say).  It checks all accounts that are inactive and
-either locks them (to be deleted later) or deletes them {\em for
+either locks them or deletes them {\em for
   good}.  If you want to keep accounts forever, just don't run the
-program.  XXX: our idea is to also delete {\em for good} all accounts
+program.  I've decided to never delete accounts that are inactive.
-that are locked (by the same period of time), but we have not yet done
-that.
 
 <<cron-remove-inactive-users.lisp>>=
 <<Quicklisp loading preamble.lisp>>
@@ -2480,12 +2748,8 @@ removed) from anyone's list of friends.  So, this involves scanning
 the entire list of accounts.  Also, notice that delete ``may modify
 {\em sequence}''.  More important is to understand that we really must
 {\tt setf} the return, otherwise we might find the deletion did not
-take effect---for example, when deleting the first element of a list.
+take effect---for example, when deleting the first element of a
-XXX: this deserves a better explanation, but if you know how linked
+list.
-lists are implemented in C, say, then you're likely well aware of how
-it works.  Months later I can't remember what the issue really is,
-though I remember what it is. Let's write a better explanation here as
-soon as we have enough energy to trace all the problem.
 
 <<How to remove inactive users.lisp>>=
 (defun remove-account! (username)
@@ -2961,6 +3225,7 @@ something to think about.
 <<Representation of articles.lisp>>
 <<Definition of maximum allowed inactive periods.lisp>>
 <<Global variable that decides whether to enable the NNTP REPL.lisp>>
+<<Global variable to hold the connections spoken lines.lisp>>
 @ 
 
 On which packages do we depend?