Rewrites conforms? and post. All checks are done in conforms? now.
This commit is contained in:
parent
efa5ee3ccd
commit
94d2e78447
1 changed files with 75 additions and 81 deletions
146
loop.nw
146
loop.nw
|
|
@ -1,7 +1,4 @@
|
||||||
% -*- mode: poly-noweb; -*-
|
% -*- mode: poly-noweb; -*-
|
||||||
% HELLO
|
|
||||||
%% %% % -*- mode: noweb; -*-
|
|
||||||
%% %% %% noweb-default-code-mode: lisp-mode;
|
|
||||||
\documentclass[a4paper,11pt]{article}
|
\documentclass[a4paper,11pt]{article}
|
||||||
\usepackage[text={6.75in,10in},centering]{geometry}
|
\usepackage[text={6.75in,10in},centering]{geometry}
|
||||||
|
|
||||||
|
|
@ -765,7 +762,8 @@ running a program [[./list-accounts]].
|
||||||
(new-passwd (or given-passwd random-passwd)))
|
(new-passwd (or given-passwd random-passwd)))
|
||||||
(if (not (get-account username))
|
(if (not (get-account username))
|
||||||
(println "No such account ``~a''." 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 "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 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))
|
(ensure-header "date" #'get-date bs))
|
||||||
@ %def ensure-mid ensure-date
|
@ %def ensure-mid ensure-date
|
||||||
|
|
||||||
Now it's time to look at the header \verb|newsgroups|. XXX: we need
|
Now it's time to look at the header \verb|newsgroups|. The name of
|
||||||
to rewrite this because we have that plan of verifying everything
|
each group must conform to the expression
|
||||||
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
|
|
||||||
|
|
||||||
<<Form of newsgroup names>>=
|
<<Form of newsgroup names>>=
|
||||||
^[^\\s/]+$
|
^[^\\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
|
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
|
is cross-posting. First, notice that we're---so far---duplicating
|
||||||
articles on the file system. (We will undo that once we reimplement
|
articles on the file system. (We will undo that once we reimplement
|
||||||
our index. More to follow.) More importantly, we cannot let the user
|
our index. More to follow.)
|
||||||
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.
|
|
||||||
|
|
||||||
<<Command post.lisp>>=
|
<<Command post.lisp>>=
|
||||||
(defun post (bs)
|
(defun post (bs)
|
||||||
(let ((ngs (newsgroups-header->list
|
(let ((ngs (newsgroups-header->list
|
||||||
(get-header "newsgroups" (parse-headers
|
(get-header "newsgroups" (parse-headers
|
||||||
(article-headers
|
(article-headers
|
||||||
(parse-article bs))))))
|
(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)
|
(dolist (ng ngs)
|
||||||
(let ((a (ensure-date (ensure-mid bs))))
|
(let ((a (ensure-date (ensure-mid bs))))
|
||||||
(save-article-insist ng (get-next-article-id ng) a (extract-mid a))
|
(save-article-insist ng (get-next-article-id ng) a (extract-mid a))
|
||||||
(update-last-post-date! (client-username *client*))))
|
(update-last-post-date! (client-username *client*))))
|
||||||
(values 240 (data "Thank you! Your article has been saved.")))
|
(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.")))))
|
|
||||||
|
|
||||||
(defun newsgroups-header->list (s)
|
(defun newsgroups-header->list (s)
|
||||||
(mapcar #'(lambda (n) (str:trim (string-downcase n))) (str:split "," s)))
|
(mapcar #'(lambda (n) (str:trim (string-downcase n))) (str:split "," s)))
|
||||||
@ %def post
|
@ %def post
|
||||||
|
|
||||||
XXX: notice we parse the article again to extract information from it
|
Notice we parse the article again to extract information from it that
|
||||||
that we need during [[post]]. That's not only a waste of
|
we need during [[post]]. That's not only a waste of time---because we
|
||||||
time---because we already did that---, but it makes [[post]] a lot
|
already did that---, but it makes [[post]] a lot less generic.
|
||||||
less generic. Perhaps [[conforms?]] should return a data structure
|
Perhaps [[conforms?]] should return a data structure that contains all
|
||||||
that contains all that [[post]] needs. Then [[post]] consumes that
|
that [[post]] needs. Then [[post]] consumes that and saves the
|
||||||
and saves the article more easily. That's a better idea. I think
|
article more easily. That's a better idea. I think [[post]] should
|
||||||
[[post]] should not even use variables such as [[*client*]]. The
|
not even use variables such as [[*client*]]. The username to which to
|
||||||
username to which to update the last-seen date should be included in
|
update the last-seen date should be included in the data structure.
|
||||||
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>>=
|
<<Command post.lisp>>=
|
||||||
(defun update-last-post-date! (username)
|
(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
|
\verb|message-id| is added by \Lp\ if the client doesn't write it
|
||||||
itself.
|
itself.
|
||||||
|
|
||||||
Let's criticize the writing of [[conforms?]]. We have a [[catch]]
|
We cannot let the user post to any group if one of the groups is
|
||||||
here and a [[throw]] in [[parse-headers]]. We also have a [[return]]
|
incorrectly named---for example, when the group doesn't exist. Why
|
||||||
here. It's getting hard to read this procedure because it's not easy
|
don't we post to the ones that are correct and warn the user of the
|
||||||
to know that a procedure has to return a certain value to match the
|
ones that are incorrect? Because that is not prudent. The user could
|
||||||
expectation of another procedure. I don't remember what [[catch]]
|
be trying to publish news to be received at the same time by various
|
||||||
does. I need to review this and then add the explanation for myself.
|
groups; we would make such plans all go down the drain. So we collect
|
||||||
If I don't remember how this works, other beginners won't know it
|
a list of newsgroups that don't exist (or whose names do not conform
|
||||||
either. %% TODO
|
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>>=
|
<<Does an article conform?.lisp>>=
|
||||||
(defun conforms? (bs)
|
(defun confor ms? (bs)
|
||||||
(catch 'article-syntax-error ;; parse-headers might throw
|
(catch 'article-syntax-error ;; parse-headers might throw
|
||||||
(let ((headers (parse-headers (article-headers (parse-article bs)))))
|
(let ((headers (parse-headers (article-headers (parse-article bs)))))
|
||||||
(let ((result (dolist (h (headers-required-from-clients))
|
(let ((result (dolist (h (headers-required-from-clients))
|
||||||
|
|
@ -2054,7 +2050,19 @@ either. %% TODO
|
||||||
((stringp result) (values nil result))
|
((stringp result) (values nil result))
|
||||||
((not (text/plain? content-type))
|
((not (text/plain? content-type))
|
||||||
(values nil (format nil "content-type must be plain/text, but it's ~a" 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)
|
(defun text/plain? (header-s)
|
||||||
;; I say T when S begins with "text/plain" or when S is "".
|
;; I say T when S begins with "text/plain" or when S is "".
|
||||||
|
|
@ -2069,31 +2077,15 @@ either. %% TODO
|
||||||
'("from" "newsgroups" "subject"))
|
'("from" "newsgroups" "subject"))
|
||||||
@ %def conforms?
|
@ %def conforms?
|
||||||
|
|
||||||
Notice that up to this point we've only verified if the necessary
|
Notice that to simplify matters we're duplicating articles
|
||||||
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
|
|
||||||
cross-posted. What we should do is write the article to the first
|
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
|
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
|
to all others.
|
||||||
Windows. I'm not sure if Windows supports symbolic links at all. We
|
|
||||||
could perhaps duplicate articles only when on Windows. %% TODO
|
|
||||||
|
|
||||||
\subsection{{\tt CREATE-GROUP}}
|
\subsection{{\tt CREATE-GROUP}}
|
||||||
|
|
||||||
We allow every user to create their own groups. (Are we crazy?) When
|
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
|
local.control.news} notifying everyone that a new group has been
|
||||||
created. People then have a chance to subscribe to the new group. We
|
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
|
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
|
{\em sequence}''. More important is to understand that we really must
|
||||||
{\tt setf} the return, otherwise we might find the deletion did not
|
{\tt setf} the return, otherwise we might find the deletion did not
|
||||||
take effect---for example, when deleting the first element of a list.
|
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
|
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>>=
|
<<How to remove inactive users.lisp>>=
|
||||||
(defun remove-account! (username)
|
(defun remove-account! (username)
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue