diff options
| author | David Edmondson | 2020-03-28 19:03:58 +0000 |
|---|---|---|
| committer | Ted Zlatanov | 2020-06-16 14:10:52 -0400 |
| commit | a77ac015b3fecc4a63ae42712b693e3158fc5452 (patch) | |
| tree | 4faa8d8fd9370394402a52d23440933b8c8479b8 | |
| parent | 4503dcf635aae4d40024267d373332bab588009f (diff) | |
| download | emacs-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.
| -rw-r--r-- | lisp/gnus/gnus-cloud.el | 54 |
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." |
| 228 | Use 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'. | |||
| 459 | When UPDATE is t, returns the result of calling `gnus-cloud-update-all'. | 454 | When UPDATE is t, returns the result of calling `gnus-cloud-update-all'. |
| 460 | Otherwise, returns the Gnus Cloud data chunks." | 455 | Otherwise, 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) |