aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorDavid Edmondson2020-03-28 19:03:58 +0000
committerTed Zlatanov2020-06-16 14:10:52 -0400
commita77ac015b3fecc4a63ae42712b693e3158fc5452 (patch)
tree4faa8d8fd9370394402a52d23440933b8c8479b8 /lisp
parent4503dcf635aae4d40024267d373332bab588009f (diff)
downloademacs-a77ac015b3fecc4a63ae42712b693e3158fc5452.tar.gz
emacs-a77ac015b3fecc4a63ae42712b693e3158fc5452.zip
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.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/gnus/gnus-cloud.el54
1 files changed, 27 insertions, 27 deletions
diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el
index da6231d7330..7ea691e7220 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."
223 (t 223 (t
224 (gnus-message 1 "Unknown type %s; ignoring" type)))))) 224 (gnus-message 1 "Unknown type %s; ignoring" type))))))
225 225
226(defun gnus-cloud-update-newsrc-data (group elem &optional force-older) 226(defun gnus-cloud-update-newsrc-data (group elem)
227 "Update the newsrc data for GROUP from ELEM. 227 "Update the newsrc data for GROUP from ELEM."
228Use old data if FORCE-OLDER is not nil."
229 (let* ((contents (plist-get elem :contents)) 228 (let* ((contents (plist-get elem :contents))
230 (date (or (plist-get elem :timestamp) "0")) 229 (date (or (plist-get elem :timestamp) "0"))
231 (now (gnus-cloud-timestamp nil))
232 (newer (string-lessp date now))
233 (group-info (gnus-get-info group))) 230 (group-info (gnus-get-info group)))
234 (if (and contents 231 (if (and contents
235 (stringp (nth 0 contents)) 232 (stringp (nth 0 contents))
@@ -238,15 +235,13 @@ Use old data if FORCE-OLDER is not nil."
238 (if (equal (format "%S" group-info) 235 (if (equal (format "%S" group-info)
239 (format "%S" contents)) 236 (format "%S" contents))
240 (gnus-message 3 "Skipping cloud update of group %s, the info is the same" group) 237 (gnus-message 3 "Skipping cloud update of group %s, the info is the same" group)
241 (if (and newer (not force-older)) 238 (when (or (not gnus-cloud-interactive)
242 (gnus-message 3 "Skipping outdated cloud info for group %s, the info is from %s (now is %s)" group date now) 239 (gnus-y-or-n-p
243 (when (or (not gnus-cloud-interactive) 240 (format "%s has different info in the cloud from %s, update it here? "
244 (gnus-y-or-n-p 241 group date)))
245 (format "%s has older different info in the cloud as of %s, update it here? " 242 (gnus-message 2 "Installing cloud update of group %s" group)
246 group date))) 243 (gnus-set-info group contents)
247 (gnus-message 2 "Installing cloud update of group %s" group) 244 (gnus-group-update-group group)))
248 (gnus-set-info group contents)
249 (gnus-group-update-group group))))
250 (gnus-error 1 "Sorry, group %s is not subscribed" group)) 245 (gnus-error 1 "Sorry, group %s is not subscribed" group))
251 (gnus-error 1 "Sorry, could not update newsrc for group %s (invalid data %S)" 246 (gnus-error 1 "Sorry, could not update newsrc for group %s (invalid data %S)"
252 group elem)))) 247 group elem))))
@@ -380,8 +375,9 @@ When FULL is t, upload everything, not just a difference from the last full."
380 (gnus-cloud-files-to-upload full) 375 (gnus-cloud-files-to-upload full)
381 (gnus-cloud-collect-full-newsrc))) 376 (gnus-cloud-collect-full-newsrc)))
382 (group (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method))) 377 (group (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method)))
378 (setq gnus-cloud-sequence (1+ (or gnus-cloud-sequence 0)))
383 (insert (format "Subject: (sequence: %s type: %s storage-method: %s)\n" 379 (insert (format "Subject: (sequence: %s type: %s storage-method: %s)\n"
384 (or gnus-cloud-sequence "UNKNOWN") 380 gnus-cloud-sequence
385 (if full :full :partial) 381 (if full :full :partial)
386 gnus-cloud-storage-method)) 382 gnus-cloud-storage-method))
387 (insert "From: nobody@gnus.cloud.invalid\n") 383 (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."
390 (if (gnus-request-accept-article gnus-cloud-group-name gnus-cloud-method 386 (if (gnus-request-accept-article gnus-cloud-group-name gnus-cloud-method
391 t t) 387 t t)
392 (progn 388 (progn
393 (setq gnus-cloud-sequence (1+ (or gnus-cloud-sequence 0)))
394 (gnus-cloud-add-timestamps elems) 389 (gnus-cloud-add-timestamps elems)
395 (gnus-message 3 "Uploaded Gnus Cloud data successfully to %s" group) 390 (gnus-message 3 "Uploaded Gnus Cloud data successfully to %s" group)
396 (gnus-group-refresh-group group)) 391 (gnus-group-refresh-group group))
@@ -459,18 +454,21 @@ instead of `gnus-cloud-sequence'.
459When UPDATE is t, returns the result of calling `gnus-cloud-update-all'. 454When UPDATE is t, returns the result of calling `gnus-cloud-update-all'.
460Otherwise, returns the Gnus Cloud data chunks." 455Otherwise, returns the Gnus Cloud data chunks."
461 (let ((articles nil) 456 (let ((articles nil)
457 (highest-sequence-seen gnus-cloud-sequence)
462 chunks) 458 chunks)
463 (dolist (header (gnus-cloud-available-chunks)) 459 (dolist (header (gnus-cloud-available-chunks))
464 (when (> (gnus-cloud-chunk-sequence (mail-header-subject header)) 460 (let ((this-sequence (gnus-cloud-chunk-sequence (mail-header-subject header))))
465 (or sequence-override gnus-cloud-sequence -1)) 461 (when (> this-sequence (or sequence-override gnus-cloud-sequence -1))
466 462
467 (if (string-match (format "storage-method: %s" gnus-cloud-storage-method) 463 (if (string-match (format "storage-method: %s" gnus-cloud-storage-method)
468 (mail-header-subject header)) 464 (mail-header-subject header))
469 (push (mail-header-number header) articles) 465 (progn
470 (gnus-message 1 "Skipping article %s because it didn't match the Gnus Cloud method %s: %s" 466 (push (mail-header-number header) articles)
471 (mail-header-number header) 467 (setq highest-sequence-seen (max highest-sequence-seen this-sequence)))
472 gnus-cloud-storage-method 468 (gnus-message 1 "Skipping article %s because it didn't match the Gnus Cloud method %s: %s"
473 (mail-header-subject header))))) 469 (mail-header-number header)
470 gnus-cloud-storage-method
471 (mail-header-subject header))))))
474 (when articles 472 (when articles
475 (nnimap-request-articles (nreverse articles) gnus-cloud-group-name) 473 (nnimap-request-articles (nreverse articles) gnus-cloud-group-name)
476 (with-current-buffer nntp-server-buffer 474 (with-current-buffer nntp-server-buffer
@@ -480,7 +478,9 @@ Otherwise, returns the Gnus Cloud data chunks."
480 (push (gnus-cloud-parse-chunk) chunks) 478 (push (gnus-cloud-parse-chunk) chunks)
481 (forward-line 1)))) 479 (forward-line 1))))
482 (if update 480 (if update
483 (mapcar #'gnus-cloud-update-all chunks) 481 (progn
482 (mapcar #'gnus-cloud-update-all chunks)
483 (setq gnus-cloud-sequence highest-sequence-seen))
484 chunks))) 484 chunks)))
485 485
486(defun gnus-cloud-server-p (server) 486(defun gnus-cloud-server-p (server)