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