Lots of changes. (See full log.)

- Converts Makefile to UNIX line termination.

Makefiles cannot be formatted with DOS CRLF because, otherwise, we
could not escape \n to continue on a second line.  We end up escaping
\r and not \n.

- Adds install target.
- Fixes remove-account!

Procedure delete-if ``may modify sequence'', but we cannot be sure it
will modify it.  There are cases in which it does and there are cases
in which it doesn't.  Seeing it did modify in one case, I incorrectly
assumed it would modify in all cases---such is life.  Since I do want
to modify it always, I wrote delete-if*, which in calls setf to be
sure the list is overwritten.

- Avoids (load'ing "~/.sbclrc") and, instead, does what Quicklisp does.

It's not always the case that ~/.sbclrc exists.  But Quicklisp in each
installation knows what to do.  So we do what Quicklisp does in each
script that we use.

- Adds command-line parsing.
- Adds install target to Makefile.

Makefile

@@ -1,79 +1,64 @@
-SHELL=/bin/sh
+default:
-REMOTE=dbastos@antartida.xyz
+	@echo "Sorry. See Makefile to know what I can make for you."
-REMOTE_LIB_PATH=quicklisp/local-projects
+
-REMOTE_EXE_PATH=loop-test
+all: loop loop.lisp loop.asd \
-SERVICE_NAME=loop-test
+scripts/build-exe.lisp \
-
+scripts/cron-remove-inactive-users.lisp \
-default:
+scripts/build-index-from-fs.lisp \
-	@echo "Sorry. You need to read the Makefile to know what I can make for you."
+scripts/migrate-add-creation-date.lisp 
-
+
-all: loop.lisp build-exe.lisp exe run \
+clean: 
-migrate-add-creation-date.lisp cron-remove-inactive-users.lisp
+	rm -f *.pdf *.out *.aux *.log *.fls *.fdb_latexmk loop loop.tex
-
+
-live: all remote-copy # remote-build-exe
+build:
-
+	mkdir -p ~/quicklisp/local-projects/loop
-remote-copy:
+	cp loop.asd loop.lisp ~/quicklisp/local-projects/loop
-	scp loop.asd loop.lisp \
+	sbcl --script scripts/build-exe.lisp
-	   $(REMOTE):$(REMOTE_LIB_PATH)/loop
+
-	scp build-exe.lisp \
+install: loop
-	   $(REMOTE):$(REMOTE_EXE_PATH)/
+	mkdir -p `head -1 conf-home` && \
-	scp migrate-add-creation-date.lisp \
+		cp -R loop accounts.lisp groups scripts `head -1 conf-home`
-	   $(REMOTE):$(REMOTE_EXE_PATH)/
+
-	scp cron-remove-inactive-users.lisp \
+loop: scripts/build-exe.lisp
-	   $(REMOTE):$(REMOTE_EXE_PATH)/
+	sbcl --script scripts/build-exe.lisp
-
+
-sync-users:
+loop.lisp: loop.nw
-	scp $(REMOTE):$(REMOTE_EXE_PATH)/accounts.lisp .
+	(any tangle -Rloop.lisp < loop.nw > loop.tmp || \
-
+		(rm loop.tmp && exit 1)) && \
-remote-build-exe:
+		mv loop.tmp loop.lisp
-	plink -ssh $(REMOTE) cd $(REMOTE_EXE_PATH)/ && \
+
-	   sbcl --script build-exe.lisp && \
+scripts/build-exe.lisp: loop.nw
-           echo "Executable built."
+	(any tangle -Rbuild-exe.lisp < loop.nw > build-exe.tmp || \
-
+		(rm build-exe.tmp && exit 1)) && \
-remote-migrate-account-creation:
+	    mv build-exe.tmp scripts/build-exe.lisp
-	plink -ssh $(REMOTE) cd $(REMOTE_EXE_PATH)/ && \
+
-	   sbcl --script migrate-add-creation-date.lisp
+scripts/build-index-from-fs.lisp: loop.nw
-
+	(any tangle -Rbuild-index-from-fs.lisp < loop.nw > \
-remote-cron-remove-inactive-users:
+		build-index-from-fs.tmp || \
-	plink -ssh $(REMOTE) cd $(REMOTE_EXE_PATH)/ && \
+		(rm build-index-from-fs.tmp && exit 1)) && \
-	   sbcl --script remote-cron-remove-inactive-users.lisp
+	    	mv build-index-from-fs.tmp scripts/build-index-from-fs.lisp
-
+
-livedoc:
+scripts/cron-remove-inactive-users.lisp: loop.nw
-	echo loop.nw | python peat -C 'make loop.pdf'
+	(any tangle -Rcron-remove-inactive-users.lisp < loop.nw > \
-
+		cron-remove-inactive-users.tmp || \
-run: loop.nw
+		(rm cron-remove-inactive-users.tmp && exit 1)) && \
-	(any tangle -Rrun < loop.nw > run.tmp || (rm run.tmp && exit 1)) && \
+		mv cron-remove-inactive-users.tmp \
-	mv run.tmp run.lisp && \
+			scripts/cron-remove-inactive-users.lisp
-	chmod 0755 run	
+
-
+migrate-add-creation-date.lisp: loop.nw
-loop.tex: loop.nw
+	(any tangle -Rmigrate-add-creation-date.lisp < loop.nw > \
-	any weave -delay -index loop.nw > loop.tex
+		migrate-add-creation-date.tmp || \
-
+		(rm migrate-add-creation-date.tmp && exit 1)) && \
-loop.pdf: loop.tex
+		mv migrate-add-creation-date.tmp \
-	latexmk -pdf loop
+			scripts/migrate-add-creation-date.lisp
-
+
-loop.lisp: loop.nw
+run: loop.nw
-	(any tangle -Rloop.lisp < loop.nw > loop.tmp || (rm loop.tmp && exit 1)) && \
+	(any tangle -Rrun < loop.nw > run.tmp || (rm run.tmp && exit 1)) && \
-	mv loop.tmp loop.lisp
+		mv run.tmp run && \
-
+		chmod 0755 run
-build-exe.lisp: loop.nw
+
-	(any tangle -Rbuild-exe.lisp < loop.nw > build-exe.tmp || (rm build-exe.tmp && exit 1)) && \
+loop.tex: loop.nw
-	    mv build-exe.tmp build-exe.lisp
+	any weave -delay -index loop.nw > loop.tex
-
+
-build-index-from-fs.lisp: loop.nw
+loop.pdf: loop.tex
-	(any tangle -Rbuild-index-from-fs.lisp < loop.nw > build-index-from-fs.tmp || (rm build-index-from-fs.tmp && exit 1)) && \
+	latexmk -pdf loop
-	    mv build-index-from-fs.tmp build-index-from-fs.lisp
-
-cron-remove-inactive-users.lisp: loop.nw
-	(any tangle -Rcron-remove-inactive-users.lisp < loop.nw > cron-remove-inactive-users.tmp || (rm cron-remove-inactive-users.tmp && exit 1)) && \
-	    mv cron-remove-inactive-users.tmp cron-remove-inactive-users.lisp
-
-migrate-add-creation-date.lisp: loop.nw
-	(any tangle -Rmigrate-add-creation-date.lisp < loop.nw > migrate-add-creation-date.tmp || (rm migrate-add-creation-date.tmp && exit 1)) && \
-	    mv migrate-add-creation-date.tmp migrate-add-creation-date.lisp
-
-exe: loop.lisp build-exe.lisp
-	sbcl --script build-exe.lisp && echo "Executable built okay."
-
-service: run
-	sudo ln -s $(pwd) /service/$(SERVICE_NAME)

README

@@ -0,0 +1,26 @@
+LOOP is an NNTP server written in Common Lisp.  We assume you run SBCL
+because it's the only one we support at the moment.
+
+(*) How to install it
+
+We assume you have Quicklisp installed.  If not, visit
+
+  https://www.quicklisp.org/
+
+and install it.  LOOP is not present in Quicklisp archive, so we'll
+direct you to install LOOP as a local project.  After you install
+Quicklisp, you will have a directory named
+
+  ~/quicklisp/local-projects/
+
+Each directory inside local-projects is a Quicklisp package.  The
+steps below are not going to copy anything to your file system.  It
+builds the executable on LOOP's source code directory.  To build LOOP,
+tell your shell
+
+  cd ~/quicklisp/local-projects/
+  git clone https://git.antartida.xyz/loop/srv
+  cd srv
+  make build
+
+Omg, I gotta think about the installation!  I need to /decide/.

build-exe.lisp

@@ -1,5 +1,10 @@
-(load "~/.sbclrc")
+#-quicklisp
+(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
+                                       (user-homedir-pathname))))
+  (when (probe-file quicklisp-init)
+    (load quicklisp-init)))
 (ql:quickload :loop :silent t)
