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

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