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

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