X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-sync.el;h=058724e5e1681bf080529c5e7e13203cc5369689;hp=8a492e8d2c35210ac673729d92c58d595a13b484;hb=b83561e18ceb438203812786590893bd5fc2a6cc;hpb=06c416da2c213c37d1674dcd31016b45062e6c8a

diff --git a/lisp/gnus-sync.el b/lisp/gnus-sync.el
index 8a492e8d2..058724e5e 100644
--- a/lisp/gnus-sync.el
+++ b/lisp/gnus-sync.el
@@ -1,6 +1,6 @@
 ;;; gnus-sync.el --- synchronization facility for Gnus
 
-;; Copyright (C) 2010  Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
 
 ;; Author: Ted Zlatanov <tzz@lifelogs.com>
 ;; Keywords: news synchronization nntp nnrss
@@ -24,42 +24,95 @@
 
 ;; This is the gnus-sync.el package.
 
-;; It's due for a rewrite using gnus-after-set-mark-hook and
-;; gnus-before-update-mark-hook.  Until then please consider it
-;; experimental.
-
 ;; Put this in your startup file (~/.gnus.el for instance)
 
 ;; possibilities for gnus-sync-backend:
 ;; Tramp over SSH: /ssh:user@host:/path/to/filename
-;; Tramp over IMAP: /imaps:user@yourhosthere.com:/INBOX.test/filename
 ;; ...or any other file Tramp and Emacs can handle...
 
 ;; (setq gnus-sync-backend "/remote:/path.gpg" ; will use Tramp+EPA if loaded
-;;       gnus-sync-global-vars `(gnus-newsrc-last-checked-date)
-;;       gnus-sync-newsrc-groups `("nntp" "nnrss")
-;;       gnus-sync-newsrc-offsets `(2 3))
+;;       gnus-sync-global-vars '(gnus-newsrc-last-checked-date)
+;;       gnus-sync-newsrc-groups '("nntp" "nnrss"))
+;;       gnus-sync-newsrc-offsets '(2 3))
+;; against a LeSync server (beware the vampire LeSync, who knows your newsrc)
+
+;; (setq gnus-sync-backend '(lesync "http://lesync.info:5984/tzz")
+;;       gnus-sync-newsrc-groups '("nntp" "nnrss"))
+
+;; What's a LeSync server?
+
+;; 1. install CouchDB, set up a real server admin user, and create a
+;; database, e.g. "tzz" and save the URL,
+;; e.g. http://lesync.info:5984/tzz
+
+;; 2. run `M-: (gnus-sync-lesync-setup "http://lesync.info:5984/tzz" "tzzadmin" "mypassword" "mysalt" t t)'
+
+;;    (If you run it more than once, you have to remove the entry from
+;;    _users yourself.  This is intentional.  This sets up a database
+;;    admin for the "tzz" database, distinct from the server admin
+;;    user in (1) above.)
+
+;; That's it, you can start using http://lesync.info:5984/tzz in your
+;; gnus-sync-backend as a LeSync backend.  Fan fiction about the
+;; vampire LeSync is welcome.
+
+;; You may not want to expose a CouchDB install to the Big Bad
+;; Internet, especially if your love of all things furry would be thus
+;; revealed.  Make sure it's not accessible by unauthorized users and
+;; guests, at least.
+
+;; If you want to try it out, I will create a test DB for you under
+;; http://lesync.info:5984/yourfavoritedbname
 
 ;; TODO:
 
-;; - after gnus-sync-read, the message counts are wrong
+;; - after gnus-sync-read, the message counts look wrong until you do
+;;   `g'.  So it's not run automatically, you have to call it with M-x
+;;   gnus-sync-read
 
 ;; - use gnus-after-set-mark-hook and gnus-before-update-mark-hook to
 ;;   catch the mark updates
 
+;; - repositioning of groups within topic after a LeSync sync is a
+;;   weird sort of bubble sort ("buttle" sort: the old entry ends up
+;;   at the rear of the list); you will eventually end up with the
+;;   right order after calling `gnus-sync-read' a bunch of times.
+
+;; - installing topics and groups is inefficient and annoying, lots of
+;;   prompts could be avoided
+
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+(eval-and-compile
+  (or (ignore-errors (progn
+                       (require 'json)))
+      ;; gnus-fallback-lib/ from gnus/lisp/gnus-fallback-lib
+      (ignore-errors
+        (let ((load-path (cons (expand-file-name
+                                "gnus-fallback-lib"
+                                (file-name-directory (locate-library "gnus")))
+                               load-path)))
+          (require 'json)))
+      (error
+       "json not found in `load-path' or gnus-fallback-lib/ directory.")))
 (require 'gnus)
 (require 'gnus-start)
 (require 'gnus-util)
+(require 'gmm-utils)
+
+(defvar gnus-topic-alist) ;; gnus-group.el
+(eval-when-compile
+  (autoload 'gnus-group-topic "gnus-topic")
+  (autoload 'gnus-topic-create-topic "gnus-topic" nil t)
+  (autoload 'gnus-topic-enter-dribble "gnus-topic"))
 
 (defgroup gnus-sync nil
   "The Gnus synchronization facility."
   :version "24.1"
   :group 'gnus)
 
-(defcustom gnus-sync-newsrc-groups `("nntp" "nnrss")
+(defcustom gnus-sync-newsrc-groups '("nntp" "nnrss")
   "List of groups to be synchronized in the gnus-newsrc-alist.
 The group names are matched, they don't have to be fully
 qualified.  Typically you would choose all of these.  That's the
@@ -71,17 +124,16 @@ this setting is harmless until the user chooses a sync backend."
 (defcustom gnus-sync-newsrc-offsets '(2 3)
   "List of per-group data to be synchronized."
   :group 'gnus-sync
+  :version "24.4"
   :type '(set (const :tag "Read ranges" 2)
-              (const :tag "Marks" 3)))
+	      (const :tag "Marks" 3)))
 
 (defcustom gnus-sync-global-vars nil
   "List of global variables to be synchronized.
 You may want to sync `gnus-newsrc-last-checked-date' but pretty
 much any symbol is fair game.  You could additionally sync
 `gnus-newsrc-alist', `gnus-server-alist', `gnus-topic-topology',
-and `gnus-topic-alist' to cover all the variables in
-newsrc.eld (except for `gnus-format-specs' which should not be
-synchronized, I believe).  Also see `gnus-variable-list'."
+and `gnus-topic-alist'.  Also see `gnus-variable-list'."
   :group 'gnus-sync
   :type '(repeat (choice (variable :tag "A known variable")
                          (symbol :tag "Any symbol"))))
@@ -90,37 +142,652 @@ synchronized, I believe).  Also see `gnus-variable-list'."
   "The synchronization backend."
   :group 'gnus-sync
   :type '(radio (const :format "None" nil)
+                (list :tag "Sync server"
+                      (const :format "LeSync Server API" lesync)
+                      (string :tag "URL of a CouchDB database for API access"))
                 (string :tag "Sync to a file")))
 
 (defvar gnus-sync-newsrc-loader nil
   "Carrier for newsrc data")
 
-(defun gnus-sync-save ()
-"Save the Gnus sync data to the backend."
-  (interactive)
+(defcustom gnus-sync-file-encrypt-to nil
+  "If non-nil, set `epa-file-encrypt-to' from this for encrypting the Sync file."
+  :version "24.4"
+  :type '(choice string (repeat string))
+  :group 'gnus-sync)
+
+(defcustom gnus-sync-lesync-name (system-name)
+  "The LeSync name for this machine."
+  :group 'gnus-sync
+  :version "24.3"
+  :type 'string)
+
+(defcustom gnus-sync-lesync-install-topics 'ask
+  "Should LeSync install the recorded topics?"
+  :group 'gnus-sync
+  :version "24.3"
+  :type '(choice (const :tag "Never Install" nil)
+                 (const :tag "Always Install" t)
+                 (const :tag "Ask Me Once" ask)))
+
+(defvar gnus-sync-lesync-props-hash (make-hash-table :test 'equal)
+  "LeSync props, keyed by group name")
+
+(defvar gnus-sync-lesync-design-prefix "/_design/lesync"
+  "The LeSync design prefix for CouchDB")
+
+(defvar gnus-sync-lesync-security-object "/_security"
+  "The LeSync security object for CouchDB")
+
+(defun gnus-sync-lesync-parse ()
+  "Parse the result of a LeSync request."
+  (goto-char (point-min))
+  (condition-case nil
+      (when (search-forward-regexp "^$" nil t)
+        (json-read))
+    (error
+     (gnus-message
+      1
+      "gnus-sync-lesync-parse: Could not read the LeSync response!")
+     nil)))
+
+(defun gnus-sync-lesync-call (url method headers &optional kvdata)
+  "Make an access request to URL using KVDATA and METHOD.
+KVDATA must be an alist."
+  (gmm-flet ((json-alist-p (list) (gnus-sync-json-alist-p list))) ; temp patch
+    (let ((url-request-method method)
+          (url-request-extra-headers headers)
+          (url-request-data (if kvdata (json-encode kvdata) nil)))
+      (with-current-buffer (url-retrieve-synchronously url)
+        (let ((data (gnus-sync-lesync-parse)))
+          (gnus-message 12 "gnus-sync-lesync-call: %s URL %s sent %S got %S"
+                        method url `((headers . ,headers) (data ,kvdata)) data)
+          (kill-buffer (current-buffer))
+          data)))))
+
+(defun gnus-sync-lesync-PUT (url headers &optional data)
+  (gnus-sync-lesync-call url "PUT" headers data))
+
+(defun gnus-sync-lesync-POST (url headers &optional data)
+  (gnus-sync-lesync-call url "POST" headers data))
+
+(defun gnus-sync-lesync-GET (url headers &optional data)
+  (gnus-sync-lesync-call url "GET" headers data))
+
+(defun gnus-sync-lesync-DELETE (url headers &optional data)
+  (gnus-sync-lesync-call url "DELETE" headers data))
+
+;; this is not necessary with newer versions of json.el but 1.2 or older
+;; (which are in Emacs 24.1 and earlier) need it
+(defun gnus-sync-json-alist-p (list)
+  "Non-null if and only if LIST is an alist."
+  (while (consp list)
+    (setq list (if (consp (car list))
+                   (cdr list)
+                 'not-alist)))
+  (null list))
+
+;; this is not necessary with newer versions of json.el but 1.2 or older
+;; (which are in Emacs 24.1 and earlier) need it
+(defun gnus-sync-json-plist-p (list)
+  "Non-null if and only if LIST is a plist."
+  (while (consp list)
+    (setq list (if (and (keywordp (car list))
+                        (consp (cdr list)))
+                   (cddr list)
+                 'not-plist)))
+  (null list))
+
+; (gnus-sync-lesync-setup "http://lesync.info:5984/tzz" "tzzadmin" "mypassword" "mysalt" t t)
+; (gnus-sync-lesync-setup "http://lesync.info:5984/tzz")
+
+(defun gnus-sync-lesync-setup (url &optional user password salt reader admin)
+  (interactive "sEnter URL to set up: ")
+  "Set up the LeSync database at URL.
+Install USER as a READER and/or an ADMIN in the security object
+under \"_security\", and in the CouchDB \"_users\" table using
+PASSWORD and SALT.  Only one USER is thus supported for now.
+When SALT is nil, a random one will be generated using `random'."
+  (let* ((design-url (concat url gnus-sync-lesync-design-prefix))
+         (security-object (concat url "/_security"))
+         (user-record `((names . [,user]) (roles . [])))
+         (couch-user-name (format "org.couchdb.user:%s" user))
+         (salt (or salt (sha1 (format "%s" (random)))))
+         (couch-user-record
+          `((_id . ,couch-user-name)
+            (type . user)
+            (name . ,(format "%s" user))
+            (roles . [])
+            (salt . ,salt)
+            (password_sha . ,(when password
+                               (sha1
+                                (format "%s%s" password salt))))))
+         (rev (progn
+                (gnus-sync-lesync-find-prop 'rev design-url design-url)
+                (gnus-sync-lesync-get-prop 'rev design-url)))
+         (latest-func "function(head,req)
+{
+  var tosend = [];
+  var row;
+  var ftime = (req.query['ftime'] || 0);
+  while (row = getRow())
+  {
+    if (row.value['float-time'] > ftime)
+    {
+      var s = row.value['_id'];
+      if (s) tosend.push('\"'+s.replace('\"', '\\\"')+'\"');
+    }
+  }
+  send('['+tosend.join(',') + ']');
+}")
+;; <key>read</key>
+;; <dict>
+;;   <key>de.alt.fan.ipod</key>
+;;   <array>
+;;       <integer>1</integer>
+;;       <integer>2</integer>
+;;       <dict>
+;;           <key>start</key>
+;;           <integer>100</integer>
+;;           <key>length</key>
+;;           <integer>100</integer>
+;;       </dict>
+;;   </array>
+;; </dict>
+         (xmlplistread-func "function(head, req) {
+  var row;
+  start({ 'headers': { 'Content-Type': 'text/xml' } });
+
+  send('<dict>');
+  send('<key>read</key>');
+  send('<dict>');
+  while(row = getRow())
+  {
+    var read = row.value.read;
+    if (read && read[0] && read[0] == 'invlist')
+    {
+      send('<key>'+row.key+'</key>');
+      //send('<invlist>'+read+'</invlist>');
+      send('<array>');
+
+      var from = 0;
+      var flip = false;
+
+      for (var i = 1; i < read.length && read[i]; i++)
+      {
+        var cur = read[i];
+        if (flip)
+        {
+          if (from == cur-1)
+          {
+            send('<integer>'+read[i]+'</integer>');
+          }
+          else
+          {
+            send('<dict>');
+            send('<key>start</key>');
+            send('<integer>'+from+'</integer>');
+            send('<key>end</key>');
+            send('<integer>'+(cur-1)+'</integer>');
+            send('</dict>');
+          }
+
+        }
+        flip = ! flip;
+        from = cur;
+      }
+      send('</array>');
+    }
+  }
+
+  send('</dict>');
+  send('</dict>');
+}
+")
+         (subs-func "function(doc){emit([doc._id, doc.source], doc._rev);}")
+         (revs-func "function(doc){emit(doc._id, doc._rev);}")
+         (bytimesubs-func "function(doc)
+{emit([(doc['float-time']||0), doc._id], doc._rev);}")
+         (bytime-func "function(doc)
+{emit([(doc['float-time']||0), doc._id], doc);}")
+         (groups-func "function(doc){emit(doc._id, doc);}"))
+    (and (if user
+             (and (assq 'ok (gnus-sync-lesync-PUT
+                             security-object
+                             nil
+                             (append (and reader
+                                          (list `(readers . ,user-record)))
+                                     (and admin
+                                          (list `(admins . ,user-record))))))
+                  (assq 'ok (gnus-sync-lesync-PUT
+                             (concat (file-name-directory url)
+                                     "_users/"
+                                     couch-user-name)
+                             nil
+                             couch-user-record)))
+           t)
+         (assq 'ok (gnus-sync-lesync-PUT
+                    design-url
+                    nil
+                    `(,@(when rev (list (cons '_rev rev)))
+                      (lists . ((latest . ,latest-func)
+                                (xmlplistread . ,xmlplistread-func)))
+                      (views . ((subs . ((map . ,subs-func)))
+                                (revs . ((map . ,revs-func)))
+                                (bytimesubs . ((map . ,bytimesubs-func)))
+                                (bytime . ((map . ,bytime-func)))
+                                (groups . ((map . ,groups-func)))))))))))
+
+(defun gnus-sync-lesync-find-prop (prop url key)
+  "Retrieve a PROPerty of a document KEY at URL.
+Calls `gnus-sync-lesync-set-prop'.
+For the 'rev PROP, uses '_rev against the document."
+  (gnus-sync-lesync-set-prop
+   prop key (cdr (assq (if (eq prop 'rev) '_rev prop)
+                       (gnus-sync-lesync-GET url nil)))))
+
+(defun gnus-sync-lesync-set-prop (prop key val)
+  "Update the PROPerty of document KEY at URL to VAL.
+Updates `gnus-sync-lesync-props-hash'."
+    (puthash (format "%s.%s" key prop) val gnus-sync-lesync-props-hash))
+
+(defun gnus-sync-lesync-get-prop (prop key)
+  "Get the PROPerty of KEY from `gnus-sync-lesync-props-hash'."
+    (gethash (format "%s.%s" key prop) gnus-sync-lesync-props-hash))
+
+(defun gnus-sync-deep-print (data)
+  (let* ((print-quoted t)
+         (print-readably t)
+         (print-escape-multibyte nil)
+         (print-escape-nonascii t)
+         (print-length nil)
+         (print-level nil)
+         (print-circle nil)
+         (print-escape-newlines t))
+    (format "%S" data)))
+
+(defun gnus-sync-newsrc-loader-builder (&optional only-modified)
+  (let* ((entries (cdr gnus-newsrc-alist))
+         entry name ret)
+    (while entries
+      (setq entry (pop entries)
+            name (car entry))
+      (when (gnus-grep-in-list name gnus-sync-newsrc-groups)
+        (if only-modified
+            (when (not (equal (gnus-sync-deep-print entry)
+                              (gnus-sync-lesync-get-prop 'checksum name)))
+              (gnus-message 9 "%s: add %s, it's modified"
+                            "gnus-sync-newsrc-loader-builder" name)
+              (push entry ret))
+          (push entry ret))))
+    ret))
+
+; (json-encode (gnus-sync-range2invlist '((1 . 47137) (47139 . 47714) 48129 48211 49231 49281 49342 49473 49475 49502)))
+(defun gnus-sync-range2invlist (ranges)
+  (append '(invlist)
+          (let ((ranges (delq nil ranges))
+                ret range from to)
+            (while ranges
+              (setq range (pop ranges))
+              (if (atom range)
+                  (setq from range
+                        to range)
+                (setq from (car range)
+                      to (cdr range)))
+              (push from ret)
+              (push (1+ to) ret))
+            (reverse ret))))
+
+; (let* ((d '((1 . 47137) (47139 . 47714) 48129 48211 49231 49281 49342 49473 49475 49502)) (j (format "%S" (gnus-sync-invlist2range (gnus-sync-range2invlist d))))) (or (equal (format "%S" d) j) j))
+(defun gnus-sync-invlist2range (inv)
+  (setq inv (append inv nil))
+  (if (equal (format "%s" (car inv)) "invlist")
+      (let ((i (cdr inv))
+            (start 0)
+            ret cur top flip)
+        (while i
+          (setq cur (pop i))
+          (when flip
+            (setq top (1- cur))
+            (if (= start top)
+                (push start ret)
+              (push (cons start top) ret)))
+          (setq flip (not flip))
+          (setq start cur))
+        (reverse ret))
+    inv))
+
+(defun gnus-sync-position (search list &optional test)
+  "Find the position of SEARCH in LIST using TEST, defaulting to `eq'."
+  (let ((pos 0)
+        (test (or test 'eq)))
+    (while (and list (not (funcall test (car list) search)))
+      (pop list)
+      (incf pos))
+    (if (funcall test (car list) search) pos nil)))
+
+(defun gnus-sync-topic-group-position (group topic-name)
+  (gnus-sync-position
+   group (cdr (assoc topic-name gnus-topic-alist)) 'equal))
+
+(defun gnus-sync-fix-topic-group-position (group topic-name position)
+  (unless (equal position (gnus-sync-topic-group-position group topic-name))
+    (let* ((loc "gnus-sync-fix-topic-group-position")
+           (groups (delete group (cdr (assoc topic-name gnus-topic-alist))))
+           (position (min position (1- (length groups))))
+           (old (nth position groups)))
+      (when (and old (not (equal old group)))
+        (setf (nth position groups) group)
+        (setcdr (assoc topic-name gnus-topic-alist)
+                (append groups (list old)))
+        (gnus-message 9 "%s: %s moved to %d, swap with %s"
+                      loc group position old)))))
+
+(defun gnus-sync-lesync-pre-save-group-entry (url nentry &rest passed-props)
+  (let* ((loc "gnus-sync-lesync-save-group-entry")
+         (k (car nentry))
+         (revision (gnus-sync-lesync-get-prop 'rev k))
+         (sname gnus-sync-lesync-name)
+         (topic (gnus-group-topic k))
+         (topic-offset (gnus-sync-topic-group-position k topic))
+         (sources (gnus-sync-lesync-get-prop 'source k)))
+    ;; set the revision so we don't have a conflict
+    `(,@(when revision
+          (list (cons '_rev revision)))
+      (_id . ,k)
+      ;; the time we saved
+      ,@passed-props
+      ;; add our name to the sources list for this key
+      (source ,@(if (member gnus-sync-lesync-name sources)
+                    sources
+                  (cons gnus-sync-lesync-name sources)))
+      ,(cons 'level (nth 1 nentry))
+      ,@(if topic (list (cons 'topic topic)) nil)
+      ,@(if topic-offset (list (cons 'topic-offset topic-offset)) nil)
+      ;; the read marks
+      ,(cons 'read (gnus-sync-range2invlist (nth 2 nentry)))
+      ;; the other marks
+      ,@(delq nil (mapcar (lambda (mark-entry)
+                            (gnus-message 12 "%s: prep param %s in %s"
+                                          loc
+                                          (car mark-entry)
+                                          (nth 3 nentry))
+                            (if (listp (cdr mark-entry))
+                                (cons (car mark-entry)
+                                      (gnus-sync-range2invlist
+                                       (cdr mark-entry)))
+                              (progn    ; else this is not a list
+                                (gnus-message 9 "%s: non-list param %s in %s"
+                                              loc
+                                              (car mark-entry)
+                                              (nth 3 nentry))
+                                nil)))
+                          (nth 3 nentry))))))
+
+(defun gnus-sync-lesync-post-save-group-entry (url entry)
+  (let* ((loc "gnus-sync-lesync-post-save-group-entry")
+         (k (cdr (assq 'id entry))))
+    (cond
+     ;; success!
+     ((and (assq 'rev entry) (assq 'id entry))
+      (progn
+        (gnus-sync-lesync-set-prop 'rev k (cdr (assq 'rev entry)))
+        (gnus-sync-lesync-set-prop 'checksum
+                                   k
+                                   (gnus-sync-deep-print
+                                    (assoc k gnus-newsrc-alist)))
+        (gnus-message 9 "%s: successfully synced %s to %s"
+                      loc k url)))
+     ;; specifically check for document conflicts
+     ((equal "conflict" (format "%s" (cdr-safe (assq 'error entry))))
+      (gnus-error
+       1
+       "%s: use `%s' to resolve the conflict synchronizing %s to %s: %s"
+       loc "gnus-sync-read" k url (cdr (assq 'reason entry))))
+     ;; generic errors
+     ((assq 'error entry)
+      (gnus-error 1 "%s: got error while synchronizing %s to %s: %s"
+                  loc k url (cdr (assq 'reason entry))))
+
+     (t
+      (gnus-message 2 "%s: unknown sync status after %s to %s: %S"
+                    loc k url entry)))
+    (assoc 'error entry)))
+
+(defun gnus-sync-lesync-groups-builder (url)
+  (let ((u (concat url gnus-sync-lesync-design-prefix "/_view/groups")))
+    (cdr (assq 'rows (gnus-sync-lesync-GET u nil)))))
+
+(defun gnus-sync-subscribe-group (name)
+  "Subscribe to group NAME.  Returns NAME on success, nil otherwise."
+  (gnus-subscribe-newsgroup name))
+
+(defun gnus-sync-lesync-read-group-entry (url name entry &rest passed-props)
+  "Read ENTRY information for NAME.  Returns NAME if successful.
+Skips entries whose sources don't contain
+`gnus-sync-lesync-name'.  When the alist PASSED-PROPS has a
+`subscribe-all' element that evaluates to true, we attempt to
+subscribe to unknown groups.  The user is also allowed to delete
+unwanted groups via the LeSync URL."
+  (let* ((loc "gnus-sync-lesync-read-group-entry")
+         (entry (gnus-sync-lesync-normalize-group-entry entry passed-props))
+         (subscribe-all (cdr (assq 'subscribe-all passed-props)))
+         (sources (cdr (assq 'source entry)))
+         (rev (cdr (assq 'rev entry)))
+         (in-sources (member gnus-sync-lesync-name sources))
+         (known (assoc name gnus-newsrc-alist))
+         cell)
+    (unless known
+      (if (and subscribe-all
+               (y-or-n-p (format "Subscribe to group %s?" name)))
+          (setq known (gnus-sync-subscribe-group name)
+                in-sources t)
+        ;; else...
+        (when (y-or-n-p (format "Delete group %s from server?" name))
+          (if (equal name (gnus-sync-lesync-delete-group url name))
+              (gnus-message 1 "%s: removed group %s from server %s"
+                            loc name url)
+            (gnus-error 1 "%s: could not remove group %s from server %s"
+                        loc name url)))))
+    (when known
+      (unless in-sources
+        (setq in-sources
+              (y-or-n-p
+               (format "Read group %s even though %s is not in sources %S?"
+                       name gnus-sync-lesync-name (or sources ""))))))
+    (when rev
+      (gnus-sync-lesync-set-prop 'rev name rev))
+
+    ;; if the source matches AND we have this group
+    (if (and known in-sources)
+        (progn
+          (gnus-message 10 "%s: reading LeSync entry %s, sources %S"
+                        loc name sources)
+          (while entry
+            (setq cell (pop entry))
+            (let ((k (car cell))
+                  (val (cdr cell)))
+              (gnus-sync-lesync-set-prop k name val)))
+          name)
+      ;; else...
+      (unless known
+        (gnus-message 5 "%s: ignoring entry %s, it wasn't subscribed.  %s"
+                        loc name "Call `gnus-sync-read' with C-u to force it."))
+      (unless in-sources
+        (gnus-message 5 "%s: ignoring entry %s, %s not in sources %S"
+                      loc name gnus-sync-lesync-name (or sources "")))
+      nil)))
+
+(defun gnus-sync-lesync-install-group-entry (name)
+  (let* ((master (assoc name gnus-newsrc-alist))
+         (old-topic-name (gnus-group-topic name))
+         (old-topic (assoc old-topic-name gnus-topic-alist))
+         (target-topic-name (gnus-sync-lesync-get-prop 'topic name))
+         (target-topic-offset (gnus-sync-lesync-get-prop 'topic-offset name))
+         (target-topic (assoc target-topic-name gnus-topic-alist))
+         (loc "gnus-sync-lesync-install-group-entry"))
+    (if master
+        (progn
+          (when (eq 'ask gnus-sync-lesync-install-topics)
+            (setq gnus-sync-lesync-install-topics
+                  (y-or-n-p "Install topics from LeSync?")))
+          (when (and (eq t gnus-sync-lesync-install-topics)
+                     target-topic-name)
+            (if (equal old-topic-name target-topic-name)
+                (gnus-message 12 "%s: %s is already in topic %s"
+                              loc name target-topic-name)
+              ;; see `gnus-topic-move-group'
+              (when (and old-topic target-topic)
+                (setcdr old-topic (gnus-delete-first name (cdr old-topic)))
+                (gnus-message 5 "%s: removing %s from topic %s"
+                              loc name old-topic-name))
+              (unless target-topic
+                (when (y-or-n-p (format "Create missing topic %s?"
+                                        target-topic-name))
+                  (gnus-topic-create-topic target-topic-name nil)
+                  (setq target-topic (assoc target-topic-name
+                                            gnus-topic-alist))))
+              (if target-topic
+                  (prog1
+                      (nconc target-topic (list name))
+                    (gnus-message 5 "%s: adding %s to topic %s"
+                                  loc name (car target-topic))
+                    (gnus-topic-enter-dribble))
+                (gnus-error 2 "%s: LeSync group %s can't go in missing topic %s"
+                            loc name target-topic-name)))
+            (when (and target-topic-offset target-topic)
+              (gnus-sync-fix-topic-group-position
+               name target-topic-name target-topic-offset)))
+          ;; install the subscription level
+          (when (gnus-sync-lesync-get-prop 'level name)
+            (setf (nth 1 master) (gnus-sync-lesync-get-prop 'level name)))
+          ;; install the read and other marks
+          (setf (nth 2 master) (gnus-sync-lesync-get-prop 'read name))
+          (setf (nth 3 master) (gnus-sync-lesync-get-prop 'marks name))
+          (gnus-sync-lesync-set-prop 'checksum
+                                     name
+                                     (gnus-sync-deep-print master))
+          nil)
+      (gnus-error 1 "%s: invalid LeSync group %s" loc name)
+      'invalid-name)))
+
+; (gnus-sync-lesync-delete-group (cdr gnus-sync-backend) "nntp+Gmane:gwene.org.slashdot")
+
+(defun gnus-sync-lesync-delete-group (url name)
+  "Returns NAME if successful deleting it from URL, an error otherwise."
+  (interactive "sEnter URL to set up: \rsEnter group name: ")
+  (let* ((u (concat (cadr gnus-sync-backend) "/" (url-hexify-string name)))
+         (del (gnus-sync-lesync-DELETE
+               u
+               `(,@(when (gnus-sync-lesync-get-prop 'rev name)
+                     (list (cons "If-Match"
+                                 (gnus-sync-lesync-get-prop 'rev name))))))))
+    (or (cdr (assq 'id del)) del)))
+
+;;; (gnus-sync-lesync-normalize-group-entry '((subscribe . ["invlist"]) (read . ["invlist"]) (topic-offset . 20) (topic . "news") (level . 6) (source . ["a" "b"]) (float-time . 1319671237.099285) (_rev . "10-edf5107f41e5e6f7f6629d1c0ee172f7") (_id . "nntp+news.net:alt.movies")) '((read-time 1319672156.486414) (subscribe-all nil)))
+
+(defun gnus-sync-lesync-normalize-group-entry (entry &optional passed-props)
+  (let (ret
+        marks
+        cell)
+    (setq entry (append passed-props entry))
+    (while (setq cell (pop entry))
+      (let ((k (car cell))
+            (val (cdr cell)))
+        (cond
+         ((eq k 'read)
+          (push (cons k (gnus-sync-invlist2range val)) ret))
+         ;; we ignore these parameters
+         ((member k '(_id subscribe-all _deleted_conflicts))
+          nil)
+         ((eq k '_rev)
+          (push (cons 'rev val) ret))
+         ((eq k 'source)
+          (push (cons 'source (append val nil)) ret))
+         ((or (eq k 'float-time)
+              (eq k 'level)
+              (eq k 'topic)
+              (eq k 'topic-offset)
+              (eq k 'read-time))
+          (push (cons k val) ret))
+;;; "How often have I said to you that when you have eliminated the
+;;; impossible, whatever remains, however improbable, must be the
+;;; truth?" --Sherlock Holmes
+          ;; everything remaining must be a mark
+          (t (push (cons k (gnus-sync-invlist2range val)) marks)))))
+    (cons (cons 'marks marks) ret)))
+
+(defun gnus-sync-save (&optional force)
+"Save the Gnus sync data to the backend.
+With a prefix, FORCE is set and all groups will be saved."
+  (interactive "P")
   (cond
+   ((and (listp gnus-sync-backend)
+         (eq (nth 0 gnus-sync-backend) 'lesync)
+         (stringp (nth 1 gnus-sync-backend)))
+
+    ;; refresh the revisions if we're forcing the save
+    (when force
+      (mapc (lambda (entry)
+              (when (and (assq 'key entry)
+                         (assq 'value entry))
+                (gnus-sync-lesync-set-prop
+                 'rev
+                 (cdr (assq 'key entry))
+                 (cdr (assq 'value entry)))))
+            ;; the revs view is key = name, value = rev
+            (cdr (assq 'rows (gnus-sync-lesync-GET
+                              (concat (nth 1 gnus-sync-backend)
+                                      gnus-sync-lesync-design-prefix
+                                      "/_view/revs")
+                              nil)))))
+
+    (let* ((ftime (float-time))
+           (url (nth 1 gnus-sync-backend))
+           (entries
+            (mapcar (lambda (entry)
+                      (gnus-sync-lesync-pre-save-group-entry
+                       (cadr gnus-sync-backend)
+                       entry
+                       (cons 'float-time ftime)))
+                    (gnus-sync-newsrc-loader-builder (not force))))
+           ;; when there are no entries, there's nothing to save
+           (sync (if entries
+                     (gnus-sync-lesync-POST
+                      (concat url "/_bulk_docs")
+                      '(("Content-Type" . "application/json"))
+                      `((docs . ,(vconcat entries nil))))
+                   (gnus-message
+                    2 "gnus-sync-save: nothing to save to the LeSync backend")
+                   nil)))
+      (mapcar (lambda (e) (gnus-sync-lesync-post-save-group-entry url e))
+              sync)))
    ((stringp gnus-sync-backend)
-    (gnus-message 7 "gnus-sync: saving to backend %s" gnus-sync-backend)
+    (gnus-message 7 "gnus-sync-save: saving to backend %s" gnus-sync-backend)
     ;; populate gnus-sync-newsrc-loader from all but the first dummy
     ;; entry in gnus-newsrc-alist whose group matches any of the
     ;; gnus-sync-newsrc-groups
     ;; TODO: keep the old contents for groups we don't have!
     (let ((gnus-sync-newsrc-loader
-           (loop for entry in (cdr gnus-newsrc-alist)
-                 when (gnus-grep-in-list
-                       (car entry)     ;the group name
-                       gnus-sync-newsrc-groups)
-                 collect (cons (car entry)
-                               (mapcar (lambda (offset)
-                                         (cons offset (nth offset entry)))
-                                       gnus-sync-newsrc-offsets)))))
+	   (loop for entry in (cdr gnus-newsrc-alist)
+		 when (gnus-grep-in-list
+		       (car entry)     ;the group name
+		       gnus-sync-newsrc-groups)
+		 collect (cons (car entry)
+			       (mapcar (lambda (offset)
+					 (cons offset (nth offset entry)))
+				       gnus-sync-newsrc-offsets)))))
       (with-temp-file gnus-sync-backend
         (progn
           (let ((coding-system-for-write gnus-ding-file-coding-system)
                 (standard-output (current-buffer)))
+            (when gnus-sync-file-encrypt-to
+              (set (make-local-variable 'epa-file-encrypt-to)
+                   gnus-sync-file-encrypt-to))
             (princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n"
                            gnus-ding-file-coding-system))
             (princ ";; Gnus sync data v. 0.0.1\n")
+            ;; TODO: replace with `gnus-sync-deep-print'
             (let* ((print-quoted t)
                    (print-readably t)
                    (print-escape-multibyte nil)
@@ -145,14 +812,14 @@ synchronized, I believe).  Also see `gnus-variable-list'."
                   (princ (symbol-name variable)))))
             (gnus-message
              7
-             "gnus-sync: stored variables %s and %d groups in %s"
+             "gnus-sync-save: stored variables %s and %d groups in %s"
              gnus-sync-global-vars
              (length gnus-sync-newsrc-loader)
              gnus-sync-backend)
 
             ;; Idea from Dan Christensen <jdc@chow.mat.jhu.edu>
             ;; Save the .eld file with extra line breaks.
-            (gnus-message 8 "gnus-sync: adding whitespace to %s"
+            (gnus-message 8 "gnus-sync-save: adding whitespace to %s"
                           gnus-sync-backend)
             (save-excursion
               (goto-char (point-min))
@@ -164,49 +831,74 @@ synchronized, I believe).  Also see `gnus-variable-list'."
     ;; the pass-through case: gnus-sync-backend is not a known choice
     (nil)))
 
-(defun gnus-sync-read ()
-"Load the Gnus sync data from the backend."
-  (interactive)
+(defun gnus-sync-read (&optional subscribe-all)
+  "Load the Gnus sync data from the backend.
+With a prefix, SUBSCRIBE-ALL is set and unknown groups will be subscribed."
+  (interactive "P")
   (when gnus-sync-backend
-    (gnus-message 7 "gnus-sync: loading from backend %s" gnus-sync-backend)
-    (cond ((stringp gnus-sync-backend)
-           ;; read data here...
-           (if (or debug-on-error debug-on-quit)
-               (load gnus-sync-backend nil t)
-             (condition-case var
-                 (load gnus-sync-backend nil t)
-               (error
-                (error "Error in %s: %s" gnus-sync-backend (cadr var)))))
-           (let ((valid-count 0)
-                 invalid-groups)
-             (dolist (node gnus-sync-newsrc-loader)
-               (if (gnus-gethash (car node) gnus-newsrc-hashtb)
-                   (progn
-                     (incf valid-count)
-                     (loop for store in (cdr node)
-                           do (setf (nth (car store)
-                                         (assoc (car node) gnus-newsrc-alist))
-                              (cdr store))))
-                 (push (car node) invalid-groups)))
-            (gnus-message
-             7
-             "gnus-sync: loaded %d groups (out of %d) from %s"
-             valid-count (length gnus-sync-newsrc-loader)
-             gnus-sync-backend)
-            (when invalid-groups
-              (gnus-message
-               7
-               "gnus-sync: skipped %d groups (out of %d) from %s"
-               (length invalid-groups)
-               (length gnus-sync-newsrc-loader)
-               gnus-sync-backend)
-              (gnus-message 9 "gnus-sync: skipped groups: %s"
-                            (mapconcat 'identity invalid-groups ", ")))))
-          (nil))
-    ;; make the hashtable again because the newsrc-alist may have been modified
-    (when gnus-sync-newsrc-offsets
-      (gnus-message 9 "gnus-sync: remaking the newsrc hashtable")
-      (gnus-make-hashtable-from-newsrc-alist))))
+    (gnus-message 7 "gnus-sync-read: loading from backend %s" gnus-sync-backend)
+    (cond
+     ((and (listp gnus-sync-backend)
+           (eq (nth 0 gnus-sync-backend) 'lesync)
+           (stringp (nth 1 gnus-sync-backend)))
+      (let ((errored nil)
+            name ftime)
+        (mapc (lambda (entry)
+		(setq name (cdr (assq 'id entry)))
+		;; set ftime the FIRST time through this loop, that
+		;; way it reflects the time we FINISHED reading
+		(unless ftime (setq ftime (float-time)))
+
+		(unless errored
+		  (setq errored
+			(when (equal name
+				     (gnus-sync-lesync-read-group-entry
+				      (nth 1 gnus-sync-backend)
+				      name
+				      (cdr (assq 'value entry))
+				      `(read-time ,ftime)
+				      `(subscribe-all ,subscribe-all)))
+			  (gnus-sync-lesync-install-group-entry
+			   (cdr (assq 'id entry)))))))
+	      (gnus-sync-lesync-groups-builder (nth 1 gnus-sync-backend)))))
+
+     ((stringp gnus-sync-backend)
+      ;; read data here...
+      (if (or debug-on-error debug-on-quit)
+          (load gnus-sync-backend nil t)
+        (condition-case var
+            (load gnus-sync-backend nil t)
+          (error
+           (error "Error in %s: %s" gnus-sync-backend (cadr var)))))
+      (let ((valid-count 0)
+            invalid-groups)
+        (dolist (node gnus-sync-newsrc-loader)
+          (if (gnus-gethash (car node) gnus-newsrc-hashtb)
+              (progn
+                (incf valid-count)
+                (loop for store in (cdr node)
+                      do (setf (nth (car store)
+                                    (assoc (car node) gnus-newsrc-alist))
+                               (cdr store))))
+            (push (car node) invalid-groups)))
+        (gnus-message
+         7
+         "gnus-sync-read: loaded %d groups (out of %d) from %s"
+         valid-count (length gnus-sync-newsrc-loader)
+         gnus-sync-backend)
+        (when invalid-groups
+          (gnus-message
+           7
+           "gnus-sync-read: skipped %d groups (out of %d) from %s"
+           (length invalid-groups)
+           (length gnus-sync-newsrc-loader)
+           gnus-sync-backend)
+          (gnus-message 9 "gnus-sync-read: skipped groups: %s"
+                        (mapconcat 'identity invalid-groups ", ")))))
+     (nil))
+
+    (gnus-message 9 "gnus-sync-read: remaking the newsrc hashtable")
+    (gnus-make-hashtable-from-newsrc-alist)))
 
 ;;;###autoload
 (defun gnus-sync-initialize ()
@@ -220,20 +912,17 @@ synchronized, I believe).  Also see `gnus-variable-list'."
   "Install the sync hooks."
   (interactive)
   ;; (add-hook 'gnus-get-new-news-hook 'gnus-sync-read)
-  (add-hook 'gnus-save-newsrc-hook 'gnus-sync-save)
-  (add-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read))
+  ;; (add-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read)
+  (add-hook 'gnus-save-newsrc-hook 'gnus-sync-save))
 
 (defun gnus-sync-unload-hook ()
   "Uninstall the sync hooks."
   (interactive)
-  ;; (remove-hook 'gnus-get-new-news-hook 'gnus-sync-read)
-  (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save)
-  (remove-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read))
+  (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save))
 
 (add-hook 'gnus-sync-unload-hook 'gnus-sync-unload-hook)
 
-;; this is harmless by default, until the gnus-sync-backend is set
-(gnus-sync-initialize)
+(when gnus-sync-backend (gnus-sync-initialize))
 
 (provide 'gnus-sync)