;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993,
;; 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002,
-;; 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+;; 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; 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
+;; 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
(require 'nnoo)
(require 'gnus-util)
(require 'gnus)
+(require 'gnus-group) ;; gnus-group-name-charset
(nnoo-declare nntp)
- `nntp-open-via-rlogin-and-netcat',
- `nntp-open-via-telnet-and-telnet'.")
+(defvoo nntp-never-echoes-commands nil
+ "*Non-nil means the nntp server never echoes commands.
+It is reported that some nntps server doesn't echo commands. So, you
+may want to set this to non-nil in the method for such a server setting
+`nntp-open-connection-function' to `nntp-open-ssl-stream' for example.
+Note that the `nntp-open-connection-functions-never-echo-commands'
+variable overrides the nil value of this variable.")
+
+(defvoo nntp-open-connection-functions-never-echo-commands
+ '(nntp-open-network-stream)
+ "*List of functions that never echo commands.
+Add or set a function which you set to `nntp-open-connection-function'
+to this list if it does not echo commands. Note that a non-nil value
+of the `nntp-never-echoes-commands' variable overrides this variable.")
+
(defvoo nntp-pre-command nil
"*Pre-command to use with the various nntp-open-via-* methods.
This is where you would put \"runsocks\" or stuff like that.")
If the gap between two consecutive articles is bigger than this
variable, split the XOVER request into two requests.")
+(defvoo nntp-xref-number-is-evil nil
+ "*If non-nil, Gnus never trusts article numbers in the Xref header.
+Some news servers, e.g., ones running Diablo, run multiple engines
+having the same articles but article numbers are not kept synchronized
+between them. If you connect to such a server, set this to a non-nil
+value, and Gnus never uses article numbers (that appear in the Xref
+header and vary by which engine is chosen) to refer to articles.")
+
(defvoo nntp-prepare-server-hook nil
"*Hook run before a server is opened.
If can be used to set up a server remotely, for instance. Say you
(defvoo nntp-last-command nil)
(defvoo nntp-authinfo-password nil)
(defvoo nntp-authinfo-user nil)
+(defvoo nntp-authinfo-force nil)
(defvar nntp-connection-list nil)
nntp-server-buffer
wait-for nnheader-callback-function)
;; If nothing to wait for, still remove possibly echo'ed commands.
- ;; We don't have echos if nntp-open-connection-function
- ;; is `nntp-open-network-stream', so we skip this in that case.
+ ;; We don't have echoes if `nntp-never-echoes-commands' is non-nil
+ ;; or the value of `nntp-open-connection-function' is in
+ ;; `nntp-open-connection-functions-never-echo-commands', so we
+ ;; skip this in that cases.
(unless (or wait-for
- (equal nntp-open-connection-function
- 'nntp-open-network-stream))
+ nntp-never-echoes-commands
+ (memq
+ nntp-open-connection-function
+ nntp-open-connection-functions-never-echo-commands))
(nntp-accept-response)
(save-excursion
(set-buffer buffer)
(goto-char pos)
(if (looking-at (regexp-quote command))
(delete-region pos (progn (forward-line 1)
- (point-at-bol))))
- )))
+ (point-at-bol)))))))
(nnheader-report 'nntp "Couldn't open connection to %s."
nntp-address))))
.authinfo file has the FORCE token."
(let* ((list (netrc-parse nntp-authinfo-file))
(alist (netrc-machine list nntp-address "nntp"))
- (force (netrc-get alist "force"))
+ (force (or (netrc-get alist "force") nntp-authinfo-force))
(user (or (netrc-get alist "login") nntp-authinfo-user))
(passwd (netrc-get alist "password")))
(when (or (not send-if-force)
(funcall nntp-open-connection-function pbuffer))
(error nil)
(quit
- (message "Quit opening connection")
+ (message "Quit opening connection to %s" nntp-address)
(nntp-kill-buffer pbuffer)
(signal 'quit nil)
nil))))
;; article number. How... helpful.
(progn
(forward-line 1)
- (looking-at "[0-9]+\t...")) ; More text after number.
+ ;; More text after number, or a dot.
+ (looking-at "[0-9]+\t...\\|\\.\r?\n"))
(setq nntp-server-xover (car commands))))
(setq commands (cdr commands)))
;; If none of the commands worked, we disable XOVER.
(match-string 1 xref))
(t "")))
(cond
- ((and (setq xref (mail-fetch-field "xref"))
+ ((and (not nntp-xref-number-is-evil)
+ (setq xref (mail-fetch-field "xref"))
(string-match
(if group
(concat "\\(" (regexp-quote group) "\\):\\([0-9]+\\)")
(defun nntp-marks-directory (server)
(expand-file-name server nntp-marks-directory))
+(defvar nntp-server-to-method-cache nil
+ "Alist of servers and select methods.")
+
+(defun nntp-group-pathname (server group &optional file)
+ "Return an absolute file name of FILE for GROUP on SERVER."
+ (let ((method (cdr (assoc server nntp-server-to-method-cache))))
+ (unless method
+ (push (cons server (setq method (or (gnus-server-to-method server)
+ (gnus-find-method-for-group group))))
+ nntp-server-to-method-cache))
+ (nnmail-group-pathname
+ (mm-decode-coding-string group
+ (inline (gnus-group-name-charset method group)))
+ (nntp-marks-directory server)
+ file)))
+
(defun nntp-possibly-create-directory (group server)
- (let ((dir (nnmail-group-pathname
- group (nntp-marks-directory server))))
+ (let ((dir (nntp-group-pathname server group))
+ (file-name-coding-system nnmail-pathname-coding-system))
(unless (file-exists-p dir)
(make-directory (directory-file-name dir) t)
(nnheader-message 5 "Creating nntp marks directory %s" dir))))
(autoload 'time-less-p "time-date"))
(defun nntp-marks-changed-p (group server)
- (let ((file (expand-file-name
- nntp-marks-file-name
- (nnmail-group-pathname
- group (nntp-marks-directory server)))))
+ (let ((file (nntp-group-pathname server group nntp-marks-file-name))
+ (file-name-coding-system nnmail-pathname-coding-system))
(if (null (gnus-gethash file nntp-marks-modtime))
t ;; never looked at marks file, assume it has changed
(time-less-p (gnus-gethash file nntp-marks-modtime)
(defun nntp-save-marks (group server)
(let ((file-name-coding-system nnmail-pathname-coding-system)
- (file (expand-file-name
- nntp-marks-file-name
- (nnmail-group-pathname
- group (nntp-marks-directory server)))))
+ (file (nntp-group-pathname server group nntp-marks-file-name)))
(condition-case err
(progn
(nntp-possibly-create-directory group server)
(error "Cannot write to %s (%s)" file err))))))
(defun nntp-open-marks (group server)
- (let ((file (expand-file-name
- nntp-marks-file-name
- (nnmail-group-pathname
- group (nntp-marks-directory server)))))
+ (let ((file (nntp-group-pathname server group nntp-marks-file-name))
+ (file-name-coding-system nnmail-pathname-coding-system))
(if (file-exists-p file)
(condition-case err
(with-temp-buffer
(let ((info (gnus-get-info
(gnus-group-prefixed-name
group
- (gnus-server-to-method (format "nntp:%s" server))))))
- (nnheader-message 7 "Bootstrapping marks for %s..." group)
+ (gnus-server-to-method (format "nntp:%s" server)))))
+ (decoded-name (mm-decode-coding-string
+ group
+ (gnus-group-name-charset
+ (gnus-server-to-method server) group))))
+ (nnheader-message 7 "Bootstrapping marks for %s..." decoded-name)
(setq nntp-marks (gnus-info-marks info))
(push (cons 'read (gnus-info-read info)) nntp-marks)
(dolist (el gnus-article-unpropagated-mark-lists)
(setq nntp-marks (gnus-remassoc el nntp-marks)))
(nntp-save-marks group server)
- (nnheader-message 7 "Bootstrapping marks for %s...done" group)))))
+ (nnheader-message 7 "Bootstrapping marks for %s...done"
+ decoded-name)))))
(provide 'nntp)