From 56766dcd9b1ec61dea2b58cd4b80a6c36b88f0ab Mon Sep 17 00:00:00 2001 From: Circling Skies Date: Thu, 3 Sep 2026 11:37:52 -0300 Subject: [PATCH] Fixes post-notification. --- loop.lisp | 44 +++++++++--------- loop.nw | 125 +++++++++++++++++++++++++++++++++++---------------- version.lisp | 2 +- 3 files changed, 109 insertions(+), 62 deletions(-) diff --git a/loop.lisp b/loop.lisp index f45f92a..5f502cb 100644 --- a/loop.lisp +++ b/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)) - (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 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.")))) + (post-from-path tmp) + (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 tmp headers-raw))) + (post-from-path tmp)) (ignore-errors (delete-file tmp))))) (defun cli/options () diff --git a/loop.nw b/loop.nw index 9b4674c..b4c50c2 100644 --- a/loop.nw +++ b/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} -\allowdisplaybreaks -\usepackage{lmodern} -\usepackage{noweb} -\noweboptions{longchunks,smallcode} -\DeclareMathOperator{\mdc}{mdc} -\DeclareMathOperator{\gcdext}{gcdext} -\DeclareMathOperator{\remainder}{remainder} -\DeclareMathOperator{\quotient}{quotient} -\DeclareMathOperator{\diff}{diff} +\makeatletter +\let\old@hyperlink\hyperlink +\protected\def\hyperlink#1#2{% + \def\nw@target{#1}% + \def\nw@badtarget{noweb.}% + \ifx\nw@target\nw@badtarget + #2% Output plain text if target is empty "noweb." + \else + \old@hyperlink{#1}{#2}% Otherwise create normal hyperlink + \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. <>= (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. <>= (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. <>= (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. <>= +(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)) - (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 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.")))) + (post-from-path tmp) + (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. <>= (defun newsgroups-header->list (s) (mapcar #'(lambda (n) (str:trim (string-downcase n))) (str:split "," s))) -@ %def post +@ <>= (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 tmp headers-raw))) + (post-from-path tmp)) (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. <> <
> <> -@ %def +@ <>= (defparameter *debug* t) diff --git a/version.lisp b/version.lisp index 2ba4c1e..196cae0 100644 --- a/version.lisp +++ b/version.lisp @@ -1,2 +1,2 @@ (in-package :loop) -(defparameter *git-hash* "b345a8d") +(defparameter *git-hash* "da757c7")