Mercurial > hg > xemacs

comparison my-news.el @ 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
comparison
equal deleted inserted replaced
85:2a83bb36896f 86:1b64c0096328
271 )) 271 ))
272 list)) 272 list))
273 273
274 (defvar spoof-targets (list 274 (defvar spoof-targets (list
275 (cons "ht" 275 (cons "ht"
276 (mapcar (lambda (d) (concat d "$")) 276 (mapcar (lambda (d) (concat d "\\b"))
277 '("hst.name" "ed.ac.uk" "markup.co.uk"))) 277 '("home\\.hst\\.name" "hst\\.name" "ed\\.ac\\.uk" "markup\\.co\\.uk")))
278 )) 278 ))
279
280 (defvar outlook-hack "^from [^ ]*\\.\\(prod\\.\\(outlook\\|exchangelabs\\)\\.com\\|svc\\.cloud\\.microsoft\\|ed\\.ac\\.uk\\)\\b")
279 281
280 (defun spoofed (from) 282 (defun spoofed (from)
281 (let ((spoofee (substring from 0 (search "@" from))) 283 (let ((spoofee (substring from 0 (search "@" from)))
282 (spoofDom (substring from (+ 1 (search "@" from))))) 284 (spoofDom (substring from (+ 1 (search "@" from))))
285 (case-fold-search t))
283 (let ((target (assoc spoofee spoof-targets))) 286 (let ((target (assoc spoofee spoof-targets)))
284 (if target 287 (if target
285 (let ((tdom (loop for d in (cdr target) thereis 288 (let ((tdom (loop for d in (cdr target) thereis
286 (and (string-match d spoofDom) 289 (and (string-match d spoofDom)
287 d)))) 290 d))))
291 (let ((case-fold-search t) 294 (let ((case-fold-search t)
292 (inhibit-point-motion-hooks t)) 295 (inhibit-point-motion-hooks t))
293 (nnheader-narrow-to-headers) 296 (nnheader-narrow-to-headers)
294 (mail-fetch-field "Received" nil nil t))))) 297 (mail-fetch-field "Received" nil nil t)))))
295 (bogon (loop for r in received thereis 298 (bogon (loop for r in received thereis
296 (and (not (string-match tdom r)) 299 (and (not (string-match outlook-hack r))
300 (not (string-match tdom r))
297 r)))) 301 r))))
298 (cond (bogon 302 (cond (bogon
299 (message "Found a spoof sender %s in %s" bogon received) 303 (message "Found a spoof sender %s in %s" bogon received)
300 t)) 304 t))
301 ))))))) 305 )))))))
449 (if (ht-next-with-unseen n) 453 (if (ht-next-with-unseen n)
450 (ht-read-group-unseen-only))))) 454 (ht-read-group-unseen-only)))))
451 455
452 (defun ht-gnus-pers-refresh (n) 456 (defun ht-gnus-pers-refresh (n)
453 (interactive "p") 457 (interactive "p")
454 (let ((gn (concat "nnml+ht:pers-" 458 (if (file-readable-p (concat (getenv "HOME") "/.bashrc"))
455 (format-time-string "%Y-%m" (current-time)))) 459 (let ((gn (concat "nnml+ht:pers-"
456 (jr ht-gnus-just-read)) 460 (format-time-string "%Y-%m" (current-time))))
457 (gnus-group-get-new-news) 461 (jr ht-gnus-just-read))
458 (let ((nn (gnus-number-of-unseen-articles-in-group gn))) 462 (gnus-group-get-new-news)
459 (gnus-group-goto-group gn) 463 (let ((nn (gnus-number-of-unseen-articles-in-group gn)))
460 (cond 464 (gnus-group-goto-group gn)
461 ((> nn 0) 465 (cond
462 (gnus-group-read-group nn)) 466 ((> nn 0)
463 ((> n 1) 467 (gnus-group-read-group nn))
464 (let ((gnus-auto-select-subject 468 ((> n 1)
465 (lambda () 469 (let ((gnus-auto-select-subject
466 (goto-char (point-max)) 470 (lambda ()
467 (previous-line 1)))) 471 (goto-char (point-max))
468 (gnus-group-read-group nil t))) 472 (previous-line 1))))
469 (t (goto-char (point-min)) 473 (gnus-group-read-group nil t)))
470 (ht-next-with-unseen 1)))) 474 (t (goto-char (point-min))
471 (message "read: %s" ht-gnus-just-read) 475 (ht-next-with-unseen 1))))
472 )) 476 (if ht-gnus-just-read
477 (message "read: %s" ht-gnus-just-read)
478 (message "no new mail%s"
479 (if (file-exists-p "/disk/scratch/mail/htcrashbox.errs")
480 ": non-empty htcrashbox.errs"
481 "")))
482 )
483 (message "relogin needed")
484 (sleep-for 1)
485 (save-window-excursion
486 (switch-to-buffer (get-buffer-create "*shell*"))
487 (insert "renc")
488 (comint-send-input)
489 (sleep 2)
490 (let ((l (line-number (point))))
491 (while (eq l (line-number (point)))
492 (sleep-for 2)))
493 )
494 )
495 )
473 496
474 (defun no-select () 497 (defun no-select ()
475 (if (member gnus-newsgroup-name no-select-groups) 498 (if (member gnus-newsgroup-name no-select-groups)
476 (progn (make-variable-buffer-local 'gnus-auto-select-first) 499 (progn (make-variable-buffer-local 'gnus-auto-select-first)
477 (setq gnus-auto-select-first nil)))) 500 (setq gnus-auto-select-first nil))))