X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-sync.el;h=058724e5e1681bf080529c5e7e13203cc5369689;hp=a4f89767b9cdb8659b0cbd900dbf202e3f83bd59;hb=b83561e18ceb438203812786590893bd5fc2a6cc;hpb=f3a3c6a123a3a3219c64802a99343c512a5592e3 diff --git a/lisp/gnus-sync.el b/lisp/gnus-sync.el index a4f89767b..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-2011 Free Software Foundation, Inc. +;; Copyright (C) 2010-2015 Free Software Foundation, Inc. ;; Author: Ted Zlatanov ;; Keywords: news synchronization nntp nnrss @@ -31,16 +31,13 @@ ;; ...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? @@ -102,13 +99,20 @@ (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 @@ -117,6 +121,13 @@ this setting is harmless until the user chooses a sync backend." :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 @@ -139,14 +150,22 @@ and `gnus-topic-alist'. Also see `gnus-variable-list'." (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))) @@ -175,14 +194,11 @@ and `gnus-topic-alist'. Also see `gnus-variable-list'." (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) @@ -236,7 +252,7 @@ When SALT is nil, a random one will be generated using `random'." (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 t))))) + (salt (or salt (sha1 (format "%s" (random))))) (couch-user-record `((_id . ,couch-user-name) (type . user) @@ -491,10 +507,22 @@ Updates `gnus-sync-lesync-props-hash'." ;; 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") @@ -669,8 +697,8 @@ unwanted groups via the LeSync URL." (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)) @@ -740,11 +768,22 @@ With a prefix, FORCE is set and all groups will be saved." ;; 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") @@ -804,24 +843,24 @@ With a prefix, SUBSCRIBE-ALL is set and unknown groups will be subscribed." (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...