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