Rebuilds and verifies the index.

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 || \

groups/local.control.news/1

@@ -1,5 +1,5 @@
 Date: 2024-03-07 21:44:31 GMT-3
-Message-Id: <edjocyeqzqqhnswlbrbo@loop>
+Message-Id: <xdjocyeqzqqhnswlbrbo@loop>
 From: Loop
 Subject: let there be light
 Newsgroups: local.control.news

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

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.
 
+<<How to create an index from the file system.lisp>>=
+(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.
 
-<<How to create an index from the file system.lisp>>=
+<<DEAD How to create an index from the file system.lisp>>=
 (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.
 <<Quicklisp loading preamble.lisp>>
 (ql:quickload :loop :silent t)
 (in-package #:loop)
+<<How to create an index from the file system.lisp>>
 (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}
+
+<<How to verify the index.lisp>>=
+(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))
+@
+
+<<verify-index.lisp>>=
+<<Quicklisp loading preamble.lisp>>
+(ql:quickload :loop :silent t)
+(in-package #:loop)
+<<How to verify the index.lisp>>
+(verify-index)
+@ 
+
+\section{Finding duplicates in the database}
+
+<<How to find duplicate message-ids.lisp>>=
+(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-duplicates.lisp>>=
+<<Quicklisp loading preamble.lisp>>
+(ql:quickload :loop :silent t)
+(in-package #:loop)
+<<How to find duplicate message-ids.lisp>>
+(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.
 
 <<Little procedures.lisp>>=
+(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.
 <<How to remove inactive users.lisp>>
 <<How to enumerate inactive accounts.lisp>>
 <<How to migrate accounts without a creation date.lisp>>
-<<How to create an index from the file system.lisp>>
 <<How to read the head of articles.lisp>>
 <<How to parse articles.lisp>>
 <<How to stream off articles.lisp>>

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.~%")

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)

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)

version.lisp

@@ -1,2 +1,2 @@
 (in-package :loop)
-(defparameter *git-hash* "05be4aa")
+(defparameter *git-hash* "d532d44")