diff --git a/loop.nw b/loop.nw index 35f9132..1af2908 100644 --- a/loop.nw +++ b/loop.nw @@ -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 <
>= ^[^\\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.) <>= (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. <>= (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. <>= -(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. <>= (defun remove-account! (username)