cgit.sxemacs.org Git - packages/blob - xemacs-packages/os-utils/crypt.el

   1 ;;; crypt.el -- handle all sorts of compressed and encrypted files
   2 ;;; (may also be installed as crypt.el)
   3
   4 ;; Authors: Lawrence R. Dodd <dodd@roebling.poly.edu>
   5 ;;      Rod Whitby <rwhitby@research.canon.oz.au>
   6 ;;      Kyle E. Jones <kyle@uunet.uu.net>
   7 ;; Maintainer: xemacs-beta@xemacs.org
   8 ;; Created: crypt.el in 1988, crypt++.el on 18 Jan 1993
   9 ;; Version: 2.94
  10 ;; Date: 1994/03/31 12:30:17
  11 ;; Keywords: extensions
  12
  13 ;;; Copyright (C) 1998, 1999, 2000, 2001, 2003 Free Software Foundation, Inc.
  14 ;;; Copyright (C) 1994 Lawrence R. Dodd
  15 ;;; Copyright (C) 1993 Lawrence R. Dodd and Rod Whitby
  16 ;;; Copyright (C) 1988, 1989, 1990 Kyle E. Jones
  17 ;;;
  18 ;;; This program is free software; you can redistribute it and/or modify
  19 ;;; it under the terms of the GNU General Public License as published by
  20 ;;; the Free Software Foundation; either version 2 of the License, or
  21 ;;; (at your option) any later version.
  22 ;;;
  23 ;;; This program is distributed in the hope that it will be useful,
  24 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  25 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  26 ;;; GNU General Public License for more details.
  27 ;;;
  28 ;;; You should have received a copy of the GNU General Public License
  29 ;;; along with this program; if not, write to the Free Software
  30 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  31
  32 ;;; Synched up with: Not in FSF.
  33
  34 ;;; Commentary:
  35
  36 ;;; Please see notes on INSTALLATION and USAGE on the pages below.
  37
  38 ;;; LCD Archive Entry:
  39 ;;; crypt++|Rod Whitby and Lawrence R. Dodd|xemacs-beta@xemacs.org|
  40 ;;; Code for handling all sorts of compressed and encrypted files.|
  41 ;;; 1994/03/31 12:30:17|2.94|~/misc/crypt++.el.Z|
  42
  43 ;;; BUG REPORTS:
  44 ;;;
  45 ;;; Type M-x crypt-submit-report to generate a bug report template or put your
  46 ;;; cursor at the end of this line and type C-x C-e: (crypt-submit-report)
  47 ;;;
  48 ;;; Please note that this bug-report facility (crypt-submit-report) uses
  49 ;;; Barry Warsaw's reporter.el which is part of GNU Emacs v19 and
  50 ;;; bundled with many other packages.  If needed, you can obtain a copy
  51 ;;; of reporter.el at the elisp-archive.  In fact, crypt-submit-report
  52 ;;; will attempt to ange-ftp a copy for you if you do not
  53 ;;; have one accessible.
  54 ;;;
  55 ;;; Main author:
  56 ;;; Lawrence R. Dodd
  57 ;;; Polytechnic University
  58 ;;; Brooklyn, New York USA
  59
  60 ;;; VERSION:
  61 ;;;
  62 ;;; Version: 2.94
  63 ;;; Ident: crypt++.el,v 2.82 1994/03/31 12:30:17 dodd Exp
  64 ;;; Date: 1994/03/31 12:30:17
  65
  66 \f
  67 ;;; INSTALLATION:
  68 ;;;
  69 ;;; To use this package, simply put it in a file called "crypt.el" in a Lisp
  70 ;;; directory known to Emacs (see `load-path'), byte-compile it (ignore
  71 ;;; warnings about undefined functions), and put the line:
  72 ;;;
  73 ;;;                      (require 'crypt)
  74 ;;;
  75 ;;; in your ~/.emacs file or in the file default.el in the ../lisp directory
  76 ;;; of the Emacs distribution.
  77 ;;;
  78 ;;; For reliable operation with Emacs versions with coding system
  79 ;;; support, you also need:
  80 ;;;
  81 ;;;    (modify-coding-system-alist 'file "\\.bz\\'" 'no-conversion)
  82 ;;;    (modify-coding-system-alist 'file "\\.bz2\\'" 'no-conversion)
  83 ;;;    (modify-coding-system-alist 'file "\\.gpg\\'" 'no-conversion)
  84 ;;;    (modify-coding-system-alist 'file "\\.gz\\'" 'no-conversion)
  85 ;;;    (modify-coding-system-alist 'file "\\.Z\\'" 'no-conversion)
  86 ;;;
  87 ;;; With XEmacs, you need 'no-conversion-unix instead of 'no-conversion.
  88 ;;; (Thanks to Jose M. Vidal <vidal@sc.edu>.)
  89 ;;;
  90 ;;; XEmacs note: not modifying file-coding-system-alist to include .gpg,
  91 ;;; because those files are ASCII-compatible, and non-ASCII-compatible
  92 ;;; support in XEmacs is and will remain (for the moment) patchy at best.
  93 ;;;
  94 ;;; Otherwise, Emacs tampers with the bytes before crypt++ gets them.
  95 ;;; The above won't help for files without those extensions.  You just
  96 ;;; have to specify the no-conversion coding system manually when
  97 ;;; visiting those files, or set no-conversion for all files if that suits you.
  98 ;;;
  99 ;;; Do not bother trying to autoload this package; it uses find-file and
 100 ;;; write-file hooks and thus should be loaded the first time you visit
 101 ;;; any sort of file.  Any package loaded after this one that appends
 102 ;;; something to `write-file-hooks' will not be executed because this
 103 ;;; package writes out the file.  Other packages that append to
 104 ;;; `write-file-hooks' should either be modified to prepend to that hook
 105 ;;; or be loaded before this one (preferably the former).
 106 ;;;
 107 ;;; An alternative is to stick (require 'crypt) in your ~/.emacs, if it is not
 108 ;;; already there, and then make a symbolic link from crypt++.el to crypt.el
 109 ;;; with "ln -s crypt++.el crypt.el".  This will make crypt++ act like a
 110 ;;; drop-in replacement for the original crypt since any package requiring
 111 ;;; crypt will find crypt++ instead.
 112 ;;; NOTE: encryption users should set `crypt-encryption-type' to one of the
 113 ;;; values in `crypt-encryption-alist' (see USAGE below).
 114
 115 ;;; SEE ALSO: /roebling.poly.edu:/pub/crypt++-fnf.el for file-not-found
 116 ;;; support for GNU Emacs.
 117
 118 ;;; SPECIAL NOTES:
 119 ;;;
 120 ;;; If crypt is dumped with the emacs executable, or if it has already been
 121 ;;; loaded in an emacs session, then modifying the variables used in building
 122 ;;; the encryption and encoding tables will have no effect until these tables
 123 ;;; are rebuilt.  This may be done with `M-x crypt-rebuild-tables'.  See USAGE
 124 ;;; below to determine variables for which this is needed.  For example,
 125 ;;; post-load changes to `crypt-encryption-file-extension' or
 126 ;;; `crypt-freeze-vs-fortran' can be incorporated into the encryption table
 127 ;;; via `M-x crypt-rebuild-tables'.  Similarly, post-load changes to
 128 ;;; `crypt-bind-insert-file' are handled with `M-x crypt-bind-insert-file'.
 129
 130 \f
 131 ;;; USAGE:
 132 ;;;
 133 ;;; By default, intended to be transparent.  User-defined variables
 134 ;;;
 135 ;;;     controlling ENCRYPTION are
 136 ;;;
 137 ;;;        crypt-encryption-type
 138 ;;;        crypt-encryption-file-extension
 139 ;;;        crypt-never-ever-decrypt
 140 ;;;        crypt-auto-write-buffer-encrypted
 141 ;;;        crypt-confirm-password
 142 ;;;        crypt-encrypted-disable-auto-save
 143 ;;;        crypt-encryption-alist
 144 ;;;
 145 ;;;     controlling ENCODING are
 146 ;;;
 147 ;;;        crypt-auto-decode-buffer
 148 ;;;        crypt-auto-write-buffer
 149 ;;;        crypt-query-if-interactive
 150 ;;;        crypt-no-extension-implies-plain
 151 ;;;        crypt-freeze-vs-fortran
 152 ;;;        crypt-compact-vs-C++
 153 ;;;        crypt-ignored-filenames
 154 ;;;        crypt-default-encoding
 155 ;;;        crypt-encoded-disable-auto-save
 156 ;;;        crypt-encoding-alist
 157 ;;;
 158 ;;;     controlling file insertion are
 159 ;;;
 160 ;;;        crypt-bind-insert-file
 161 ;;;        crypt-auto-decode-insert
 162 ;;;
 163 ;;; To find out more about these variables, load this file, put your cursor at
 164 ;;; the end of any of the variable names, and hit C-h v [RET].
 165 ;;;
 166 ;;; NOTE: encryption users should set `crypt-encryption-type' to one of the
 167 ;;; values in `crypt-encryption-alist'
 168 ;;;
 169 ;;; Although rarely needed, the following functions may be called interactively
 170 ;;;
 171 ;;;        (crypt-encoded-mode)
 172 ;;;        (crypt-encode-region)
 173 ;;;        (crypt-encrypted-mode)
 174 ;;;        (crypt-encrypt-region)
 175 ;;;        (crypt-set-encryption-key)
 176 ;;;        (crypt-rebuild-tables)
 177 ;;;        (crypt-insert-file)
 178 ;;;        (crypt-bind-insert-file)
 179 ;;;        (crypt-submit-report)
 180 ;;;
 181 ;;; To find out more about these functions, load this file, put your cursor
 182 ;;; inside any of the `()' of the above lines, and hit C-h f [RET].
 183
 184 \f
 185 ;;; NOTES ON INTERFACES WITH OTHER PROGRAMS AND PACKAGES:
 186 ;;;
 187 ;;; GZIP: the environment variable GZIP of gzip can cause an error if it
 188 ;;; contains `--verbose' because standard output messages will be appended to
 189 ;;; gzip'ed files.  This corrupts the files.  The cleanest solution is to pass
 190 ;;; the `--quiet' switch in `crypt-encoding-alist' to override this.  use gzip
 191 ;;; version 1.0.4 or higher from prep.ai.mit.edu:/pub/gnu
 192 ;;;
 193 ;;; TAR-MODE: works properly with version 1.28 (or higher) with v19 emacs.
 194
 195 \f
 196 ;;; DESCRIPTION:
 197 ;;;
 198 ;;; The basic purpose of this package of Lisp functions is to recognize
 199 ;;; automatically encrypted and encoded (i.e., compressed) files when they are
 200 ;;; first visited or written.  The BUFFER corresponding to the file is decoded
 201 ;;; and/or decrypted before it is presented to the user.  The file itself is
 202 ;;; unchanged on the disk.  When the buffer is subsequently saved to disk, a
 203 ;;; hook function re-encodes the buffer before the actual disk write takes
 204 ;;; place.
 205 ;;;
 206 ;;; This package recognizes all sorts of compressed files by a magic number at
 207 ;;; the beginning of these files but uses a heuristic to detect encrypted
 208 ;;; files.  If you are asked for an encryption key for a file that is in fact
 209 ;;; not encrypted, just hit RET and the file will be accepted as is, and the
 210 ;;; crypt minor mode will not be entered.
 211 ;;;
 212 ;;; Other types of encoding programs may be added to this package by using the
 213 ;;; variable `crypt-encoding-alist' which contains a table of encoding
 214 ;;; programs such as compress, gzip (GNU zip), freeze, and compact.
 215 ;;;
 216 ;;; This new extended version of crypt now monitors the filename extensions of
 217 ;;; buffers that are written out using write-file (C-x C-w).  If the filename
 218 ;;; extension matches one of the extensions listed in `crypt-encoding-alist,'
 219 ;;; then this package will write the file out using the corresponding encoding
 220 ;;; (compression) method. This is done whether or not the buffer originated
 221 ;;; from a previously encoded (compressed) file.
 222 ;;;
 223 ;;; Thus, if the user is editing a file that may or may not have been encoded
 224 ;;; originally (e.g., foobar.Z or foobar) and decides to write it to a
 225 ;;; different file (e.g., barfoo or barfoo.z or barfoo.C).  This package will
 226 ;;; examine the filename extension and write the buffer in plain format or an
 227 ;;; alternate encoding (compression) format by searching through the entries
 228 ;;; in the table of encoding methods `crypt-encoding-alist.'  This change in
 229 ;;; encoding state is done automatically if the variable
 230 ;;; `crypt-auto-write-buffer' is t otherwise the user is asked.
 231
 232 \f
 233 ;;; TO DO/KNOWN BUGS/HELP WANTED/APPLY WITHIN:
 234 ;;;
 235 ;;; All Users/hackers out there are strongly encouraged to pursue any of these
 236 ;;; matters further (especially those that concern encryption and decryption!).
 237 ;;; It is important to future programmers and modifiers of crypt++.el to know
 238 ;;; about its perceived limitations.  Since necessity drives invention, users
 239 ;;; who find any of the following features of crypt++.el annoying are asked to
 240 ;;; make suggestions and send patches (again, especially those that concern
 241 ;;; encryption and decryption!).
 242 ;;;
 243 ;;; * currently crypt++ assumes that if a file is both encrypted and encoded
 244 ;;;   (i.e., compressed) that the order in which it was done was encryption
 245 ;;;   first _then_ compression.  As has been pointed by many people compression
 246 ;;;   following encryption is useless since the encrypted file is basically
 247 ;;;   random.  On the other hand, many agree that doing encryption _following_
 248 ;;;   compression is better since it makes it harder to crack the encryption.
 249 ;;;   We would like to make the ordering of these two user-configurable or if
 250 ;;;   nothing else change the order.
 251 ;;;
 252 ;;;   Having read the above however, Francois Pinard <pinard@iro.umontreal.ca>
 253 ;;;   writes that encryption following compression may not be harder to crack
 254 ;;;   since "the fact that the first few uncrypted bytes are expected (the
 255 ;;;   compress signature) facilitates a serious attempt at uncrypting."
 256 ;;;   jwz agrees with Francois.
 257 ;;;
 258 ;;; * get write-region and append-to-file to handle encoded and encrypted
 259 ;;;   files.  There is an interesting low-level encoding package by Jay Adams
 260 ;;;   <jka@ece.cmu.edu> called jka-compr.el that might address some of these
 261 ;;;   issues.  We encourage hackers out there to come up with crypt++ versions
 262 ;;;   of write-region and append-to-file.  The difficulty is creating versions
 263 ;;;   that mimic the originals as closely as possible.
 264 ;;;
 265 ;;; * instead of using call-process-region (which can fail badly if the region
 266 ;;;   is large and there's not much room in /tmp), write the region to a temp
 267 ;;;   file (with a customisable location) and use call-process directly.
 268 ;;;
 269 ;;; * users have mentioned trouble using crypt++ and hilit simultaneously since
 270 ;;;   the functions in write-file-hook for both write the file to disk and
 271 ;;;   return t.  A possible solution is to have one of them write to a
 272 ;;;   scratch buffer instead of to disk and return nil and then allow the
 273 ;;;   other to do its work on the scratch buffer and write it to disk.  Thanks
 274 ;;;   to Wayne Folta <folta@cs.UMD.EDU> and Amir J Katz <amir@matis.ingr.com>.
 275 ;;;   It would be nice to have another way in emacs to have an
 276 ;;;   after-write-file-hook and a before-write-file-hook of some sort.
 277 ;;;   Lucid Emacs has an after-write-file-hook.  Recent versions of hilit19.el
 278 ;;;   do not automatically attach to `write-file-hooks' and return t.
 279 ;;;   However, the general problem of multiple packages returning t still
 280 ;;;   remains.  dos-mode.el and crypt.el also conflict.
 281 ;;;
 282 ;;; * another possible source of trouble is with encryption (and encoding)
 283 ;;;   programs sticking verbose output into buffers prior to being written to
 284 ;;;   disk.  This was definitely occurring with gzip because of --verbose in
 285 ;;;   the GZIP environment variable and is solved/hidden with the --quiet
 286 ;;;   switch.  However, I suspect that some encryption problems out there are
 287 ;;;   capable of similar things so the user should be careful.
 288 ;;;
 289 ;;; * integrating crypt++ with a backgrounding package such as Olin Shivers'
 290 ;;;   `background.el' might be useful too.  thanks to Mark Borges
 291 ;;;   <mdb@noaacrd.Colorado.EDU> for suggesting this.
 292 ;;;
 293 ;;; * Performing M-x crypt-encode-buffer or M-x crypt-encrypt-buffer and then
 294 ;;;   saving the file would possibly cause errors.  It is better to toggle
 295 ;;;   `crypt-encoded-mode' (or `crypt-encrypted-mode') and simply save the
 296 ;;;   file.  It is for this reason that `crypt-encode-buffer' and
 297 ;;;   `crypt-encrypt-buffer' are not interactive.
 298 ;;;
 299 ;;; * use plists instead of alists replacing calls to `nth' with `get'
 300 ;;;
 301 ;;; * merge encryption code completely into encoding code making encryption
 302 ;;;   just a special case of encoding.
 303
 304 \f
 305 ;;; Change log:
 306 ;;;
 307 ;;; 1.1 - original version of crypt.el
 308 ;;; 1.2 -
 309 ;;;   jwz: works with tar-mode.el
 310 ;;;   jwz: applied patch from piet, merged with Lawrence Dodd's gzip version
 311 ;;; 1.3 -
 312 ;;;   lrd: fixed compress-magic-regexp
 313 ;;; 1.4, 1.5, 1.6 -
 314 ;;;   lrd: write-file compresses or gzips based on file extension
 315 ;;; 2.1 -
 316 ;;;   lrd: merged with Rod Whitby's table-driven version (major upgrade)
 317 ;;; 2.2 -
 318 ;;;   rjw: Changed file name to crypt++.el, so archie and lispdir can find it.
 319 ;;; 2.3 -
 320 ;;;   rjw: Separated the hook additions and minor mode alist additions.
 321 ;;; 2.4 -
 322 ;;;   rjw: Fixed the interactive form for crypt-buffer.
 323 ;;; 2.5 -
 324 ;;;   lrd: doc mods, changed GNU free software notice (was out of date), added
 325 ;;;   anonymous ftp information
 326 ;;; 2.6 -
 327 ;;;   lrd: added back in definition of `buffer' in defun crypt-buffer caused
 328 ;;;   an error when trying to read encrypted file; modified check for minor
 329 ;;;   mode alist addition; added gzip magic number warning
 330 ;;; 2.7 - [posted to gnu.emacs.sources]
 331 ;;;   lrd: added `TO DO' and `KNOW BUGS' section to header
 332 ;;; 2.8 -
 333 ;;;   lrd: added note about updating to v 1.24 of tar-mode.el
 334 ;;;   Thanks to Mark Borges <mdb@noaacrd.Colorado.EDU>
 335 ;;; 2.9 -
 336 ;;;   lrd: moved query about `crypt-freeze-vs-fortran' out of defvar for
 337 ;;;   `crypt-encoding-alist,' an erroneous value of nil was being stuck into
 338 ;;;   alist when user set `crypt-freeze-vs-fortran' was nil, doc mod.
 339 ;;;   Thanks to Mark Borges <mdb@noaacrd.Colorado.EDU>
 340 ;;; 2.10 -
 341 ;;;   rjw: moved query about `crypt-freeze-vs-fortran' back into defvar for
 342 ;;;   `crypt-encoding-alist,' - used append to ignore the erroneous nil.
 343 ;;; 2.11 -
 344 ;;;   rjw: fixed a bug in my fix :-(
 345 ;;; 2.12 -
 346 ;;;   rjw: Defvar crypt-magic-regexp and crypt-magic-regexp-inverse and
 347 ;;;   allow either a regexp or an elisp expression.
 348 ;;;   Suggested by Franc,ois Pinard <pinard@iro.umontreal.ca>.
 349 ;;; 2.13 -
 350 ;;;   lrd: added in info on lispdir.el, doc mods and some puttering while
 351 ;;;   looking over rjw's v 2.12 mods.
 352 ;;; 2.14 -
 353 ;;;   lrd: doc mod - trivial huh? switched `compact' and  `gzip' in
 354 ;;;   `crypt-encoding-alist' - want gzip near top
 355 ;;; 2.15 -
 356 ;;;   lrd: added in LCD Archive Entry and modified comments on tar-mode.el
 357 ;;;   since the version at the elisp-archive now works with crypt++.el
 358 ;;; 2.16 -
 359 ;;;   lrd: provide `crypt' as well as `crypt++' allowing something like `ln -s
 360 ;;;   crypt++.el crypt.el' to be meaningful
 361 ;;;   Suggested (by|as) Per Abrahamsen <amanda@iesd.auc.dk>
 362 ;;; 2.17 -
 363 ;;;   lrd: clarified bug report procedure, added fancy pseudo-graphics, added
 364 ;;;   to the `TO DO' list, put RCS tags in LCD Archive entry
 365 ;;; 2.18 - [posted to gnu.emacs.sources]
 366 ;;;   lrd: included pointer to elisp archive in crypt-version description,
 367 ;;;   changed "Decode buffer %s? " to "Decode %s? " in crypt-find-file-hook
 368 ;;;   to be more general (mainly for crypt-insert-file)
 369 ;;; 2.19 -
 370 ;;;   rjw: Added the crypt-compact-vs-C++ switch to distinguish compacted and
 371 ;;;   C++ files.
 372 ;;; 2.20 -
 373 ;;;   lrd: (1) modified interactive form of crypt-buffer. (2) made search
 374 ;;;   case-insensitive in crypt-submit-report. (3) modified encoded-mode and
 375 ;;;   crypt-mode so that buffer-modified is not unconditionally set to nil
 376 ;;;   when the mode is not changed. Thanks to Gerd Hillebrand
 377 ;;;   <ggh@cs.brown.edu> for suggesting (2) and (3).
 378 ;;; 2.21 -
 379 ;;;   rjw: Added an entry to the TODO list about the hazards of using
 380 ;;;   call-process-region on a large region and not much room in /tmp
 381 ;;;   (David Carlisle <carlisle@computer-science.manchester.ac.uk>).
 382 ;;; 2.22 -
 383 ;;;   lrd: allow write-file-hooks to contain functions as well as lists.
 384 ;;;   Contributed by Ken Laprade <laprade@trantor.harris-atd.com>.
 385 ;;; 2.23 -
 386 ;;;   lrd: made crypt-submit-report list values of more user-defined variables
 387 ;;; 2.24 -
 388 ;;;   lrd: pass the -q switch to gzip to thwart the possibility of a --verbose
 389 ;;;   in the GZIP environment variable
 390 ;;; 2.25 -
 391 ;;;   lrd: added some more to the TO DO list, clarified some things, also
 392 ;;;   untabified the entire file (I got tired of the control I's)
 393 ;;; 2.26 -
 394 ;;;   lrd: use the long-named options for GNU zip (self-documenting)
 395 ;;; 2.27 -
 396 ;;;   lrd: included observation by Francois Pinard <pinard@iro.umontreal.ca>
 397 ;;;   and worked on text in TO DO/KNOWN BUGS list
 398 ;;; 2.28 -
 399 ;;;   lrd: added two new variables in (crypt-submit-report) to the list stuck
 400 ;;;   at the bottom of the mail message; changed the comments regarding the
 401 ;;;   user-defined variables.  added in default values in user defined
 402 ;;;   variables.  added to and removed stuff to the `TO DO' list.
 403 ;;;
 404 ;;;   (encoded-mode):
 405 ;;;   added in code to remove any auto-save-files that may have been formed
 406 ;;;   before becoming an encoded buffer (for example a plain file saved to
 407 ;;;   disk encoded had orphan auto-save-files left behind).  turning off
 408 ;;;   auto-save-mode disables the creation of auto-save-files, but it also
 409 ;;;   disables the possibility of these being removed when the buffer is
 410 ;;;   saved.
 411 ;;;
 412 ;;;   (crypt-region):
 413 ;;;   now call the encryption and decryption program directly instead of
 414 ;;;   through the shell.  this is more secure since the shell will expose the
 415 ;;;   password (key).  thanks to Jon Cargille <jcargill@cs.wisc.edu>.  defined
 416 ;;;   two new variables `crypt-decryption-args' and `crypt-encryption-args' to
 417 ;;;   take the arguments separately.  removed (let ((opoint)...)) construct
 418 ;;;   this was a throw back to some old dead code and was not being used.
 419 ;;; 2.29 -
 420 ;;;   lrd: added three new variables in (crypt-submit-report); added to the
 421 ;;;   `TO DO' list.
 422 ;;;
 423 ;;;   (encode-region,encode-buffer,encoded-mode): fixed interactive forms -
 424 ;;;   the conversion to table version had eliminated some of the interactive
 425 ;;;   features of these.  thanks to Kimball Collins <kpc@ptolemy.arc.nasa.gov>
 426 ;;;   for point this out.  new interactive form uses functions
 427 ;;;   `crypt-get-encoding-type' and `crypt-symbol-alist-to-table' and variable
 428 ;;;   `crypt-default-encoding' to generate completion list of encoding types.
 429 ;;;
 430 ;;;   (crypt-write-file-hook): two new user-defined variables
 431 ;;;   `crypt-query-if-interactive' and `crypt-no-extension-implies-plain' and
 432 ;;;   the buffer-local variable `buffer-interactive-mode' are used to help
 433 ;;;   determined whether or not plain output is really desired for files
 434 ;;;   without a compression file-name extension.  the default behavior is the
 435 ;;;   same as before.
 436 ;;; 2.30 -
 437 ;;;   lrd: added test for user-defined variable `crypt-never-ever-decrypt'
 438 ;;;   when finding a file.  some users may never wish to decrypt files
 439 ;;;   and like to edit binary files.  thanks to Nelson Minar
 440 ;;;   <nelson@reed.edu>.  added to doc-strings of
 441 ;;;   `crypt-magic-regexp[-inverse]' -- these can be set to nil[t] and
 442 ;;;   accomplish the same thing as setting `crypt-never-ever-decrypt' to t
 443 ;;; 2.31 -
 444 ;;;   rjw: Updated the comments in the encryption check section.
 445 ;;; 2.32 - [posted to gnu.emacs.sources]
 446 ;;;   lrd: added warning about `crypt-(de|en)cryption-program'; doc mod.
 447 ;;; 2.33 -
 448 ;;;   lrd: if `crypt-(de|en)cryption-args' are nil then don't pass any
 449 ;;;   arguments to (de|en)cryption program, nil is the default instead of
 450 ;;;   "".  Thanks to Joe Ilacqua <spike@world.std.com>, David J. Schur
 451 ;;;   <djs@idm.com>, Peter Nuth <nuth@ai.mit.edu>, and Greg Larson
 452 ;;;   <glarson@bnr.ca>.  `-q' exists in gzip 1.0.3 but not `--quiet' changed
 453 ;;;   GZIP NOTE.  Thanks to Chris Moore <moore@src.bae.co.uk>.
 454 ;;; 2.34 -
 455 ;;;   lrd: allow `crypt-(de|en)cryption-args' to be a list of strings -- more
 456 ;;;   robust.  query for password (key), if none is set, when writing out file
 457 ;;;   for which `buffer-save-encrypted' is t.  Thanks to John Interrante
 458 ;;;   <interran@uluru.Stanford.EDU>.  (crypt-write-file-hook): check filename
 459 ;;;   extension against regexp `crypt-encryption-file-extension' and query for
 460 ;;;   encryption, unless `crypt-auto-write-buffer-encrypted' is t (don't
 461 ;;;   bother doing reverse check, encrypted to plain, not a common request).
 462 ;;;   (crypt-mode): delete auto-save files (cf., encoded-mode), may exist now.
 463 ;;;   (read-string-no-echo): applied patch from Piet van Oostrum
 464 ;;;   <piet@cs.ruu.nl> -- set `cursor-in-echo-area' _after_ setting buffer
 465 ;;;   (this was screwing up gnews).
 466 ;;; 2.35 -
 467 ;;;   lrd: doc mod
 468 ;;; 2.36 -
 469 ;;;   lrd: fixed typo, added RMAIL note.
 470 ;;; 2.37 - [posted to gnu.emacs.sources]
 471 ;;;   lrd:
 472 ;;;   (crypt-write-file-hook): search user-defined list
 473 ;;;   `crypt-ignored-filenames' for possible match with `buffer-filename'
 474 ;;;   before attempting conversion from compressed to plain format; useful for
 475 ;;;   compressed incoming mail files (e.g., RMAIL, INBOX).
 476 ;;;
 477 ;;;   (crypt-mode): query for key if not set already; need to switch order of
 478 ;;;   recovering key and toggling crypt-mode in crypt-find-file-hook (thanks
 479 ;;;   to Piet van Oostrum <piet@cs.ruu.nl>).
 480 ;;;
 481 ;;;   (crypt-buffer) and (encode-buffer): remove interactive form; use
 482 ;;;   (crypt-mode) and (encoded-mode) instead so encryption and compression
 483 ;;;   are done at the very end; leave interactive form in (crypt-region) and
 484 ;;;   (encode-region) may still be used.
 485 ;;;
 486 ;;;   (set-encryption-key): remove from `command-history' if called
 487 ;;;   interactively - thanks to George M. Georgiou
 488 ;;;   <georgiou@silicon.csci.csusb.edu>.
 489 ;;; 2.38 -
 490 ;;;   lrd: added `crypt-' prefix to `(read-string-no-echo)' and `(save-point)'
 491 ;;;   changed file extension for gzip files to `.z' _or_ `.gz' (future release
 492 ;;;   of gzip with use later extension by default and so this should be
 493 ;;;   changed to just `.gz' someday).
 494 ;;; 2.39 -
 495 ;;;   lrd: doc mod. added in patch from jwz - `(crypt-read-string-no-echo)' is
 496 ;;;   more secure, put property 'permanent-local on buffer-locals works for
 497 ;;;   Lucid Emacs and doesn't harm v18 emacs, change `buffer-interactive-mode'
 498 ;;;   to `buffer-interactive-encoded-mode.'
 499 ;;; 2.40 -
 500 ;;;   lrd: put property 'preserved in case kill-fix.el is being used.
 501 ;;; 2.41 -
 502 ;;;   lrd: all functions and variables now start with `crypt-', moved REVISION
 503 ;;;   HISTORY to bottom of header, interactive version of
 504 ;;;   `(crypt-encrypt-region)' clearer, `(crypt-read-string-no-echo)' now
 505 ;;;   echos `.'
 506 ;;; 2.42 -
 507 ;;;   lrd: (crypt-check-extension-for-encoding): broke out of
 508 ;;;   `(crypt-write-file-hook)'.  setting user variables
 509 ;;;   `crypt-compact-vs-C++' and `crypt-freeze-vs-fortran' to nil no longer
 510 ;;;   completely disables the reading compact'ed and frozen files but just
 511 ;;;   disables the use of the file-extension tricks of
 512 ;;;   `(crypt-check-extension-for-encoding).'  (crypt-encode-region): allow
 513 ;;;   for a single line message from encoding program at top of region; if it
 514 ;;;   is there, then remove it; kludge for `compact' program.
 515 ;;; 2.43 -
 516 ;;;   lrd: (crypt-encode-region): generalize the clean up procedure; add
 517 ;;;   element to `crypt-encoding-alist' and introduce new function
 518 ;;;   `(crypt-encoding-cleanup-regexp)' to extract a compression specific
 519 ;;;   regexp for erroneous message or lisp expression for cleanup.
 520 ;;; 2.44 -
 521 ;;;   lrd: new element for `crypt-encoding-alist' handles whether or not
 522 ;;;   file-name extension tricks may be play with encoding method; compact and
 523 ;;;   freeze values default to `crypt-compact-vs-C++' and
 524 ;;;   `crypt-freeze-vs-fortran' (thanks to rjw);
 525 ;;;   (crypt-encoding-extension-tricks): new defun to handle this;
 526 ;;;   (crypt-check-extension-for-encoding): monitors "tricks" entry of
 527 ;;;   `crypt-encoding-alist' and adjust the bag of tricks it can apply.
 528 ;;; 2.45 -
 529 ;;;   lrd: (crypt-encode-region): delete entire match of cleanup regexp by
 530 ;;;   requiring newlines in GARBAGE-REGEXP-OR-LISPEXP.  (crypt-submit-report):
 531 ;;;   use Warsaw's reporter.el.
 532 ;;; 2.46 -
 533 ;;;   lrd: (crypt-find-file-hook, crypt-write-file-hook): cleaned, documented,
 534 ;;;   and replaced occurrences of `(cond (C BODY))' with `(if C BODY)';
 535 ;;;   changed `crypt-magic-regexp' to `crypt-encryption-magic-regexp' and
 536 ;;;   `crypt-magic-regexp-inverse' to `crypt-encryption-magic-regexp-inverse'
 537 ;;;   for consistency with other variable names. new user-defined variable
 538 ;;;   `crypt-encryption-minor-mode-name' instead of always "Crypt".  grouped
 539 ;;;   all encryption variables together.
 540 ;;; 2.47 -
 541 ;;;   lrd: somewhat major change - put program-specific encryption variables
 542 ;;;   into a single table `crypt-encryption-alist' and let the variable
 543 ;;;   `crypt-encryption-type' define the appropriate entry to use; new
 544 ;;;   user-defined variable `crypt-confirm-password,' thanks to Jeff Clark
 545 ;;;   <jclark@src.honeywell.com>. (crypt-submit-report): improved error
 546 ;;;   handling, thanks to baw. (crypt-write-file-hook): fixed bug with
 547 ;;;   `crypt-encoding-extension-tricks'
 548 ;;; 2.48 -
 549 ;;;   lrd: added dummy argument to `crypt-encoding-alist' and
 550 ;;;   `crypt-encryption-alist' and merged all defuns that work on their
 551 ;;;   elements into defuns that all start with `crypt-get-' and look through
 552 ;;;   both lists.  simplifies some of code and closer to treating encryption
 553 ;;;   as a special case of encoding; crypt-minor-mode-alist: replaced (nth *)
 554 ;;;   with `(crypt-get-minor-mode)' call; (crypt-encode-region): allow
 555 ;;;   arguments to be list of strings; renamed (crypt-get-encoding-type) to
 556 ;;;   (crypt-read-encoding-type) for clarity.
 557 ;;; 2.49 - [posted to gnu.emacs.sources]
 558 ;;;   lrd: (crypt-encode-region): ignore `args' if set to t
 559 ;;; 2.50 -
 560 ;;;   lrd: (crypt-write-file-hook): in v19 we need to call `backup-buffer'
 561 ;;;   ourselves -- we write out the file and return t so `basic-save-buffer'
 562 ;;;   does not do it; also call `set-file-modes'
 563 ;;; 2.51 -
 564 ;;;   lrd: some `defvar's are now `defconst's and tar-mode note was changed.
 565 ;;; 2.52 -
 566 ;;;   lrd: make doc strings conform to GNU standards.
 567 ;;; 2.53 -
 568 ;;;   lrd: made header conform to GNU Conventional Headers standard.
 569 ;;; 2.54 -
 570 ;;;   lrd: `crypt-encryption-file-extension', `crypt-freeze-vs-fortran',
 571 ;;;   `crypt-compact-vs-C++', `crypt-encryption-magic-regexp', and
 572 ;;;   `crypt-encryption-magic-regexp-inverse' are used in defining the tables
 573 ;;;   `crypt-encoding-alist' and `crypt-encryption-alist' and so need to be set
 574 ;;;   _before_ loading crypt++.  use `add-hook' if it is available.
 575 ;;; 2.55 -
 576 ;;;   lrd: new interactive function `crypt-insert-file' mimics `insert-file'
 577 ;;;   but attempts to decode or decrypt before insertion; bound `C-x i' if
 578 ;;;   `crypt-bind-insert-file' is non-nil.  comment out doc-strings from
 579 ;;;   internal subroutines, saves space.
 580 ;;; 2.56 -
 581 ;;;   tfb: change the definitions of crypt-{encoding,encryption}-alist, to
 582 ;;;   call the functions crypt-make-{encoding,encryption}-alist resp.
 583 ;;;   Added crypt-reinit which regenerates these variables from their
 584 ;;;   functions, thus allowing this stuff to be preloaded even if people
 585 ;;;   set things in their init files.
 586 ;;;   Tim Bradshaw <tim.bradshaw@mid-heidelberg.de>
 587 ;;; 2.57 -
 588 ;;;   lrd: untabify; remove duplicate entry in `crypt-make-encoding-alist';
 589 ;;;   change name of `crypt-make-*-alist' to `crypt-build-*-alist' and
 590 ;;;   `crypt-reinit' to `crypt-rebuild-tables'; (crypt-read-string-no-echo):
 591 ;;;   change local variable `form' to `help-form' so it is defined;
 592 ;;;   `crypt-encryption-alist' and `crypt-encoding-alist' must be defined with
 593 ;;;   `defconst' since we wish crypt++ to initialize these variables
 594 ;;;   unconditionally; modify INSTALLATION section to reflect these changes.
 595 ;;; 2.58 -
 596 ;;;   lrd: doc mod.
 597 ;;; 2.59 - [posted to gnu.emacs.sources]
 598 ;;;   lrd: (crypt-bind-insert-file): new function for changing "C-x i" in
 599 ;;;   initialization file or interactively.
 600 ;;; 2.60 -
 601 ;;;   lrd: add `crypt-rebuild-tables' and `crypt-bind-insert-file' to
 602 ;;;   `after-init-hook' in GNU emacs v19 and to `term-setup-hook' in Lucid
 603 ;;;   emacs.  Change INSTALLATION notes.
 604 ;;; 2.61 - [posted to gnu.emacs.sources]
 605 ;;;   lrd: Doc mod.  Clean up the installation of minor mode indicators.
 606 ;;; 2.62 - [posted to gnu.emacs.sources]
 607 ;;;   lrd: installed patch from stig@hackvan.com to simplify crypt-get-* defuns
 608 ;;;   (now defmacros).  Don't add to `term-setup-hook' unless no
 609 ;;;   `after-init-hook' _and_ definitely running v19, otherwise Rod gets an
 610 ;;;   error at home :-<.  Don't assume C-x i had `insert-file' bound to it:
 611 ;;;   store old binding in `crypt-old-binding' before overwriting and use in
 612 ;;;   function `crypt-bind-insert-file.'
 613 ;;; 2.63 -
 614 ;;;   lrd: (crypt-encode-buffer, crypt-encode-region, crypt-encrypt-buffer,
 615 ;;;   crypt-encrypt-region): changed argument list putting optional buffer
 616 ;;;   last and making default action to encode or encrypt. (crypt-encoded-p,
 617 ;;;   crypt-encrypted-p): new functions that do the actual testing of file
 618 ;;;   contents.  (crypt-find-file): uses these new functions.
 619 ;;;   (crypt-rebuild-minor-modes-alist): new function to rebuild
 620 ;;;   `minor-mode-alist' called by function crypt-rebuild-tables.
 621 ;;;   (crypt-build-minor-mode-alist): new function called by
 622 ;;;   `crypt-minor-mode-alist' to create itself.  `crypt-minor-mode-encrypted'
 623 ;;;   removed because defined in function crypt-build-minor-mode-alist.
 624 ;;; 2.64 -
 625 ;;;   lrd: (crypt-find-file-hook): temporarily remove the encrytion file
 626 ;;;   extension to help determine the major mode, just like is done with the
 627 ;;;   encoding file extension.  In order for this to work properly the file
 628 ;;;   extension in `crypt-encryption-file-extension' and
 629 ;;;   `crypt-encryption-alist' needs to be inside a pair of \\( \\).
 630 ;;; 2.65 -
 631 ;;;   lrd: (crypt-find-file-hook): move determination of key, password, into
 632 ;;;   (crypt-encrypted-p).
 633 ;;; 2.66 -
 634 ;;;   lrd: (crypt-set-encryption-key): improve prompt string for encryption
 635 ;;;   key.
 636 ;;; 2.67 -
 637 ;;;   lrd: (crypt-write-file-hook): make check for encryption file-name
 638 ;;;   extension case-sensitive.
 639 ;;; 2.68 -
 640 ;;;   lrd: fixed check for previous addition to `minor-mode-alist' -- was not
 641 ;;;   working. Check for an `add-hook' function; if one does not exist then
 642 ;;;   use a copy of one from GNU Emacs 19.  When using `add-hook' to append to
 643 ;;;   the `write-file-hooks' make sure that the version accepts the optional
 644 ;;;   APPEND argument -- v19's does but the one in the elisp archive by Dan
 645 ;;;   LaLiberte <liberte@cs.uiuc.edu> does not append.  This causes problems.
 646 ;;;   Thanks to Francesco Potorti` <pot@fly.CNUCE.CNR.IT> for pointing this
 647 ;;;   out.
 648 ;;; 2.69 - [posted to gnu.emacs.sources]
 649 ;;;   lrd: doc mod with regards `after-init-hook' and Lucid Emacs.  Add
 650 ;;;   pointer to crypt++-fnf.el for people who might be interested.
 651 ;;; 2.70 -
 652 ;;;   lrd: narrow conditions under which crypt-encryption-magic-regexp
 653 ;;;   matches.  Thanks to Philippe Michel <michel@thomson-lcr.fr> and Francois
 654 ;;;   Pinard <pinard@iro.umontreal.ca> for helping explain this with regards
 655 ;;;   to ISO/Latin-1.
 656 ;;; 2.71 -
 657 ;;;   lrd: applied patches from Darrin Jewell <jewell@bdi.com> for DOS to UNIX
 658 ;;;   support.  DOS entry added to crypt-build-encoding-alist.
 659 ;;;   (crypt-dos-to-unix-region, crypt-unix-to-dos-region): New
 660 ;;;   functions. (crypt-dos-has-ctrl-z): New buffer-local variable.
 661 ;;;   (crypt-encode-region): allow for encoding and decoding programs to be
 662 ;;;   elisp expressions.  If they are then apply them directly to region.
 663 ;;;   Point out that crypt++.el conflicts with dos-mode.el.
 664 ;;; 2.72 -
 665 ;;;   lrd: The limit for the regular expression search done by
 666 ;;;   `crypt-encrypted-p' is extended to 100 by default.  The enlargement of
 667 ;;;   search field is needed because of previous reduction in size of regexp
 668 ;;;   being searched for.  (crypt-magic-search-limit): New variable defining
 669 ;;;   this new limit.  (crypt-encrypted-p): Uses it and cleaned up.  Doc mod.
 670 ;;;   Thanks to Philippe Michel <michel@thomson-lcr.fr>, Francois Pinard
 671 ;;;   <pinard@iro.umontreal.ca>, and Dave Goldberg <dsg@blackbird.mitre.org>.
 672 ;;; 2.73 - [posted to gnu.emacs.sources]
 673 ;;;   lrd: Apply patch from Kevin Rodgers <kevin@traffic.den.mmc.com> that
 674 ;;;   uses more verbose messages and capitals.  Doc mod.
 675 ;;; 2.74 -
 676 ;;;   lrd: Untabify.  (crypt-encrypted-p): Check value of
 677 ;;;   `crypt-never-ever-decrypt' before anything else.
 678 ;;; 2.75 -
 679 ;;;   lrd: (crypt-version): Remove call to `substring'.
 680 ;;; 2.76 -
 681 ;;;   lrd: (crypt-encryption-magic-regexp-inverse): Add in regexp that will
 682 ;;;   match ksh `.sh_history' files so that they are not interpreted as
 683 ;;;   encrypted files.  Thanks to Francesco Potorti` <pot@fly.CNUCE.CNR.IT>.
 684 ;;; 2.77 - [posted to gnu.emacs.sources]
 685 ;;;   lrd: (crypt-bind-insert-file): Use substitute-key-definition to bind
 686 ;;;   crypt-insert-file to whatever key insert-file is bound to (not
 687 ;;;   necessarily C-x i).  Call crypt-bind-insert-file directly in
 688 ;;;   file. Variable crypt-bind-insert-file: Doc mod.  Remove
 689 ;;;   crypt-old-binding.  Replace `M-x foobar' in doc strings with
 690 ;;;   `\\[foobar]'.
 691 ;;; 2.78 -
 692 ;;;   lrd: (crypt-auto-write-answer-local): New internal variable.  Holds
 693 ;;;   answer to query about file-extension tricks question per buffer.  Thanks
 694 ;;;   to George Forman <forman@cs.washington.edu>.  Remove Rod from list of
 695 ;;;   maintainers...he's busy enough.  Merge multiple setq forms into single
 696 ;;;   setq forms.
 697 ;;; 2.79 -
 698 ;;;   lrd: (crypt-y-or-n-p): New internal function for querying.  Tests the
 699 ;;;   internal variable crypt-auto-write-answer-local to ensure single query.
 700 ;;;   (crypt-check-extension-for-encoding): Replace all occurrences of queries
 701 ;;;   involving y-or-no-p constructs with crypt-y-or-n-p.
 702 ;;; 2.80 - [posted to gnu.emacs.sources]
 703 ;;;   lrd: (crypt-set-encryption-key): Shorten interactive prompt.  Change
 704 ;;;   documentation.
 705 ;;; 2.81 -
 706 ;;;   lrd: (crypt-variable-list): Add shell and path variables.
 707 ;;;   (crypt-confirm-password): Fix spelling error in doc.
 708 ;;; 2.82 -
 709 ;;;   lrd: Applied patch from Noah Friedman <friedman@prep.ai.mit.edu>.
 710 ;;;   (crypt-encoded-disable-auto-save, crypt-encrypted-disable-auto-save):
 711 ;;;   New user-defined variables. (crypt-encoded-mode, crypt-encrypted-mode):
 712 ;;;   Use them.
 713 ;;; 2.84 -
 714 ;;;   hniksic: Added custom.
 715 ;;; 2.94 -
 716 ;;;   Aidan Kehoe: imported Karl Berry's Crypt++. See ChangeLog for details
 717 ;;;   of the changes made there.
 718
 719 \f
 720 ;;; Code:
 721
 722 ;;;; User definable variables.
 723 (defvar shell-command-switch "-c") ; in case it isn't defined yet.
 724
 725 (progn
 726   (defgroup crypt nil
 727     "Handling compressed and encrypted files."
 728     :group 'compression)
 729   )
 730
 731 (defcustom crypt-encryption-type 'crypt
 732   "*Method of encryption.  Must be an element of `crypt-encryption-alist.'
 733 If you change this after crypt++ is loaded then do \\[crypt-rebuild-tables]."
 734   :type 'symbol
 735   :group 'crypt)
 736
 737 (defcustom crypt-encryption-file-extension nil
 738   "*Regexp for extension of files encrypted with `crypt-encryption-type.'
 739 Should be of the form \"\\\\(\\\\.foo\\\\)$\".  nil says use default values in
 740 `crypt-encryption-alist.'  If you change this after crypt++ is loaded then do
 741 \\[crypt-rebuild-tables]."
 742   :type 'regexp
 743   :group 'crypt)
 744
 745 (defcustom crypt-never-ever-decrypt nil
 746   "*t says never attempt to decrypt a buffer."
 747   :type 'boolean
 748   :group 'crypt)
 749
 750 (defcustom crypt-auto-write-buffer-encrypted nil
 751   "*t says files with `crypt-encryption-alist' file extension auto-encrypted.
 752 nil says query.  See `crypt-auto-write-buffer.'"
 753   :type 'boolean
 754   :group 'crypt)
 755
 756 (defcustom crypt-confirm-password nil
 757   "*t says confirm new passwords when writing a newly encrypted buffer."
 758   :type 'boolean
 759   :group 'crypt)
 760
 761 (defcustom crypt-encoded-disable-auto-save t
 762   "*If t, turn off auto-save-mode for buffers which are encoded.
 763 If non-nil but not t, then no message is displayed.
 764
 765 The default is t is because there isn't any way to tell emacs to encode the
 766 autosave file, so the autosave would be in a different format from the
 767 original.  The disadvantage of turning off autosaves is that any work you
 768 do in that buffer will be completely lost if the changes are not explicitly
 769 saved.
 770
 771 It is probably best to set this variable to nil and use buffer-local
 772 variables in files for which you don't actually care about autosaves.
 773 Unencoded recovery data is better than none at all."
 774   :type '(choice (const :tag "on" t)
 775                  (const :tag "off" nil)
 776                  (const :tag "no message" other))
 777   :group 'crypt)
 778
 779 (defcustom crypt-encrypted-disable-auto-save t
 780   "*If t, turn off auto-save-mode for buffers which are encrypted.
 781 If non-nil but not t, then no message is displayed.
 782
 783 The default is t is because there isn't any way to tell emacs to encrypt
 784 the autosave file, so the autosave would be in cleartext form.  The
 785 disadvantage of turning off autosaves is that any work you do in that
 786 buffer will be completely lost if the changes are not explicitly saved.
 787
 788 You might consider setting this variable to nil and use buffer-local
 789 variables in files for which security is more important than data
 790 recovery."
 791   :type '(choice (const :tag "on" t)
 792                  (const :tag "off" nil)
 793                  (const :tag "no message" other))
 794   :group 'crypt)
 795
 796 ;;; ENCRYPTION
 797
 798 ;;; Encrypted files have no magic number, so we have to hack a way of
 799 ;;; determining when a buffer should be decrypted.  we do this only buffers
 800 ;;; that match a MAGIC-REGEXP very close to beginning of buffer and that do
 801 ;;; _NOT_ match a MAGIC-REGEXP-INVERSE.
 802 ;;;
 803 ;;; Currently MAGIC-REGEXP matches non-ASCII characters and
 804 ;;; MAGIC-REGEXP-INVERSE will match Sun OS, 4.x BSD, and Ultrix executable
 805 ;;; magic numbers, so binaries can still be edited (heh) without headaches.
 806
 807 (defconst crypt-encryption-magic-regexp "[\000\200-\237]\\|^-----BEGIN PGP MESSAGE\\|^Salted__"
 808   "Regexp that must be found very close to beginning of encrypted buffer.
 809 This is intended to be an internal variable \(not user-visible\).  If you
 810 change this after crypt++ is loaded then do \\[crypt-rebuild-tables].")
 811
 812 (defconst crypt-encryption-magic-regexp-inverse
 813   "\\`\201\001\\|^\\(..\\)?\\([\007\010\013]\001\\|\001[\007\010\013]\\)\\|^From \\|^;ELC"
 814   "Regexp that must *not* be found very close to beginning of encrypted buffer.
 815 This is intended to be an internal variable \(not user-visible\).  If you
 816 change this after crypt++ is loaded then do \\[crypt-rebuild-tables].")
 817
 818 (defconst crypt-magic-search-limit 100
 819   "Limit of regular expression search used to recognize encrypted files.
 820 Maximum position in file for presence of `crypt-encryption-magic-regexp' and
 821 absence of `crypt-encryption-magic-regexp-inverse'.")
 822
 823 (defun crypt-build-encryption-alist ()
 824   ;; Returns the encryption alist
 825   (list
 826    ;; crypt
 827    (list 'crypt
 828          crypt-encryption-magic-regexp crypt-encryption-magic-regexp-inverse
 829          (or crypt-encryption-file-extension "\\(\\.e\\)$")
 830          "crypt" "crypt"
 831          nil
 832          nil
 833          "Crypt"
 834          nil
 835          t
 836          nil
 837          )
 838    ;; DES (Cipher Block Chaining - CBC) [DES' default]
 839    (list 'des
 840          crypt-encryption-magic-regexp crypt-encryption-magic-regexp-inverse
 841          (or crypt-encryption-file-extension "\\(\\.des\\)$")
 842          "des" "des"
 843          '("-e" "-k")
 844          '("-d" "-k")
 845          "DES-CBC"
 846          nil
 847          t
 848          nil
 849          )
 850    ;; DES (Electronic Code Book - ECB)
 851    (list 'des-ecb
 852          crypt-encryption-magic-regexp crypt-encryption-magic-regexp-inverse
 853          (or crypt-encryption-file-extension "\\(\\.des\\)$")
 854          "des" "des"
 855          '("-e" "-b" "-k")
 856          '("-d" "-b" "-k")
 857          "DES-ECB"
 858          nil
 859          t
 860          nil
 861          )
 862    ;; PGP
 863    (list 'pgp
 864          crypt-encryption-magic-regexp crypt-encryption-magic-regexp-inverse
 865          (or crypt-encryption-file-extension "\\(\\.pgp\\)$")
 866          "pgp" "pgp"
 867          '("+batchmode" "+verbose=0" "-c" "-f" "-z")
 868          '("+batchmode" "+verbose=0" "-f" "-z")
 869          "PGP"
 870          nil
 871          t
 872          nil
 873          )
 874    ;; PGP with public-key encryption
 875    (list 'pgp-pub
 876          crypt-encryption-magic-regexp crypt-encryption-magic-regexp-inverse
 877          (or crypt-encryption-file-extension "\\(\\.pgp\\)$")
 878          "pgp" "pgp"
 879          nil
 880          nil
 881          "PGP-PUB"
 882          nil
 883          t
 884          nil
 885          )
 886    ;; GPG
 887    (list 'gpg
 888          crypt-encryption-magic-regexp crypt-encryption-magic-regexp-inverse
 889          (or crypt-encryption-file-extension "\\(\\.gpg\\)$")
 890          "gpg" "gpg"
 891          '("--batch" "--quiet" "-c" "-o" "-" "--passphrase-fd" "0")
 892          '("--batch" "--quiet" "-o" "-" "--passphrase-fd" "0")
 893          "GPG"
 894          nil
 895          t
 896          t
 897          )
 898   (list 'mcrypt
 899         crypt-encryption-magic-regexp crypt-encryption-magic-regexp-inverse
 900         (or crypt-encryption-file-extension "\\(\\.nc\\)$")
 901         "mcrypt" "mcrypt"
 902         '("-k")
 903         '("-d" "-k")
 904         "Rijndael-128"
 905         nil
 906         t
 907         nil
 908         )
 909   (list 'rc4
 910         crypt-encryption-magic-regexp crypt-encryption-magic-regexp-inverse
 911         (or crypt-encryption-file-extension "\\(\\.rc4\\)$")
 912         "openssl" "openssl"
 913         '("enc" "-rc4" "-e" "-k")
 914         '("enc" "-rc4" "-d" "-k")
 915         "RC4"
 916         nil
 917         t
 918         nil
 919         )
 920   (list 'bfe
 921         ;; See http://sourceforge.net/projects/bcrypt
 922         crypt-encryption-magic-regexp crypt-encryption-magic-regexp-inverse
 923         (or crypt-encryption-file-extension "\\(\\.bfe\\)$")
 924         "bcrypt" "bcrypt"
 925         '("")
 926         '("")
 927         "BFE"
 928         nil
 929         t
 930         nil
 931         )
 932  ;; Add new elements here ...
 933   ))
 934
 935 (defconst crypt-encryption-alist (crypt-build-encryption-alist)
 936   "List of elements describing the encryption methods available.
 937 each element looks like
 938
 939         \(ENCRYPTION-TYPE
 940           MAGIC-REGEXP MAGIC-REGEXP-INVERSE
 941           FILE-EXTENSION
 942           ENCRYPT-PROGRAM DECRYPT-PROGRAM
 943           ENCRYPT-ARGS
 944           DECRYPT-ARGS
 945           MINOR-MODE
 946           GARBAGE-REGEXP-OR-LISPEXP
 947           FILE-EXTENSION-TRICKS
 948           ENCRYPTION-KEY-STDIN
 949          \)
 950
 951 ENCRYPTION-TYPE is a symbol denoting the encryption type.
 952
 953 MAGIC-REGEXP regexp that must match very close to the beginning of an
 954 encrypted buffer.  This may also be some elisp expression to be evaluated at
 955 \(point-min\) that will return t for an encrypted buffer.  If this is set to
 956 nil then crypt++ will never try to decrypt a buffer.  Currently set to the
 957 internal variable `crypt-encryption-magic-regexp' which will match non-ASCII
 958 characters.
 959
 960 MAGIC-REGEXP-INVERSE regexp that must _NOT_ match very close to the beginning
 961 of an encrypted buffer.  This may also be some elisp expression to be
 962 evaluated at \(point-min\) that will return t for a NON-encrypted buffer.
 963 If this is set to t then crypt++ will never try to decrypt a buffer.
 964 Currently set to the internal variable `crypt-encryption-magic-regexp-inverse'
 965 which will match Sun OS, 4.x BSD, and Ultrix executable magic numbers, so
 966 binaries can still be edited (heh) without headaches.
 967
 968 FILE-EXTENSION regexp denoting the file extension usually appended the
 969 filename of files encrypted with ENCRYPT-PROGRAM.  The variable
 970 `crypt-encryption-file-extension' will over ride the default.
 971
 972 ENCRYPT-PROGRAM name of executable file to be used for encryption.
 973
 974 DECRYPT-PROGRAM name of executable file to be used for decryption.
 975
 976 ENCRYPT-ARGS arguments to be passed to ENCRYPT-PROGRAM may be a string or a
 977 list of strings or nil.
 978
 979 DECRYPT-ARGS arguments to be passed to DECRYPT-PROGRAM may be a string or a
 980 list of strings or nil.
 981
 982 MINOR-MODE string denoting the name for the encrypted minor mode as it will
 983 appear in the mode line.
 984
 985 GARBAGE-REGEXP-OR-LISPEXP dummy variable for compatibility with encoding.
 986
 987 FILE-EXTENSION-TRICKS is t or nil depending on whether or not tricks
 988 converting between different encryption types can be done based on
 989 FILE-EXTENSION; typically t.
 990
 991 ENCRYPTION-KEY-STDIN is t if the encryption key should be passed to the
 992 encryption program on stdin, or nil if it should be appended to the end
 993 of the command line.  It is more secure to pass it on stdin.
 994 ")
 995
 996 \f
 997 ;;; ENCODING
 998
 999 (defcustom crypt-auto-decode-buffer t
1000   "*t says buffers visiting encoded files will be decoded automatically.
1001 nil means to ask before doing the decoding."
1002   :type 'boolean
1003   :group 'crypt)
1004
1005 (defcustom crypt-auto-write-buffer nil
1006   "*t says save files with `crypt-encoding-alist' file extensions as encoded.
1007 nil says to ask before doing this encoding.  Similarly, buffers originating
1008 from encoded files to be written to files not ending in `crypt-encoding-alist'
1009 file extensions will be written in plain format automatically.  nil says to
1010 ask before doing this decoding."
1011   :type 'boolean
1012   :group 'crypt)
1013
1014 ;; This is an internal variable documented here and not in a DOCSTRING in
1015 ;; order to save memory.  If this variable's value has been changed from its
1016 ;; default, then it contains the answer to the question "Write out buffer
1017 ;; foobar using `compression-type'?".  This question is asked only if *plain*
1018 ;; buffer foobar is being written to disk *and* it has a provocative
1019 ;; `compression-type' file-name extension (see DOCSTRING for variable
1020 ;; crypt-auto-write-buffer).  The variable is local to all buffers with a
1021 ;; default value of 'ask so if the situation described above arises, then the
1022 ;; question is asked at least once, unless the user-defined variable
1023 ;; crypt-auto-write-buffer is non-nil.
1024 (defvar crypt-auto-write-answer-local 'ask)
1025 (make-variable-buffer-local 'crypt-auto-write-answer-local)
1026 (setq-default crypt-auto-write-answer-local 'ask)
1027 (put 'crypt-auto-write-answer-local 'permanent-local t) ; for v19 Emacs
1028 (put 'crypt-auto-write-answer-local 'preserved t)       ; for kill-fix.el
1029
1030 (defcustom crypt-query-if-interactive t
1031   "*t says ask when saving buffers where `crypt-encoded-mode' was toggled.
1032 nil says that even if filename extension is plain (i.e., not listed in
1033 `crypt-encoding-alist') buffer will be written in an encoded format without
1034 asking.
1035
1036 This variable is designed for users that edit a plain file (with plain
1037 extension) and then toggle `(crypt-encoded-mode)' and do not wish to be
1038 queried every time that they save the buffer.
1039
1040 NOTE: if `(crypt-encoded-mode)' was not called interactively (the usual
1041 scenario) then the value of this variable has no effect on how the buffer is
1042 written to disk.  In such a case `crypt-no-extension-implies-plain' is then
1043 the relevant variable."
1044   :type 'boolean
1045   :group 'crypt)
1046
1047 (defcustom crypt-no-extension-implies-plain t
1048   "*t says file extensions not in `crypt-encoding-alist' may be written plain.
1049 if `crypt-auto-write-buffer' is also t then any file ending in a plain
1050 extension is written in plain format automatically, otherwise query user.
1051
1052 nil says user works with encoded (compressed) files without file extensions
1053 and will not be queried each time they save these files.
1054
1055 NOTE: (1) this does not affect find-file (C-x C-f) since that works with a
1056 magic regexp.  (2) there is no way to distinguish between write-file and
1057 save-buffer so nil will mean that neither will query."
1058   :type 'boolean
1059   :group 'crypt)
1060
1061 (defcustom crypt-freeze-vs-fortran t
1062   "*t says `.F' file extension denotes a frozen file not a Fortran file.
1063 If you change this variable after crypt++ has been loaded then do
1064 \\[crypt-rebuild-tables]."
1065   :type 'boolean
1066   :group 'crypt)
1067
1068 (defcustom crypt-compact-vs-C++ nil
1069   "*t says `.C' file extension denotes a compacted file not a C++ file.
1070 If you change this variable after crypt++ has been loaded then do
1071 \\[crypt-rebuild-tables]."
1072   :type 'boolean
1073   :group 'crypt)
1074
1075 (defcustom crypt-ignored-filenames nil
1076   "*List of regexp filenames for which encoded to plain conversion is not done.
1077 A filename with a plain extension, in encoded format, that is matched by one of
1078 these elements will be saved in encoded format without a query for conversion to
1079 plain format.
1080
1081 This variable is provided for users that want to compress their incoming mail
1082 for RMAIL and VM which look for files `RMAIL' and `INBOX,' respectively, to
1083 store incoming mail.  For example, the gzip extensions on `RMAIL.gz' and
1084 `INBOX.gz' can be removed, this variable set to '\(\"INBOX$\" \"RMAIL$\"\) and
1085 no query about conversion to plain format will be made."
1086   :type '(repeat regexp)
1087   :group 'crypt)
1088
1089 (defcustom crypt-default-encoding "gzip"
1090   "*Default encoding type as string used when `crypt-encoded-mode' is toggled.
1091 Must match one of the elements of `crypt-encoding-alist'."
1092   :type 'string
1093   :group 'crypt)
1094
1095 (defcustom crypt-dos-has-ctrl-z nil
1096   "t if this buffer had a ctrl-z stripped from end, otherwise, nil.
1097 Buffer local and set by `crypt-dos-to-unix-region'"
1098   :type 'boolean
1099   :group 'crypt)
1100 (make-variable-buffer-local 'crypt-dos-has-ctrl-z)
1101 (setq-default crypt-dos-has-ctrl-z nil)
1102 (put 'crypt-dos-has-ctrl-z 'permanent-local t) ; for v19 Emacs
1103 (put 'crypt-dos-has-ctrl-z 'preserved t)       ; for kill-fix.el
1104
1105 (defvar crypt-decode-dos-p t "Says whether to decode DOS (\r\n) files.")
1106 (defvar crypt-decode-mac-p t "Says whether to decode Mac (\r) files.")
1107
1108 (defun crypt-build-encoding-alist ()
1109   ;; Returns the encoding alist
1110   (list
1111    ;; compress
1112    (list 'compress
1113          "\037\235" nil
1114          "\\(\\.Z\\)$"
1115          "compress" "uncompress"
1116          nil nil
1117          "Compress"
1118          nil
1119          t
1120          nil)
1121    ;; gzip (GNU zip, http://www.gzip.org)
1122    (list 'gzip
1123          "\037\213" nil
1124          "\\(\\.g?z\\)$"
1125          "gzip" "gzip"
1126          "--quiet" "--decompress --quiet"
1127          "Gzip"
1128          nil
1129          t
1130          nil)
1131    ;; bzip
1132    (list 'bzip
1133          "BZ0" nil
1134          "\\(\\.bz\\)$"
1135          "bzip" "bzip"
1136          "" "--decompress"
1137          "Bzip"
1138          nil
1139          t
1140          nil)
1141    ;; bzip2 (block-sorting, http://www.digistar.com/bzip2/)
1142    (list 'bzip2
1143          "BZh" nil
1144          "\\(\\.bz2\\)$"
1145          "bzip2" "bzip2"
1146          "" "--decompress"
1147          "Bzip2"
1148          nil
1149          t
1150          nil)
1151    ;; freeze
1152    (list 'freeze
1153          "\037\236\\|\037\237" nil
1154          "\\(\\.F\\)$"
1155          "freeze" "freeze"
1156          "" "-d"
1157          "Freeze"
1158          nil
1159          crypt-freeze-vs-fortran
1160          nil)
1161    ;; compact
1162    (list 'compact
1163          "\377\037" nil
1164          "\\(\\.C\\)$"
1165          "compact" "uncompact"
1166          nil nil
1167          "Compact"
1168          "^Compression *:.*\n"
1169          crypt-compact-vs-C++
1170          nil)
1171    ;; DOS (crlf)
1172    (and crypt-decode-dos-p (list 'dos
1173          "[^\n\r]*\r\n" nil
1174          "\\(\\.DOS\\)$"
1175          'crypt-unix-to-dos-region 'crypt-dos-to-unix-region
1176          nil nil
1177          "Dos"
1178          nil
1179          nil
1180          nil
1181          nil))
1182     ;; Mac (cr)
1183     (and crypt-decode-mac-p (list 'mac
1184           "[ -~]*\r[ -~]" nil
1185           "\\(\\.MAC\\)$"
1186           'crypt-unix-to-mac-region 'crypt-mac-to-unix-region
1187           nil nil
1188           "Mac"
1189           nil
1190           nil
1191           nil))))
1192
1193 (defconst crypt-encoding-alist (crypt-build-encoding-alist)
1194   "List of elements describing the encoding methods available.
1195 each element looks like
1196
1197         \(ENCODING-TYPE
1198           MAGIC-REGEXP MAGIC-REGEXP-INVERSE
1199           FILE-EXTENSION
1200           ENCODE-PROGRAM DECODE-PROGRAM
1201           ENCODE-ARGS DECODE-ARGS
1202           MINOR-MODE
1203           GARBAGE-REGEXP-OR-LISPEXP
1204           FILE-EXTENSION-TRICKS
1205          \)
1206
1207 ENCODING-TYPE is a symbol denoting the encoding type.  Currently known
1208 encodings are (compress compact freeze gzip).
1209
1210 MAGIC-REGEXP is a regexp that matches the magic number at the
1211 beginning of files encoded with ENCODING-TYPE.
1212
1213 MAGIC-REGEXP-INVERSE dummy variable for compatibility with encryption.
1214
1215 FILE-EXTENSION is a string denoting the file extension usually
1216 appended the filename of files encoded with ENCODING-TYPE.
1217
1218 ENCODE-PROGRAM is a string denoting the name of the executable used to
1219 encode files.
1220
1221 DECODE-PROGRAM is a string denoting the name of the executable used to
1222 decode files.
1223
1224 ENCODE-ARGS arguments to be passed to ENCODE-PROGRAM may be a string or a
1225 list of strings or nil.
1226
1227 DECODE-ARGS arguments to be passed to DECODE-PROGRAM may be a string or a
1228 list of strings or nil.
1229
1230 MINOR-MODE is a string denoting the name for the encoded minor mode as
1231 it will appear in the mode line.
1232
1233 GARBAGE-REGEXP-OR-LISPEXP is (1) a regexp that matches any extraneous text
1234 that is produced by the ENCODE-COMMAND including any newlines and will be
1235 removed from the buffer before saving to disk; (2) a lisp expression that will
1236 clean up extraneous material in the buffer or nil.  This is normally not
1237 needed but can be derived for any ENCODE-COMMAND by checking the standard
1238 error that results from `sh -c \"cat foo | ENCODE-COMMAND > bar\"'.
1239
1240 FILE-EXTENSION-TRICKS is t or nil depending on whether or not tricks
1241 converting between different encoding types can be done based on
1242 FILE-EXTENSION; typically t.
1243
1244 ENCRYPTION-KEY-STDIN is a dummy variable for compatibility with encryption.
1245 ")
1246
1247 (defvar crypt-inhibit-formats (when (featurep 'mule) '(dos))
1248   "*A list of crypt abilities to turn off.  In particular, setting this
1249 variable to be '(dos) will stop the dos-mode CRLF <-> LF damage.")
1250
1251 \f
1252 ;;; This allows the user to alter contents of the encoding and encryption
1253 ;;; table variables without having to reload all of crypt++.
1254 (defun crypt-rebuild-tables ()
1255   "Rebuilds the encryption and encoding tables and `minor-mode-alist'.
1256 Allows user to alter variables used in building these tables.  May be called
1257 interactively or in an initialization file.  Part of `after-init-hook'."
1258   (interactive)
1259   (setq crypt-encryption-alist (crypt-build-encryption-alist)
1260         crypt-encoding-alist (crypt-build-encoding-alist))
1261   (crypt-rebuild-minor-modes-alist))
1262
1263 \f
1264 ;;; Buffer locals.
1265
1266 (defvar crypt-buffer-save-encrypted nil
1267   "*non-nil says save buffer encrypted with `crypt-encryption-type.'
1268 local to all buffers.")
1269 (make-variable-buffer-local 'crypt-buffer-save-encrypted)
1270 (put 'crypt-buffer-save-encrypted 'permanent-local t) ; for v19 Emacs
1271 (put 'crypt-buffer-save-encrypted 'preserved t)       ; for kill-fix.el
1272
1273 (defvar crypt-buffer-encryption-key nil
1274   "*Key used for encryption of current buffer.  Local to all buffers.")
1275 (make-variable-buffer-local 'crypt-buffer-encryption-key)
1276 (put 'crypt-buffer-encryption-key 'permanent-local t) ; for v19 Emacs
1277 (put 'crypt-buffer-encryption-key 'preserved t)       ; for kill-fix.el
1278
1279 (defvar crypt-buffer-save-encoded nil
1280   "*non-nil says buffer will be saved encoded.  Local to all buffers.")
1281 (make-variable-buffer-local 'crypt-buffer-save-encoded)
1282 (put 'crypt-buffer-save-encoded 'permanent-local t)   ; for v19 Emacs
1283 (put 'crypt-buffer-save-encoded 'preserved t)         ; for kill-fix.el
1284
1285 (defvar crypt-buffer-encoding-type nil
1286   "*non-nil says buffer is encoded with ENCODING-TYPE.  Local to all buffers.")
1287 (make-variable-buffer-local 'crypt-buffer-encoding-type)
1288 (put 'crypt-buffer-encoding-type 'permanent-local t)  ; for v19 Emacs
1289 (put 'crypt-buffer-encoding-type 'preserved t)        ; for kill-fix.el
1290
1291 (defvar crypt-buffer-interactive-encoded-mode nil
1292   "t says `crypt-encoded-mode' was toggled interactively, almost always nil.
1293 Local to all buffers.")
1294 (make-variable-buffer-local 'crypt-buffer-interactive-encoded-mode)
1295 (put 'crypt-buffer-interactive-encoded-mode 'permanent-local t) ; v19 Emacs
1296 (put 'crypt-buffer-interactive-encoded-mode 'preserved t)       ; kill-fix.el
1297
1298 \f
1299 ;;; Functions and macros that search `crypt-encryption-alist' and
1300 ;;; `crypt-encoding-alist'.
1301
1302 (defun crypt-get-alist-member (type n)
1303   ;; Returns TYPE's Nth element
1304   (nth n (or (assoc type crypt-encryption-alist)
1305              (assoc type crypt-encoding-alist))))
1306
1307 (defmacro crypt-get-magic-regexp (type)
1308   ;; Returns regexp found at top of files encoded/encrypted with TYPE.
1309   (list 'crypt-get-alist-member type 1))
1310
1311 (defmacro crypt-get-magic-regexp-inverse (type)
1312   ;; Returns regexp *not* found at top of files encoded/encrypted with TYPE.
1313   (list 'crypt-get-alist-member type 2))
1314
1315 (defmacro crypt-get-file-extension (type)
1316   ;; Returns regexp matching extension of files encoded/encrypted with TYPE.
1317   (list 'crypt-get-alist-member type 3))
1318
1319 (defmacro crypt-get-encoding-program (type)
1320   ;; Returns name of program, as string, used to encode/encrypt with TYPE.
1321   (list 'crypt-get-alist-member type 4))
1322
1323 (defmacro crypt-get-decoding-program (type)
1324   ;; Returns name of program, as string, used to decode/decrypt with TYPE.
1325   (list 'crypt-get-alist-member type 5))
1326
1327 (defmacro crypt-get-encoding-args (type)
1328   ;; Returns arguments passed to program used to encode/encrypt with TYPE.
1329   (list 'crypt-get-alist-member type 6))
1330
1331 (defmacro crypt-get-decoding-args (type)
1332   ;; Returns arguments passed to program used to decode/decrypt with TYPE.
1333   (list 'crypt-get-alist-member type 7))
1334
1335 (defmacro crypt-get-minor-mode-name (type)
1336   ;; Returns minor mode name, as string, for encoding/encrypting with TYPE.
1337   (list 'crypt-get-alist-member type 8))
1338
1339 (defmacro crypt-get-cleanup-regexp (type)
1340   ;; Returns regexp or lisp-exp for cleaning up encoding/encrypting with TYPE.
1341   (list 'crypt-get-alist-member type 9))
1342
1343 (defmacro crypt-get-extension-tricks (type)
1344   ;; Returns t if file extension tricks doable for encoding/encrypting with
1345   ;; TYPE.
1346   (list 'crypt-get-alist-member type 10))
1347
1348 (defmacro crypt-get-encryption-key-stdin (type)
1349   ;; Returns t if encryption program takes passphrase on stdin, or nil
1350   ;; if at end of command line.
1351   (list 'crypt-get-alist-member type 11))
1352
1353 (defun crypt-buffer-save-name (type)
1354   ;; Returns variable `crypt-buffer-save-TYPE', set to t if encoding with TYPE.
1355   ;; local to all buffers.
1356   (intern (concat "crypt-buffer-save-" (symbol-name type))))
1357
1358 \f
1359 ;;; Create a buffer-local variable for each type of encoding.
1360 ;;; These variables are used to trigger the minor mode names.
1361
1362 (defun crypt-build-minor-mode-alist ()
1363   ;; Returns minor mode alist entries for encoded and encrypted buffers.
1364   (append
1365    ;; First the encrypted minor mode -- only one.
1366    (list (list 'crypt-buffer-save-encrypted
1367                (concat " " (crypt-get-minor-mode-name crypt-encryption-type))))
1368    ;; Now the encoding minor modes.
1369    (mapcar
1370     (function
1371      (lambda (element)
1372        (let ((variable (crypt-buffer-save-name (car element))))
1373          (make-variable-buffer-local variable)
1374          (put variable 'permanent-local t) ; for v19 Emacs
1375          (put variable 'preserved t)       ; for kill-fix.el
1376          (list variable
1377                (concat " " (crypt-get-minor-mode-name (car element)))))))
1378     crypt-encoding-alist)))
1379
1380 (defconst crypt-minor-mode-alist (crypt-build-minor-mode-alist)
1381   "Alist containing encoded and encrypted minor modes.
1382 Derived from variable `crypt-encoding-alist' and function
1383 `crypt-build-minor-mode-encrypted'")
1384
1385 (defun crypt-rebuild-minor-modes-alist ()
1386   ;; Rebuilds the encryption and encoding minor modes and `minor-mode-alist.'
1387   ;; Allows user to alter variables used in building this alist. Called by
1388   ;; `crypt-rebuild-tables' and so part of `after-init-hook'."
1389
1390   ;; First remove old crypt minor mode entries from `minor-mode-alist'.
1391   (if (memq (car crypt-minor-mode-alist) minor-mode-alist)
1392       (let ((alist crypt-minor-mode-alist) elt)
1393         (while (and alist (setq elt (car alist)))
1394           (setq minor-mode-alist (delq elt minor-mode-alist)
1395                 alist (cdr alist)))))
1396
1397   ;; Get new crypt minor mode entries and add to minor-mode-alist.
1398   (setq crypt-minor-mode-alist (crypt-build-minor-mode-alist)
1399         minor-mode-alist (append crypt-minor-mode-alist minor-mode-alist)))
1400
1401 \f
1402 (defmacro crypt-save-point (&rest body)
1403   ;; Save value of point, evaluate FORMS, and restore value of point.  If the
1404   ;; saved value of point is no longer valid go to (point-max).  This macro
1405   ;; exists because, save-excursion loses track of point during some types of
1406   ;; deletions.
1407   (let ((var (make-symbol "saved-point")))
1408     (list 'let (list (list var '(point)))
1409           (list 'unwind-protect
1410                 (cons 'progn body)
1411                 (list 'goto-char var)))))
1412
1413 \f
1414 ;; Hook run for decoding and/or decrypting the contents of a buffer.  Meant
1415 ;; to be called as part of `find-file-hooks'.
1416 ;;
1417 (defun crypt-find-file-hook ()
1418   (let ((buffer-file-name buffer-file-name)
1419         (old-buffer-file-name buffer-file-name)
1420         (old-buffer-modified-p (buffer-modified-p))
1421         (case-fold-search nil) ; case-sensitive
1422         (binary-process-input t) ; Win32
1423         (binary-process-output t) ; Win32
1424         encrypted encoded buffer-read-only)
1425
1426     ;; DECODE AND/OR DECRYPT
1427     (crypt-save-point
1428
1429      ;; Do we have to DECODE? If not, then move on.
1430      (if (and (crypt-encoded-p)
1431               (or crypt-auto-decode-buffer
1432                   (y-or-n-p (format "Decode %s? " (buffer-name)))))
1433
1434          ;; Decode, uncompress, the buffer.
1435          (progn
1436
1437          ;; This is ugly, but it makes tar-mode recognize and decode the
1438          ;; buffer after we uncompress it.  We should at least use the
1439          ;; regexps already defined in the table.
1440          (if (and (not (null buffer-file-name))
1441                   (string-match "\\.Z$" buffer-file-name))
1442              (set-visited-file-name
1443               (substring buffer-file-name 0 (match-beginning 0)))
1444            (if (and (not (null buffer-file-name))
1445                     (string-match "\\.g?z$" buffer-file-name))
1446                (set-visited-file-name
1447                 (substring buffer-file-name 0 (match-beginning 0))))
1448            (if (and (not (null buffer-file-name))
1449                     (string-match "\\.tgz$" buffer-file-name))
1450                (set-visited-file-name
1451                 (concat (substring buffer-file-name 0 (match-beginning 0)) ".tar")))
1452            (if (and (not (null buffer-file-name))
1453                     (string-match "\\.tbz$" buffer-file-name))
1454                (set-visited-file-name
1455                 (concat (substring buffer-file-name 0 (match-beginning 0)) ".tar")))
1456            (if (and (not (null buffer-file-name))
1457                     (string-match "\\.bz2?$" buffer-file-name))
1458                (set-visited-file-name
1459                 (substring buffer-file-name 0 (match-beginning 0)))))
1460            (message "Decoding %s..." (buffer-name))
1461            (crypt-encode-buffer t)
1462
1463            ;; Store the encoding mode.
1464
1465            ;; We can not yet go into the minor modes because the major mode
1466            ;; may change later on and blow away all local variables (and thus
1467            ;; the minor modes).  Only needed for vanilla v18.  Our
1468            ;; buffer-locals defined 'permanent-local for v19 Emacs and
1469            ;; 'preserved for kill-fix.el.
1470
1471            (setq encoded crypt-buffer-encoding-type)
1472
1473            ;; Strip encoded file's extension so later we can set buffer's
1474            ;; major mode based on its file-name sans encoding extension.
1475            (if (string-match (crypt-get-file-extension
1476                               crypt-buffer-encoding-type) buffer-file-name)
1477                (setq buffer-file-name
1478                      (substring buffer-file-name 0 (match-beginning 1))))
1479
1480            ;; Decoding ends.
1481            (if (not (input-pending-p))
1482                (message "Decoding %s... done" (buffer-name)))))
1483
1484      ;; Do we have to DECRYPT? If not, then move on.
1485      (if (crypt-encrypted-p)
1486
1487          ;; Decrypt buffer.
1488          (progn
1489
1490            (message "Decrypting %s..." (buffer-name))
1491            (crypt-encrypt-buffer crypt-buffer-encryption-key t)
1492
1493            ;; Save key in case major mode blows all buffer-locals.
1494
1495            ;; Only needed for vanilla v18.  Our buffer-locals defined
1496            ;; 'permanent-local for v19 Emacs and 'preserved for
1497            ;; kill-fix.el.
1498
1499            (setq encrypted crypt-buffer-encryption-key)
1500
1501            ;; Strip encrypted file's extension so later we can set buffer's
1502            ;; major mode based on its file-name sans encrypting extension.
1503            (if (and (crypt-get-extension-tricks crypt-encryption-type)
1504                     (string-match (crypt-get-file-extension
1505                                    crypt-encryption-type) buffer-file-name))
1506                (setq buffer-file-name
1507                      (substring buffer-file-name 0 (match-beginning 1))))
1508
1509            (if (not (input-pending-p))
1510                (message "Decrypting %s... done" (buffer-name))))))
1511
1512     ;; MAJOR AND MINOR MODES
1513
1514     ;; OK, if any changes have been made to the buffer we need to rerun the
1515     ;; code the does automatic selection of major mode.
1516
1517     (if (or encoded encrypted)
1518
1519         (progn
1520
1521           ;; Set the major mode.
1522           (set-auto-mode)
1523           (hack-local-variables)
1524
1525           ;; Now set our own minor mode(s).
1526           (if encoded
1527               ;; Recover encoding type, may have been smashed by major mode,
1528               ;; and toggle encoded mode.
1529               (progn (setq crypt-buffer-encoding-type encoded)
1530                      (crypt-encoded-mode 1)))
1531
1532           (if encrypted
1533               ;; Recover encryption key, may have been smashed by major mode,
1534               ;; and toggle encrypted mode.
1535               (progn (setq crypt-buffer-encryption-key encrypted)
1536                      (crypt-encrypted-mode 1)))
1537
1538           ;; Restore buffer file name now, so that lock file entry is removed
1539           ;; properly.
1540           (setq buffer-file-name old-buffer-file-name)
1541
1542           ;; Restore buffer modified flag to its previous value.  Will also
1543           ;; remove lock file entry for buffer if previous value was nil.
1544           ;; This is why buffer-file-name had to be restored manually above.
1545           (set-buffer-modified-p old-buffer-modified-p)))))
1546
1547 (defun crypt-encoded-p (&optional buffer)
1548   ;; Returns t if current buffer, or optionally BUFFER, is encoded.
1549   ;; Sets `crypt-buffer-encoding-type' to encoding method.
1550   (save-excursion
1551     (and buffer (set-buffer buffer))
1552     (save-restriction
1553       (widen)
1554       (goto-char (point-min))
1555       (let ((alist crypt-encoding-alist) elt found)
1556         (while (and alist (setq elt (car alist)) (not found))
1557           (if (and (looking-at (nth 1 elt))
1558                    (not (memq (nth 0 elt) crypt-inhibit-formats)))
1559               (setq crypt-buffer-encoding-type (nth 0 elt)
1560                     found t)
1561             ;; Decrement
1562             (setq alist (cdr alist))))
1563         found))))
1564
1565 (defun crypt-encryption-type-get (file)
1566   "Determine type of encryption from file extension."
1567   (let (ret
1568         regexp)
1569     (dolist (elt crypt-encryption-alist)
1570       (setq regexp (nth 3 elt))
1571       (if (and (stringp regexp)
1572                (string-match regexp file))
1573         (return (nth 0 elt))))))
1574
1575 (defun crypt-encryption-type-set ()
1576   "Set `crypt-encryption-type'"
1577   (let (type)
1578     (if (setq type (crypt-encryption-type-get buffer-file-name))
1579         (progn
1580           (setq crypt-encryption-type type)
1581           (crypt-rebuild-tables)))))
1582
1583 (defun crypt-encrypted-p (&optional buffer)
1584   ;; Returns t if current buffer, or optionally BUFFER, is encrypted.
1585   ;; Look for MAGIC-REGEXP and absence of MAGIC-REGEXP-INVERSE.  If so, then
1586   ;; assume it is an encrypted buffer.
1587   ;; Sets `crypt-buffer-encryption-key' to password if not set already.
1588
1589   ;; Do not try to decrypt buffer if not wanted.
1590   (if (not crypt-never-ever-decrypt)
1591
1592       (save-excursion
1593         (and buffer (set-buffer buffer))
1594
1595         (save-restriction
1596           (widen)
1597           (goto-char (point-min))
1598           (crypt-encryption-type-set)
1599           (let ((magic-regexp (crypt-get-magic-regexp crypt-encryption-type))
1600                 (magic-regexp-inverse (crypt-get-magic-regexp-inverse
1601                                        crypt-encryption-type))
1602                 (limit (min (point-max) crypt-magic-search-limit)))
1603
1604             ;; Check all encryption conditions.  If any fail, then return nil
1605             ;; value of this if-form, else check for password.
1606             (if (and
1607
1608                  ;; Check for existence of MAGIC-REGEXP.
1609                  (if (stringp magic-regexp)
1610                      ;; regular expression
1611                      (re-search-forward magic-regexp limit t)
1612                    ;; lisp expression
1613                    (eval magic-regexp))
1614
1615                  (goto-char (point-min))
1616
1617                  ;; Check for absence of MAGIC-REGEXP-INVERSE.
1618                  (not (if (stringp magic-regexp-inverse)
1619                           ;; regular expression
1620                           (re-search-forward magic-regexp-inverse limit t)
1621                         ;; lisp expression
1622                         (eval magic-regexp-inverse))))
1623
1624                 (progn
1625
1626                   ;; Get key, i.e., the password?
1627                   (or crypt-buffer-encryption-key
1628                       ;; Do not confirm on reading an encrypted file.
1629                       (let ((crypt-confirm-password nil))
1630                         (call-interactively 'crypt-set-encryption-key)))
1631
1632                   ;; Do not turn on encryption mode if no key: may be a binary
1633                   ;; file.  Thanks to Paul Dworkin (paul@media-lab.media.mit.edu).
1634                   (if (equal crypt-buffer-encryption-key "")
1635                       ;; Return nil.
1636                       (progn
1637                         (message "No key given.  Assumed normal.")
1638                         nil)
1639                     ;; Return t.
1640                     t))))))))
1641
1642 \f
1643 ;;;
1644
1645 (defun crypt-check-extension-for-encoding ()
1646
1647   ;; Checks file extensions for possible toggling of encoding modes.  Used for
1648   ;; buffers to be written to disk and called by `crypt-write-file-hook'
1649
1650   ;; We try to flag a buffer to be written out in encoded form if the file
1651   ;; ends in one of the file-extensions in `crypt-encoding-alist' even if
1652   ;; `crypt-buffer-save-encoded' is nil.  Conversely, we try to write out a
1653   ;; buffer as a plain file if it does _not_ end in one of these
1654   ;; file-extensions even if `crypt-buffer-save-encoded' is non-nil.
1655
1656   (let ((alist crypt-encoding-alist)
1657         (case-fold-search nil)
1658         found elt)
1659
1660     ;; Search through the file name extensions for a match.
1661     (while (and alist (setq elt (car alist)) (not found))
1662       (if (string-match (nth 3 elt) buffer-file-name)
1663           (setq found t)
1664         ;; Decrement.
1665         (setq alist (cdr alist))))
1666
1667     ;; Did we find a match?
1668     (if found
1669
1670         ;; File name ends in a very provocative extension.
1671
1672         ;; Check to see if already an encoded file.
1673         (if crypt-buffer-save-encoded
1674
1675             ;; Already encoded - do the methods of encoding match?
1676             (if (not (eq (nth 0 elt) crypt-buffer-encoding-type))
1677
1678                 ;; A new encoding method is desired.
1679
1680                 ;; Can we play some filename extension tricks with the
1681                 ;; destination extension?
1682                 (if (crypt-get-extension-tricks (nth 0 elt))
1683
1684                     ;; Can play tricks.
1685                     ;; Change the method of encoding?
1686                     (if (crypt-y-or-n-p (format "Write %s using %s? "
1687                                          (buffer-name) (nth 4 elt)))
1688
1689                         ;; Case one.
1690                         ;; Turn off original encoding and turn on new encoding.
1691                         (progn (crypt-encoded-mode -1)
1692                                (setq crypt-buffer-encoding-type (nth 0 elt))
1693                                (crypt-encoded-mode 1)))
1694
1695                   ;; Can not play tricks - maybe wants a plain file?
1696                   (if (crypt-y-or-n-p (format "Write %s a plain file? "
1697                                               (buffer-name)))
1698
1699                       ;; Case three.
1700                       ;; Turn off the minor mode and _then_ the flags.
1701                       (progn
1702                         (crypt-encoded-mode -1)
1703                         (setq crypt-buffer-save-encoded nil
1704                               crypt-buffer-encoding-type nil)))))
1705
1706           ;; Was a plain file.
1707           (if (and
1708                ;; Can we play some filename extension tricks?
1709                ;; If not then we must abort.
1710                (crypt-get-extension-tricks (nth 0 elt))
1711
1712                (crypt-y-or-n-p (format "Write %s using %s? "
1713                                        (buffer-name) (nth 4 elt))))
1714
1715               ;; Case two.
1716               ;; Turn on encoding flags and _then_ the minor mode.
1717               (progn
1718                 (setq crypt-buffer-save-encoded t
1719                       crypt-buffer-encoding-type (nth 0 elt))
1720                 (crypt-encoded-mode 1))))
1721
1722       ;; No match - a plain-jane file extension - but if the encoded flag is
1723       ;; non-nil then the user may really want it written out in plain
1724       ;; format so we must override this flag.
1725       (if (and crypt-buffer-save-encoded
1726
1727                ;; Search the list of files to be ignored.
1728                ;; If `crypt-ignored-filenames' is nil then this let form
1729                ;; will return t.  If a match is found this form will return
1730                ;; nil.  Otherwise it will return t.
1731                (let ((tlist crypt-ignored-filenames)
1732                      case-fold-search found elt)
1733
1734                  ;; Search through the list of filenames for a match.
1735                  (while (and tlist (setq elt (car tlist)) (not found))
1736                    (if (string-match elt buffer-file-name)
1737                        (setq found t)
1738                      ;; Decrement.
1739                      (setq tlist (cdr tlist))))
1740
1741                  ;; Return t if we can _not_ find a match.
1742                  (not found))
1743
1744                ;; If `(crypt-encoded-mode)' was called interactively, then
1745                ;; there is a high probability that no matter what the file
1746                ;; name extension the user wishes to write the file out in some
1747                ;; encoded format.  Thanks to Kimball Collins
1748                ;; <kpc@ptolemy.arc.nasa.gov> for pointing out the need for
1749                ;; this.  Unfortunately, still can not distinguish between
1750                ;; write-file and save-buffer.  In the former the user may want
1751                ;; to write in plain format (or indeed some other format).
1752
1753                (if crypt-buffer-interactive-encoded-mode
1754                    ;; Interactive
1755                    crypt-query-if-interactive
1756                  ;; Non-interactive but still may want encoded format.
1757                  crypt-no-extension-implies-plain)
1758
1759                (crypt-y-or-n-p (format "Write %s as a plain file? "
1760                                        (buffer-name))))
1761
1762           ;; Case three.
1763           ;; Turn off the minor mode and _then_ the flags.
1764           (progn
1765             (crypt-encoded-mode -1)
1766             (setq crypt-buffer-save-encoded nil
1767                   crypt-buffer-encoding-type nil))))))
1768
1769 \f
1770 (defun crypt-y-or-n-p (prompt)
1771   ;; Queries user based on `crypt-auto-write-buffer' and internal buffer-local
1772   ;; variable `crypt-auto-write-answer-local'.  Returns value of
1773   ;; `crypt-auto-write-answer-local', which is t or nil.
1774
1775   ;; Check if we need to ask user.  Should be 'ask, nil, or t.
1776   (if (eq crypt-auto-write-answer-local 'ask) ; Default value.
1777       ;; We may need to ask.
1778       (or crypt-auto-write-buffer
1779           ;; Ask and store the answer.
1780           ;; Note: we only store if we asked.
1781           (setq crypt-auto-write-answer-local (y-or-n-p prompt)))
1782     ;; Use previous answer.
1783     crypt-auto-write-answer-local)) ; Will be nil or t.
1784
1785 \f
1786 ;;; This function should be called ONLY as a write-file hook.
1787 ;;; Odd things will happen if it is called elsewhere.
1788
1789 (defun crypt-write-file-hook ()
1790
1791   ;; Hook for possibly writing out file, and backup file, in a non-plain
1792   ;; format.  Terminates calls in `write-file-hooks' and should be at end of
1793   ;; list.
1794
1795   (let ((binary-process-input t)  ; Win32
1796         (binary-process-output t) ; Win32
1797         (inhibit-read-only t)     ; else we lose on read-only properties
1798        )
1799
1800   ;; Check file-extension for possible toggling of encoding modes.
1801   (crypt-check-extension-for-encoding)
1802
1803   ;; Check extension for encryption.
1804   (if (and
1805
1806        ;; Maybe file ends with provocative extension w.r.t. encryption?
1807        (stringp (crypt-get-file-extension crypt-encryption-type))
1808        (let ((case-fold-search nil)) ; Make case-sensitive.
1809          (string-match (crypt-get-file-extension crypt-encryption-type)
1810                        buffer-file-name))
1811
1812        ;; Can we play tricks?
1813        (crypt-get-extension-tricks crypt-encryption-type)
1814
1815        ;; Match of filename extension - is file in plain format?
1816        (not crypt-buffer-save-encrypted)
1817
1818        ;; Query?
1819        (or crypt-auto-write-buffer-encrypted
1820            (y-or-n-p
1821             (format "Write %s as an encrypted file? " (buffer-name)))))
1822
1823       (progn
1824         ;; Set password and toggle `crypt-encrypted-mode'
1825         (if (eq crypt-encryption-type 'pgp-pub)
1826             (crypt-set-encryption-key "dummy-key")
1827           (call-interactively 'crypt-set-encryption-key))
1828         (crypt-encrypted-mode 1)))
1829
1830   ;; Now decide whether or not we need to continue with this defun. Does the
1831   ;; buffer need to be saved in a non-plain form?  If not then writing is not
1832   ;; done here but later in the write-file-hooks - probably at the end.
1833
1834   (if (or crypt-buffer-save-encoded crypt-buffer-save-encrypted)
1835
1836       (save-excursion
1837         (save-restriction
1838
1839           (let
1840
1841               ;; BINDINGS
1842               ((copy-buffer (get-buffer-create " *crypt copy buffer*"))
1843                (selective-display selective-display)
1844                (buffer-read-only))
1845
1846             ;; FORMS
1847             (copy-to-buffer copy-buffer 1 (1+ (buffer-size)))
1848             (narrow-to-region (point) (point))
1849
1850             (unwind-protect
1851
1852                 ;; BODYFORM
1853                 (let (setmodes)
1854
1855                   ;; As of v19, if one of functions of the `write-file-hooks'
1856                   ;; returns a non-nil value, then `basic-save-buffer' no
1857                   ;; longer creates a backup file.  We must do it ourselves.
1858                   ;; this should be a no-op in v18.
1859                   (or buffer-backed-up
1860                       (setq setmodes (backup-buffer)))
1861
1862                   (insert-buffer-substring copy-buffer)
1863                   (kill-buffer copy-buffer)
1864
1865                   ;; "Who would cross the Bridge of Death
1866                   ;;  Must answer me
1867                   ;;  These questions three
1868                   ;;  Ere the other side he see."
1869                   ;;
1870                   ;; Bridgekeeper from Monty Python and the Holy Grail
1871
1872                   ;; [1] selective-display non-nil means we must convert
1873                   ;; carriage returns to newlines now, and set the variable
1874                   ;; selective-display temporarily to nil.
1875                   (if selective-display
1876                       (progn
1877                         (goto-char (point-min))
1878                         (subst-char-in-region (point-min) (point-max) ?\r ?\n)
1879                         (setq selective-display nil)))
1880
1881                   ;; [2] encryption
1882                   (if crypt-buffer-save-encrypted
1883                       (progn
1884                         ;; check for password
1885                         (if (not crypt-buffer-encryption-key)
1886                             (call-interactively 'crypt-set-encryption-key))
1887                         (if (null crypt-buffer-encryption-key)
1888                             (error "No encryption key set for buffer %s"
1889                                    (buffer-name)))
1890                         (if (not (stringp crypt-buffer-encryption-key))
1891                             (error "Encryption key is not a string"))
1892                         (message "Encrypting %s..." (buffer-name))
1893                         (crypt-encrypt-buffer crypt-buffer-encryption-key)))
1894
1895                   ;; [3] encoding
1896                   (if crypt-buffer-save-encoded
1897                       (progn
1898                         (message "Encoding %s..." (buffer-name))
1899                         (crypt-encode-buffer)))
1900
1901                   ;; Now write buffer/region to disk.
1902                   (write-region (point-min) (point-max) buffer-file-name nil t)
1903                   (delete-region (point-min) (point-max))
1904                   (set-buffer-modified-p nil)
1905
1906                   ;; Now that the file is written, set its modes.
1907                   (if setmodes
1908                       (condition-case ()
1909                           (set-file-modes buffer-file-name setmodes)
1910                         (error nil)))
1911
1912                   ;; Return t so that `basic-save-buffer' will know that the
1913                   ;; save has already been done.
1914
1915                   ;; NOTE: this TERMINATES write-file-hooks so any hooks
1916                   ;; following this one will not be executed.
1917
1918                   t )
1919
1920               ;; UNWINDFORMS
1921               ;; unwind...sit back...take a load off...have a beer
1922
1923               ;; If the encoded and encrypted stuff has already been removed
1924               ;; then this is a no-op.  This form is executed if BODYFORM
1925               ;; completes normally but the value of BODYFORM is returned -
1926               ;; i.e., t is returned.
1927
1928               (delete-region (point-min) (point-max)))))))))
1929
1930 \f
1931 ;;;; ENCRYPTION
1932
1933 (defvar crypt-pgp-pub-library 'mailcrypt
1934   "What PGP library to use.
1935 Bind to 'npgp to use \"PEM - PGP Enhanced Messaging for GNU Emacs\"
1936 from Roy Frederick Busdiecker, III (Rick)
1937 or to 'mailcrypt (see also crypt-pgp-pub-sub-library).")
1938
1939 (defvar crypt-pgp-pub-sub-library 'pgp50
1940   "What variant of mailcrypt 3.5.x to use: 'pgp, 'pgp50, 'gpg.")
1941
1942 (defvar crypt-pgp-pub-npgp-userid nil
1943   "PGP key for the current user.")
1944
1945 (defvar crypt-pgp-pub-npgp-key-id nil
1946   "Keyid of PGP key for the current user.
1947 Useful if your \\[user-full-name] doesn't match a unique key.
1948 Should have a leading 0x.")
1949
1950 (defvar crypt-pgp-pub-multirecipients t
1951   "If t, enables prompts for user so when a file is saved, he/she has the opportunity to enter users for whom the file should be encrypted. nil encrypts only with the user's public key without prompts")
1952
1953 (defvar crypt-pgp-pub-recipient-history ""
1954   "History list of previous entered recipients")
1955
1956 (defvar crypt-pgp-pub-recipients nil
1957   "Comma-separated string containing the names of all the people who's private keys could decrypt this file (e.g. recipients, if the file was an email)")
1958
1959 (defun crypt-pgp-pub-clear-recipients ()
1960   "Clear the recipient list, forcing crypt++ to ask you for the people who's public keys you wish to encrypt the message with"
1961   (interactive)
1962   (setq crypt-pgp-pub-recipients nil)
1963 )
1964
1965 (defun crypt-pgp-pub-npgp-userid ()
1966   "Return crypt-pgp-pub-npgp-userid, initializing it if necessary."
1967   (require 'pam)
1968   (if (and crypt-pgp-pub-npgp-userid
1969            npgp:*pass-phrases*)
1970       crypt-pgp-pub-npgp-userid
1971     (setq crypt-pgp-pub-npgp-userid
1972           (list
1973            (if crypt-pgp-pub-npgp-key-id
1974                (npgp:get-key-by-key-id crypt-pgp-pub-npgp-key-id)
1975              (pam:read-name-key (user-full-name)))))))
1976
1977 (defun crypt-pgp-pub-mailcrypt-userid ()
1978   "Do the right thing."
1979   (require 'mailcrypt)
1980   (cond
1981    ((eq crypt-pgp-pub-sub-library 'pgp)
1982     (car (mc-pgp-lookup-key mc-pgp-user-id)))
1983    ((eq crypt-pgp-pub-sub-library 'pgp50)
1984     (car (mc-pgp50-lookup-key mc-pgp50-user-id)))
1985    ((eq crypt-pgp-pub-sub-library 'gpg)
1986     (car (mc-gpg-lookup-key mc-gpg-user-id)))
1987    (t (error "crypt-pgp-pub-mailcrypt-userid: no pgp sub-library."))))
1988
1989
1990 (defun crypt-pgp-pub-load-mailcrypt ()
1991   (require 'mailcrypt)
1992   ;; ick ick ick this code needs to be cleaned up
1993   (cond
1994    ((null (eq crypt-pgp-pub-library 'mailcrypt))
1995     t)
1996    ((eq crypt-pgp-pub-sub-library 'pgp)
1997     (load-library "mc-pgp"))
1998    ((eq crypt-pgp-pub-sub-library 'pgp50)
1999     (load-library "mc-pgp5"))
2000    ((eq crypt-pgp-pub-sub-library 'gpg)
2001     (load-library "mc-gpg"))
2002    (t (error "crypt-pgp-pub-load-mailcrypt: no pgp sub-library."))))
2003
2004 (defun crypt-pgp-pub-decrypt-region (start end)
2005   (cond
2006    ((eq crypt-pgp-pub-library 'npgp) (npgp:decrypt-region start end))
2007    ((eq crypt-pgp-pub-library 'mailcrypt)
2008     (crypt-pgp-pub-load-mailcrypt)
2009     (cond
2010      ((eq crypt-pgp-pub-sub-library 'pgp)
2011       (mc-pgp-decrypt-region start end))
2012      ((eq crypt-pgp-pub-sub-library 'pgp50)
2013       (mc-pgp50-decrypt-region start end))
2014      ((eq crypt-pgp-pub-sub-library 'gpg)
2015       (mc-gpg-decrypt-region start end))
2016      (t (error "crypt-pgp-pub-decrypt-region: no decryption sub-library."))))
2017    (t (error "crypt-pgp-pub-decrypt-region: no decryption library."))))
2018
2019 (defun crypt-pgp-pub-encrypt-region (start end)
2020   (cond
2021    ((eq crypt-pgp-pub-library 'npgp)
2022     (npgp:encrypt-region (crypt-pgp-pub-npgp-userid) start end))
2023    ((eq crypt-pgp-pub-library 'mailcrypt)
2024     (crypt-pgp-pub-load-mailcrypt)
2025     (let ((old-sign mc-pgp-always-sign)
2026           old-comment recipients)
2027       (if crypt-pgp-pub-multirecipients
2028           (if (eq (length crypt-pgp-pub-recipients) 0)
2029               (progn
2030                 (if (y-or-n-p
2031                      (concat "Encrypt with your public key ("
2032                               (crypt-pgp-pub-mailcrypt-userid)
2033                               ")? "))
2034                     (setq crypt-pgp-pub-recipients
2035                           (concat (crypt-pgp-pub-mailcrypt-userid) ","))
2036                   (setq crypt-pgp-pub-recipients ""))
2037                 (setq crypt-pgp-pub-recipients
2038                       (concat crypt-pgp-pub-recipients
2039                               (read-string
2040                                "Recipients: " nil crypt-pgp-pub-recipient-history)))))
2041         (setq crypt-pgp-pub-recipients (crypt-pgp-pub-mailcrypt-userid)))
2042       (setq mc-pgp-always-sign 'never
2043             recipients (mc-split "\\([ \t\n]*,[ \t\n]*\\)+" crypt-pgp-pub-recipients))
2044       (cond
2045        ((eq crypt-pgp-pub-sub-library 'pgp)
2046         (setq old-comment mc-pgp-comment
2047               mc-pgp-comment nil)
2048         (mc-pgp-encrypt-region recipients start end
2049                                (crypt-pgp-pub-mailcrypt-userid) nil)
2050         (setq mc-pgp-comment old-comment))
2051        ((eq crypt-pgp-pub-sub-library 'pgp50)
2052         (setq old-comment mc-pgp50-comment
2053               mc-pgp50-comment nil)
2054         (mc-pgp50-encrypt-region recipients start end
2055                                (crypt-pgp-pub-mailcrypt-userid) nil)
2056         (setq mc-pgp50-comment old-comment))
2057        ((eq crypt-pgp-pub-sub-library 'gpg)
2058         (setq old-comment mc-gpg-comment
2059               mc-gpg-comment nil)
2060         (mc-gpg-encrypt-region recipients start end
2061                                (crypt-pgp-pub-mailcrypt-userid) nil)
2062         (setq mc-gpg-comment old-comment))
2063        (t (error "crypt-pgp-pub-decrypt-region: no encryption sub-library.")))
2064       (setq mc-pgp-always-sign old-sign)))
2065    (t (error "crypt-pgp-pub-encrypt-region: no encryption library."))))
2066
2067 (defun crypt-encrypt-region (start end key &optional decrypt)
2068   "Encrypt region START to END using KEY and `crypt-encryption-type'.  When
2069 called interactively START and END default to point and mark \(START being the
2070 lesser of the two\), and KEY is prompted for.  With optional DECRYPT non-nil,
2071 decryption is done."
2072
2073   (interactive
2074    (let (decrypt)
2075      (barf-if-buffer-read-only)
2076      (list (region-beginning)
2077            (region-end)
2078            (crypt-read-string-no-echo
2079             (concat (if (setq decrypt (y-or-n-p "Decrypt region? ")) "De" "En")
2080                     "crypt buffer using key: ")
2081             ;; Do not confirm on decrypting region.
2082             (if (not decrypt) crypt-confirm-password))
2083            decrypt)))
2084
2085   (crypt-save-point
2086
2087    ;; We define the PROGRAM as the encryption program or decryption program
2088    ;; listed for `crypt-encryption-type' of `crypt-encryption-alist.'  These
2089    ;; should be just the name of the executable and should _not_ contain any
2090    ;; arguments.  `(call-process-region)' would be confused if we tried to
2091    ;; pass the arguments as part of the PROGRAM.  The arguments are passed
2092    ;; through the encryption args or decryption args listed for
2093    ;; `crypt-encryption-type' of `crypt-encryption-alist.'
2094
2095    ;; Thanks to Joe Ilacqua <spike@world.std.com> and others for pointing out
2096    ;; an error that occurs with some encryption programs (e.g., the crypt from
2097    ;; Sun Microsystems, HPUX-8, and BSD) if `args' is `"".'  This will allow
2098    ;; nil values and lists of strings for argument.
2099
2100    (let ((coding-system-for-write 'no-conversion)
2101          (coding-system-for-read 'no-conversion)
2102          prog args)
2103
2104      ;; Get the proper program and arguments.
2105      (if decrypt
2106          (setq prog (crypt-get-decoding-program crypt-encryption-type)
2107                args (crypt-get-decoding-args crypt-encryption-type))
2108        (setq prog (crypt-get-encoding-program crypt-encryption-type)
2109              args (crypt-get-encoding-args crypt-encryption-type)))
2110
2111      ;; Either pass encryption key as first line of region, or
2112      ;; as last argument to program.
2113      (cond
2114       ((crypt-get-encryption-key-stdin crypt-encryption-type)
2115          (progn
2116            (goto-char start)
2117            (insert key "\n")
2118            (setq end (+ end (length key) 1))))
2119       ((listp args)
2120        (setq args (append args (list key))))
2121       ;; nil or "" args - don't pass.
2122       ((or (not args) (equal "" args))
2123        (setq args key))
2124       (t
2125        (setq args (concat args " " key))))
2126
2127      ;; Check arguments.
2128      (cond
2129
2130       ;; special-case pgp-pub
2131       ;; (Yes, this hack is gross.)
2132       ((eq crypt-encryption-type 'pgp-pub)
2133        (if decrypt
2134            (crypt-pgp-pub-decrypt-region start end)
2135          (crypt-pgp-pub-encrypt-region start end)))
2136
2137       ;; Check if the args are in the form of a list - must use apply.
2138       ((listp args)
2139        (apply 'call-process-region
2140               (append (list start end prog t (list t nil) nil) args)))
2141
2142       ;; Default - just a non-null string.
2143       (t
2144        (call-process-region start end prog t '(t nil) nil args))))))
2145
2146
2147 (defun crypt-encrypt-buffer (key &optional decrypt buffer)
2148
2149   ;; Use KEY to encrypt current buffer and with optional DECRYPT decrypt.
2150   ;; With optional BUFFER, encrypt or decrypt that buffer.  Not meant to be
2151   ;; called interactively, toggle `crypt-encrypted-mode' to encrypt an entire
2152   ;; buffer.
2153
2154   (or buffer (setq buffer (current-buffer)))
2155   (save-excursion (set-buffer buffer)
2156                   (crypt-encrypt-region (point-min) (point-max) key decrypt)))
2157
2158 (defun crypt-decrypt-buffer (key)
2159   "Use KEY to decrypt current buffer."
2160   (interactive
2161    (let (pass)
2162      (barf-if-buffer-read-only)
2163      (list
2164       (crypt-read-string-no-echo
2165        "Decrypt buffer using key: "))))
2166   (setq crypt-buffer-encryption-key key)
2167   (crypt-encrypt-region (point-min) (point-max) key 'decrypt))
2168
2169 \f
2170 ;;;; ENCODING
2171
2172 (defun crypt-encode-region (start end &optional decode)
2173
2174   "Encode region START to END.  When called interactively START and END
2175 default to point and mark \(START being the lesser of the two\).  With
2176 optional DECODE non-nil, decoding is done.
2177
2178 If encoding is attempted, then checks for correct magic number at start of
2179 newly-encoded region.  If not found, then searches and deletes a user-defined
2180 regexp, or executes a user-defined lisp expression, as defined in
2181 `crypt-encoding-alist,' and checks again for magic number."
2182
2183   (interactive "*r\nP")
2184
2185   ;; If called interactively then we may need to determine the encoding type.
2186   (if (and (interactive-p) (not crypt-buffer-encoding-type))
2187       (crypt-read-encoding-type))
2188
2189   (crypt-save-point
2190
2191    ;; We define the PROGRAM as `shell-file-name' and have it call the encoding
2192    ;; or decoding program with the arguments.
2193
2194    (let ((coding-system-for-write 'no-conversion)
2195          (coding-system-for-read 'no-conversion)
2196          prog args)
2197
2198      ;; Get the proper program and arguments.
2199      (if decode
2200          (setq prog (crypt-get-decoding-program crypt-buffer-encoding-type)
2201                args (crypt-get-decoding-args crypt-buffer-encoding-type))
2202        (setq prog (crypt-get-encoding-program crypt-buffer-encoding-type)
2203              args (crypt-get-encoding-args crypt-buffer-encoding-type)))
2204
2205      (cond
2206
2207       ;; prog is a string?
2208       ((stringp prog)
2209
2210        ;; Check arguments.
2211        (cond
2212
2213         ;; Check if the args are in the form of a list, will catch 'nil.
2214         ((listp args)
2215
2216          ;; Cat all the strings together.
2217          (while args
2218            (setq prog (concat prog " " (car args))
2219                  args (cdr args))))
2220
2221         ;; Check if a non-null string.
2222         ((and (not (string= "" args))
2223               (not (eq args t))) ; just in case...
2224          (setq prog (concat prog " " args))))
2225
2226        (call-process-region start end shell-file-name t '(t nil) nil
2227                             shell-command-switch prog))
2228
2229       ;; Otherwise try and eval it.
2230       (t
2231        (eval (if args
2232                  (list prog start end args)
2233                (list prog start end))))))
2234
2235    ;; Encoding or decoding region?
2236    (if (not decode)
2237
2238        ;; Check if encoded region starts with magic number.
2239        (let ((magic (crypt-get-magic-regexp crypt-buffer-encoding-type))
2240              (clean (crypt-get-cleanup-regexp crypt-buffer-encoding-type))
2241              (case-fold-search nil))
2242
2243          ;; Top of region.
2244          (goto-char start)
2245
2246          ;; Check for magic number.
2247          (if (not (looking-at magic))
2248
2249              ;; Magic number not there.
2250
2251              ;; Some compression programs produce an (inane) standard error
2252              ;; message that gets piped into the buffer.  For example, some
2253              ;; versions of compact output "Compression : 35.50%."  There may
2254              ;; be some way to clean up buffer and check again.
2255
2256              (cond
2257
2258               ;; No mechanism to clean up - failed.
2259               ((eq clean nil)
2260                (error "Encoding failed!"))
2261
2262               ;; Cleanup a regexp string?
2263               ((stringp clean)
2264
2265                ;; Is regexp there?
2266                (if (looking-at clean)
2267
2268                    (progn
2269                      ;; Delete the match.
2270                      (delete-region (match-beginning 0) (match-end 0))
2271
2272                      ;; Check for magic again.
2273                      (if (not (looking-at magic))
2274                          (error "Encoding failed!")))))
2275
2276               ;; Default: evaluate a lisp expression and check again.
2277               (t (eval clean)
2278                  (if (not (looking-at magic))
2279                      (error "Encoding failed!")))))))))
2280
2281 (defun crypt-encode-buffer (&optional decode buffer)
2282
2283   ;; Encode current buffer.  With optional DECODE non-nil decode and optional
2284   ;; BUFFER, encode or decode that buffer.  Not meant to be called
2285   ;; interactively, toggle `crypt-encoded-mode' to encode an entire buffer.
2286
2287   (or buffer (setq buffer (current-buffer)))
2288   (save-excursion (set-buffer buffer)
2289                   (crypt-encode-region (point-min) (point-max) decode)))
2290
2291 \f
2292 ;;;; DOS <--> UNIX
2293 (defun crypt-dos-to-unix-region (start end)
2294   "Converts region from START to END, from dos to unix format.
2295 Replaces \"\\r\\n\" with \"\\n\" and, if exists, removes ^Z at end of file.
2296 Sets `crypt-dos-has-ctrl-z'."
2297   (save-excursion
2298     (save-restriction
2299       (let ((remove-ctrl-z (equal end (point-max))))
2300         (narrow-to-region start end)
2301         (goto-char (point-min))
2302         (while (search-forward "\r\n" nil t)
2303           (replace-match "\n" nil t))
2304         (if remove-ctrl-z
2305             (progn
2306               (goto-char (1- (point-max)))
2307               (setq crypt-dos-has-ctrl-z (looking-at "\C-z"))
2308               (if crypt-dos-has-ctrl-z (replace-match ""))))))))
2309
2310 (defun crypt-unix-to-dos-region (start end)
2311   "Converts region from START to END, from unix to dos format.
2312 Replaces \"\\n\" with \"\\r\\n\" and adds a ^Z at end of file if
2313 `crypt-dos-has-ctrl-z' is non-nil."
2314   (save-excursion
2315     (save-restriction
2316       (let ((add-ctrl-z (and crypt-dos-has-ctrl-z
2317                             (equal end (point-max)))))
2318         (narrow-to-region start end)
2319         (goto-char (point-min))
2320         (while (search-forward "\n" nil t)
2321           (replace-match "\r\n" nil t))
2322         (if add-ctrl-z
2323             (progn
2324               (goto-char (point-max))
2325               (insert "\C-z")))))))
2326
2327 ;;;; MAC <--> UNIX
2328 (defun crypt-mac-to-unix-region (start end)
2329   "Converts region from START to END, from mac to unix format.
2330 Replaces \"\\r\" with \"\\n\"."
2331   (save-excursion
2332     ;(message "doing mac to unix")
2333     (save-restriction
2334       (narrow-to-region start end)
2335       (goto-char (point-min))
2336       (while (search-forward "\r" nil t)
2337         (replace-match "\n" nil t))
2338       )))
2339
2340 (defun crypt-unix-to-mac-region (start end)
2341   "Converts region from START to END, from mac to unix format.
2342 Replaces \"\\n\" with \"\\r\"."
2343   (save-excursion
2344     ;(message "doing unix to mac")
2345     (save-restriction
2346       (narrow-to-region start end)
2347       (goto-char (point-min))
2348       (while (search-forward "\n" nil t)
2349         (replace-match "\r" nil t))
2350       )))
2351
2352 \f
2353 ;;;; MODES
2354
2355 (defun crypt-encrypted-mode (&optional arg)
2356
2357   "Toggle encrypted mode.  With ARG, turn on iff positive, otherwise turn off.
2358 minor mode in which buffers are automatically encrypted before being written.
2359 if toggled and a key has been set for the current buffer, then the current
2360 buffer is marked modified, since it needs to be rewritten with or without
2361 encryption.
2362
2363 Entering encrypted mode causes auto-saving to be turned off in the current
2364 buffer, as there is no way in Emacs Lisp to force auto save files to be
2365 encrypted."
2366
2367   (interactive "P")
2368   (let ((oldval crypt-buffer-save-encrypted))
2369     (setq crypt-buffer-save-encrypted
2370           (if arg (> arg 0) (not crypt-buffer-save-encrypted)))
2371
2372     (if crypt-buffer-save-encrypted
2373         ;; We are going to save as encrypted, we will turn off auto-saving.
2374         (progn
2375 ;; NEVER do this.  Turning off auto-saving is one thing.  But if there's
2376 ;; already an autosave for some other reason, what business does this
2377 ;; package have tampering with it?
2378 ;          ;; If an auto-save file already exists, then delete it.
2379 ;          (if (and (stringp buffer-auto-save-file-name)
2380 ;                   (file-exists-p buffer-auto-save-file-name))
2381 ;              (delete-file buffer-auto-save-file-name))
2382           ;; If the key is not set then ask for it.
2383           (if (not crypt-buffer-encryption-key)
2384               (call-interactively 'crypt-set-encryption-key))
2385           ;; Encrypted files should not be converted.
2386           (setq buffer-file-coding-system 'no-conversion)
2387           ;; Turn-off auto-saving if crypt-encrypted-disable-auto-save non-nil.
2388           (and crypt-encrypted-disable-auto-save
2389                auto-save-default
2390                (progn
2391                  (auto-save-mode 0)
2392                  (if (eq crypt-encrypted-disable-auto-save t)
2393                      (message "Auto-save off (in this buffer)")))))
2394
2395       ;; We are not going to save as encrypted, we will turn on auto-saving
2396       ;; but only if we are editing a file and the default says we should.
2397       (auto-save-mode (if (and auto-save-default buffer-file-name) 1 0)))
2398
2399     (if crypt-buffer-encryption-key
2400         ;; Set buffer-modified flag to t only if the mode has been changed,
2401         ;; old code set unconditionally to nil if mode was not changed .
2402         ;; Modification suggested by: Gerd Hillebrand <ggh@cs.brown.edu>
2403         (if (not (eq oldval crypt-buffer-save-encrypted))
2404             (set-buffer-modified-p t)))))
2405
2406 \f
2407 ;;; Forgetting encryption keys (by jwz)
2408 ;;; This is really kind of bogus.  Good behavior would be:
2409 ;;; - If a crypted buffer has not been "accessed" (edited? selected?
2410 ;;;   viewed?) in N minutes, kill the buffer (since the plaintext is valuable.)
2411 ;;; - If a crypted buffer is modified, but "idle", just forget the password
2412 ;;;   instead of killing the buffer (though the plaintext is valuable, it's
2413 ;;;   also unsaved...)
2414 ;;; - The "idleness" of a modified buffer should be reset with every mod, so
2415 ;;;   that an unsaved buffer that you have been constantly typing at for an
2416 ;;;   hour doesn't lose its password.
2417 ;;; - But, if a password for a buffer has been discarded, and then an attempt
2418 ;;;   is made to save that buffer, then we should confirm that the newly-
2419 ;;;   typed password is the same as the password used in the file on disk.
2420 ;;;   with PGP, we could check that by attempting to decrypt the file on
2421 ;;;   disk into a scratch buffer and seeing if it contains the PGP error
2422 ;;;   message.
2423 ;;; - BUG: if a password has been forgotten, and you save, and are prompted,
2424 ;;;   the old file has already been renamed to a backup!!  so if you ^G, the
2425 ;;;   real file name no longer exists on disk - only as a ~ file.
2426
2427 (defun crypt-forget-encryption-key ()
2428   (cond (crypt-buffer-encryption-key
2429          (let ((inhibit-quit t))
2430            (fillarray crypt-buffer-encryption-key 0)
2431            (setq crypt-buffer-encryption-key nil))
2432          t)
2433         (t nil)))
2434
2435 (add-hook 'kill-buffer-hook 'crypt-forget-encryption-key)
2436
2437 (defcustom crypt-forget-passwd-timeout (* 60 60)
2438   "*Do not retain passwords for encrypted buffers more than this many seconds.
2439 If nil, keep them indefinitely."
2440   :type '(choice integer (const :tag "indefinite" nil))
2441   :group 'crypt)
2442
2443 (defun crypt-reset-passwd-timer ()
2444   (if (fboundp 'get-itimer)     ; XEmacs, or anything with itimer.el loaded.
2445       (let ((name "crypt-forget-passwds"))
2446         (if (get-itimer name)
2447             (delete-itimer name))
2448         (if crypt-forget-passwd-timeout
2449             (start-itimer name
2450                           'crypt-reset-passwds-timeout
2451                           crypt-forget-passwd-timeout)))))
2452
2453 (defun crypt-reset-passwds-timeout ()
2454   ;; run by the timer code to forget all passwords
2455   (let ((buffers (buffer-list))
2456         (inhibit-quit t)
2457         (keep-going nil))
2458     (while buffers
2459       (save-excursion
2460         (set-buffer (car buffers))
2461         (cond ((and crypt-buffer-encryption-key
2462                     (buffer-modified-p))
2463                ;; don't forget the password in modified buffers, but
2464                ;; do check again later (maybe it will be unmodified.)
2465                (setq keep-going t))
2466               (crypt-buffer-encryption-key
2467                ;; forget the password in unmodified buffers.
2468                (crypt-forget-encryption-key)
2469                ;; Mark the buffer read only so that it's not accidentally
2470                ;; edited; the smart thing to do is revert it, type the
2471                ;; encryption key (to make sure they same key is used)
2472                ;; and then edit it.
2473                (setq buffer-read-only t)
2474                (message "Password discarded in buffer %s"
2475                         (buffer-name (car buffers))))
2476               ))
2477       (setq buffers (cdr buffers)))
2478     (if keep-going
2479         (crypt-reset-passwd-timer))
2480     nil))
2481
2482 \f
2483 ;;; Originally `tek-symbol-alist-to-table' from tek-highlight.el.
2484 (defun crypt-symbol-alist-to-table (list)
2485   ;; Converts an alist of symbols to a table suitable for `completing-read.'
2486   ;; Called by `crypt-read-encoding-type'
2487   (mapcar (function (lambda (x) (list (symbol-name (car x)))))
2488           list))
2489
2490 (defun crypt-read-encoding-type ()
2491
2492   ;; Function called to query user for `crypt-buffer-encoding-type' uses
2493   ;; contents of `crypt-encoding-alist' and `crypt-default-encoding.'
2494
2495   ;; Use poor man's gmhist (i.e., we could have used gmhist's
2496   ;; `completing-read-with-history-in' instead).
2497   (let (
2498         ;; Find the encoding type desired by user.
2499         (type
2500          (completing-read
2501           (concat "encoding type (? for list): [" crypt-default-encoding "] ")
2502           (crypt-symbol-alist-to-table crypt-encoding-alist))))
2503
2504     ;; Test length of object returned by `completing-read'.
2505     (if (zerop (length type))
2506
2507         ;; Nothing there, i.e., user hit return -- use default.
2508         (setq crypt-buffer-encoding-type (intern crypt-default-encoding))
2509
2510       ;; Use the value from mini-buffer and update the default value.
2511       (setq crypt-buffer-encoding-type (intern type)
2512             crypt-default-encoding type))))
2513
2514 (defun crypt-encoded-mode (&optional arg)
2515
2516   "Toggle encoded mode.  With ARG, turn on iff positive, otherwise turn off.
2517 minor mode in which buffers are automatically encoded before being written.  if
2518 toggled then current buffer is marked modified, since it needs to be written
2519 with or without encoding.
2520
2521 Entering encoded mode causes auto-saving to be turned off in the current
2522 buffer, as there is no way in Emacs Lisp to force auto save files to be
2523 encoded."
2524
2525   (interactive "P")
2526
2527   ;; Set flag indicating whether or not `(crypt-encoded-mode)' was called
2528   ;; interactively.
2529   (setq crypt-buffer-interactive-encoded-mode (interactive-p))
2530
2531   ;; If called interactively then need to determine encoding type.
2532   (if (and crypt-buffer-interactive-encoded-mode
2533            (not crypt-buffer-encoding-type))
2534       (crypt-read-encoding-type))
2535
2536   ;; Save old value of `crypt-buffer-save-encoded'.
2537   (let ((oldval crypt-buffer-save-encoded))
2538
2539     ;; Set the variable `crypt-buffer-save-encoded' to t if the argument is
2540     ;; positive, otherwise toggle its current value.
2541     (setq crypt-buffer-save-encoded
2542           (if arg (> arg 0) (not crypt-buffer-save-encoded)))
2543
2544     ;; Set the variable generated by `(crypt-buffer-save-name)' to the value
2545     ;; stored in `crypt-buffer-save-encoded.'
2546     (set-variable (crypt-buffer-save-name crypt-buffer-encoding-type)
2547                   crypt-buffer-save-encoded)
2548
2549     (if crypt-buffer-save-encoded
2550         ;; We are going to save as encoded, we might turn off auto-saving.
2551         (progn
2552 ;; NEVER do this.  Turning off auto-saving is one thing.  But if there's
2553 ;; already an autosave for some other reason, what business does this
2554 ;; package have tampering with it?
2555 ;          ;; If an auto-save file already exists, then delete it.
2556 ;          (if (and (stringp buffer-auto-save-file-name)
2557 ;                   (file-exists-p buffer-auto-save-file-name))
2558 ;              (delete-file buffer-auto-save-file-name))
2559           ;; Turn-off auto-saving if crypt-encoded-disable-auto-save non-nil.
2560           (and crypt-encoded-disable-auto-save
2561                auto-save-default
2562                (progn
2563                  (auto-save-mode 0)
2564                  (if (eq crypt-encoded-disable-auto-save t)
2565                      (message "Auto-save off (in this buffer)")))))
2566
2567       ;; We are not going to save as encoded, we will turn on auto-saving but
2568       ;; only if we are editing a file and the default says we should.
2569       (auto-save-mode (if (and auto-save-default buffer-file-name) 1 0)))
2570
2571     ;; Have we toggled the mode?
2572
2573     ;; If yes, then mark buffer as modified.  If not, then leave
2574     ;; buffer-modified flag alone.
2575
2576     ;; The old code previously set the variable `set-buffer-modified-p' to a
2577     ;; value of t if there was a mode change and (unconditionally) to nil
2578     ;; if there was not a mode change.
2579
2580     ;; Modification suggested by: Gerd Hillebrand <ggh@cs.brown.edu>.
2581
2582     (if (not (eq oldval crypt-buffer-save-encoded))
2583         (set-buffer-modified-p t))))
2584
2585 \f
2586 ;;;; Additional encryption functions
2587
2588 ;; For Emacs V18 compatibility
2589 (and (not (fboundp 'buffer-disable-undo))
2590      (fboundp 'buffer-flush-undo)
2591      (fset 'buffer-disable-undo 'buffer-flush-undo))
2592
2593 (fset 'crypt-read-string-no-echo 'read-passwd)
2594
2595 (defun crypt-set-encryption-key (key &optional buffer)
2596
2597   "Set the encryption KEY, a string, for current buffer or optionally BUFFER.
2598 If buffer is in encrypted mode, then it is also marked as modified, since it
2599 needs to be saved with the new key."
2600
2601   (interactive
2602    (progn
2603      (barf-if-buffer-read-only)
2604      (list
2605       (if (eq crypt-encryption-type 'pgp-pub)
2606           "dummy-key"
2607         (crypt-read-string-no-echo
2608          (format "Encryption key for %s? [RET to ignore]: " (buffer-name))
2609          crypt-confirm-password)))))
2610
2611   ;; For security reasons we remove `(crypt-set-encryption-key "password")'
2612   ;; from the `command-history' list if called interactively.
2613   (if (interactive-p)
2614       (setq command-history (cdr command-history)))
2615
2616   (or buffer (setq buffer (current-buffer)))
2617
2618   (save-excursion
2619     (set-buffer buffer)
2620     (if (equal key crypt-buffer-encryption-key)
2621         (message "Key is identical to original, no change.")
2622
2623       (progn
2624         ;; jwz: destroy old string
2625         (if (and crypt-buffer-encryption-key
2626                  (not (eq crypt-buffer-encryption-key key)))
2627             (fillarray crypt-buffer-encryption-key 0))
2628         (setq crypt-buffer-encryption-key key)
2629
2630         ;; Don't touch the modify flag unless we're in `(crypt-encrypted-mode)'.
2631         (if crypt-buffer-save-encrypted
2632             (set-buffer-modified-p t))
2633
2634         (crypt-reset-passwd-timer)
2635         ))))
2636
2637 \f
2638 ;;;; Install hooks and mode indicators.
2639
2640 ;;; Check if mode indicators are not already installed and then prepend them.
2641 (and (not (assq 'crypt-buffer-save-encrypted minor-mode-alist))
2642      (setq minor-mode-alist (append crypt-minor-mode-alist minor-mode-alist)))
2643
2644 ;;; Install the hooks.
2645
2646 ;;; If add-hook isn't already defined overwrite it with our own.
2647 ;;; Note the `add-hook' function must take the optional APPEND argument.
2648 (if (not (fboundp 'add-hook))
2649     ;; No add-hook found.
2650     ;; Use `add-hook' from GNU Emacs v19.
2651     (defun add-hook (hook function &optional append)
2652       "Add to the value of HOOK the function FUNCTION.
2653 FUNCTION is not added if already present.
2654 FUNCTION is added (if necessary) at the beginning of the hook list
2655 unless the optional argument APPEND is non-nil, in which case
2656 FUNCTION is added at the end.
2657
2658 HOOK should be a symbol, and FUNCTION may be any valid function.  If
2659 HOOK is void, it is first set to nil.  If HOOK's value is a single
2660 function, it is changed to a list of functions."
2661       (or (boundp hook) (set hook nil))
2662       ;; If the hook value is a single function, turn it into a list.
2663       (let ((old (symbol-value hook)))
2664         (if (or (not (listp old)) (eq (car old) 'lambda))
2665             (set hook (list old))))
2666       (or (if (consp function)
2667               ;; Clever way to tell whether a given lambda-expression
2668               ;; is equal to anything in the hook.
2669               (let ((tail (assoc (cdr function) (symbol-value hook))))
2670                 (equal function tail))
2671             (memq function (symbol-value hook)))
2672           (set hook
2673                (if append
2674                    (nconc (symbol-value hook) (list function))
2675                  (cons function (symbol-value hook)))))))
2676
2677 ;;; Attach ourselves to the find-file-hooks and find-file-not-found-hooks.
2678 (add-hook 'find-file-hooks 'crypt-find-file-hook)
2679 (add-hook 'find-file-not-found-hooks 'crypt-find-file-hook)
2680
2681 ;; Take care when appending to write-file-hook.  User's version of add-hook
2682 ;; may not have APPEND option.  If it fails then do it by hand.  I wish
2683 ;; everyone would upgrade - lrd 8/31/93.
2684 (condition-case err
2685     (add-hook 'write-file-hooks 'crypt-write-file-hook t) ; *must* append this
2686   (error
2687    ;; Do it by hand.  Not as robust as `add-hook'.
2688
2689    ;; Contributed by Ken Laprade <laprade@trantor.harris-atd.com>
2690    ;; Really should use some sort of add-hook - 16 Feb 93 - KCL
2691    (or (and (listp write-file-hooks) (not (eq (car write-file-hooks) 'lambda)))
2692        (setq write-file-hooks (list write-file-hooks)))
2693
2694    (cond
2695     ((not (memq 'crypt-write-file-hook write-file-hooks))
2696      ;; make this hook last on purpose
2697      (setq write-file-hooks (append write-file-hooks
2698                                     (list 'crypt-write-file-hook)))))))
2699
2700 ;; In order that the tables and key-binding correctly reflect user's
2701 ;; preferences we add ourselves to the `after-init-hook' GNU Emacs v19 and
2702 ;; Lucid Emacs v 19.8 (or later) or `term-setup-hook' in Lucid Emacs v 19.7
2703 ;; (or earlier).  These are run *after* ~/.emacs and ../lisp/default.el are
2704 ;; loaded.  Unfortunately, v18 does not have `after-init-hook' and
2705 ;; `term-setup-hook' is just a single function.  It is a bit of a pain trying
2706 ;; to work our functions in properly without overwriting the user's value.
2707 ;; Therefore, we do nothing and hope they upgrade to v19 soon.
2708
2709 (cond ((boundp 'after-init-hook)
2710        ;; Must be running GNU Emacs v19 :->
2711        (add-hook 'after-init-hook 'crypt-rebuild-tables)
2712        (add-hook 'after-init-hook 'crypt-rebuild-minor-modes-alist)
2713        (add-hook 'after-init-hook 'crypt-bind-insert-file))
2714
2715       ((and (string-match "^19" emacs-version) t)
2716        ;; Probably running Lucid Emacs v19.7 (or earlier) since it,
2717        ;; unfortunately, does not have `after-init-hook'.  Use
2718        ;; `term-setup-hook' instead and hope they upgrade to Lucid 19.8 or GNU
2719        ;; Emacs 19.
2720        (add-hook 'term-setup-hook 'crypt-rebuild-tables)
2721        (add-hook 'term-setup-hook 'crypt-rebuild-minor-modes-alist)
2722        (add-hook 'term-setup-hook 'crypt-bind-insert-file)))
2723
2724 \f
2725 ;;; Code for conditionally decoding/decrypting an inserted file
2726
2727 (defcustom crypt-bind-insert-file t
2728   "*t value means bind `crypt-insert-file' over `insert-file'.
2729 If you wish to change this variable after crypt++ has been loaded then do
2730 \\[crypt-bind-insert-file]."
2731   :type 'boolean
2732   :group 'crypt)
2733
2734 (defcustom crypt-auto-decode-insert nil
2735   "*t says decode/decrypt files that are inserted with `crypt-insert-file'.
2736 nil says to ask before doing this."
2737   :type 'boolean
2738   :group 'crypt)
2739
2740 ;;; Bind `crypt-insert-file' over wherever `insert-file' is bound?
2741 (defun crypt-bind-insert-file ()
2742   "Bind `crypt-insert-file' in place of `insert-file' or reverse based on
2743 `crypt-bind-insert-file'.  Part of `after-init-hook'."
2744
2745   (interactive)
2746
2747   (if (interactive-p)
2748       (setq crypt-bind-insert-file
2749             (y-or-n-p "Bind crypt-insert-file over insert-file? ")))
2750
2751   (if crypt-bind-insert-file
2752       (substitute-key-definition
2753        'insert-file 'crypt-insert-file (current-global-map))
2754     (substitute-key-definition
2755      'crypt-insert-file 'insert-file (current-global-map))))
2756
2757 ;;; Now call it.
2758 (crypt-bind-insert-file)
2759
2760 ;;; crypt++ replacement for `insert-file'
2761 (defun crypt-insert-file (filename &optional codesys)
2762   "Insert decoded/decrypted contents of file FILENAME into buffer after point.
2763 Set mark after the inserted text.
2764
2765 Under XEmacs/Mule, optional second argument specifies the
2766 coding system to use when decoding the file.  Interactively,
2767 with a prefix argument, you will be prompted for the coding system.
2768
2769 This function is meant for the user to run interactively.
2770 Don't call it from programs!  Use `insert-file-contents' instead.
2771 \(Its calling sequence is different; see its documentation\).
2772
2773 This version will attempt to decrypt and/or decode file before inserting.
2774 see variable `crypt-auto-decode-insert'."
2775   (interactive "*fInsert file: \nZCoding system: ")
2776   (if (file-directory-p filename)
2777       (signal 'file-error (list "Opening input file" "file is a directory"
2778                                 filename)))
2779   (let* (format-alist ; format.el only confuses people in this context
2780          (tem
2781          (if codesys
2782              (let ((coding-system-for-read
2783                     (get-coding-system codesys)))
2784                (crypt-insert-file-contents filename))
2785            (crypt-insert-file-contents filename))))
2786     (push-mark (+ (point) (car (cdr tem))))))
2787
2788 ;; Similar to `insert-file-contents' except decoding/decrypting of FILE
2789 ;; attempted.  See `crypt-insert-file' and `crypt-auto-decode-insert'
2790 ;;
2791 (defun crypt-insert-file-contents (file)
2792   (let (temp-buffer
2793         temp-list
2794         (crypt-auto-decode-buffer crypt-auto-decode-insert)
2795         (orig-buffer (current-buffer)))
2796
2797     ;; Create a temporary buffer and decode and decrypt it.
2798     (save-excursion
2799
2800       ;; Temporary buffer, use the same name as the file to be inserted.
2801       (setq temp-buffer (generate-new-buffer (file-name-nondirectory file)))
2802       (set-buffer temp-buffer)
2803
2804       ;; Original insert-file-contents - save list.
2805       (setq temp-list (insert-file-contents file nil))
2806
2807       ;; Make temp-buffer unmodified.
2808       (set-buffer-modified-p nil)
2809
2810       ;; Need to set buffer name to file name for crypt++.
2811       (setq buffer-file-name file)
2812
2813       ;; Decode and decrypt, if necessary.
2814       (crypt-find-file-hook)
2815
2816       ;; Find the length of the file to be inserted. `insert-file-contents'
2817       ;; returns it for the original encoded/encrypted file.
2818       (setcdr temp-list (cons (buffer-size) ()))
2819
2820       ;; Now insert temp-buffer into original buffer.
2821       (set-buffer orig-buffer)
2822       (insert-buffer temp-buffer)
2823
2824       ;; Kill the temporary buffer.
2825       (kill-buffer temp-buffer))
2826
2827     ;; Return modified list from `insert-file-contents'.
2828     temp-list))
2829
2830 \f
2831 ;;;; BUG REPORTS
2832
2833 ;;; This section is provided for reports.
2834 ;;; Using Barry A. Warsaw's reporter.el
2835
2836 (defconst crypt-version "2.94"
2837   "Revision number of crypt++.el -- handles compressed and encrypted files.
2838 Type \\[crypt-submit-report] to send a bug report.  Available via anonymous
2839 +ftp at ftp://ftp.cs.umb.edu/pub/misc/crypt++.el")
2840
2841 (defconst crypt-help-address
2842   "xemacs-beta@xemacs.org"
2843   "Address(es) accepting submission of reports on crypt++.el.")
2844
2845 (defconst crypt-maintainer "XEmacs Developers"
2846   "First name(s) of people accepting submission of reports on crypt++.el.")
2847
2848 (defconst crypt-file "crypt.el"
2849   "Name of file containing emacs lisp code.")
2850
2851 (defconst crypt-variable-list
2852   (list 'shell-file-name ; These
2853         'load-path       ; are
2854         'exec-path       ; useful.
2855         'crypt-encryption-type
2856         'crypt-encryption-file-extension
2857         'crypt-never-ever-decrypt
2858         'crypt-auto-write-buffer-encrypted
2859         'crypt-confirm-password
2860         'crypt-encrypted-disable-auto-save
2861         'crypt-auto-decode-buffer
2862         'crypt-auto-write-buffer
2863         'crypt-query-if-interactive
2864         'crypt-no-extension-implies-plain
2865         'crypt-freeze-vs-fortran
2866         'crypt-compact-vs-C++
2867         'crypt-ignored-filenames
2868         'crypt-default-encoding
2869         'crypt-encoded-disable-auto-save
2870         'crypt-bind-insert-file
2871         'crypt-auto-decode-insert
2872         'crypt-encoding-alist
2873         'crypt-encryption-alist
2874         )
2875   "List of variables to be appended to reports sent by `crypt-submit-report.'")
2876
2877 (defun crypt-submit-report ()
2878   "Submit via reporter.el a bug report on program.  Send report on `crypt-file'
2879 version `crypt-version,' to `crypt-maintainer' at address `crypt-help-address'
2880 listing variables `crypt-variable-list' in the message."
2881   (interactive)
2882
2883   ;; In case we can't find reporter...
2884   (condition-case err
2885       (progn
2886         ;; Get it if we can.
2887         (require 'reporter)
2888
2889         (reporter-submit-bug-report
2890          crypt-help-address                     ; address
2891          (concat crypt-file " " crypt-version)  ; pkgname
2892          crypt-variable-list                    ; varlist
2893          nil nil                                ; pre-hooks and post-hooks
2894          (concat "Yo! " crypt-maintainer ","))) ; salutation
2895
2896     ;; ...fail gracefully.
2897     (error
2898      (beep)
2899
2900      ;; Do they have ange-ftp?
2901      (if (and (featurep 'ange-ftp)
2902               (y-or-n-p (concat "Sorry, reporter.el not found.  "
2903                                 "Can I ange-ftp it for you? ")))
2904
2905          ;; Yes.  Then Ange-ftp a copy.
2906          (let ((ange-ftp-generate-anonymous-password t))
2907            ;; Might want to use the elisp archive official site?  But
2908            ;; then it would have to be uncompressed, etc. Ick!
2909            (find-file-other-window
2910 "/anonymous@archive.cis.ohio-state.edu:/pub/gnu/emacs/elisp-archive/misc/reporter.el.Z")
2911            (eval-current-buffer)
2912            (message (concat "Save reporter.el somewhere in `load-path' "
2913                             "and try again.")))
2914
2915        ;; No ange-ftp.
2916        (message "Sorry, reporter.el not found.")
2917        (sit-for 3)
2918        (message "Get it from archive.cis.ohio-state.edu.")))))
2919
2920 \f
2921 ;;; Provide the many forms of this package.
2922 (provide 'crypt+pgp-pub)
2923 (provide 'crypt++)
2924 (provide 'crypt)
2925
2926 ;;; crypt++.el ends here.