bug#40280: gnus-cloud doesn't do anything useful

[David Edmondson]

After some time away, I'm playing with Gnus again. In this instance,
gnus-cloud isn't working for me.

Specifically, I can add a gnus-cloud storage server (on nnimap) and
register another server (nntp) with it. ~u causes messages to be added
to Emacs-Cloud and they appear to have the right kind of content.

~d on another machine never does anything useful (e.g. mark some
articles as read) because this test:

              (if (and newer (not force-older))
                (gnus-message 3 "Skipping outdated cloud info for group %s, the 
info is from %s (now is %s)" group date now)

always returns true.

Looking at how `newer' is calculated, it compares the group timestamp
from the gnus-cloud message with the current time. It's not clear to me
how that test is ever going to return `nil', unless I have a version of
emacs running somewhere in the future that updates gnus-cloud.

In general I would have expected to replay any changes with a higher
sequence number, irrespective of the date of the changes. That they
happened in the past is somewhat the point, isn't it? :-)

Another problem is that after a set of Emacs-Cloud messages have been
used to replay, the emacs instance doing that replay doesn't persist the
last seen sequence value as `gnus-cloud-sequence', so the next time it
attempts to replay it will unnecessarily replay the same sequence
numbered messages again.

Attached is a suggested patch. This makes things work for me in some
limited testing.


Gnus v5.13
GNU Emacs 26.1 (build 2, x86_64-pc-linux-gnu, GTK+ Version 3.24.11)
 of 2019-09-09, modified by Debian
200 news.gmane.io InterNetNews NNRP server INN 2.6.3 ready (posting ok)
100 Legal commands
  ARTICLE [message-ID|number]
  AUTHINFO USER name|PASS password|SASL mechanism [initial-response]|GENERIC 
program [argument ...]
  BODY [message-ID|number]
  CAPABILITIES [keyword]
  COMPRESS DEFLATE
  DATE
  GROUP newsgroup
  HDR header [message-ID|range]
  HEAD [message-ID|number]
  HELP
  IHAVE message-ID
  LAST
  LIST [ACTIVE [wildmat]|ACTIVE.TIMES [wildmat]|COUNTS 
[wildmat]|DISTRIB.PATS|DISTRIBUTIONS|HEADERS 
[MSGID|RANGE]|MODERATORS|MOTD|NEWSGROUPS [wildmat]|OVERVIEW.FMT|SUBSCRIPTIONS 
[wildmat]]
  LISTGROUP [newsgroup [range]]
  MODE READER
  NEWGROUPS [yy]yymmdd hhmmss [GMT]
  NEWNEWS wildmat [yy]yymmdd hhmmss [GMT]
  NEXT
  OVER [range]
  POST
  QUIT
  STARTTLS
  STAT [message-ID|number]
  XGTITLE [wildmat]
  XHDR header [message-ID|range]
  XOVER [range]
  XPAT header message-ID|range pattern [pattern ...]
Report problems to <usenet@ciao.gmane.io>.
.
382 Begin TLS negotiation now
100 Legal commands
  ARTICLE [message-ID|number]
  AUTHINFO USER name|PASS password|SASL mechanism [initial-response]|GENERIC 
program [argument ...]
  BODY [message-ID|number]
  CAPABILITIES [keyword]
  COMPRESS DEFLATE
  DATE
  GROUP newsgroup
  HDR header [message-ID|range]
  HEAD [message-ID|number]
  HELP
  IHAVE message-ID
  LAST
  LIST [ACTIVE [wildmat]|ACTIVE.TIMES [wildmat]|COUNTS 
[wildmat]|DISTRIB.PATS|DISTRIBUTIONS|HEADERS 
[MSGID|RANGE]|MODERATORS|MOTD|NEWSGROUPS [wildmat]|OVERVIEW.FMT|SUBSCRIPTIONS 
[wildmat]]
  LISTGROUP [newsgroup [range]]
  MODE READER
  NEWGROUPS [yy]yymmdd hhmmss [GMT]
  NEWNEWS wildmat [yy]yymmdd hhmmss [GMT]
  NEXT
  OVER [range]
  POST
  QUIT
  STARTTLS
  STAT [message-ID|number]
  XGTITLE [wildmat]
  XHDR header [message-ID|range]
  XOVER [range]
  XPAT header message-ID|range pattern [pattern ...]
Report problems to <usenet@ciao.gmane.io>.
.

>From a3bdd2219855a72e2ee90de1b6f823c9678a470c Mon Sep 17 00:00:00 2001
From: David Edmondson <dme@dme.org>
Date: Sat, 28 Mar 2020 19:03:58 +0000
Subject: [PATCH] gnus-cloud: Improve cloud sync

After replaying a set of actions downloaded by gnus-cloud, persist the
highest sequence number seen as the local `gnus-cloud-sequence'
number, in order that a future download will not unnecessarily replay
previously seen actions and any future uploads from this emacs
instance use a higher sequence number than that downloaded.

Remove the test on whether individual newsrc entries are older than
the current time, as that is always going to be the case.
---
 lisp/gnus/gnus-cloud.el | 54 ++++++++++++++++++++---------------------
 1 file changed, 27 insertions(+), 27 deletions(-)

diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el
index da6231d73300..7ea691e7220c 100644
--- a/lisp/gnus/gnus-cloud.el
+++ b/lisp/gnus/gnus-cloud.el
@@ -223,13 +223,10 @@ easy interactive way to set this from the Server buffer."
        (t
         (gnus-message 1 "Unknown type %s; ignoring" type))))))
 
