Announcements and discussions for Gnus, the GNU Emacs Usenet newsreader
 help / color / mirror / Atom feed
From: Eric Abrahamsen <eric@ericabrahamsen.net>
To: info-gnus-english@gnu.org
Subject: Re: Mail source unreachable - continue yes/no?
Date: Wed, 13 Oct 2021 22:03:31 -0700	[thread overview]
Message-ID: <87bl3srye4.fsf@ericabrahamsen.net> (raw)
In-Reply-To: <874k9l88h2.fsf@gnus.org>

[-- Attachment #1: Type: text/plain, Size: 4149 bytes --]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Eric Abrahamsen <eric@ericabrahamsen.net> writes:
>
>> I put plain old calls to `error' inside `nnimap-request-scan', and that
>> also derailed the "g" update process. So whatever handling there once
>> was either is not around this particular piece of code, or else it might
>> have gone away at some point.
>
> Yeah, perhaps it went missing at some point.
>
>> Are you likely to recall further how this once worked? :) I can start
>> sketching out some custom errors, otherwise.
>
> I'm not sure about anything.  I do recall (in the olden days) getting a
> humongous appended error message from all the backends if the network
> went down or something, though.

On second thought you're not wrong here: the various *-open-server
deffoos report their own failures with `nnheader-report' instead of
signaling errors, and then `gnus-open-server' swallows any other errors
and converts them to messages.

Failures arrived at via `gnus-request-scan' mostly show up as actual
errors.

I still haven't looked into why nntp-connection-timeout ends up
interrupting everything.

> Custom errors sound good, though.

Okay, here's a _very_ rough first sketch. There are a handful of errors
defined, mostly for connection problems. I didn't do any handling for
authentication failures, because that's a fairly distinct system, and
I'm not sure there's any need to mess with it (I haven't tested what
auth failures do to Gnus update), anyway that can be left for later.

A few things happen in this patch:

- When the gnus-open-server deffoo processes fail, they (or their
  downstream functions) signal 'gnus-server-connection-error. (I didn't
  go through and do this for every backend, just enough to get the
  idea.)
- Mail source fetching can fail, in which case 'gnus-mail-source-error
  is signaled. nnmail.el no longer handles this error: it propagates up
  and out through gnus-request-scan.
- There are `condition-case' wrappers in `gnus-get-unread-articles' now,
  which seems to be the main place where it's important not to interrupt
  a larger loop. Most other places the user is just "doing one thing",
  and it seems okay to let the error reach them directly.

Some observations and questions:

- There are many places and depth-levels in Gnus where failure modes are
  dealt with as messages (in effect working like `with-demoted-errors')
  or as nil return values from functions, which are then converted into
  messages, or sometimes even re-signaled as an actual `error' with a
  new message string. This often ends up burying real errors, and/or
  making debug on error hard to use. We could try flattening this out:
  low-level functions signal errors, and only top-level functions in
  gnus-start/gnus-group/gnus-sum get to catch them at the last minute,
  and only if necessary (other layers can of course catch and re-signal
  the errors if some cleanup work needs to be done). I have no idea if
  this would end up working out, but I think it would be good to try.
  And more use of `condition-case-unless-debug' at the top level.

- There are many ways of logging, and messaging the user. Apart from
  `message' itself, there's `nnheader-report', `gnus-backend-trace',
  `nnheader-message(-maybe)', `gnus-message' and its action message log,
  along with `gnus-final-warning' and `gnus-error'.

  nnheader-report, in particular, seems to often be used as a substitute
  for actually signaling an error. A server is asked to do something, it
  fails for some reason and logs the reason with nnheader-report, then
  returns nil. The caller sees the nil, then retrieves the string with
  nnheader-get-report, and uses it to signal an error.

  I'm not claiming to have thought this through completely, much less
  tested anything, but I wonder if in most cases the underlying code
  couldn't just signal an error directly.

- Lastly, I wanted to try out the warning facilities here, just to see
  if they might provide a good tool.
  nnheader-message/gnus-message/gnus-error could dispatch to
  display-warning.

Anyway, those are some thoughts that occurred while poking around with
this.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: gnus-define-errors.diff --]
[-- Type: text/x-patch, Size: 13863 bytes --]

diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 606bd3a39a..3c1387b73f 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -45,6 +45,14 @@ gnus-agent-file-loading-local
 (defvar gnus-agent-file-loading-cache)
 (defvar gnus-topic-alist)
 
+(define-error 'gnus-error "Gnus error")
+(define-error 'gnus-mail-source-error
+  "Gnus mail source error" 'gnus-error)
+(define-error 'gnus-server-error
+  "Gnus server error" 'gnus-error)
+(define-error 'gnus-server-connection-error
+  "Error connecting to server" 'gnus-server-error)
+
 (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")
   "Your `.newsrc' file.
 `.newsrc-SERVER' will be used instead if that exists."
@@ -1604,7 +1612,8 @@ gnus-get-unread-articles
 	 (gnus-agent-article-local-times 0)
 	 (archive-method (gnus-server-to-method "archive"))
 	 info group active method cmethod
-	 method-type method-group-list entry)
+	 method-type method-group-list entry
+         failed-methods)
     (gnus-message 6 "Checking new news...")
 
     (while newsrc
@@ -1685,8 +1694,11 @@ gnus-get-unread-articles
 			    gnus-secondary-select-methods))
 	(when (and (not (assoc method type-cache))
 		   (gnus-check-backend-function 'request-list (car method)))
-	  (with-current-buffer nntp-server-buffer
-	    (gnus-read-active-file-1 method nil)))))
+          (condition-case-unless-debug err
+	      (with-current-buffer nntp-server-buffer
+	        (gnus-read-active-file-1 method nil))
+            (gnus-server-connection-error
+             (push (cons method err) failed-methods))))))
 
     ;; Clear out all the early methods.
     (dolist (elem type-cache)
@@ -1697,11 +1709,15 @@ gnus-get-unread-articles
 		    'retrieve-group-data-early (car method))
 		   (not (gnus-method-denied-p method)))
 	  (when (ignore-errors (gnus-get-function method 'open-server))
-	    (unless (gnus-server-opened method)
-	      (gnus-open-server method))
-	    (when (gnus-server-opened method)
-	      ;; Just mark this server as "cleared".
-	      (gnus-retrieve-group-data-early method nil))))))
+            (condition-case-unless-debug err
+	        (progn
+                  (unless (gnus-server-opened method)
+	            (gnus-open-server method))
+	          ;; Just mark this server as "cleared".
+	          (gnus-retrieve-group-data-early method nil))
+              (gnus-server-connection-error
+               (push (cons method err) failed-methods)
+               (setq type-cache (delq elem type-cache))))))))
 
     ;; Start early async retrieval of data.
     (let ((done-methods nil)
@@ -1725,7 +1741,6 @@ gnus-get-unread-articles
 		     ;; be unique at this point, but apparently it
 		     ;; does happen in the wild with some setups.
 		     (not (member sanity-spec done-methods))
-		     (gnus-server-opened method)
 		     (gnus-check-backend-function
 		      'retrieve-group-data-early (car method)))
 		(push sanity-spec done-methods)
@@ -1744,12 +1759,23 @@ gnus-get-unread-articles
 	  (let ((updatep (gnus-check-backend-function
 			  'request-update-info (car method))))
 	    ;; See if any of the groups from this method require updating.
-	    (gnus-read-active-for-groups method infos early-data)
-	    (dolist (info infos)
-	      (inline (gnus-get-unread-articles-in-group
-		       info (gnus-active (gnus-info-group info))
-		       updatep)))))))
-    (gnus-message 6 "Checking new news...done")))
+            (condition-case-unless-debug err
+                (progn
+	          (gnus-read-active-for-groups method infos early-data)
+	          (dolist (info infos)
+	            (inline (gnus-get-unread-articles-in-group
+		             info (gnus-active (gnus-info-group info))
+		             updatep))))
+              ((gnus-server-connection-error gnus-mail-source-error)
+               (push (cons method err) failed-methods)))))))
+    (gnus-message 6 "Checking new news...done")
+    (when failed-methods
+      (let ((warning-series t))
+        (dolist (m failed-methods)
+          (delay-warning
+           '(gnus)
+           (format "Failed to open %s: %S" (car m) (cdr m))
+           :error "*Gnus Warnings*"))))))
 
 (defun gnus-method-rank (type method)
   (cond
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index af0a198376..2515a4261a 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -549,13 +549,10 @@ mail-source-fetch
 			   callback mail-source-crash-box))
 	      (mail-source-delete-crash-box))
 	    (+ found
-	       (if (or debug-on-quit debug-on-error)
+	       (condition-case-unless-debug err
 		   (funcall function source callback)
-		 (condition-case err
-		     (funcall function source callback)
-		   (error
-		    (if (and (not mail-source-ignore-errors)
-			     (not
+		 (error
+		  (unless (or mail-source-ignore-errors
 			      (yes-or-no-p
 			       (format "Mail source %s error (%s).  Continue? "
 				       (if (memq ':password source)
@@ -563,10 +560,10 @@ mail-source-fetch
 					     (setcar (cdr (memq ':password s))
 						     "********")
 					     s)
-					 source)
-				       (cadr err)))))
-		      (error "Cannot get new mail"))
-		    0)))))))))
+				         source)
+				       (cadr err))))
+		    (signal 'gnus-mail-source-error (list source err)))
+		  0))))))))
 
 (declare-function gnus-message "gnus-util" (level &rest args))
 
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 8a2acf6459..3305b6edd2 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -456,9 +456,7 @@ nnimap-open-connection
 		   while (eq stream 'no-connect)
 		   finally (return stream))
 	   (nnimap-open-connection-1 buffer))))
-    (if (eq stream 'no-connect)
-	nil
-      stream)))
+    stream))
 
 ;; This is only needed for Windows XP or earlier
 (defun nnimap-map-port (port)
@@ -534,7 +532,8 @@ nnimap-open-connection-1
 	    (progn
 	      (nnheader-report 'nnimap "Unable to contact %s:%s via %s"
 			       nnimap-address (car ports) nnimap-stream)
-	      'no-connect)
+	      (signal 'gnus-server-connection-error
+                      (list nnimap-object)))
 	  (set-process-query-on-exit-flag stream nil)
 	  (if (not (string-match-p "[*.] \\(OK\\|PREAUTH\\)" greeting))
 	      (nnheader-report 'nnimap "%s" greeting)
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index bcf01cfa9e..1a9258273c 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -1825,25 +1825,22 @@ nnmail-get-new-mail-1
       ;; and fetch the mail from each.
       (while (setq source (pop fetching-sources))
 	(when (setq new
-		    (condition-case cond
-			(mail-source-fetch
-			 source
-			 (let ((smsym (intern (format "%s-save-mail" method)))
+		    (or (mail-source-fetch
+		         source
+		         (let ((smsym (intern (format "%s-save-mail" method)))
 			       (ansym (intern (format "%s-active-number" method)))
 			       (src source))
-			   (lambda (file orig-file)
+		           (lambda (file orig-file)
 			     (nnmail-split-incoming
 			      file smsym
 			      spool-func
 			      (or in-group
-				  (if (equal file orig-file)
+			          (if (equal file orig-file)
 				      nil
 				    (nnmail-get-split-group orig-file
 							    src)))
 			      ansym))))
-		      ((error quit)
-		       (message "Mail source %s failed: %s" source cond)
-		       0)))
+                        0))
 	  (cl-incf total new)
 	  (cl-incf i)))
       ;; If we did indeed read any incoming spools, we save all info.
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 690761a2d6..8d2b8d4cef 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -670,63 +670,65 @@ nnmaildir-open-server
   (let ((server (alist-get server-string nnmaildir--servers
 			   nil nil #'equal))
 	dir size x)
-    (catch 'return
-      (if server
-	  (and (nnmaildir--srv-groups server)
-	       (setq nnmaildir--cur-server server)
-	       (throw 'return t))
-	(setq server (make-nnmaildir--srv :address server-string))
-	(let ((inhibit-quit t))
-	  (setf (alist-get server-string nnmaildir--servers
-			   nil nil #'equal)
-		server)))
-      (setq dir (assq 'directory defs))
-      (unless dir
-	(setf (nnmaildir--srv-error server)
-	      "You must set \"directory\" in the select method")
-	(throw 'return nil))
-      (setq dir (cadr dir)
-	    dir (eval dir t)	;FIXME: Why `eval'?
-	    dir (expand-file-name dir)
-	    dir (file-name-as-directory dir))
-      (unless (file-exists-p dir)
-	(setf (nnmaildir--srv-error server) (concat "No such directory: " dir))
-	(throw 'return nil))
-      (setf (nnmaildir--srv-dir server) dir)
-      (setq x (assq 'directory-files defs))
-      (if (null x)
-	  (setq x (if nnheader-directory-files-is-safe 'directory-files
-		    'nnheader-directory-files-safe))
-	(setq x (cadr x))
-	(unless (functionp x)
-	  (setf (nnmaildir--srv-error server)
-		(concat "Not a function: " (prin1-to-string x)))
-	  (throw 'return nil)))
-      (setf (nnmaildir--srv-ls server) x)
-      (setq size (length (funcall x dir nil "\\`[^.]" 'nosort)))
-      (and (setq x (assq 'get-new-mail defs))
-	   (setq x (cdr x))
-	   (car x)
-	   (setf (nnmaildir--srv-gnm server) t)
-	   (require 'nnmail))
-      (setq x (assq 'target-prefix defs))
-      (if x
-	  (progn
-	    (setq x (cadr x)
-		  x (eval x t))	;FIXME: Why `eval'?
-	    (setf (nnmaildir--srv-target-prefix server) x))
-	(setq x (assq 'create-directory defs))
-	(if x
-	    (progn
-	      (setq x (cadr x)
-		    x (eval x t) ;FIXME: Why `eval'?
-		    x (file-name-as-directory x))
-	      (setf (nnmaildir--srv-target-prefix server) x))
-	  (setf (nnmaildir--srv-target-prefix server) "")))
-      (setf (nnmaildir--srv-groups server)
-	    (gnus-make-hashtable size))
-      (setq nnmaildir--cur-server server)
-      t)))
+    (unless
+	(catch 'return
+	  (if server
+	      (and (nnmaildir--srv-groups server)
+		   (setq nnmaildir--cur-server server)
+		   (throw 'return t))
+	    (setq server (make-nnmaildir--srv :address server-string))
+	    (let ((inhibit-quit t))
+	      (setf (alist-get server-string nnmaildir--servers
+			       nil nil #'equal)
+		    server)))
+	  (setq dir (assq 'directory defs))
+	  (unless dir
+	    (setf (nnmaildir--srv-error server)
+		  "You must set \"directory\" in the select method")
+	    (throw 'return nil))
+	  (setq dir (cadr dir)
+		dir (eval dir t)	;FIXME: Why `eval'?
+		dir (expand-file-name dir)
+		dir (file-name-as-directory dir))
+	  (unless (file-exists-p dir)
+	    (setf (nnmaildir--srv-error server) (concat "No such directory: " dir))
+	    (throw 'return nil))
+	  (setf (nnmaildir--srv-dir server) dir)
+	  (setq x (assq 'directory-files defs))
+	  (if (null x)
+	      (setq x (if nnheader-directory-files-is-safe 'directory-files
+			'nnheader-directory-files-safe))
+	    (setq x (cadr x))
+	    (unless (functionp x)
+	      (setf (nnmaildir--srv-error server)
+		    (concat "Not a function: " (prin1-to-string x)))
+	      (throw 'return nil)))
+	  (setf (nnmaildir--srv-ls server) x)
+	  (setq size (length (funcall x dir nil "\\`[^.]" 'nosort)))
+	  (and (setq x (assq 'get-new-mail defs))
+	       (setq x (cdr x))
+	       (car x)
+	       (setf (nnmaildir--srv-gnm server) t)
+	       (require 'nnmail))
+	  (setq x (assq 'target-prefix defs))
+	  (if x
+	      (progn
+		(setq x (cadr x)
+		      x (eval x t))	;FIXME: Why `eval'?
+		(setf (nnmaildir--srv-target-prefix server) x))
+	    (setq x (assq 'create-directory defs))
+	    (if x
+		(progn
+		  (setq x (cadr x)
+			x (eval x t)	;FIXME: Why `eval'?
+			x (file-name-as-directory x))
+		  (setf (nnmaildir--srv-target-prefix server) x))
+	      (setf (nnmaildir--srv-target-prefix server) "")))
+	  (setf (nnmaildir--srv-groups server)
+		(gnus-make-hashtable size))
+	  (setq nnmaildir--cur-server server)
+	  t)
+      (signal 'gnus-server-connection-error (list server)))))
 
 (defun nnmaildir--parse-filename (file)
   (let ((prefix (car file))
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index 18acc73aad..98cbe79e8b 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -163,17 +163,18 @@ nnml-open-server
   (nnoo-change-server 'nnml server defs)
   (when (not (file-exists-p nnml-directory))
     (ignore-errors (make-directory nnml-directory t)))
-  (cond
-   ((not (file-exists-p nnml-directory))
-    (nnml-close-server)
-    (nnheader-report 'nnml "Couldn't create directory: %s" nnml-directory))
-   ((not (file-directory-p (file-truename nnml-directory)))
-    (nnml-close-server)
-    (nnheader-report 'nnml "Not a directory: %s" nnml-directory))
-   (t
-    (nnheader-report 'nnml "Opened server %s using directory %s"
-		     server nnml-directory)
-    t)))
+  (let (msg)
+    (if (or (and (not (file-exists-p nnml-directory))
+                 (setq msg "Couldn't create directory: %s"))
+            (and (not (file-directory-p (file-truename nnml-directory)))
+                 (setq msg "Not a directory: %s")))
+        (progn
+          (nnml-close-server)
+          (nnheader-report 'nnml msg nnml-directory)
+          (signal 'gnus-server-connection-error (list server)))
+      (nnheader-report 'nnml "Opened server %s using directory %s"
+		       server nnml-directory)
+      t)))
 
 (deffoo nnml-request-regenerate (server)
   (nnml-possibly-change-directory nil server)
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 615a3c931b..2f8b271c55 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -1296,7 +1296,8 @@ nntp-open-connection
 	(goto-char (point-min))
 	(nnheader-report 'nntp "Error when connecting: %s"
 			 (buffer-substring (point) (line-end-position))))
-      (setq process nil))
+      (setq process nil)
+      (signal 'gnus-server-connection-error (list nntp-address)))
     (unless process
       (nntp-kill-buffer pbuffer))
     (when (and (buffer-live-p pbuffer)

  reply	other threads:[~2021-10-14  5:03 UTC|newest]

Thread overview: 24+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-10-11  6:07 Lars-Johan Liman
2021-10-12 12:39 ` Lars Ingebrigtsen
2021-10-12 16:50   ` Eric Abrahamsen
2021-10-12 16:57     ` Lars Ingebrigtsen
2021-10-12 17:49       ` Eric Abrahamsen
2021-10-12 17:56         ` Lars Ingebrigtsen
2021-10-12 18:18           ` Eric Abrahamsen
2021-10-12 18:25             ` Lars Ingebrigtsen
2021-10-12 19:50               ` Eric Abrahamsen
2021-10-13 11:33                 ` Lars Ingebrigtsen
2021-10-14  5:03                   ` Eric Abrahamsen [this message]
2021-10-14 11:22                     ` Lars Ingebrigtsen
2021-10-14 18:31                       ` Eric Abrahamsen
2021-10-15 10:42                         ` Lars Ingebrigtsen
2021-10-15 17:43                           ` Eric Abrahamsen
2021-10-12 16:57   ` Lars-Johan Liman
2021-10-14 17:39     ` Eric Abrahamsen
2021-10-15 10:48       ` Lars Ingebrigtsen
2021-10-15 17:52         ` Eric Abrahamsen
2021-10-18  6:42           ` Lars Ingebrigtsen
2021-10-18 15:03             ` Eric Abrahamsen
2021-10-19 13:42               ` Lars Ingebrigtsen
2021-10-19 15:15                 ` Eric Abrahamsen
2021-10-21 23:36               ` Eric Abrahamsen

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87bl3srye4.fsf@ericabrahamsen.net \
    --to=eric@ericabrahamsen.net \
    --cc=info-gnus-english@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).