Writes index in the UNIX way.

Adds support for TAGS in noweb files.

I really don't know whether the above is complete or not.

Makefile

@@ -5,5 +5,5 @@ loop: loop.asd loop.lisp scripts/build-exe.lisp
 
 install: loop
 	mkdir -p `head -1 conf-home` && \
-		cp -R loop accounts.lisp groups scripts \
+		cp -R loop accounts.lisp index groups scripts \
 			`head -1 conf-home`

Nowebfile

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

TAGS

@@ -0,0 +1,291 @@
+
+loop.nw,3549
+\def\nwendcode{\nwendcode
35,939
+\newcommand{\lxxp}\lxxp
39,1017
+\newcommand{\Lp}\Lp
40,1048
+\newcommand{\lp}\lp
41,1077
+\newcommand{\bug}\bug
42,1099
+\newcommand{\symlink}\symlink
43,1128
+\newcommand{\symlinks}\symlinks
44,1171
+  \label{fg:gnus}fg:gnus
81,2706
+  \label{fg:bird}fg:bird
87,2911
+  \label{fg:sylpheed}fg:sylpheed
93,3111
+\ref{fg:gnus}fg:gnus
137,5733
+\section*{*
140,5822
+Section \ref{sec:inactive-users}sec:inactive-users
148,6361
+\section*{*
184,8177
+\section{Implementation strategy}\label{sec:design}Implementation
190,8309
+illustrated in Figures~\ref{fg:gnus}fg:gnus
319,12489
+Section~\ref{sec:repl}sec:repl
323,12758
+\section{NNTP protocol}NNTP
328,12991
+\section{It's a network server}It's
342,13733
+through the command line as illustrated in Section~\ref{sec:design}sec:design
369,15205
+\section{REPL for \lp}\label{sec:repl}REPL
371,15275
+\section{Representation of a client}Representation
437,17373
+\section{Representation of a command}Representation
449,17769
+\section{Representation of requests and responses}Representation
517,20742
+\section{Main loop}Main
594,23952
+\section{Parsing of requests}Parsing
668,25894
+\section{Parsing of command-line arguments}Parsing
687,26655
+\section{Request dispatching mechanism}Request
956,36835
+\section{Representation and parsing of articles}Representation
977,37628
+\section{How to extract articles from the database}How
1056,40692
+\section{Commands}Commands
1106,42494
+\subsection{{\tt HELP}}1108,42514
+\subsection{{\tt AUTHINFO}}\label{sec:authinfo}1142,43799
+Section~\ref{sec:login}sec:login
1148,44091
+\subsection{{\tt CREATE-ACCOUNT}}1193,45783
+\subsection{{\tt UNLOCK-ACCOUNT}}1311,50341
+\ref{sec:inactive-users}sec:inactive-users
1314,50430
+\subsection{{\tt LOGIN}}\label{sec:login}1347,51741
+Besides {\tt AUTHINFO} in Section~\ref{sec:authinfo}sec:authinfo
1349,51784
+\subsection{{\tt PASSWD}}\label{sec:passwd}1375,52745
+\subsection{{\tt USERS}}\label{sec:users}1421,54619
+\subsection{{\tt LIST}}\label{sec:list}1471,56270
+\subsection{{\tt GROUP}}\label{sec:group}1623,62335
+\subsection{{\tt BODY}, {\tt HEAD}, {\tt ARTICLE} e {\tt NEXT}}1653,63159
+\label{sec:typical-cmds}sec:typical-cmds
1654,63223
+Section~\ref{sec:index}sec:index
1664,63791
+\subsection{{\tt XOVER}}\label{sec:xover}1766,68395
+\subsection{{\tt MODE READER}}\label{sec:mode-reader}1824,70966
+\subsection{{\tt DATE}}\label{sec:date}1833,71213
+\subsection{{\tt QUIT}}\label{sec:quit}1846,71556
+\subsection{{\tt DD}}\label{sec:dd}1856,71819
+\subsection{{\tt POST}}\label{sec:post}1868,72221
+\subsection{{\tt CREATE-GROUP}}2224,87356
+\subsection{{\tt REPL}}2261,89096
+\section{Publication of news}Publication
2288,89946
+\section{Algorithm of {\tt split-vector}}Algorithm
2329,91508
+\section{Article index}\label{sec:index}Article
2360,92703
+\section{Essential operations relative to the index}Essential
2455,97073
+\section{Procedure to import the index from the file system}Procedure
2498,98728
+\section{Deletion and locking of inactive accounts}\label{sec:inactive-users}Deletion
2561,100684
+\section{Macros to ease writing}\label{sec:dsl}Macros
2728,107298
+\section{Other procedures}Other
2791,109436
+\section{Tests}Tests
2881,112192
+\section{Executable, how to build it}Executable,
2955,115097
+\section{Log of \lp's communication, how to produce it}Log
2976,115677
+\section{Package {\tt loop.lisp} as the compiler needs it}Package
3013,117026
+\section{Other source code}Other
3115,120122
+\section*{*
3195,122671
+\section*{*
3198,122712
+
+loop.nw,7305
+(defun repl 406,16343
+(defstruct client 444,17634
+(defparameter *client* 445,17706
+(defstruct command 460,18265
+(defparameter *commands-assoc* 461,18305
+(defun table-of-commands 465,18368
+(defun set-up-tables! 490,19685
+(defun get-command 503,20181
+(defstruct request 532,21442
+(defstruct response 533,21477
+(defun empty-response 537,21574
+(defun prepend-response-with 538,21653
+(defun append-crlf-if-needed 549,22043
+(defun send-response! 559,22363
+(defun my-write 588,23775
+(defun main-loop 609,24653
+(defun request-quit? 617,24876
+(defun response-quit? 618,24943
+(defun server-start 620,25016
+(defun main 625,25091
+(defun send-banner! 632,25233
+(defun parse-request 675,26144
+(defun root/command 716,28117
+(defun root/options 725,28344
+(defun root/handlers 744,28795
+(defun root/main 809,31474
+(defun account/command 824,31972
+(defun account/options 831,32139
+(defun account/manager 875,33168
+(defun account/list-accounts 924,35337
+(defun account/create-account! 927,35421
+(defun account/change-passwd! 943,36207
+(defun dispatch 967,37362
+(defun dispatch-line 973,37517
+(defstruct article 998,38720
+(defun parse-article 1002,38784
+(defun hs-space-collapsed 1006,38965
+(defun hs-lines 1009,39081
+(defun parse-header 1011,39139
+(defun parse-headers 1024,39630
+(defun string-integer? 1028,39756
+(defun get-header-from-article 1035,39991
+(defun get-header 1038,40099
+(defun fetch-headers 1042,40205
+(defun enrich-headers 1048,40421
+(defun nlines 1053,40603
+(defun fetch-article 1064,41049
+(defun read-file-raw 1068,41136
+(defun fetch-body 1079,41431
+(defun encode-body 1090,41887
+(defun extract-mid 1100,42298
+(defun lookup 1102,42398
+(defun cmd-help 1123,43298
+(defun menu 1131,43561
+(defun display-fn 1135,43639
+(defun cmd-authinfo 1158,44464
+(defun authinfo-check 1180,45447
+(defun auth? 1183,45516
+(defun log-user-in! 1186,45570
+(defun user-name-conforms? 1213,46445
+(defun cmd-create-account 1217,46550
+(defstruct account 1234,47320
+(defparameter *accounts* 1235,47414
+(defun read-accounts! 1239,47491
+(defun string->array 1247,47688
+(defun string->sha256 1252,47849
+(defun new-account! 1256,47997
+(defun write-accounts! 1289,49613
+(defun get-account 1305,50135
+(defun cmd-unlock-account 1318,50539
+(defun unlock-account! 1335,51329
+(defun cmd-login 1355,52064
+(defun log-user-in-as! 1370,52632
+(defun cmd-passwd 1382,53017
+(defun pass? 1401,53919
+(defun change-passwd! 1412,54342
+(defun cmd-list-users 1427,54763
+(defun size-of-longest-username 1435,54990
+(defun list-users 1439,55105
+(defun universal-to-human 1459,55939
+(defun last-time-seen 1465,56058
+(defstruct group 1481,56720
+(defun cmd-list 1483,56753
+(defun build-groups-lines 1490,57013
+(defun build-groups-structs 1497,57177
+(defun between? 1504,57442
+(defun filesize 1508,57517
+(defun zero-file? 1512,57589
+(defun temporary-article? 1515,57640
+(defun article-ready? 1519,57749
+(defun get-articles 1524,57866
+(defun group-high-low 1534,58254
+(defun articles->integers 1541,58481
+(defun list-groups 1548,58718
+(defun last-char 1553,58915
+(defun basename 1561,59128
+(defun loop-directory* 1582,60148
+(defun loop-list-files 1592,60810
+(defun loop-list-directories 1601,61165
+(defun cmd-group 1628,62466
+(defun group? 1639,62876
+(defun xgroup? 1643,62946
+(defun set-group! 1646,62986
+(defun typical-cmd-head-body-article 1667,63887
+(defun cmd-head 1683,64754
+(defun cmd-body 1685,64827
+(defun cmd-article 1687,64900
+(defun article-response 1690,64980
+(defun head-response 1692,65079
+(defun body-response 1694,65195
+(defun typical-cmd-response 1723,66781
+(defun cmd-next 1744,67563
+(defun article-next! 1755,68017
+(defun mid-by-name 1762,68284
+(defun cmd-xover 1775,68756
+(defun xover 1794,69713
+(defun xover-format-line 1815,70635
+(defun xover-headers 1820,70857
+(defun cmd-mode 1829,71112
+(defun cmd-date 1839,71400
+(defun cmd-quit 1852,71733
+(defun cmd-dd 1864,72114
+(defun suggest-message-id 1880,72765
+(defun random-string 1883,72857
+(defun unparse-article 1897,73270
+(defun ensure-header 1914,73886
+(defun get-date 1927,74369
+(defun ensure-mid 1934,74611
+(defun ensure-date 1936,74690
+(defun cmd-post 1964,75771
+(defun post 1998,77338
+(defun newsgroups-header->list 2020,78438
+(defun update-last-post-date! 2035,79134
+(defun rename-no-extension 2053,80063
+(defun save-article-try 2056,80166
+(defun save-article-insist 2084,81134
+(defun get-next-article-id 2090,81408
+(defun nntp-read-article 2106,82107
+(defun nntp-read-line 2125,82983
+(defun list->bytes 2134,83346
+(defun vector->bytes 2137,83400
+(defun data->bytes 2140,83469
+(defun add-crlf-between 2148,83738
+(defun string->bytes 2152,83890
+(defun bytes->string 2155,83945
+(defun conforms? 2177,84969
+(defun text/plain? 2190,85624
+(defun headers-required-from-clients 2199,85967
+(defun cmd-create-group 2234,87805
+(defun group-name-conforms? 2257,88972
+(defun cmd-repl 2267,89249
+(defparameter *enable-nntp-repl* 2285,89906
+(defun notify-group-created 2295,90179
+(defun notify-user-created 2300,90390
+(defun notify-user-unlocked 2305,90588
+(defun post-notification 2311,90805
+(defun make-news 2317,91098
+(defun split-vector 2340,92004
+(defun split-vector-helper 2344,92146
+(defparameter *default-database* 2391,93939
+(defun connect-index! 2395,94048
+(defun create-index! 2398,94167
+(defun drop-create-index! 2404,94414
+(defun insert-index 2471,97843
+(defun lookup-index 2487,98372
+(defun index-from-fs! 2520,99565
+(defun remake-index-from-fs 2529,99978
+(defun remove-inactive-users! 2586,101650
+(defun remove-account! 2622,103553
+(defun lock-account! 2630,103845
+(defun loop-epoch 2646,104579
+(defun migrate-add-creation-and-post-date! 2649,104640
+(defparameter *months-inactive-allowed* 2671,105406
+(defparameter *months-never-logged-in* 2672,105449
+(defun user-inactive? 2676,105535
+(defun inactive-from-never-logged-in? 2680,105661
+(defun locked? 2687,105915
+(defun inactive-from-last-post? 2690,106002
+(defun inactive-from-last-seen? 2698,106360
+(defun inactive-from? 2707,106709
+(defun ever-logged-in? 2715,106916
+(defun never-logged-in? 2718,106992
+(defun list-inactive-users 2721,107064
+(defmacro in-dir 2736,107574
+(defmacro in-groups 2750,108093
+(defun in-group-lambda 2752,108155
+(defmacro in-group 2754,108211
+(defmacro with-group 2757,108311
+(defmacro with-n-args 2767,108639
+(defmacro with-group-set 2777,109016
+(defmacro with-auth 2784,109221
+(defun conforms-to? 2802,109968
+(defun print/finish 2809,110219
+(defun word-plural 2813,110305
+(defun plural 2820,110556
+(defun out 2827,110740
+(defun stderr 2830,110811
+(defun stdout 2835,110937
+(defun println 2838,111013
+(defun enumerate 2841,111125
+(defun ucs-2->ascii 2845,111242
+(defun bad-input 2849,111339
+(defun integer->string 2852,111436
+(defun mkstr 2855,111487
+(defun data 2859,111592
+(defun crlf 2862,111675
+(defun crlf-string 2865,111709
+(defun flatten 2868,111775
+(defmacro mac 2877,112061
+(define-test dispatching2912,113895
+(defun unix->nntp 2915,113990
+(defvar a-post 2919,114102
+(defvar a-bad-post 2927,114251
+(define-test post-wrong-newsgroup2935,114446
+(define-test post-okay2940,114613
+(defpackage #:loop3037,118108
+(defparameter *debug* 3086,119338
+(asdf:defsystem :<<Name>>3108,119953

loop.lisp

@@ -5,8 +5,6 @@
      :filesystem-utils :ironclad/digest/sha256)
    :silent t))
 
-(clsql:file-enable-sql-reader-syntax)
-
 (defpackage #:loop
   (:use :common-lisp :local-time)
   (:import-from :lisp-unit define-test assert-true)
@@ -24,7 +22,6 @@
 (defparameter *client* (make-client))
 (defstruct request verb args said)
 (defstruct response code data request multi-line)
-(defparameter *default-database* nil)
 (defstruct command fn verb description)
 (defparameter *commands-assoc* nil)
 (defstruct article headers body)
@@ -283,42 +280,25 @@
                              :args args))))))
 
 (defun insert-index (m g i)
-  (handler-case
+  (let ((from (fmt "index/~a" m))
-      (clsql:insert-records 
+        (to (fmt "../groups/~a/~a" g i)))
-       :into "indices"
+    (create-symbolic-link from to)))
-       :attributes '(id grp article) 
-       :values (list (str:trim m) (str:trim g) (str:trim i)))
-    (clsql-sys:sql-database-data-error (c)
-      (cond ((= (slot-value c 'clsql-sys::error-id) 19)
-             'already-indexed)
-            (t
-             ; We should log this error.
-             ;(format t "other error: ~a" (slot-value c 'clsql-sys::database-message))
-             'sql-error)))
-    (:no-error () 
-      nil)))
 
 (defun lookup-index (mid)
-  (let* ((found (clsql:select [grp] [article] 
+  (let ((path (ignore-errors (truename (fmt "index/~a" mid)))))
-                              :from [indices] 
+    (when path
-                              :where [= [id] (str:trim mid)]))
+        (let* ((name (namestring path))
-         (article (first found))
+               (pair (last (str:split "/" name) 2)))
-         (grp (first article))
+          (values (car pair) (cadr pair))))))
-         (art (second article)))
-    (when found
-      (values grp art))))
-
-(defun connect-index! (filename)
-  (setq *default-database* (clsql:connect (list filename) :database-type :sqlite3)))
 
 (defun create-index! ()
-  (clsql:execute-command "create table if not exists indices 
+  (ensure-directories-exist "index/"))
-     (id varchar(1000), grp varchar(1000), article varchar(300))")
+
-  (clsql:execute-command "create unique index if not exists idx_id_1 
+(defun rm-rf (path)
-    on indices (id)"))
+  (uiop:delete-directory-tree (pathname path) :validate t))
 
 (defun drop-create-index! ()
-  (clsql:execute-command "drop table if exists indices")
+  (rm-rf "index/")
   (create-index!))
 
 (defun remove-inactive-users! ()
@@ -1133,21 +1113,19 @@
 
 (defun write-accounts! ()
   (let ((name
-          (loop 
+          (let* ((tmp (random-string 10))
-            (let* ((tmp (random-string 10))
+                 (name (format nil "~a.tmp" tmp)))
-                   (name (format nil "~a.tmp" tmp)))
+            (with-open-file 
-              (when 
+                (s name
-                  (ignore-errors 
+                   :direction :output
-                   (with-open-file 
+                   :if-exists :error
-                       (s name
+                   :if-does-not-exist :create)
-                          :direction :output
+              (write *accounts* :stream s)
-                          :if-exists :error
+              name))))
-                          :if-does-not-exist :create)
+    (rename-file name "accounts.lisp")
-                     (write *accounts* :stream s)))
+    (values t *accounts*)
-                (return name))))))
+    ;(values nil (format nil "could not rename ~a to accounts.lisp" name))
-    (if (ignore-errors (rename-file name "accounts.lisp"))
+    ))
-        (values t *accounts*)
-        (values nil (format nil "could not rename ~a to accounts.lisp" name)))))
 
 (defun get-account (username)
   (loop for u in *accounts*
@@ -1251,23 +1229,24 @@
         maximizing (length (account-username u))))
 
 (defun list-users ()
-  (read-accounts!)
+  (mapcar
-  (mapcar #'(lambda (row) (cadr row))
+   #'(lambda (row) (cadr row))
-          (sort
+   (sort
-           (loop for u in *accounts* 
+    (loop for u in *accounts* 
-                 collect (list (account-username u) 
+          collect (list
-                               (fmt "~v@a~a, ~a, invited ~a" 
+                   (account-username u) 
-                                    (size-of-longest-username)
+                   (fmt "~v@a~a, ~a, invited ~a" 
-                                    (account-username u)
+                        (size-of-longest-username)
-                                    (if (locked? (account-username u))
+                        (account-username u)
-                                        (fmt " (account locked: ~a)"
+                        (if (locked? (account-username u))
-                                             (account-pass-locked-why u))
+                            (fmt " (account locked: ~a)"
-                                        "")
+                                 (account-pass-locked-why u))
-                                    (if (last-time-seen (account-username u))
+                          "")
-                                        (fmt "last seen on ~a" (last-time-seen (account-username u)))
+                        (if (last-time-seen (account-username u))
-                                        "never logged in")
+                            (fmt "last seen on ~a" (last-time-seen (account-username u)))
-                                    (or (account-friends u) "nobody"))))
+                          "never logged in")
-           #'string<= :key #'(lambda (row) (car row)))))
+                        (or (account-friends u) "nobody"))))
+    #'string<= :key #'(lambda (row) (car row)))))
 
 (defun universal-to-human (s)
   (format-timestring
@@ -1325,45 +1304,147 @@
                  ("newsgroups" .  "local.control.news")))))
    :body (data body)))
 
-(defun cli/options () 
+(defun root/command ()
+  (clingon:make-command
+   :name "LOOP"
+   :description "An NNTP server for a circle of friends."
+   :version "a89e088"
+   :options (root/options)
+   :handler #'root/handlers
+   :sub-commands (list (account/command))))
+
+(defun root/options () 
   (list 
-   (clingon:make-option
-    :string
-    :description "creates a new account"
-    :long-name "create-account"
-    :key :create-account)
-   (clingon:make-option
-    :string
-    :description "changes password"
-    :long-name "change-passwd"
-    :key :change-passwd)
    (clingon:make-option
     :flag
-    :description "lists accounts"
+    :description "action: runs a REPL on the terminal"
-    :short-name #\l
-    :long-name "list-accounts"
-    :key :list-accounts)
-   (clingon:make-option
-    :flag
-    :description "runs a REPL right now"
     :short-name #\r
     :long-name "repl"
     :key :repl)
    (clingon:make-option
     :flag
-    :description "disables the NNTP REPL"
+    :description "action: disables the NNTP REPL"
     :long-name "disable-nntp-repl"
     :key :disable-nntp-repl)
    (clingon:make-option
     :flag
-    :description "logging (on stderr)"
+    :description "action: logs to stderr"
     :long-name "logging"
     :key :logging)))
 
-(defun cli/list-accounts ()
+(defun root/handlers (cmd)
+  (handler-case 
+      (root/main cmd)
+    (end-of-file ()
+      (print/finish "^d~%")
+      (uiop:quit 0))
+    (interactive-interrupt ()
+      (print/finish "^c~%")
+      (uiop:quit 0))))
+
+(defun root/main (cmd)
+  (let ((args (clingon:command-arguments cmd))
+        (repl? (clingon:getopt cmd :repl))
+        (logging? (clingon:getopt cmd :logging))
+        (disable-nntp-repl? (clingon:getopt cmd :disable-nntp-repl)))
+    (setq *debug* logging?)
+    (setq *enable-nntp-repl* (not disable-nntp-repl?))
+    (when repl? 
+      (return-from root/main (repl (make-request))))
+    (server-start)))
+
+(defun account/command ()
+  (clingon:make-command
+   :name "account"
+   :description "manages accounts"
+   :options (account/options)
+   :handler #'account/manager))
+
+(defun account/options () 
+  (list 
+   (clingon:make-option
+    :flag
+    :description "action: creates a new --username account invited by --invited-by"
+    :short-name #\n
+    :long-name "new"
+    :key :new)
+   (clingon:make-option
+    :flag
+    :description "action: lists all accounts"
+    :short-name #\l
+    :long-name "list"
+    :key :list)
+   (clingon:make-option
+    :string
+    :description "action: sets password for --username"
+    :short-name #\p
+    :long-name "password"
+    :key :password)
+   (clingon:make-option
+    :string
+    :description ""
+    :short-name #\u
+    :long-name "username"
+    :key :username)
+   (clingon:make-option
+    :string
+    :description ""
+    :short-name #\i
+    :long-name "invited-by"
+    :key :inviter)
+   (clingon:make-option
+    :flag
+    :description "action: destroys account --username"
+    :short-name #\d
+    :long-name "delete"
+    :key :del?)))
+
+(defun account/manager (cmd)
+  (let ((args (clingon:command-arguments cmd))
+        (new? (clingon:getopt cmd :new))
+        (del? (clingon:getopt cmd :del?))
+        (list? (clingon:getopt cmd :list))
+        (pass (clingon:getopt cmd :password))
+        (user (str:upcase (clingon:getopt cmd :username)))
+        (inviter (clingon:getopt cmd :inviter)))
+    (cond 
+      (pass
+       (cond ((not user)
+              (return-from account/manager 
+                (println "Option --username is required.")))
+             (t (account/change-passwd! user pass)
+                ;(println "Okay, ~a has now password ``~a''" user pass)
+                )))
+      (del? 
+       (cond ((not user)
+              (return-from account/manager 
+                (println "Option --username is required.")))
+             ((not (get-account user))
+              (return-from account/manager
+                (println "Account ~a not found." user)))
+             (t (remove-account! user)
+                (write-accounts!)
+                (println "Account ~a deleted." user))))
+      (new? 
+           (cond ((or (not user) (not inviter))
+                  (return-from account/manager 
+                    (println "Options --username, --invited-by are required.")))
+                 ((not (user-name-conforms? user))
+                  (return-from account/manager
+                    (println "Username ``~a'' doesn't conform to regex /^[^\\s]+$/." user)))
+                 ((not (get-account inviter))
+                  (return-from account/manager
+                    (println "Inviter ~a is not a known account; list'em all with ``account -l''." inviter)))
+                 (t 
+                  (log-user-in-as! inviter)
+                  (account/create-account! user (list inviter)))))
+          (list? (account/list-accounts))
+          (t (println "Nothing to do.  Say --help.")))))
+
+(defun account/list-accounts ()
   (println (str:join (crlf-string) (list-users))))
 
-(defun cli/create-account (username args)
+(defun account/create-account! (username args)
   (let ((invited-by (car args)))
     (cond ((null invited-by)
            (println "Must specify who invites the new account."))
@@ -1379,62 +1460,15 @@
                         (notify-user-created username))
                  (println "Sorry, ~a." pass-or-error)))))))
 
-(defun cli/change-passwd (username args)
+(defun account/change-passwd! (username &optional given-passwd)
   (let* ((random-passwd (random-string 6))
-         (given-passwd (car args))
          (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))))))
+              (println "Sorry, could not change password: ~a." problem)))))) 
-
-(defun cli/main-with-handlers (cmd)
-  (handler-case 
-      (cli/main cmd)
-    (end-of-file ()
-      (print/finish "^D~%")
-      (uiop:quit 0))
-    (interactive-interrupt ()
-      (print/finish "^C~%")
-      (uiop:quit 0))))
-
-(defun cli/main (cmd)
-  (read-accounts!)
-  (connect-index! "message-id.db")
-  (create-index!)
-  (let ((args (clingon:command-arguments cmd))
-        (run-server t)
-        (repl (clingon:getopt cmd :repl))
-        (ca (clingon:getopt cmd :create-account))
-        (pa (clingon:getopt cmd :change-passwd))
-        (la (clingon:getopt cmd :list-accounts))
-        (logging (clingon:getopt cmd :logging))
-        (disable-nntp-repl (clingon:getopt cmd :disable-nntp-repl)))
-    (setf *debug* logging)
-    (when (or ca pa la)
-        (setf run-server nil))
-    (when la
-      (cli/list-accounts))
-    (when ca
-      (cli/create-account ca args))
-    (when pa
-      (cli/change-passwd pa args))
-    (when repl
-      (repl (make-request :verb "repl" :args '(command-line))))
-    (when disable-nntp-repl
-      (setq *enable-nntp-repl* nil))
-    (when run-server
-      (server-start))))
-
-(defun cli/command ()
-  (clingon:make-command
-   :name "loop"
-   :description "An NNTP server for a circle of friends."
-   :version "a89e088"
-   :license "GPL v3"
-   :options (cli/options)
-   :handler #'cli/main-with-handlers))
 
 (defun main-loop ()
   (loop
@@ -1454,7 +1488,9 @@
   (main-loop))
 
 (defun main ()
-  (let ((app (cli/command)))
+  (read-accounts!)
+  (create-index!)
+  (let ((app (root/command)))
     (clingon:run app)))
 
 (defun send-banner! ()
@@ -1493,7 +1529,6 @@ A bad test from the biggest mouth of the south.
 
 (define-test post-okay
   (read-accounts!)
-  (connect-index! "test.db")
   (create-index!)
   (setq *client* (make-client :username "ROOT" :auth? 'yes))
   (multiple-value-bind (code msg) (post (string->bytes a-post))

loop.nw

@@ -623,7 +623,9 @@ itself---so we can cascade actions based on a user's request.
   (main-loop))
 
 (defun main ()
-  (let ((app (cli/command)))
+  (read-accounts!)
+  (create-index!)
+  (let ((app (root/command)))
     (clingon:run app)))
 
 (defun send-banner! ()
@@ -684,57 +686,244 @@ letters are equivalent in request verbs.
 \section{Parsing of command-line arguments}
 
 We're using the clingon library as per Vincent Dardel suggestion in
-``The Common Lisp Cookbook''.  We begin with writing a description of
+``The Common Lisp Cookbook''.  I'd like to thank the library's author,
-the program and options it understands.  XXX: notice I don't know how
+Marin Atanasov Nikolov, for his attention while I was learning to use
-to support a two-argument option, so I hacked a solution away.  What
+the library.
-we need to is to implement a new option.  The library is extensible.
+
+The library elegantly supports subcommands, of which we will take
+advantage.  Let's not dissertate too much what we're implementing
+because this is likely a very unstable part of the system---that is,
+we'll likely add many more options, switches and commands.  Let's
+content ourselves---for now---with explaining the design of the
+library restrictly to our current needs.
+
+I'm thinking of the design of the library as a tree of commands.  You
+begin at the root command, which is the \lxxp\ executable itself.
+From the root command, other subcommands will spring---for example,
+{\tt account} for handling user account matters such as creating an
+account or changing a password.  This capability allows us to design
+various programs into a single one.  Let's begin, therefore, with the
+root command and then we connect all the others.
+
+The [[main]] procedure is not here because we already have a section
+called ``main loop'', so perhaps that's a better place to put \Lp's
+main entry point.  The main procedure will invoke [[root/command]].
+Attached to a command are the options and the handlers of the options.
+In the root command, there's also a list of subcommands.
 
 <<Command-line parsing>>=
-(defun cli/options () 
+(defun root/command ()
+  (clingon:make-command
+   :name "<<Name>>"
+   :description "<<Description>>"
+   :version "<<Version>>"
+   :options (root/options)
+   :handler #'root/handlers
+   :sub-commands (list (account/command))))
+
+(defun root/options () 
   (list 
-   (clingon:make-option
-    :string
-    :description "creates a new account"
-    :long-name "create-account"
-    :key :create-account)
-   (clingon:make-option
-    :string
-    :description "changes password"
-    :long-name "change-passwd"
-    :key :change-passwd)
    (clingon:make-option
     :flag
-    :description "lists accounts"
+    :description "action: runs a REPL on the terminal"
-    :short-name #\l
-    :long-name "list-accounts"
-    :key :list-accounts)
-   (clingon:make-option
-    :flag
-    :description "runs a REPL right now"
     :short-name #\r
     :long-name "repl"
     :key :repl)
    (clingon:make-option
     :flag
-    :description "disables the NNTP REPL"
+    :description "action: disables the NNTP REPL"
     :long-name "disable-nntp-repl"
     :key :disable-nntp-repl)
    (clingon:make-option
     :flag
-    :description "logging (on stderr)"
+    :description "action: logs to stderr"
     :long-name "logging"
     :key :logging)))
-@ 
 
-We implement first the procedures that handle options that represent
+(defun root/handlers (cmd)
-an entire program.  For example, saying [[--list-accounts]] is like
+  (handler-case 
-running a program [[./list-accounts]].
+      (root/main cmd)
+    (end-of-file ()
+      (print/finish "^d~%")
+      (uiop:quit 0))
+    (interactive-interrupt ()
+      (print/finish "^c~%")
+      (uiop:quit 0))))
+@ %def root/command
+
+You've already see root options above and next you'll see options and
+flags for subcommands, so let me explain how I see the command line.
+The command line is a language with which we program what we want the
+system to do.  If a certain action requires a username, for example,
+do expect to issue an option such as {\tt --username john}.  For a
+more complete example, suppose you're going to create a new account
+for user {\tt peter}.  Certainly there will be {\tt --username peter}
+in the command line; the subcommand for account creation is {\tt
+  account}, so we're looking at a command line such as {\tt ./loop
+  account --username peter}.  But the subcommand {\tt account} houses
+many commands such as one for creating an account, another for
+changing a password and so on.  So we're missing the account {\em
+  action} in that command line.  The complete solution is {\tt ./loop
+  account --new --username peter --invited-by root}.  Where did that
+{\tt --invited-by} come from?  It turns out account creation has this
+extra requirement---every account must be associated to an account
+holder.  The system demands a tree of users.  You would discover the
+requirement by trying the wrong command line:
+%
+\begin{verbatim}
+%./loop account --new --username peter
+Options --username, --invited-by are required.
+\end{verbatim}
+
+The way to familiarize yourself with the language to instruct
+\Lp\ what to do is to say {\tt --help} to the root command and all
+subcommands.  When an option has no description, that means that
+option is merely part of another option.  In the help below, you can
+see that {\tt --invited-by} has no description, but it is mentioned by
+the {\tt --new} option.
+%
+\begin{verbatim}
+%./loop account --help
+NAME:
+  LOOP account - manages accounts
+
+USAGE:
+  LOOP [global-options] account [options] [arguments ...]
+
+OPTIONS:
+      --help                display usage information and exit
+      --version             display version and exit
+  -d, --delete              destroys account --username
+  -i, --invited-by <VALUE>  
+  -l, --list                lists all accounts
+  -n, --new                 creates a new --username account invited by --invited-by
+  -p, --password <VALUE>    sets password for --username
+  -u, --username <VALUE>    
+\end{verbatim}
+
+Let's describe the actions of the root command.  Every command has to
+have a certain main procedure.  So this is it for the root command.
 
 <<Command-line parsing>>=
-(defun cli/list-accounts ()
+(defun root/main (cmd)
+  (let ((args (clingon:command-arguments cmd))
+        (repl? (clingon:getopt cmd :repl))
+        (logging? (clingon:getopt cmd :logging))
+        (disable-nntp-repl? (clingon:getopt cmd :disable-nntp-repl)))
+    (setq *debug* logging?)
+    (setq *enable-nntp-repl* (not disable-nntp-repl?))
+    (when repl? 
+      (return-from root/main (repl (make-request))))
+    (server-start)))
+@ %def root/main
+
+We continue with the {\tt account} subcommand.
+
+<<Command-line parsing>>=
+(defun account/command ()
+  (clingon:make-command
+   :name "account"
+   :description "manages accounts"
+   :options (account/options)
+   :handler #'account/manager))
+
+(defun account/options () 
+  (list 
+   (clingon:make-option
+    :flag
+    :description "action: creates a new --username account invited by --invited-by"
+    :short-name #\n
+    :long-name "new"
+    :key :new)
+   (clingon:make-option
+    :flag
+    :description "action: lists all accounts"
+    :short-name #\l
+    :long-name "list"
+    :key :list)
+   (clingon:make-option
+    :string
+    :description "action: sets password for --username"
+    :short-name #\p
+    :long-name "password"
+    :key :password)
+   (clingon:make-option
+    :string
+    :description ""
+    :short-name #\u
+    :long-name "username"
+    :key :username)
+   (clingon:make-option
+    :string
+    :description ""
+    :short-name #\i
+    :long-name "invited-by"
+    :key :inviter)
+   (clingon:make-option
+    :flag
+    :description "action: destroys account --username"
+    :short-name #\d
+    :long-name "delete"
+    :key :del?)))
+@ %def account/command
+
+The [[account/manager]] is the main procedure of the {\tt account}
+command.
+
+<<Command-line parsing>>=
+(defun account/manager (cmd)
+  (let ((args (clingon:command-arguments cmd))
+        (new? (clingon:getopt cmd :new))
+        (del? (clingon:getopt cmd :del?))
+        (list? (clingon:getopt cmd :list))
+        (pass (clingon:getopt cmd :password))
+        (user (str:upcase (clingon:getopt cmd :username)))
+        (inviter (clingon:getopt cmd :inviter)))
+    (cond 
+      (pass
+       (cond ((not user)
+              (return-from account/manager 
+                (println "Option --username is required.")))
+             (t (account/change-passwd! user pass)
+                ;(println "Okay, ~a has now password ``~a''" user pass)
+                )))
+      (del? 
+       (cond ((not user)
+              (return-from account/manager 
+                (println "Option --username is required.")))
+             ((not (get-account user))
+              (return-from account/manager
+                (println "Account ~a not found." user)))
+             (t (remove-account! user)
+                (write-accounts!)
+                (println "Account ~a deleted." user))))
+      (new? 
+           (cond ((or (not user) (not inviter))
+                  (return-from account/manager 
+                    (println "Options --username, --invited-by are required.")))
+                 ((not (user-name-conforms? user))
+                  (return-from account/manager
+                    (println "Username ``~a'' doesn't conform to regex /<<Form of user names>>/." user)))
+                 ((not (get-account inviter))
+                  (return-from account/manager
+                    (println "Inviter ~a is not a known account; list'em all with ``account -l''." inviter)))
+                 (t 
+                  (log-user-in-as! inviter)
+                  (account/create-account! user (list inviter)))))
+          (list? (account/list-accounts))
+          (t (println "Nothing to do.  Say --help.")))))
+@ %def account/manager
+
+You will find some redundancy here.  For instance, we might be double
+checking for human error.  It's harmless, but we would like to address
+that eventually.  We end this section with the remaining account
+management commands.
+
+<<Command-line parsing>>=
+(defun account/list-accounts ()
   (println (str:join (crlf-string) (list-users))))
 
-(defun cli/create-account (username args)
+(defun account/create-account! (username args)
   (let ((invited-by (car args)))
     (cond ((null invited-by)
            (println "Must specify who invites the new account."))
@@ -750,70 +939,18 @@ running a program [[./list-accounts]].
                         (notify-user-created username))
                  (println "Sorry, ~a." pass-or-error)))))))
 
-(defun cli/change-passwd (username args)
+(defun account/change-passwd! (username &optional given-passwd)
   (let* ((random-passwd (random-string 6))
-         (given-passwd (car args))
          (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))))))
+              (println "Sorry, could not change password: ~a." problem)))))) 
-@ %def cli/change-passwd cli/list-accounts cli/create-account
+@ %def account/change-passwd! account/list-accounts account/create-account!
 
-Now let's write the main procedure in command-line parsing.  Notice
+That's it for now.  Good job.
-that because of the design of the [[clingon]] library, command-line
-parsing becomes the main procedure of \lp.  In other words, \lp's
-service proper starts at [[server-start]].
-
-<<Command-line parsing>>=
-(defun cli/main-with-handlers (cmd)
-  (handler-case 
-      (cli/main cmd)
-    (end-of-file ()
-      (print/finish "^D~%")
-      (uiop:quit 0))
-    (interactive-interrupt ()
-      (print/finish "^C~%")
-      (uiop:quit 0))))
-
-(defun cli/main (cmd)
-  (read-accounts!)
-  (connect-index! "message-id.db")
-  (create-index!)
-  (let ((args (clingon:command-arguments cmd))
-        (run-server t)
-        (repl (clingon:getopt cmd :repl))
-        (ca (clingon:getopt cmd :create-account))
-        (pa (clingon:getopt cmd :change-passwd))
-        (la (clingon:getopt cmd :list-accounts))
-        (logging (clingon:getopt cmd :logging))
-        (disable-nntp-repl (clingon:getopt cmd :disable-nntp-repl)))
-    (setf *debug* logging)
-    (when (or ca pa la)
-        (setf run-server nil))
-    (when la
-      (cli/list-accounts))
-    (when ca
-      (cli/create-account ca args))
-    (when pa
-      (cli/change-passwd pa args))
-    (when repl
-      (repl (make-request :verb "repl" :args '(command-line))))
-    (when disable-nntp-repl
-      (setq *enable-nntp-repl* nil))
-    (when run-server
-      (server-start))))
-
-(defun cli/command ()
-  (clingon:make-command
-   :name "loop"
-   :description "<<Description>>"
-   :version "<<Version>>"
-   :license "GPL v3"
-   :options (cli/options)
-   :handler #'cli/main-with-handlers))
-@ %def cli/options cli/command
 
 \section{Request dispatching mechanism}
 
@@ -1140,26 +1277,29 @@ the problem?  Two processes in parallel may ask for the writing of
 modifications lost.  What do we need to do?  Either we use file
 locking or we do something smarter without a real file locking
 mechanism.  It's not clear to me what is possible here, but this is
-definitely a problem that we need to solve.
+definitely a problem that we need to solve. XXX: Notice, too, that
+there's a bug in [[write-accounts!]] that's hit when we try to write a
+[[nil]] list of accounts.  Of course, we should not let anyone delete
+the root account, but we don't understand the bug.  The bug is an
+infinite loop of attempts.  Why?  We need to take the ignore-errors
+from there to see what's happening.  Not easy.
 
 <<Command create-account>>=
 (defun write-accounts! ()
   (let ((name
-          (loop 
+          (let* ((tmp (random-string 10))
-            (let* ((tmp (random-string 10))
+                 (name (format nil "~a.tmp" tmp)))
-                   (name (format nil "~a.tmp" tmp)))
+            (with-open-file 
-              (when 
+                (s name
-                  (ignore-errors 
+                   :direction :output
-                   (with-open-file 
+                   :if-exists :error
-                       (s name
+                   :if-does-not-exist :create)
-                          :direction :output
+              (write *accounts* :stream s)
-                          :if-exists :error
+              name))))
-                          :if-does-not-exist :create)
+    (rename-file name "accounts.lisp")
-                     (write *accounts* :stream s)))
+    (values t *accounts*)
-                (return name))))))
+    ;(values nil (format nil "could not rename ~a to accounts.lisp" name))
-    (if (ignore-errors (rename-file name "accounts.lisp"))
+    ))
-        (values t *accounts*)
-        (values nil (format nil "could not rename ~a to accounts.lisp" name)))))
 
 (defun get-account (username)
   (loop for u in *accounts*
@@ -2119,7 +2259,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 totally {\em hackable}; users can say {\tt repl} to have
 complete control over their \lxxp\ process.
 
 <<Command repl>>=
@@ -2218,7 +2358,7 @@ searching for the next line.
 
 \section{Article index}\label{sec:index}
 
-Every NNTP server needs to have an index of articles.  Each article is
+An NNTP server needs to have an index of articles.  Each article is
 indexed by its message-id.  For example, the article
 %
 \begin{verbatim}
@@ -2233,89 +2373,68 @@ indexed by its message-id.  For example, the article
     Content-Transfer-Encoding: 8bit
 \end{verbatim}
 %
-is indexed by the header {\tt message-id}.  If you ask for article
+is indexed by the header {\tt message-id} and the index will tell us
-{\tt <87plr25js5.fsf@tor.soy>}, \Lp\ will tell you that you can find
+that you can find this article in {\tt
-the article in group {\tt comp.unix} and its numeric ID is 37.  Note
+  groups/comp.unix/<87plr25js5.fsf@tor.soy>}.  We implement the index
-that the number 37 is not inside the article, but only in the name of
+as a symbolic link from {\tt index/<87plr25js5.fsf@tor.soy>} to {\tt
-the file stored in the file system.  The index, therefore, knows in
+  groups/comp.unix/<87plr25js5.fsf@tor.soy>}.  Now, what happens when
-which file is each {\tt message-id}.  This fact implies that you
+an article belongs to multiple groups?  The index will always point to
-cannot rename files in the file system---of course not: you'd changing
+the first group.  The other groups will have symbolic links to the
-identifiers inside a database.  If you have rename a file, you will
+first group, too.  This means we need to change [[post]] to reflect
-need to rebuild the index.  Given that the index is an SQL table, you
+the new way of storing articles.  Let's create a procedure called
-can adjust the index relative to the any files you may need to rename
+[[make-link]] that takes a message-id and a group name.  The procedure
-for whatever reason.  You can also rebuild the entire index by reading
+then creates a zero-byte file holding the id for the link and then
-the file system---unless you have a lot of files, that's probably the
+replaces it with a symbolic link.  How will it replace it?  It will
-easiest thing to do.
+replace it by first writing the symbolic link to a temporary file and
-
+then renaming it.  In other words, we need a [[make-atomic-symlink]]
-The use of [[*default-database*]] by the library [[clsql]] is very
+procedure.
-convenient for us: we don't need to specify with which database we're
-working.  Since we work with only one, we pretty much never need to
-specify anything.
-
-<<Reference to the database>>=
-(defparameter *default-database* nil)
-@ %def *default-database*
-
-<<How to create and connect to the index>>=
-(defun connect-index! (filename)
-  (setq *default-database* (clsql:connect (list filename) :database-type :sqlite3)))
 
+<<How to create the index>>=
 (defun create-index! ()
-  (clsql:execute-command "create table if not exists indices 
+  (ensure-directories-exist "index/"))
-     (id varchar(1000), grp varchar(1000), article varchar(300))")
+
-  (clsql:execute-command "create unique index if not exists idx_id_1 
+(defun rm-rf (path)
-    on indices (id)"))
+  (uiop:delete-directory-tree (pathname path) :validate t))
 
 (defun drop-create-index! ()
-  (clsql:execute-command "drop table if exists indices")
+  (rm-rf "index/")
   (create-index!))
-@ %def create-index! drop-create-index! connect-index!
+@ %def create-index! drop-create-index!
 
-Of course, the creation and connection of the index must occur before
+Hey, remember that [[rm-rf]] must be take a slashed directory.
-[[main-loop]], so it takes place in [[main]].  
 
-When someone requests an article, it's either by its numeric index but
+By the way, the creation and connection of the index must occur before
-then the client has already chosen a group, or it's by its {\tt
+[[main-loop]], so it takes place in [[main]].
-  message-id}.  We don't need to tell the client to which groups the
-article belongs; we just give the entire article to the client.  It
-is, therefore, the client's responsibility what to do with the
-article.  However, to fetch an article, we need to know where in the
-database (in the file system) is the article; in other words, we must
-know one group in which the article was stored.  This implies that the
-index must know at least one group.  We've decided to always index the
-first group in the {\tt newsgroups} header.  So the index's anatomy is
-$(m, g, i)$, where $m$ is the {\tt message-id}, $g$ is the name of the
-group and $i$, is the name of the article in the file system.  This
-also defines the anatomy of the SQL table.
 
-Should we store more information in the index?  Not really.  If we
+Writing a new article means creating the index and then writing the
-need anything about an article, we can get it after we fetch it from
+file.  So we need to make that into a transaction.  Use
-the file system.  For example, suppose that a search command wishes to
+[[unwind-protect]] to delete the index entry if anything goes wrong
-display the fact that article was posted in various groups.  Suppose
+with writing the article.
-further the command has already located in the index an article to be
-displayed.  This means the command has the {\tt message-id} and one of
-the groups in which the article was posted.  The command is then able
-to fetch the entire article from the file system.  Now it's a matter
-of reading the article itself to know almost everything there is to
-know about it.  (It's also interesting that we keep the index thin
-because we need to allow it to grow to great sizes.)
 
-%% (clsql:create-table "INDICES" '(([id] (string 1000)) ([grp] (string 1000)) ([article] (string 300))))
+These and others are essential operations of the index.
-%% (clsql:execute-command "create table if not exists indices (id varchar(1000), grp varchar(1000), article varchar(300))")
 
-%% LOOP> (clsql:create-index "idx_id_1" :on "indices" :attributes "id" :unique "id")
+I think that in a time like this, literate programming doesn't help
-%% ; No value
+much.  I think we should go straight to the code right now and then
-%% (clsql:execute-command "CREATE UNIQUE INDEX if not exists idx_id_1 ON INDICES (ID)")
+bring it back when it's done.  Let's face it---we don't work linearly.
+This is probably hindering us.  Literate programming is to help us
+organize, present, improve, understand; it's not here to help
+prototype exactly.  Let's write our ideas here, but the code straight
+to the source code.  Now I gotta be careful not to destroy work.  If I
+say {\tt make}, it will destroy?  No, {\tt make} just compiles it as
+it should.  But if say {\tt nomake}, my work would be destroyed.  Can
+we stop that somehow?  An easy solution is to destroy {\tt Nowebfile}
+by moving it to {\tt Nowebfrost}.  Elegant solution.  But then we
+cannot build the PDF either.  But that's okay.
 
-%% CL-USER> (clsql:list-attributes "indices")
+Now, the funny thing is that I only began directly at the source code
-%% ("ID" "GRP" "ARTICLE")
+and soon I was back at literate programming.  The changes were very
-
+small in the end.  So I said I was going to do one thing and did
-%% CL-USER> (clsql:insert-records :into "indices" :attributes '(id grp article) :values '("<87plr25js5.fsf@tor.soy>" "comp.unix" 37))
+another.  But it's true that we don't write code linearly.  Literate
-%% ; No value
+programming is not the first place where we put the pen.  We put the
-
+pen on any piece of paper at all.  When we realize we have something
-%% CL-USER> (clsql:select 'id 'grp 'article :from "indices")
+with any resemblance of coherence, we then literate it out.  That's
-%% (("<87plr25js5.fsf@tor.soy>" "comp.unix"))
+our approach here.  Let's be very rational and use whatever works
-%% ("ID" "GRP")
+best.  Let's try to compile this thing.
 
 \section{Essential operations relative to the index}
 
@@ -2332,32 +2451,33 @@ Sure---in the future, we will not duplicate articles in storage; we
 will make symbolic links.  We don't do that right now because Windows
 doesn't really support symbolic links.
 
+How do we insert a message to the index?  We cannot atomically create
+two files: the system won't do it for us.  We'll need to build the
+transaction ourselves and in Lisp that's easy with [[unwind-protect]].
+
 <<Essential operations relative to the index>>=
 (defun insert-index (m g i)
-  (handler-case
+  (let ((from (fmt "index/~a" m))
-      (clsql:insert-records 
+        (to (fmt "../groups/~a/~a" g i)))
-       :into "indices"
+    (create-symbolic-link from to)))
-       :attributes '(id grp article) 
+@ %def insert-index.
-       :values (list (str:trim m) (str:trim g) (str:trim i)))
-    (clsql-sys:sql-database-data-error (c)
-      (cond ((= (slot-value c 'clsql-sys::error-id) 19)
-             'already-indexed)
-            (t
-             ; We should log this error.
-             ;(format t "other error: ~a" (slot-value c 'clsql-sys::database-message))
-             'sql-error)))
-    (:no-error () 
-      nil)))
 
+Lisp [[truename]] is not going to blow an error if message-id doesn't
+exist on the file system.  It's going to simply not translate the
+path.  What we do is take the last 2 elements of splitting the
+pathname.  If we get {\tt index}, it's because it wasn't translated.
+This, of course, implies we cannot have a group named ``index''.  What
+we'll do instead is consider it a bug if the index would point to a
+file that doesn't exist.  It's really not supposed to happen.  This
+simplifies.
+
+<<Essential operations relative to the index>>=
 (defun lookup-index (mid)
-  (let* ((found (clsql:select [grp] [article] 
+  (let ((path (ignore-errors (truename (fmt "index/~a" mid)))))
-                              :from [indices] 
+    (when path
-                              :where [= [id] (str:trim mid)]))
+        (let* ((name (namestring path))
-         (article (first found))
+               (pair (last (str:split "/" name) 2)))
-         (grp (first article))
+          (values (car pair) (cadr pair))))))
-         (art (second article)))
-    (when found
-      (values grp art))))
 @ %def insert-index lookup-index
 
 \section{Procedure to import the index from the file system}
@@ -2396,13 +2516,16 @@ we need to index it.
   (index-from-fs!))
 @
 
+Cool.  We just rewrote the index, giving up on using sqlite, and we
+don't need to update this procedure.  Thanks to functional
+abstraction.
+
 Here's a program to build the index from a UNIX shell.
 
 <<build-index-from-fs.lisp>>=
 <<Quicklisp loading preamble>>
 (ql:quickload :loop :silent t)
 (in-package #:loop)
-(connect-index! "message-id.db")
 (drop-create-index!)
 (index-from-fs!)
 (format t "Index built.~%")
@@ -2440,7 +2563,6 @@ that.
 (ql:quickload :loop :silent t)
 (in-package #:loop)
 (read-accounts!)
-(connect-index! "message-id.db")
 (remove-inactive-users!)
 (write-accounts!)
 @ %def cron-remove-inactive-users.lisp
@@ -2804,7 +2926,6 @@ A bad test from the biggest mouth of the south.
 
 (define-test post-okay
   (read-accounts!)
-  (connect-index! "test.db")
   (create-index!)
   (setq *client* (make-client :username "ROOT" :auth? 'yes))
   (multiple-value-bind (code msg) (post (string->bytes a-post))
@@ -2817,7 +2938,7 @@ XXX: we got a problem with test [[post-okay]].  We're getting an
 execution error, but we can't see any error message.  The posting is
 taking place---here in the REPL at least.
 
-\section{How to produce the binary executable}
+\section{Executable, how to build it}
 
 Just say {\tt make loop} to your shell.
 
@@ -2838,7 +2959,7 @@ Just say {\tt make loop} to your shell.
     (load quicklisp-init)))
 @ %def quicklisp
 
-\section{How to get a log of \lp's communication}
+\section{Log of \lp's communication, how to produce it}
 
 If you invoke \lxxp\ with option [[--logging]], you get logging on
 [[stderr]]:
@@ -2897,8 +3018,6 @@ something to think about.
    '(<<List of packages to be loaded>>)
    :silent t))
 
-(clsql:file-enable-sql-reader-syntax)
-
 (defpackage #:loop
   (:use :common-lisp :local-time)
   (:import-from :lisp-unit define-test assert-true)
@@ -2916,7 +3035,7 @@ something to think about.
 <<Loop's REPL>>
 <<Procedures for requests and responses>>
 <<Essential operations relative to the index>>
-<<How to create and connect to the index>>
+<<How to create the index>>
 <<How to remove inactive users>>
 <<How to enumerate inactive accounts>>
 <<How to migrate accounts without a creation date>>
@@ -2952,7 +3071,6 @@ something to think about.
 <<Representation of accounts>>
 <<Representation of a client>>
 <<Representation of requests and responses>>
-<<Reference to the database>>
 <<Representation of commands>>
 <<Representation of articles>>
 <<Definition of maximum allowed inactive periods>>

scripts/build-index-from-fs.lisp

@@ -5,7 +5,6 @@
     (load quicklisp-init)))
 (ql:quickload :loop :silent t)
 (in-package #:loop)
-(connect-index! "message-id.db")
 (drop-create-index!)
 (index-from-fs!)
 (format t "Index built.~%")

scripts/cron-remove-inactive-users.lisp

@@ -6,6 +6,5 @@
 (ql:quickload :loop :silent t)
 (in-package #:loop)
 (read-accounts!)
-(connect-index! "message-id.db")
 (remove-inactive-users!)
 (write-accounts!)