Mercurial > hg > xemacs

changeset 86:1b64c0096328 default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
more patterns for outlook-hack
author Henry S. Thompson <ht@inf.ed.ac.uk>
date Sun, 25 Oct 2026 16:51:14 +0000
parents 2a83bb36896f
children
files my-news.el
diffstat 1 files changed, 46 insertions(+), 23 deletions(-) [+]
line wrap: on
line diff
--- a/my-news.el	Thu Jul 02 10:12:17 2026 +0100
+++ b/my-news.el	Sun Oct 25 16:51:14 2026 +0000
@@ -273,13 +273,16 @@
 
 (defvar spoof-targets (list
 		       (cons "ht"
-			    (mapcar (lambda (d) (concat d "$"))
-				    '("hst.name" "ed.ac.uk" "markup.co.uk")))
+			    (mapcar (lambda (d) (concat d "\\b"))
+				    '("home\\.hst\\.name" "hst\\.name" "ed\\.ac\\.uk" "markup\\.co\\.uk")))
 		       ))
 
+(defvar outlook-hack "^from [^ ]*\\.\\(prod\\.\\(outlook\\|exchangelabs\\)\\.com\\|svc\\.cloud\\.microsoft\\|ed\\.ac\\.uk\\)\\b")
+
 (defun spoofed (from)
   (let ((spoofee (substring from 0 (search "@" from)))
-	(spoofDom (substring from (+ 1 (search "@" from)))))
+	(spoofDom (substring from (+ 1 (search "@" from))))
+	(case-fold-search t))
     (let ((target (assoc spoofee spoof-targets)))
       (if target
 	  (let ((tdom (loop for d in (cdr target) thereis
@@ -293,7 +296,8 @@
 				       (nnheader-narrow-to-headers)
 				       (mail-fetch-field "Received" nil nil t)))))
 		       (bogon (loop for r in received thereis
-				(and (not (string-match tdom r))
+				(and (not (string-match outlook-hack r))
+				     (not (string-match tdom r))
 				     r))))
 		  (cond (bogon
 			 (message "Found a spoof sender %s in %s"  bogon received)
@@ -451,25 +455,44 @@
 
 (defun ht-gnus-pers-refresh (n)
   (interactive "p")
-  (let ((gn (concat "nnml+ht:pers-"
-		    (format-time-string "%Y-%m" (current-time))))
-	(jr ht-gnus-just-read))
-    (gnus-group-get-new-news)
-    (let ((nn (gnus-number-of-unseen-articles-in-group gn)))
-      (gnus-group-goto-group gn)
-      (cond
-       ((> nn 0)
-	(gnus-group-read-group nn))
-       ((> n 1)
-	(let ((gnus-auto-select-subject
-	       (lambda ()
-		 (goto-char (point-max))
-		 (previous-line 1))))
-	  (gnus-group-read-group nil t)))
-       (t (goto-char (point-min))
-	  (ht-next-with-unseen 1))))
-    (message "read: %s" ht-gnus-just-read)
-  ))
+  (if (file-readable-p (concat (getenv "HOME") "/.bashrc"))
+      (let ((gn (concat "nnml+ht:pers-"
+			(format-time-string "%Y-%m" (current-time))))
+	    (jr ht-gnus-just-read))
+	(gnus-group-get-new-news)
+	(let ((nn (gnus-number-of-unseen-articles-in-group gn)))
+	  (gnus-group-goto-group gn)
+	  (cond
+	   ((> nn 0)
+	    (gnus-group-read-group nn))
+	   ((> n 1)
+	    (let ((gnus-auto-select-subject
+		   (lambda ()
+		     (goto-char (point-max))
+		     (previous-line 1))))
+	      (gnus-group-read-group nil t)))
+	   (t (goto-char (point-min))
+	      (ht-next-with-unseen 1))))
+	(if ht-gnus-just-read
+	    (message "read: %s" ht-gnus-just-read)
+	  (message "no new mail%s"
+		   (if (file-exists-p "/disk/scratch/mail/htcrashbox.errs")
+		       ": non-empty htcrashbox.errs"
+		     "")))
+	)
+    (message "relogin needed")
+    (sleep-for 1)
+    (save-window-excursion 
+      (switch-to-buffer (get-buffer-create "*shell*"))
+      (insert "renc")
+      (comint-send-input)
+      (sleep 2)
+      (let ((l (line-number (point))))
+	(while (eq l (line-number (point)))
+	  (sleep-for 2)))
+      )
+    )
+  )
 
 (defun no-select ()
   (if (member gnus-newsgroup-name no-select-groups)