Disables the NNTP repl command when --disables-nntp-repl is given.

accounts.lisp

@@ -1,9 +1,10 @@
 (#S(LOOP::ACCOUNT
     :USERNAME "ROOT"
-    :SEEN 3943637447
+    :SEEN 3943778307
     :LAST-POST NIL
     :FRIENDS NIL
-    :PASS NIL
+    :PASS #(166 101 164 89 32 66 47 157 65 126 72 103 239 220 79 184 160 74 31
+            63 255 31 160 126 153 142 134 247 247 162 122 227)
     :PASS-LOCKED NIL
     :PASS-LOCKED-WHY NIL
-    :CREATION 3913066800))
+    :CREATION 3913066800))

format-def

@@ -16,7 +16,7 @@ usage()
 sed -E '/^\(defun |\(defmacro /{
  i\
 
-}' $* | sed '/^[ \t]*$/{
+}' "$@" | sed '/^[ \t]*$/{
    N
    /^[ \t]*\n$/D
 }'

loop.asd

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

loop.lisp

@@ -17,19 +17,20 @@
 
 (in-package #:loop)
 
+(defparameter *debug* nil)
 (defstruct account username seen last-post friends pass pass-locked pass-locked-why creation)
 (defparameter *accounts* nil)
 (defstruct client group (article 1) (username "ANONYMOUS") (auth? 'no))
 (defparameter *client* (make-client))
 (defstruct request verb args said)
 (defstruct response code data request multi-line)
-(defvar *default-database* nil)
+(defparameter *default-database* nil)
 (defstruct command fn verb description)
 (defparameter *commands-assoc* nil)
 (defstruct article headers body)
 (defparameter *months-inactive-allowed* 3)
 (defparameter *months-never-logged-in* 1)
-(defvar *debug* nil)
+(defparameter *enable-nntp-repl* t)
 
 (defun table-of-commands ()
   `(("GROUP" ,#'cmd-group "sets the current group") 
@@ -843,7 +844,7 @@
 
 (defun menu (ls)
   (loop for item in ls 
-        collect (display-fn (car ls))))
+        collect (display-fn item)))
 
 (defun display-fn (cmd-pair)
   (let ((cmd (cdr cmd-pair)))
@@ -935,16 +936,18 @@
 (defun cmd-post (r)
   (with-auth 
       (send-response! 
-       (make-response :code 340 
+       (make-response 
-                      :data (format nil "Okay, go ahead. Suggested message-id ~a."
+        :code 340 
+        :data (format nil "Okay, go ahead. Suggested message-id ~a."
                                     (suggest-message-id))))
     (let* ((bs (nntp-read-article)))
       (multiple-value-bind (okay? error) (conforms? bs)
-        (if (not okay?)
+        (cond ((not okay?)
-            (make-response :code 400 :request r
+               (make-response 
-                           :data (format nil "Sorry. Your article doesn't conform: ~a." error))
+                :code 400 :request r
-            (multiple-value-bind (code reply) (post bs)
+                :data (format nil "Sorry. Your article doesn't conform: ~a." error)))
-              (make-response :code code :request r :data reply)))))))
+              (t (multiple-value-bind (code reply) (post bs)
+                   (make-response :code code :request r :data reply))))))))
 
 (defun post (bs)
   (let ((ngs (newsgroups-header->list 
@@ -1282,8 +1285,13 @@
   (make-response :code 200 :data (format nil "state: ~a" *client*) :request r))
 
 (defun cmd-repl (r)
-  (with-auth
+  (if *enable-nntp-repl*
-      (repl r)))
+      (with-auth
+          (repl r))
+      (make-response 
+       :code 400
+       :data "The REPL has been *explicitly* disabled by the sysadmin. :("
+       :request r)))
 
 (defun notify-group-created (g)
   (post-notification 
@@ -1338,10 +1346,15 @@
     :key :list-accounts)
    (clingon:make-option
     :flag
-    :description "runs a REPL"
+    :description "runs a REPL right now"
     :short-name #\r
     :long-name "repl"
     :key :repl)
+   (clingon:make-option
+    :flag
+    :description "disables the NNTP REPL"
+    :long-name "disable-nntp-repl"
+    :key :disable-nntp-repl)
    (clingon:make-option
     :flag
     :description "logging (on stderr)"
@@ -1392,12 +1405,16 @@
   (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)))
+        (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
@@ -1406,14 +1423,16 @@
       (cli/change-passwd pa args))
     (when repl
       (repl (make-request :verb "repl" :args '(command-line))))
-    (when (and (not la) (not ca) (not pa) (not repl))
+    (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 "afe7d0e"
+   :version "a89e088"
    :license "GPL v3"
    :options (cli/options)
    :handler #'cli/main-with-handlers))
@@ -1443,7 +1462,7 @@
   (send-response! 
    (make-response 
     :code 200 
-    :data "Welcome! I am LOOP afe7d0e. Say ``help'' for a menu.")))
+    :data "Welcome! I am LOOP a89e088. Say ``help'' for a menu.")))
 
 (setq lisp-unit:*print-failures* t)
 (define-test dispatching

loop.nw

@@ -47,6 +47,7 @@
   {a circle out of fashion}}
 \date{January 2024}
 \begin{document}
+\pdfbookmark[1]{Introduction}{intro}
 \fontfamily{cmr}\selectfont
 \maketitle
 %\setlength{\parskip}{3pt}
@@ -54,9 +55,9 @@
 
 \Lp\ is an out-of-fashion program, used as medium of communication by
 antiquated people.  \Lp\ members insist that technical communication
-be made in writing and not in a hurry.  That's how backwards they are.
+be made in writing and not in a hurry.  To give you an idea, they
-To give you an idea, they write \Lp\ in Lisp---jurassic technology.
+write \Lp\ in jurassic technology.  You wouldn't pay them any
-We surely wouldn't pay them any attention.
+attention.
 %
 \begin{verbatim}
          Drunk and dressed in their best brown baggies and their platform soles
@@ -74,6 +75,24 @@ the list of destinaries.  So long as everyone replies to everyone,
 John, too, will start getting all the messages.  If anyone violates
 this rule of replying to everyone involved, the loop is broken.
 
+%% \begin{figure}[!htb]
+%%   \centering \includegraphics[width=0.8\linewidth]{images/gnus-summary.png}
+%%   \caption{Gnus, a news reader embedded in the GNU EMACS text editor.}
+%%   \label{fg:gnus}
+%% \end{figure}
+%% 
+%% \begin{figure}[!htb]
+%%   \centering \includegraphics[width=0.8\linewidth]{images/tbird-summary.png}
+%%   \caption{Thunderbird, a news reader produced by the Mozilla Foundation.}
+%%   \label{fg:bird}
+%% \end{figure}
+%% 
+%% \begin{figure}[!htb]
+%%   \centering \includegraphics[width=0.8\linewidth]{images/sylpheed-summary.png}
+%%   \caption{Sylpheed, a news reader produced by Hiroyuki Yamamoto.}
+%%   \label{fg:sylpheed}
+%% \end{figure}
+
 There are surely inconveniences in using e-mail as conference medium.
 For example, after John has been added to the loop, he is not able to
 leave by his own account.  He needs to ask everyone involved to stop
@@ -118,41 +137,23 @@ NNTP-aware programs.  You could write your own.  Figures
 \ref{fg:gnus}--\ref{fg:sylpheed} show a few programs for reading
 network news via NNTP.
 
-\begin{figure}[!htb]
+\pdfbookmark[1]{Principles for a discussion group}{principles}
-  \centering \includegraphics[width=0.8\linewidth]{images/gnus-summary.png}
+\label{principles} 
-  \caption{Gnus, a news reader embedded in the GNU EMACS text editor.}
+{\bf Principles for a discussion group}. We believe a discussion group
-  \label{fg:gnus}
-\end{figure}
-
-\begin{figure}[!htb]
-  \centering \includegraphics[width=0.8\linewidth]{images/tbird-summary.png}
-  \caption{Thunderbird, a news reader produced by the Mozilla Foundation.}
-  \label{fg:bird}
-\end{figure}
-
-\begin{figure}[!htb]
-  \centering \includegraphics[width=0.8\linewidth]{images/sylpheed-summary.png}
-  \caption{Sylpheed, a news reader produced by Hiroyuki Yamamoto.}
-  \label{fg:sylpheed}
-\end{figure}
-
-\noindent{\bf Principles for a discussion group}. We believe a discussion group
 should be small and grow slowly.  By ``slowly'', we mean that each
 member comes in through an invitation.  This way, the group being
 closed by definition, we keep spam out and give members a certain
-sense of privilege.
+sense of privilege.  A discussion group should be formed by interested
-
+people.  If a participant doesn't log-in for a certain period of time,
-A discussion group should be formed by interested people.  If a
+\lp locks the participant's account---see Section
-participant doesn't log-in for a certain period of time, \lp locks the
+\ref{sec:inactive-users}.  The account can be reactivated, but it will
-participant's account---see Section \ref{sec:inactive-users}.  The
+take asking another participant (with an active account) to do so.  In
-account can be reactivated, but it will take asking another
+other words, there's an encouragement for an uninterested member not
-participant (with an active account) to do so.  In other words,
+to come back to the \lp.  The idea is to keep a certain cohesion in
-there's an encouragement for an uninterested member not to come back
+the discussion groups.  When an account is locked or unlocked, an
-to the \lp.  The idea is to keep a certain cohesion in the discussion
+article is posted to the group {\tt local.control.news}, so everyone
-groups.  When an account is locked or unlocked, an article is posted
+knows who is leaving and arriving.  This way, participants get to have
-to the group {\tt local.control.news}, so everyone knows who is
+an idea of who is reading them.
-leaving and arriving.  This way, participants get to have an idea of
-who is reading them.
 
 Each invitation comes with a certain responsibility: it's possible to
 see who invited who.  If {\tt BOB} misbehaves, everyone gets to see
@@ -658,7 +659,7 @@ An NNTP server for a circle of friends.
 @ 
 
 <<Version>>=
-afe7d0e
+a89e088
 @ 
 
 \section{Parsing of requests}
@@ -709,10 +710,15 @@ we need to is to implement a new option.  The library is extensible.
     :key :list-accounts)
    (clingon:make-option
     :flag
-    :description "runs a REPL"
+    :description "runs a REPL right now"
     :short-name #\r
     :long-name "repl"
     :key :repl)
+   (clingon:make-option
+    :flag
+    :description "disables the NNTP REPL"
+    :long-name "disable-nntp-repl"
+    :key :disable-nntp-repl)
    (clingon:make-option
     :flag
     :description "logging (on stderr)"
@@ -776,12 +782,16 @@ service starts with [[server-start]].
   (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)))
+        (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
@@ -790,7 +800,9 @@ service starts with [[server-start]].
       (cli/change-passwd pa args))
     (when repl
       (repl (make-request :verb "repl" :args '(command-line))))
-    (when (and (not la) (not ca) (not pa) (not repl))
+    (when disable-nntp-repl
+      (setq *enable-nntp-repl* nil))
+    (when run-server
       (server-start))))
 
 (defun cli/command ()
@@ -980,7 +992,7 @@ reason to think we're doing to debug it.}
 
 (defun menu (ls)
   (loop for item in ls 
-        collect (display-fn (car ls))))
+        collect (display-fn item)))
 
 (defun display-fn (cmd-pair)
   (let ((cmd (cdr cmd-pair)))
@@ -1555,7 +1567,15 @@ XXX: instead of only catching [[sb-posix:syscall-error]], we should
 catch anything else, reporting the error.  Otherwise, we will blow up
 in case of some unexpected error, which might not be a bad idea---as
 long as we can log these errors and get a report later on of what's
-going on so we can improve the code.
+going on so we can improve the code.  I still don't really know what
+to do here.  Let's leave it as it is.  The original idea is to put a
+[[t]]-case in the [[handler-case]] below and just log the error
+instead of crashing completely.  We can simulate the catching of an
+unexpected condition by signaling it from fetch-article as a test.
+This type of situation should have a testing routine as well.  So,
+yeah, first give yourself another read of the [[lisp-unit]]
+documentation, then how to handle conditions properly and then come
+back to this to-do item.
 
 <<Commands head, body, article>>=
 (defun typical-cmd-response (code r g i get-data)
@@ -1775,10 +1795,11 @@ now, however, we have only these two to worry about.
   (ensure-header "date" #'get-date bs))
 @ %def ensure-mid ensure-date
 
-Now it's time to look at the header \verb|newsgroups|.  (XXX: Our code
+Now it's time to look at the header \verb|newsgroups|.  XXX: we need
-here is a bit confusing, but I don't know the best to do here, so I'm
+to rewrite this because we have that plan of verifying everything
-going ahead unpretentiously.)  If we get approved by [[conforms?]],
+there is to verify up front in [[conforms?]].  So when we invoke
-then we verify the list of newsgroups right away.
+[[post]], there's nothing else to verify.  We're verifying in two
+places at the same time.
 
 The name of each group must conform to the expression
 
@@ -1801,16 +1822,18 @@ of trying to stop them.
 (defun cmd-post (r)
   (with-auth 
       (send-response! 
-       (make-response :code 340 
+       (make-response 
-                      :data (format nil "Okay, go ahead. Suggested message-id ~a."
+        :code 340 
+        :data (format nil "Okay, go ahead. Suggested message-id ~a."
                                     (suggest-message-id))))
     (let* ((bs (nntp-read-article)))
       (multiple-value-bind (okay? error) (conforms? bs)
-        (if (not okay?)
+        (cond ((not okay?)
-            (make-response :code 400 :request r
+               (make-response 
-                           :data (format nil "Sorry. Your article doesn't conform: ~a." error))
+                :code 400 :request r
-            (multiple-value-bind (code reply) (post bs)
+                :data (format nil "Sorry. Your article doesn't conform: ~a." error)))
-              (make-response :code code :request r :data reply)))))))
+              (t (multiple-value-bind (code reply) (post bs)
+                   (make-response :code code :request r :data reply))))))))
 @ 
 
 It's time to write the action of posting.  One thing to keep in mind
@@ -1820,14 +1843,14 @@ our index.  More to follow.)  More importantly, we cannot let the user
 post to any group if one of the groups is incorrectly named---for
 example, when the group doesn't exist.  Why don't we post to the ones
 that are correct and warn the user of the ones that are incorrect?
-Because that is not prudent.  The user could be trying to divulge news
+Because that is not prudent.  The user could be trying to publish news
 to be received at the same time by various groups.  We would make such
-plans all go down the drain.  So we don't.
+plans all go down the drain.
 
 We collect a list of newsgroups that don't exist (or whose names do
 not conform for any reason).  If we find any such group, then we
 refuse posting and return a 400 code with a message describing which
-group names failed.  Otherwise we [[save-article-insist]].
+group names failed.  Otherwise we save the article.
 
 <<Command post>>=
 (defun post (bs)
@@ -2096,16 +2119,30 @@ 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
-complete control over their \lxxp\ process.  XXX: we should implement
+complete control over their \lxxp\ process.
-an option [[--disable-repl]] so that REPL hacking is turned off.
-(This would mean your users are not true hackers.)
 
 <<Command repl>>=
 (defun cmd-repl (r)
-  (with-auth
+  (if *enable-nntp-repl*
-      (repl r)))
+      (with-auth
+          (repl r))
+      (make-response 
+       :code 400
+       :data "The REPL has been *explicitly* disabled by the sysadmin. :("
+       :request r)))
 @
 
+If your users are not the hacker-type, you can disable the NNTP REPL
+with the command-line option [[--disable-nntp-repl]].  We decide not
+to hide the command in the list of commands given by saying {\tt HELP}
+to \lp\ because this way users are advertised about the commands that
+exist---they could be having fun, but their sysadmin doesn't think
+they're skilled enough.
+
+<<Global variable that decides whether to enable the NNTP REPL>>=
+(defparameter *enable-nntp-repl* t)
+@ 
+
 \section{Publication of news}
 
 If you're interested in being notified about what's going on in the
@@ -2215,7 +2252,7 @@ working.  Since we work with only one, we pretty much never need to
 specify anything.
 
 <<Reference to the database>>=
-(defvar *default-database* nil)
+(defparameter *default-database* nil)
 @ %def *default-database*
 
 <<How to create and connect to the index>>=
@@ -2387,16 +2424,15 @@ Index built.
 
 \section{Deletion and locking of inactive accounts}\label{sec:inactive-users}
 
-XXX: remove this paragraph from here; present the program first and
+We now implement some of the principles exposed earlier on
-then talk about it.  In [[remove-friend]], note that [[username]] is
+page~\pageref{principles}.  The program
-the account name and [[friend]] is the name of the account being
+@<<cron-remove-inactive-users.lisp@>> would be run by {\tt cron} every
-removed.  Notice as well that we only know who invited the person
+day (at midnight, say).  It checks all accounts that are inactive and
-after we can get a hold of the account in [[accounts.lisp]].  This
+either locks them (to be deleted later) or deletes them {\em for
-means we must scan each account to delete an account---we can't delete
+  good}.  If you want to keep accounts forever, just don't run the
-an account and still leave the account as someone's friend.
+program.  XXX: our idea is to also delete {\em for good} all accounts
-
+that are locked (by the same period of time), but we have not yet done
-The program [[cron-remove-inactive-users.lisp]] can be executed every
+that.
-day at midnight, say.
 
 <<cron-remove-inactive-users.lisp>>=
 <<Quicklisp loading preamble>>
@@ -2408,15 +2444,12 @@ day at midnight, say.
 (write-accounts!)
 @ %def cron-remove-inactive-users.lisp
 
-In [[remove-account]], we probably should use [[delete-if]] as well on
+The entire program is really [[remove-inactive-users!]].
-the list of friends since it is effectively what we are doing there
-with [[setf]]. %% TODO
 
 <<How to remove inactive users>>=
 (defun remove-inactive-users! ()
   (loop for u in *accounts* do
     (let ((username (account-username u)))
-      (format t "Username: ~a~%" username)
       (cond ((and (not (locked? username))
                   (inactive-from-never-logged-in? username))
              (post-notification 
@@ -2442,10 +2475,10 @@ with [[setf]]. %% TODO
 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
+{\em sequence}''.  More important is to understand that we really must
-must {\tt setf} the return, otherwise we might find the deletion did
+{\tt setf} the return, otherwise we might find the deletion did not
-not take effect---for example, when deleting the first element of a
+take effect---for example, when deleting the first element of a list.
-list.  (This deserves a better explanation, but if you know how linked
+(XXX: 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.)
 
@@ -2469,7 +2502,9 @@ 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
 \Lp\ epoch, which is January 1st 2024, the exact month in which
 \Lp\ was written.  But notice that this migration is done only once.
-New system administrators of \Lp\ will never need to run this.
+New system administrators of \Lp\ will never need to run this.  (We do
+not remove this set of source code chunks because they serve as an
+example of how to a migration like that.)
 
 <<How to migrate accounts without a creation date>>=
 (defun loop-epoch ()
@@ -2916,6 +2951,7 @@ something to think about.
 @ %def
 
 <<Global variables>>=
+(defparameter *debug* nil)
 <<Representation of accounts>>
 <<Representation of a client>>
 <<Representation of requests and responses>>
@@ -2923,7 +2959,7 @@ something to think about.
 <<Representation of commands>>
 <<Representation of articles>>
 <<Definition of maximum allowed inactive periods>>
-(defvar *debug* nil)
+<<Global variable that decides whether to enable the NNTP REPL>>
 @ 
 
 On which packages do we depend?
@@ -2942,7 +2978,7 @@ The \lp\ system definition:
   :description "<<Description>>"
   :depends-on (<<List of packages to be loaded>>)
   :components ((:file "loop")))
-@ %def :loop loop.asd
+@
 
 \section*{Index of chunks}
 \nowebchunks

make-release

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