Mercurial > hg > xemacs
comparison my-news.el @ 85:2a83bb36896f default tip
merge
| author | Henry S Thompson <ht@inf.ed.ac.uk> |
|---|---|
| date | Thu, 02 Jul 2026 10:12:17 +0100 |
| parents | 8e82ac8512d2 |
| children |
comparison
equal
deleted
inserted
replaced
| 84:72f455f3cec1 | 85:2a83bb36896f |
|---|---|
| 245 (defun known-black (list) | 245 (defun known-black (list) |
| 246 (if (get-database (get-from-gnus-addr) blacklist-db) | 246 (if (get-database (get-from-gnus-addr) blacklist-db) |
| 247 list)) | 247 list)) |
| 248 | 248 |
| 249 (defun white-spam (list) | 249 (defun white-spam (list) |
| 250 (if (or (equal (get-database (get-from-gnus-addr) whitelist-db) "t") | 250 (if |
| 251 (let ((case-fold-search t) | 251 (let ((from (get-from-gnus-addr))) |
| 252 (subj (gnus-fetch-field "Subject")) | 252 (and (or (equal (get-database (get-from-gnus-addr) whitelist-db) "t") |
| 253 (from (get-from-gnus-addr))) | 253 (let ((case-fold-search t) |
| 254 (or | 254 (subj (gnus-fetch-field "Subject"))) |
| 255 (and subj (string-match white-subjects subj)) | 255 (or |
| 256 (and from | 256 (and subj (string-match white-subjects subj)) |
| 257 (let ((fromDom (substring from (+ 1 (search "@" from))))) | 257 (and from |
| 258 (and fromDom (member fromDom white-domains))))))) | 258 (let ((fromDom (substring from (+ 1 (search "@" from))))) |
| 259 (and fromDom (member fromDom white-domains))))))) | |
| 260 (not (spoofed from)) | |
| 261 )) | |
| 259 list)) | 262 list)) |
| 260 | 263 |
| 261 (defun ad-spam (list) | 264 (defun ad-spam (list) |
| 262 (if (let ((from (get-from-gnus-addr))) | 265 (if (let ((from (get-from-gnus-addr))) |
| 263 (or | 266 (or |
| 266 (let ((fromDom (substring from (+ 1 (search "@" from))))) | 269 (let ((fromDom (substring from (+ 1 (search "@" from))))) |
| 267 (and fromDom (member fromDom ad-domains)))) | 270 (and fromDom (member fromDom ad-domains)))) |
| 268 )) | 271 )) |
| 269 list)) | 272 list)) |
| 270 | 273 |
| 274 (defvar spoof-targets (list | |
| 275 (cons "ht" | |
| 276 (mapcar (lambda (d) (concat d "$")) | |
| 277 '("hst.name" "ed.ac.uk" "markup.co.uk"))) | |
| 278 )) | |
| 279 | |
| 280 (defun spoofed (from) | |
| 281 (let ((spoofee (substring from 0 (search "@" from))) | |
| 282 (spoofDom (substring from (+ 1 (search "@" from))))) | |
| 283 (let ((target (assoc spoofee spoof-targets))) | |
| 284 (if target | |
| 285 (let ((tdom (loop for d in (cdr target) thereis | |
| 286 (and (string-match d spoofDom) | |
| 287 d)))) | |
| 288 (if tdom | |
| 289 (let* ((received (save-excursion | |
| 290 (save-restriction | |
| 291 (let ((case-fold-search t) | |
| 292 (inhibit-point-motion-hooks t)) | |
| 293 (nnheader-narrow-to-headers) | |
| 294 (mail-fetch-field "Received" nil nil t))))) | |
| 295 (bogon (loop for r in received thereis | |
| 296 (and (not (string-match tdom r)) | |
| 297 r)))) | |
| 298 (cond (bogon | |
| 299 (message "Found a spoof sender %s in %s" bogon received) | |
| 300 t)) | |
| 301 ))))))) | |
| 302 | |
| 271 (defun bogoNote (group) | 303 (defun bogoNote (group) |
| 272 (if (memq number | 304 (if (memq number |
| 273 (with-current-buffer gnus-summary-buffer | 305 (with-current-buffer gnus-summary-buffer |
| 274 gnus-newsgroup-processable)) | 306 gnus-newsgroup-processable)) |
| 275 (let ((addr (get-from-gnus-addr))) | 307 (let ((addr (get-from-gnus-addr))) |
| 276 (new-white addr))) | 308 (new-white addr))) |
| 277 (shell-command-on-region (point-min) (point-max) | 309 (shell-command-on-region (point-min) (point-max) |
| 278 "/afs/inf.ed.ac.uk/user/h/ht/share/bin/local/makeBogo") | 310 "/home/ht/bin/makeBogo") |
| 279 'delete) | 311 'delete) |
| 280 | 312 |
| 281 (defun whiten-recip () | 313 (defun whiten-recip () |
| 282 ;;; a hook for outgoing mail | 314 ;;; a hook for outgoing mail |
| 283 (let* ((to (message-fetch-field "To")) | 315 (let* ((to (message-fetch-field "To")) |