Function: nntp-retrieve-headers-with-xover

nntp-retrieve-headers-with-xover is a byte-compiled function defined in nntp.el.gz.

Signature

(nntp-retrieve-headers-with-xover ARTICLES &optional FETCH-OLD)

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/nntp.el.gz
(defun nntp-retrieve-headers-with-xover (articles &optional fetch-old)
  (set-buffer nntp-server-buffer)
  (erase-buffer)
  (cond

   ;; This server does not talk NOV.
   ((not nntp-server-xover)
    nil)

   ;; We don't care about gaps.
   ((or (not nntp-nov-gap)
	fetch-old)
    (nntp-send-xover-command
     (if fetch-old
	 (if (numberp fetch-old)
	     (max 1 (- (car articles) fetch-old))
	   1)
       (car articles))
     (car (last articles)) 'wait)

    (goto-char (point-min))
    (when (looking-at "[1-5][0-9][0-9] .*\n")
      (delete-region (point) (progn (forward-line 1) (point))))
    (while (search-forward "\r" nil t)
      (replace-match "" t t))
    (goto-char (point-max))
    (forward-line -1)
    (when (looking-at "\\.")
      (delete-region (point) (progn (forward-line 1) (point)))))

   ;; We do it the hard way.  For each gap, an XOVER command is sent
   ;; to the server.  We do not wait for a reply from the server, we
   ;; just send them off as fast as we can.  That means that we have
   ;; to count the number of responses we get back to find out when we
   ;; have gotten all we asked for.
   ((numberp nntp-nov-gap)
    (let ((count 0)
	  (received 0)
	  last-point
	  in-process-buffer-p
	  (buf nntp-server-buffer)
	  (process-buffer (nntp-find-connection-buffer nntp-server-buffer))
	  first status)
      ;; We have to check `nntp-server-xover'.  If it gets set to nil,
      ;; that means that the server does not understand XOVER, but we
      ;; won't know that until we try.
      (while (and nntp-server-xover articles)
	(setq first (car articles))
	;; Search forward until we find a gap, or until we run out of
	;; articles.
	(while (and (cdr articles)
		    (< (- (nth 1 articles) (car articles)) nntp-nov-gap))
	  (setq articles (cdr articles)))

	(setq in-process-buffer-p (stringp nntp-server-xover))
        (nntp-send-xover-command first (car articles))
        (setq articles (cdr articles))

	(when (and nntp-server-xover in-process-buffer-p)
	  ;; Don't count tried request.
	  (setq count (1+ count))

	  ;; Every 400 requests we have to read the stream in
	  ;; order to avoid deadlocks.
	  (when (or (null articles)	;All requests have been sent.
		    (= 1 (% count nntp-maximum-request)))

	    (nntp-accept-response)
	    ;; On some Emacs versions the preceding function has a
	    ;; tendency to change the buffer.  Perhaps.  It's quite
	    ;; difficult to reproduce, because it only seems to happen
	    ;; once in a blue moon.
	    (set-buffer process-buffer)
	    (while (progn
		     (goto-char (or last-point (point-min)))
		     ;; Count replies.
		     (while (re-search-forward "^\\([0-9][0-9][0-9]\\) .*\n"
					       nil t)
		       (cl-incf received)
		       (setq status (match-string 1))
		       (if (string-match "^[45]" status)
			   (setq status 'error)
			 (setq status 'ok)))
		     (setq last-point (point))
		     (or (< received count)
			 (if (eq status 'error)
			     nil
			   ;; I haven't started reading the final response
			   (progn
			     (goto-char (point-max))
			     (forward-line -1)
			     (not (looking-at "^\\.\r?\n"))))))
	      ;; I haven't read the end of the final response
	      (nntp-accept-response)
	      (set-buffer process-buffer))))

        ;; Some nntp servers seem to have an extension to the XOVER
        ;; extension.  On these servers, requesting an article range
        ;; preceding the active range does not return an error as
        ;; specified in the RFC.  What we instead get is the NOV entry
        ;; for the first available article.  Obviously, a client can
        ;; use that entry to avoid making unnecessary requests.  The
        ;; only problem is for a client that assumes that the response
        ;; will always be within the requested range.  For such a
        ;; client, we can get N copies of the same entry (one for each
        ;; XOVER command sent to the server).

        (when (<= count 1)
          (goto-char (point-min))
          (when (re-search-forward "^[0-9][0-9][0-9] .*\n\\([0-9]+\\)" nil t)
            (let ((low-limit (string-to-number
			      (buffer-substring (match-beginning 1)
						(match-end 1)))))
              (while (and articles (<= (car articles) low-limit))
                (setq articles (cdr articles))))))
        (set-buffer buf))

      (when nntp-server-xover
	(when in-process-buffer-p
	  (set-buffer buf)
	  (goto-char (point-max))
	  (nnheader-insert-buffer-substring process-buffer)
	  (set-buffer process-buffer)
	  (erase-buffer)
	  (set-buffer buf))

	;; We remove any "." lines and status lines.
	(goto-char (point-min))
	(while (search-forward "\r" nil t)
	  (delete-char -1))
	(goto-char (point-min))
	(delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] ")
	t))))

  nntp-server-xover)