-(sb-ext:save-lisp-and-die #P"loop.exe"
+(sb-ext:save-lisp-and-die #P"loop"
                          :toplevel #'loop:main
-                         :executable t)
+                         :executable t
+                         :save-runtime-options t)

build-index-from-fs.lisp

@@ -1,7 +0,0 @@
-(load "~/.sbclrc")
-(ql:quickload :loop :silent t)
-(in-package #:loop)
-(connect-index! "message-id.db")
-(remake-index!)
-(index-from-fs!)
-(format t "Index built.~%")

conf-home

@@ -0,0 +1,4 @@
+~/loop
+
+The executable and the ucspi-tcp-tcpserver service will be installed
+at this directory.

cron-remove-inactive-users.lisp

@@ -1,8 +0,0 @@
-(load "~/.sbclrc")
-(ql:quickload :loop :silent t)
-(in-package #:loop)
-;; (format t *default-pathname-defaults*)
-(read-accounts!)
-(connect-index! "message-id.db")
-(remove-inactive-users!)
-(write-accounts!)

groups/local.control.news/2

@@ -1,7 +0,0 @@
-Date: 2024-12-05 07:27:01 GMT-3
-Message-Id: <kocaojivldajgfnjiiou@loop>
-From: Loop
-Subject: account HIMMEL removed by Loop
-Newsgroups: local.control.news
-
-HIMMEL didn't log in a first time (for 1 month) since account creation.

groups/local.control.news/3

@@ -1,7 +0,0 @@
-Date: 2024-12-05 07:52:39 GMT-3
-Message-Id: <tjvhrdqxpqiyixsodahj@loop>
-From: Loop
-Subject: account HIMMEL removed by Loop
-Newsgroups: local.control.news
-
-HIMMEL didn't log in a first time (for 1 month) since account creation.

groups/local.control.news/4

@@ -1,7 +0,0 @@
-Date: 2024-12-05 07:52:39 GMT-3
-Message-Id: <qpxbepgswiifybcnycow@loop>
-From: Loop
-Subject: account MFELIX locked by Loop
-Newsgroups: local.control.news
-
-MFELIX disappeared for over 3 months.

groups/local.control.news/5

@@ -1,7 +0,0 @@
-Date: 2024-12-05 07:52:39 GMT-3
-Message-Id: <ygvnlcmcrzcmtreismjl@loop>
-From: Loop
-Subject: account KIMOCHI locked by Loop
-Newsgroups: local.control.news
-
-KIMOCHI disappeared for over 3 months.

groups/local.control.news/6

@@ -1,7 +0,0 @@
-Date: 2024-12-05 07:52:39 GMT-3
-Message-Id: <zjccjxlroztlxteeoakf@loop>
-From: Loop
-Subject: account WILLIAMP locked by Loop
-Newsgroups: local.control.news
-
-WILLIAMP disappeared for over 3 months.

groups/local.control.news/7

@@ -1,7 +0,0 @@
-Date: 2024-12-05 07:52:39 GMT-3
-Message-Id: <gdcqooyqhkxanqnaxfvc@loop>
-From: Loop
-Subject: account JPMAB locked by Loop
-Newsgroups: local.control.news
-
-JPMAB disappeared for over 3 months.

groups/local.test/1.~1~

@@ -1,7 +0,0 @@
-Date: 2024-03-07 21:44:31 GMT-3
-Message-Id: <edjocyeqzqqhnswlbrbo@loop>
-From: Loop
-Subject: let there be light
-Newsgroups: local.control.news
-
-A sample group.

loop.lisp

@@ -1,14 +1,8 @@
 ;;; -*- mode: LISP; syntax: COMMON-LISP; package: LOOP; -*-
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (ql:quickload 
-   '(:lisp-unit 
+   '(:lisp-unit :str :uiop :cl-fad :cl-ppcre :local-time :iterate :clsql-sqlite3
-     :str 
+     :clingon)
-     :uiop 
-     :cl-fad 
-     :cl-ppcre 
-     :local-time 
-     :iterate 
-     :clsql-sqlite3)
    :silent t))
 
 (clsql:enable-sql-reader-syntax)
