X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/60dd094a8c7bdbbff121c99f56f42910534e7cc1..30b3a842ec87d27cfe003b6d4323689d48b3fcd2:/lisp/gnus/gnus-cloud.el

diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el
index a6a0f64603..22086b1f36 100644
--- a/lisp/gnus/gnus-cloud.el
+++ b/lisp/gnus/gnus-cloud.el
@@ -28,6 +28,12 @@
 (require 'parse-time)
 (require 'nnimap)
 
+(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")
+
 (defgroup gnus-cloud nil
   "Syncing Gnus data via IMAP."
   :version "25.1"
@@ -43,18 +49,36 @@
   ;; FIXME this type does not match the default.  Nor does the documentation.
   :type '(repeat regexp))
 
-(defvar gnus-cloud-group-name "*Emacs Cloud*")
+(defcustom gnus-cloud-storage-method (if (featurep 'epg) 'epg 'base64-gzip)
+  "Storage method for cloud data, defaults to EPG if that's available."
+  :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."
+  :group 'gnus-cloud
+  :type 'boolean)
+
+(defvar gnus-cloud-group-name "Emacs-Cloud")
 (defvar gnus-cloud-covered-servers nil)
 
 (defvar gnus-cloud-version 1)
 (defvar gnus-cloud-sequence 1)
 
-(defvar gnus-cloud-method nil
-  "The IMAP select method used to store the cloud data.")
+(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")))
 
 (defun gnus-cloud-make-chunk (elems)
   (with-temp-buffer
-    (insert (format "Version %s\n" gnus-cloud-version))
+    (insert (format "Gnus-Cloud-Version %s\n" gnus-cloud-version))
     (insert (gnus-cloud-insert-data elems))
     (buffer-string)))
 
@@ -63,106 +87,187 @@
     (dolist (elem elems)
       (cond
        ((eq (plist-get elem :type) :file)
-	(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) :data)
-	(insert (format "(:type :data :name %S :length %d)\n"
-			(plist-get elem :name)
-			(with-current-buffer (plist-get elem :buffer)
-			  (buffer-size))))
-	(insert-buffer-substring (plist-get elem :buffer))
-	(insert "\n"))
+        (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"))
        ((eq (plist-get elem :type) :delete)
-	(insert (format "(:type :delete :file-name %S)\n"
-			(plist-get elem :file-name))))))
+        (insert (format "(:type :delete :file-name %S)\n"
+                        (plist-get elem :file-name))))))
     (gnus-cloud-encode-data)
     (buffer-string)))
 
 (defun gnus-cloud-encode-data ()
-  (call-process-region (point-min) (point-max) "gzip"
-		       t (current-buffer) nil
-		       "-c")
-  (base64-encode-region (point-min) (point-max)))
+  (cond
+   ((eq gnus-cloud-storage-method 'base64-gzip)
+    (call-process-region (point-min) (point-max) "gzip"
+                         t (current-buffer) nil
+                         "-c"))
+
+   ((memq gnus-cloud-storage-method '(base64 base64-gzip))
+    (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))))
 
 (defun gnus-cloud-decode-data ()
-  (base64-decode-region (point-min) (point-max))
-  (call-process-region (point-min) (point-max) "gunzip"
-		       t (current-buffer) nil
-		       "-c"))
+  (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))))
 
 (defun gnus-cloud-parse-chunk ()
   (save-excursion
-    (goto-char (point-min))
-    (unless (looking-at "Version \\([0-9]+\\)")
+    (unless (looking-at "Gnus-Cloud-Version \\([0-9]+\\)")
       (error "Not a valid Cloud chunk in the current buffer"))
     (forward-line 1)
     (let ((version (string-to-number (match-string 1)))
-	  (data (buffer-substring (point) (point-max))))
+          (data (buffer-substring (point) (point-max))))
       (mm-with-unibyte-buffer
-	(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)))))))
+        (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)))))))
 
 (defun gnus-cloud-parse-version-1 ()
   (let ((elems nil))
     (while (not (eobp))
       (while (and (not (eobp))
-		  (not (looking-at "(:type")))
-	(forward-line 1))
+                  (not (looking-at "(:type")))
+        (forward-line 1))
       (unless (eobp)
-	(let ((spec (ignore-errors (read (current-buffer))))
-	      length)
-	  (when (and (consp spec)
-		     (memq (plist-get spec :type) '(:file :data :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))))))
+        (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)))))))
     (nreverse elems)))
 
