gnus-cloud.el 19.3 KB
Newer Older
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
1 2
;;; gnus-cloud.el --- storing and retrieving data via IMAP

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20

;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
21
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
22 23 24

;;; Commentary:

25 26 27 28
;; The name gnus-cloud parodizes but otherwise has little to do with
;; "cloud computing", a misleading term normally best avoided.  See:
;; https://www.gnu.org/philosophy/words-to-avoid.html#CloudComputing

Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
29 30 31 32 33 34
;;; Code:

(eval-when-compile (require 'cl))
(require 'parse-time)
(require 'nnimap)

35 36 37 38 39 40
(eval-when-compile (require 'epg)) ;; setf-method for `epg-context-armor'
(autoload 'epg-make-context "epg")
(autoload 'epg-context-set-passphrase-callback "epg")
(autoload 'epg-decrypt-string "epg")
(autoload 'epg-encrypt-string "epg")

Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
41 42
(defgroup gnus-cloud nil
  "Syncing Gnus data via IMAP."
43
  :version "25.1"
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
44 45 46 47 48 49 50 51 52
  :group 'gnus)

(defcustom gnus-cloud-synced-files
  '(;;"~/.authinfo"
    "~/.authinfo.gpg"
    "~/.gnus.el"
    (:directory "~/News" :match ".*.SCORE\\'"))
  "List of file regexps that should be kept up-to-date via the cloud."
  :group 'gnus-cloud
53
  ;; FIXME this type does not match the default.  Nor does the documentation.
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
54 55
  :type '(repeat regexp))

56 57
(defcustom gnus-cloud-storage-method (if (featurep 'epg) 'epg 'base64-gzip)
  "Storage method for cloud data, defaults to EPG if that's available."
58
  :version "26.1"
59 60 61 62 63 64 65 66
  :group 'gnus-cloud
  :type '(radio (const :tag "No encoding" nil)
                (const :tag "Base64" base64)
                (const :tag "Base64+gzip" base64-gzip)
                (const :tag "EPG" epg)))

(defcustom gnus-cloud-interactive t
  "Whether Gnus Cloud changes should be confirmed."
67
  :version "26.1"
68 69 70 71
  :group 'gnus-cloud
  :type 'boolean)

(defvar gnus-cloud-group-name "Emacs-Cloud")
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
72 73 74 75 76
(defvar gnus-cloud-covered-servers nil)

(defvar gnus-cloud-version 1)
(defvar gnus-cloud-sequence 1)

77 78 79 80 81 82 83
(defcustom gnus-cloud-method nil
  "The IMAP select method used to store the cloud data.
See also `gnus-server-toggle-cloud-method-server' for an
easy interactive way to set this from the Server buffer."
  :group 'gnus-cloud
  :type '(radio (const :tag "Not set" nil)
                (string :tag "A Gnus server name as a string")))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
84 85 86

(defun gnus-cloud-make-chunk (elems)
  (with-temp-buffer
87
    (insert (format "Gnus-Cloud-Version %s\n" gnus-cloud-version))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
88 89 90 91 92 93 94 95
    (insert (gnus-cloud-insert-data elems))
    (buffer-string)))

(defun gnus-cloud-insert-data (elems)
  (mm-with-unibyte-buffer
    (dolist (elem elems)
      (cond
       ((eq (plist-get elem :type) :file)
96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
        (let (length data)
          (mm-with-unibyte-buffer
            (insert-file-contents-literally (plist-get elem :file-name))
            (setq length (buffer-size)
                  data (buffer-string)))
          (insert (format "(:type :file :file-name %S :timestamp %S :length %d)\n"
                          (plist-get elem :file-name)
                          (plist-get elem :timestamp)
                          length))
          (insert data)
          (insert "\n")))
       ((eq (plist-get elem :type) :newsrc-data)
        (let ((print-level nil)
              (print-length nil))
          (print elem (current-buffer)))
        (insert "\n"))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
112
       ((eq (plist-get elem :type) :delete)
113 114
        (insert (format "(:type :delete :file-name %S)\n"
                        (plist-get elem :file-name))))))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
115 116 117 118
    (gnus-cloud-encode-data)
    (buffer-string)))

(defun gnus-cloud-encode-data ()
119 120
  (cond
   ((eq gnus-cloud-storage-method 'base64-gzip)
121 122 123 124 125
    (progn
      (call-process-region (point-min) (point-max) "gzip"
                           t (current-buffer) nil
                           "-c")
      (base64-encode-region (point-min) (point-max))))
126

127
   ((eq gnus-cloud-storage-method 'base64)
128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146
    (base64-encode-region (point-min) (point-max)))

   ((eq gnus-cloud-storage-method 'epg)
    (let ((context (epg-make-context 'OpenPGP))
          cipher)
      (setf (epg-context-armor context) t)
      (setf (epg-context-textmode context) t)
      (let ((data (epg-encrypt-string context
                                      (buffer-substring-no-properties
                                       (point-min)
                                       (point-max))
                                      nil)))
        (delete-region (point-min) (point-max))
        (insert data))))

   ((null gnus-cloud-storage-method)
    (gnus-message 5 "Leaving cloud data plaintext"))
   (t (gnus-error 1 "Invalid cloud storage method %S"
                  gnus-cloud-storage-method))))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
147 148

(defun gnus-cloud-decode-data ()
149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170
  (cond
   ((memq gnus-cloud-storage-method '(base64 base64-gzip))
    (base64-decode-region (point-min) (point-max)))

   ((eq gnus-cloud-storage-method 'base64-gzip)
    (call-process-region (point-min) (point-max) "gunzip"
                         t (current-buffer) nil
                         "-c"))

   ((eq gnus-cloud-storage-method 'epg)
    (let* ((context (epg-make-context 'OpenPGP))
           (data (epg-decrypt-string context (buffer-substring-no-properties
                                              (point-min)
                                              (point-max)))))
      (delete-region (point-min) (point-max))
      (insert data)))

   ((null gnus-cloud-storage-method)
    (gnus-message 5 "Reading cloud data as plaintext"))

   (t (gnus-error 1 "Invalid cloud storage method %S"
                  gnus-cloud-storage-method))))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
171 172 173

(defun gnus-cloud-parse-chunk ()
  (save-excursion
174
    (unless (looking-at "Gnus-Cloud-Version \\([0-9]+\\)")
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
175 176 177
      (error "Not a valid Cloud chunk in the current buffer"))
    (forward-line 1)
    (let ((version (string-to-number (match-string 1)))
178
          (data (buffer-substring (point) (point-max))))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
179
      (mm-with-unibyte-buffer
180 181 182 183 184 185 186 187
        (insert data)
        (cond
         ((= version 1)
          (gnus-cloud-decode-data)
          (goto-char (point-min))
          (gnus-cloud-parse-version-1))
         (t
          (error "Unsupported Cloud chunk version %s" version)))))))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
188 189 190 191 192

(defun gnus-cloud-parse-version-1 ()
  (let ((elems nil))
    (while (not (eobp))
      (while (and (not (eobp))
193 194
                  (not (looking-at "(:type")))
        (forward-line 1))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
195
      (unless (eobp)
196 197 198 199 200 201 202 203 204 205 206 207 208 209
        (let ((spec (ignore-errors (read (current-buffer))))
              length)
          (when (consp spec)
            (cond
             ((memq (plist-get spec :type) '(:file :delete))
              (setq length (plist-get spec :length))
              (push (append spec
                            (list
                             :contents (buffer-substring (1+ (point))
                                                         (+ (point) 1 length))))
                    elems)
              (goto-char (+ (point) 1 length)))
             ((memq (plist-get spec :type) '(:newsrc-data))
              (push spec elems)))))))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
210 211
    (nreverse elems)))

212
(defun gnus-cloud-update-all (elems)
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
213 214 215
  (dolist (elem elems)
    (let ((type (plist-get elem :type)))
      (cond
216 217 218 219
       ((eq type :newsrc-data)
        (gnus-cloud-update-newsrc-data (plist-get elem :name) elem))
       ((memq type '(:delete :file))
        (gnus-cloud-update-file elem type))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
220
       (t
221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278
        (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."
  (let* ((contents (plist-get elem :contents))
         (date (or (plist-get elem :timestamp) "0"))
         (now (gnus-cloud-timestamp (current-time)))
         (newer (string-lessp date now))
         (group-info (gnus-get-info group)))
    (if (and contents
             (stringp (nth 0 contents))
             (integerp (nth 1 contents)))
        (if group-info
            (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)))
          (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))))

(defun gnus-cloud-update-file (elem op)
  "Apply Gnus Cloud data ELEM and operation OP to a file."
  (let* ((file-name (plist-get elem :file-name))
         (date (plist-get elem :timestamp))
         (contents (plist-get elem :contents))
         (exists (file-exists-p file-name)))
    (if (gnus-cloud-file-covered-p file-name)
        (cond
         ((eq op :delete)
          (if (and exists
                   ;; prompt only if the file exists already
                   (or (not gnus-cloud-interactive)
                       (gnus-y-or-n-p (format "%s has been deleted as of %s, delete it locally? "
                                              file-name date))))
              (rename-file file-name (car (find-backup-file-name file-name)))
            (gnus-message 3 "%s was already deleted before the cloud got it" file-name)))
         ((eq op :file)
          (when (or (not exists)
                    (and exists
                         (mm-with-unibyte-buffer
                           (insert-file-contents-literally file-name)
                           (not (equal (buffer-string) contents)))
                         ;; prompt only if the file exists already
                         (or (not gnus-cloud-interactive)
                             (gnus-y-or-n-p (format "%s has updated contents as of %s, update it? "
                                                    file-name date)))))
            (gnus-cloud-replace-file file-name date contents))))
      (gnus-message 2 "%s isn't covered by the cloud; ignoring" file-name))))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
279 280 281 282 283 284 285 286 287 288 289 290 291 292

(defun gnus-cloud-replace-file (file-name date new-contents)
  (mm-with-unibyte-buffer
    (insert new-contents)
    (when (file-exists-p file-name)
      (rename-file file-name (car (find-backup-file-name file-name))))
    (write-region (point-min) (point-max) file-name)
    (set-file-times file-name (parse-iso8601-time-string date))))

(defun gnus-cloud-file-covered-p (file-name)
  (let ((matched nil))
    (dolist (elem gnus-cloud-synced-files)
      (cond
       ((stringp elem)
293 294
        (when (equal elem file-name)
          (setq matched t)))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
295
       ((consp elem)
296 297 298 299 300
        (when (and (equal (directory-file-name (plist-get elem :directory))
                          (directory-file-name (file-name-directory file-name)))
                   (string-match (plist-get elem :match)
                                 (file-name-nondirectory file-name)))
          (setq matched t)))))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
301 302 303 304 305 306 307
    matched))

(defun gnus-cloud-all-files ()
  (let ((files nil))
    (dolist (elem gnus-cloud-synced-files)
      (cond
       ((stringp elem)
308
        (push elem files))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
309
       ((consp elem)
310 311 312 313 314 315 316
        (dolist (file (directory-files (plist-get elem :directory)
                                       nil
                                       (plist-get elem :match)))
          (push (format "%s/%s"
                        (directory-file-name (plist-get elem :directory))
                        file)
                files)))))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
317 318 319 320 321 322
    (nreverse files)))

(defvar gnus-cloud-file-timestamps nil)

(defun gnus-cloud-files-to-upload (&optional full)
  (let ((files nil)
323
        timestamp)
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
324 325
    (dolist (file (gnus-cloud-all-files))
      (if (file-exists-p file)
326 327 328 329
          (when (setq timestamp (gnus-cloud-file-new-p file full))
            (push `(:type :file :file-name ,file :timestamp ,timestamp) files))
        (when (assoc file gnus-cloud-file-timestamps)
          (push `(:type :delete :file-name ,file) files))))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
330 331
    (nreverse files)))

332 333 334 335
(defun gnus-cloud-timestamp (time)
  "Return a general timestamp string for TIME."
  (format-time-string "%FT%T%z" time))

Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
336
(defun gnus-cloud-file-new-p (file full)
337 338
  (let ((timestamp (gnus-cloud-timestamp (nth 5 (file-attributes file))))
        (old (cadr (assoc file gnus-cloud-file-timestamps))))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
339
    (when (or full
340 341
              (null old)
              (string< old timestamp))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
342 343
      timestamp)))

344
(declare-function gnus-activate-group "gnus-start"
345
                  (group &optional scan dont-check method dont-sub-check))
346
(declare-function gnus-subscribe-group "gnus-start"
347
                  (group &optional previous method))
348

Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
349 350
(defun gnus-cloud-ensure-cloud-group ()
  (let ((method (if (stringp gnus-cloud-method)
351 352
                    (gnus-server-to-method gnus-cloud-method)
                  gnus-cloud-method)))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
353
    (unless (or (gnus-active gnus-cloud-group-name)
354 355
                (gnus-activate-group gnus-cloud-group-name nil nil
                                     gnus-cloud-method))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
356
      (and (gnus-request-create-group gnus-cloud-group-name gnus-cloud-method)
357 358 359 360 361 362 363
           (gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method)
           (gnus-subscribe-group gnus-cloud-group-name)))))

(defun gnus-cloud-upload-all-data ()
  "Upload all data (newsrc and files) to the Gnus Cloud."
  (interactive)
  (gnus-cloud-upload-data t))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
364 365

(defun gnus-cloud-upload-data (&optional full)
366 367 368
  "Upload data (newsrc and files) to the Gnus Cloud.
When FULL is t, upload everything, not just a difference from the last full."
  (interactive)
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
369 370
  (gnus-cloud-ensure-cloud-group)
  (with-temp-buffer
371 372 373 374 375 376 377 378 379
    (let ((elems (append
                  (gnus-cloud-files-to-upload full)
                  (gnus-cloud-collect-full-newsrc)))
          (group (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method)))
      (insert (format "Subject: (sequence: %s type: %s storage-method: %s)\n"
                      (or gnus-cloud-sequence "UNKNOWN")
                      (if full :full :partial)
                      gnus-cloud-storage-method))
      (insert "From: nobody@gnus.cloud.invalid\n")
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
380 381
      (insert "\n")
      (insert (gnus-cloud-make-chunk elems))
382 383 384 385 386 387 388 389
      (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))
        (gnus-error 2 "Failed to upload Gnus Cloud data to %s" group)))))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
390 391 392 393

(defun gnus-cloud-add-timestamps (elems)
  (dolist (elem elems)
    (let* ((file-name (plist-get elem :file-name))
394
           (old (assoc file-name gnus-cloud-file-timestamps)))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
395
      (when old
396 397
        (setq gnus-cloud-file-timestamps
              (delq old gnus-cloud-file-timestamps)))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
398
      (push (list file-name (plist-get elem :timestamp))
399
            gnus-cloud-file-timestamps))))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
400 401 402 403

(defun gnus-cloud-available-chunks ()
  (gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method)
  (let* ((group (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method))
404 405
         (active (gnus-active group))
         headers head)
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
406 407
    (when (gnus-retrieve-headers (gnus-uncompress-range active) group)
      (with-current-buffer nntp-server-buffer
408 409 410 411
        (goto-char (point-min))
        (while (and (not (eobp))
                    (setq head (nnheader-parse-head)))
          (push head headers))))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
412
    (sort (nreverse headers)
413 414 415
          (lambda (h1 h2)
            (> (gnus-cloud-chunk-sequence (mail-header-subject h1))
               (gnus-cloud-chunk-sequence (mail-header-subject h2)))))))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
416 417 418 419 420 421

(defun gnus-cloud-chunk-sequence (string)
  (if (string-match "sequence: \\([0-9]+\\)" string)
      (string-to-number (match-string 1 string))
    0))

422
;; TODO: use this
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
423 424
(defun gnus-cloud-prune-old-chunks (headers)
  (let ((headers (reverse headers))
425
        (found nil))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
426
  (while (and headers
427
              (not found))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
428 429 430 431 432 433 434 435
    (when (string-match "type: :full" (mail-header-subject (car headers)))
      (setq found t))
    (pop headers))
  ;; All the chunks that are older than the newest :full chunk can be
  ;; deleted.
  (when headers
    (gnus-request-expire-articles
     (mapcar (lambda (h)
436 437
               (mail-header-number h))
             (nreverse headers))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
438 439
     (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method)))))

440 441 442 443 444 445 446 447 448 449 450 451 452
(defun gnus-cloud-download-all-data ()
  "Download the Gnus Cloud data and install it.
Starts at `gnus-cloud-sequence' in the sequence."
  (interactive)
  (gnus-cloud-download-data t))

(defun gnus-cloud-download-data (&optional update sequence-override)
  "Download the Gnus Cloud data and install it if UPDATE is t.
When SEQUENCE-OVERRIDE is given, start at that sequence number
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."
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
453
  (let ((articles nil)
454
        chunks)
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
455 456
    (dolist (header (gnus-cloud-available-chunks))
      (when (> (gnus-cloud-chunk-sequence (mail-header-subject header))
457 458 459 460 461 462 463 464 465
               (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)))))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
466 467 468
    (when articles
      (nnimap-request-articles (nreverse articles) gnus-cloud-group-name)
      (with-current-buffer nntp-server-buffer
469 470 471 472 473 474 475 476
        (goto-char (point-min))
        (while (re-search-forward "^Gnus-Cloud-Version " nil t)
          (beginning-of-line)
          (push (gnus-cloud-parse-chunk) chunks)
          (forward-line 1))))
    (if update
        (mapcar #'gnus-cloud-update-all chunks)
      chunks)))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
477 478 479 480

(defun gnus-cloud-server-p (server)
  (member server gnus-cloud-covered-servers))

481 482 483 484 485 486
(defun gnus-cloud-host-server-p (server)
  (equal gnus-cloud-method server))

(defun gnus-cloud-host-acceptable-method-p (server)
  (eq (car-safe (gnus-server-to-method server)) 'nnimap))

487
(defun gnus-cloud-collect-full-newsrc ()
488
  "Collect all the Gnus newsrc data in a portable format."
489 490 491
  (let ((infos nil))
    (dolist (info (cdr gnus-newsrc-alist))
      (when (gnus-cloud-server-p
492 493 494 495 496 497
             (gnus-method-to-server
              (gnus-find-method-for-group (gnus-info-group info))))

        (push `(:type :newsrc-data :name ,(gnus-info-group info) :contents ,info :timestamp ,(gnus-cloud-timestamp (current-time)))
              infos)))
    infos))
498

Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
499 500 501
(provide 'gnus-cloud)

;;; gnus-cloud.el ends here