Identifies each binary with a version tag.

It also includes scripts for formating Lisp code for people who will
read Lisp code directly.  It doesn't cost us much to organize the Lisp
output a bit.  In a similar spirit, I'm not including NOWEB as part of
the build process.  (Most users will not have NOWEB around to use it.)
So while the Makefile is pretty short because there's little to do,
Anyfile is the ANYWEB makefile.  ANYWEB is my modified, personal
version of NOWEB for Windows.  (The way I use this second makefile is
to make a shell alias called /amake/ that automatically invokes ``make
-f Anyfile'' for me.)

Anyfile

@@ -0,0 +1,67 @@
+# -*- mode: makefile -*-
+include Makefile
+
+default: all
+
+all: loop.exe loop.lisp loop.asd scripts/build-exe.lisp \
+scripts/build-index-from-fs.lisp \
+scripts/cron-remove-inactive-users.lisp \
+scripts/migrate-add-creation-date.lisp
+
+loop.exe: scripts/build-exe.lisp loop.lisp loop.asd
+	sbcl --script scripts/build-exe.lisp
+	(test -f loop.exe && cmp loop loop.exe) || cp loop loop.exe
+
+loop.lisp: loop.nw
+	./make-release $$(git log --oneline | head -1 | awk '{print $$1}') \
+           loop.nw > loop.tmp && mv loop.tmp loop.nw
+	(any tangle -Rloop.lisp < loop.nw | sh format-def | \
+		dos2unix > loop.tmp || \
+		(rm loop.tmp && exit 1)) && \
+		mv loop.tmp loop.lisp
+
+loop.asd: loop.nw
+	(any tangle -Rloop.asd < loop.nw | dos2unix > loop-asd.tmp || \
+		(rm loop-asd.tmp && exit 1)) && \
+		mv loop-asd.tmp loop.asd
+
+scripts/build-exe.lisp: loop.asd loop.lisp loop.nw
+	(any tangle -Rbuild-exe.lisp < loop.nw | dos2unix > build-exe.tmp || \
+		(rm build-exe.tmp && exit 1)) && \
+	    mv build-exe.tmp scripts/build-exe.lisp
+
+scripts/build-index-from-fs.lisp: loop.nw
+	(any tangle -Rbuild-index-from-fs.lisp < loop.nw | dos2unix > \
+		build-index-from-fs.tmp || \
+		(rm build-index-from-fs.tmp && exit 1)) && \
+	    	mv build-index-from-fs.tmp scripts/build-index-from-fs.lisp
+
+scripts/cron-remove-inactive-users.lisp: loop.nw
+	(any tangle -Rcron-remove-inactive-users.lisp < loop.nw | dos2unix > \
+		cron-remove-inactive-users.tmp || \
+		(rm cron-remove-inactive-users.tmp && exit 1)) && \
+		mv cron-remove-inactive-users.tmp \
+			scripts/cron-remove-inactive-users.lisp
+
+scripts/migrate-add-creation-date.lisp: loop.nw
+	(any tangle -Rmigrate-add-creation-date.lisp < loop.nw | dos2unix > \
+		migrate-add-creation-date.tmp || \
+		(rm migrate-add-creation-date.tmp && exit 1)) && \
+		mv migrate-add-creation-date.tmp \
+			scripts/migrate-add-creation-date.lisp
+
+run: loop.nw
+	(any tangle -Rrun < loop.nw | dos2unix > run.tmp || \
+		(rm run.tmp && exit 1)) && \
+		mv run.tmp run && \
+		chmod 0755 run
+
+loop.tex: loop.nw
+	any weave -delay -index loop.nw | dos2unix > loop.tex
+
+loop.pdf: loop.tex
+	latexmk -pdf loop
+
+clean: 
+	rm -f loop loop.exe loop.asd loop.lisp loop.tex loop.pdf \
+	  *.fasl *.db .*~ *~ *.out *.aux *.log *.fls *.fdb_latexmk

README

@@ -6,20 +6,12 @@ LOOP is an NNTP server written in Common Lisp.
 
 We assume
 
