From 33b3a7da01eaa2e3ac6301d802b7c0b0dd8e894c Mon Sep 17 00:00:00 2001 From: Circling Skies Date: Tue, 18 Aug 2026 15:53:10 -0300 Subject: [PATCH] Rebuilds and verifies the index. --- Anyfile | 14 +++ groups/local.control.news/1 | 2 +- loop.lisp | 19 ++-- loop.nw | 154 ++++++++++++++++++++++++++++++- scripts/build-index-from-fs.lisp | 54 ++++++++++- scripts/find-duplicates.lisp | 37 ++++++++ scripts/verify-index.lisp | 37 ++++++++ version.lisp | 2 +- 8 files changed, 299 insertions(+), 20 deletions(-) create mode 100644 scripts/find-duplicates.lisp create mode 100644 scripts/verify-index.lisp diff --git a/Anyfile b/Anyfile index c5b227b..6acca13 100644 --- a/Anyfile +++ b/Anyfile @@ -7,6 +7,8 @@ all: loop.exe loop.lisp loop.asd scripts/build-exe.lisp \ scripts/build-index-from-fs.lisp \ scripts/cron-remove-inactive-users.lisp \ scripts/migrate-add-creation-date.lisp \ +scripts/verify-index.lisp \ +scripts/find-duplicates.lisp \ version.lisp TAGS version.lisp: loop.lisp @@ -47,6 +49,18 @@ scripts/build-index-from-fs.lisp: loop.nw (rm build-index-from-fs.tmp && exit 1)) && \ mv build-index-from-fs.tmp scripts/build-index-from-fs.lisp +scripts/verify-index.lisp: loop.nw + (no tangle -Rverify-index.lisp < loop.nw > \ + verify-index.tmp || \ + (rm verify-index.tmp && exit 1)) && \ + mv verify-index.tmp scripts/verify-index.lisp + +scripts/find-duplicates.lisp: loop.nw + (no tangle -Rfind-duplicates.lisp < loop.nw > \ + find-duplicates.tmp || \ + (rm find-duplicates.tmp && exit 1)) && \ + mv find-duplicates.tmp scripts/find-duplicates.lisp + scripts/cron-remove-inactive-users.lisp: loop.nw (no tangle -Rcron-remove-inactive-users.lisp < loop.nw > \ cron-remove-inactive-users.tmp || \ diff --git a/groups/local.control.news/1 b/groups/local.control.news/1 index adc869e..943c249 100644 --- a/groups/local.control.news/1 +++ b/groups/local.control.news/1 @@ -1,5 +1,5 @@ Date: 2024-03-07 21:44:31 GMT-3 -Message-Id: +Message-Id: From: Loop Subject: let there be light Newsgroups: local.control.news diff --git a/loop.lisp b/loop.lisp index a6226bd..ccb3043 100644 --- a/loop.lisp +++ b/loop.lisp @@ -165,6 +165,12 @@ (make-response :code 400 :data "You must authenticate first.") (progn ,@body))) +(defun get-file-inode (path) + "Returns the inode number for PATH or NIL if the file doesn't exist." + (handler-case + (sb-posix:stat-ino (sb-posix:stat (uiop:native-namestring path))) + (sb-posix:syscall-error () nil))) + (defun conforms-to? (s re &optional error-msg) "Does string S conform to regular expression RE?" (let ((okay? (cl-ppcre:scan-to-strings re s))) @@ -364,19 +370,6 @@ (setf (account-last-post u) (account-seen u)))) (write-accounts!)) -(defun index-from-fs! () - (loop for path in (in-groups (directory "**/*")) - do (let* ((g (str:trim (first (last (pathname-directory path))))) - (i (str:trim (pathname-name path))) - (m (str:trim (extract-mid (fetch-article g i))))) - (when (> (length m) 0) - (format t "article ~a/~a indexed by ~a~%" g i m) - (insert-index m g i))))) - -(defun remake-index-from-fs () - (drop-create-index!) - (index-from-fs!)) - (defun read-headers-raw (path) (with-open-file (in path :element-type '(unsigned-byte 8) :if-does-not-exist :error) (let ((acc (make-array 8192 diff --git a/loop.nw b/loop.nw index 087ee9a..e761cfb 100644 --- a/loop.nw +++ b/loop.nw @@ -2906,6 +2906,62 @@ What we now need is a procedure to intern a directory full of articles. We could have a series of articles somewhere and we would like to have them all recognized by \Lp. +<>= +(defun index-from-fs! () + (loop for path in (in-groups (directory "**/*")) + do (let* ((g (str:trim (first (last (pathname-directory path))))) + (i (str:trim (pathname-name path))) + (m (ignore-errors (str:trim (extract-mid (fetch-article g i)))))) + (when (and m (> (length m) 0)) + (let* ((hash (index-hash m)) + (idx-path (index-path hash))) + (ensure-index-directories! hash) + ;; If index file exists, verify if it shares our inode. If not, force-link it. + (cond + ((probe-file idx-path) + (unless (= (handler-case (sb-posix:stat-ino (sb-posix:stat (uiop:native-namestring path))) + (sb-posix:syscall-error () 0)) + (handler-case (sb-posix:stat-ino (sb-posix:stat (uiop:native-namestring idx-path))) + (sb-posix:syscall-error () -1))) + ;; Overwrite stale/mismatched index entry with the correct hard link + (ignore-errors (delete-file idx-path)) + (sb-posix:link (uiop:native-namestring path) idx-path) + (format t "article ~a/~a force-linked to index ~a~%" g i hash))) + (t + (handler-case + (progn + (sb-posix:link (uiop:native-namestring path) idx-path) + (format t "article ~a/~a indexed by ~a hash ~a~%" g i m hash)) + (sb-posix:syscall-error (c) + (if (= (sb-posix:syscall-errno c) sb-posix:eexist) + (format t "article ~a/~a already indexed concurrently.~%" g i) + (error c))))))))))) + +(defun index-from-fs!-old () + (loop for path in (in-groups (directory "**/*")) + do (let* ((g (str:trim (first (last (pathname-directory path))))) + (i (str:trim (pathname-name path))) + (m (ignore-errors (str:trim (extract-mid (fetch-article g i)))))) + (when (and m (> (length m) 0)) + (let* ((hash (index-hash m)) + (idx-path (index-path hash))) + (if (probe-file idx-path) ;; article exists in index: unify inodes by re-linking group file to index + (unless (= (get-file-inode path) (get-file-inode idx-path)) + (delete-file path) + (sb-posix:link (uiop:native-namestring idx-path) (uiop:native-namestring path)) + (format t "article ~a/~a relinked-to-existing-index ~a~%" g i hash)) + (progn + (ensure-index-directories! hash) + (handler-case + (progn + (sb-posix:link (uiop:native-namestring path) idx-path) + (format t "article ~a/~a mid ~a hashes-to ~a~%" g i m hash)) + (sb-posix:syscall-error (c) + (if (= (sb-posix:syscall-errno c) sb-posix:eexist) + (format t "article ~a/~a indexed due to a cross-post? EEXIST.~%" g i) + (error c))))))))))) +@ + \begin{crossedblock} When we build the index from scratch, it's important to have a procedure capable of reading all articles in the file system and index @@ -2914,7 +2970,7 @@ group, we get the name of the file relative to the article---that's the numeric ID of the article---and its {\tt message-id}. That's all we need to index it. -<>= +<>= (defun index-from-fs! () (loop for path in (in-groups (directory "**/*")) do (let* ((g (str:trim (first (last (pathname-directory path))))) @@ -2925,9 +2981,9 @@ we need to index it. (insert-index m g i))))) (defun remake-index-from-fs () - (drop-create-index!) (index-from-fs!)) @ +\end{crossedblock} Here's a program to build the index from a UNIX shell. @@ -2935,10 +2991,11 @@ Here's a program to build the index from a UNIX shell. <> (ql:quickload :loop :silent t) (in-package #:loop) +<> (index-from-fs!) -(format t "Index built.~%") @ +\begin{crossedblock} Be careful when using this program: it will build the database [[message-id.db]], which is an operation that needs to be done only once. Here's how to use it: @@ -2955,6 +3012,90 @@ Index built. \end{verbatim} \end{crossedblock} +\section{How to verify the index is properly done} + +<>= +(defun verify-index-inodes () + "Iterates over all group articles and prints whether they share an inode with index/." + (loop for path in (in-groups (directory "**/*")) + do (let* ((dir-list (pathname-directory path)) + (g (when dir-list (str:trim (first (last dir-list))))) + (i (pathname-name path)) + (i-str (when i (str:trim i)))) + ;; ignore metadata and directories + (when (and g i-str (parse-integer i-str :junk-allowed t)) + (let ((mid (ignore-errors (get-mid-from-path path)))) + (if (or (null mid) (zerop (length (str:trim mid)))) + (format t "no-mid ~a/~a couldn't find message-id~%" g i-str) + (let* ((hash (index-hash mid)) + (idx-path (index-path hash)) + (grp-inode (get-file-inode path)) + (idx-inode (get-file-inode idx-path))) + (cond + ((null idx-inode) + (stdout "no-index ~a/~a mid ~a hashes-to ~a~%" + g i-str mid idx-path)) + ((= grp-inode idx-inode) + (stdout "okay ~a/~a shares-inode ~a with ~a~%" + g i-str grp-inode idx-path)) + (t + (stdout "mismatch ~a/~a inode ~a =/= inode ~a hash ~a~%" + g i-str grp-inode idx-inode idx-path)))))))))) + +(defun verify-index () + (verify-index-inodes)) +@ + +<>= +<> +(ql:quickload :loop :silent t) +(in-package #:loop) +<> +(verify-index) +@ + +\section{Finding duplicates in the database} + +<>= +(defun find-duplicate-mids () + "Displays any duplicated message-ids across all group articles." + (let ((mid-map (make-hash-table :test 'equal)) + (found-dupes nil)) + ;; collect all articles and group by message-id + (loop for path in (in-groups (directory "**/*")) + do (let* ((dir-list (pathname-directory path)) + (g (when dir-list (str:trim (first (last dir-list))))) + (i (pathname-name path)) + (i-str (when i (str:trim i)))) + ;; process numeric article files only + (when (and g i-str (parse-integer i-str :junk-allowed t)) + (let ((mid (ignore-errors (get-mid-from-path path)))) + (when (and mid (> (length (str:trim mid)) 0)) + ;; push the (group . article-number) pair into the hash map + (push (cons g i-str) (gethash mid mid-map))))))) + ;; remove duplicates + (maphash (lambda (mid locations) + (when (> (length locations) 1) + (push (cons mid locations) found-dupes))) + mid-map) + ;; displays + (when found-dupes + (loop for (mid . locs) in found-dupes + do (format t "message-id: ~a~%" mid) + ;; sort by group + (let ((sorted-locs (sort locs #'string-lessp :key #'car))) + (loop for (g . i) in sorted-locs + do (format t "~a/~a~%" g i))))))) +@ + +<>= +<> +(ql:quickload :loop :silent t) +(in-package #:loop) +<> +(find-duplicate-mids) +@ + \section{Deletion and locking of inactive accounts}\label{sec:inactive-users} We now implement some of the \hyperref[principles]{principles} exposed @@ -3208,6 +3349,12 @@ any more. Of small importance, they have nothing. <>= +(defun get-file-inode (path) + "Returns the inode number for PATH or NIL if the file doesn't exist." + (handler-case + (sb-posix:stat-ino (sb-posix:stat (uiop:native-namestring path))) + (sb-posix:syscall-error () nil))) + (defun conforms-to? (s re &optional error-msg) "Does string S conform to regular expression RE?" (let ((okay? (cl-ppcre:scan-to-strings re s))) @@ -3424,7 +3571,6 @@ something to think about. <> <> <> -<> <> <> <> diff --git a/scripts/build-index-from-fs.lisp b/scripts/build-index-from-fs.lisp index ff24b3a..ed02e93 100644 --- a/scripts/build-index-from-fs.lisp +++ b/scripts/build-index-from-fs.lisp @@ -5,5 +5,57 @@ (load quicklisp-init))) (ql:quickload :loop :silent t) (in-package #:loop) +(defun index-from-fs! () + (loop for path in (in-groups (directory "**/*")) + do (let* ((g (str:trim (first (last (pathname-directory path))))) + (i (str:trim (pathname-name path))) + (m (ignore-errors (str:trim (extract-mid (fetch-article g i)))))) + (when (and m (> (length m) 0)) + (let* ((hash (index-hash m)) + (idx-path (index-path hash))) + (ensure-index-directories! hash) + ;; If index file exists, verify if it shares our inode. If not, force-link it. + (cond + ((probe-file idx-path) + (unless (= (handler-case (sb-posix:stat-ino (sb-posix:stat (uiop:native-namestring path))) + (sb-posix:syscall-error () 0)) + (handler-case (sb-posix:stat-ino (sb-posix:stat (uiop:native-namestring idx-path))) + (sb-posix:syscall-error () -1))) + ;; Overwrite stale/mismatched index entry with the correct hard link + (ignore-errors (delete-file idx-path)) + (sb-posix:link (uiop:native-namestring path) idx-path) + (format t "article ~a/~a force-linked to index ~a~%" g i hash))) + (t + (handler-case + (progn + (sb-posix:link (uiop:native-namestring path) idx-path) + (format t "article ~a/~a indexed by ~a (~a)~%" g i m hash)) + (sb-posix:syscall-error (c) + (if (= (sb-posix:syscall-errno c) sb-posix:eexist) + (format t "article ~a/~a already indexed concurrently.~%" g i) + (error c))))))))))) + +(defun index-from-fs!-old () + (loop for path in (in-groups (directory "**/*")) + do (let* ((g (str:trim (first (last (pathname-directory path))))) + (i (str:trim (pathname-name path))) + (m (ignore-errors (str:trim (extract-mid (fetch-article g i)))))) + (when (and m (> (length m) 0)) + (let* ((hash (index-hash m)) + (idx-path (index-path hash))) + (if (probe-file idx-path) ;; article exists in index: unify inodes by re-linking group file to index + (unless (= (get-file-inode path) (get-file-inode idx-path)) + (delete-file path) + (sb-posix:link (uiop:native-namestring idx-path) (uiop:native-namestring path)) + (format t "article ~a/~a relinked-to-existing-index ~a~%" g i hash)) + (progn + (ensure-index-directories! hash) + (handler-case + (progn + (sb-posix:link (uiop:native-namestring path) idx-path) + (format t "article ~a/~a mid ~a hashes-to ~a~%" g i m hash)) + (sb-posix:syscall-error (c) + (if (= (sb-posix:syscall-errno c) sb-posix:eexist) + (format t "article ~a/~a indexed due to a cross-post? EEXIST.~%" g i) + (error c))))))))))) (index-from-fs!) -(format t "Index built.~%") diff --git a/scripts/find-duplicates.lisp b/scripts/find-duplicates.lisp new file mode 100644 index 0000000..1ee49c7 --- /dev/null +++ b/scripts/find-duplicates.lisp @@ -0,0 +1,37 @@ +#-quicklisp +(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" + (user-homedir-pathname)))) + (when (probe-file quicklisp-init) + (load quicklisp-init))) +(ql:quickload :loop :silent t) +(in-package #:loop) +(defun find-duplicate-mids () + "Displays any duplicated message-ids across all group articles." + (let ((mid-map (make-hash-table :test 'equal)) + (found-dupes nil)) + ;; collect all articles and group by message-id + (loop for path in (in-groups (directory "**/*")) + do (let* ((dir-list (pathname-directory path)) + (g (when dir-list (str:trim (first (last dir-list))))) + (i (pathname-name path)) + (i-str (when i (str:trim i)))) + ;; process numeric article files only + (when (and g i-str (parse-integer i-str :junk-allowed t)) + (let ((mid (ignore-errors (get-mid-from-path path)))) + (when (and mid (> (length (str:trim mid)) 0)) + ;; push the (group . article-number) pair into the hash map + (push (cons g i-str) (gethash mid mid-map))))))) + ;; remove duplicates + (maphash (lambda (mid locations) + (when (> (length locations) 1) + (push (cons mid locations) found-dupes))) + mid-map) + ;; displays + (when found-dupes + (loop for (mid . locs) in found-dupes + do (format t "message-id: ~a~%" mid) + ;; sort by group + (let ((sorted-locs (sort locs #'string-lessp :key #'car))) + (loop for (g . i) in sorted-locs + do (format t "~a/~a~%" g i))))))) +(find-duplicate-mids) diff --git a/scripts/verify-index.lisp b/scripts/verify-index.lisp new file mode 100644 index 0000000..4525bba --- /dev/null +++ b/scripts/verify-index.lisp @@ -0,0 +1,37 @@ +#-quicklisp +(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" + (user-homedir-pathname)))) + (when (probe-file quicklisp-init) + (load quicklisp-init))) +(ql:quickload :loop :silent t) +(in-package #:loop) +(defun verify-index-inodes () + "Iterates over all group articles and prints whether they share an inode with index/." + (loop for path in (in-groups (directory "**/*")) + do (let* ((dir-list (pathname-directory path)) + (g (when dir-list (str:trim (first (last dir-list))))) + (i (pathname-name path)) + (i-str (when i (str:trim i)))) + ;; ignore metadata and directories + (when (and g i-str (parse-integer i-str :junk-allowed t)) + (let ((mid (ignore-errors (get-mid-from-path path)))) + (if (or (null mid) (zerop (length (str:trim mid)))) + (format t "no-mid ~a/~a couldn't find message-id~%" g i-str) + (let* ((hash (index-hash mid)) + (idx-path (index-path hash)) + (grp-inode (get-file-inode path)) + (idx-inode (get-file-inode idx-path))) + (cond + ((null idx-inode) + (stdout "no-index ~a/~a mid ~a hashes-to ~a~%" + g i-str mid idx-path)) + ((= grp-inode idx-inode) + (stdout "okay ~a/~a shares-inode ~a = ~a hashed-at ~a~%" + g i-str grp-inode idx-inode idx-path)) + (t + (stdout "mismatch ~a/~a inode ~a =/= inode ~a hash ~a~%" + g i-str grp-inode idx-inode idx-path)))))))))) + +(defun verify-index () + (verify-index-inodes)) +(verify-index) diff --git a/version.lisp b/version.lisp index e04af87..97345a7 100644 --- a/version.lisp +++ b/version.lisp @@ -1,2 +1,2 @@ (in-package :loop) -(defparameter *git-hash* "05be4aa") +(defparameter *git-hash* "d532d44")