@@ -21,6 +15,101 @@
 
 (in-package #:loop)
 
+(defun cli/command ()
+  (clingon:make-command
+   :name "loop"
+   :description "An NNTP server for a circle of friends."
+   :version "0.1"
+   :authors '("Circling Skies <loop@antartida.xyz>")
+   :license "GPL v3"
+   :options (cli/options)
+   :handler #'cli/main))
+
+(defun cli/options () 
+  (list 
+   (clingon:make-option
+    :string
+    :description "<username> <invited-by> creates a new account"
+    :long-name "create-account"
+    :key :create-account)
+   (clingon:make-option
+    :string
+    :description "<username> <new-password> changes password"
+    :long-name "change-passwd"
+    :key :change-passwd)
+   (clingon:make-option
+    :flag
+    :description "lists accounts"
+    :short-name #\l
+    :long-name "list-accounts"
+    :key :list-accounts)
+   (clingon:make-option
+    :flag
+    :description "runs NNTP server reading from stdout"
+    :short-name #\s
+    :long-name "server"
+    :key :server)
+   (clingon:make-option
+    :flag
+    :description "run a REPL on port 4006"
+    :short-name #\r
+    :long-name "repl"
+    :key :repl)
+   (clingon:make-option
+    :flag
+    :description "turn on debug logging on stderr"
+    :long-name "logging"
+    :key :logging)))
+(defun cli/list-accounts ()
+  (read-accounts!)
+  (println (str:join (crlf-string) (list-users))))
+
+(defun cli/create-account (username args)
+  (let ((invited-by (car args)))
+    (cond ((null invited-by)
+           (println "Must specify who invites the new account."))
+          ((get-account create-account)
+           (println "Username account ``~a'' already exists." create-account))
+          ((not (get-account invited-by))
+           (println "Invited-by account ``~a'' doesn't exist." invited-by))
+          (t 
+           (multiple-value-bind (okay? pass-or-error) (new-account! create-account invited-by)
+             (if okay?
+                 (progn (println "Okay, account ``~a'' created with password ``~a''."
+                                 create-account pass-or-error)
+                        (notify-user-created create-account))
+                 (println "Sorry, ~a." pass-or-error)))))))
+
+(defun cli/change-passwd (username args)
+  (let* ((random-passwd (random-string 6))
+         (given-passwd (car args))
+         (new-passwd (or given-passwd random-passwd)))
+    (if (not (get-account change-passwd-account))
+        (println "No such account ``~a''." change-passwd-account)
+        (multiple-value-bind (okay? problem) (change-passwd! change-passwd-account new-passwd)
+          (if okay?
+              (println "Okay, account ~a now has password ``~a''." change-passwd-account new-passwd)
+              (println "Sorry, could not change password: ~a." problem))))))
+(defvar *debug* nil)
+(defun cli/main (cmd)
+  (let ((args (clingon:command-arguments cmd))
+        (repl (clingon:getopt cmd :repl))
+        (server (clingon:getopt cmd :server))
+        (create-account (clingon:getopt cmd :create-account))
+        (change-passwd-account (clingon:getopt cmd :change-passwd))
+        (list-accounts (clingon:getopt cmd :list-accounts))
+        (logging (clingon:getopt cmd :logging)))
+    (setf *debug* logging)
+    (when list-accounts
+      (cli/list-accounts))
+    (when create-account
+      (cli/create-account create-account args))
+    (when change-passwd-account
+      (cli/change-passwd change-passwd-account args))
+    (when repl
+      (stderr "Running a REPL on localhost:4006...~%"))
+    (when server
+      (server-start))))
 (defun remove-inactive-users! ()
   (loop for u in *accounts* do
     (let ((username (account-username u)))
@@ -45,21 +134,19 @@
                             (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
-    (delete-if #'(lambda (x) (equal x username)) (account-friends u)))
+        (setf (account-friends u)
-  (delete-if #'(lambda (x) (equal username (account-username x))) *accounts*))
+              (delete username (account-friends u) :test #'equal)))
+  (setf *accounts*
+        (delete-if #'(lambda (a) (equal (account-username a) username))
+                   *accounts*)))
 
 (defun lock-account! (username why)
   (let ((u (get-account username)))
     (setf (account-pass-locked u) (account-pass u))
     (setf (account-pass u) "locked")
     (setf (account-pass-locked-why u) why)))
-
-(defun remove-friend (username friend)
-  (remove-if #'(lambda (x) (equal x friend)) 
-             (account-friends (get-account username))))
 (defparameter *months-inactive-allowed* 3)
 (defparameter *months-never-logged-in* 1)
 
@@ -132,7 +219,7 @@
   (clsql:execute-command "create unique index if not exists idx_id_1 
     on indices (id)"))
 
-(defun remake-index! ()
+(defun drop-create-index! ()
   (clsql:execute-command "drop table if exists indices")
   (create-index!))
 (defun insert-index (m g i)
@@ -163,15 +250,22 @@
 (defun plural (v suffix)
   (if (> v 1) "s" ""))
 
-(defun debug? () nil)
-
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun fmt (cstr &rest args)
     (apply #'format nil (list* cstr args))))
 
+(defun out (stream &rest args)
+  (apply #'format (cons stream args)))
+
 (defun stderr (&rest args)
-  (when (debug?)
+  (when *debug*
-      (apply #'format (cons *error-output* args))))
+    (apply #'out (cons *error-output* args))))
+
+(defun stdout (&rest args)
+  (apply #'out (list* *standard-output* args)))
+
+(defun println (&rest args)
+  (apply #'out (list* *standard-output* (str:concat (car args) "~%") (cdr args))))
 
 (defun enumerate (ls &optional (first-index 0))
   (loop for e in ls and i from first-index
@@ -366,14 +460,18 @@
 (defun request-quit? (r) (and r (string= 'quit (request-verb r))))
 (defun response-quit? (r) (and r (request-quit? (response-request r))))
 
-(defun main ()
+(defun server-start ()
-  (send-banner!)
-  (set-up-tables!)
   (read-accounts!)
   (connect-index! "message-id.db")
   (create-index!)
+  (set-up-tables!)
+  (send-banner!)
   (main-loop))
 
+(defun main ()
+  (let ((app (cli/command)))
+    (clingon:run app)))
+
 (defun send-banner! ()
   (send-response! 
    (make-response :code 200 :data "Welcome! Say ``help'' for a menu.")))
@@ -954,7 +1052,7 @@
       (with-n-args 1 r
         (let* ((args (mapcar #'str:upcase (request-args r)))
                (username (car args)))
-          (multiple-value-bind (username pass-or-error) (new-account! username)
+          (multiple-value-bind (username pass-or-error) (new-account! username (client-username *client*))
             (if (not username)
                 (make-response :code 400 :request r
                                :data (fmt "~a. Choose a new name." pass-or-error))
@@ -975,7 +1073,7 @@
       (setq *accounts* (read s))))
   *accounts*)
 
-(defun new-account! (username)
+(defun new-account! (username invited-by)
   (let* ((u (str:upcase username))
          (p (random-string 6))
          (a (make-account :username u
@@ -983,8 +1081,8 @@
                           :creation (get-universal-time)))) 
     (if (get-account u)
         (values nil (fmt "account ~a already exists" u))
-        (let ((c (get-account (client-username *client*))))
+        (progn
-          (push u (account-friends c))
+          (push u (account-friends (get-account invited-by)))
           (push a *accounts*)
           (write-accounts!)
           (values (str:upcase username) p)))))
@@ -1190,5 +1288,5 @@
                (insert-index m g i)))))
 
 (defun remake-index-from-fs ()
-  (remake-index!)
+  (drop-create-index!)
   (index-from-fs!))

loop.nw

@@ -7,7 +7,7 @@
 \usepackage[T1]{fontenc}
 \usepackage[utf8]{inputenc}
 \usepackage{csquotes}
-\usepackage[brazil]{babel}
+\usepackage{babel}
 
 \usepackage{etoolbox}
 \AtBeginEnvironment{quote}{\small}
@@ -16,14 +16,14 @@
 %% \usepackage[backend=biber]{biblatex}
 %% \addbibresource{refs.bib}
 %% \renewcommand{\cite}{\parencite}
-\usepackage[hyperref]{xcolor}
+% \usepackage[hyperref]{xcolor}
 \usepackage[colorlinks=true,citecolor=]{hyperref} % linkcolor=red
 
 \usepackage{amsmath,amsthm,amssymb}
 \allowdisplaybreaks
 \usepackage{lmodern}
 \usepackage{noweb}
-\noweboptions{brazil,longchunks,smallcode}
+\noweboptions{longchunks,smallcode}
 \DeclareMathOperator{\mdc}{mdc}
 \DeclareMathOperator{\gcdext}{gcdext}
 \DeclareMathOperator{\remainder}{remainder}
@@ -359,6 +359,18 @@ way, they work together.  And \lp\ handles only a text stream, which
 is why it's so easy to connect a keyboard to it and interact with it
 through the command line as illustrated in Section~\ref{sec:design}.
 
+\section{The description of the package}
+
+<<Description>>=
+An NNTP server for a circle of friends.
+@ 
+
+<<Version>>=
+0.1
+@ 
+
+These chunks are used in [[loop.asd]].
+
 \section{The representation of a client}
 
 How do we represent a client?  A client is typically reading a group
@@ -557,19 +569,144 @@ itself---so we can cascade actions based on a user's request.
 (defun request-quit? (r) (and r (string= 'quit (request-verb r))))
 (defun response-quit? (r) (and r (request-quit? (response-request r))))
 
-(defun main ()
+(defun server-start ()
-  (send-banner!)
-  (set-up-tables!)
   (read-accounts!)
   (connect-index! "message-id.db")
   (create-index!)
+  (set-up-tables!)
+  (send-banner!)
   (main-loop))
 
+(defun main ()
+  (let ((app (cli/command)))
+    (clingon:run app)))
+
 (defun send-banner! ()
   (send-response! 
    (make-response :code 200 :data "Welcome! Say ``help'' for a menu.")))
 @ %def main main-loop
 
+\section{Command-line parsing}
+
+We're using the clingon library as per Vincent Dardel suggestion in
+``The Common Lisp Cookbook''.  (Thanks, Vincent!)  We begin with
+writing a description of the program and options it understands.  XXX:
+notice I don't know how to support a two-argument option, so I hacked
+a solution away.
+
+<<Command-line parsing>>=
+(defun cli/command ()
+  (clingon:make-command
+   :name "loop"
+   :description "<<Description>>"
+   :version "<<Version>>"
+   :authors '("Circling Skies <loop@antartida.xyz>")
+   :license "GPL v3"
+   :options (cli/options)
+   :handler #'cli/main))
+
+(defun cli/options () 
+  (list 
+   (clingon:make-option
+    :string
+    :description "<username> <invited-by> creates a new account"
+    :long-name "create-account"
+    :key :create-account)
+   (clingon:make-option
+    :string
+    :description "<username> <new-password> changes password"
+    :long-name "change-passwd"
+    :key :change-passwd)
+   (clingon:make-option
+    :flag
+    :description "lists accounts"
+    :short-name #\l
+    :long-name "list-accounts"
+    :key :list-accounts)
+   (clingon:make-option
+    :flag
+    :description "runs NNTP server reading from stdout"
+    :short-name #\s
+    :long-name "server"
+    :key :server)
+   (clingon:make-option
+    :flag
+    :description "run a REPL on port 4006"
+    :short-name #\r
+    :long-name "repl"
+    :key :repl)
+   (clingon:make-option
+    :flag
+    :description "turn on debug logging on stderr"
+    :long-name "logging"
+    :key :logging)))
+@ 
+
+The command-line options form a language.  The user specifies
+everything he wants with flags.  If he wants nothing, for instance, he
+specifies nothing and then nothing happens.  XXX: I'd like to have a
+default action (which would be running the server) that is invoked by
+default if none of the other options would run.  But I don't know how
+to do that yet.
+
+<<Command-line parsing>>=
+(defun cli/list-accounts ()
+  (read-accounts!)
+  (println (str:join (crlf-string) (list-users))))
+
+(defun cli/create-account (username args)
+  (let ((invited-by (car args)))
+    (cond ((null invited-by)
+           (println "Must specify who invites the new account."))
+          ((get-account create-account)
+           (println "Username account ``~a'' already exists." create-account))
+          ((not (get-account invited-by))
+           (println "Invited-by account ``~a'' doesn't exist." invited-by))
+          (t 
+           (multiple-value-bind (okay? pass-or-error) (new-account! create-account invited-by)
+             (if okay?
+                 (progn (println "Okay, account ``~a'' created with password ``~a''."
+                                 create-account pass-or-error)
+                        (notify-user-created create-account))
+                 (println "Sorry, ~a." pass-or-error)))))))
+
+(defun cli/change-passwd (username args)
+  (let* ((random-passwd (random-string 6))
+         (given-passwd (car args))
+         (new-passwd (or given-passwd random-passwd)))
+    (if (not (get-account change-passwd-account))
+        (println "No such account ``~a''." change-passwd-account)
+        (multiple-value-bind (okay? problem) (change-passwd! change-passwd-account new-passwd)
+          (if okay?
+              (println "Okay, account ~a now has password ``~a''." change-passwd-account new-passwd)
+              (println "Sorry, could not change password: ~a." problem))))))
+@ 
+
+Now let's write the main procedure in command-line parsing.
+
+<<Command-line parsing>>=
+(defvar *debug* nil)
+(defun cli/main (cmd)
+  (let ((args (clingon:command-arguments cmd))
+        (repl (clingon:getopt cmd :repl))
+        (server (clingon:getopt cmd :server))
+        (create-account (clingon:getopt cmd :create-account))
+        (change-passwd-account (clingon:getopt cmd :change-passwd))
+        (list-accounts (clingon:getopt cmd :list-accounts))
+        (logging (clingon:getopt cmd :logging)))
+    (setf *debug* logging)
+    (when list-accounts
+      (cli/list-accounts))
+    (when create-account
+      (cli/create-account create-account args))
+    (when change-passwd-account
+      (cli/change-passwd change-passwd-account args))
+    (when repl
+      (stderr "Running a REPL on localhost:4006...~%"))
+    (when server
+      (server-start))))
+@ %def cli/options cli/command
+
 \section{The request dispatching mechanism}
 
 Dispatching requests means consuming one and invoking the correct
@@ -728,7 +865,8 @@ Lisp offers me [[labels]], but [[labels]] don't seem so helpful when
 I'm at the REPL.  When I use [[defun]], I'm able to always invoke the
 procedure at the REPL, but that's not so with [[labels]].  I guess the
 use of [[labels]] is when the procedure is so trivial that we have no
-reason to think we're doing to debug it.} %% TODO
+reason to think we're doing to debug it.} XXX: replace menu with
+[[loop]].
 
 <<Help command>>=
 (defun cmd-help (r)
@@ -803,16 +941,10 @@ Syntax error. Say ``authinfo USER /your-name/'' then ``authinfo PASS /your-pass/
 
 \subsection{{\tt CREATE-ACCOUNT}}
 
-We allow authenticated members to invite their friends.
+We allow authenticated members to invite their friends.  Notice that
-
+we're not doing any kind of checking on the username.  XXX: take a
-%% A propósito, estamos removendo a conta {\tt ROOT} de exibição.  O que
+look at how we verify group names match a certain regex and apply the
-%% significa que {\tt ROOT} não nem mesmo se conectar ao \Lp.  Se
+same check here.
-%% desejarmos que {\tt ROOT} se conecte, talvez a gente possa fazer
-%% código especialmente pra gerenciar a conta dele.  Fazemos assim pra
-%% não permitir que usuários tenham qualquer chance de 
-%% 
-%% (remove-if #'(lambda (u) (equal "ROOT" (account-username u)))
-%%                        (read s))
 
 <<Command create-account>>=
 (defun cmd-create-account (r)
@@ -820,7 +952,7 @@ We allow authenticated members to invite their friends.
       (with-n-args 1 r
         (let* ((args (mapcar #'str:upcase (request-args r)))
                (username (car args)))
-          (multiple-value-bind (username pass-or-error) (new-account! username)
+          (multiple-value-bind (username pass-or-error) (new-account! username (client-username *client*))
             (if (not username)
                 (make-response :code 400 :request r
                                :data (fmt "~a. Choose a new name." pass-or-error))
@@ -841,7 +973,7 @@ We allow authenticated members to invite their friends.
       (setq *accounts* (read s))))
   *accounts*)
 
-(defun new-account! (username)
+(defun new-account! (username invited-by)
   (let* ((u (str:upcase username))
          (p (random-string 6))
          (a (make-account :username u
@@ -849,12 +981,12 @@ We allow authenticated members to invite their friends.
                           :creation (get-universal-time)))) 
     (if (get-account u)
         (values nil (fmt "account ~a already exists" u))
-        (let ((c (get-account (client-username *client*))))
+        (progn
-          (push u (account-friends c))
+          (push u (account-friends (get-account invited-by)))
           (push a *accounts*)
           (write-accounts!)
           (values (str:upcase username) p)))))
-@ %def CREATE-ACCOUNT
+@ %def CREATE-ACCOUNT new-account!
 
 Notice that we have a race condition in [[write-accounts]].  What is
 the problem?  Two processes in parallel may ask for the writing of
@@ -1860,10 +1992,10 @@ specify anything.
   (clsql:execute-command "create unique index if not exists idx_id_1 
     on indices (id)"))
 
-(defun remake-index! ()
+(defun drop-create-index! ()
   (clsql:execute-command "drop table if exists indices")
   (create-index!))
-@ %def create-index! remake-index! connect-index!
+@ %def create-index! drop-create-index! connect-index!
 
 Of course, the creation and connection of the index must occur before
 [[main-loop]], so it takes place in [[main]].  
@@ -1986,19 +2118,23 @@ we need to index it.
                (insert-index m g i)))))
 
 (defun remake-index-from-fs ()
-  (remake-index!)
+  (drop-create-index!)
   (index-from-fs!))
 @
 
 Here's a program to build the index from a UNIX shell.
 
 <<build-index-from-fs.lisp>>=
-(load "~/.sbclrc")
+#-quicklisp
+(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
+                                       (user-homedir-pathname))))
+  (when (probe-file quicklisp-init)
+    (load quicklisp-init)))
 (ql:quickload :loop :silent t)
 (in-package #:loop)
 (connect-index! "message-id.db")
-(remake-index!)
+(drop-create-index!)
-(index-from-fs)
+(index-from-fs!)
 (format t "Index built.~%")
 @ 
 
@@ -2019,21 +2155,25 @@ Index built.
 
 \section{Deletion and locking of inactive accounts}\label{sec:inactive-users}
 
-In [[remove-friend]], note that [[username]] is the account name and
+XXX: remove this paragraph from here; present the program first and
-[[friend]] is the name of the account being removed.  Notice as well
+then talk about it.  In [[remove-friend]], note that [[username]] is
-that we only know who invited the person after we can get a hold of
+the account name and [[friend]] is the name of the account being
-the account in [[accounts.lisp]].  This means we must scan each
+removed.  Notice as well that we only know who invited the person
-account to delete an account---we can't delete an account and still
+after we can get a hold of the account in [[accounts.lisp]].  This
-leave the account as someone's friend.
+means we must scan each account to delete an account---we can't delete
+an account and still leave the account as someone's friend.
 
 The program [[cron-remove-inactive-users.lisp]] can be executed every
 day at midnight, say.
 
 <<cron-remove-inactive-users.lisp>>=
-(load "~/.sbclrc")
+#-quicklisp
+(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
+                                       (user-homedir-pathname))))
+  (when (probe-file quicklisp-init)
+    (load quicklisp-init)))
 (ql:quickload :loop :silent t)
 (in-package #:loop)
-;; (format t *default-pathname-defaults*)
 (read-accounts!)
 (connect-index! "message-id.db")
 (remove-inactive-users!)
@@ -2069,22 +2209,33 @@ with [[setf]]. %% TODO
                             (fmt "disappeared for over ~a months" 
                                  *months-inactive-allowed*))
              (format t "Locked ~a due to long-time-no-see.~%" username))))))
+@ %def remove-inactive-users!
 
+To remove an account, we need to first remove the username (to be
+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 importantly is to understand tha 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.  (This deserves a better explanation, but if you know how linked
+lists are implemented in C, say, then you're likely well aware of how
+it works.)
+
+<<How to remove inactive users>>=
 (defun remove-account! (username)
   (loop for u in *accounts* do
-    (delete-if #'(lambda (x) (equal x username)) (account-friends u)))
+        (setf (account-friends u)
-  (delete-if #'(lambda (x) (equal username (account-username x))) *accounts*))
+              (delete username (account-friends u) :test #'equal)))
+  (setf *accounts*
+        (delete-if #'(lambda (a) (equal (account-username a) username))
+                   *accounts*)))
 
 (defun lock-account! (username why)
   (let ((u (get-account username)))
     (setf (account-pass-locked u) (account-pass u))
     (setf (account-pass u) "locked")
     (setf (account-pass-locked-why u) why)))
-
+@ %def remove-account!
-(defun remove-friend (username friend)
-  (remove-if #'(lambda (x) (equal x friend)) 
-             (account-friends (get-account username))))
-@ %def remove-account! remove-friend
 
 Accounts that do not have a creation date up until today---Tue Sep 17
 21:37:18 ESAST 2024---will have its creation dates migrated to the
@@ -2108,7 +2259,11 @@ New system administrators of \Lp\ will never need to run this.
 Here's a program to run the migration in a UNIX shell.
 
 <<migrate-add-creation-date.lisp>>=
-(load "~/.sbclrc")
+#-quicklisp
+(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
+                                       (user-homedir-pathname))))
+  (when (probe-file quicklisp-init)
+    (load quicklisp-init)))
 (ql:quickload :loop :silent t)
 (in-package #:loop)
 (migrate-add-creation-and-post-date!)
@@ -2240,15 +2395,22 @@ means 2 bytes.  So our conversion is just removing the first byte.
 (defun plural (v suffix)
   (if (> v 1) "s" ""))
 
-(defun debug? () nil)
-
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun fmt (cstr &rest args)
     (apply #'format nil (list* cstr args))))
 
+(defun out (stream &rest args)
+  (apply #'format (cons stream args)))
+
 (defun stderr (&rest args)
-  (when (debug?)
+  (when *debug*
-      (apply #'format (cons *error-output* args))))
+    (apply #'out (cons *error-output* args))))
+
+(defun stdout (&rest args)
+  (apply #'out (list* *standard-output* args)))
+
+(defun println (&rest args)
+  (apply #'out (list* *standard-output* (str:concat (car args) "~%") (cdr args))))
 
 (defun enumerate (ls &optional (first-index 0))
   (loop for e in ls and i from first-index
@@ -2320,18 +2482,28 @@ the code.
 
 \section{How to produce the binary executable}
 
-Just say {\tt make exe} to your shell.
+Just say {\tt make loop} to your shell.
 
 <<build-exe.lisp>>=
-(load "~/.sbclrc")
+#-quicklisp
+(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
+                                       (user-homedir-pathname))))
+  (when (probe-file quicklisp-init)
+    (load quicklisp-init)))
 (ql:quickload :loop :silent t)
-(sb-ext:save-lisp-and-die #P"loop.exe"
+(sb-ext:save-lisp-and-die #P"loop"
                          :toplevel #'loop:main
-                         :executable t)
+                         :executable t
+                         :save-runtime-options t)
 @
 
 \section{How to update the remote server}\label{sec:live}
 
+XXX: notice we don't include such targets in the [[Makefile]]
+anymore. Now we use a [[Makefile.personal]] that we don't release
+anymore.  We may still keep this section as instruction, but we need
+to update it to reflect the facts.
+
 We automate here the process of updating and compilation of a new
 version of \lp.  It's certain that what we document here is specific
 to a single UNIX system, but what's important is that you (dear
@@ -2417,18 +2589,16 @@ variables in the chunks where it's used.  But for someone reading
 global variables at the top of the file.  That's something to think
 about.
 
+<<List of packages to be loaded>>=
+:lisp-unit :str :uiop :cl-fad :cl-ppcre :local-time :iterate :clsql-sqlite3
+:clingon
+@
+
 <<loop.lisp>>=
 ;;; -*- mode: LISP; syntax: COMMON-LISP; package: LOOP; -*-
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (ql:quickload 
-   '(:lisp-unit 
+   '(<<List of packages to be loaded>>)
-     :str 
-     :uiop 
-     :cl-fad 
-     :cl-ppcre 
-     :local-time 
-     :iterate 
-     :clsql-sqlite3)
    :silent t))
 
 (clsql:enable-sql-reader-syntax)
@@ -2441,6 +2611,7 @@ about.
 
 (in-package #:loop)
 
+<<Command-line parsing>>
 <<How to remove inactive users>>
 <<How to enumerate inactive accounts>>
 <<How to migrate accounts without a creation date>>
@@ -2487,37 +2658,58 @@ about.
 <<loop.asd>>=
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; -*-
 (asdf:defsystem :loop
-  :version "0.0.1"
+  :version "<<Version>>"
-  :description "An NNTP server for a group of friends."
+  :description "<<Description>>"
-  :depends-on (:lisp-unit :str :uiop :cl-fad :cl-ppcre)
+  :depends-on (<<List of packages to be loaded>>)
   :components ((:file "loop")))
-@ %def :loop
+@ %def :loop loop.asd
 
 \section{The UNIX service}
 
+XXX: this section should be informative only.  We're going to suggest
+users how to run the system.  We may provide a [[make install]] target
+that runs things the way we do, but this should be optional.  Idea:
+instead of hard coding a path to the service, make it {\tt conf-home}
+or {\tt conf-service}.
+
+The installation is as follows.  You clone the repo to your
+local-projects, then run make build.  This builds the executable.  You
+edit conf-home to choose your install directory.  Then you say make
+install which copies loop, accounts.lisp, the scripts and the service
+directory.  It is now the syadmin duty to do ln -s ./svc to
+/service/loop, which runs it.  Let's see if we can pull that off.
+
 We use the {\tt tcpserver} program by Daniel J. Bernstein from the
 package \href{https://cr.yp.to/ucspi-tcp.html}{\tt ucspi-tcp}.
 
-<<path to the service>>=
-/home/dbastos/loop
-@ %def
-
 <<port number>>=
 119
 @ %def
 
 <<run>>=
 #!/bin/sh
+home=`head -1 conf-home`
+cd $home
+exec 2>1&
 echo loop
-cd <<path to the service>>
+exec "$home"/tcpserver -HR 0.0.0.0 <<port number>> "$home"/loop
-exec <<path to the service>>/tcpserver -HR 0.0.0.0 <<port number>> <<path to the service>>/loop.exe
 @ %def
 
-How should you update the server if you modified the source-code?  See
+<<log-run>>=
-Section~\ref{sec:live}.
+#!/bin/sh
+echo loop
+exec /usr/bin/logger -i -t loop
+@ 
 
 \section{The writing process}
 
+XXX: note to self.  Targets [[make build]] and [[make install]] must
+be completely non-dependent on noweb.  Also, most users will not run
+any web at all---they'll run noweb, so releasing {\tt any} use in the
+Makefile makes no sense to users.  I think we'll need to set up a
+virtual machine to practice the use of real-world noweb for other
+users.  (Lots of work!)
+
 The program {\tt latexmk} is iseful when I'm writing \LaTeX\ in
 general, but to get the attention of {\tt latexmk} we need to rewrite
 {\tt loop.tex}.  So what I do while writing \lp\ is to have a

scripts/build-exe.lisp

@@ -0,0 +1,10 @@
+#-quicklisp
+(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
+                                       (user-homedir-pathname))))
+  (when (probe-file quicklisp-init)
+    (load quicklisp-init)))
+(ql:quickload :loop :silent t)
+(sb-ext:save-lisp-and-die #P"loop"
+                         :toplevel #'loop:main
+                         :executable t
+                         :save-runtime-options t)

scripts/build-index-from-fs.lisp

@@ -0,0 +1,11 @@
+#-quicklisp
+(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
+                                       (user-homedir-pathname))))
+  (when (probe-file quicklisp-init)
+    (load quicklisp-init)))
+(ql:quickload :loop :silent t)
+(in-package #:loop)
+(connect-index! "message-id.db")
+(remake-index!)
+(index-from-fs!)
+(format t "Index built.~%")

scripts/cron-remove-inactive-users.lisp

@@ -0,0 +1,11 @@
+#-quicklisp
+(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
+                                       (user-homedir-pathname))))
+  (when (probe-file quicklisp-init)
+    (load quicklisp-init)))
+(ql:quickload :loop :silent t)
+(in-package #:loop)
+(read-accounts!)
+(connect-index! "message-id.db")
+(remove-inactive-users!)
+(write-accounts!)

scripts/migrate-add-creation-date.lisp

@@ -0,0 +1,9 @@
+#-quicklisp
+(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
+                                       (user-homedir-pathname))))
+  (when (probe-file quicklisp-init)
+    (load quicklisp-init)))
+(ql:quickload :loop :silent t)
+(in-package #:loop)
+(migrate-add-creation-and-post-date!)
+(format t "Accounts rewritten.~%")