Fixes post-notification.

loop.lisp

@@ -917,7 +917,7 @@
                   :request r)))
 
 (defun overview-fmt-lines ()
-  '("Subject:" 
+  '("Subject:"
     "From:"
     "Date:"
     "Message-ID:"
@@ -1245,6 +1245,22 @@
       (setq mid (cons (char universe (random len state)) mid)))
     (coerce mid 'string)))
 
+(defun post-from-path (tmp-path)
+  (let* ((headers-raw (read-headers-raw tmp-path))
+         (headers-str (bytes->string headers-raw))
+         (hds (parse-headers headers-str))
+         (mid (get-header "message-id" hds))
+         (ngs (newsgroups-header->list (get-header "newsgroups" hds))))
+    (stderr "finished reading the headers of the tmp file~%")
+    (stderr "headers string: ~a~%" headers-str)
+    (conforms-headers? headers-str) ;; raises a condition if it doesn't go well
+    (let* ((hash (store-article-in-index! tmp-path mid)))
+      (stderr "stored ~a from ~a~%" hash mid)
+      (dolist (ng ngs)
+        (let ((new-id (link-article-into-group-insist! hash ng (get-next-article-id ng))))
+          (update-group-meta-incremental! ng new-id)))
+      (stderr "linking finished~%"))))
+
 (defun cmd-post (r)
   (with-auth
       (send-response!
@@ -1256,22 +1272,9 @@
                (progn
                  (nntp-read-article-to-disk tmp)
                  (stderr "finished writing article to disk in ~a~%" tmp)
-                 (let* ((headers-raw (read-headers-raw tmp))
+                 (post-from-path tmp)
-                        (headers-str (bytes->string headers-raw))
+                 (update-last-post-date! (client-username *client*))
-                        (hds (parse-headers headers-str))
+                 (make-response :code 240 :request r :data "Thank you! Your article has been saved."))
-                        (mid (get-header "message-id" hds))
-                        (ngs (newsgroups-header->list (get-header "newsgroups" hds))))
-                   (stderr "finished reading the headers of the tmp file~%")
-                   (stderr "headers string: ~a~%" headers-str)
-                   (conforms-headers? headers-str) ;; raises a condition if it doesn't go well
-                   (let* ((hash (store-article-in-index! tmp mid)))
-                     (stderr "stored ~a from ~a~%" hash mid)
-                     (dolist (ng ngs)
-                       (let ((new-id (link-article-into-group-insist! hash ng (get-next-article-id ng))))
-                         (update-group-meta-incremental! ng new-id)))
-                     (stderr "linking finished~%")
-                     (update-last-post-date! (client-username *client*))
-                     (make-response :code 240 :request r :data "Thank you! Your article has been saved."))))
              (article-syntax-error (c)
                (make-response
                          :code 441 :request r
@@ -1785,20 +1788,16 @@ we impose right now."
               (when (search q curr-line :test #'char-equal)
                 (setf matched-any t)
                 (setf unfound-queries (remove q unfound-queries :test #'string-equal))))
-            
             ;; Capture the very first matched context block
             (when (and matched-any (null snippet))
               (setf snippet (list prev-line curr-line next-line))))
-          
           ;; Early exit if all queries are found
           (when (null unfound-queries)
             (return-from scan-article-for-search snippet))
-          
           ;; Shift the 3-line sliding window
           (setf prev-line curr-line
                 curr-line next-line
                 next-line (read-line stream nil nil)))
-        
         ;; If EOF reached, ensure ALL queries were found before returning the snippet
         (if (null unfound-queries) snippet nil)))))
 
@@ -1841,8 +1840,7 @@ we impose right now."
                (write-byte 13 out) (write-byte 10 out)
                (write-sequence (map 'vector #'char-code body) out)
                (write-byte 13 out) (write-byte 10 out)))
-           (let ((headers-raw (read-headers-raw tmp)))
+           (post-from-path tmp))
-             (post tmp headers-raw)))
       (ignore-errors (delete-file tmp)))))
 
 (defun cli/options () 

loop.nw

@@ -16,23 +16,73 @@
 \AtBeginEnvironment{quote}{\small}
 \AtBeginEnvironment{verbatim}{\small}
 
+\usepackage{amsmath,amsthm,amssymb}
+\allowdisplaybreaks
+\usepackage{lmodern}
+\usepackage{noweb}
 %% \usepackage[backend=biber]{biblatex}
 %% \addbibresource{refs.bib}
 %% \renewcommand{\cite}{\parencite}
 % \usepackage[hyperref]{xcolor}
 \usepackage[colorlinks=true,citecolor=]{hyperref} % linkcolor=red
 
-\usepackage{amsmath,amsthm,amssymb}
+\makeatletter
-\allowdisplaybreaks
+\let\old@hyperlink\hyperlink
-\usepackage{lmodern}
+\protected\def\hyperlink#1#2{%
-\usepackage{noweb}
+  \def\nw@target{#1}%
-\noweboptions{longchunks,smallcode}
+  \def\nw@badtarget{noweb.}%
-\DeclareMathOperator{\mdc}{mdc}
+  \ifx\nw@target\nw@badtarget
-\DeclareMathOperator{\gcdext}{gcdext}
+    #2% Output plain text if target is empty "noweb."
-\DeclareMathOperator{\remainder}{remainder}
+  \else
-\DeclareMathOperator{\quotient}{quotient}
+    \old@hyperlink{#1}{#2}% Otherwise create normal hyperlink
-\DeclareMathOperator{\diff}{diff}
+  \fi
+}
+\makeatother
 
+%% The root cause is a flaw in how noweb interacts with hyperref when
+%% generating cross-reference footers for code chunks that span page
+%% ranges or multiple definitions.
+%% 
+%%     Empty Anchor Lookup: When noweave outputs chunk footers (such
+%%     as "used in chunks 28–30" via \nwused), noweb attempts to look
+%%     up a unique target ID for the target chunk. Because
+%%     range-spanning chunks lack a single discrete anchor target, the
+%%     lookup returns an empty string ("").
+%% 
+%%     Naïve Target Concatenation: noweb constructs the link target by
+%%     appending the target ID directly to its default prefix
+%%     ("noweb." + ""), resulting in the literal string noweb..
+%% 
+%%     Hyperref Target Failure: noweb passes
+%%     \hyperlink{noweb.}{28--30} to hyperref. Because no destination
+%%     named noweb. was ever registered in the document, hyperref
+%%     flags it as a missing target.
+%% 
+%%     Lack of Sanitization in noweb.sty: Unlike modern LaTeX
+%%     packages, legacy noweb.sty does not check whether a tag ID is
+%%     empty before wrapping the display text in a \hyperlink.
+%% 
+%% Intercepting \hyperlink in your preamble fixes this at the root by
+%% catching any target evaluating strictly to noweb. and stripping the
+%% hyperlink wrapper, letting the plain text (28--30) render cleanly
+%% without triggering hyperref.
+
+\makeatletter
+\let\old@hyper@link\hyper@link
+\def\hyper@link#1#2#3{%
+  \def\testtarget{#2}%
+  \def\badtarget{noweb.}%
+  \ifx\testtarget\badtarget
+    \typeout{^^J==================================================}%
+    \typeout{ROOT CAUSE FOUND AT TEX LINE: \the\inputlineno}%
+    \typeout{Link Type: #1 | Target: '#2' | Text: '#3'}%
+    \typeout{==================================================^^J}%
+  \fi
+  \old@hyper@link{#1}{#2}{#3}%
+}
+\makeatother
+
+\noweboptions{longchunks,smallcode}
 \def\nwendcode{\endtrivlist \endgroup}
 \let\nwdocspar=\par
 
@@ -65,6 +115,7 @@
   {a circle out of fashion}}
 \date{January 2024}
 \begin{document}
+%\hypertarget{noweb.}{} % fixes the bug
 \pdfbookmark[1]{Introduction}{intro}
 \fontfamily{cmr}\selectfont
 \maketitle
@@ -2263,7 +2314,7 @@ So, we're always in reader mode, so we just ignore this command.
 <<Command mode reader.lisp>>=
 (defun cmd-mode (r) ;; Whatever.
   (make-response :code 200 :request r :data "Sure thing."))
-@ %def
+@
 
 \subsection{{\tt DATE}}\label{sec:date}
 
@@ -2299,7 +2350,7 @@ says {\tt QUIT}, [[main-loop]] must terminate.
 <<Command quit.lisp>>=
 (defun cmd-quit (r)
   (make-response :code 205 :data "Good-bye." :request r))
-@ %def
+@
 
 \subsection{{\tt DD}}\label{sec:dd}
 
@@ -2310,7 +2361,7 @@ state of how the server sees it.
 <<Command dd.lisp>>=
 (defun cmd-dd (r) 
   (make-response :code 200 :data (fmt "state: ~a" *client*) :request r))
-@ %def
+@
 
 \subsection{{\tt POST}}\label{sec:post}
 
@@ -2354,6 +2405,22 @@ the matter and find a solution.  Let's let people mess it up instead
 of trying to stop them.
 
 <<Command post.lisp>>=
+(defun post-from-path (tmp-path)
+  (let* ((headers-raw (read-headers-raw tmp-path))
+         (headers-str (bytes->string headers-raw))
+         (hds (parse-headers headers-str))
+         (mid (get-header "message-id" hds))
+         (ngs (newsgroups-header->list (get-header "newsgroups" hds))))
+    (stderr "finished reading the headers of the tmp file~%")
+    (stderr "headers string: ~a~%" headers-str)
+    (conforms-headers? headers-str) ;; raises a condition if it doesn't go well
+    (let* ((hash (store-article-in-index! tmp-path mid)))
+      (stderr "stored ~a from ~a~%" hash mid)
+      (dolist (ng ngs)
+        (let ((new-id (link-article-into-group-insist! hash ng (get-next-article-id ng))))
+          (update-group-meta-incremental! ng new-id)))
+      (stderr "linking finished~%"))))
+
 (defun cmd-post (r)
   (with-auth
       (send-response!
@@ -2365,22 +2432,9 @@ of trying to stop them.
                (progn
                  (nntp-read-article-to-disk tmp)
                  (stderr "finished writing article to disk in ~a~%" tmp)
-                 (let* ((headers-raw (read-headers-raw tmp))
+                 (post-from-path tmp)
-                        (headers-str (bytes->string headers-raw))
+                 (update-last-post-date! (client-username *client*))
-                        (hds (parse-headers headers-str))
+                 (make-response :code 240 :request r :data "Thank you! Your article has been saved."))
-                        (mid (get-header "message-id" hds))
-                        (ngs (newsgroups-header->list (get-header "newsgroups" hds))))
-                   (stderr "finished reading the headers of the tmp file~%")
-                   (stderr "headers string: ~a~%" headers-str)
-                   (conforms-headers? headers-str) ;; raises a condition if it doesn't go well
-                   (let* ((hash (store-article-in-index! tmp mid)))
-                     (stderr "stored ~a from ~a~%" hash mid)
-                     (dolist (ng ngs)
-                       (let ((new-id (link-article-into-group-insist! hash ng (get-next-article-id ng))))
-                         (update-group-meta-incremental! ng new-id)))
-                     (stderr "linking finished~%")
-                     (update-last-post-date! (client-username *client*))
-                     (make-response :code 240 :request r :data "Thank you! Your article has been saved."))))
              (article-syntax-error (c)
                (make-response
                          :code 441 :request r
@@ -2393,7 +2447,7 @@ of trying to stop them.
 <<Command post.lisp>>=
 (defun newsgroups-header->list (s)
   (mapcar #'(lambda (n) (str:trim (string-downcase n))) (str:split "," s)))
-@ %def post
+@
 
 <<Command post.lisp>>=
 (defun update-last-post-date! (username)
@@ -2972,20 +3026,16 @@ we impose right now."
               (when (search q curr-line :test #'char-equal)
                 (setf matched-any t)
                 (setf unfound-queries (remove q unfound-queries :test #'string-equal))))
-            
             ;; Capture the very first matched context block
             (when (and matched-any (null snippet))
               (setf snippet (list prev-line curr-line next-line))))
-          
           ;; Early exit if all queries are found
           (when (null unfound-queries)
             (return-from scan-article-for-search snippet))
-          
           ;; Shift the 3-line sliding window
           (setf prev-line curr-line
                 curr-line next-line
                 next-line (read-line stream nil nil)))
-        
         ;; If EOF reached, ensure ALL queries were found before returning the snippet
         (if (null unfound-queries) snippet nil)))))
 @
@@ -3036,8 +3086,7 @@ invitations {\em et cetera} are published there.
                (write-byte 13 out) (write-byte 10 out)
                (write-sequence (map 'vector #'char-code body) out)
                (write-byte 13 out) (write-byte 10 out)))
-           (let ((headers-raw (read-headers-raw tmp)))
+           (post-from-path tmp))
-             (post tmp headers-raw)))
       (ignore-errors (delete-file tmp)))))
 @ %def notify-group-created notify-user-created
 
@@ -3707,7 +3756,7 @@ Newsgroups: local.test, bad.newsgroup
 
 A bad test from the biggest mouth of the south.
 "))
-@ %def
+@
 \end{crossedblock}
 
 \section{How to produce the binary executable}
@@ -3841,7 +3890,7 @@ something to think about.
 <<Command-line parsing.lisp>>
 <<Main loop.lisp>>
 <<Test procedures.lisp>>
-@ %def
+@
 
 <<Global variables.lisp>>=
 (defparameter *debug* t)

version.lisp

@@ -1,2 +1,2 @@
 (in-package :loop)
-(defparameter *git-hash* "b345a8d")
+(defparameter *git-hash* "da757c7")