From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on inbox.vuxu.org X-Spam-Level: X-Spam-Status: No, score=-3.4 required=5.0 tests=DKIM_SIGNED,DKIM_VALID, DKIM_VALID_AU,MAILING_LIST_MULTI,RCVD_IN_DNSWL_MED,RCVD_IN_MSPIKE_H2 autolearn=ham autolearn_force=no version=3.4.4 Received: (qmail 9157 invoked from network); 14 Oct 2021 17:39:31 -0000 Received: from lists.gnu.org (209.51.188.17) by inbox.vuxu.org with ESMTPUTF8; 14 Oct 2021 17:39:31 -0000 Received: from localhost ([::1]:54992 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mb4hV-0000P5-AN for ml@inbox.vuxu.org; Thu, 14 Oct 2021 13:39:29 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:49794) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mb4hB-0000Mw-Q9 for info-gnus-english@gnu.org; Thu, 14 Oct 2021 13:39:10 -0400 Received: from mail.ericabrahamsen.net ([52.70.2.18]:57964) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mb4h8-00005E-W4 for info-gnus-english@gnu.org; Thu, 14 Oct 2021 13:39:09 -0400 Received: from localhost (c-71-197-232-156.hsd1.wa.comcast.net [71.197.232.156]) (Authenticated sender: eric@ericabrahamsen.net) by mail.ericabrahamsen.net (Postfix) with ESMTPSA id 1DA5AFA098; Thu, 14 Oct 2021 17:39:03 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=ericabrahamsen.net; s=mail; t=1634233144; bh=x0vPlfDBEReXh8zgOkBXVB3CuzW4BJwbeMoGnsp1p5A=; h=From:To:Cc:Subject:References:Date:In-Reply-To:From; b=lDaZ7WMhkOm/+2oB0cjS4rfEyhqTAls/OiKwkHUnzG5K4+LNmLZu8GtVg6xnXshRt jTzKeLv15pAiBA54CAEAbK+aKnzitGZ1oCTyzgWnNkajMv1J+90ixZO5OXUEIa3c8r kgWe3P49oKAeDrXQTzkaf3tqsERooCKLYbkzGj30= From: Eric Abrahamsen To: Lars-Johan Liman Subject: Re: Mail source unreachable - continue yes/no? References: <22ee8sumb0.fsf@hiptop.liman.net> <87zgrect8z.fsf@gnus.org> <225yu241v1.fsf@hiptop.liman.net> Date: Thu, 14 Oct 2021 10:39:02 -0700 In-Reply-To: <225yu241v1.fsf@hiptop.liman.net> (Lars-Johan Liman's message of "Tue, 12 Oct 2021 18:57:54 +0200") Message-ID: <875ytzqzex.fsf@ericabrahamsen.net> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Received-SPF: pass client-ip=52.70.2.18; envelope-from=eric@ericabrahamsen.net; helo=mail.ericabrahamsen.net X-Spam_score_int: -43 X-Spam_score: -4.4 X-Spam_bar: ---- X-Spam_report: (-4.4 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, RCVD_IN_DNSWL_MED=-2.3, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: info-gnus-english@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Announcements and discussions for GNUS, the GNU Emacs Usenet newsreader \(in English\)" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: Lars Ingebrigtsen , info-gnus-english@gnu.org Errors-To: info-gnus-english-bounces+ml=inbox.vuxu.org@gnu.org Sender: "info-gnus-english" --=-=-= Content-Type: text/plain Lars-Johan Liman writes: > Lol! > > Thanks. OK, so I wasn't off the mark, then. :-) > > I'm not even sure this needs to be fixed. It's good that the fact that > the server couldn't be reached is signalled, but continuing seems like > the right thing to do. The message is somewhat misleading though. How > about changing the "question" to a "Please ack!" of some kind? Looking over the code, I'm inclined to agree with Lars-Johan here: there isn't really any need to halt the process, what's important is that the user be made aware of the failure. I'm trying to imagine why the user would _need_ to halt things here. Unless we've got some sort of restart situation, where the user can eg put in the correct password and try again, it doesn't seem useful. Allow me to re-introduce my suggestion of using warnings! It's looking better and better the more I consider it. `delay-warning' is just what we want: it puts messages in the hopper, which aren't displayed until the current command is completely finished, instead of messages clobbering each other and getting buried. It has its own private buffer, keeping information separate. There are plenty of user-facing knobs, and facilities for hiding or silencing the warnings. See attached! --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=gnus-define-errors.diff 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) --=-=-=--