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 /lisp | |
| 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.
Diffstat (limited to 'lisp')
| -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) |