diff --git a/loop.nw b/loop.nw index 7cf5eb8..d2fa40b 100644 --- a/loop.nw +++ b/loop.nw @@ -537,7 +537,15 @@ mark such responses with [[multi-line]]. <>= (defun empty-response () (make-response :code 400 :data "I beg your pardon?")) + (defun prepend-response-with (message r) + (make-response + :code (response-code r) + :data (list message (crlf) (response-data r)) + :multi-line (response-multi-line r) + :request (response-request r))) + +(defun prepend-response-with-old (message r) (make-response :code (response-code r) :data (data message (crlf) (response-data r)) @@ -559,6 +567,20 @@ Here's how to send a [[response]] to a client. (t (error (format nil "append-crlf-if-needed: unsupported type: ~a" (type-of seq)))))) (defun send-response! (r) + ;; Write the response code and a space + (send-chunk! (integer->string (response-code r)) *standard-output*) + (send-chunk! " " *standard-output*) + ;; Write the actual payload (status text + article body) + (send-chunk! (response-data r) *standard-output*) + ;; Ensure a CRLF at the end of the payload + (send-chunk! (crlf) *standard-output*) + (when (response-multi-line r) + (send-chunk! "." *standard-output*) + (send-chunk! (crlf) *standard-output*)) + (force-output) + r) + +(defun send-response-old! (r) (let ((bs (data (integer->string (response-code r)) " " (append-crlf-if-needed (response-data r))))) (my-write bs *standard-output*) @@ -571,11 +593,14 @@ Here's how to send a [[response]] to a client. r) @ %def send-response! -The Windows Console---the one we use when we run {\tt cmd.exe}---makes -the Lisp procedure [[write-sequence]] produce UCS-2. Windows will do -what we need of [[write-sequence]] if we're not operating \lp\ on the -Windows Console. Recall that we do not run \lp\ on Windows Console, -so whatever happens because of it is of little importance to us. +{\bf XXX: dead paragraph}. (We're not running Windows anymore and +perhaps we're never going back to it? I believe this procedure could +be just the else clause. Check it and clean this up.) The Windows +Console---the one we use when we run {\tt cmd.exe}---makes the Lisp +procedure [[write-sequence]] produce UCS-2. Windows will do what we +need of [[write-sequence]] if we're not operating \lp\ on the Windows +Console. Recall that we do not run \lp\ on Windows Console, so +whatever happens because of it is of little importance to us. However, we implement \lp\ on Windows and so it's convenient for us that \lp\ and Windows play nicely with each other. A cheap solution here is to simply convert the bytes to a string if \lp\ is directly @@ -921,14 +946,16 @@ We now write some procedures that we use when we're build the {\em (let* ((a-string (fetch-article g i)) (a-parsed (parse-article a-string)) (headers (parse-headers (article-headers a-parsed)))) - (enrich-headers headers a-string))) + (enrich-headers headers a-string a-parsed))) -(defun enrich-headers (hs a) +(defun enrich-headers (hs a-raw a-parsed) (append hs - `(("line-count" . ,(format nil "~a" (nlines (article-body (parse-article a))))) - ("byte-count" . ,(format nil "~a" (length a)))))) + `(("line-count" . ,(format nil "~a" (nlines (article-body a-parsed)))) + ("byte-count" . ,(format nil "~a" (length a-raw)))))) -(defun nlines (v) (length (split-vector (crlf) v nil))) +(defun nlines (v) + (loop for b across v + count (= b 10))) @ %def get-header fetch-headers \section{How to extract articles from the database} @@ -958,16 +985,6 @@ interpreting such bytes. That's why we call [[read-sequence]] here. (article-body (parse-article (fetch-article g i)))) @ %def fetch-article -The purpose of [[encode-body]] is to eventually worry about the -appearance of a period on a line by itself in the middle of an -article. Since ``\verb|.\r\n|'' is part of the NNTP protocol, we must -handle this gracefully---but notice we have not done anything about -that so far. So we are essentially writing a bug right here. - -<>= -(defun encode-body (a) a) -@ %def encode-body - The procedures [[extract-mid]] and [[lookup]] also belong belong in this section. Notice that I also wrote [[mid-by-name]], which should merge with [[extract-mid]]. I think I also wrote more @@ -1562,11 +1579,11 @@ Section~\ref{sec:index} for the implementation of the index. (typical-cmd-head-body-article r #'article-response)) (defun article-response (r g i) - (typical-cmd-response 220 r g i #'(lambda (a) (encode-body a)))) + (typical-cmd-response 220 r g i #'(lambda (a) a))) (defun head-response (r g i) (typical-cmd-response 221 r g i #'(lambda (a) (article-headers (parse-article a))))) (defun body-response (r g i) - (typical-cmd-response 222 r g i #'(lambda (a) (encode-body (article-body (parse-article a)))))) + (typical-cmd-response 222 r g i #'(lambda (a) (article-body (parse-article a))))) @ In processing such commands, we need to verify the existence of files @@ -1963,10 +1980,33 @@ lines. Otherwise, we continue by attaching the new line to the end of our accumulated list of lines. <>= -(defun nntp-read-article (&optional acc) +(defun nntp-read-article () + ;; Returns a vector of bytes: the article, CRLF between lines, up to + ;; (excluding) the "." terminator. VECTOR-PUSH-EXTEND grows the + ;; buffer in amortized O(1) per push, so total cost is O(article + ;; size) rather than O(article size^2). + (let ((buf (make-array 8192 + :element-type '(unsigned-byte 8) + :adjustable t + :fill-pointer 0))) + (loop + (let ((ls (nntp-read-line))) + (stderr "nntp-read-line: [~A]" ls) + (when (eq ls :eof) (error 'end-of-file :stream *standard-input*)) + (when (end-of-article? ls) (return buf)) + (map nil (lambda (b) (vector-push-extend b buf)) ls) + (vector-push-extend 13 buf) + (vector-push-extend 10 buf))))) + +(defun end-of-article? (ls) + ;; A line is the NNTP terminator only if it's exactly the single byte + ;; 46 (#\.). LENGTH/ELT instead of EQUAL-against-a-list, since + ;; NNTP-READ-LINE hands back a vector. + (and ls (not (eq ls :eof)) (= (length ls) 1) (= (elt ls 0) 46))) + +(defun nntp-read-article-slow (&optional acc) ;; Returns List-of Byte. (let* ((ls (nntp-read-line))) - (stderr "I read: [~A]" ls) (cond ;; a single period "." on a line marks the end of the ;; article. That is, 46 == (byte #\.) ((and (= 1 (length ls)) @@ -2265,6 +2305,18 @@ most complicated task of \Lp. All the rest is a total breeze. ((vectorp d) (vector->bytes d)) (t (error (format nil "type ~a is not supported" (type-of d)))))) +(defun send-chunk! (chunk s) + "Writes chunks sequentially to the stream." + (cond ((stringp chunk) + (my-write (string->bytes chunk) s)) + ((vectorp chunk) + (my-write chunk s)) + ((listp chunk) + (dolist (c chunk) + (send-chunk! c s))) + ((integerp chunk) + (write-byte chunk s)))) + (defun add-crlf-between (ls-of-ls) ;; Add \r\n to each ``line''. Returns List-of Byte. (mapcar #'(lambda (ls) (append ls (list 13 10))) ls-of-ls))