-(defun gnus-cloud-update-newsrc-data (group elem &optional force-older)
-  "Update the newsrc data for GROUP from ELEM.
-Use old data if FORCE-OLDER is not nil."
+(defun gnus-cloud-update-newsrc-data (group elem)
+  "Update the newsrc data for GROUP from ELEM."
   (let* ((contents (plist-get elem :contents))
          (date (or (plist-get elem :timestamp) "0"))
-         (now (gnus-cloud-timestamp nil))
-         (newer (string-lessp date now))
          (group-info (gnus-get-info group)))
     (if (and contents
              (stringp (nth 0 contents))
@@ -238,15 +235,13 @@ Use old data if FORCE-OLDER is not nil."
             (if (equal (format "%S" group-info)
                        (format "%S" contents))
                 (gnus-message 3 "Skipping cloud update of group %s, the info 
is the same" group)
-              (if (and newer (not force-older))
-                (gnus-message 3 "Skipping outdated cloud info for group %s, 
the info is from %s (now is %s)" group date now)
-                (when (or (not gnus-cloud-interactive)
-                          (gnus-y-or-n-p
-                           (format "%s has older different info in the cloud 
as of %s, update it here? "
-                                  group date)))
-                 (gnus-message 2 "Installing cloud update of group %s" group)
-                 (gnus-set-info group contents)
-                 (gnus-group-update-group group))))
+              (when (or (not gnus-cloud-interactive)
+                       (gnus-y-or-n-p
+                        (format "%s has different info in the cloud from %s, 
update it here? "
+                                group date)))
+               (gnus-message 2 "Installing cloud update of group %s" group)
+               (gnus-set-info group contents)
+               (gnus-group-update-group group)))
           (gnus-error 1 "Sorry, group %s is not subscribed" group))
       (gnus-error 1 "Sorry, could not update newsrc for group %s (invalid data 
%S)"
                   group elem))))
@@ -380,8 +375,9 @@ When FULL is t, upload everything, not just a difference 
from the last full."
                   (gnus-cloud-files-to-upload full)
                   (gnus-cloud-collect-full-newsrc)))
           (group (gnus-group-full-name gnus-cloud-group-name 
gnus-cloud-method)))
+      (setq gnus-cloud-sequence (1+ (or gnus-cloud-sequence 0)))
       (insert (format "Subject: (sequence: %s type: %s storage-method: %s)\n"
-                      (or gnus-cloud-sequence "UNKNOWN")
+                      gnus-cloud-sequence
                       (if full :full :partial)
                       gnus-cloud-storage-method))
       (insert "From: nobody@gnus.cloud.invalid\n")
@@ -390,7 +386,6 @@ When FULL is t, upload everything, not just a difference 
from the last full."
       (if (gnus-request-accept-article gnus-cloud-group-name gnus-cloud-method
                                        t t)
           (progn
-            (setq gnus-cloud-sequence (1+ (or gnus-cloud-sequence 0)))
             (gnus-cloud-add-timestamps elems)
             (gnus-message 3 "Uploaded Gnus Cloud data successfully to %s" 
group)
             (gnus-group-refresh-group group))
@@ -459,18 +454,21 @@ instead of `gnus-cloud-sequence'.
 When UPDATE is t, returns the result of calling `gnus-cloud-update-all'.
 Otherwise, returns the Gnus Cloud data chunks."
   (let ((articles nil)
+       (highest-sequence-seen gnus-cloud-sequence)
         chunks)
     (dolist (header (gnus-cloud-available-chunks))
-      (when (> (gnus-cloud-chunk-sequence (mail-header-subject header))
-               (or sequence-override gnus-cloud-sequence -1))
-
-        (if (string-match (format "storage-method: %s" 
gnus-cloud-storage-method)
-                          (mail-header-subject header))
-            (push (mail-header-number header) articles)
-          (gnus-message 1 "Skipping article %s because it didn't match the 
Gnus Cloud method %s: %s"
-                        (mail-header-number header)
-                        gnus-cloud-storage-method
-                        (mail-header-subject header)))))
+      (let ((this-sequence (gnus-cloud-chunk-sequence (mail-header-subject 
header))))
+       (when (> this-sequence (or sequence-override gnus-cloud-sequence -1))
+
+         (if (string-match (format "storage-method: %s" 
gnus-cloud-storage-method)
+                           (mail-header-subject header))
+             (progn
+               (push (mail-header-number header) articles)
+               (setq highest-sequence-seen (max highest-sequence-seen 
this-sequence)))
+           (gnus-message 1 "Skipping article %s because it didn't match the 
Gnus Cloud method %s: %s"
+                         (mail-header-number header)
+                         gnus-cloud-storage-method
+                         (mail-header-subject header))))))
     (when articles
       (nnimap-request-articles (nreverse articles) gnus-cloud-group-name)
       (with-current-buffer nntp-server-buffer
@@ -480,7 +478,9 @@ Otherwise, returns the Gnus Cloud data chunks."
           (push (gnus-cloud-parse-chunk) chunks)
           (forward-line 1))))
     (if update
-        (mapcar #'gnus-cloud-update-all chunks)
+        (progn
+         (mapcar #'gnus-cloud-update-all chunks)
+         (setq gnus-cloud-sequence highest-sequence-seen))
       chunks)))
 
 (defun gnus-cloud-server-p (server)
-- 
2.25.1

dme.
-- 
And the sign said: long haired freaky people need not apply.