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

   1 ;;; encrypt.el --- file encryption routines
   2 ;; Copyright (C) 2002, 2003, 2004, 2005 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 3, 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., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, 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 ;;; Use in Gnus like this:
  32 ;;; (require 'encrypt)
  33 ;;; (setq
  34 ;;;   nnimap-authinfo-file "~/.authinfo.enc"
  35 ;;;   nntp-authinfo-file "~/.authinfo.enc"
  36 ;;;   smtpmail-auth-credentials "~/.authinfo.enc"
  37 ;;;   ;; GnuPG using the AES256 cipher, feel free to use your own favorite
  38 ;;;   encrypt-file-alist (quote (("~/.authinfo.enc" (gpg "AES256"))))
  39 ;;;   password-cache-expiry 600)
  40
  41 ;;; Then write ~/.authinfo.enc:
  42
  43 ;;; 1) open the old authinfo
  44 ;;; C-x C-f ~/.authinfo
  45
  46 ;;; 2) write the new authinfo.enc
  47 ;;; M-x encrypt-write-file-contents RET ~/.authinfo.enc
  48
  49 ;;; 3) verify the new authinfo is correct (this will show the contents in the minibuffer)
  50 ;;; M-: (encrypt-get-file-contents "~/.authinfo.enc")
  51
  52
  53 ;;; Code:
  54
  55 ;; autoload password
  56 (eval-and-compile
  57   (if (locate-library "password-cache")
  58       (require 'password-cache)
  59     (require 'password)))
  60
  61 (defgroup encrypt '((password-cache custom-variable)
  62                     (password-cache-expiry custom-variable))
  63   "File encryption configuration."
  64   :group 'applications)
  65
  66 (defcustom encrypt-file-alist nil
  67   "List of file names or regexes matched with encryptions.
  68 Format example:
  69  '((\"beta\"
  70     (gpg \"AES\"))
  71    (\"/home/tzz/alpha\"
  72     (encrypt-xor \"Semi-Secret\")))"
  73
  74   :type '(repeat
  75           (list :tag "Encryption entry"
  76            (radio :tag "What to encrypt"
  77                   (file :tag "Filename")
  78                   (regexp :tag "Regular expression match"))
  79            (radio :tag "How to encrypt it"
  80                   (list
  81                    :tag "GPG Encryption"
  82                    (const :tag "GPG Program" gpg)
  83                    (radio :tag "Choose a cipher"
  84                           (const :tag "3DES Encryption" "3DES")
  85                           (const :tag "CAST5 Encryption" "CAST5")
  86                           (const :tag "Blowfish Encryption" "BLOWFISH")
  87                           (const :tag "AES Encryption" "AES")
  88                           (const :tag "AES192 Encryption" "AES192")
  89                           (const :tag "AES256 Encryption" "AES256")
  90                           (const :tag "Twofish Encryption" "TWOFISH")
  91                           (string :tag "Cipher Name")))
  92                   (list
  93                    :tag "Built-in simple XOR"
  94                    (const :tag "XOR Encryption" encrypt-xor)
  95                    (string :tag "XOR Cipher Value (seed value)")))))
  96   :group 'encrypt)
  97
  98 ;; TODO: now, load gencrypt.el and if successful, modify the
  99 ;; custom-type of encrypt-file-alist to add the gencrypt.el options
 100
 101 ;; (plist-get (symbol-plist 'encrypt-file-alist) 'custom-type)
 102 ;; then use plist-put
 103
 104 (defcustom encrypt-gpg-path (executable-find "gpg")
 105   "Path to the GPG program."
 106   :type '(radio
 107           (file :tag "Location of the GPG executable")
 108           (const :tag "GPG is not installed" nil))
 109   :group 'encrypt)
 110
 111 (defvar encrypt-temp-prefix "encrypt"
 112   "Prefix for temporary filenames")
 113
 114 ;;;###autoload
 115 (defun encrypt-find-model (filename)
 116   "Given a filename, find a encrypt-file-alist entry"
 117   (dolist (entry encrypt-file-alist)
 118     (let ((match (nth 0 entry))
 119           (model (nth 1 entry)))
 120       (when (or (eq match filename)
 121                 (string-match match filename))
 122         (return model)))))
 123
 124 ;;;###autoload
 125 (defun encrypt-insert-file-contents (file &optional model)
 126   "Decrypt FILE into the current buffer."
 127   (interactive "fFile to insert: ")
 128   (let* ((model (or model (encrypt-find-model file)))
 129          (method (nth 0 model))
 130          (cipher (nth 1 model))
 131          (password-key (format "encrypt-password-%s-%s %s"
 132                                (symbol-name method) cipher file))
 133          (passphrase
 134           (password-read-and-add
 135            (format "%s password for cipher %s (file %s)? "
 136                    file (symbol-name method) cipher)
 137            password-key))
 138           (buffer-file-coding-system 'binary)
 139          (coding-system-for-read 'binary)
 140          outdata)
 141
 142     ;; note we only insert-file-contents if the method is known to be valid
 143     (cond
 144      ((eq method 'gpg)
 145       (insert-file-contents file)
 146       (setq outdata (encrypt-gpg-decode-buffer passphrase cipher)))
 147      ((eq method 'encrypt-xor)
 148       (insert-file-contents file)
 149       (setq outdata (encrypt-xor-decode-buffer passphrase cipher))))
 150
 151     (if outdata
 152         (progn
 153           (message "%s was decrypted with %s (cipher %s)"
 154                    file (symbol-name method) cipher)
 155           (delete-region (point-min) (point-max))
 156           (goto-char (point-min))
 157           (insert outdata))
 158       ;; the decryption failed, alas
 159       (password-cache-remove password-key)
 160       (gnus-error 5 "%s was NOT decrypted with %s (cipher %s)"
 161                   file (symbol-name method) cipher))))
 162
 163 (defun encrypt-get-file-contents (file &optional model)
 164   "Decrypt FILE and return the contents."
 165   (interactive "fFile to decrypt: ")
 166   (with-temp-buffer
 167     (encrypt-insert-file-contents file model)
 168     (buffer-string)))
 169
 170 (defun encrypt-put-file-contents (file data &optional model)
 171   "Encrypt the DATA to FILE, then continue normally."
 172   (with-temp-buffer
 173     (insert data)
 174     (encrypt-write-file-contents file model)))
 175
 176 (defun encrypt-write-file-contents (file &optional model)
 177   "Encrypt the current buffer to FILE, then continue normally."
 178   (interactive "sFile to write: ")
 179   (setq model (or model (encrypt-find-model file)))
 180   (if model
 181       (let* ((method (nth 0 model))
 182              (cipher (nth 1 model))
 183              (password-key (format "encrypt-password-%s-%s %s"
 184                                    (symbol-name method) cipher file))
 185              (passphrase
 186               (password-read
 187                (format "%s password for cipher %s? "
 188                        (symbol-name method) cipher)
 189                password-key))
 190              outdata)
 191
 192         (cond
 193          ((eq method 'gpg)
 194           (setq outdata (encrypt-gpg-encode-buffer passphrase cipher)))
 195          ((eq method 'encrypt-xor)
 196           (setq outdata (encrypt-xor-encode-buffer passphrase cipher))))
 197
 198         (if outdata
 199             (progn
 200               (message "%s was encrypted with %s (cipher %s)"
 201                        file (symbol-name method) cipher)
 202               (delete-region (point-min) (point-max))
 203               (goto-char (point-min))
 204               (insert outdata)
 205               ;; do not confirm overwrites
 206               (write-file file nil))
 207           ;; the decryption failed, alas
 208           (password-cache-remove password-key)
 209           (gnus-error 5 "%s was NOT encrypted with %s (cipher %s)"
 210                       file (symbol-name method) cipher)))
 211     (gnus-error 1 "%s has no associated encryption model!  See encrypt-file-alist." file)))
 212
 213 (defun encrypt-xor-encode-buffer (passphrase cipher)
 214   (encrypt-xor-process-buffer passphrase cipher t))
 215
 216 (defun encrypt-xor-decode-buffer (passphrase cipher)
 217   (encrypt-xor-process-buffer passphrase cipher nil))
 218
 219 (defun encrypt-xor-process-buffer (passphrase
 220                                         cipher
 221                                         &optional encode)
 222   "Given PASSPHRASE, xor-encode or decode the contents of the current buffer."
 223   (let* ((bs (buffer-substring-no-properties (point-min) (point-max)))
 224          ;; passphrase-sum is a simple additive checksum of the
 225          ;; passphrase and the cipher
 226         (passphrase-sum
 227          (when (stringp passphrase)
 228            (apply '+ (append cipher passphrase nil))))
 229         new-list)
 230
 231     (with-temp-buffer
 232       (if encode
 233           (progn
 234             (dolist (x (append bs nil))
 235               (setq new-list (cons (logxor x passphrase-sum) new-list)))
 236
 237             (dolist (x new-list)
 238               (insert (format "%d " x))))
 239         (progn
 240           (setq new-list (reverse (split-string bs)))
 241           (dolist (x new-list)
 242             (setq x (string-to-number x))
 243             (insert (format "%c" (logxor x passphrase-sum))))))
 244       (buffer-substring-no-properties (point-min) (point-max)))))
 245
 246 (defun encrypt-gpg-encode-buffer (passphrase cipher)
 247   (encrypt-gpg-process-buffer passphrase cipher t))
 248
 249 (defun encrypt-gpg-decode-buffer (passphrase cipher)
 250   (encrypt-gpg-process-buffer passphrase cipher nil))
 251
 252 (defun encrypt-gpg-process-buffer (passphrase
 253                                         cipher
 254                                         &optional encode)
 255   "With PASSPHRASE, use GPG to encode or decode the current buffer."
 256   (let* ((program encrypt-gpg-path)
 257          (input (buffer-substring-no-properties (point-min) (point-max)))
 258          (temp-maker (if (fboundp 'make-temp-file)
 259                          'make-temp-file
 260                        'make-temp-name))
 261          (temp-file (funcall temp-maker encrypt-temp-prefix))
 262          (default-enable-multibyte-characters nil)
 263          (args `("--cipher-algo" ,cipher
 264                  "--status-fd" "2"
 265                  "--logger-fd" "2"
 266                  "--passphrase-fd" "0"
 267                  "--no-tty"))
 268          exit-status exit-data)
 269
 270     (when encode
 271       (setq args
 272             (append args
 273                     '("--symmetric"
 274                       "--armor"))))
 275
 276     (if program
 277         (with-temp-buffer
 278           (when passphrase
 279             (insert passphrase "\n"))
 280           (insert input)
 281           (setq exit-status
 282                 (apply #'call-process-region (point-min) (point-max) program
 283                        t `(t ,temp-file) nil args))
 284           (if (equal exit-status 0)
 285               (setq exit-data
 286                     (buffer-substring-no-properties (point-min) (point-max)))
 287             (with-temp-buffer
 288               (when (file-exists-p temp-file)
 289                 (insert-file-contents temp-file))
 290               (gnus-error 5 (format "%s exited abnormally: '%s' [%s]"
 291                                     program exit-status (buffer-string)))))
 292           (delete-file temp-file))
 293       (gnus-error 5 "GPG is not installed."))
 294     exit-data))
 295
 296 (provide 'encrypt)
 297 ;;; encrypt.el ends here
 298
 299 ;; arch-tag: d907e4f1-71b5-42b1-a180-fc7b84ff0648