-  - you run SBCL
+  - you run SBCL, Quicklisp and git installed
-
-  - you have Quicklisp installed and knows how to use it
-
   - you know how to use a TCP server such as 
-
       https://cr.yp.to/ucspi-tcp.html
-
+  - you know how to manage a daemon witha package such as
-  - you know how to manage a daemon with 
-
       https://cr.yp.to/daemontools.html
 
-  - you have git and knows how to use it
-
 (*) How to install it
 
 LOOP is not in the Quicklisp repository, so we'll instruct you to
@@ -34,9 +26,6 @@ and say
   $ echo /path/to/loop/home > conf-home
   $ make install
 
-If you just installed SBCL and quicklisp, the build might take a
-little while due to downloading dependencies.  Be patient.
-
 (*) Systems with no installation issues
 
 We installed LOOP just fine on
@@ -123,8 +112,8 @@ It's easy and fun.
 
 (*) LOOP's REPL
 
-LOOP is totally hackable.  Even if you're remotely connected, you can
+LOOP is hackable.  If you're remotely connected, you can get total
-have total control over the loop process with the repl command:
+control over the loop process using the repl command.
 
 $ telnet example.com 119
 Trying example.com...
@@ -137,16 +126,14 @@ repl
 LOOP> *client*
 #S(CLIENT :GROUP NIL :ARTICLE 1 :USERNAME YOU :AUTH? YES)
 LOOP> (list-groups)
-(comp.editors.emacs comp.lisp comp.programming comp.unix
+(local.control.news local.test)
-       humanities.poetry local.control.news local.havoc local.system.reports
-       local.test local.users.evalu math.calculus math.havoc)
 LOOP> quit
 200 Okay, no more REPL hacking.
 
 (*) Cron jobs
 
 If you'd like to remove inactive accounts, we wrote
-scripts/cron-remove-inactive-users.lisp.  Her's our crontab:
+scripts/cron-remove-inactive-users.lisp.  Here's our crontab:
 
 $ crontab -l
 @daily cd /path/to/loop/home && sbcl --script scripts/cron-remove-inactive-users.lisp

format-def

@@ -0,0 +1,27 @@
+#!/bin/sh
+usage()
+{
+  printf 'usage: %s [file.lisp]\n' $0
+  exit 1
+}
+## The first program finds certain definitions and inserts a new blank
+## line *before* the definition.  Such action makes function
+## definitions separated by two blank lines in some cases.  We then
+## remove the excess with the second program.  Notice we need the -E
+## option because we're using the | metacharacter that is only
+## supported by popular sed programs with the -E option.  This
+## violates POSIX sed, but keep in mind that we only run this when
+## releasing the package.  This is a building tool, not part of the
+## service.
+sed -E '/^\(defun |\(defmacro /{
+ i\
+
+}' $* | sed '/^[ \t]*$/{
+   N
+   /^[ \t]*\n$/D
+}'
+## We first find a blank line.  Then we say N to expand the pattern
+## space to include the next line.  Then we delete the *first* blank
+## line and not the second---that's what the D command does.  This
+## strategy is explained by Dale Dougherty and Arnold Robbins in ``sed
+## & awk'' second edition, pages 112--114.

loop.asd

