;;; gnus-sync.el --- synchronization facility for Gnus
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: news synchronization nntp nnrss
;; ...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/sync.php")
-;; gnus-sync-global-vars `(gnus-newsrc-last-checked-date)
-;; gnus-sync-newsrc-groups `("nntp" "nnrss")
-;; gnus-sync-newsrc-offsets `(2 3))
+;; (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 admin user, and create a
+;; 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.)
+;; _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
;; TODO:
-;; - after gnus-sync-read, the message counts are wrong. So it's not
-;; run automatically, you have to call it with M-x gnus-sync-read
+;; - 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
: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
(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."
- ;;(debug (json-encode kvdata))
- ;; (when (string-match-p "gmane.emacs.devel" url) (debug kvdata))
(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)
- ;;(debug (buffer-string))
(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)
(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: ")
(security-object (concat url "/_security"))
(user-record `((names . [,user]) (roles . [])))
(couch-user-name (format "org.couchdb.user:%s" user))
- (salt (or salt (sha1 (random t))))
- (couch-user-record `((_id . ,couch-user-name)
- (type . user)
- (name . ,(format "%s" user))
- (roles . [])
- (password_sha . ,(sha1
- (format "%s%s" password salt)))
- (salt . ,(format "%s" salt))))
+ (salt (or salt (sha1 (format "%s" (random t)))))
+ (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)))
}
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)
design-url
nil
`(,@(when rev (list (cons '_rev rev)))
- (lists . ((latest . ,latest-func)))
+ (lists . ((latest . ,latest-func)
+ (xmlplistread . ,xmlplistread-func)))
(views . ((subs . ((map . ,subs-func)))
(revs . ((map . ,revs-func)))
(bytimesubs . ((map . ,bytimesubs-func)))
;; the read marks
,(cons 'read (gnus-sync-range2invlist (nth 2 nentry)))
;; the other marks
- ,@(mapcar (lambda (mark-entry)
- (cons (car mark-entry)
- (gnus-sync-range2invlist (cdr mark-entry))))
- (nth 3 nentry)))))
+ ,@(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")
(cond
((eq k 'read)
(push (cons k (gnus-sync-invlist2range val)) ret))
- ;; we already know the name
- ((eq k '_id)
+ ;; we ignore these parameters
+ ((member k '(_id subscribe-all _deleted_conflicts))
nil)
((eq k '_rev)
(push (cons 'rev val) ret))
(gnus-message
2 "gnus-sync-save: nothing to save to the LeSync backend")
nil)))
- (mapcar (apply-partially 'gnus-sync-lesync-post-save-group-entry url)
+ (mapcar (lambda (e) (gnus-sync-lesync-post-save-group-entry url e))
sync)))
((stringp gnus-sync-backend)
(gnus-message 7 "gnus-sync-save: saving to backend %s" gnus-sync-backend)
projects / gnus / blobdiff