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