X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnntp.el;h=a8ffc6576cafef4b094f2c77bee43d93b57b1e89;hb=cc52ad34d2922b013fd8026d0728617261979da6;hp=66a6365cb3bd20b859b9042aba9023ac35558c08;hpb=5b15466c9e3335702597014ca6b8c3d7436f7a7f;p=gnus diff --git a/lisp/nntp.el b/lisp/nntp.el index 66a6365cb..a8ffc6576 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -27,13 +27,16 @@ ;; For Emacs <22.2 and XEmacs. (eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) + (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))) + ;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for + ;; `make-network-stream'. + (unless (fboundp 'open-protocol-stream) + (require 'proto-stream))) (require 'nnheader) (require 'nnoo) (require 'gnus-util) (require 'gnus) -(require 'proto-stream) (require 'gnus-group) ;; gnus-group-name-charset (nnoo-declare nntp) @@ -76,27 +79,27 @@ to innd, you could say something like: 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), -- `network-only' (the same as the above, but don't do automatic - STARTTLS upgrades). -- `nntp-open-ssl-stream', -- `nntp-open-tls-stream', -- `nntp-open-netcat-stream'. -- `nntp-open-telnet-stream'. - -Indirect connections: -- `nntp-open-via-rlogin-and-netcat', -- `nntp-open-via-rlogin-and-telnet', -- `nntp-open-via-telnet-and-telnet'.") + "Method for connecting to a remote system. +It should be a function, which is called with the output buffer +as its single argument, or one of the following special values: + +- `nntp-open-network-stream' specifies a network connection, + upgrading to a TLS connection via STARTTLS if possible. +- `nntp-open-plain-stream' specifies an unencrypted network + connection (no STARTTLS upgrade is attempted). +- `nntp-open-ssl-stream' or `nntp-open-tls-stream' specify a TLS + network connection. + +Apart from the above special values, valid functions are as +follows; please refer to their respective doc string for more +information. +For direct connections: +- `nntp-open-netcat-stream' +- `nntp-open-telnet-stream' +For indirect connections: +- `nntp-open-via-rlogin-and-netcat' +- `nntp-open-via-rlogin-and-telnet' +- `nntp-open-via-telnet-and-telnet'") (defvoo nntp-never-echoes-commands nil "*Non-nil means the nntp server never echoes commands. @@ -361,19 +364,6 @@ be restored and the command retried." (throw 'nntp-with-open-group-error t)) -(defmacro nntp-insert-buffer-substring (buffer &optional start end) - "Copy string from unibyte buffer to multibyte current buffer." - (if (featurep 'xemacs) - `(insert-buffer-substring ,buffer ,start ,end) - `(if enable-multibyte-characters - (insert (with-current-buffer ,buffer - (mm-string-to-multibyte - ,(if (or start end) - `(buffer-substring (or ,start (point-min)) - (or ,end (point-max))) - '(buffer-string))))) - (insert-buffer-substring ,buffer ,start ,end)))) - (defmacro nntp-copy-to-buffer (buffer start end) "Copy string from unibyte current buffer to multibyte buffer." (if (featurep 'xemacs) @@ -431,7 +421,7 @@ be restored and the command retried." (unless discard (with-current-buffer buffer (goto-char (point-max)) - (nntp-insert-buffer-substring (process-buffer process)) + (nnheader-insert-buffer-substring (process-buffer process)) ;; Nix out "nntp reading...." message. (when nntp-have-messaged (setq nntp-have-messaged nil) @@ -993,7 +983,7 @@ command whose response triggered the error." (narrow-to-region (setq point (goto-char (point-max))) (progn - (nntp-insert-buffer-substring buf last-point (cdr entry)) + (nnheader-insert-buffer-substring buf last-point (cdr entry)) (point-max))) (setq last-point (cdr entry)) (nntp-decode-text) @@ -1025,16 +1015,15 @@ command whose response triggered the error." (deffoo nntp-request-article (article &optional group server buffer command) (nntp-with-open-group - group server + group server (when (nntp-send-command-and-decode "\r?\n\\.\r?\n" "ARTICLE" (if (numberp article) (int-to-string article) article)) - (if (and buffer - (not (equal buffer nntp-server-buffer))) - (with-current-buffer nntp-server-buffer - (copy-to-buffer buffer (point-min) (point-max)) - (nntp-find-group-and-number group)) - (nntp-find-group-and-number group))))) + (when (and buffer + (not (equal buffer nntp-server-buffer))) + (with-current-buffer nntp-server-buffer + (copy-to-buffer buffer (point-min) (point-max)))) + (nntp-find-group-and-number group)))) (deffoo nntp-request-head (article &optional group server) (nntp-with-open-group @@ -1238,17 +1227,20 @@ If SEND-IF-FORCE, only send authinfo to the server if the (require 'netrc) (let* ((list (netrc-parse nntp-authinfo-file)) (alist (netrc-machine list nntp-address "nntp")) - (force (or (netrc-get alist "force") nntp-authinfo-force)) (auth-info (nth 0 (auth-source-search :max 1 ;; TODO: allow the virtual server name too :host nntp-address :port '("119" "nntp")))) (auth-user (plist-get auth-info :user)) + (auth-force (plist-get auth-info :force)) (auth-passwd (plist-get auth-info :secret)) (auth-passwd (if (functionp auth-passwd) (funcall auth-passwd) auth-passwd)) + (force (or (netrc-get alist "force") + nntp-authinfo-force + auth-force)) (user (or ;; this is preferred to netrc-* auth-user @@ -1340,25 +1332,25 @@ password contained in '~/.nntp-authinfo'." (let ((coding-system-for-read nntp-coding-system-for-read) (coding-system-for-write nntp-coding-system-for-write) (map '((nntp-open-network-stream network) - (network-only network-only) + (network-only plain) ; compat + (nntp-open-plain-stream plain) (nntp-open-ssl-stream tls) (nntp-open-tls-stream tls)))) (if (assoc nntp-open-connection-function map) - (car (open-protocol-stream - "nntpd" pbuffer nntp-address nntp-port-number - :type (cadr - (assoc nntp-open-connection-function map)) - :end-of-command "^\\([2345]\\|[.]\\).*\n" - :capability-command "CAPABILITIES\r\n" - :success "^3" - :starttls-function - (lambda (capabilities) - (if (not (string-match "STARTTLS" capabilities)) - nil - "STARTTLS\r\n")))) + (open-protocol-stream + "nntpd" pbuffer nntp-address nntp-port-number + :type (cadr (assoc nntp-open-connection-function map)) + :end-of-command "^\\([2345]\\|[.]\\).*\n" + :capability-command "CAPABILITIES\r\n" + :success "^3" + :starttls-function + (lambda (capabilities) + (if (not (string-match "STARTTLS" capabilities)) + nil + "STARTTLS\r\n"))) (funcall nntp-open-connection-function pbuffer))) (error - (nnheader-report 'nntp "%s" err)) + (nnheader-report 'nntp ">>> %s" err)) (quit (message "Quit opening connection to %s" nntp-address) (nntp-kill-buffer pbuffer) @@ -1366,10 +1358,19 @@ password contained in '~/.nntp-authinfo'." nil)))) (when timer (nnheader-cancel-timer timer)) + (when (and process + (not (memq (process-status process) '(open run)))) + (setq process nil)) (unless process (nntp-kill-buffer pbuffer)) (when (and (buffer-name pbuffer) process) + (when (and (fboundp 'set-network-process-option) ;; Unavailable in XEmacs. + (fboundp 'process-type) ;; Emacs 22 doesn't provide it. + (eq (process-type process) 'network)) + ;; Use TCP-keepalive so that connections that pass through a NAT router + ;; don't hang when left idle. + (set-network-process-option process :keepalive t)) (gnus-set-process-query-on-exit-flag process nil) (if (and (nntp-wait-for process "^2.*\n" buffer nil t) (memq (process-status process) '(open run))) @@ -1467,7 +1468,7 @@ password contained in '~/.nntp-authinfo'." (goto-char (point-max)) (save-restriction (narrow-to-region (point) (point)) - (nntp-insert-buffer-substring buf start) + (nnheader-insert-buffer-substring buf start) (when decode (nntp-decode-text)))))) ;; report it. @@ -1695,7 +1696,7 @@ password contained in '~/.nntp-authinfo'." (when in-process-buffer-p (set-buffer buf) (goto-char (point-max)) - (nntp-insert-buffer-substring process-buffer) + (nnheader-insert-buffer-substring process-buffer) (set-buffer process-buffer) (erase-buffer) (set-buffer buf))