Synch to No Gnus 200408041711.
authoryamaoka <yamaoka>
Wed, 4 Aug 2004 21:50:35 +0000 (21:50 +0000)
committeryamaoka <yamaoka>
Wed, 4 Aug 2004 21:50:35 +0000 (21:50 +0000)
lisp/ChangeLog
lisp/gnus-encrypt.el [new file with mode: 0644]
lisp/gnus-registry.el
lisp/netrc.el
lisp/password.el

index 45bbeb2..47408c0 100644 (file)
@@ -1,3 +1,18 @@
+2004-08-04  Teodor Zlatanov  <tzz@lifelogs.com>
+
+       * gnus-registry.el (gnus-registry-split-fancy-with-parent): try
+       to append in-reply-to: data to the references: header
+
+       * netrc.el: removed old encryption support, autoload gnus-encrypt.el
+       (netrc-parse): use gnus-encrypt.el functions
+
+       * gnus-encrypt.el: new file for encryption support; currently
+       does only a few GPG ciphers and an internal XOR cipher
+
+       * password.el: add comments on using password-read-and-add
+       (password-read-and-add): new function to read and add the
+       password to the cache at once
+
 2004-07-28  Simon Josefsson  <jas@extundo.com>
 
        * pgg-pgp5.el (pgg-pgp5-encrypt-region): Accept sign
