popovich@park.cs.columbia.edu (Steve Popovich) (03/13/89)
This message applies to GNUS version 3.11.
There is a bug in nntp-retrieve-headers that can cause an infinite
loop when selecting a newsgroup. The bug appears when the NNTP server
sends GNUS a header that doesn't start with any of the keywords it is
expecting. In my case, the culprit was an article with both a "From: "
header and, later, a "from:" header (all lower case, with no whitespace
after the colon). The bogus "from:" header caused the endless loop,
because nntp-retrieve-headers will advance to the next line only after
each line is recognized. The answer is of course to make sure that
non-matching lines will eventually get skipped over. The following
is one way of doing this; replace your version of nntp-retrieve-headers
with this or a similarly redefined version to avoid the bug.
-Steve
(defun nntp-retrieve-headers (sequence)
"Return list of article headers specified by SEQUENCE of article id.
The format of list is `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID] ...)'.
Reader macros for the vector are defined as `nntp-header-FIELD'.
Writer macros for the vector are defined as `nntp-set-header-FIELD'.
News group must be selected before calling me."
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)
(let ((number (length sequence))
(last-point (point-min))
(received 0)
(count 0)
(headers nil) ;Result list.
(article 0)
(subject nil)
(message-id)
(from nil)
(xref nil)
(lines 0)
(date nil))
;; Send HEAD command.
(while sequence
(nntp-send-strings-to-server "HEAD" (car sequence))
(setq sequence (cdr sequence))
(setq count (1+ count))
;; Every 400 header requests we have to read stream in order
;; to avoid deadlock.
(if (or (null sequence) ;All requests have been sent.
(zerop (% count nntp-maximum-request)))
(progn
(accept-process-output)
(while (progn
(goto-char last-point)
;; Count replies.
(while (re-search-forward "^[0-9]" nil t)
(setq received (1+ received)))
(setq last-point (point))
(< received count))
;; If number of headers is greater than 100, give
;; informative messages.
(and (> number nntp-large-newsgroup)
(zerop (% received 20))
(message "NNTP: %d%% of headers received."
(/ (* received 100) number)))
(nntp-accept-response))
))
)
;; Wait for text of last command.
(goto-char (point-max))
(re-search-backward "^[0-9]" nil t)
(if (looking-at "^[23]")
(while (progn
(goto-char (- (point-max) 3))
(not (looking-at "^\\.\r$")))
(nntp-accept-response)
))
(if (> number nntp-large-newsgroup)
(message "NNTP: 100%% of headers received."))
;; Now all of replies are received.
;; First, delete unnecessary lines.
(goto-char (point-min))
(delete-non-matching-lines
"^Subject:\\|^Xref:\\|^From:\\|^Lines:\\|^Date:\\|^[23]")
(if (> number nntp-large-newsgroup)
(message "NNTP: Parsing headers..."))
(setq received number)
;; Then examines replies.
(while (not (eobp))
(cond ((looking-at "^[23].*[ \t]+\\([0-9]+\\)[ \t]+\\(<.+>\\)")
(setq article
(string-to-int
(buffer-substring (match-beginning 1) (match-end 1))))
(setq message-id
(buffer-substring (match-beginning 2) (match-end 2)))
(forward-line 1)
;; Set default value.
(setq subject nil)
(setq xref nil)
(setq from nil)
(setq lines 0)
(setq date nil)
;; It is better to extract From:, Subject:, Date:,
;; Lines: and Xref: field values in *THIS* order.
;; Forward-line each time after getting expected value
;; in order to reduce count of string matching.
(while (looking-at "^[^23]")
(let ((no-match t))
(if (looking-at "^From:[ \t]\\(.*\\)\r$")
(progn
(setq from (buffer-substring (match-beginning 1)
(match-end 1)))
(forward-line 1)
(setq no-match nil)))
(if (looking-at "^Subject:[ \t]\\(.*\\)\r$")
(progn
(setq subject (buffer-substring (match-beginning 1)
(match-end 1)))
(forward-line 1)
(setq no-match nil)))
(if (looking-at "^Date:[ \t]\\(.*\\)\r$")
(progn
(setq date (buffer-substring (match-beginning 1)
(match-end 1)))
(forward-line 1)
(setq no-match nil)))
(if (looking-at "^Lines:[ \t]\\(.*\\)\r$")
(progn
(setq lines (string-to-int
(buffer-substring (match-beginning 1)
(match-end 1))))
(forward-line 1)
(setq no-match nil)))
(if (looking-at "^Xref:[ \t]\\(.*\\)\r$")
(progn
(setq xref (buffer-substring (match-beginning 1)
(match-end 1)))
(forward-line 1)
(setq no-match nil)))
(if no-match
(forward-line 1))
))
(if (null subject)
(setq subject "(None)"))
(if (null from)
(setq from "Unknown User"))
(setq headers
(cons (vector article subject from
xref lines date message-id)
headers))
)
(t (forward-line 1)) ;Skip invalid field (ex. Subject:abc)
)
(setq received (1- received))
(and (> number nntp-large-newsgroup)
(zerop (% received 20))
(message "NNTP: Parsing headers... %d%%"
(/ (* received 100) number)))
)
(if (> number nntp-large-newsgroup)
(message "NNTP: Parsing headers... done"))
(nreverse headers)
)))umerin@photon.stars.flab.fujitsu.junet (Masanobu UMEDA) (03/18/89)
Date: 12 Mar 89 21:56:50 GMT
From: fgw!uunet!columbia.edu!cs!popovich (Steve Popovich)
Organization: Columbia University
This message applies to GNUS version 3.11.
There is a bug in nntp-retrieve-headers that can cause an infinite
loop when selecting a newsgroup. The bug appears when the NNTP server
sends GNUS a header that doesn't start with any of the keywords it is
expecting.
I hope the following patch will solve these kinds of problems. Please
try it.
Masanobu UMEDA
umerin@flab.Fujitsu.JUNET
umerin%flab.Fujitsu.JUNET@uunet.uu.NET
*** /tmp/,RCSt1a00422 Sat Mar 18 11:18:25 1989
--- nntp.el Sat Mar 18 11:13:42 1989
***************
*** 271,276 ****
--- 271,279 ----
(setq xref (buffer-substring (match-beginning 1)
(match-end 1)))
(forward-line 1)))
+ ;; Skip invalid field (ex. Subject:abc)
+ (if (looking-at "^[^:]*:[^ \t]")
+ (forward-line 1))
)
(if (null subject)
(setq subject "(None)"))
***************
*** 606,614 ****
;; Initialize communication buffer.
(setq nntp-server-buffer (get-buffer-create " *nntpd*"))
(set-buffer nntp-server-buffer)
- (kill-all-local-variables)
(buffer-flush-undo (current-buffer))
(erase-buffer)
(setq nntp-server-process
(open-network-stream "nntpd" (current-buffer)
host (or service "nntp")))
--- 609,618 ----
;; Initialize communication buffer.
(setq nntp-server-buffer (get-buffer-create " *nntpd*"))
(set-buffer nntp-server-buffer)
(buffer-flush-undo (current-buffer))
(erase-buffer)
+ (kill-all-local-variables)
+ (setq case-fold-search t) ;Should ignore case.
(setq nntp-server-process
(open-network-stream "nntpd" (current-buffer)
host (or service "nntp")))