mly@AI.MIT.EDU (Richard Mlynarik) (08/21/89)
Gnu's NNTP interface dies (goes into a loop) when it encounters an
(illegal) header of the form "Date:" (ie a date header with no actual
header content.)
A few weeks ago Rob Austein sent in a patch to make
nntp-retrieve-header not choke and die on header continuation lines.
The below patch shoudl also fix that problem.
This version should also run faster (and be a little more correct)
than the original...
(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 ())) ;Result list.
;; 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 (mod 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 (mod 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.
(setq received number)
;; Now all of replies are received.
;; First, delete unnecessary lines.
(goto-char (point-min))
(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
(replace-match " " t t))
;; Then examines replies.
(goto-char (point-min))
(while (not (eobp))
(if (not (looking-at "^[23][0-9][0-9][ \t]+\\([0-9]+\\)[ \t]+\\(<[^>]+>\\)"))
(forward-line 1) ;Skip invalid field (ex. Subject:abc)
(let ((article 0)
(subject nil)
(message-id nil)
(from nil)
(xref nil)
(lines 0)
(date nil))
(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)
(while (and (not (eobp))
(not (memq (following-char) '(?2 ?3))))
(if (looking-at "\\(From\\|Subject\\|Date\\|Lines\\|Xref\\):[ \t]+\\([^ \t\n]+.*\\)\r$")
(let ((s (buffer-substring (match-beginning 2)
(match-end 2)))
(c (char-after (match-beginning 0))))
(cond ((char-equal c ?S)
(setq subject (if subject (concat subject "\n" s) s)))
((char-equal c ?F)
(setq from (if from (concat from ", " s) s)))
((char-equal c ?D)
(setq date (or date s)))
((char-equal c ?L)
(setq lines (string-to-int s)))
((char-equal c ?X)
(setq xref (if xref (concat xref " " s) s))))))
(forward-line 1))
(setq subject (or subject "(None)"))
(setq from (or from "(Unknown User)"))
(setq headers (cons (vector article subject from
xref lines date message-id)
headers))))
(setq received (1- received))
(and (> number nntp-large-newsgroup)
(zerop (mod received 20))
(message "NNTP: Parsing headers... %d%%"
(/ (* received 100) number))))
(if (> number nntp-large-newsgroup)
(message "NNTP: Parsing headers... done"))
(nreverse headers))))