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

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
+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>>=
 ^[^\\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
+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>>=
 (defun post (bs)
   (let ((ngs (newsgroups-header->list 
               (get-header "newsgroups" (parse-headers
-                                        (article-headers
+                                         (article-headers
-                                         (parse-article bs))))))
+                                          (parse-article bs)))))))
-        (ngs-dont-exist))
+    (dolist (ng ngs)
-    (dolist (g ngs)
+      (let ((a (ensure-date (ensure-mid bs))))
-      (if (or (not (group-name-conforms? g))
+        (save-article-insist ng (get-next-article-id ng) a (extract-mid a))
-              (not (group? g)))
+        (update-last-post-date! (client-username *client*))))
-          (push g ngs-dont-exist)))
+    (values 240 (data "Thank you! Your article has been saved."))))
-    (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.")))))
 
 (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
+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>>=
 (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]]
+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>>=
-(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
+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
 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}}
 
 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)