root/loop
1
0
Fork 0
Code Issues Pull requests Activity

Rewrites conforms? and post. All checks are done in conforms? now.

Browse source
This commit is contained in:
Circling Skies 2026-06-11 01:30:06 -03:00
parent efa5ee3ccd
commit 94d2e78447
1 changed files with 75 additions and 81 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

156
loop.nw
View file

@ -1,7 +1,4 @@
% -*- mode: poly-noweb; -*-
% HELLO
%% %% % -*- mode: noweb; -*-
%% %% %% noweb-default-code-mode: lisp-mode;
\documentclass[a4paper,11pt]{article}
\usepackage[text={6.75in,10in},centering]{geometry}
@ -765,7 +762,8 @@ running a program [[./list-accounts]].
(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))))))
@ %def cli/change-passwd cli/list-accounts cli/create-account
@ -1806,13 +1804,8 @@ 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: we need
to rewrite this because we have that plan of verifying everything
there is to verify up front in [[conforms?]]. So when we invoke
[[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
Now it's time to look at the header \verb|newsgroups|. The name of
each group must conform to the expression
<<Form of newsgroup names>>=
^[^\\s/]+$
@ -1850,55 +1843,43 @@ of trying to stop them.
It's time to write the action of posting. One thing to keep in mind
is cross-posting. First, notice that we're---so far---duplicating
articles on the file system. (We will undo that once we reimplement
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 publish news
to be received at the same time by various groups. We would make such
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 the article.
our index. More to follow.)
<<Command post.lisp>>=
(defun post (bs)
(let ((ngs (newsgroups-header->list
(get-header "newsgroups" (parse-headers
(article-headers
(parse-article bs))))))
(ngs-dont-exist))
(dolist (g ngs)
(if (or (not (group-name-conforms? g))
(not (group? g)))
(push g ngs-dont-exist)))
(if (zerop (length ngs-dont-exist))
(progn
(dolist (ng ngs)
(let ((a (ensure-date (ensure-mid bs))))
(save-article-insist ng (get-next-article-id ng) a (extract-mid a))
(update-last-post-date! (client-username *client*))))
(values 240 (data "Thank you! Your article has been saved.")))
(values 400 (data "Sorry. We did not post your article to any newsgroup because "
"the " (word-plural (length ngs-dont-exist) "newsgroup") " "
(str:join ", " (sort ngs-dont-exist #'string<))
" just " (word-plural (length ngs-dont-exist) "doesn't") " exist.")))))
(article-headers
(parse-article bs)))))))
(dolist (ng ngs)
(let ((a (ensure-date (ensure-mid bs))))
(save-article-insist ng (get-next-article-id ng) a (extract-mid a))
(update-last-post-date! (client-username *client*))))
(values 240 (data "Thank you! Your article has been saved."))))
(defun newsgroups-header->list (s)
(mapcar #'(lambda (n) (str:trim (string-downcase n))) (str:split "," s)))
@ %def post
XXX: notice we parse the article again to extract information from it
that we need during [[post]]. That's not only a waste of
time---because we already did that---, but it makes [[post]] a lot
less generic. Perhaps [[conforms?]] should return a data structure
that contains all that [[post]] needs. Then [[post]] consumes that
and saves the article more easily. That's a better idea. I think
[[post]] should not even use variables such as [[*client*]]. The
username to which to update the last-seen date should be included in
the data structure.
Notice we parse the article again to extract information from it that
we need during [[post]]. That's not only a waste of time---because we
already did that---, but it makes [[post]] a lot less generic.
Perhaps [[conforms?]] should return a data structure that contains all
that [[post]] needs. Then [[post]] consumes that and saves the
article more easily. That's a better idea. I think [[post]] should
not even use variables such as [[*client*]]. The username to which to
update the last-seen date should be included in the data structure.
However, it's nice to ask for everything and much harder to do it.
Our design so far is that [[conforms?]] return [[T]] when the article
conforms and our writing method is to simply write the sequence of
bytes that the article is. Here's what we should do, without a whole
lot of thinking---make [[post]] consume the sequence of bytes it
consumes today but also make it consume a structure that describes the
entire parsed article. (Keep [[conforms?]] as it is.) This avoids
[[post]] to have to figure out to which groups to post. Regarding the
use of [[update-last-post-date!]], which reads [[*client*]], that's
irrelevant: some procedure must read [[*client*]]; if it's [[post]]
itself or some higher-level other, some procedure must do it.
<<Command post.lisp>>=
(defun update-last-post-date! (username)
@ -2033,17 +2014,32 @@ network of servers---so we're leaving that out for now. The header
\verb|message-id| is added by \Lp\ if the client doesn't write it
itself.
Let's criticize the writing of [[conforms?]]. We have a [[catch]]
here and a [[throw]] in [[parse-headers]]. We also have a [[return]]
here. It's getting hard to read this procedure because it's not easy
to know that a procedure has to return a certain value to match the
expectation of another procedure. I don't remember what [[catch]]
does. I need to review this and then add the explanation for myself.
If I don't remember how this works, other beginners won't know it
either. %% TODO
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 publish news to be received at the same time by various
groups; we would make such plans all go down the drain. So 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 the article is susceptible to be saved by [[post]].
So the message here is that if an article is vetted by [[conforms?]],
then it can be saved. Any problem with the article must be reported
by [[conforms?]].
XXX: heads up. We have a [[catch]] here and a [[throw]] in
[[parse-headers]]. We also have a [[return]] here. It's getting hard
to read this procedure because it's not easy to know that a procedure
has to return a certain value to match the expectation of another
procedure. I don't remember what [[catch]] does. I need to review
this and then add the explanation for myself. If I don't remember how
this works, other beginners won't know it either. It's unclear right
now what the wise measure is, so we'll keep on moving.
<<Does an article conform?.lisp>>=
(defun conforms? (bs)
(defun confor ms? (bs)
(catch 'article-syntax-error ;; parse-headers might throw
(let ((headers (parse-headers (article-headers (parse-article bs)))))
(let ((result (dolist (h (headers-required-from-clients))
@ -2054,7 +2050,19 @@ either. %% TODO
((stringp result) (values nil result))
((not (text/plain? content-type))
(values nil (format nil "content-type must be plain/text, but it's ~a" content-type)))
(t (values t nil)))))))
(t
(let ((ngs (newsgroups-header->list (get-header "newsgroups" headers)))
(ngs-dont-exist nil))
(dolist (g ngs)
(when (or (not (group-name-conforms? g))
(not (group? g)))
(push g ngs-dont-exist)))
(if (not (zerop (length ngs-dont-exist)))
(values nil (format nil "the ~a ~a just ~a exist"
(word-plural (length ngs-dont-exist) "newsgroup")
(str:join ", " (sort ngs-dont-exist #'string<))
(word-plural (length ngs-dont-exist) "doesn't")))
(values t nil)))))))))
(defun text/plain? (header-s)
;; I say T when S begins with "text/plain" or when S is "".
@ -2069,31 +2077,15 @@ either. %% TODO
'("from" "newsgroups" "subject"))
@ %def conforms?
Notice that up to this point we've only verified if the necessary
headers are present. The \verb|newsgroups| header is a direct
influence to the article storage. For instance, \verb|newsgroups|
must mention only groups that exist. When we save the article, we
check each group. If at least one group exists, we save the article;
if at least one group doesn't exist, we report to the user all groups
that don't exist, but we do save the article if at least one does
exist. That's probably not the best thing to do. We should probably
warn the user that one group doesn't exist because that could make all
the difference to the user. For instance, someone might decide not to
post at all if they can't cross post to all the groups they wish to.
One typo in one group name and the article would be posted to some
groups, but not to the misstyped one. We need to change this. %% TODO
Also, do notice that to simplify matters we're duplicating articles
Notice that to simplify matters we're duplicating articles
cross-posted. What we should do is write the article to the first
group in the list of \verb|newsgroups| and then make a symbolic link
to all others. The problem is that I don't know how to do that on
Windows. I'm not sure if Windows supports symbolic links at all. We
could perhaps duplicate articles only when on Windows. %% TODO
to all others.
\subsection{{\tt CREATE-GROUP}}
We allow every user to create their own groups. (Are we crazy?) When
someone craetes a group, we post an article to {\tt
someone creates a group, we post an article to {\tt
local.control.news} notifying everyone that a new group has been
created. People then have a chance to subscribe to the new group. We
assume that when someone creates a group, it's either no problem at
@ -2489,9 +2481,11 @@ the entire list of accounts. Also, notice that delete ``may modify
{\em sequence}''. More important is to understand that 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.
(XXX: 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.)
it works. Months later I can't remember what the issue really is,
though I remember what it is. Let's write a better explanation here as
soon as we have enough energy to trace all the problem.
<<How to remove inactive users.lisp>>=
(defun remove-account! (username)