117 |
(require 'sendmail) |
(require 'sendmail) |
118 |
;; Those sections of code which are dependent upon |
;; Those sections of code which are dependent upon |
119 |
;; RMAIL are only evaluated if we have received a message with RMAIL... |
;; RMAIL are only evaluated if we have received a message with RMAIL... |
120 |
;;(require 'rmail) |
;;(require 'rmail) |
121 |
|
|
122 |
(defgroup uce nil |
(defgroup uce nil |
123 |
"Facilitate reply to unsolicited commercial email." |
"Facilitate reply to unsolicited commercial email." |
137 |
:type 'hook |
:type 'hook |
138 |
:group 'uce) |
:group 'uce) |
139 |
|
|
140 |
(defcustom uce-message-text |
(defcustom uce-message-text |
141 |
"Recently, I have received an Unsolicited Commercial E-mail from you. |
"Recently, I have received an Unsolicited Commercial E-mail from you. |
142 |
I do not like UCE's and I would like to inform you that sending |
I do not like UCE's and I would like to inform you that sending |
143 |
unsolicited messages to someone while he or she may have to pay for |
unsolicited messages to someone while he or she may have to pay for |
148 |
services you are mistaken. Spamming will only make people hate you, not |
services you are mistaken. Spamming will only make people hate you, not |
149 |
buy from you. |
buy from you. |
150 |
|
|
151 |
If you have any list of people you send unsolicited commercial emails to, |
If you have any list of people you send unsolicited commercial emails to, |
152 |
REMOVE me from such list immediately. I suggest that you make this list |
REMOVE me from such list immediately. I suggest that you make this list |
153 |
just empty. |
just empty. |
154 |
|
|
155 |
---------------------------------------------------- |
---------------------------------------------------- |
192 |
:group 'uce) |
:group 'uce) |
193 |
|
|
194 |
(defcustom uce-signature mail-signature |
(defcustom uce-signature mail-signature |
195 |
"Text to put as your signature after the note to UCE sender. |
"Text to put as your signature after the note to UCE sender. |
196 |
Value nil means none, t means insert `~/.signature' file (if it happens |
Value nil means none, t means insert `~/.signature' file (if it happens |
197 |
to exist), if this variable is a string this string will be inserted |
to exist), if this variable is a string this string will be inserted |
198 |
as your signature." |
as your signature." |
221 |
(let ((message-buffer |
(let ((message-buffer |
222 |
(cond ((eq uce-mail-reader 'gnus) gnus-original-article-buffer) |
(cond ((eq uce-mail-reader 'gnus) gnus-original-article-buffer) |
223 |
((eq uce-mail-reader 'rmail) "RMAIL") |
((eq uce-mail-reader 'rmail) "RMAIL") |
224 |
(t (error |
(t (error |
225 |
"Variable uce-mail-reader set to unrecognized value")))) |
"Variable uce-mail-reader set to unrecognized value")))) |
226 |
(full-header-p (and (eq uce-mail-reader 'rmail) |
(full-header-p (and (eq uce-mail-reader 'rmail) |
227 |
(not (rmail-msg-is-pruned))))) |
(not (rmail-msg-is-pruned))))) |
246 |
end-of-hostname (string-match "[ ,>]" to first-at-sign) |
end-of-hostname (string-match "[ ,>]" to first-at-sign) |
247 |
sender-host (substring to first-at-sign end-of-hostname)) |
sender-host (substring to first-at-sign end-of-hostname)) |
248 |
(if (string-match "\\." sender-host) |
(if (string-match "\\." sender-host) |
249 |
(setq to (format "%s, postmaster%s, abuse%s" |
(setq to (format "%s, postmaster%s, abuse%s" |
250 |
to sender-host sender-host)))) |
to sender-host sender-host)))) |
251 |
(setq mail-send-actions nil) |
(setq mail-send-actions nil) |
252 |
(setq mail-reply-buffer nil) |
(setq mail-reply-buffer nil) |
258 |
(rmail-toggle-header 1) |
(rmail-toggle-header 1) |
259 |
(widen) |
(widen) |
260 |
(rmail-maybe-set-message-counters) |
(rmail-maybe-set-message-counters) |
261 |
(copy-region-as-kill (rmail-msgbeg rmail-current-message) |
(copy-region-as-kill (rmail-msgbeg rmail-current-message) |
262 |
(rmail-msgend rmail-current-message)))))) |
(rmail-msgend rmail-current-message)))))) |
263 |
;; Restore the pruned header state we found. |
;; Restore the pruned header state we found. |
264 |
(if full-header-p |
(if full-header-p |
286 |
(beginning-of-buffer) |
(beginning-of-buffer) |
287 |
(search-forward "*** EOOH ***\n") |
(search-forward "*** EOOH ***\n") |
288 |
(beginning-of-line) |
(beginning-of-line) |
289 |
(forward-line -1))) |
(forward-line -1))) |
290 |
(re-search-backward "^Received:") |
(re-search-backward "^Received:") |
291 |
(beginning-of-line) |
(beginning-of-line) |
292 |
;; Is this always good? It's the only thing I saw when I checked |
;; Is this always good? It's the only thing I saw when I checked |
304 |
(forward-char -1) |
(forward-char -1) |
305 |
;; And add its postmaster to the list of addresses. |
;; And add its postmaster to the list of addresses. |
306 |
(if (string-match "\\." (buffer-substring temp (point))) |
(if (string-match "\\." (buffer-substring temp (point))) |
307 |
(setq to (format "%s, postmaster@%s" |
(setq to (format "%s, postmaster@%s" |
308 |
to (buffer-substring temp (point))))) |
to (buffer-substring temp (point))))) |
309 |
;; Also look at the message-id, it helps *very* often. |
;; Also look at the message-id, it helps *very* often. |
310 |
(if (and (search-forward "\nMessage-Id: " nil t) |
(if (and (search-forward "\nMessage-Id: " nil t) |
320 |
(search-forward ">") |
(search-forward ">") |
321 |
(forward-char -1) |
(forward-char -1) |
322 |
(if (string-match "\\." (buffer-substring temp (point))) |
(if (string-match "\\." (buffer-substring temp (point))) |
323 |
(setq to (format "%s, postmaster@%s" |
(setq to (format "%s, postmaster@%s" |
324 |
to (buffer-substring temp (point))))))) |
to (buffer-substring temp (point))))))) |
325 |
(cond ((eq uce-mail-reader 'gnus) |
(cond ((eq uce-mail-reader 'gnus) |
326 |
;; Does Gnus always have Lines: in the end? |
;; Does Gnus always have Lines: in the end? |
384 |
;; might be to set up special key bindings, replace standart |
;; might be to set up special key bindings, replace standart |
385 |
;; functions in mail-mode, etc. |
;; functions in mail-mode, etc. |
386 |
(run-hooks 'mail-setup-hook 'uce-setup-hook)))) |
(run-hooks 'mail-setup-hook 'uce-setup-hook)))) |
387 |
|
|
388 |
(defun uce-insert-ranting (&optional ignored) |
(defun uce-insert-ranting (&optional ignored) |
389 |
"Insert text of the usual reply to UCE into current buffer." |
"Insert text of the usual reply to UCE into current buffer." |
390 |
(interactive "P") |
(interactive "P") |