From 653e993dac37e97b7f1b33ae2534e17eb1a13fb6 Mon Sep 17 00:00:00 2001 From: Teodor Zlatanov Date: Wed, 4 Aug 2004 17:11:58 +0000 Subject: [PATCH] * 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 --- lisp/ChangeLog | 15 ++ lisp/gnus-encrypt.el | 344 ++++++++++++++++++++++++++++++++++++++++++ lisp/gnus-registry.el | 8 +- lisp/netrc.el | 81 +--------- lisp/password.el | 18 ++- 5 files changed, 390 insertions(+), 76 deletions(-) create mode 100644 lisp/gnus-encrypt.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 973b6defa..853a615c0 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,18 @@ +2004-08-04 Teodor Zlatanov + + * 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 * 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 index 000000000..72a6a7231 --- /dev/null +++ b/lisp/gnus-encrypt.el @@ -0,0 +1,344 @@ +;;; gnus-encrypt.el --- file encryption routines for Gnus +;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. + +;; Author: Teodor Zlatanov +;; 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))) + diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el index 44df67a5e..4fcc7cd51 100644 --- a/lisp/gnus-registry.el +++ b/lisp/gnus-registry.el @@ -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 diff --git a/lisp/netrc.el b/lisp/netrc.el index 85ab77491..0a407a86f 100644 --- a/lisp/netrc.el +++ b/lisp/netrc.el @@ -34,65 +34,17 @@ ;;; .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)) diff --git a/lisp/password.el b/lisp/password.el index d079bf394..e8be612ec 100644 --- a/lisp/password.el +++ b/lisp/password.el @@ -35,7 +35,14 @@ ;; ;; (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', -- 2.25.1