git.chise.org Git - elisp/gnus.git-/blob - lisp/encrypt.el

   1 ;;; encrypt.el --- file encryption routines
   2 ;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
   3
   4 ;; Author: Teodor Zlatanov <tzz@lifelogs.com>
   5 ;; Created: 2003/01/24
   6 ;; Keywords: files
   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 2, or (at your option)
  13 ;; 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; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;; This module addresses data encryption.  Page breaks are used for
  28 ;;; grouping declarations and documentation relating to each
  29 ;;; particular aspect.
  30
  31 ;;; Code:
  32
  33 ;; autoload password
  34 (eval-and-compile
  35   (autoload 'password-read "password")
  36   ;; Those two autoloads are needed since T-gnus won't load password.el
  37   ;; by way of pgg.el at the compile time.
  38   (autoload 'password-read-and-add "password")
  39   (autoload 'password-cache-remove "password"))
  40
  41 (defgroup encrypt nil
  42   "File encryption configuration.")
  43
  44 (defcustom encrypt-password-cache-expiry 200
  45   "Encryption password timeout.
  46 When set, directly sets password-cache-expiry"
  47   :type 'integer
  48   :group 'encrypt
  49   :set (lambda (symbol value)
  50          (set symbol value)
  51          (setq password-cache-expiry value)))
  52
  53 (defcustom encrypt-file-alist nil
  54   "List of file names or regexes matched with encryptions.
  55 Format example:
  56  '((\"beta\"
  57     (gpg \"AES\"))
  58    (\"/home/tzz/alpha\"
  59     (encrypt-xor \"Semi-Secret\")))"
  60
  61   :type '(repeat
  62           (list :tag "Encryption entry"
  63            (radio :tag "What to encrypt"
  64                   (file :tag "Filename")
  65                   (regexp :tag "Regular expression match"))
  66            (radio :tag "How to encrypt it"
  67                   (list
  68                    :tag "GPG Encryption"
  69                    (const :tag "GPG Program" gpg)
  70                    (radio :tag "Choose a cipher"
  71                           (const :tag "3DES Encryption" "3DES")
  72                           (const :tag "CAST5 Encryption" "CAST5")
  73                           (const :tag "Blowfish Encryption" "BLOWFISH")
  74                           (const :tag "AES Encryption" "AES")
  75                           (const :tag "AES192 Encryption" "AES192")
  76                           (const :tag "AES256 Encryption" "AES256")
  77                           (const :tag "Twofish Encryption" "TWOFISH")
  78                           (string :tag "Cipher Name")))
  79                   (list
  80                    :tag "Built-in simple XOR"
  81                    (const :tag "XOR Encryption" encrypt-xor)
  82                    (string :tag "XOR Cipher Value (seed value)")))))
  83   :group 'encrypt)
  84
  85 ;; TODO: now, load gencrypt.el and if successful, modify the
  86 ;; custom-type of encrypt-file-alist to add the gencrypt.el options
  87
  88 ;; (plist-get (symbol-plist 'encrypt-file-alist) 'custom-type)
  89 ;; then use plist-put
  90
  91 (defcustom encrypt-gpg-path (executable-find "gpg")
  92   "Path to the GPG program."
  93   :type '(radio
  94           (file :tag "Location of the GPG executable")
  95           (const :tag "GPG is not installed" nil))
  96   :group 'encrypt)
  97
  98 (defvar encrypt-temp-prefix "encrypt"
  99   "Prefix for temporary filenames")
 100
 101 ;;;###autoload
 102 (defun encrypt-find-model (filename)
 103   "Given a filename, find a encrypt-file-alist entry"
 104   (dolist (entry encrypt-file-alist)
 105     (let ((match (nth 0 entry))
 106           (model (nth 1 entry)))
 107       (when (or (eq match filename)
 108                 (string-match match filename))
 109         (return model)))))
 110
 111 ;;;###autoload
 112 (defun encrypt-insert-file-contents (file &optional model)
 113   "Decrypt FILE into the current buffer."
 114   (interactive "fFile to insert: ")
 115   (let* ((model (or model (encrypt-find-model file)))
 116          (method (nth 0 model))
 117          (cipher (nth 1 model))
 118          (password-key (format "encrypt-password-%s-%s %s"
 119                                (symbol-name method) cipher file))
 120          (passphrase
 121           (password-read-and-add
 122            (format "%s password for cipher %s? "
 123                    (symbol-name method) cipher)
 124            password-key))
 125           (buffer-file-coding-system 'binary)
 126          (coding-system-for-read 'binary)
 127          outdata)
 128
 129     ;; note we only insert-file-contents if the method is known to be valid
 130     (cond
 131      ((eq method 'gpg)
 132       (insert-file-contents file)
 133       (setq outdata (encrypt-gpg-decode-buffer passphrase cipher)))
 134      ((eq method 'encrypt-xor)
 135       (insert-file-contents file)
 136       (setq outdata (encrypt-xor-decode-buffer passphrase cipher))))
 137
 138     (if outdata
 139         (progn
 140           (gnus-message 9 "%s was decrypted with %s (cipher %s)"
 141                         file (symbol-name method) cipher)
 142           (delete-region (point-min) (point-max))
 143           (goto-char (point-min))
 144           (insert outdata))
 145       ;; the decryption failed, alas
 146       (password-cache-remove password-key)
 147       (gnus-error 5 "%s was NOT decrypted with %s (cipher %s)"
 148                   file (symbol-name method) cipher))))
 149
 150 (defun encrypt-get-file-contents (file &optional model)
 151   "Decrypt FILE and return the contents."
 152   (interactive "fFile to decrypt: ")
 153   (with-temp-buffer
 154     (encrypt-insert-file-contents file model)
 155     (buffer-string)))
 156
 157 (defun encrypt-put-file-contents (file data &optional model)
 158   "Encrypt the DATA to FILE, then continue normally."
 159   (with-temp-buffer
 160     (insert data)
 161     (encrypt-write-file-contents file model)))
 162
 163 (defun encrypt-write-file-contents (file &optional model)
 164   "Encrypt the current buffer to FILE, then continue normally."
 165   (interactive "fFile to write: ")
 166   (let* ((model (or model (encrypt-find-model file)))
 167          (method (nth 0 model))
 168          (cipher (nth 1 model))
 169          (password-key (format "encrypt-password-%s-%s %s"
 170                                (symbol-name method) cipher file))
 171          (passphrase
 172           (password-read
 173            (format "%s password for cipher %s? "
 174                    (symbol-name method) cipher)
 175            password-key))
 176          outdata)
 177
 178     (cond
 179      ((eq method 'gpg)
 180       (setq outdata (encrypt-gpg-encode-buffer passphrase cipher)))
 181      ((eq method 'encrypt-xor)
 182       (setq outdata (encrypt-xor-encode-buffer passphrase cipher))))
 183
 184     (if outdata
 185         (progn
 186           (gnus-message 9 "%s was encrypted with %s (cipher %s)"
 187                         file (symbol-name method) cipher)
 188           (delete-region (point-min) (point-max))
 189           (goto-char (point-min))
 190           (insert outdata)
 191           ;; do not confirm overwrites
 192           (write-file file nil))
 193       ;; the decryption failed, alas
 194       (password-cache-remove password-key)
 195       (gnus-error 5 "%s was NOT encrypted with %s (cipher %s)"
 196                   file (symbol-name method) cipher))))
 197
 198 (defun encrypt-xor-encode-buffer (passphrase cipher)
 199   (encrypt-xor-process-buffer passphrase cipher t))
 200
 201 (defun encrypt-xor-decode-buffer (passphrase cipher)
 202   (encrypt-xor-process-buffer passphrase cipher nil))
 203
 204 (defun encrypt-xor-process-buffer (passphrase
 205                                         cipher
 206                                         &optional encode)
 207   "Given PASSPHRASE, xor-encode or decode the contents of the current buffer."
 208   (let* ((bs (buffer-substring-no-properties (point-min) (point-max)))
 209          ;; passphrase-sum is a simple additive checksum of the
 210          ;; passphrase and the cipher
 211         (passphrase-sum
 212          (when (stringp passphrase)
 213            (apply '+ (append cipher passphrase nil))))
 214         new-list)
 215
 216     (with-temp-buffer
 217       (if encode
 218           (progn
 219             (dolist (x (append bs nil))
 220               (setq new-list (cons (logxor x passphrase-sum) new-list)))
 221
 222             (dolist (x new-list)
 223               (insert (format "%d " x))))
 224         (progn
 225           (setq new-list (reverse (split-string bs)))
 226           (dolist (x new-list)
 227             (setq x (string-to-int x))
 228             (insert (format "%c" (logxor x passphrase-sum))))))
 229       (buffer-substring-no-properties (point-min) (point-max)))))
 230
 231 (defun encrypt-gpg-encode-buffer (passphrase cipher)
 232   (encrypt-gpg-process-buffer passphrase cipher t))
 233
 234 (defun encrypt-gpg-decode-buffer (passphrase cipher)
 235   (encrypt-gpg-process-buffer passphrase cipher nil))
 236
 237 (defun encrypt-gpg-process-buffer (passphrase
 238                                         cipher
 239                                         &optional encode)
 240   "With PASSPHRASE, use GPG to encode or decode the current buffer."
 241   (let* ((program encrypt-gpg-path)
 242          (input (buffer-substring-no-properties (point-min) (point-max)))
 243          (temp-maker (if (fboundp 'make-temp-file)
 244                          'make-temp-file
 245                        'make-temp-name))
 246          (temp-file (funcall temp-maker encrypt-temp-prefix))
 247          (default-enable-multibyte-characters nil)
 248          (args `("--cipher-algo" ,cipher
 249                  "--status-fd" "2"
 250                  "--logger-fd" "2"
 251                  "--passphrase-fd" "0"
 252                  "--no-tty"))
 253          exit-status exit-data)
 254
 255     (when encode
 256       (setq args
 257             (append args
 258                     '("--symmetric"
 259                       "--armor"))))
 260
 261     (if program
 262         (with-temp-buffer
 263           (when passphrase
 264             (insert passphrase "\n"))
 265           (insert input)
 266           (setq exit-status
 267                 (apply #'call-process-region (point-min) (point-max) program
 268                        t `(t ,temp-file) nil args))
 269           (if (equal exit-status 0)
 270               (setq exit-data
 271                     (buffer-substring-no-properties (point-min) (point-max)))
 272             (with-temp-buffer
 273               (when (file-exists-p temp-file)
 274                 (insert-file-contents temp-file))
 275               (gnus-error 5 (format "%s exited abnormally: '%s' [%s]"
 276                                     program exit-status (buffer-string)))))
 277           (delete-file temp-file))
 278       (gnus-error 5 "GPG is not installed."))
 279     exit-data))
 280
 281 (provide 'encrypt)
 282 ;;; encrypt.el ends here