-(defun gnus-cloud-update-data (elems)
+(defun gnus-cloud-update-all (elems)
   (dolist (elem elems)
     (let ((type (plist-get elem :type)))
       (cond
-       ((eq type :data)
-	)
-       ((eq type :delete)
-	(gnus-cloud-delete-file (plist-get elem :file-name))
-	)
-       ((eq type :file)
-	(gnus-cloud-update-file elem))
+       ((eq type :newsrc-data)
+        (gnus-cloud-update-newsrc-data (plist-get elem :name) elem))
+       ((memq type '(:delete :file))
+        (gnus-cloud-update-file elem type))
        (t
-	(message "Unknown type %s; ignoring" type))))))
-
-(defun gnus-cloud-update-file (elem)
-  (let ((file-name (plist-get elem :file-name))
-	(date (plist-get elem :timestamp))
-	(contents (plist-get elem :contents)))
-    (unless (gnus-cloud-file-covered-p file-name)
-      (message "%s isn't covered by the cloud; ignoring" file-name))
-    (when (or (not (file-exists-p file-name))
-	      (and (file-exists-p file-name)
-		   (mm-with-unibyte-buffer
-		     (insert-file-contents-literally file-name)
-		     (not (equal (buffer-string) contents)))))
-      (gnus-cloud-replace-file file-name date contents))))
+        (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))))
 
 (defun gnus-cloud-replace-file (file-name date new-contents)
   (mm-with-unibyte-buffer
@@ -172,25 +277,19 @@
     (write-region (point-min) (point-max) file-name)
     (set-file-times file-name (parse-iso8601-time-string date))))
 
-(defun gnus-cloud-delete-file (file-name)
-  (unless (gnus-cloud-file-covered-p file-name)
-    (message "%s isn't covered by the cloud; ignoring" file-name))
-  (when (file-exists-p file-name)
-    (rename-file file-name (car (find-backup-file-name file-name)))))
-
 (defun gnus-cloud-file-covered-p (file-name)
   (let ((matched nil))
     (dolist (elem gnus-cloud-synced-files)
       (cond
        ((stringp elem)
-	(when (equal elem file-name)
-	  (setq matched t)))
+        (when (equal elem file-name)
+          (setq matched t)))
        ((consp elem)
-	(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)))))
+        (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)))))
     matched))
 
 (defun gnus-cloud-all-files ()
@@ -198,106 +297,126 @@
     (dolist (elem gnus-cloud-synced-files)
       (cond
        ((stringp elem)
-	(push elem files))
+        (push elem files))
        ((consp elem)
-	(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)))))
+        (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)))))
     (nreverse files)))
 
 (defvar gnus-cloud-file-timestamps nil)
 
 (defun gnus-cloud-files-to-upload (&optional full)
   (let ((files nil)
-	timestamp)
+        timestamp)
     (dolist (file (gnus-cloud-all-files))
       (if (file-exists-p file)
-	  (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))))
+          (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))))
     (nreverse files)))
 
+(defun gnus-cloud-timestamp (time)
+  "Return a general timestamp string for TIME."
+  (format-time-string "%FT%T%z" time))
+
 (defun gnus-cloud-file-new-p (file full)
-  (let ((timestamp (format-time-string
-		    "%FT%T%z" (nth 5 (file-attributes file))))
-	(old (cadr (assoc file gnus-cloud-file-timestamps))))
+  (let ((timestamp (gnus-cloud-timestamp (nth 5 (file-attributes file))))
+        (old (cadr (assoc file gnus-cloud-file-timestamps))))
     (when (or full
-	      (null old)
-	      (string< old timestamp))
+              (null old)
+              (string< old timestamp))
       timestamp)))
 
 (declare-function gnus-activate-group "gnus-start"
-		  (group &optional scan dont-check method dont-sub-check))
+                  (group &optional scan dont-check method dont-sub-check))
 (declare-function gnus-subscribe-group "gnus-start"
-		  (group &optional previous method))
+                  (group &optional previous method))
 
 (defun gnus-cloud-ensure-cloud-group ()
   (let ((method (if (stringp gnus-cloud-method)
-		    (gnus-server-to-method gnus-cloud-method)
-		  gnus-cloud-method)))
+                    (gnus-server-to-method gnus-cloud-method)
+                  gnus-cloud-method)))
     (unless (or (gnus-active gnus-cloud-group-name)
-		(gnus-activate-group gnus-cloud-group-name nil nil
-				     gnus-cloud-method))
+                (gnus-activate-group gnus-cloud-group-name nil nil
+                                     gnus-cloud-method))
       (and (gnus-request-create-group gnus-cloud-group-name gnus-cloud-method)
-	   (gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method)
-	   (gnus-subscribe-group gnus-cloud-group-name)))))
+           (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))
 
 (defun gnus-cloud-upload-data (&optional full)
+  "Upload data (newsrc and files) to the Gnus Cloud.
+When FULL is t, upload everything, not just a difference from the last full."
+  (interactive)
   (gnus-cloud-ensure-cloud-group)
   (with-temp-buffer
-    (let ((elems (gnus-cloud-files-to-upload full)))
-      (insert (format "Subject: (sequence: %d type: %s)\n"
-		      gnus-cloud-sequence
-		      (if full :full :partial)))
-      (insert "From: nobody@invalid.com\n")
+    (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")
       (insert "\n")
       (insert (gnus-cloud-make-chunk elems))
-      (when (gnus-request-accept-article gnus-cloud-group-name gnus-cloud-method
-					 t t)
-	(setq gnus-cloud-sequence (1+ gnus-cloud-sequence))
-	(gnus-cloud-add-timestamps elems)))))
+      (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)))))
 
 (defun gnus-cloud-add-timestamps (elems)
   (dolist (elem elems)
     (let* ((file-name (plist-get elem :file-name))
-	   (old (assoc file-name gnus-cloud-file-timestamps)))
+           (old (assoc file-name gnus-cloud-file-timestamps)))
       (when old
-	(setq gnus-cloud-file-timestamps
-	      (delq old gnus-cloud-file-timestamps)))
+        (setq gnus-cloud-file-timestamps
+              (delq old gnus-cloud-file-timestamps)))
       (push (list file-name (plist-get elem :timestamp))
-	    gnus-cloud-file-timestamps))))
+            gnus-cloud-file-timestamps))))
 
 (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))
