;;; gnus-sync.el --- synchronization facility for Gnus
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 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
(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
:group 'gnus-sync
:type '(repeat regexp))
+(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)))
+
(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
(defvar gnus-sync-newsrc-loader nil
"Carrier for newsrc data")
+(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
+(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)))
(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
+ (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)
- ;;(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)))))
+ (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)
;; 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 (gnus-sync-newsrc-loader-builder)))
+ (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)))))
(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")
(stringp (nth 1 gnus-sync-backend)))
(let ((errored nil)
name ftime)
- (mapcar (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)))))
+ (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...
projects / gnus / blobdiff