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

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

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

;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: network, spam, mail, gmane, report

;; 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 3, 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)

(defcustom spam-report-resend-to nil
  "Email address that spam articles are resent to when reporting.
If not set, the user will be prompted to enter a value which will be
saved for future use."
  :type 'string
  :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-resend (articles &optional ham)
  "Report an article as spam by resending via email.
Reports is as ham when HAM is set."
  (dolist (article articles)
    (gnus-message 6 
		  "Reporting %s article %d to <%s>..."
		  (if ham "ham" "spam")
		  article spam-report-resend-to)
    (unless spam-report-resend-to
      (customize-set-variable 
       spam-report-resend-to
       (read-from-minibuffer "email address to resend SPAM/HAM to? ")))
    ;; This is ganked from the `gnus-summary-resend-message' function.
    ;; It involves rendering the SPAM, which is undesirable, but there does
    ;; not seem to be a nicer way to achieve this.
    ;; select this particular article
    (gnus-summary-select-article nil nil nil article)
    ;; resend it to the destination address
    (save-excursion
      (set-buffer gnus-original-article-buffer)
      (message-resend spam-report-resend-to))))

(defun spam-report-resend-ham (articles)
  "Report an article as ham by resending via email."
  (spam-report-resend articles t))

(defun spam-report-gmane-ham (&rest articles)
  "Report ARTICLES as ham (unregister) through Gmane."
  (interactive (gnus-summary-work-articles current-prefix-arg))
  (dolist (article articles)
    (spam-report-gmane-internal t article)))

(defun spam-report-gmane-spam (&rest articles)
  "Report ARTICLES as spam through Gmane."
  (interactive (gnus-summary-work-articles current-prefix-arg))
  (dolist (article articles)
    (spam-report-gmane-internal nil article)))

;; `spam-report-gmane' was an interactive entry point, so we should provide an
;; alias.
(defalias 'spam-report-gmane 'spam-report-gmane-spam)

(defun spam-report-gmane-internal (unspam article)
  "Report ARTICLE as spam or not-spam through Gmane, depending on UNSPAM."
  (when (and gnus-newsgroup-name
	     (or (null spam-report-gmane-regex)
		 (string-match spam-report-gmane-regex gnus-newsgroup-name)))
    (let ((rpt-host (if unspam "unspam.gmane.org" "spam.gmane.org")))
      (gnus-message 6 "Reporting article %d to %s..." article rpt-host)
      (cond
       ;; Special-case nnweb groups -- these have the URL to use in
       ;; the Xref headers.
       ((eq (car (gnus-find-method-for-group gnus-newsgroup-name)) 'nnweb)
	(spam-report-url-ping
	 rpt-host
	 (concat
	  "/"
	  (gnus-replace-in-string
	   (gnus-replace-in-string
	    (gnus-replace-in-string
	     (mail-header-xref (gnus-summary-article-header article))
	     "/raw" ":silent")
	    "^.*article.gmane.org/" "")
	   "/" ":"))))
       (spam-report-gmane-use-article-number
	(spam-report-url-ping
	 rpt-host
	 (format "/%s:%d"
		 (gnus-group-real-name gnus-newsgroup-name)
		 article)))
       (t
	(with-current-buffer nntp-server-buffer
	  (erase-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 "X-Report-Unspam")
			    (gnus-fetch-field "Archived-At")))
	    (if (not (stringp field))
		(if (and (setq field (gnus-fetch-field "Xref"))
			 (string-match "[^ ]+ +\\([^ ]+\\)" field))
		    (setq report (concat "/" (match-string 1 field))
			  host rpt-host))
	      (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 host
	      (when (string-equal "permalink.gmane.org" host)
		(setq host rpt-host)
		(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 article 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))

(defcustom spam-report-user-mail-address
  (and (stringp user-mail-address)
       (gnus-replace-in-string user-mail-address "@" "<at>"))
  "Mail address of this user used for spam reports to Gmane.
This is initialized based on `user-mail-address'."
  :type '(choice string
		 (const :tag "Don't expose address" nil))
  :version "23.0" ;; No Gnus
  :group 'spam-report)

(defvar spam-report-user-agent
  (if spam-report-user-mail-address
      (format "%s (%s) %s" "spam-report.el"
	      spam-report-user-mail-address
	      (gnus-extended-version))
    (format "%s %s" "spam-report.el"
	    (gnus-extended-version))))

(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\nHost: %s\n\n"
	       report spam-report-user-agent host))
      ;; Wait until we get something so we don't DOS the host. 
      (while (and (memq (process-status tcp-connection) '(open run))
		  (zerop (buffer-size)))
	(accept-process-output tcp-connection)))))

;;;###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://\\([^/]+\\)\\(/.*\\) *$" (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
d7a0267c	3	;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
23f87bed	4
01c52d31 MB	5	;; Author: Ted Zlatanov <tzz@lifelogs.com>
01c52d31 MB	6	;; Keywords: network, spam, mail, gmane, report
23f87bed MB	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
5a9dffec	12	;; the Free Software Foundation; either version 3, or (at your option)
23f87bed MB	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
01c52d31 MB	83	(defcustom spam-report-resend-to nil
	84	"Email address that spam articles are resent to when reporting.
	85	If not set, the user will be prompted to enter a value which will be
	86	saved for future use."
	87	:type 'string
	88	:group 'spam-report)
	89
61b397cd MB	90	(defvar spam-report-url-ping-temp-agent-function nil
	91	"Internal variable for `spam-report-agentize' and `spam-report-deagentize'.
	92	This variable will store the value of `spam-report-url-ping-function' from
	93	before `spam-report-agentize' was run, so that `spam-report-deagentize' can
	94	undo that change.")
	95
01c52d31 MB	96	(defun spam-report-resend (articles &optional ham)
	97	"Report an article as spam by resending via email.
	98	Reports is as ham when HAM is set."
	99	(dolist (article articles)
	100	(gnus-message 6
	101	"Reporting %s article %d to <%s>..."
	102	(if ham "ham" "spam")
	103	article spam-report-resend-to)
	104	(unless spam-report-resend-to
	105	(customize-set-variable
	106	spam-report-resend-to
	107	(read-from-minibuffer "email address to resend SPAM/HAM to? ")))
	108	;; This is ganked from the `gnus-summary-resend-message' function.
	109	;; It involves rendering the SPAM, which is undesirable, but there does
	110	;; not seem to be a nicer way to achieve this.
	111	;; select this particular article
	112	(gnus-summary-select-article nil nil nil article)
	113	;; resend it to the destination address
	114	(save-excursion
	115	(set-buffer gnus-original-article-buffer)
	116	(message-resend spam-report-resend-to))))
	117
	118	(defun spam-report-resend-ham (articles)
	119	"Report an article as ham by resending via email."
	120	(spam-report-resend articles t))
	121
	122	(defun spam-report-gmane-ham (&rest articles)
	123	"Report ARTICLES as ham (unregister) through Gmane."
	124	(interactive (gnus-summary-work-articles current-prefix-arg))
	125	(dolist (article articles)
	126	(spam-report-gmane-internal t article)))
	127
	128	(defun spam-report-gmane-spam (&rest articles)
	129	"Report ARTICLES as spam through Gmane."
	130	(interactive (gnus-summary-work-articles current-prefix-arg))
23f87bed	131	(dolist (article articles)
01c52d31 MB	132	(spam-report-gmane-internal nil article)))
	133
	134	;; `spam-report-gmane' was an interactive entry point, so we should provide an
	135	;; alias.
	136	(defalias 'spam-report-gmane 'spam-report-gmane-spam)
	137
	138	(defun spam-report-gmane-internal (unspam article)
	139	"Report ARTICLE as spam or not-spam through Gmane, depending on UNSPAM."
	140	(when (and gnus-newsgroup-name
	141	(or (null spam-report-gmane-regex)
	142	(string-match spam-report-gmane-regex gnus-newsgroup-name)))
	143	(let ((rpt-host (if unspam "unspam.gmane.org" "spam.gmane.org")))
	144	(gnus-message 6 "Reporting article %d to %s..." article rpt-host)
	145	(cond
	146	;; Special-case nnweb groups -- these have the URL to use in
	147	;; the Xref headers.
	148	((eq (car (gnus-find-method-for-group gnus-newsgroup-name)) 'nnweb)
	149	(spam-report-url-ping
	150	rpt-host
	151	(concat
	152	"/"
	153	(gnus-replace-in-string
	154	(gnus-replace-in-string
	155	(gnus-replace-in-string
	156	(mail-header-xref (gnus-summary-article-header article))
	157	"/raw" ":silent")
	158	"^.*article.gmane.org/" "")
	159	"/" ":"))))
	160	(spam-report-gmane-use-article-number
	161	(spam-report-url-ping
	162	rpt-host
	163	(format "/%s:%d"
	164	(gnus-group-real-name gnus-newsgroup-name)
	165	article)))
	166	(t
23f87bed	167	(with-current-buffer nntp-server-buffer
01c52d31	168	(erase-buffer)
23f87bed	169	(gnus-request-head article gnus-newsgroup-name)
d752cf53 MB	170	(let ((case-fold-search t)
	171	field host report url)
	172	;; First check for X-Report-Spam because it's more specific to
	173	;; spam reporting than Archived-At. OTOH, all new articles on
	174	;; Gmane don't have X-Report-Spam anymore (unless Lars changes his
	175	;; mind :-)).
	176	;;
	177	;; There might be more than one Archived-At header so we need to
	178	;; find (and transform) the one related to Gmane.
	179	(setq field (or (gnus-fetch-field "X-Report-Spam")
01c52d31	180	(gnus-fetch-field "X-Report-Unspam")
d752cf53	181	(gnus-fetch-field "Archived-At")))
01c52d31 MB	182	(if (not (stringp field))
	183	(if (and (setq field (gnus-fetch-field "Xref"))
	184	(string-match "[^ ]+ +\\([^ ]+\\)" field))
	185	(setq report (concat "/" (match-string 1 field))
	186	host rpt-host))
	187	(setq host
	188	(progn
	189	(string-match
	190	(concat "http://\\([a-z]+\\.gmane\\.org\\)"
	191	"\\(/[^:/]+[:/][0-9]+\\)")
	192	field)
	193	(match-string 1 field)))
	194	(setq report (match-string 2 field)))
	195	(when host
	196	(when (string-equal "permalink.gmane.org" host)
	197	(setq host rpt-host)
	198	(setq report (gnus-replace-in-string
	199	report "/\\([0-9]+\\)$" ":\\1")))
	200	(setq url (format "http://%s%s" host report)))
d752cf53 MB	201	(if (not (and host report url))
	202	(gnus-message
	203	3 "Could not find a spam report header in article %d..."
	204	article)
01c52d31 MB	205	(gnus-message 7 "Reporting article through URL %s..." url)
01c52d31 MB	206	(spam-report-url-ping host report)))))))))
23f87bed MB	207
	208	(defun spam-report-url-ping (host report)
	209	"Ping a host through HTTP, addressing a specific GET resource using
	210	the function specified by `spam-report-url-ping-function'."
d752cf53 MB	211	;; Example:
	212	;; host: "spam.gmane.org"
	213	;; report: "/gmane.some.group:123456"
23f87bed MB	214	(funcall spam-report-url-ping-function host report))
23f87bed MB	215
01c52d31 MB	216	(defcustom spam-report-user-mail-address
	217	(and (stringp user-mail-address)
	218	(gnus-replace-in-string user-mail-address "@" "<at>"))
	219	"Mail address of this user used for spam reports to Gmane.
	220	This is initialized based on `user-mail-address'."
	221	:type '(choice string
	222	(const :tag "Don't expose address" nil))
	223	:version "23.0" ;; No Gnus
	224	:group 'spam-report)
	225
	226	(defvar spam-report-user-agent
	227	(if spam-report-user-mail-address
	228	(format "%s (%s) %s" "spam-report.el"
	229	spam-report-user-mail-address
	230	(gnus-extended-version))
	231	(format "%s %s" "spam-report.el"
	232	(gnus-extended-version))))
	233
23f87bed MB	234	(defun spam-report-url-ping-plain (host report)
	235	"Ping a host through HTTP, addressing a specific GET resource."
	236	(let ((tcp-connection))
	237	(with-temp-buffer
	238	(or (setq tcp-connection
	239	(open-network-stream
	240	"URL ping"
	241	(buffer-name)
	242	host
	243	80))
	244	(error "Could not open connection to %s" host))
	245	(set-marker (process-mark tcp-connection) (point-min))
	246	(process-send-string
	247	tcp-connection
01c52d31 MB	248	(format "GET %s HTTP/1.1\nUser-Agent: %s\nHost: %s\n\n"
	249	report spam-report-user-agent host))
	250	;; Wait until we get something so we don't DOS the host.
	251	(while (and (memq (process-status tcp-connection) '(open run))
	252	(zerop (buffer-size)))
	253	(accept-process-output tcp-connection)))))
23f87bed	254
61b397cd MB	255	;;;###autoload
	256	(defun spam-report-process-queue (&optional file keep)
	257	"Report all queued requests from `spam-report-requests-file'.
	258
	259	If FILE is given, use it instead of `spam-report-requests-file'.
	260	If KEEP is t, leave old requests in the file. If KEEP is the
	261	symbol `ask', query before flushing the queue file."
	262	(interactive
	263	(list (read-file-name
	264	"File: "
	265	(file-name-directory spam-report-requests-file)
	266	spam-report-requests-file
	267	nil
	268	(file-name-nondirectory spam-report-requests-file))
	269	current-prefix-arg))
	270	(if (eq spam-report-url-ping-function 'spam-report-url-to-file)
	271	(error (concat "Cannot process requests when "
	272	"`spam-report-url-ping-function' is "
	273	"`spam-report-url-to-file'."))
	274	(gnus-message 7 "Processing requests using `%s'."
	275	spam-report-url-ping-function))
	276	(or file (setq file spam-report-requests-file))
	277	(save-excursion
	278	(set-buffer (find-file-noselect file))
	279	(goto-char (point-min))
	280	(while (and (not (eobp))
	281	(re-search-forward
01c52d31	282	"http://\\([^/]+\\)\\(/.\\) $" (point-at-eol) t))
61b397cd MB	283	(funcall spam-report-url-ping-function (match-string 1) (match-string 2))
	284	(forward-line 1))
	285	(if (or (eq keep nil)
	286	(and (eq keep 'ask)
	287	(y-or-n-p
	288	(format
	289	"Flush requests from `%s'? " (current-buffer)))))
	290	(progn
	291	(gnus-message 7 "Flushing request file `%s'"
	292	spam-report-requests-file)
	293	(erase-buffer)
	294	(save-buffer)
	295	(kill-buffer (current-buffer)))
	296	(gnus-message 7 "Keeping requests in `%s'" spam-report-requests-file))))
	297
	298	;;;###autoload
23f87bed MB	299	(defun spam-report-url-ping-mm-url (host report)
	300	"Ping a host through HTTP, addressing a specific GET resource. Use
	301	the external program specified in `mm-url-program' to connect to
	302	server."
	303	(with-temp-buffer
e9bd5782	304	(let ((url (format "http://%s%s" host report)))
23f87bed MB	305	(mm-url-insert url t))))
23f87bed MB	306
61b397cd MB	307	;;;###autoload
	308	(defun spam-report-url-to-file (host report)
	309	"Collect spam report requests in `spam-report-requests-file'.
	310	Customize `spam-report-url-ping-function' to use this function."
e9bd5782	311	(let ((url (format "http://%s%s" host report))
61b397cd MB	312	(file spam-report-requests-file))
	313	(gnus-make-directory (file-name-directory file))
	314	(gnus-message 9 "Writing URL `%s' to file `%s'" url file)
	315	(with-temp-buffer
	316	(insert url)
	317	(newline)
	318	(append-to-file (point-min) (point-max) file))))
	319
	320	;;;###autoload
	321	(defun spam-report-agentize ()
	322	"Add spam-report support to the Agent.
	323	Spam reports will be queued with \\[spam-report-url-to-file] when
	324	the Agent is unplugged, and will be submitted in a batch when the
	325	Agent is plugged."
	326	(interactive)
	327	(add-hook 'gnus-agent-plugged-hook 'spam-report-plug-agent)
	328	(add-hook 'gnus-agent-unplugged-hook 'spam-report-unplug-agent))
	329
	330	;;;###autoload
	331	(defun spam-report-deagentize ()
	332	"Remove spam-report support from the Agent.
	333	Spam reports will be queued with the method used when
	334	\\[spam-report-agentize] was run."
	335	(interactive)
	336	(remove-hook 'gnus-agent-plugged-hook 'spam-report-plug-agent)
	337	(remove-hook 'gnus-agent-unplugged-hook 'spam-report-unplug-agent))
	338
	339	(defun spam-report-plug-agent ()
	340	"Adjust spam report settings for plugged state.
	341	Process queued spam reports."
	342	;; Process the queue, unless the user only wanted to report to a file
	343	;; anyway.
	344	(unless (equal spam-report-url-ping-temp-agent-function
	345	'spam-report-url-to-file)
	346	(spam-report-process-queue))
	347	;; Set the reporting function, if we have memorized something otherwise,
	348	;; stick with plain URL reporting.
	349	(setq spam-report-url-ping-function
	350	(or spam-report-url-ping-temp-agent-function
	351	'spam-report-url-ping-plain)))
	352
	353	(defun spam-report-unplug-agent ()
	354	"Restore spam report settings for unplugged state."
	355	;; save the old value
	356	(setq spam-report-url-ping-temp-agent-function
	357	spam-report-url-ping-function)
	358	;; store all reports to file
	359	(setq spam-report-url-ping-function
	360	'spam-report-url-to-file))
	361
23f87bed MB	362	(provide 'spam-report)
	363
	364	;;; arch-tag: f6683295-ec89-4ab5-8803-8cc842293022
	365	;;; spam-report.el ends here.