[bpt/emacs.git] / lisp / gnus / spam-report.el

;;; spam-report.el --- Reporting spam

;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.

;; Author: Teodor Zlatanov <tzz@lifelogs.com>
;; Keywords: network

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;;; This module addresses a few aspects of spam reporting under Gnus.  Page
;;; breaks are used for grouping declarations and documentation relating to
;;; each particular aspect.

;;; Code:
(require 'gnus)
(require 'gnus-sum)

(eval-and-compile
  (autoload 'mm-url-insert "mm-url"))

(defgroup spam-report nil
  "Spam reporting configuration."
  :group 'mail
  :group 'news)

(defcustom spam-report-gmane-regex nil
  "Regexp matching Gmane newsgroups, e.g. \"^nntp\\+.*:gmane\\.\"
If you are using spam.el, consider setting gnus-spam-process-newsgroups
or the gnus-group-spam-exit-processor-report-gmane group/topic parameter
instead."
  :type '(radio (const nil)
		(regexp :value "^nntp\+.*:gmane\."))
  :group 'spam-report)

(defcustom spam-report-gmane-use-article-number t
  "Whether the article number (faster!) or the header should be used.

You must set this to nil if you don't read Gmane groups directly
from news.gmane.org, e.g. when using local newsserver such as
leafnode."
  :type 'boolean
  :group 'spam-report)

(defcustom spam-report-url-ping-function
  'spam-report-url-ping-plain
  "Function to use for url ping spam reporting.
The function must accept the arguments `host' and `report'."
  :type '(choice
	  (const :tag "Connect directly"
		 spam-report-url-ping-plain)
	  (const :tag "Use the external program specified in `mm-url-program'"
		 spam-report-url-ping-mm-url)
	  (const :tag "Store request URLs in `spam-report-requests-file'"
		 spam-report-url-to-file)
	  (function :tag "User defined function" nil))
  :group 'spam-report)

(defcustom spam-report-requests-file
  (nnheader-concat gnus-directory "spam/" "spam-report-requests.url")
  ;; Is there a convention for the extension of such a file?
  ;; Should we use `spam-directory'?
  "File where spam report request are stored."
  :type 'file
  :group 'spam-report)

(defvar spam-report-url-ping-temp-agent-function nil
  "Internal variable for `spam-report-agentize' and `spam-report-deagentize'.
This variable will store the value of `spam-report-url-ping-function' from
before `spam-report-agentize' was run, so that `spam-report-deagentize' can
undo that change.")

(defun spam-report-gmane (&rest articles)
  "Report an article as spam through Gmane"
  (dolist (article articles)
    (when (and gnus-newsgroup-name
	       (or (null spam-report-gmane-regex)
		   (string-match spam-report-gmane-regex gnus-newsgroup-name)))
      (gnus-message 6 "Reporting spam article %d to spam.gmane.org..." article)
      (if spam-report-gmane-use-article-number
	  (spam-report-url-ping
	   "spam.gmane.org"
	   (format "/%s:%d"
		   (gnus-group-real-name gnus-newsgroup-name)
		   article))
	(with-current-buffer nntp-server-buffer
	  (gnus-request-head article gnus-newsgroup-name)
	  (let ((case-fold-search t)
		field host report url)
	    ;; First check for X-Report-Spam because it's more specific to
	    ;; spam reporting than Archived-At.  OTOH, all new articles on
	    ;; Gmane don't have X-Report-Spam anymore (unless Lars changes his
	    ;; mind :-)).
	    ;;
	    ;; There might be more than one Archived-At header so we need to
	    ;; find (and transform) the one related to Gmane.
	    (setq field (or (gnus-fetch-field "X-Report-Spam")
			    (gnus-fetch-field "Archived-At")))
	    (setq host (progn
			 (string-match
			  (concat "http://\\([a-z]+\\.gmane\\.org\\)"
				  "\\(/[^:/]+[:/][0-9]+\\)")
			  field)
			 (match-string 1 field)))
	    (setq report (match-string 2 field))
	    (when (string-equal "permalink.gmane.org" host)
	      (setq host "spam.gmane.org")
	      (setq report (gnus-replace-in-string
			    report "/\\([0-9]+\\)$" ":\\1")))
	    (setq url (format "http://%s%s" host report))
	    (if (not (and host report url))
		(gnus-message
		 3 "Could not find a spam report header in article %d..."
		 article)
	      (gnus-message 7 "Reporting spam through URL %s..." url)
	      (spam-report-url-ping host report))))))))

(defun spam-report-url-ping (host report)
  "Ping a host through HTTP, addressing a specific GET resource using
the function specified by `spam-report-url-ping-function'."
  ;; Example:
  ;; host: "spam.gmane.org"
  ;; report: "/gmane.some.group:123456"
  (funcall spam-report-url-ping-function host report))

(defun spam-report-url-ping-plain (host report)
  "Ping a host through HTTP, addressing a specific GET resource."
  (let ((tcp-connection))
    (with-temp-buffer
      (or (setq tcp-connection
		(open-network-stream
		 "URL ping"
		 (buffer-name)
		 host
		 80))
	  (error "Could not open connection to %s" host))
      (set-marker (process-mark tcp-connection) (point-min))
      (process-send-string
       tcp-connection
       (format "GET %s HTTP/1.1\nUser-Agent: %s (spam-report.el)\nHost: %s\n\n"
	       report (gnus-extended-version) host)))))

;;;###autoload
(defun spam-report-process-queue (&optional file keep)
  "Report all queued requests from `spam-report-requests-file'.

If FILE is given, use it instead of `spam-report-requests-file'.
If KEEP is t, leave old requests in the file.  If KEEP is the
symbol `ask', query before flushing the queue file."
  (interactive
   (list (read-file-name
	  "File: "
	  (file-name-directory spam-report-requests-file)
	  spam-report-requests-file
	  nil
	  (file-name-nondirectory spam-report-requests-file))
	 current-prefix-arg))
  (if (eq spam-report-url-ping-function 'spam-report-url-to-file)
      (error (concat "Cannot process requests when "
		     "`spam-report-url-ping-function' is "
		     "`spam-report-url-to-file'."))
    (gnus-message 7 "Processing requests using `%s'."
		  spam-report-url-ping-function))
  (or file (setq file spam-report-requests-file))
  (save-excursion
    (set-buffer (find-file-noselect file))
    (goto-char (point-min))
    (while (and (not (eobp))
		(re-search-forward
		 "http://\\([^/]+\\)\\(/.*\\) *$" (gnus-point-at-eol) t))
      (funcall spam-report-url-ping-function (match-string 1) (match-string 2))
      (forward-line 1))
    (if (or (eq keep nil)
	    (and (eq keep 'ask)
		 (y-or-n-p
		  (format
		   "Flush requests from `%s'? " (current-buffer)))))
	(progn
	  (gnus-message 7 "Flushing request file `%s'"
			spam-report-requests-file)
	  (erase-buffer)
	  (save-buffer)
	  (kill-buffer (current-buffer)))
      (gnus-message 7 "Keeping requests in `%s'" spam-report-requests-file))))

;;;###autoload
(defun spam-report-url-ping-mm-url (host report)
  "Ping a host through HTTP, addressing a specific GET resource. Use
the external program specified in `mm-url-program' to connect to
server."
  (with-temp-buffer
    (let ((url (format "http://%s%s" host report)))
      (mm-url-insert url t))))

;;;###autoload
(defun spam-report-url-to-file (host report)
  "Collect spam report requests in `spam-report-requests-file'.
Customize `spam-report-url-ping-function' to use this function."
  (let ((url (format "http://%s%s" host report))
	(file spam-report-requests-file))
    (gnus-make-directory (file-name-directory file))
    (gnus-message 9 "Writing URL `%s' to file `%s'" url file)
    (with-temp-buffer
      (insert url)
      (newline)
      (append-to-file (point-min) (point-max) file))))

;;;###autoload
(defun spam-report-agentize ()
  "Add spam-report support to the Agent.
Spam reports will be queued with \\[spam-report-url-to-file] when
the Agent is unplugged, and will be submitted in a batch when the
Agent is plugged."
  (interactive)
  (add-hook 'gnus-agent-plugged-hook 'spam-report-plug-agent)
  (add-hook 'gnus-agent-unplugged-hook 'spam-report-unplug-agent))

;;;###autoload
(defun spam-report-deagentize ()
  "Remove spam-report support from the Agent.
Spam reports will be queued with the method used when
\\[spam-report-agentize] was run."
  (interactive)
  (remove-hook 'gnus-agent-plugged-hook 'spam-report-plug-agent)
  (remove-hook 'gnus-agent-unplugged-hook 'spam-report-unplug-agent))

(defun spam-report-plug-agent ()
  "Adjust spam report settings for plugged state.
Process queued spam reports."
  ;; Process the queue, unless the user only wanted to report to a file
  ;; anyway.
  (unless (equal spam-report-url-ping-temp-agent-function
		 'spam-report-url-to-file)
    (spam-report-process-queue))
  ;; Set the reporting function, if we have memorized something otherwise,
  ;; stick with plain URL reporting.
  (setq spam-report-url-ping-function
	(or spam-report-url-ping-temp-agent-function
	    'spam-report-url-ping-plain)))

(defun spam-report-unplug-agent ()
  "Restore spam report settings for unplugged state."
  ;; save the old value
  (setq spam-report-url-ping-temp-agent-function
	spam-report-url-ping-function)
  ;; store all reports to file
  (setq spam-report-url-ping-function
	'spam-report-url-to-file))

(provide 'spam-report)

;;; arch-tag: f6683295-ec89-4ab5-8803-8cc842293022
;;; spam-report.el ends here.
Commit	Line	Data
23f87bed	1	;;; spam-report.el --- Reporting spam
e84b4b86	2
88e6695f	3	;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
23f87bed MB	4
	5	;; Author: Teodor Zlatanov <tzz@lifelogs.com>
	6	;; Keywords: network
	7
	8	;; This file is part of GNU Emacs.
	9
	10	;; GNU Emacs is free software; you can redistribute it and/or modify
	11	;; it under the terms of the GNU General Public License as published by
	12	;; the Free Software Foundation; either version 2, or (at your option)
	13	;; any later version.
	14
	15	;; GNU Emacs is distributed in the hope that it will be useful,
	16	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	17	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	18	;; GNU General Public License for more details.
	19
	20	;; You should have received a copy of the GNU General Public License
	21	;; along with GNU Emacs; see the file COPYING. If not, write to the
3a35cf56 LK	22	;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
3a35cf56 LK	23	;; Boston, MA 02110-1301, USA.
23f87bed MB	24
	25	;;; Commentary:
	26
	27	;;; This module addresses a few aspects of spam reporting under Gnus. Page
	28	;;; breaks are used for grouping declarations and documentation relating to
	29	;;; each particular aspect.
	30
	31	;;; Code:
	32	(require 'gnus)
	33	(require 'gnus-sum)
	34
	35	(eval-and-compile
	36	(autoload 'mm-url-insert "mm-url"))
	37
	38	(defgroup spam-report nil
d0859c9a MB	39	"Spam reporting configuration."
	40	:group 'mail
	41	:group 'news)
23f87bed MB	42
	43	(defcustom spam-report-gmane-regex nil
	44	"Regexp matching Gmane newsgroups, e.g. \"^nntp\\+.*:gmane\\.\"
	45	If you are using spam.el, consider setting gnus-spam-process-newsgroups
	46	or the gnus-group-spam-exit-processor-report-gmane group/topic parameter
	47	instead."
	48	:type '(radio (const nil)
ad136a7c	49	(regexp :value "^nntp\+.*:gmane\."))
23f87bed MB	50	:group 'spam-report)
23f87bed MB	51
23f87bed	52	(defcustom spam-report-gmane-use-article-number t
c96ec15a MB	53	"Whether the article number (faster!) or the header should be used.
	54
	55	You must set this to nil if you don't read Gmane groups directly
	56	from news.gmane.org, e.g. when using local newsserver such as
	57	leafnode."
23f87bed MB	58	:type 'boolean
	59	:group 'spam-report)
	60
	61	(defcustom spam-report-url-ping-function
	62	'spam-report-url-ping-plain
61b397cd MB	63	"Function to use for url ping spam reporting.
61b397cd MB	64	The function must accept the arguments `host' and `report'."
23f87bed MB	65	:type '(choice
	66	(const :tag "Connect directly"
	67	spam-report-url-ping-plain)
	68	(const :tag "Use the external program specified in `mm-url-program'"
61b397cd MB	69	spam-report-url-ping-mm-url)
	70	(const :tag "Store request URLs in `spam-report-requests-file'"
	71	spam-report-url-to-file)
	72	(function :tag "User defined function" nil))
23f87bed MB	73	:group 'spam-report)
23f87bed MB	74
61b397cd MB	75	(defcustom spam-report-requests-file
	76	(nnheader-concat gnus-directory "spam/" "spam-report-requests.url")
	77	;; Is there a convention for the extension of such a file?
	78	;; Should we use `spam-directory'?
	79	"File where spam report request are stored."
	80	:type 'file
	81	:group 'spam-report)
	82
	83	(defvar spam-report-url-ping-temp-agent-function nil
	84	"Internal variable for `spam-report-agentize' and `spam-report-deagentize'.
	85	This variable will store the value of `spam-report-url-ping-function' from
	86	before `spam-report-agentize' was run, so that `spam-report-deagentize' can
	87	undo that change.")
	88
23f87bed MB	89	(defun spam-report-gmane (&rest articles)
	90	"Report an article as spam through Gmane"
	91	(dolist (article articles)
	92	(when (and gnus-newsgroup-name
	93	(or (null spam-report-gmane-regex)
	94	(string-match spam-report-gmane-regex gnus-newsgroup-name)))
	95	(gnus-message 6 "Reporting spam article %d to spam.gmane.org..." article)
	96	(if spam-report-gmane-use-article-number
e84b4b86	97	(spam-report-url-ping
61b397cd MB	98	"spam.gmane.org"
	99	(format "/%s:%d"
	100	(gnus-group-real-name gnus-newsgroup-name)
	101	article))
23f87bed MB	102	(with-current-buffer nntp-server-buffer
23f87bed MB	103	(gnus-request-head article gnus-newsgroup-name)
d752cf53 MB	104	(let ((case-fold-search t)
	105	field host report url)
	106	;; First check for X-Report-Spam because it's more specific to
	107	;; spam reporting than Archived-At. OTOH, all new articles on
	108	;; Gmane don't have X-Report-Spam anymore (unless Lars changes his
	109	;; mind :-)).
	110	;;
	111	;; There might be more than one Archived-At header so we need to
	112	;; find (and transform) the one related to Gmane.
	113	(setq field (or (gnus-fetch-field "X-Report-Spam")
	114	(gnus-fetch-field "Archived-At")))
	115	(setq host (progn
	116	(string-match
	117	(concat "http://\\([a-z]+\\.gmane\\.org\\)"
	118	"\\(/[^:/]+[:/][0-9]+\\)")
	119	field)
	120	(match-string 1 field)))
	121	(setq report (match-string 2 field))
	122	(when (string-equal "permalink.gmane.org" host)
a8f6d239 MB	123	(setq host "spam.gmane.org")
	124	(setq report (gnus-replace-in-string
	125	report "/\\([0-9]+\\)$" ":\\1")))
d752cf53 MB	126	(setq url (format "http://%s%s" host report))
	127	(if (not (and host report url))
	128	(gnus-message
	129	3 "Could not find a spam report header in article %d..."
	130	article)
	131	(gnus-message 7 "Reporting spam through URL %s..." url)
	132	(spam-report-url-ping host report))))))))
23f87bed MB	133
	134	(defun spam-report-url-ping (host report)
	135	"Ping a host through HTTP, addressing a specific GET resource using
	136	the function specified by `spam-report-url-ping-function'."
d752cf53 MB	137	;; Example:
	138	;; host: "spam.gmane.org"
	139	;; report: "/gmane.some.group:123456"
23f87bed MB	140	(funcall spam-report-url-ping-function host report))
	141
	142	(defun spam-report-url-ping-plain (host report)
	143	"Ping a host through HTTP, addressing a specific GET resource."
	144	(let ((tcp-connection))
	145	(with-temp-buffer
	146	(or (setq tcp-connection
	147	(open-network-stream
	148	"URL ping"
	149	(buffer-name)
	150	host
	151	80))
	152	(error "Could not open connection to %s" host))
	153	(set-marker (process-mark tcp-connection) (point-min))
	154	(process-send-string
	155	tcp-connection
	156	(format "GET %s HTTP/1.1\nUser-Agent: %s (spam-report.el)\nHost: %s\n\n"
5fae1cae	157	report (gnus-extended-version) host)))))
23f87bed	158
61b397cd MB	159	;;;###autoload
	160	(defun spam-report-process-queue (&optional file keep)
	161	"Report all queued requests from `spam-report-requests-file'.
	162
	163	If FILE is given, use it instead of `spam-report-requests-file'.
	164	If KEEP is t, leave old requests in the file. If KEEP is the
	165	symbol `ask', query before flushing the queue file."
	166	(interactive
	167	(list (read-file-name
	168	"File: "
	169	(file-name-directory spam-report-requests-file)
	170	spam-report-requests-file
	171	nil
	172	(file-name-nondirectory spam-report-requests-file))
	173	current-prefix-arg))
	174	(if (eq spam-report-url-ping-function 'spam-report-url-to-file)
	175	(error (concat "Cannot process requests when "
	176	"`spam-report-url-ping-function' is "
	177	"`spam-report-url-to-file'."))
	178	(gnus-message 7 "Processing requests using `%s'."
	179	spam-report-url-ping-function))
	180	(or file (setq file spam-report-requests-file))
	181	(save-excursion
	182	(set-buffer (find-file-noselect file))
	183	(goto-char (point-min))
	184	(while (and (not (eobp))
	185	(re-search-forward
8654e13a	186	"http://\\([^/]+\\)\\(/.\\) $" (gnus-point-at-eol) t))
61b397cd MB	187	(funcall spam-report-url-ping-function (match-string 1) (match-string 2))
	188	(forward-line 1))
	189	(if (or (eq keep nil)
	190	(and (eq keep 'ask)
	191	(y-or-n-p
	192	(format
	193	"Flush requests from `%s'? " (current-buffer)))))
	194	(progn
	195	(gnus-message 7 "Flushing request file `%s'"
	196	spam-report-requests-file)
	197	(erase-buffer)
	198	(save-buffer)
	199	(kill-buffer (current-buffer)))
	200	(gnus-message 7 "Keeping requests in `%s'" spam-report-requests-file))))
	201
	202	;;;###autoload
23f87bed MB	203	(defun spam-report-url-ping-mm-url (host report)
	204	"Ping a host through HTTP, addressing a specific GET resource. Use
	205	the external program specified in `mm-url-program' to connect to
	206	server."
	207	(with-temp-buffer
e9bd5782	208	(let ((url (format "http://%s%s" host report)))
23f87bed MB	209	(mm-url-insert url t))))
23f87bed MB	210
61b397cd MB	211	;;;###autoload
	212	(defun spam-report-url-to-file (host report)
	213	"Collect spam report requests in `spam-report-requests-file'.
	214	Customize `spam-report-url-ping-function' to use this function."
e9bd5782	215	(let ((url (format "http://%s%s" host report))
61b397cd MB	216	(file spam-report-requests-file))
	217	(gnus-make-directory (file-name-directory file))
	218	(gnus-message 9 "Writing URL `%s' to file `%s'" url file)
	219	(with-temp-buffer
	220	(insert url)
	221	(newline)
	222	(append-to-file (point-min) (point-max) file))))
	223
	224	;;;###autoload
	225	(defun spam-report-agentize ()
	226	"Add spam-report support to the Agent.
	227	Spam reports will be queued with \\[spam-report-url-to-file] when
	228	the Agent is unplugged, and will be submitted in a batch when the
	229	Agent is plugged."
	230	(interactive)
	231	(add-hook 'gnus-agent-plugged-hook 'spam-report-plug-agent)
	232	(add-hook 'gnus-agent-unplugged-hook 'spam-report-unplug-agent))
	233
	234	;;;###autoload
	235	(defun spam-report-deagentize ()
	236	"Remove spam-report support from the Agent.
	237	Spam reports will be queued with the method used when
	238	\\[spam-report-agentize] was run."
	239	(interactive)
	240	(remove-hook 'gnus-agent-plugged-hook 'spam-report-plug-agent)
	241	(remove-hook 'gnus-agent-unplugged-hook 'spam-report-unplug-agent))
	242
	243	(defun spam-report-plug-agent ()
	244	"Adjust spam report settings for plugged state.
	245	Process queued spam reports."
	246	;; Process the queue, unless the user only wanted to report to a file
	247	;; anyway.
	248	(unless (equal spam-report-url-ping-temp-agent-function
	249	'spam-report-url-to-file)
	250	(spam-report-process-queue))
	251	;; Set the reporting function, if we have memorized something otherwise,
	252	;; stick with plain URL reporting.
	253	(setq spam-report-url-ping-function
	254	(or spam-report-url-ping-temp-agent-function
	255	'spam-report-url-ping-plain)))
	256
	257	(defun spam-report-unplug-agent ()
	258	"Restore spam report settings for unplugged state."
	259	;; save the old value
	260	(setq spam-report-url-ping-temp-agent-function
	261	spam-report-url-ping-function)
	262	;; store all reports to file
	263	(setq spam-report-url-ping-function
	264	'spam-report-url-to-file))
	265
23f87bed MB	266	(provide 'spam-report)
	267
	268	;;; arch-tag: f6683295-ec89-4ab5-8803-8cc842293022
	269	;;; spam-report.el ends here.