@@ -1,6 +1,6 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; -*-
-(asdf:defsystem :loop
+(asdf:defsystem :LOOP
-  :version "0.1"
+  :version "9575ac2"
   :description "An NNTP server for a circle of friends."
   :depends-on (:lisp-unit :str :uiop :cl-ppcre :local-time :clsql-sqlite3 :clingon
                :filesystem-utils :ironclad/digest/sha256)

loop.lisp

@@ -30,6 +30,7 @@
 (defparameter *months-inactive-allowed* 3)
 (defparameter *months-never-logged-in* 1)
 (defvar *debug* nil)
+
 (defun table-of-commands ()
   `(("GROUP" ,#'cmd-group "sets the current group") 
     ("NEXT" ,#'cmd-next "increments the article pointer")
@@ -80,6 +81,7 @@
                 :verb 'unrecognized
                 :description "a command for all commands typed wrong")))
       (or (cdr cmd) (unrecognized-command)))))
+
 (defmacro in-dir (dir &rest body)
   `(let ((*default-pathname-defaults* (truename ,dir)))
      (uiop:with-current-directory (,dir)
@@ -187,6 +189,7 @@
 
 (defmacro mac (&rest body)
   `(macroexpand-1 ,@body))
+
 (defun repl (r)
   (in-package :loop)
   (loop
@@ -212,14 +215,20 @@
         (print/finish "^C~%")
       (uiop:quit 0))
       (t (c) 
-        (print/finish "Oops: ~a~%" c)))))
+        (print/finish 
+         "Oops: ~a~%" 
+         (str:collapse-whitespaces 
+          (str:replace-all (string #\linefeed) " " (fmt "~a" c))))))))
+
 (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 (data message (crlf) (response-data r))
    :multi-line (response-multi-line r)
    :request (response-request r)))
+
 (defun append-crlf-if-needed (seq)
   (cond 
     ((stringp seq)
@@ -241,10 +250,12 @@
       (stderr ">>> ~a" (bytes->string (ucs-2->ascii bs)))))
   (force-output)
   r)
+
 (defun my-write (ls-of-bytes s)
   (if (interactive-stream-p s)
       (write-sequence (mapcar #'code-char ls-of-bytes) s)
       (write-sequence ls-of-bytes s)))
+
 (defun parse-request (r)
   (let* ((collapsed-s (str:collapse-whitespaces (request-said r)))
          (ls (str:split " " collapsed-s :omit-nulls 'please)))
@@ -255,6 +266,7 @@
                (make-request :said (request-said r)
                              :verb (str:upcase verb)
                              :args args))))))
+
 (defun insert-index (m g i)
   (handler-case
       (clsql:insert-records 
@@ -280,6 +292,7 @@
          (art (second article)))
     (when found
       (values grp art))))
+
 (defun connect-index! (filename)
   (setq *default-database* (clsql:connect (list filename) :database-type :sqlite3)))
 
@@ -292,6 +305,7 @@
 (defun drop-create-index! ()
   (clsql:execute-command "drop table if exists indices")
   (create-index!))
+
 (defun remove-inactive-users! ()
   (loop for u in *accounts* do
     (let ((username (account-username u)))
@@ -316,6 +330,7 @@
                             (fmt "disappeared for over ~a months" 
                                  *months-inactive-allowed*))
              (format t "Locked ~a due to long-time-no-see.~%" username))))))
+
 (defun remove-account! (username)
   (loop for u in *accounts* do
         (setf (account-friends u)
@@ -329,6 +344,7 @@
     (setf (account-pass-locked u) (account-pass u))
     (setf (account-pass u) "locked")
     (setf (account-pass-locked-why u) why)))
+
 (defun user-inactive? (username)
   (or (inactive-from-never-logged-in? username)
       (inactive-from-last-seen? username)))
@@ -379,6 +395,7 @@
         (format t "Username ~a is inactive? ~a~%" 
                 (account-username u)
                 (user-inactive? (account-username u)))))
+
 (defun loop-epoch ()
   (encode-timestamp 0 0 0 0 1 1 2024))
 
@@ -389,6 +406,7 @@
                (setf (account-creation u) (timestamp-to-universal (loop-epoch)))
                (setf (account-last-post u) (account-seen u))))
   (write-accounts!))
+
 (defun split-vector (delim v acc &key limit (so-far 1))
   (let ((len (length v)))
     (split-vector-helper delim v len acc limit so-far 0)))
@@ -407,6 +425,7 @@
                   limit
                   (1+ so-far)
                   (+ pos (length delim))))))))
+
 (defun index-from-fs! ()
   (loop for path in (in-groups (directory "**/*"))
         do (let* ((g (str:trim (first (last (pathname-directory path)))))
@@ -419,6 +438,7 @@
 (defun remake-index-from-fs ()
   (drop-create-index!)
   (index-from-fs!))
+
 (defun parse-article (v)
   (let ((parts (split-vector (vector 13 10 13 10) v nil :limit 2)))
     (make-article :headers (map 'string #'code-char (car parts)) :body (cadr parts))))
@@ -446,6 +466,7 @@
     (mapcar #'(lambda (h) (parse-header h)) ls)))
 
 (defun string-integer? (s) (ignore-errors (parse-integer s)))
+
 (defun get-header-from-article (h a)
   (get-header h (parse-headers (article-headers (parse-article a)))))
 
@@ -465,6 +486,7 @@
      ("byte-count" . ,(format nil "~a" (length a))))))
 
 (defun nlines (v) (length (split-vector (crlf) v nil)))
+
 (defun fetch-article (g i)
   (in-groups
    (read-file-raw (format nil "~a/~a" g i))))
@@ -482,11 +504,15 @@
 
 (defun fetch-body (g i)
   (article-body (parse-article (fetch-article g i))))
+
 (defun encode-body (a) a)
+
 (defun extract-mid (a)
   (lookup "message-id" (parse-headers (article-headers (parse-article a)))))
+
 (defun lookup (key table)
   (cdr (assoc key table :test #'string=)))
+
 (defun dispatch (r)
   (let* ((verb (request-verb r)))
     (if (null verb)
@@ -495,6 +521,7 @@
 
 (defun dispatch-line (ln)
   (dispatch (parse-request (make-request :said ln))))
+
 (defun cmd-authinfo (r) 
   (let* ((args (mapcar #'str:upcase (request-args r))))
     (cond 
@@ -528,8 +555,10 @@
   (let ((u (get-account (client-username *client*))))
     (setf (account-seen u) (get-universal-time)))
   (write-accounts!))
+
 (defun cmd-mode (r) ;; Whatever.
   (make-response :code 200 :request r :data "Sure thing."))
+
 (defun typical-cmd-head-body-article (r fn-name)
   (with-auth
       (with-group-set
@@ -548,17 +577,22 @@
 
 (defun cmd-head (r)
   (typical-cmd-head-body-article r #'head-response))
+
 (defun cmd-body (r)
   (typical-cmd-head-body-article r #'body-response))
+
 (defun cmd-article (r)
   (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))))
+
 (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))))))
+
 (defun typical-cmd-response (code r g i get-data)
   (handler-case 
       (let ((a (fetch-article g i)))
@@ -575,6 +609,7 @@
       (make-response 
        :code 400 :request r 
        :data (format nil "article ~a/~a: ~a" g i c)))))
+
 (defun cmd-next (r)
   (with-auth
       (let ((g (client-group *client*))
@@ -595,6 +630,7 @@
 
 (defun mid-by-name (g name)
   (extract-mid (fetch-article g name)))
+
 (defun cmd-xover (r)
   (with-auth
       (with-group-set
@@ -635,13 +671,16 @@
                                         (member (car h) (xover-headers) 
                                                 :test #'string=))
                                     (fetch-headers g i)))))))))))
+
 (defun xover-format-line (i hs)
   (str:concat (format nil "~a~a" i #\tab)
               (str:join #\tab 
                         (mapcar #'(lambda (h) (get-header h hs))
                                 (xover-headers)))))
+
 (defun xover-headers ()
   '("subject" "from" "date" "message-id" "references" "line-count" "byte-count"))
+
 (defun cmd-group (r)
   (with-auth
       (with-n-args 1 r
@@ -712,7 +751,7 @@
   #+sbcl (apply #'directory directory :resolve-symlinks NIL args)
   #-(or allegro clozure digitool clisp cmucl scl lispworks sbcl)
   (apply #'directory directory args))
-  
+
 (defun loop-list-files (directory)
   (let ((directory (pathname-utils:to-directory directory)))
     (let* ((directory (pathname-utils:pathname* directory))
@@ -773,11 +812,13 @@
           #'string-lessp)))
 
 (defun last-char (s) (char s (1- (length s))))
+
 (defun basename (path)
   (let ((s (str:collapse-whitespaces path)))
     (if (char= #\/ (last-char s))
         (car (last (pathname-directory s)))
         (file-namestring s))))
+
 (defun cmd-help (r)
   (let ((lines (menu *commands-assoc*)))
     (prepend-response-with 
@@ -785,6 +826,7 @@
      (make-response :code 200 :multi-line 'yes
                     :request r 
                     :data (str:join (crlf-string) lines)))))
+
 (defun menu (ls)
   (if (null ls)
       nil
@@ -795,13 +837,16 @@
     (format nil "~A ~A" 
             (command-verb cmd) 
             (command-description cmd))))
+
 (defun cmd-quit (r)
   (make-response :code 205 :data "Good-bye." :request r))
+
 (defun cmd-date (r)
   (make-response :code 201
                  :request r
                  :data 
                  (format-timestring nil (now))))
+
 (defun conforms? (bs)
   (catch 'article-syntax-error ;; parse-headers might throw
     (let ((headers (parse-headers (article-headers (parse-article bs)))))
@@ -826,6 +871,7 @@
 
 (defun headers-required-from-clients ()
   '("from" "newsgroups" "subject"))
+
 (defun suggest-message-id (&optional (n 20))
   (format nil "<~a@loop>" (random-string n)))
 
@@ -837,6 +883,7 @@
     (dotimes (c size)
       (setq mid (cons (char universe (random len state)) mid)))
     (coerce mid 'string)))
+
 (defun unparse-article (parsed)
   (data
    (let ((ls))
@@ -845,6 +892,7 @@
      (nreverse ls))
    (crlf)
    (article-body parsed)))
+
 (defun ensure-header (h fn bs)
   (let* ((headers (parse-headers (article-headers (parse-article bs)))))
     (if (lookup h headers)
@@ -867,8 +915,10 @@
 
 (defun ensure-mid (bs)
   (ensure-header "message-id" #'suggest-message-id bs))
+
 (defun ensure-date (bs)
   (ensure-header "date" #'get-date bs))
+
 (defun newsgroups-header->list (s)
   (mapcar (lambda (n) (str:trim (string-downcase n))) (str:split "," s)))
 
@@ -907,9 +957,11 @@
                             (data " However, the groups "
                                   (str:join ", " (sort ngs-dont-exist #'string<))
                                   " just don't exist.")))))))
+
 (defun update-last-post-date! (username)
   (let ((u (get-account username)))
     (setf (account-last-post u) (get-universal-time))))
+
 (defun rename-no-extension (old new)
   (rename-file old (make-pathname :name new :type :unspecific)))
 
@@ -933,6 +985,7 @@
            :element-type '(unsigned-byte 8))
       (write-sequence bs s))
     (rename-no-extension tmp name)))
+
 (defun save-article-insist (g name a message-id)
   (loop for name from name do
     (in-dir (format nil "groups/~a/" g)
@@ -943,12 +996,14 @@
   (multiple-value-bind (low high len) (group-high-low g)
     (declare (ignore low len))
     (1+ high)))
+
 (defun nntp-read-article (&optional acc)
   ;; Returns List-of Byte.
   (let* ((ls (ucs-2->ascii (nntp-read-line))))
     (cond ;; 46 == (byte #\.)
       ((equal (list 46) ls) (flatten (add-crlf-between acc))) 
       (t (nntp-read-article (append acc (list ls)))))))
+
 (defun nntp-read-line (&optional (s *standard-input*) acc)
   ;; Returns List-of Byte.
   (let ((x (read-byte s)))
@@ -981,6 +1036,7 @@
 
 (defun bytes->string (ls)
   (map 'string #'code-char ls))
+
 (defun cmd-create-group (r)
   (with-n-args 1 r
     (let ((g (string-downcase (car (request-args r)))))
@@ -1009,6 +1065,7 @@
     (if okay? 
         (values t nil)
         (values nil "must match ^([a-z0-9]+)"))))
+
 (defun cmd-create-account (r)
   (with-auth 
       (with-n-args 1 r
@@ -1023,6 +1080,7 @@
                   (make-response :code 200 :request r
                                  :data (fmt "Okay, account ~a created with password ``~a''."
                                             username pass-or-error)))))))))
+
 (defun read-accounts! ()
   (let ((*package* (find-package '#:loop)))
     (with-open-file 
@@ -1053,6 +1111,7 @@
           (push a *accounts*)
           (write-accounts!)
           (values (str:upcase username) p)))))
+
 (defun write-accounts! ()
   (let ((name
           (loop 
@@ -1075,6 +1134,7 @@
   (loop for u in *accounts*
         do (when (string= (str:upcase username) (account-username u))
              (return u))))
+
 (defun cmd-unlock-account (r)
   (with-auth 
       (with-n-args 1 r
@@ -1102,6 +1162,7 @@
            (setf (account-pass u) (account-pass-locked u))
            (setf (account-pass-locked u) nil)
            (setf (account-pass-locked-why u) nil)))))
+
 (defun cmd-login (r) 
   (let* ((args (mapcar #'str:upcase (request-args r))))
     (cond 
@@ -1120,6 +1181,7 @@
 (defun log-user-in-as! (name)
   (setf (client-username *client*) name)
   (log-user-in!))
+
 (defun cmd-passwd (r) 
   (with-auth
       (let* ((args (mapcar #'str:upcase (request-args r))))
@@ -1197,8 +1259,10 @@
   (let ((u (get-account username)))
     (if u (let ((s (account-seen u)))
             (if s (universal-to-human s))))))
+
 (defun cmd-dd (r) 
   (make-response :code 200 :data (format nil "state: ~a" *client*) :request r))
+
 (defun cmd-repl (r)
   (with-auth
       (repl r)))
@@ -1265,6 +1329,7 @@
     :description "logging (on stderr)"
     :long-name "logging"
     :key :logging)))
+
 (defun cli/list-accounts ()
   (println (str:join (crlf-string) (list-users))))
 
@@ -1294,6 +1359,7 @@
           (if okay?
               (println "Okay, account ~a now has password ``~a''." username new-passwd)
               (println "Sorry, could not change password: ~a." problem))))))
+
 (defun cli/main-with-handlers (cmd)
   (handler-case 
       (cli/main cmd)
@@ -1330,7 +1396,7 @@
   (clingon:make-command
    :name "loop"
    :description "An NNTP server for a circle of friends."
-   :version "0.1"
+   :version "9575ac2"
    :license "GPL v3"
    :options (cli/options)
    :handler #'cli/main-with-handlers))
@@ -1344,6 +1410,7 @@
           (return))))))
 
 (defun request-quit? (r) (and r (string= 'quit (request-verb r))))
+
 (defun response-quit? (r) (and r (request-quit? (response-request r))))
 
 (defun server-start ()
@@ -1357,7 +1424,9 @@
 
 (defun send-banner! ()
   (send-response! 
-   (make-response :code 200 :data "Welcome! Say ``help'' for a menu.")))
+   (make-response 
+    :code 200 
+    :data "Welcome! I am LOOP 9575ac2. Say ``help'' for a menu.")))
 
 (setq lisp-unit:*print-failures* t)
 (define-test first-test-of-the-west

loop.nw

@@ -323,6 +323,7 @@ Section~\ref{sec:repl}.  Commands such as [[CREATE-ACCOUNT]],
 users need to know how to use {\tt nc} or {\tt telnet} to take
 advantage of all of \lp's capabilities.
 
+
 \section{NNTP protocol}
 
 An Internet protocol is usually defined by a document whose tradition
@@ -426,21 +427,12 @@ line, which is what causes that 400 response.
         (print/finish "^C~%")
       (uiop:quit 0))
       (t (c) 
-        (print/finish "Oops: ~a~%" c)))))
+        (print/finish 
+         "Oops: ~a~%" 
+         (str:collapse-whitespaces 
+          (str:replace-all (string #\linefeed) " " (fmt "~a" c))))))))
 @ %def repl
 
-\section{Description of the package}
-
-<<Description>>=
-An NNTP server for a circle of friends.
-@ 
-
-<<Version>>=
-0.1
-@ 
-
-These chunks are used in [[loop.asd]].
-
 \section{Representation of a client}
 
 How do we represent a client?  A client is typically reading a group
@@ -598,25 +590,6 @@ else should we handle this?
       (write-sequence ls-of-bytes s)))
 @ %def my-write
 
-\section{Parsing of requests}
-
-The commands themselves we call {\tt verbs} and everything else the
-user types we call {\tt args}.  Observe that upper and lower case
-letters are equivalent in request verbs.
-
-<<Procedures for requests and responses>>=
-(defun parse-request (r)
-  (let* ((collapsed-s (str:collapse-whitespaces (request-said r)))
-         (ls (str:split " " collapsed-s :omit-nulls 'please)))
-    ;; What are we going to do with a null request?
-    (cond ((null ls) (make-request :said (request-said r)))
-          (t (let ((verb (car ls))
-                   (args (cdr ls)))
-               (make-request :said (request-said r)
-                             :verb (str:upcase verb)
-                             :args args))))))
-@ %def parse-request
-
 \section{Main loop}
 
 Every command consumes a [[request]] and produces a [[response]].  If
@@ -654,9 +627,59 @@ itself---so we can cascade actions based on a user's request.
 
 (defun send-banner! ()
   (send-response! 
-   (make-response :code 200 :data "Welcome! Say ``help'' for a menu.")))
+   (make-response 
+    :code 200 
+    :data "<<Welcome message>>")))
 @ %def main main-loop
 
+\noindent It's always useful to know which version exactly we're
+dealing with:
+%
+\begin{verbatim}
+%./loop.exe
+200 Welcome! I am LOOP 9575ac2. Say ``help'' for a menu.
+\end{verbatim}
+%
+So we put a release tag on \lp's banner.
+
+<<Welcome message>>=
+Welcome! I am <<Name>> <<Version>>. Say ``help'' for a menu.
+@ 
+
+\noindent We take the opportunity and describe \lp's package,
+information which we also use in [[loop.asd]].
+
+<<Name>>=
+LOOP
+@ 
+
+<<Description>>=
+An NNTP server for a circle of friends.
+@ 
+
+<<Version>>=
+9575ac2
+@ 
+
+\section{Parsing of requests}
+
+The commands themselves we call {\tt verbs} and everything else the
+user types we call {\tt args}.  Observe that upper and lower case
+letters are equivalent in request verbs.
+
+<<Procedures for requests and responses>>=
+(defun parse-request (r)
+  (let* ((collapsed-s (str:collapse-whitespaces (request-said r)))
+         (ls (str:split " " collapsed-s :omit-nulls 'please)))
+    ;; What are we going to do with a null request?
+    (cond ((null ls) (make-request :said (request-said r)))
+          (t (let ((verb (car ls))
+                   (args (cdr ls)))
+               (make-request :said (request-said r)
+                             :verb (str:upcase verb)
+                             :args args))))))
+@ %def parse-request
+
 \section{Parsing of command-line arguments}
 
 We're using the clingon library as per Vincent Dardel suggestion in
@@ -2801,7 +2824,7 @@ The \lp\ system definition:
 
 <<loop.asd>>=
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; -*-
-(asdf:defsystem :loop
+(asdf:defsystem :<<Name>>
   :version "<<Version>>"
   :description "<<Description>>"
   :depends-on (<<List of packages to be loaded>>)

make-release

@@ -0,0 +1,14 @@
+#!/bin/sh
+usage()
+{
+  printf 'usage: %s tag file\n' $0
+  exit 1
+}
+test $# '<' 2 && usage
+tag="$1"
+shift
+sed "/<<Version>>=/ {
+ n;
+ c\\
+$tag
+}" $*