Mercurial > hg > xemacs

changeset 85:2a83bb36896f default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Henry S Thompson <ht@inf.ed.ac.uk>
date Thu, 02 Jul 2026 10:12:17 +0100
parents 72f455f3cec1
children
files my-news.el
diffstat 1 files changed, 42 insertions(+), 10 deletions(-) [+]
line wrap: on
line diff
--- a/my-news.el	Thu Jul 02 10:11:31 2026 +0100
+++ b/my-news.el	Thu Jul 02 10:12:17 2026 +0100
@@ -247,15 +247,18 @@
       list))
 
 (defun white-spam (list)
-  (if (or (equal (get-database (get-from-gnus-addr) whitelist-db) "t")
-	  (let ((case-fold-search t)
-		(subj (gnus-fetch-field "Subject"))
-		(from (get-from-gnus-addr)))
-	    (or
-	     (and subj (string-match white-subjects subj))
-	     (and from
-		  (let ((fromDom (substring from (+ 1 (search "@" from)))))
-		    (and fromDom (member fromDom white-domains)))))))
+  (if
+      (let ((from (get-from-gnus-addr)))
+	(and (or (equal (get-database (get-from-gnus-addr) whitelist-db) "t")
+		 (let ((case-fold-search t)
+		       (subj (gnus-fetch-field "Subject")))
+		   (or
+		    (and subj (string-match white-subjects subj))
+		    (and from
+			 (let ((fromDom (substring from (+ 1 (search "@" from)))))
+			   (and fromDom (member fromDom white-domains)))))))
+	     (not (spoofed from))
+	     ))
       list))
 
 (defun ad-spam (list)
@@ -268,6 +271,35 @@
        ))
       list))
 
+(defvar spoof-targets (list
+		       (cons "ht"
+			    (mapcar (lambda (d) (concat d "$"))
+				    '("hst.name" "ed.ac.uk" "markup.co.uk")))
+		       ))
+
+(defun spoofed (from)
+  (let ((spoofee (substring from 0 (search "@" from)))
+	(spoofDom (substring from (+ 1 (search "@" from)))))
+    (let ((target (assoc spoofee spoof-targets)))
+      (if target
+	  (let ((tdom (loop for d in (cdr target) thereis
+			(and (string-match d spoofDom)
+			     d))))
+	    (if tdom
+		(let* ((received (save-excursion
+				   (save-restriction
+				     (let ((case-fold-search t)
+					   (inhibit-point-motion-hooks t))
+				       (nnheader-narrow-to-headers)
+				       (mail-fetch-field "Received" nil nil t)))))
+		       (bogon (loop for r in received thereis
+				(and (not (string-match tdom r))
+				     r))))
+		  (cond (bogon
+			 (message "Found a spoof sender %s in %s"  bogon received)
+			 t))
+		  )))))))
+
 (defun bogoNote (group)
   (if  (memq number
 	     (with-current-buffer gnus-summary-buffer
@@ -275,7 +307,7 @@
       (let ((addr (get-from-gnus-addr)))
 	(new-white addr)))
   (shell-command-on-region (point-min) (point-max)
-			   "/afs/inf.ed.ac.uk/user/h/ht/share/bin/local/makeBogo")
+			   "/home/ht/bin/makeBogo")
   'delete)
 
 (defun whiten-recip ()