;;; Copyright (C) 1987-90,92-97 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Katsumi Yamaoka <yamaoka@jpl.org>
;; Keywords: news
;; This file is part of GNU Emacs.
(nnoo-declare nntp)
-(eval-and-compile
- (unless (fboundp 'open-network-stream)
- (require 'tcp)))
-
(eval-when-compile (require 'cl))
(defvoo nntp-address nil
(defvoo nntp-warn-about-losing-connection t
"*If non-nil, beep when a server closes connection.")
-(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.")
-
(defcustom nntp-authinfo-file "~/.authinfo"
".netrc-like file that holds nntp authinfo passwords."
:type
"*Number of seconds to wait before an nntp connection times out.
If this variable is nil, which is the default, no timers are set.")
+(defvoo nntp-prepare-post-hook nil
+ "*Hook run just before posting an article. It is supposed to be used for
+inserting Cancel-Lock headers, signing with Gpg, etc.")
+
;;; Internal variables.
(defvar nntp-record-commands nil
(nnheader-report 'nntp "Server closed connection"))
(t
(goto-char (point-max))
- (let ((limit (point-min)))
+ (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))))
+ (goto-char (point-max)))
+ (setq response (match-string 0))
+ (save-current-buffer
+ (set-buffer nntp-server-buffer)
+ (setq nntp-process-response response)))
(nntp-decode-text (not decode))
(unless discard
(save-excursion
(cond
;; A result that starts with a 2xx code is terminated by
;; a line with only a "." on it.
- ((eq (following-char) ?2)
+ ((eq (char-after) ?2)
(if (re-search-forward "\n\\.\r?\n" nil t)
t
nil))
(deffoo nntp-request-group (group &optional server dont-check)
(nntp-possibly-change-group nil server)
- (when (nntp-send-command "^21.*\n" "GROUP" group)
+ (when (nntp-send-command "^[245].*\n" "GROUP" group)
(let ((entry (nntp-find-connection-entry nntp-server-buffer)))
(setcar (cddr entry) group))))
(deffoo nntp-request-post (&optional server)
(nntp-possibly-change-group nil server)
(when (nntp-send-command "^[23].*\r?\n" "POST")
- (nntp-send-buffer "^[23].*\n")))
+ (let ((response (save-current-buffer
+ (set-buffer nntp-server-buffer)
+ nntp-process-response))
+ server-id)
+ (when (and response
+ (string-match "^[23].*\\(<[^\t\n @<>]+@[^\t\n @<>]+>\\)"
+ response))
+ (setq server-id (match-string 1 response))
+ (narrow-to-region (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (1- (point))
+ (point-max)))
+ (unless (mail-fetch-field "Message-ID")
+ (goto-char (point-min))
+ (insert "Message-ID: " server-id "\n"))
+ (widen))
+ (run-hooks 'nntp-prepare-post-hook)
+ (nntp-send-buffer "^[23].*\n"))))
(deffoo nntp-request-type (group article)
'news)
The authinfo login name is taken from the user's login name and the
password contained in '~/.nntp-authinfo'."
(when (file-exists-p "~/.nntp-authinfo")
- (with-temp-buffer
+ (nnheader-temp-write nil
(insert-file-contents "~/.nntp-authinfo")
(goto-char (point-min))
(nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name))
(kill-buffer ,pbuffer))))))
(process
(condition-case ()
- (let ((coding-system-for-read nntp-coding-system-for-read)
- (coding-system-for-write nntp-coding-system-for-write))
- (funcall nntp-open-connection-function pbuffer))
+ (funcall nntp-open-connection-function pbuffer)
(error nil)
(quit nil))))
(when timer
nil))))
(defun nntp-open-network-stream (buffer)
- (open-network-stream "nntpd" buffer nntp-address nntp-port-number))
+ (open-network-stream-as-binary
+ "nntpd" buffer nntp-address nntp-port-number))
(defun nntp-open-ssl-stream (buffer)
(let* ((ssl-program-arguments '("-connect" (concat host ":" service)))
(set-buffer (process-buffer (car entry)))
(erase-buffer)
(nntp-send-string (car entry) (concat "GROUP " group))
- (nntp-wait-for-string "^2.*\n")
+ ;; allow for unexpected responses, since this can be called
+ ;; from a timer with quit inhibited
+ (nntp-wait-for-string "^[245].*\n")
(setcar (cddr entry) group)
(erase-buffer))))))
(save-excursion
(set-buffer buffer)
(erase-buffer)
- (let ((proc (apply
- 'start-process
- "nntpd" buffer nntp-telnet-command nntp-telnet-switches))
+ (let ((proc (as-binary-process
+ (apply
+ 'start-process
+ "nntpd" buffer nntp-telnet-command nntp-telnet-switches)))
(case-fold-search t))
(when (memq (process-status proc) '(open run))
(process-send-string proc "set escape \^X\n")
(defun nntp-open-rlogin (buffer)
"Open a connection to SERVER using rsh."
(let ((proc (if nntp-rlogin-user-name
- (apply 'start-process
- "nntpd" buffer nntp-rlogin-program
- nntp-address "-l" nntp-rlogin-user-name
- nntp-rlogin-parameters)
- (apply 'start-process
- "nntpd" buffer nntp-rlogin-program nntp-address
- nntp-rlogin-parameters))))
+ (as-binary-process
+ (apply 'start-process
+ "nntpd" buffer nntp-rlogin-program
+ nntp-address "-l" nntp-rlogin-user-name
+ nntp-rlogin-parameters))
+ (as-binary-process
+ (apply 'start-process
+ "nntpd" buffer nntp-rlogin-program nntp-address
+ nntp-rlogin-parameters)))))
(save-excursion
(set-buffer buffer)
(nntp-wait-for-string "^\r*20[01]")
projects / elisp / gnus.git- / blobdiff