-	 (active (gnus-active group))
-	 headers head)
+         (active (gnus-active group))
+         headers head)
     (when (gnus-retrieve-headers (gnus-uncompress-range active) group)
       (with-current-buffer nntp-server-buffer
-	(goto-char (point-min))
-	(while (and (not (eobp))
-		    (setq head (nnheader-parse-head)))
-	  (push head headers))))
+        (goto-char (point-min))
+        (while (and (not (eobp))
+                    (setq head (nnheader-parse-head)))
+          (push head headers))))
     (sort (nreverse headers)
-	  (lambda (h1 h2)
-	    (> (gnus-cloud-chunk-sequence (mail-header-subject h1))
-	       (gnus-cloud-chunk-sequence (mail-header-subject h2)))))))
+          (lambda (h1 h2)
+            (> (gnus-cloud-chunk-sequence (mail-header-subject h1))
+               (gnus-cloud-chunk-sequence (mail-header-subject h2)))))))
 
 (defun gnus-cloud-chunk-sequence (string)
   (if (string-match "sequence: \\([0-9]+\\)" string)
       (string-to-number (match-string 1 string))
     0))
 
+;; TODO: use this
 (defun gnus-cloud-prune-old-chunks (headers)
   (let ((headers (reverse headers))
-	(found nil))
+        (found nil))
   (while (and headers
-	      (not found))
+              (not found))
     (when (string-match "type: :full" (mail-header-subject (car headers)))
       (setq found t))
     (pop headers))
@@ -306,37 +425,68 @@
   (when headers
     (gnus-request-expire-articles
      (mapcar (lambda (h)
-	       (mail-header-number h))
-	     (nreverse headers))
+               (mail-header-number h))
+             (nreverse headers))
      (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method)))))
 
-(defun gnus-cloud-download-data ()
+(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."
   (let ((articles nil)
-	chunks)
+        chunks)
     (dolist (header (gnus-cloud-available-chunks))
       (when (> (gnus-cloud-chunk-sequence (mail-header-subject header))
-	       gnus-cloud-sequence)
-	(push (mail-header-number header) articles)))
+               (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)))))
     (when articles
       (nnimap-request-articles (nreverse articles) gnus-cloud-group-name)
       (with-current-buffer nntp-server-buffer
-	(goto-char (point-min))
-	(while (re-search-forward "^Version " nil t)
-	  (beginning-of-line)
-	  (push (gnus-cloud-parse-chunk) chunks)
-	  (forward-line 1))))))
+        (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)))
 
 (defun gnus-cloud-server-p (server)
   (member server gnus-cloud-covered-servers))
 
+(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))
+
 (defun gnus-cloud-collect-full-newsrc ()
+  "Collect all the Gnus newsrc data in a portable format."
   (let ((infos nil))
     (dolist (info (cdr gnus-newsrc-alist))
       (when (gnus-cloud-server-p
-	     (gnus-method-to-server
-	      (gnus-find-method-for-group (gnus-info-group info))))
-	(push info infos)))
-    ))
+             (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))
 
 (provide 'gnus-cloud)