diff --git a/lisp/gnus-encrypt.el b/lisp/gnus-encrypt.el
new file mode 100644 (file)
index 0000000..72a6a72
--- /dev/null
@@ -0,0 +1,344 @@
+;;; gnus-encrypt.el --- file encryption routines for Gnus
+;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
+
+;; Author: Teodor Zlatanov <tzz@lifelogs.com>
+;; Created: 2003/01/24
+;; Keywords: files
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.         See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; This module addresses data encryption under Gnus.  Page breaks are
+;;; used for grouping declarations and documentation relating to each
+;;; particular aspect.
+
+;;; Code:
+
+;; autoload password
+(eval-and-compile
+  (autoload 'password-read "password"))
+
+(defgroup gnus-encrypt nil
+  "Gnus encryption configuration.")
+
+(defcustom gnus-encrypt-password-cache-expiry 200
+  "Gnus encryption password timeout.
+When set, directly sets password-cache-expiry"
+  :type 'integer
+  :group 'gnus-encrypt
+  :set (lambda (symbol value)
+        (set symbol value)
+        (setq password-cache-expiry value)))
+
+(defcustom gnus-encrypt-file-alist nil
+  "List of file names or regexes matched with encryptions.
+Format example:
+ '((\"beta\"
+    (gpg \"AES\"))
+   (\"/home/tzz/alpha\"
+    (gnus-encrypt-xor \"Semi-Secret\")))"
+
+  :type '(repeat
+         (list :tag "Encryption entry"
+          (radio :tag "What to encrypt"
+                 (file :tag "Filename")
+                 (regexp :tag "Regular expression match"))
+          (radio :tag "How to encrypt it"
+                 (list
+                  :tag "GPG Encryption"
+                  (const :tag "GPG Program" gpg)
+                  (radio :tag "Choose a cipher"
+                         (const :tag "3DES Encryption" "3DES")
+                         (const :tag "CAST5 Encryption" "CAST5")
+                         (const :tag "Blowfish Encryption" "BLOWFISH")
+                         (const :tag "AES Encryption" "AES")
+                         (const :tag "AES192 Encryption" "AES192")
+                         (const :tag "AES256 Encryption" "AES256")
+                         (const :tag "Twofish Encryption" "TWOFISH")
+                         (string :tag "Cipher Name")))
+                 (list
+                  :tag "Built-in simple XOR"
+                  (const :tag "XOR Encryption" gnus-encrypt-xor)
+                  (string :tag "XOR Cipher Value (seed value)")))))
+  :group 'gnus-encrypt)
+
+;; TODO: now, load gencrypt.el and if successful, modify the
+;; custom-type of gnus-encrypt-file-alist to add the gencrypt.el options
+
+;; (plist-get (symbol-plist 'gnus-encrypt-file-alist) 'custom-type)
+;; then use plist-put
+
+(defcustom gnus-encrypt-gpg-path (executable-find "gpg")
+  "Path to the GPG program."
+  :type '(radio
+         (file :tag "Location of the GPG executable")
+         (const :tag "GPG is not installed" nil))
+  :group 'gnus-encrypt)
+
+(defvar gnus-encrypt-temp-prefix "gnus-encrypt"
+  "Prefix for temporary filenames")
+
+(defun gnus-encrypt-find-model (filename)
+  "Given a filename, find a gnus-encrypt-file-alist entry"
+  (dolist (entry gnus-encrypt-file-alist)
+    (let ((match (nth 0 entry))
+         (model (nth 1 entry)))
+      (when (or (eq match filename)
+               (string-match match filename))
+       (return model)))))
+
+(defun gnus-encrypt-insert-file-contents (file &optional model)
+  "Decrypt FILE into the current buffer."
+  (interactive "fFile to insert: ")
+  (let* ((model (or model (gnus-encrypt-find-model file)))
+        (method (nth 0 model))
+        (cipher (nth 1 model))
+        (password-key (format "gnus-encrypt-password-%s-%s"
+                              (symbol-name method) cipher))
+        (passphrase
+         (password-read-and-add
+          (format "%s password for cipher %s? "
+                  (symbol-name method) cipher)
+          password-key))
+         (buffer-file-coding-system 'binary)
+        (coding-system-for-read 'binary)
+        outdata)
+
+    ;; note we only insert-file-contents if the method is known to be valid
+    (cond
+     ((eq method 'gpg)
+      (insert-file-contents file)
+      (setq outdata (gnus-encrypt-gpg-decode-buffer passphrase cipher)))
+     ((eq method 'gnus-encrypt-xor)
+      (insert-file-contents file)
+      (setq outdata (gnus-encrypt-xor-decode-buffer passphrase cipher))))
+
+    (if outdata
+       (progn
+         (gnus-message 9 "%s was decrypted with %s (cipher %s)"
+                       file (symbol-name method) cipher)
+         (delete-region (point-min) (point-max))
+         (goto-char (point-min))
+         (insert outdata))
+      (gnus-error 5 "%s was NOT decrypted with %s (cipher %s)"
+                 file (symbol-name method) cipher))))
+
+(defun gnus-encrypt-get-file-contents (file &optional model)
+  "Decrypt FILE and return the contents."
+  (interactive "fFile to decrypt: ")
+  (with-temp-buffer
+    (gnus-encrypt-insert-file-contents file model)
+    (buffer-string)))
+
+(defun gnus-encrypt-put-file-contents (file data &optional model)
+  "Encrypt the DATA to FILE, then continue normally."
+  (with-temp-buffer
+    (insert data)
+    (gnus-encrypt-write-file-contents file model)))
+
+(defun gnus-encrypt-write-file-contents (file &optional model)
+  "Encrypt the current buffer to FILE, then continue normally."
+  (interactive "fFile to write: ")
+  (let* ((model (or model (gnus-encrypt-find-model file)))
+        (method (nth 0 model))
+        (cipher (nth 1 model))
+        (passphrase
+         (password-read
+          (format "%s password for cipher %s? "
+                  (symbol-name method) cipher)
+          (format "gnus-encrypt-password-%s-%s"
+                  (symbol-name method) cipher)))
+        outdata)
+
+    (cond
+     ((eq method 'gpg)
+      (setq outdata (gnus-encrypt-gpg-encode-buffer passphrase cipher)))
+     ((eq method 'gnus-encrypt-xor)
+      (setq outdata (gnus-encrypt-xor-encode-buffer passphrase cipher))))
+
+    (if outdata
+       (progn
+         (gnus-message 9 "%s was encrypted with %s (cipher %s)"
+                       file (symbol-name method) cipher)
+         (delete-region (point-min) (point-max))
+         (goto-char (point-min))
+         (insert outdata)
+         ;; do not confirm overwrites
+         (write-file file nil))
+      (gnus-error 5 "%s was NOT encrypted with %s (cipher %s)"
+                 file (symbol-name method) cipher))))
+
+(defun gnus-encrypt-xor-encode-buffer (passphrase cipher)
+  (gnus-encrypt-xor-process-buffer passphrase cipher t))
+
+(defun gnus-encrypt-xor-decode-buffer (passphrase cipher)
+  (gnus-encrypt-xor-process-buffer passphrase cipher nil))
+
+(defun gnus-encrypt-xor-process-buffer (passphrase
+                                       cipher
+                                       &optional encode)
+  "Given PASSPHRASE, xor-encode or decode the contents of the current buffer."
+  (let* ((bs (buffer-substring-no-properties (point-min) (point-max)))
+        ;; passphrase-sum is a simple additive checksum of the
+        ;; passphrase and the cipher
+       (passphrase-sum
+        (when (stringp passphrase)
+          (apply '+ (append cipher passphrase nil))))
+       new-list)
+
+    (with-temp-buffer
+      (if encode
+         (progn
+           (dolist (x (append bs nil))
+             (setq new-list (cons (logxor x passphrase-sum) new-list)))
+
+           (dolist (x new-list)
+             (insert (format "%d " x))))
+       (progn
+         (setq new-list (reverse (split-string bs)))
+         (dolist (x new-list)
+           (setq x (string-to-int x))
+           (insert (format "%c" (logxor x passphrase-sum))))))
+      (buffer-substring-no-properties (point-min) (point-max)))))
+
+(defun gnus-encrypt-gpg-encode-buffer (passphrase cipher)
+  (gnus-encrypt-gpg-process-buffer passphrase cipher t))
+
+(defun gnus-encrypt-gpg-decode-buffer (passphrase cipher)
+  (gnus-encrypt-gpg-process-buffer passphrase cipher nil))
+
+(defun gnus-encrypt-gpg-process-buffer (passphrase 
+                                       cipher 
+                                       &optional encode)
+  "With PASSPHRASE, use GPG to encode or decode the current buffer."
+  (let* ((program gnus-encrypt-gpg-path)
+        (input (buffer-substring-no-properties (point-min) (point-max)))
+        (temp-maker (if (fboundp 'make-temp-file) 
+                        'make-temp-file 
+                      'make-temp-name))
+        (temp-file (funcall temp-maker gnus-encrypt-temp-prefix))
+        (default-enable-multibyte-characters nil)
+        (args `("--cipher-algo" ,cipher
+                "--status-fd" "2"
+                "--logger-fd" "2"
+                "--passphrase-fd" "0"
+                "--no-tty"))
+        exit-status exit-data)
+    
+    (when encode
+      (setq args
+           (append args
+                   '("--symmetric"
+                     "--armor"))))
+
+    (if program
+       (with-temp-buffer
+         (when passphrase
+           (insert passphrase "\n"))
+         (insert input)
+         (setq exit-status
+               (apply #'call-process-region (point-min) (point-max) program
+                      t `(t ,temp-file) nil args))
+         (if (equal exit-status 0)
+             (setq exit-data
+                   (buffer-substring-no-properties (point-min) (point-max)))
+           (with-temp-buffer
+             (when (file-exists-p temp-file)
+               (insert-file-contents temp-file))
+             (gnus-error 5 (format "%s exited abnormally: '%s' [%s]"
+                                   program exit-status (buffer-string)))))
+         (delete-file temp-file))
+      (gnus-error 5 "GPG is not installed."))
+    exit-data))
+
+(provide 'gnus-encrypt)
+;;; gnus-encrypt.el ends here
+
+;; (defcustom netrc-encrypting-method nil
+;;   "Decoding method used for the netrc file.
+;; Use the OpenSSL symmetric ciphers here.  Leave nil for no
+;; decoding.  Encrypt the file with netrc-encrypt, but make sure you
+;; have set netrc-encrypting-method to a non-nil value."
+;;   :type '(choice
+;;       (const :tag "DES-3" "des3")
+;;       (const :tag "IDEA" "idea")
+;;       (const :tag "RC4" "rc4")
+;;       (string :tag "Explicit cipher name")
+;;       (const :tag "None" nil))
+;;   :group 'netrc)
+
+;; (defcustom netrc-openssl-path (executable-find "openssl")
+;;   "File path of the OpenSSL shell."
+;;   :type '(choice (file :tag "Location of openssl")
+;;              (const :tag "openssl is not installed" nil))
+;;   :group 'netrc)
+
+;; (defun netrc-encrypt (plain-file encrypted-file)
+;;   (interactive "fPlain File: \nFEncrypted File: ")
+;;   "Encrypt FILE to ENCRYPTED-FILE with netrc-encrypting-method cipher."
+;;   (when (and (file-exists-p plain-file)
+;;          (stringp encrypted-file)
+;;          netrc-encrypting-method
+;;          netrc-openssl-path)
+;;     (let ((buffer-file-coding-system 'binary)
+;;       (coding-system-for-read 'binary)
+;;       (coding-system-for-write 'binary)
+;;       (password 
+;;        (password-read
+;;         (format "OpenSSL Password for cipher %s? "
+;;                 netrc-encrypting-method)
+;;         (format "netrc-openssl-password-%s"
+;;                 netrc-encrypting-method))))
+;;       (when password
+;;     (with-temp-buffer
+;;       (insert-file-contents plain-file)
+;;       (setenv "NETRC_OPENSSL_PASSWORD" password)
+;;       (shell-command-on-region 
+;;        (point-min) 
+;;        (point-max)
+;;        (format "%s %s -pass env:NETRC_OPENSSL_PASSWORD -e"
+;;                netrc-openssl-path
+;;                netrc-encrypting-method)
+;;        t
+;;        t)
+;;       (write-file encrypted-file t))))))
+
+;;     (if (and netrc-encrypting-method
+;;              netrc-openssl-path)
+;;         (let ((buffer-file-coding-system 'binary)
+;;               (coding-system-for-read 'binary)
+;;               (coding-system-for-write 'binary)
+;;               (password 
+;;                (password-read
+;;                 (format "OpenSSL Password for cipher %s? "
+;;                         netrc-encrypting-method)
+;;                 (format "netrc-openssl-password-%s" 
+;;                         netrc-encrypting-method))))
+;;           (when password
+;;             (insert-file-contents file)
+;;             (setenv "NETRC_OPENSSL_PASSWORD" password)
+;;             (shell-command-on-region
+;;              (point-min) 
+;;              (point-max)
+;;              (format "%s %s -pass env:NETRC_OPENSSL_PASSWORD -d"
+;;                      netrc-openssl-path
+;;                      netrc-encrypting-method)
+;;              t
+;;              t)))
+
index 712d88c..bd405c0 100644 (file)
@@ -358,8 +358,12 @@ References or In-Reply-To header and then looks in the registry to
 see which group that message was put in.  This group is returned.
 
 See the Info node `(gnus)Fancy Mail Splitting' for more details."
-  (let ((refstr (or (message-fetch-field "references")
-                   (message-fetch-field "in-reply-to")))
+  (let* ((refstr (or (message-fetch-field "references") "")) ; guarantee string
+        (reply-to (message-fetch-field "in-reply-to"))      ; grab reply-to
+        ;; now, if reply-to is valid, append it to the References
+        (refstr (if reply-to 
+                    (concat refstr " " reply-to)
+                  refstr))
        (nnmail-split-fancy-with-parent-ignore-groups
         (if (listp nnmail-split-fancy-with-parent-ignore-groups)
             nnmail-split-fancy-with-parent-ignore-groups
index 236af15..c3be996 100644 (file)
 ;;; .netrc and .authinfo rc parsing
 ;;;
 
-;; autoload password
+;; autoload gnus-encrypt
 (eval-and-compile
-  (autoload 'password-read "password"))
+  (autoload 'gnus-encrypt-find-model "gnus-encrypt")
+  (autoload 'gnus-encrypt-insert-file-contents "gnus-encrypt"))
 
 (defgroup netrc nil
  "Netrc configuration.")
 
-(defcustom netrc-encrypting-method nil
-  "Decoding method used for the netrc file.
-Use the OpenSSL symmetric ciphers here.  Leave nil for no
-decoding.  Encrypt the file with netrc-encrypt, but make sure you
-have set netrc-encrypting-method to a non-nil value."
-  :type '(choice
-         (const :tag "DES-3" "des3")
-         (const :tag "IDEA" "idea")
-         (const :tag "RC4" "rc4")
-         (string :tag "Explicit cipher name")
-         (const :tag "None" nil))
-  :group 'netrc)
-
-(defcustom netrc-openssl-path (executable-find "openssl")
-  "File path of the OpenSSL shell."
-  :type '(choice (file :tag "Location of openssl")
-                (const :tag "openssl is not installed" nil))
-  :group 'netrc)
-
 (defvar netrc-services-file "/etc/services"
   "The name of the services file.")
 
-(defun netrc-encrypt (plain-file encrypted-file)
-  (interactive "fPlain File: \nFEncrypted File: ")
-  "Encrypt FILE to ENCRYPTED-FILE with netrc-encrypting-method cipher."
-  (when (and (file-exists-p plain-file)
-            (stringp encrypted-file)
-            netrc-encrypting-method
-            netrc-openssl-path)
-    (let ((buffer-file-coding-system 'binary)
-         (coding-system-for-read 'binary)
-         (coding-system-for-write 'binary)
-         (password 
-          (password-read
-           (format "OpenSSL Password for cipher %s? "
-                   netrc-encrypting-method)
-           (format "netrc-openssl-password-%s"
-                   netrc-encrypting-method))))
-      (when password
-       (with-temp-buffer
-         (insert-file-contents plain-file)
-         (setenv "NETRC_OPENSSL_PASSWORD" password)
-         (shell-command-on-region 
-          (point-min) 
-          (point-max)
-          (format "%s %s -pass env:NETRC_OPENSSL_PASSWORD -e"
-                  netrc-openssl-path
-                  netrc-encrypting-method)
-          t
-          t)
-         (write-file encrypted-file t))))))
-
 (defun netrc-parse (file)
   (interactive "fFile to Parse: ")
   "Parse FILE and return an list of all entries in the file."
@@ -101,30 +53,13 @@ have set netrc-encrypting-method to a non-nil value."
       (let ((tokens '("machine" "default" "login"
                      "password" "account" "macdef" "force"
                      "port"))
+           (encryption-model (gnus-encrypt-find-model file))
            alist elem result pair)
-       (if (and netrc-encrypting-method
-                netrc-openssl-path)
-           (let ((buffer-file-coding-system 'binary)
-                 (coding-system-for-read 'binary)
-                 (coding-system-for-write 'binary)
-                 (password 
-                  (password-read
-                   (format "OpenSSL Password for cipher %s? "
-                           netrc-encrypting-method)
-                   (format "netrc-openssl-password-%s" 
-                           netrc-encrypting-method))))
-             (when password
-               (insert-file-contents file)
-               (setenv "NETRC_OPENSSL_PASSWORD" password)
-               (shell-command-on-region
-                (point-min) 
-                (point-max)
-                (format "%s %s -pass env:NETRC_OPENSSL_PASSWORD -d"
-                        netrc-openssl-path
-                        netrc-encrypting-method)
-                t
-                t)))
+
+       (if encryption-model
+           (gnus-encrypt-insert-file-contents file encryption-model)
          (insert-file-contents file))
+
        (goto-char (point-min))
        ;; Go through the file, line by line.
        (while (not (eobp))
index 4683a9c..e4fb910 100644 (file)
 ;;
 ;; (password-cache-add "test" "foo")
 ;;  => nil
-;;
+
+;; Note the previous two can be replaced with:
+;; (password-read-and-add "Password? " "test")
+;; ;; Minibuffer prompt for password.
+;; => "foo"
+;; ;; "foo" is now cached with key "test"
+
+
 ;; (password-read "Password? " "test")
 ;; ;; No minibuffer prompt
 ;;  => "foo"
@@ -83,6 +90,15 @@ The variable `password-cache' control whether the cache is used."
           (symbol-value (intern-soft key password-data)))
       (read-passwd prompt)))
 
+(defun password-read-and-add (prompt &optional key)
+  "Read password, for use with KEY, from user, or from cache if wanted.
+Then store the password in the cache.  Uses `password-read' and
+`password-cache-add'."
+  (let ((password (password-read prompt key)))
+    (when (and password key)
+      (password-cache-add key password))
+    password))
+
 (defun password-cache-remove (key)
   "Remove password indexed by KEY from password cache.
 This is typically run be a timer setup from `password-cache-add',