;;; news2news.el --- a news to news gateway for GNU Emacs ;; Copyright (C) 2006, 2007 Katsumi Yamaoka ;; Author: Katsumi Yamaoka ;; Keywords: news, Gnus, rnews ;; This program 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. ;; This program 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 this program; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; *************************************************************** ;; ** Don't use this program to feed a huge amount of articles! ** ;; ** To do that, use the news server program, such as INN. ** ;; *************************************************************** ;; This program is used to feed news articles from foreign news servers ;; to the local news server, using Gnus and the rnews program. An easy ;; way to use it is to run this program as a cron job by an exclusive ;; user who reads only the foreign newsgroups where there are articles ;; you want to feed to the local newsgroups. The most eligible user ;; would be `news' who manages the local news server. Make sure Gnus ;; has been configured to enable that user to subscribe to the foreign ;; newsgroups with the "nntp+SERVER:GROUP" style, and there are ;; corresponding local groups in the local news server. ;; ;; Note that that user must not read articles in the foreign groups to ;; be fed using Gnus manually because this program feeds only unread ;; articles, or articles which have been read manually will not be fed. ;; You may do it if you use `Q' to quit all the summary buffers, though. ;; In addition, I strongly recommend you to catch up all the foreign ;; groups to feed (i.e., to mark all articles as read) in advance. ;; Here's an example to configure the .emacs file: ;; ;; (autoload 'news2news "news2news") ;; ;; (setq news2news-group-alist ;; '(("server1" ;; ("foreign_group" . "local_group") ;; ...) ;; ("server2" ;; ("foreign_group" . "local_group") ;; ...) ;; ...)) ;; ;; See the documentation of the `news2news-group-alist' variable for ;; details. ;; It might be useful to make `gnus-select-method' the `nnnil' back end ;; and to add something like the following to the .gnus.el file in order ;; to run the news2news process fast: ;; ;; (setq gnus-agent nil ;; gnus-large-newsgroup nil ;; gnus-read-newsrc-file nil ;; gnus-save-newsrc-file nil ;; gnus-show-threads nil) ;; ;; (if noninteractive ;; (setq gnus-article-decode-hook nil ;; gnus-check-new-newsgroups nil ;; gnus-display-mime-function nil)) ;; To check whether all will go well, type this command: ;; ;; emacs -batch -u news -f news2news ;; ;; I've tested it with Emacs 22. (Emacs 21 didn't work only if it was ;; run as a cron job for some unknown reason.) If the rnews command does ;; not work, check the `server:' entry in the inn.conf file, which should ;; be set to the host name of the news server (if you use the INN server). ;; Moreover the permission of the rnews file is significant. ;; To run this program as a cron job, add a crontab entry as follows: ;; ;; 0 * * * * emacs -batch -u news -f news2news ;; ;; Where the "-u news" option is needed to load the ~news/.emacs file ;; even if this crontab entry is owned by the user `news'. If it talks ;; too verbosely, try setting the `gnus-verbose' variable to 3 or less, ;; and the `gnus-verbose-backends' variable to 6 or less, and also try ;; setting the LC_CTYPE environment variable to C if necessary. You can ;; use the following for instance to achieve the latter one. ;; ;; 0 * * * * LC_CTYPE=C emacs -batch -u news -f news2news ;; ;; In addition to this, you might also need to prohibit from performing ;; `set-language-environment' (if any) in the .emacs file when the value ;; of the `noninteractive' variable is non-nil. ;; See the documentations of the following variables for further ;; information: ;; ;; `news2news-lock-file' ;; `news2news-local-distribution' ;; `news2news-group-alist' ;; `news2news-mail2news-alist' ;; `news2news-distribution-alist' ;; `news2news-distribution-precedence-list' ;; `news2news-filter-function' ;; `news2news-gnus-arguments' ;; `news2news-rnews-program' ;; `news2news-rnews-arguments' ;; `news2news-rnews-maximum-size' ;;; ChangeLog: ;; 2007-09-10 ;; (news2news-lock-file): New variable. ;; (news2news): Be controlled with it. ;; 2007-08-21 ;; (news2news-queue): Count canceled articles. ;; (news2news): Clarify echo messages. ;; 2007-08-07 ;; (news2news-mail2news-alist): Add bugs@quimby.gnus.org. ;; 2006-12-07 ;; (news2news): Don't access denied servers; close servers right ;; after fetching articles. ;; 2006-11-20 ;; (news2news-filter-function): Fix example usage. ;; 2006-11-13 ;; (news2news-queue): Make sure bodies aren't empty. ;; 2006-11-10 ;; (news2news-cancel-distribution): New variable. ;; (news2news-queue): Use it. ;; 2006-11-09 ;; (news2news-queue): make it issue cancel messages according to ;; `news2news-filter-function' and not modify control messages. ;; 2006-10-24 ;; (news2news-filter-function): Doc fix. ;; 2006-08-22 ;; (news2news): Silence the "Wrote ~/.newsrc.eld" message. ;; 2006-08-16 ;; (news2news): Don't issue needless messages. ;; 2006-07-31 ;; (news2news): Enable the distribution to be controled by groups ;; which are in the Newsgroups header and in ;; `news2news-distribution-alist' but not in `news2news-group-alist'. ;; 2006-07-28 ;; (news2news): Protect against the case where articles have been ;; canceled. ;; 2006-07-27 ;; (news2news): Use the local distribution to feed an article ;; whenever the Newsgroups header is modified. ;; 2006-07-18 ;; (news2news-destination): Cope with broken mail addresses. ;; 2006-06-20 ;; (news2news): Fix infloop. ;; 2006-06-19 ;; (news2news): Crosspost articles which have been sent to both ;; newsgroups and mailing lists to the groups which are gatewayed to ;; those mail addresses. ;; 2006-06-14 ;; (news2news): Reduce the number of times to run rnews. ;; 2006-06-13 ;; (news2news-filter-function): New variable. ;; (news2news-rnews-arguments): New variable. ;; 2006-06-12 ;; (news2news-post-article): Support crossposting. ;; 2006-06-09 ;; New file. ;;; Code: (defconst news2news-version "0.19") (require 'gnus-art) (defvar news2news-lock-file nil "*Name of a file used to prevent another `news2news' from running. If it is non-nil and a file with this name exists, `news2news' does nothing. Otherwise, news2news makes an empty file with this name, runs specified jobs, and removes it at the end.") (defvar news2news-local-distribution "local" "*Distribution name making articles be posted to only the local server. The value is used in the Distribution header when the Newsgroups header is modified (see also `news2news-group-alist').") (defvar news2news-cancel-distribution nil "*Default distribution name used to post cancel messages. It defaults to the value of `news2news-local-distribution'. The value \"world\" means to add no Distribution header to cancel messages. The distribution name used to a cancel message to be posted to GROUP is determined by the following procedure: \(let ((distribution (news2news-distribution GROUP))) (or (unless (string-equal distribution \"world\") distribution) news2news-cancel-distribution news2news-local-distribution)) See also `news2news-distribution-alist' and `news2news-filter-function', and consult the function definition of `news2news-queue'.") (defvar news2news-group-alist nil "*Alist of servers, foreign groups and corresponding local groups. The value looks like the following: \((\"SERVER-A\" (\"FOREIGN-GROUP-A1\" . \"LOCAL-GROUP-A1\") (\"FOREIGN-GROUP-B2\" . \"LOCAL-GROUP-A2\") ...) (\"SERVER-B\" (\"FOREIGN-GROUP-B1\" . \"LOCAL-GROUP-B1\") (\"FOREIGN-GROUP-B2\" . \"LOCAL-GROUP-B2\") ...) ...) For instance, articles posted to FOREIGN-GROUP-A1 in the SERVER-A will be fed to LOCAL-GROUP-A1 in the local server. If a local group portion is omitted, articles will be fed without changing the Newsgroups header. Exceptionally, if an article was crossposted to mailing lists gatewayed to newsgroups, they will be added to the Newsgroups header. The `news2news-mail2news-alist' variable specifies which mailing lists are gatewayed to which newsgroups. You can also specify the control groups, such as control.checkgroups, control.newgroup and control.rmgroup, as foreign groups. In that case, local group portions are ignored and articles are fed without modification. In any case where the Newsgroups header is modified, the Distribution header is added (or modified) with the value that the `news2news-local-distribution' variable specifies in order to deliver the article only to the local server. In that case, the value of the `news2news-distribution-alist' variable is ignored. Here is an example to set this variable: \(setq news2news-group-alist '(;; Feed articles from individual.net. (\"individual\" (\"fj.news.reader.gnus\") (\"gnu.emacs.gnus\")) ;; Feed articles from Gmane only to the local groups. (\"gmane\" (\"gmane.emacs.devel\" . \"local.emacs-devel\") (\"gmane.emacs.pretest.bugs\" . \"local.pretest-bugs\")) ;; Feed articles from quimby.gnus.org without crossposting. (\"quimby\" (\"gnus.cvslog\" . \"gnus.cvslog\") (\"gnus.ding\" . \"gnus.ding\")))) Make sure Gnus has already been configured to subscribe those foreign groups and corresponding local groups exist.") (defvar news2news-mail2news-alist '(("bugs@gnus.org" . ("gnus.gnus-bug")) ("bugs@quimby.gnus.org" . ("gnus.gnus-bug")) ("cvslog@quimby.gnus.org" . ("gmane.emacs.gnus.cvs" "gnus.cvslog")) ("ding-announce@gnus.org" . ("gmane.emacs.gnus.announce" "gnus.ding-announce")) ("ding-patches@gnus.org" . ("gmane.emacs.gnus.patches" "gnus.patches")) ("ding-patches@hawk.netfonds.no" . ("gmane.emacs.gnus.commits" "gnus.commits")) ("ding@gnus.org" . ("gmane.emacs.gnus.general" "gnus.ding")) ("emacs-commit@gnu.org" . ("gmane.emacs.cvs")) ("emacs-devel@gnu.org" . ("gmane.emacs.devel")) ("emacs-diffs@gnu.org" . ("gmane.emacs.diffs")) ("emacs-pretest-bug@gnu.org" . ("gmane.emacs.pretest.bugs")) ("emacs-w3m@namazu.org" . ("gmane.emacs.w3m")) ("gnupg-announce@gnupg.org" . ("gmane.comp.gnu.gnupg.users" "gmane.comp.encryption.gpg.user")) ("gnupg-users@gnupg.org" . ("gmane.comp.gnu.gnupg.users" "gmane.comp.encryption.gpg.user")) ("mh-e-devel@lists.sourceforge.net" . ("gmane.mail.mh-e.devel")) ("semi-gnus-ja@meadowy.org" . ("gmane.emacs.gnus.semi.japanese")) ("tramp-devel@gnu.org" . ("gmane.emacs.tramp")) ("wl-en@lists.airs.net" . ("gmane.mail.wanderlust.general" "gmane.mail.wanderlust.general.japanese")) ("wl@lists.airs.net" . ("gmane.mail.wanderlust.general.japanese")) ("xemacs-announce@xemacs.org" . ("gmane.emacs.xemacs.announce")) ("xemacs-beta@xemacs.org" . ("gmane.emacs.xemacs.beta")) ("xemacs-cvs@xemacs.org" . ("gmane.emacs.xemacs.cvs")) ("xemacs-design@xemacs.org" . ("gmane.emacs.xemacs.design")) ("xemacs-patches@xemacs.org" . ("gmane.emacs.xemacs.patches"))) "*Alist of mail addresses and lists of gatewayed newsgroups. News articles CC'd to the mailing list will be crossposted to the newsgroups in the local server that are gatewayed to the list.") (defvar news2news-distribution-alist `(("" . ,news2news-local-distribution)) "*Alist of regexps to match local group names and distributions. If the group to which articles are fed matches one of regexps, the Distribution header is added or modified with the associated value. The last element `(\"\" . \"DISTRIBUTION\")' specifies the default distribution. The value \"world\" means to add no Distribution header. If you use the values other than \"local\" for some groups, make sure the local server is configured not to deliver articles in those groups worldwide. Also note that the value of this variable is ignored when articles fetched from the control groups (e.g., control.checkgroups) are fed.") (defvar news2news-distribution-precedence-list '("world" "local") "*List of distribution names in the decreasing order of area. When crossposting an articles to groups of which the distributions are different, the narrowest one will be used.") (defvar news2news-filter-function nil "*Function run in the buffer containing a raw article. It takes two arguments GROUP and SEVER and should return a non-nil value if an article is worth to be posted to the local server. The return value `cancel' is special, which means to issue the control message to cancel the article only in the local news server. It is useful if unwanted news articles might be fed also from other news servers into the local news server. For example, the following function would be useful to block spam messages from being posted in the gmane.emacs.cvs group: \(setq news2news-filter-function (lambda (group server) (let ((subject (save-restriction (article-narrow-to-head) (message-fetch-field \"subject\")))) (cond ;; Reject messages of which the subjects don't begin ;; with \"emacs[ /]\" or \"Changes to emacs/\". ((string-equal group \"gmane.emacs.cvs\") (and subject (string-match \"\\\\`emacs[ /]\\\\|\\\\`Changes to emacs/\" subject))) (t t)))))") (defvar news2news-gnus-arguments nil "*List of arguments passed to the Lisp function `gnus'.") (defvar news2news-rnews-program "rnews" "*Program to post news.") (defvar news2news-rnews-arguments nil "*List of arguments passed to the rnews program.") (defvar news2news-rnews-maximum-size 1048576 "*Maximum size of articles that rnews posts at a time.") (defun news2news-distribution (group) "Return a ditribution used when posting articles to the local GROUP." (let ((alist news2news-distribution-alist) distribution) (while alist (if (string-match (caar alist) group) (setq distribution (cdar alist) alist nil) (setq alist (cdr alist)))) (or distribution "world"))) (defun news2news-distribution-narrow-p (dist-a dist-b) "Return t if DIST-A is narrower than DIST-B." (< (length (member dist-a news2news-distribution-precedence-list)) (length (member dist-b news2news-distribution-precedence-list)))) (defun news2news-destination (group ogroups odistribution &rest addresses) "Return a cons of local group(s) and a distribution according to GROUP. The second argument OGROUPS is comma-separated newsgroups to which the original article was posted, the third argument ODISTRIBUTION is a distribution which was specified then, and the remainder arguments ADDRESSES are mail addresses to which the original article was sent. The nil value in the result means it does not have to be changed." (setq ogroups (sort (delete "" (split-string ogroups "[ \f\t\n\r\v,]+")) 'string-lessp)) (let ((alist (apply 'append (mapcar 'cdr news2news-group-alist))) (groups (cons group (apply 'append (copy-sequence ogroups) (mapcar (lambda (recipient) (when (cadr recipient) (cdr (assoc (downcase (cadr recipient)) news2news-mail2news-alist)))) (mail-extract-address-components (mapconcat 'identity (delq nil addresses) ", ") t))))) elem igroups newsgroups distribution extra) (while groups (setq group (pop groups) groups (delete group groups) elem (assoc group alist)) (when elem (push (or (cdr elem) group) igroups)) (push (or (cdr elem) group) newsgroups)) (setq newsgroups (sort newsgroups 'string-lessp)) (if (equal newsgroups ogroups) (progn (setq distribution (or (car (sort (mapcar 'news2news-distribution igroups) 'news2news-distribution-narrow-p)) "world")) (setq extra (car (sort (let ((news2news-distribution-alist (butlast news2news-distribution-alist))) (mapcar 'news2news-distribution newsgroups)) 'news2news-distribution-narrow-p))) (when (news2news-distribution-narrow-p extra distribution) (setq distribution extra)) (unless (string-equal distribution (or odistribution "world")) (cons nil distribution))) (cons (mapconcat 'identity newsgroups ",") news2news-local-distribution)))) (defun news2news-queue (buffer queue group server canceled) "Add an article in BUFFER to QUEUE. GROUP and SERVER specifies the location the article has been gotten. The current buffer is expected to contain the raw article. CANCELED is increased by the number of canceled articles. Return t if queuing is successful." (let (estimation id subject distribution destination) (mm-with-unibyte-buffer (setq case-fold-search t) (insert-buffer-substring buffer) (setq estimation (if (functionp news2news-filter-function) (funcall news2news-filter-function group server) t)) (cond ((eq estimation 'cancel) (article-narrow-to-head) (unless (or (not (setq id (message-fetch-field "message-id"))) (assoc id (symbol-value queue))) (setq subject (message-fetch-field "subject") distribution (news2news-distribution group)) (setq distribution (or (unless (string-equal distribution "world") distribution) news2news-cancel-distribution news2news-local-distribution)) (widen) (erase-buffer) (insert "Path: not-for-mail\n" "From: " user-full-name " <" user-mail-address ">\n" "Newsgroups: " group "\n" (if (string-equal distribution "world") "" (concat "Distribution: " distribution "\n")) "Subject: Cancel -- " subject "\n" "Control: cancel " id "\n" "Date: " (message-make-date) "\n" "Message-ID: " (message-make-message-id) "\n\n") (set queue (cons (list id (buffer-size) (buffer-string)) (symbol-value queue))) (set canceled (1+ (symbol-value canceled))) nil)) (estimation (article-narrow-to-head) (unless (or (not (setq id (message-fetch-field "message-id"))) (assoc id (symbol-value queue))) (setq destination ;; Don't modify control messages. (unless (string-match "\\`control\\(?:\\'\\|\\.\\)" group) (news2news-destination group (or (message-fetch-field "newsgroups") group) (message-fetch-field "distribution") (mail-fetch-field "to" nil t) (mail-fetch-field "cc" nil t) (mail-fetch-field "original-to" nil t)))) (when (setq group (car destination)) (while (re-search-forward "^Newsgroups:" nil t) (replace-match "X-Original-\\&")) (goto-char (point-max)) (insert "Newsgroups: " group "\n")) (when (setq distribution (cdr destination)) (goto-char (point-min)) (while (re-search-forward "^Distribution:" nil t) (replace-match "X-Original-\\&")) (unless (string-equal distribution "world") (goto-char (point-max)) (insert "Distribution: " distribution "\n"))) (goto-char (point-min)) (while (re-search-forward "^Xref:[^\n]*\\(?:\n[\t ][^\t\n ]*\\)*\n" nil t) (delete-region (match-beginning 0) (match-end 0))) (goto-char (point-max)) (widen) ;; Make sure a body is not empty. (when (eobp) (insert "\n")) (goto-char (point-min)) (while (search-forward "\000" nil t) (replace-match "^@")) (set queue (cons (list id (buffer-size) (buffer-string)) (symbol-value queue))) t)))))) (defun news2news () "Feed articles in foreign servers to local groups." (when news2news-lock-file (when (file-exists-p news2news-lock-file) (error "\ Do nothing because another `news2news' seems to be running \(the lock file \"%s\" exists)." news2news-lock-file)) (condition-case code (write-region "" nil news2news-lock-file nil 'silent) (error (message "%s" (error-message-string code)))) (unless (file-exists-p news2news-lock-file) (error "Couldn't create the lock file \"%s\"" news2news-lock-file))) (apply 'gnus news2news-gnus-arguments) (let ((alist news2news-group-alist) (queue (make-symbol "news2news-queue")) (canceled (make-symbol "news2news-canceled")) (coding-system-for-write 'binary) (sum 0) server groups source destination articles total queued elem size) (set queue nil) (set canceled 0) (while alist (setq server (caar alist) groups (cdar alist) alist (cdr alist)) (while groups (setq source (concat "nntp+" server ":" (caar groups))) (if (eq (gnus-server-status (gnus-find-method-for-group source)) 'denied) (setq groups nil) (setq destination (or (cdar groups) (caar groups)) groups (cdr groups) articles (gnus-group-unread source)) (when (and (numberp articles) (> articles 0)) (setq total articles sum (+ sum total) queued 0) (unless noninteractive (gnus-message 3 "Fetching %d article%s from %s..." total (if (= total 1) "" "s") source)) (gnus-group-read-group nil nil source) ;; We will not be in the summary buffer if the articles have ;; been canceled. (when (eq major-mode 'gnus-summary-mode) (while (> articles 0) (when (news2news-queue gnus-original-article-buffer queue destination server canceled) (setq queued (1+ queued))) (if (zerop (setq articles (1- articles))) (gnus-summary-exit) ;; Prevent it from selecting the next unread group. (setq last-input-event nil) (gnus-summary-next-unread-article)))) (if (= queued total) (gnus-message 3 (if noninteractive "Fetching %d article%s from %s" "Fetching %d article%s from %s...done") queued (if (= queued 1) "" "s") source) (gnus-message 3 (if noninteractive "Fetching %d of %d article%s from %s" "Fetching %d of %d article%s from %s...done") queued total (if (= queued 1) "" "s") source))))) (gnus-close-server (gnus-find-method-for-group source))) (if noninteractive (let ((wr (symbol-function 'write-region))) (fset 'write-region (lambda (start end filename &optional append visit &rest args) (if (memq visit (list nil t)) (apply wr start end filename append 'silent args) (apply wr start end filename append visit args)))) (unwind-protect (gnus-group-exit) (fset 'write-region wr))) (let (gnus-interactive-exit) (gnus-group-exit))) (when (setq articles (nreverse (symbol-value queue))) (setq canceled (symbol-value canceled) queued (- (length articles) canceled) total 0) (mm-with-unibyte-buffer (unless noninteractive (cond ((zerop queued) (unless (zerop canceled) (gnus-message 3 "Canceling %d article%s using %s..." canceled (if (= canceled 1) "" "s") news2news-rnews-program))) ((zerop canceled) (unless (zerop queued) (gnus-message 3 "Feeding %d article%s into %s..." queued (if (= queued 1) "" "s") news2news-rnews-program))) (t (gnus-message 3 "\ Canceling %d article%s and feeding %d article%s into %s..." canceled (if (= canceled 1) "" "s") queued (if (= queued 1) "" "s") news2news-rnews-program)))) (while articles (setq elem (car articles) size (nth 1 elem)) (when (or (zerop total) (< (+ total size) news2news-rnews-maximum-size) (prog1 nil (setq total news2news-rnews-maximum-size))) (insert "#! rnews " (number-to-string size) "\n" (nth 2 elem)) (setq articles (cdr articles) total (+ total size))) (when (or (null articles) (>= total news2news-rnews-maximum-size)) (apply 'call-process-region (point-min) (point-max) news2news-rnews-program nil nil nil news2news-rnews-arguments) (erase-buffer) (setq total 0))) (cond ((zerop queued) (unless (zerop canceled) (gnus-message 3 "Canceling %d article%s using %s%s" canceled (if (= canceled 1) "" "s") news2news-rnews-program (if noninteractive "" "...done")))) ((zerop canceled) (unless (zerop queued) (gnus-message 3 "Feeding %d article%s into %s%s" queued (if (= queued 1) "" "s") news2news-rnews-program (if noninteractive "" "...done")))) (t (gnus-message 3 "\ Canceling %d article%s and feeding %d article%s into %s%s" canceled (if (= canceled 1) "" "s") queued (if (= queued 1) "" "s") news2news-rnews-program (if noninteractive "" "...done")))) (when noninteractive (cond ((zerop sum) (gnus-message 3 "No article has been fed")) ((> (setq sum (- sum queued canceled)) 0) (gnus-message 3 "\ %d article%s been rejected or may have already been canceled" sum (if (= sum 1) " has" "s have")))))))) (when news2news-lock-file (if (file-exists-p news2news-lock-file) (progn (condition-case code (delete-file news2news-lock-file) (error (gnus-message 1 "%s" (error-message-string code)))) (when (file-exists-p news2news-lock-file) (gnus-message 1 "Couldn't delete the lock file \"%s\"" news2news-lock-file))) (gnus-message 1 "\ The lock file \"%s\" seems to have been deleted by another `news2news'" news2news-lock-file)))) (provide 'news2news) ;;; news2news.el ends here