cgit.sxemacs.org Git - packages/blob - xemacs-packages/mailcrypt/mailcrypt.el

   1 ;; mailcrypt.el v3.5.6, mail encryption with PGP
   2 ;; Copyright (C) 1995  Jin Choi <jin@atype.com>
   3 ;;                     Patrick LoPresti <patl@lcs.mit.edu>
   4 ;;           (C) 1998  Len Budney <lbudney@pobox.com>
   5 ;;           (C) 2001  Brian Warner <warner@lothar.com>
   6 ;; Any comments or suggestions welcome.
   7 ;; Inspired by pgp.el, by Gray Watson <gray@antaire.com>.
   8
   9 ;;{{{ Licensing
  10 ;; This file is intended to be used with GNU Emacs.
  11
  12 ;; This program is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; This program is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  24 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  25 ;;}}}
  26
  27 ;;{{{ Load some required packages
  28
  29 (eval-when-compile
  30   ;; Quiet warnings
  31   (autoload 'start-itimer "itimer")
  32   (autoload 'cancel-itimer "itimer")
  33   (autoload 'delete-itimer "itimer"))
  34
  35 (require 'easymenu)
  36 (require 'comint)
  37 (require 'rfc822)
  38
  39 (eval-and-compile
  40   (condition-case nil (require 'itimer) (error nil))
  41   (if (not (featurep 'itimer))
  42       (condition-case nil (require 'timer) (error nil)))
  43
  44   (if (not (fboundp 'buffer-substring-no-properties))
  45       (fset 'buffer-substring-no-properties 'buffer-substring)))
  46
  47 (defconst mc-xemacs-p (string-match "XEmacs" emacs-version))
  48
  49 (autoload 'mc-decrypt "mc-toplev" nil t)
  50 (autoload 'mc-verify "mc-toplev" nil t)
  51 (autoload 'mc-snarf "mc-toplev" nil t)
  52 (autoload 'mc-pgp-fetch-key "mc-pgp" nil t)
  53 (autoload 'mc-encrypt "mc-toplev" nil t)
  54 (autoload 'mc-sign "mc-toplev" nil t)
  55 (autoload 'mc-insert-public-key "mc-toplev" nil t)
  56 (autoload 'mc-remailer-encrypt-for-chain "mc-remail" nil t)
  57 (autoload 'mc-remailer-insert-response-block "mc-remail" nil t)
  58 (autoload 'mc-remailer-insert-pseudonym "mc-remail" nil t)
  59 (autoload 'mc-setversion "mc-setversion" nil t)
  60
  61 ;;}}}
  62
  63 ;;{{{ Minor mode variables and functions
  64
  65 (defvar mc-pgp-always-sign nil
  66   "*If t, always sign encrypted PGP messages, or never sign if 'never.")
  67
  68 (defvar mc-read-mode nil
  69   "Non-nil means Mailcrypt read mode key bindings are available.")
  70
  71 (defvar mc-write-mode nil
  72   "Non-nil means Mailcrypt write mode key bindings are available.")
  73
  74 (make-variable-buffer-local 'mc-read-mode)
  75 (make-variable-buffer-local 'mc-write-mode)
  76
  77 (defvar mc-read-mode-string " MC-r"
  78   "*String to put in mode line when Mailcrypt read mode is active.")
  79
  80 (defvar mc-write-mode-string " MC-w"
  81   "*String to put in mode line when Mailcrypt write mode is active.")
  82
  83 (defvar mc-read-mode-map nil
  84   "Keymap for Mailcrypt read mode bindings.")
  85
  86 (defvar mc-write-mode-map nil
  87   "Keymap for Mailcrypt write mode bindings.")
  88
  89 (or mc-read-mode-map
  90     (progn
  91       (setq mc-read-mode-map (make-sparse-keymap))
  92       (define-key mc-read-mode-map "\C-c/f" 'mc-deactivate-passwd)
  93       (define-key mc-read-mode-map "\C-c/d" 'mc-decrypt)
  94       (define-key mc-read-mode-map "\C-c/v" 'mc-verify)
  95       (define-key mc-read-mode-map "\C-c/a" 'mc-snarf)
  96       (define-key mc-read-mode-map "\C-c/k" 'mc-pgp-fetch-key)))
  97
  98 (or mc-write-mode-map
  99     (progn
 100       (setq mc-write-mode-map (make-sparse-keymap))
 101       (define-key mc-write-mode-map "\C-c/f" 'mc-deactivate-passwd)
 102       (define-key mc-write-mode-map "\C-c/e" 'mc-encrypt)
 103       (define-key mc-write-mode-map "\C-c/s" 'mc-sign)
 104       (define-key mc-write-mode-map "\C-c/x" 'mc-insert-public-key)
 105       (define-key mc-write-mode-map "\C-c/k" 'mc-pgp-fetch-key)
 106       (define-key mc-write-mode-map "\C-c/r"
 107         'mc-remailer-encrypt-for-chain)
 108       (define-key mc-write-mode-map "\C-c/b"
 109         'mc-remailer-insert-response-block)
 110       (define-key mc-write-mode-map "\C-c/p"
 111         'mc-remailer-insert-pseudonym)))
 112
 113 (easy-menu-define
 114  mc-read-mode-menu (if mc-xemacs-p nil (list mc-read-mode-map))
 115  "Mailcrypt read mode menu."
 116  '("Mailcrypt"
 117    ["Decrypt Message" mc-decrypt t]
 118    ["Verify Signature" mc-verify t]
 119    ["Snarf Keys" mc-snarf t]
 120    ["Fetch Key" mc-pgp-fetch-key t]
 121    ["Forget Passphrase(s)" mc-deactivate-passwd t]))
 122
 123 (easy-menu-define
 124  mc-write-mode-menu (if mc-xemacs-p nil (list mc-write-mode-map))
 125  "Mailcrypt write mode menu."
 126  '("Mailcrypt"
 127    ["Encrypt Message" mc-encrypt t]
 128    ["Sign Message" mc-sign t]
 129    ["Insert Public Key" mc-insert-public-key t]
 130    ["Fetch Key" mc-pgp-fetch-key t]
 131    ["Encrypt for Remailer(s)" mc-remailer-encrypt-for-chain t]
 132    ["Insert Pseudonym" mc-remailer-insert-pseudonym t]
 133    ["Insert Response Block" mc-remailer-insert-response-block t]
 134    ["Forget Passphrase(s)" mc-deactivate-passwd t]))
 135
 136 (or (assq 'mc-read-mode minor-mode-map-alist)
 137     (setq minor-mode-map-alist
 138           (cons (cons 'mc-read-mode mc-read-mode-map)
 139                 minor-mode-map-alist)))
 140
 141 (or (assq 'mc-write-mode minor-mode-map-alist)
 142     (setq minor-mode-map-alist
 143           (cons (cons 'mc-write-mode mc-write-mode-map)
 144                 minor-mode-map-alist)))
 145
 146 (or (assq 'mc-read-mode minor-mode-alist)
 147     (setq minor-mode-alist
 148           (cons '(mc-read-mode mc-read-mode-string) minor-mode-alist)))
 149
 150 (or (assq 'mc-write-mode minor-mode-alist)
 151     (setq minor-mode-alist
 152           (cons '(mc-write-mode mc-write-mode-string) minor-mode-alist)))
 153
 154 (defun mc-read-mode (&optional arg)
 155   "\nMinor mode for interfacing with cryptographic functions.
 156 \\<mc-read-mode-map>
 157 \\[mc-decrypt]\t\tDecrypt an encrypted message
 158 \\[mc-verify]\t\tVerify signature on a clearsigned message
 159 \\[mc-snarf]\t\tAdd public key(s) to keyring
 160 \\[mc-pgp-fetch-key]\t\tFetch a PGP key via finger or HTTP
 161 \\[mc-deactivate-passwd]\t\tForget passphrase(s)\n"
 162   (interactive)
 163   (setq mc-read-mode
 164         (if (null arg) (not mc-read-mode)
 165           (> (prefix-numeric-value arg) 0)))
 166   (and mc-read-mode mc-write-mode (mc-write-mode nil))
 167   (if mc-read-mode
 168       (easy-menu-add mc-read-mode-menu)
 169     (easy-menu-remove mc-read-mode-menu)))
 170
 171 (defun mc-write-mode (&optional arg)
 172   "\nMinor mode for interfacing with cryptographic functions.
 173 \\<mc-write-mode-map>
 174 \\[mc-encrypt]\t\tEncrypt (and optionally sign) message
 175 \\[mc-sign]\t\tClearsign message
 176 \\[mc-insert-public-key]\t\tExtract public key from keyring and insert into message
 177 \\[mc-pgp-fetch-key]\t\tFetch a PGP key via finger or HTTP
 178 \\[mc-remailer-encrypt-for-chain]\t\tEncrypt message for remailing
 179 \\[mc-remailer-insert-pseudonym]\t\tInsert a pseudonym (for remailing)
 180 \\[mc-remailer-insert-response-block]\t\tInsert a response block (for remailing)
 181 \\[mc-deactivate-passwd]\t\tForget passphrase(s)\n"
 182   (interactive)
 183   (setq mc-write-mode
 184         (if (null arg) (not mc-write-mode)
 185           (> (prefix-numeric-value arg) 0)))
 186   (and mc-write-mode mc-read-mode (mc-read-mode nil))
 187   (if mc-write-mode
 188       (easy-menu-add mc-write-mode-menu)
 189     (easy-menu-remove mc-write-mode-menu)))
 190
 191 (defun mc-install-read-mode ()
 192   (interactive)
 193   (mc-read-mode 1))
 194
 195 (defun mc-install-write-mode ()
 196   (interactive)
 197   (mc-write-mode 1))
 198
 199 ;;}}}
 200
 201 ;;{{{ Note:
 202 ;; The funny triple braces you see are used by `folding-mode', a minor
 203 ;; mode by Jamie Lokier, available from the elisp archive.
 204 ;;}}}
 205
 206 ;;{{{ User variables.
 207 (defconst mc-version "3.5.8")
 208 (defvar mc-temp-directory
 209   (cond ((fboundp 'temp-directory) (temp-directory))
 210         ((boundp 'temporary-file-directory) temporary-file-directory)
 211         ("/tmp/"))
 212   "*Default temp directory to be used by Mailcrypt.")
 213 (defvar mc-default-scheme 'mc-scheme-pgp "*Default encryption scheme to use.")
 214 (defvar mc-passwd-timeout 60
 215   "*Time to deactivate password in seconds after a use.
 216 nil or 0 means deactivate immediately.  If the only timer package available
 217 is the 'timer' package, then this can be a string in timer format.")
 218
 219 (defvar mc-ripem-user-id (or (getenv "RIPEM_USER_NAME")
 220                              (user-full-name) "*Your RIPEM user ID."))
 221
 222 (defvar mc-always-replace nil
 223   "*If t, decrypt mail messages in place without prompting.
 224
 225 If 'never, always use a viewer instead of replacing.")
 226
 227 (defvar mc-use-default-recipients nil "*Assume that the message should
 228   be encoded for everyone listed in the To, Cc, and Bcc fields.")
 229
 230 (defvar mc-encrypt-for-me nil "*Encrypt all outgoing messages with
 231   user's public key.")
 232
 233 (defvar mc-pre-signature-hook nil
 234   "*List of hook functions to run immediately before signing.")
 235 (defvar mc-post-signature-hook nil
 236   "*List of hook functions to run immediately after signing.")
 237 (defvar mc-pre-encryption-hook nil
 238   "*List of hook functions to run immediately before encrypting.")
 239 (defvar mc-post-encryption-hook nil
 240   "*List of hook functions to run after encrypting.")
 241 (defvar mc-pre-decryption-hook nil
 242   "*List of hook functions to run immediately before decrypting.")
 243 (defvar mc-post-decryption-hook nil
 244   "*List of hook functions to run after decrypting.")
 245
 246 (defconst mc-buffer-name "*MailCrypt*"
 247   "Name of temporary buffer for mailcrypt")
 248
 249 (defvar mc-modes-alist
 250   '((rmail-mode (decrypt . mc-rmail-decrypt-message)
 251                 (verify . mc-rmail-verify-signature))
 252     (rmail-summary-mode (decrypt . mc-rmail-summary-decrypt-message)
 253                         (verify . mc-rmail-summary-verify-signature)
 254                         (snarf . mc-rmail-summary-snarf-keys))
 255     (mew-draft-mode (encrypt . mc-encrypt-message)
 256                     (sign . mc-sign-message))
 257     (mew-message-mode (decrypt . mc-mew-decrypt-message))
 258     (mew-summary-mode (decrypt . mc-mew-summary-decrypt-message)
 259                       (verify . mc-mew-summary-verify-signature)
 260                       (snarf . mc-mew-summary-snarf-keys))
 261     (vm-mode (decrypt . mc-vm-decrypt-message)
 262              (verify . mc-vm-verify-signature)
 263              (snarf . mc-vm-snarf-keys))
 264     (vm-virtual-mode (decrypt . mc-vm-decrypt-message)
 265                      (verify . mc-vm-verify-signature)
 266                      (snarf . mc-vm-snarf-keys))
 267     (vm-summary-mode (decrypt . mc-vm-decrypt-message)
 268                      (verify . mc-vm-verify-signature)
 269                      (snarf . mc-vm-snarf-keys))
 270     (mh-folder-mode (decrypt . mc-mh-decrypt-message)
 271                     (verify . mc-mh-verify-signature)
 272                     (snarf . mc-mh-snarf-keys))
 273     (message-mode (encrypt . mc-encrypt-message)
 274                   (sign . mc-sign-message))
 275     (gnus-summary-mode (decrypt . mc-gnus-decrypt-message)
 276                        (verify . mc-gnus-verify-signature)
 277                        (snarf . mc-gnus-snarf-keys))
 278     (gnus-article-mode (decrypt . mc-gnus-decrypt-message)
 279                        (verify . mc-gnus-verify-signature)
 280                        (snarf . mc-gnus-snarf-keys))
 281     (mail-mode (encrypt . mc-encrypt-message)
 282                (sign . mc-sign-message))
 283     (vm-mail-mode (encrypt . mc-encrypt-message)
 284                   (sign . mc-sign-message))
 285     (mh-letter-mode (encrypt . mc-encrypt-message)
 286                     (sign . mc-sign-message))
 287     (news-reply-mode (encrypt . mc-encrypt-message)
 288                      (sign . mc-sign-message)))
 289
 290   "Association list (indexed by major mode) of association lists
 291 (indexed by operation) of functions to call for each major mode.")
 292
 293 ;;}}}
 294 ;;{{{ Program variables and constants.
 295
 296 (defvar mc-timer nil "Timer object for password deactivation.")
 297
 298 (defvar mc-passwd-cache nil "Cache for passphrases.")
 299
 300 (defvar mc-schemes '(("pgp50" . mc-scheme-pgp50)
 301                      ("pgp" . mc-scheme-pgp)
 302                      ("gpg" . mc-scheme-gpg)
 303                      ))
 304
 305 ;;}}}
 306
 307 ;;{{{ Utility functions.
 308
 309 (defun mc-message-delimiter-positions (start-re end-re &optional begin)
 310   ;; Returns pair of integers (START . END) that delimit message marked off
 311   ;; by the regular expressions start-re and end-re. Optional argument BEGIN
 312   ;; determines where we should start looking from.
 313   (setq begin (or begin (point-min)))
 314   (let (start)
 315     (save-excursion
 316       (goto-char begin)
 317       (and (re-search-forward start-re nil t)
 318            (setq start (match-beginning 0))
 319            (re-search-forward end-re nil t)
 320            (cons start (point))))))
 321
 322
 323 (defun mc-split (regexp str)
 324   "Splits STR into a list of elements which were separated by REGEXP,
 325 stripping initial and trailing whitespace."
 326   (let ((data (match-data))
 327         (retval '())
 328         beg end)
 329     (unwind-protect
 330         (progn
 331           (string-match "[ \t\n]*" str) ; Will always match at 0
 332           (setq beg (match-end 0))
 333           (setq end (string-match "[ \t\n]*\\'" str))
 334           (while (string-match regexp str beg)
 335             (setq retval
 336                   (cons (substring str beg (match-beginning 0))
 337                         retval))
 338             (setq beg (match-end 0)))
 339           (if (not (= (length str) beg)) ; Not end
 340               (setq retval (cons (substring str beg end) retval)))
 341           (nreverse retval))
 342       (store-match-data data))))
 343
 344 ;;; FIXME - Function never called?
 345 ;(defun mc-temp-display (beg end &optional name)
 346 ;  (let (tmp)
 347 ;    (if (not name)
 348 ;       (setq name mc-buffer-name))
 349 ;    (if (string-match name "*ERROR*")
 350 ;       (progn
 351 ;         (message "mailcrypt: An error occured!  See *ERROR* buffer.")
 352 ;         (beep)))
 353 ;    (setq tmp (buffer-substring beg end))
 354 ;    (delete-region beg end)
 355 ;    (save-excursion
 356 ;      (save-window-excursion
 357 ;       (with-output-to-temp-buffer name
 358 ;         (princ tmp))))))
 359
 360 ;; In case I ever decide to do this right.
 361 ;; LRB - Thanks Pat! This helped a lot in updating mixmaster support.
 362 ;; mc-field-name-regexp now catches precisely those email headers
 363 ;; which are RFC-822 compliant.
 364 (defconst mc-field-name-regexp
 365   (concat
 366    "^\\(["
 367    (char-to-string 33) "-" (char-to-string 57)
 368    (char-to-string 59) "-" (char-to-string 126)
 369    "]*\\)"))
 370 (defconst mc-field-body-regexp "\\(.*\\(\n[ \t].*\\)*\n\\)")
 371
 372 (defun mc-get-fields (&optional matching bounds nuke)
 373   "Get all header fields within BOUNDS.  Return as an
 374 alist ((FIELD-NAME . FIELD-BODY) (FIELD-NAME . FIELD-BODY) ...).
 375
 376 Argument MATCHING, if present, is a regexp which each FIELD-NAME
 377 must match exactly.  Matching is case-insensitive.
 378
 379 Optional arg NUKE, if non-nil, means eliminate all fields returned."
 380   (save-excursion
 381     (save-restriction
 382       (let ((case-fold-search t)
 383             (header-field-regexp
 384              (concat mc-field-name-regexp ":" mc-field-body-regexp))
 385             ret name body field-start field-end)
 386         ;; Ensure exact match
 387         (if matching
 388             (setq matching (concat "^\\(" matching "\\)$")))
 389
 390         (if bounds
 391             (narrow-to-region (car bounds) (cdr bounds)))
 392
 393         (goto-char (point-max))
 394
 395         (while (re-search-backward header-field-regexp nil 'move)
 396           (setq field-start (match-beginning 0))
 397           (setq field-end (match-end 0))
 398           (setq name (buffer-substring-no-properties
 399                       (match-beginning 1) (match-end 1)))
 400           (setq body (buffer-substring-no-properties
 401                       (match-beginning 2) (match-end 2)))
 402           (if (or (null matching) (string-match matching name))
 403               (progn
 404                 (setq ret (cons (cons name body) ret))
 405                 (if nuke
 406                     (delete-region field-start field-end)))))
 407         ret))))
 408
 409 (defsubst mc-strip-address (addr)
 410   "Strip everything from ADDR except the basic Email address."
 411   (car (rfc822-addresses addr)))
 412
 413 (defun mc-strip-addresses (addr-list)
 414   "Strip everything from the addresses in ADDR-LIST except the basic
 415 Email address.  ADDR-LIST may be a single string or a list of strings."
 416   (if (not (listp addr-list)) (setq addr-list (list addr-list)))
 417   (setq addr-list
 418         (mapcar
 419          (function (lambda (s) (rfc822-addresses s)))
 420          addr-list))
 421   (setq addr-list (apply 'append addr-list))
 422   (mapconcat 'mc-strip-address addr-list ", "))
 423
 424 (defun mc-display-buffer (buffer)
 425   "Like display-buffer, but always display top of the buffer."
 426   (save-excursion
 427     (set-buffer buffer)
 428     (goto-char (point-min))
 429     (display-buffer buffer)))
 430
 431 (defun mc-message (msg &optional buffer default)
 432   ;; returns t if we used msg, nil if we used default
 433   (let ((retval t))
 434     (if buffer
 435         (setq msg
 436               (save-excursion
 437                 (set-buffer buffer)
 438                 (goto-char (point-min))
 439                 (if (re-search-forward msg nil t)
 440                     (buffer-substring-no-properties
 441                      (match-beginning 0) (match-end 0))
 442                   (setq retval nil)
 443                   default))))
 444     (if msg (message-or-box "%s" msg))
 445     retval))
 446
 447 (defun mc-message-sigstatus (msg &optional attention)
 448   "Emit a signature status line. If ATTENTION is non-nil, be noisy about it."
 449   ;; this function exists to be overridden by the unit tests
 450   (if attention (ding))
 451   (message-or-box "%s" msg)
 452 )
 453
 454 (defun mc-process-region (beg end passwd program args parser &optional buffer)
 455   (let ((obuf (current-buffer))
 456         (process-connection-type nil)
 457         mybuf result rgn proc)
 458     (unwind-protect
 459         (progn
 460           (setq mybuf (or buffer (generate-new-buffer " *mailcrypt temp")))
 461           (set-buffer mybuf)
 462           (erase-buffer)
 463           (set-buffer obuf)
 464           (buffer-disable-undo mybuf)
 465           (setq proc
 466                 (apply 'start-process "*PGP*" mybuf program args))
 467           (if passwd
 468               (progn
 469                 (process-send-string proc (concat passwd "\n"))
 470                 (or mc-passwd-timeout (mc-deactivate-passwd t))))
 471           (process-send-region proc beg end)
 472           (process-send-eof proc)
 473           (while (eq 'run (process-status proc))
 474             (accept-process-output proc 5))
 475           (setq result (process-exit-status proc))
 476           ;; Hack to force a status_notify() in Emacs 19.29
 477           (delete-process proc)
 478           (set-buffer mybuf)
 479           (goto-char (point-max))
 480           (if (re-search-backward "\nProcess \\*PGP.*\n\\'" nil t)
 481               (delete-region (match-beginning 0) (match-end 0)))
 482           (goto-char (point-min))
 483           ;; CRNL -> NL
 484           (while (search-forward "\r\n" nil t)
 485             (replace-match "\n"))
 486           ;; Hurm.  FIXME; must get better result codes.
 487           (if (stringp result)
 488               (error "%s exited abnormally: '%s'" program result)
 489             (setq rgn (funcall parser result))
 490             ;; If the parser found something, migrate it
 491             (if (consp rgn)
 492                 (progn
 493                   (set-buffer obuf)
 494                   (delete-region beg end)
 495                   (goto-char beg)
 496                   (insert-buffer-substring mybuf (car rgn) (cdr rgn))
 497                   (set-buffer mybuf)
 498                   (delete-region (car rgn) (cdr rgn)))))
 499           ;; Return nil on failure and exit code on success
 500           (if rgn result))
 501       ;; Cleanup even on nonlocal exit
 502       (if (and proc (eq 'run (process-status proc)))
 503           (interrupt-process proc))
 504       (set-buffer obuf)
 505       (or buffer (null mybuf) (kill-buffer mybuf)))))
 506
 507 ;;}}}
 508
 509 ;;{{{ Passphrase management
 510 (defun mc-activate-passwd (id &optional prompt)
 511   "Activate the passphrase matching ID, using PROMPT for a prompt.
 512 Return the passphrase.  If PROMPT is nil, only return value if cached."
 513   (cond ((featurep 'itimer)
 514          (if mc-timer (delete-itimer mc-timer))
 515          (setq mc-timer (if mc-passwd-timeout
 516                             (start-itimer "mc-itimer"
 517                                           'mc-deactivate-passwd
 518                                           mc-passwd-timeout)
 519                           nil)))
 520         ((featurep 'timer)
 521          (let ((string-time (if (integerp mc-passwd-timeout)
 522                                 (format "%d sec" mc-passwd-timeout)
 523                               mc-passwd-timeout)))
 524            (if mc-timer (cancel-timer mc-timer))
 525            (setq mc-timer (if string-time
 526                               (run-at-time string-time
 527                                            nil 'mc-deactivate-passwd)
 528                             nil)))))
 529   (let ((cell (assoc id mc-passwd-cache))
 530         passwd)
 531     (setq passwd (cdr-safe cell))
 532     (if (and (not passwd) prompt)
 533         (setq passwd (comint-read-noecho prompt)))
 534     (if cell
 535         (setcdr cell passwd)
 536       (setq mc-passwd-cache (cons (cons id passwd) mc-passwd-cache)))
 537     passwd))
 538
 539 (defun mc-deactivate-passwd (&optional inhibit-message)
 540   "*Deactivate the passphrase cache."
 541   (interactive)
 542   (if mc-timer
 543       (cond ((featurep 'itimer) (delete-itimer mc-timer))
 544             ((featurep 'timer) (cancel-timer mc-timer))))
 545   (mapcar
 546    (function
 547     (lambda (cell)
 548       (if (stringp (cdr-safe cell)) (fillarray (cdr cell) 0))
 549       (setcdr cell nil)))
 550    mc-passwd-cache)
 551   (or inhibit-message
 552       (not (interactive-p))
 553       (message "Passphrase%s deactivated"
 554                (if (> (length mc-passwd-cache) 1) "s" ""))))
 555
 556 ;;}}}
 557
 558 ;;{{{ Define several aliases so that an apropos on `mailcrypt' will
 559 ;; return something.
 560 (defalias 'mailcrypt-encrypt 'mc-encrypt)
 561 (defalias 'mailcrypt-decrypt 'mc-decrypt)
 562 (defalias 'mailcrypt-sign 'mc-sign)
 563 (defalias 'mailcrypt-verify 'mc-verify)
 564 (defalias 'mailcrypt-insert-public-key 'mc-insert-public-key)
 565 (defalias 'mailcrypt-snarf 'mc-snarf)
 566 ;;}}}
 567
 568 (provide 'mailcrypt)