]> code.delx.au - gnu-emacs/blobdiff - lisp/gnus/nntp.el
Merge from gnus--devo--0
[gnu-emacs] / lisp / gnus / nntp.el
index f318ee303f0fa3662ff998b0b2fe5783fd9164d4..8a6c9a2d78aebacceeceaa7c609b481b8809a534 100644 (file)
@@ -2,27 +2,25 @@
 
 ;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993,
 ;;   1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002,
-;;   2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;;   2003, 2004, 2005, 2006, 2007, 2008, 2009 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 3, or (at your
-;; option) any later version.
+;; 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 of the License, 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.
+;; 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.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -38,6 +36,8 @@
 
 (eval-when-compile (require 'cl))
 
+(autoload 'auth-source-user-or-password "auth-source")
+
 (defgroup nntp nil
   "NNTP access for Gnus."
   :group 'gnus)
@@ -84,11 +84,12 @@ Direct connections:
 - `nntp-open-network-stream' (the default),
 - `nntp-open-ssl-stream',
 - `nntp-open-tls-stream',
+- `nntp-open-netcat-stream'.
 - `nntp-open-telnet-stream'.
 
 Indirect connections:
-- `nntp-open-via-rlogin-and-telnet',
 - `nntp-open-via-rlogin-and-netcat',
+- `nntp-open-via-rlogin-and-telnet',
 - `nntp-open-via-telnet-and-telnet'.")
 
 (defvoo nntp-never-echoes-commands nil
@@ -143,12 +144,13 @@ 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"
+(defvoo nntp-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.")
+This command is used by the `nntp-open-netcat-stream' and
+`nntp-open-via-rlogin-and-netcat' methods.")
 
-(defvoo nntp-via-netcat-switches nil
-  "*Switches given to the netcat command `nntp-via-netcat-command'.")
+(defvoo nntp-netcat-switches nil
+  "*Switches given to the netcat command `nntp-netcat-command'.")
 
 (defvoo nntp-via-user-name nil
   "*User name to log in on an intermediate host with.
@@ -1177,8 +1179,19 @@ If SEND-IF-FORCE, only send authinfo to the server if the
   (let* ((list (netrc-parse nntp-authinfo-file))
         (alist (netrc-machine list nntp-address "nntp"))
         (force (or (netrc-get alist "force") nntp-authinfo-force))
-        (user (or (netrc-get alist "login") nntp-authinfo-user))
-        (passwd (netrc-get alist "password")))
+        (auth-info 
+         (auth-source-user-or-password '("login" "password") nntp-address "nntp"))
+        (auth-user (nth 0 auth-info))
+        (auth-passwd (nth 1 auth-info))
+        (user (or
+               ;; this is preferred to netrc-*
+               auth-user
+               (netrc-get alist "login")
+               nntp-authinfo-user))
+        (passwd (or
+                 ;; this is preferred to netrc-*
+                 auth-passwd
+                 (netrc-get alist "password"))))
     (when (or (not send-if-force)
              force)
       (unless user
@@ -1292,10 +1305,9 @@ password contained in '~/.nntp-authinfo'."
 (defun nntp-open-network-stream (buffer)
   (open-network-stream "nntpd" buffer nntp-address nntp-port-number))
 
-(eval-and-compile
-  (autoload 'format-spec "format-spec")
-  (autoload 'format-spec-make "format-spec")
-  (autoload 'open-tls-stream "tls"))
+(autoload 'format-spec "format-spec")
+(autoload 'format-spec-make "format-spec")
+(autoload 'open-tls-stream "tls")
 
 (defun nntp-open-ssl-stream (buffer)
   (let* ((process-connection-type nil)
@@ -1801,9 +1813,21 @@ via telnet.")
 (defvoo nntp-telnet-passwd nil
   "Password to use to log in via telnet with.")
 
+(defun nntp-service-to-port (svc)
+  (cond
+   ((integerp svc) (number-to-string svc))
+   ((string-match "\\`[[:digit:]]\\'" svc) svc)
+   (t
+    (with-temp-buffer
+      (ignore-errors (insert-file-contents "/etc/services"))
+      (goto-char (point-min))
+      (if (re-search-forward (concat "^" (regexp-quote svc)
+                                     "[ \t]+\\([[:digit:]]+\\)/tcp"))
+          (match-string 1)
+        svc)))))
+
 (defun nntp-open-telnet (buffer)
-  (save-excursion
-    (set-buffer buffer)
+  (with-current-buffer buffer
     (erase-buffer)
     (let ((proc (apply
                 'start-process
@@ -1859,8 +1883,7 @@ via telnet.")
                (apply 'start-process
                       "nntpd" buffer nntp-rlogin-program nntp-address
                       nntp-rlogin-parameters))))
-    (save-excursion
-      (set-buffer buffer)
+    (with-current-buffer buffer
       (nntp-wait-for-string "^\r*20[01]")
       (beginning-of-line)
       (delete-region (point-min) (point))
@@ -1873,7 +1896,7 @@ via telnet.")
 
 (defun nntp-open-telnet-stream (buffer)
   "Open a nntp connection by telnet'ing the news server.
-`nntp-open-via-netcat' is recommended in place of this function
+`nntp-open-netcat-stream' is recommended in place of this function
 because it is more reliable.
 
 Please refer to the following variables to customize the connection:
@@ -1885,7 +1908,8 @@ Please refer to the following variables to customize the connection:
 - `nntp-end-of-line'."
   (let ((command `(,nntp-telnet-command
                   ,@nntp-telnet-switches
-                  ,nntp-address ,nntp-port-number))
+                  ,nntp-address
+                  ,(nntp-service-to-port nntp-port-number)))
        proc)
     (and nntp-pre-command
         (push nntp-pre-command command))
@@ -1928,8 +1952,9 @@ Please refer to the following variables to customize the connection:
     (setq proc (apply 'start-process "nntpd" buffer command))
     (with-current-buffer buffer
       (nntp-wait-for-string "^r?telnet")
-      (process-send-string proc (concat "open " nntp-address
-                                       " " nntp-port-number "\n"))
+      (process-send-string proc (concat "open " nntp-address " "
+                                       (nntp-service-to-port nntp-port-number)
+                                       "\n"))
       (nntp-wait-for-string "^\r*20[01]")
       (beginning-of-line)
       (delete-region (point-min) (point))
@@ -1954,24 +1979,46 @@ Please refer to the following variables to customize the connection:
 - `nntp-via-rlogin-command-switches',
 - `nntp-via-user-name',
 - `nntp-via-address',
-- `nntp-via-netcat-command',
-- `nntp-via-netcat-switches',
+- `nntp-netcat-command',
+- `nntp-netcat-switches',
 - `nntp-address',
-- `nntp-port-number',
-- `nntp-end-of-line'."
+- `nntp-port-number'."
   (let ((command `(,@(when nntp-pre-command
                       (list nntp-pre-command))
                   ,nntp-via-rlogin-command
-                  ,@(when nntp-via-rlogin-command-switches
-                      nntp-via-rlogin-command-switches)
+                  ,@nntp-via-rlogin-command-switches
                   ,@(when nntp-via-user-name
                       (list "-l" nntp-via-user-name))
                   ,nntp-via-address
-                  ,nntp-via-netcat-command
-                  ,@nntp-via-netcat-switches
+                  ,nntp-netcat-command
+                  ,@nntp-netcat-switches
                   ,nntp-address
-                  ,nntp-port-number)))
-    (apply 'start-process "nntpd" buffer command)))
+                  ,(nntp-service-to-port nntp-port-number))))
+    ;; A non-nil connection type results in mightily odd behavior where
+    ;; (process-send-string proc "\^M") ends up sending a "\n" to the
+    ;; ssh process.  --Stef
+    ;; Also a nil connection allow ssh-askpass to work under X11.
+    (let ((process-connection-type nil))
+      (apply 'start-process "nntpd" buffer command))))
+
+(defun nntp-open-netcat-stream (buffer)
+  "Open a connection to an nntp server through netcat.
+I.e. use the `nc' command rather than Emacs's builtin networking code.
+
+Please refer to the following variables to customize the connection:
+- `nntp-pre-command',
+- `nntp-netcat-command',
+- `nntp-netcat-switches',
+- `nntp-address',
+- `nntp-port-number'."
+  (let ((command `(,nntp-netcat-command
+                  ,@nntp-netcat-switches
+                   ,nntp-address
+                   ,(nntp-service-to-port nntp-port-number))))
+    (and nntp-pre-command (push nntp-pre-command command))
+    (let ((process-connection-type nil)) ;See `nntp-open-via-rlogin-and-netcat'.
+      (apply 'start-process "nntpd" buffer command))))
 
 (defun nntp-open-via-telnet-and-telnet (buffer)
   "Open a connection to an nntp server through an intermediate host.
@@ -2029,7 +2076,7 @@ Please refer to the following variables to customize the connection:
                                     ,nntp-telnet-command
                                     ,@nntp-telnet-switches
                                     ,nntp-address
-                                    ,nntp-port-number)))
+                                    ,(nntp-service-to-port nntp-port-number))))
          (process-send-string proc
                               (concat (mapconcat 'identity
                                                  real-telnet-command " ")
@@ -2075,8 +2122,7 @@ Please refer to the following variables to customize the connection:
       (make-directory (directory-file-name dir) t)
       (nnheader-message 5 "Creating nntp marks directory %s" dir))))
 
-(eval-and-compile
-  (autoload 'time-less-p "time-date"))
+(autoload 'time-less-p "time-date")
 
 (defun nntp-marks-changed-p (group server)
   (let ((file (nntp-group-pathname server group nntp-marks-file-name))