cgit.sxemacs.org Git - gnus/blob - lisp/gnus-cloud.el

   1 ;;; gnus-cloud.el --- storing and retrieving data via IMAP
   2
   3 ;; Copyright (C) 2014 Free Software Foundation, Inc.
   4
   5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   6 ;; Keywords: mail
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 (eval-when-compile (require 'cl))
  28
  29 (defgroup gnus-cloud nil
  30   "Syncing Gnus data via IMAP."
  31   :group 'gnus)
  32
  33 (defcustom gnus-cloud-synced-files '("~/\\.authinfo"
  34                                      "~/\\.authinfo\\.gpg"
  35                                      "~/\\.gnus\\.el"
  36                                      "~/News/.*.SCORE")
  37   "List of file regexps that should be kept up-to-date via the cloud."
  38   :group 'gnus-cloud
  39   :type '(repeat regexp))
  40
  41 (defvar gnus-cloud-version "0.1")
  42
  43 (defun gnus-cloud-make-chunk (elems)
  44   (with-temp-buffer
  45     (insert (format "Version %s\n" gnus-cloud-version))
  46     (insert (gnus-cloud-insert-data elems))))
  47
  48 (defun gnus-cloud-insert-data (elems)
  49   (mm-with-unibyte-buffer
  50     (dolist (elem elems)
  51       (cond
  52        ((eq (car elem) :file)
  53         (let (length data)
  54           (mm-with-unibyte-buffer
  55             (insert-file-contents-literally (cadr elem))
  56             (setq length (buffer-size)
  57                   data (buffer-string)))
  58           (insert (format "file %S %s %d\n"
  59                           (cadr elem)
  60                           (format-time-string
  61                            "%FT%T%z" (nth 5 (file-attributes (cadr elem))))
  62                           length))
  63           (insert data)
  64           (insert "\n")))
  65        ((eq (car elem) :buffer)
  66         (insert (format "data %S %d\n" (cadr elem)
  67                         (with-current-buffer (caddr elem)
  68                           (buffer-size))))
  69         (insert-buffer-substring (caddr elem))
  70         (insert "\n"))))
  71     (gnus-cloud-encode-data)
  72     (buffer-string)))
  73
  74 (defun gnus-cloud-encode-data ()
  75   (call-process-region (point-min) (point-max) "gzip" t (current-buffer) nil
  76                        "-c")
  77   (base64-encode-region (point-min) (point-max)))
  78
  79 (provide 'gnus-cloud)
  80
  81 ;;; gnus-cloud.el ends here