[gnus] / lisp / nntp.el

;;; nntp.el --- nntp access for Gnus

;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993,
;;   1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002,
;;   2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.

;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news

;; 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, 51 Franklin Street, Fifth Floor, Boston,
;; MA 02110-1301, USA.

;;; Commentary:

;;; Code:

(require 'nnheader)
(require 'nnoo)
(require 'gnus-util)
(require 'gnus)

(nnoo-declare nntp)

(eval-when-compile (require 'cl))

(defgroup nntp nil
  "NNTP access for Gnus."
  :group 'gnus)

(defvoo nntp-address nil
  "Address of the physical nntp server.")

(defvoo nntp-port-number "nntp"
  "Port number on the physical nntp server.")

(defvoo nntp-server-opened-hook '(nntp-send-mode-reader)
  "*Hook used for sending commands to the server at startup.
The default value is `nntp-send-mode-reader', which makes an innd
server spawn an nnrpd server.")

(defvoo nntp-authinfo-function 'nntp-send-authinfo
  "Function used to send AUTHINFO to the server.
It is called with no parameters.")

(defvoo nntp-server-action-alist
    '(("nntpd 1\\.5\\.11t"
       (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader))
      ("NNRP server Netscape"
       (setq nntp-server-list-active-group nil)))
  "Alist of regexps to match on server types and actions to be taken.
For instance, if you want Gnus to beep every time you connect
to innd, you could say something like:

\(setq nntp-server-action-alist
       '((\"innd\" (ding))))

You probably don't want to do that, though.")

(defvoo nntp-open-connection-function 'nntp-open-network-stream
  "*Function used for connecting to a remote system.
It will be called with the buffer to output in as argument.

Currently, five such functions are provided (please refer to their
respective doc string for more information), three of them establishing
direct connections to the nntp server, and two of them using an indirect
host.

Direct connections:
- `nntp-open-network-stream' (the default),
- `nntp-open-ssl-stream',
- `nntp-open-tls-stream',
- `nntp-open-telnet-stream'.

Indirect connections:
- `nntp-open-via-rlogin-and-telnet',
- `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.")

(defvoo nntp-telnet-command "telnet"
  "*Telnet command used to connect to the nntp server.
This command is used by the methods `nntp-open-telnet-stream',
`nntp-open-via-rlogin-and-telnet' and `nntp-open-via-telnet-and-telnet'.")

(defvoo nntp-telnet-switches '("-8")
  "*Switches given to the telnet command `nntp-telnet-command'.")

(defvoo nntp-end-of-line "\r\n"
  "*String to use on the end of lines when talking to the NNTP server.
This is \"\\r\\n\" by default, but should be \"\\n\" when using an indirect
connection method (nntp-open-via-*).")

(defvoo nntp-via-rlogin-command "rsh"
  "*Rlogin command used to connect to an intermediate host.
This command is used by the methods `nntp-open-via-rlogin-and-telnet'
and `nntp-open-via-rlogin-and-netcat'.  The default is \"rsh\", but \"ssh\"
is a popular alternative.")

(defvoo nntp-via-rlogin-command-switches nil
  "*Switches given to the rlogin command `nntp-via-rlogin-command'.
If you use \"ssh\" for `nntp-via-rlogin-command', you may set this to
\(\"-C\") in order to compress all data connections, otherwise set this
to \(\"-t\" \"-e\" \"none\") or (\"-C\" \"-t\" \"-e\" \"none\") if the telnet
command requires a pseudo-tty allocation on an intermediate host.")

(defvoo nntp-via-telnet-command "telnet"
  "*Telnet command used to connect to an intermediate host.
This command is used by the `nntp-open-via-telnet-and-telnet' method.")

(defvoo nntp-via-telnet-switches '("-8")
  "*Switches given to the telnet command `nntp-via-telnet-command'.")

(defvoo nntp-via-netcat-command "nc"
  "*Netcat command used to connect to the nntp server.
This command is used by the `nntp-open-via-rlogin-and-netcat' method.")

(defvoo nntp-via-netcat-switches nil
  "*Switches given to the netcat command `nntp-via-netcat-command'.")

(defvoo nntp-via-user-name nil
  "*User name to log in on an intermediate host with.
This variable is used by the various nntp-open-via-* methods.")

(defvoo nntp-via-user-password nil
  "*Password to use to log in on an intermediate host with.
This variable is used by the `nntp-open-via-telnet-and-telnet' method.")

(defvoo nntp-via-address nil
  "*Address of an intermediate host to connect to.
This variable is used by the various nntp-open-via-* methods.")

(defvoo nntp-via-envuser nil
  "*Whether both telnet client and server support the ENVIRON option.
If non-nil, there will be no prompt for a login name.")

(defvoo nntp-via-shell-prompt "bash\\|\$ *\r?$\\|> *\r?"
  "*Regular expression to match the shell prompt on an intermediate host.
This variable is used by the `nntp-open-via-telnet-and-telnet' method.")

(defvoo nntp-large-newsgroup 50
  "*The number of articles which indicates a large newsgroup.
If the number of articles is greater than the value, verbose
messages will be shown to indicate the current status.")

(defvoo nntp-maximum-request 400
  "*The maximum number of the requests sent to the NNTP server at one time.
If Emacs hangs up while retrieving headers, set the variable to a
lower value.")

(defvoo nntp-nov-is-evil nil
  "*If non-nil, nntp will never attempt to use XOVER when talking to the server.")

(defvoo nntp-xover-commands '("XOVER" "XOVERVIEW")
  "*List of strings that are used as commands to fetch NOV lines from a server.
The strings are tried in turn until a positive response is gotten.  If
none of the commands are successful, nntp will just grab headers one
by one.")

(defvoo nntp-nov-gap 5
  "*Maximum allowed gap between two articles.
If the gap between two consecutive articles is bigger than this
variable, split the XOVER request into two requests.")

(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
have an account at the machine \"other.machine\".  This machine has
access to an NNTP server that you can't access locally.  You could
then use this hook to rsh to the remote machine and start a proxy NNTP
server there that you can connect to.  See also
`nntp-open-connection-function'")

(defvoo nntp-coding-system-for-read 'binary
  "*Coding system to read from NNTP.")

(defvoo nntp-coding-system-for-write 'binary
  "*Coding system to write to NNTP.")

;; Marks
(defvoo nntp-marks-is-evil nil
  "*If non-nil, Gnus will never generate and use marks file for nntp groups.
See `nnml-marks-is-evil' for more information.")

(defvoo nntp-marks-file-name ".marks")
(defvoo nntp-marks nil)
(defvar nntp-marks-modtime (gnus-make-hashtable))

(defcustom nntp-marks-directory
  (nnheader-concat gnus-directory "marks/")
  "*The directory where marks for nntp groups will be stored."
  :group 'nntp
  :type 'directory)

(defcustom nntp-authinfo-file "~/.authinfo"
  ".netrc-like file that holds nntp authinfo passwords."
  :group 'nntp
  :type
  '(choice file
           (repeat :tag "Entries"
                   :menu-tag "Inline"
                   (list :format "%v"
                         :value ("" ("login" . "") ("password" . ""))
                         (string :tag "Host")
                         (checklist :inline t
                                    (cons :format "%v"
                                          (const :format "" "login")
                                          (string :format "Login: %v"))
                                    (cons :format "%v"
                                          (const :format "" "password")
                                          (string :format "Password: %v")))))))

\f

(defvoo nntp-connection-timeout nil
  "*Number of seconds to wait before an nntp connection times out.
If this variable is nil, which is the default, no timers are set.
NOTE: This variable is never seen to work in Emacs 20 and XEmacs 21.")

(defvoo nntp-prepare-post-hook nil
  "*Hook run just before posting an article.  It is supposed to be used
to insert Cancel-Lock headers.")

;;; Internal variables.

(defvar nntp-record-commands nil
  "*If non-nil, nntp will record all commands in the \"*nntp-log*\" buffer.")

(defvar nntp-have-messaged nil)

(defvar nntp-process-wait-for nil)
(defvar nntp-process-to-buffer nil)
(defvar nntp-process-callback nil)
(defvar nntp-process-decode nil)
(defvar nntp-process-start-point nil)
(defvar nntp-inside-change-function nil)
(defvoo nntp-last-command-time nil)
(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)

(defvoo nntp-server-type nil)
(defvoo nntp-connection-alist nil)
(defvoo nntp-status-string "")
(defconst nntp-version "nntp 5.0")
(defvoo nntp-inhibit-erase nil)
(defvoo nntp-inhibit-output nil)

(defvoo nntp-server-xover 'try)
(defvoo nntp-server-list-active-group 'try)

(defvar nntp-async-needs-kluge
  (string-match "^GNU Emacs 20\\.3\\." (emacs-version))
  "*When non-nil, nntp will poll asynchronous connections
once a second.  By default, this is turned on only for Emacs
20.3, which has a bug that breaks nntp's normal method of
noticing asynchronous data.")

(defvar nntp-async-timer nil)
(defvar nntp-async-process-list nil)

(defvar nntp-ssl-program
  "openssl s_client -quiet -ssl3 -connect %s:%p"
"A string containing commands for SSL connections.
Within a string, %s is replaced with the server address and %p with
port number on server.  The program should accept IMAP commands on
stdin and return responses to stdout.")

(defvar nntp-authinfo-rejected nil
"A custom error condition used to report 'Authentication Rejected' errors.  
Condition handlers that match just this condition ensure that the nntp 
backend doesn't catch this error.")
(put 'nntp-authinfo-rejected 'error-conditions '(error nntp-authinfo-rejected))
(put 'nntp-authinfo-rejected 'error-message "Authorization Rejected")

\f

;;; Internal functions.

(defsubst nntp-send-string (process string)
  "Send STRING to PROCESS."
  ;; We need to store the time to provide timeouts, and
  ;; to store the command so the we can replay the command
  ;; if the server gives us an AUTHINFO challenge.
  (setq nntp-last-command-time (current-time)
        nntp-last-command string)
  (when nntp-record-commands
    (nntp-record-command string))
  (process-send-string process (concat string nntp-end-of-line))
  (or (memq (process-status process) '(open run))
      (nntp-report "Server closed connection")))

(defun nntp-record-command (string)
  "Record the command STRING."
  (save-excursion
    (set-buffer (get-buffer-create "*nntp-log*"))
    (goto-char (point-max))
    (let ((time (current-time)))
      (insert (format-time-string "%Y%m%dT%H%M%S" time)
              "." (format "%03d" (/ (nth 2 time) 1000))
              " " nntp-address " " string "\n"))))

(defun nntp-report (&rest args)
  "Report an error from the nntp backend.  The first string in ARGS
can be a format string.  For some commands, the failed command may be
retried once before actually displaying the error report."

  (when nntp-record-commands
    (nntp-record-command "*** CALLED nntp-report ***"))

  (nnheader-report 'nntp args)

  (apply 'error args))

(defun nntp-report-1 (&rest args)
  "Throws out to nntp-with-open-group-error so that the connection may
be restored and the command retried."

  (when nntp-record-commands
    (nntp-record-command "*** CONNECTION LOST ***"))

  (throw 'nntp-with-open-group-error t))

(defsubst nntp-wait-for (process wait-for buffer &optional decode discard)
  "Wait for WAIT-FOR to arrive from PROCESS."

  (save-excursion
    (set-buffer (process-buffer process))
    (goto-char (point-min))

    (while (and (or (not (memq (char-after (point)) '(?2 ?3 ?4 ?5)))
                    (looking-at "48[02]"))
                (memq (process-status process) '(open run)))
      (cond ((looking-at "480")
             (nntp-handle-authinfo process))
            ((looking-at "482")
             (nnheader-report 'nntp (get 'nntp-authinfo-rejected 'error-message))
             (signal 'nntp-authinfo-rejected nil))
            ((looking-at "^.*\n")
             (delete-region (point) (progn (forward-line 1) (point)))))
      (nntp-accept-process-output process)
      (goto-char (point-min)))
    (prog1
        (cond
         ((looking-at "[45]")
          (progn
            (nntp-snarf-error-message)
            nil))
         ((not (memq (process-status process) '(open run)))
          (nntp-report "Server closed connection"))
         (t
          (goto-char (point-max))
          (let ((limit (point-min))
                response)
            (while (not (re-search-backward wait-for limit t))
              (nntp-accept-process-output process)
              ;; We assume that whatever we wait for is less than 1000
              ;; characters long.
              (setq limit (max (- (point-max) 1000) (point-min)))
              (goto-char (point-max)))
            (setq response (match-string 0))
            (with-current-buffer nntp-server-buffer
              (setq nntp-process-response response)))
          (nntp-decode-text (not decode))
          (unless discard
            (save-excursion
              (set-buffer buffer)
              (goto-char (point-max))
              (insert-buffer-substring (process-buffer process))
              ;; Nix out "nntp reading...." message.
              (when nntp-have-messaged
                (setq nntp-have-messaged nil)
                (nnheader-message 5 ""))))
          t))
      (unless discard
        (erase-buffer)))))

(defun nntp-kill-buffer (buffer)
  (when (buffer-name buffer)
    (kill-buffer buffer)
    (nnheader-init-server-buffer)))

(defun nntp-erase-buffer (buffer)
  "Erase contents of BUFFER."
  (with-current-buffer buffer
    (erase-buffer)))

(defsubst nntp-find-connection (buffer)
  "Find the connection delivering to BUFFER."
  (let ((alist nntp-connection-alist)
        (buffer (if (stringp buffer) (get-buffer buffer) buffer))
        process entry)
    (while (and alist (setq entry (pop alist)))
      (when (eq buffer (cadr entry))
        (setq process (car entry)
              alist nil)))
    (when process
      (if (memq (process-status process) '(open run))
          process
        (nntp-kill-buffer (process-buffer process))
        (setq nntp-connection-alist (delq entry nntp-connection-alist))