cgit.sxemacs.org Git - gnus/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"
 113                                (symbol-name method) cipher))
 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       (gnus-error 5 "%s was NOT decrypted with %s (cipher %s)"
 140                   file (symbol-name method) cipher))))
 141
 142 (defun gnus-encrypt-get-file-contents (file &optional model)
 143   "Decrypt FILE and return the contents."
 144   (interactive "fFile to decrypt: ")
 145   (with-temp-buffer
 146     (gnus-encrypt-insert-file-contents file model)
 147     (buffer-string)))
 148
 149 (defun gnus-encrypt-put-file-contents (file data &optional model)
 150   "Encrypt the DATA to FILE, then continue normally."
 151   (with-temp-buffer
 152     (insert data)
 153     (gnus-encrypt-write-file-contents file model)))
 154
 155 (defun gnus-encrypt-write-file-contents (file &optional model)
 156   "Encrypt the current buffer to FILE, then continue normally."
 157   (interactive "fFile to write: ")
 158   (let* ((model (or model (gnus-encrypt-find-model file)))
 159          (method (nth 0 model))
 160          (cipher (nth 1 model))
 161          (passphrase
 162           (password-read
 163            (format "%s password for cipher %s? "
 164                    (symbol-name method) cipher)
 165            (format "gnus-encrypt-password-%s-%s"
 166                    (symbol-name method) cipher)))
 167          outdata)
 168
 169     (cond
 170      ((eq method 'gpg)
 171       (setq outdata (gnus-encrypt-gpg-encode-buffer passphrase cipher)))
 172      ((eq method 'gnus-encrypt-xor)
 173       (setq outdata (gnus-encrypt-xor-encode-buffer passphrase cipher))))
 174
 175     (if outdata
 176         (progn
 177           (gnus-message 9 "%s was encrypted with %s (cipher %s)"
 178                         file (symbol-name method) cipher)
 179           (delete-region (point-min) (point-max))
 180           (goto-char (point-min))
 181           (insert outdata)
 182           ;; do not confirm overwrites
 183           (write-file file nil))
 184       (gnus-error 5 "%s was NOT encrypted with %s (cipher %s)"
 185                   file (symbol-name method) cipher))))
 186
 187 (defun gnus-encrypt-xor-encode-buffer (passphrase cipher)
 188   (gnus-encrypt-xor-process-buffer passphrase cipher t))
 189
 190 (defun gnus-encrypt-xor-decode-buffer (passphrase cipher)
 191   (gnus-encrypt-xor-process-buffer passphrase cipher nil))
 192
 193 (defun gnus-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-int x))
 217             (insert (format "%c" (logxor x passphrase-sum))))))
 218       (buffer-substring-no-properties (point-min) (point-max)))))
 219
 220 (defun gnus-encrypt-gpg-encode-buffer (passphrase cipher)
 221   (gnus-encrypt-gpg-process-buffer passphrase cipher t))
 222
 223 (defun gnus-encrypt-gpg-decode-buffer (passphrase cipher)
 224   (gnus-encrypt-gpg-process-buffer passphrase cipher nil))
 225
 226 (defun gnus-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 gnus-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 gnus-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 'gnus-encrypt)
 271 ;;; gnus-encrypt.el ends here
 272
 273 ;; (defcustom netrc-encrypting-method nil
 274 ;;   "Decoding method used for the netrc file.
 275 ;; Use the OpenSSL symmetric ciphers here.  Leave nil for no
 276 ;; decoding.  Encrypt the file with netrc-encrypt, but make sure you
 277 ;; have set netrc-encrypting-method to a non-nil value."
 278 ;;   :type '(choice
 279 ;;        (const :tag "DES-3" "des3")
 280 ;;        (const :tag "IDEA" "idea")
 281 ;;        (const :tag "RC4" "rc4")
 282 ;;        (string :tag "Explicit cipher name")
 283 ;;        (const :tag "None" nil))
 284 ;;   :group 'netrc)
 285
 286 ;; (defcustom netrc-openssl-path (executable-find "openssl")
 287 ;;   "File path of the OpenSSL shell."
 288 ;;   :type '(choice (file :tag "Location of openssl")
 289 ;;               (const :tag "openssl is not installed" nil))
 290 ;;   :group 'netrc)
 291
 292 ;; (defun netrc-encrypt (plain-file encrypted-file)
 293 ;;   (interactive "fPlain File: \nFEncrypted File: ")
 294 ;;   "Encrypt FILE to ENCRYPTED-FILE with netrc-encrypting-method cipher."
 295 ;;   (when (and (file-exists-p plain-file)
 296 ;;           (stringp encrypted-file)
 297 ;;           netrc-encrypting-method
 298 ;;           netrc-openssl-path)
 299 ;;     (let ((buffer-file-coding-system 'binary)
 300 ;;        (coding-system-for-read 'binary)
 301 ;;        (coding-system-for-write 'binary)
 302 ;;        (password
 303 ;;         (password-read
 304 ;;          (format "OpenSSL Password for cipher %s? "
 305 ;;                  netrc-encrypting-method)
 306 ;;          (format "netrc-openssl-password-%s"
 307 ;;                  netrc-encrypting-method))))
 308 ;;       (when password
 309 ;;      (with-temp-buffer
 310 ;;        (insert-file-contents plain-file)
 311 ;;        (setenv "NETRC_OPENSSL_PASSWORD" password)
 312 ;;        (shell-command-on-region
 313 ;;         (point-min)
 314 ;;         (point-max)
 315 ;;         (format "%s %s -pass env:NETRC_OPENSSL_PASSWORD -e"
 316 ;;                 netrc-openssl-path
 317 ;;                 netrc-encrypting-method)
 318 ;;         t
 319 ;;         t)
 320 ;;        (write-file encrypted-file t))))))
 321
 322 ;;      (if (and netrc-encrypting-method
 323 ;;               netrc-openssl-path)
 324 ;;          (let ((buffer-file-coding-system 'binary)
 325 ;;                (coding-system-for-read 'binary)
 326 ;;                (coding-system-for-write 'binary)
 327 ;;                (password
 328 ;;                 (password-read
 329 ;;                  (format "OpenSSL Password for cipher %s? "
 330 ;;                          netrc-encrypting-method)
 331 ;;                  (format "netrc-openssl-password-%s"
 332 ;;                          netrc-encrypting-method))))
 333 ;;            (when password
 334 ;;              (insert-file-contents file)
 335 ;;              (setenv "NETRC_OPENSSL_PASSWORD" password)
 336 ;;              (shell-command-on-region
 337 ;;               (point-min)
 338 ;;               (point-max)
 339 ;;               (format "%s %s -pass env:NETRC_OPENSSL_PASSWORD -d"
 340 ;;                       netrc-openssl-path
 341 ;;                       netrc-encrypting-method)
 342 ;;               t
 343 ;;               t)))
 344