home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / mailcrypt / mc-toplev.el < prev    next >
Encoding:
Text File  |  1995-08-02  |  19.2 KB  |  642 lines
  1. ;; mc-toplev.el, entry point functions for Mailcrypt
  2. ;; Copyright (C) 1995  Jin Choi <jsc@mit.edu>
  3. ;;                     Patrick LoPresti <patl@lcs.mit.edu>
  4.  
  5. ;;{{{ Licensing
  6. ;; This file is intended to be used with GNU Emacs.
  7.  
  8. ;; This program is free software; you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation; either version 2, or (at your option)
  11. ;; any later version.
  12.  
  13. ;; This program is distributed in the hope that it will be useful,
  14. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. ;; GNU General Public License for more details.
  17.  
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  20. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  21. ;;}}}
  22. ;;{{{ Load some required packages
  23. (require 'mailcrypt)
  24. (require 'mail-utils)
  25.  
  26. (eval-when-compile
  27.   ;; RMAIL
  28.   (condition-case nil (require 'rmail) (error nil))
  29.   (autoload 'rmail-abort-edit "rmailedit")
  30.   (autoload 'rmail-cease-edit "rmailedit")
  31.   ;; Is this a good idea?
  32.   (defvar rmail-buffer nil)
  33.  
  34.   ;; VM
  35.   (condition-case nil (require 'vm) (error nil))
  36.  
  37.   ;; GNUS
  38.   (condition-case nil (require 'gnus) (error nil))
  39.  
  40.   ;; MH-E
  41.   (condition-case nil (require 'mh-e) (error nil)))
  42.  
  43. (eval-and-compile
  44.   (condition-case nil (require 'mailalias) (error nil)))
  45.  
  46. (autoload 'mc-scheme-pgp "mc-pgp" nil t)
  47.  
  48. ;;}}}
  49.  
  50. ;;{{{ Encryption
  51.  
  52. (defun mc-cleanup-recipient-headers (str)
  53.   ;; Takes a comma separated string of recipients to encrypt for and,
  54.   ;; assuming they were possibly extracted from the headers of a reply,
  55.   ;; returns a list of the address components.
  56.   (mapcar (function
  57.        (lambda (x)
  58.          (car (cdr (mail-extract-address-components x)))))
  59.       (mc-split "\\([ \t\n]*,[ \t\n]*\\)+" str)))
  60.  
  61. (defun mc-find-headers-end ()
  62.   (save-excursion
  63.     (goto-char (point-min))
  64.     (re-search-forward
  65.      (concat "^" (regexp-quote mail-header-separator) "\n"))
  66.     (if (looking-at "^::\n")
  67.     (re-search-forward "^\n" nil t))
  68.     (if (looking-at "^##\n")
  69.     (re-search-forward "^\n" nil t))
  70.     (point-marker)))
  71.  
  72. (defun mc-encrypt (arg)
  73.   "*Encrypt the current buffer.
  74.  
  75. Exact behavior depends on current major mode.
  76.  
  77. With \\[universal-argument], prompt for User ID to sign as.
  78.  
  79. With \\[universal-argument] \\[universal-argument], prompt for encryption scheme to use."
  80.   (interactive "p")
  81.   (mc-encrypt-region arg nil nil))
  82.  
  83. (defun mc-encrypt-region (arg start end)
  84.   "*Encrypt the current region."
  85.   (interactive "p\nr")
  86.   (let* ((mode-alist (cdr-safe (assq major-mode mc-modes-alist)))
  87.      (func (or (cdr-safe (assq 'encrypt mode-alist))
  88.            'mc-encrypt-generic))
  89.      sign scheme from)
  90.     (if (>= arg 4)
  91.     (setq from (read-string "User ID: ")
  92.           sign t))
  93.     (if (>= arg 16)
  94.     (setq scheme
  95.           (cdr (assoc
  96.             (completing-read "Encryption Scheme: " mc-schemes)
  97.             mc-schemes))))
  98.     (funcall func nil scheme start end from sign)))
  99.  
  100. (defun mc-encrypt-generic (&optional recipients scheme start end from sign)
  101.   "*Generic function to encrypt a region of data."
  102.   (save-excursion
  103.     (or start (setq start (point-min-marker)))
  104.     (or (markerp start) (setq start (copy-marker start)))
  105.     (or end (setq end (point-max-marker)))
  106.     (or (markerp end) (setq end (copy-marker end)))
  107.     (run-hooks 'mc-pre-encryption-hook)
  108.     (cond ((stringp recipients)
  109.        (setq recipients
  110.          (mc-split "\\([ \t\n]*,[ \t\n]*\\)+" recipients)))
  111.       ((null recipients)
  112.        (setq recipients
  113.          (mc-cleanup-recipient-headers (read-string "Recipients: "))))
  114.       (t (error "mc-encrypt-generic: recipients not string or nil")))
  115.     (or scheme (setq scheme mc-default-scheme))
  116.     (if (funcall (cdr (assoc 'encryption-func (funcall scheme)))
  117.          recipients start end from sign)
  118.     (progn
  119.       (run-hooks 'mc-post-encryption-hook)
  120.       t))))
  121.  
  122. (defun mc-encrypt-message (&optional recipients scheme start end from sign)
  123.   "*Encrypt a message for RECIPIENTS using the given encryption SCHEME.
  124. RECIPIENTS is a comma separated string. If SCHEME is nil, use the value
  125. of `mc-default-scheme'.  Returns t on success, nil otherwise."
  126.   (save-excursion
  127.     (let ((headers-end (mc-find-headers-end))
  128.       default-recipients)
  129.  
  130.       (setq default-recipients
  131.         (save-restriction
  132.           (goto-char (point-min))
  133.           (re-search-forward
  134.            (concat "^" (regexp-quote mail-header-separator) "$"))
  135.           (narrow-to-region (point-min) (point))
  136.           (and (featurep 'mailalias)
  137.            mail-aliases
  138.            (expand-mail-aliases (point-min) (point-max)))
  139.           (mapconcat
  140.            'identity
  141.            (append
  142.         (mc-cleanup-recipient-headers
  143.          (or (mail-fetch-field "to" nil t) ""))
  144.         (mc-cleanup-recipient-headers
  145.          (or (mail-fetch-field "bcc" nil t) ""))
  146.         (mc-cleanup-recipient-headers
  147.          (or (mail-fetch-field "cc" nil t) "")))
  148.            ", ")))
  149.  
  150.       (if (not from)
  151.       (save-restriction
  152.         (goto-char (point-min))
  153.         (re-search-forward
  154.          (concat "^" (regexp-quote mail-header-separator) "\n"))
  155.         (narrow-to-region (point) headers-end)
  156.         (setq from (mail-fetch-field "From"))))
  157.       
  158.       (if (not recipients)
  159.       (setq recipients
  160.         (if mc-use-default-recipients
  161.             default-recipients
  162.           (read-from-minibuffer "Recipients: " default-recipients))))
  163.      
  164.       (or recipients (error "No recipients!"))
  165.  
  166.       (or start (setq start headers-end))
  167.       (or end (setq end (point-max-marker)))
  168.  
  169.       (mc-encrypt-generic recipients scheme start end from sign))))
  170.       
  171.  
  172. ;;}}}
  173. ;;{{{ Decryption
  174.  
  175. (defun mc-decrypt ()
  176.   "*Decrypt a message in the current buffer.
  177.  
  178. Exact behavior depends on current major mode."
  179.   (interactive)
  180.   (let* ((mode-alist (cdr-safe (assq major-mode mc-modes-alist)))
  181.      (func (or (cdr-safe (assq 'decrypt mode-alist))
  182.            'mc-decrypt-message)))
  183.     (funcall func)))
  184.  
  185. (defun mc-decrypt-message ()
  186.   "Decrypt whatever message is in the current buffer.
  187. Returns a pair (SUCCEEDED . VERIFIED) where SUCCEEDED is t if the encryption
  188. succeeded and VERIFIED is t if it had a valid signature."
  189.   (save-excursion
  190.     (let ((schemes mc-schemes)
  191.       limits scheme)
  192.       (while (and schemes
  193.           (setq scheme (cdr (car schemes)))
  194.           (not (setq
  195.             limits
  196.             (mc-message-delimiter-positions
  197.              (cdr (assoc 'msg-begin-line (funcall scheme)))
  198.              (cdr (assoc 'msg-end-line (funcall scheme)))))))
  199.     (setq schemes (cdr schemes)))
  200.       
  201.       (if (null limits)
  202.       (error "Found no encrypted message in this buffer.")
  203.     (run-hooks 'mc-pre-decryption-hook)
  204.     (let ((resultval (funcall (cdr (assoc 'decryption-func
  205.                           (funcall scheme))) 
  206.                   (car limits) (cdr limits))))
  207.       (goto-char (point-min))
  208.       (if (car resultval) ; decryption succeeded
  209.           (run-hooks 'mc-post-decryption-hook))
  210.       resultval)))))
  211. ;;}}}  
  212. ;;{{{ Signing
  213. (defun mc-sign (arg)
  214.   "*Sign a message in the current buffer.
  215.  
  216. Exact behavior depends on current major mode.
  217.  
  218. With one prefix arg, prompts for private key to use, with two prefix args,
  219. also prompts for encryption scheme to use.  With negative prefix arg,
  220. inhibits clearsigning (pgp)."
  221.   (interactive "p")
  222.   (mc-sign-region arg nil nil))
  223.  
  224. (defun mc-sign-region (arg start end)
  225.   "*Sign the current region."
  226.   (interactive "p\nr")
  227.   (let* ((mode-alist (cdr-safe (assq major-mode mc-modes-alist)))
  228.      (func (or (cdr-safe (assq 'sign mode-alist))
  229.            'mc-sign-generic))
  230.      from scheme)
  231.     (if (>= arg 16)
  232.     (setq scheme
  233.           (cdr (assoc
  234.             (completing-read "Encryption Scheme: " mc-schemes)
  235.             mc-schemes))))
  236.     (if (>= arg 4)
  237.     (setq from (read-string "User ID: ")))
  238.  
  239.     (funcall func from scheme start end (< arg 0))))
  240.  
  241. (defun mc-sign-generic (withkey scheme start end unclearsig)
  242.   (or scheme (setq scheme mc-default-scheme))
  243.   (or start (setq start (point-min-marker)))
  244.   (or (markerp start) (setq start (copy-marker start)))
  245.   (or end (setq end (point-max-marker)))
  246.   (or (markerp end) (setq end (copy-marker end)))
  247.   (run-hooks 'mc-pre-signature-hook)
  248.   (funcall (cdr (assoc 'signing-func (funcall scheme)))
  249.        start end withkey unclearsig)
  250.   (run-hooks 'mc-post-signature-hook))
  251.  
  252. (defun mc-sign-message (&optional withkey scheme start end unclearsig)
  253.   "Clear sign the message."
  254.   (save-excursion
  255.     (let ((headers-end (mc-find-headers-end)))
  256.       (or withkey
  257.       (progn
  258.         (goto-char (point-min))
  259.         (re-search-forward
  260.          (concat "^" (regexp-quote mail-header-separator) "\n"))
  261.         (save-restriction
  262.           (narrow-to-region (point) headers-end)
  263.           (setq withkey (mail-fetch-field "From")))))
  264.       (or start (setq start headers-end))
  265.       (or end (setq end (point-max-marker)))
  266.       (mc-sign-generic withkey scheme start end unclearsig))))
  267.  
  268. ;;}}}
  269. ;;{{{ Signature verification
  270.  
  271. (defun mc-verify ()
  272.   "*Verify a message in the current buffer.
  273.  
  274. Exact behavior depends on current major mode."
  275.   (interactive)
  276.   (let* ((mode-alist (cdr-safe (assq major-mode mc-modes-alist)))
  277.      (func (or (cdr-safe (assq 'verify mode-alist))
  278.            'mc-verify-signature)))
  279.     (funcall func)))
  280.  
  281. (defun mc-verify-signature ()
  282.   "*Verify the signature of the signed message in the current buffer.
  283. Show the result as a message in the minibuffer. Returns t if the signature
  284. is verified."
  285.   (save-excursion
  286.     (let ((schemes mc-schemes)
  287.       limits scheme)
  288.       (while (and schemes
  289.           (setq scheme (cdr (car schemes)))
  290.           (not
  291.            (setq
  292.             limits
  293.             (mc-message-delimiter-positions
  294.              (cdr (assoc 'signed-begin-line (funcall scheme)))
  295.              (cdr (assoc 'signed-end-line (funcall scheme)))))))
  296.     (setq schemes (cdr schemes)))
  297.  
  298.       (if (null limits)
  299.       (error "Found no signed message in this buffer.")
  300.     (funcall (cdr (assoc 'verification-func (funcall scheme)))
  301.          (car limits) (cdr limits))))))
  302.  
  303.  
  304. ;;}}}
  305. ;;{{{ Key management
  306.  
  307. ;;{{{ mc-insert-public-key
  308.  
  309. (defun mc-insert-public-key (&optional userid scheme)
  310.   "*Insert your public key at point.
  311. With one prefix arg, prompts for user id to use. With two prefix
  312. args, prompts for encryption scheme."
  313.   (interactive
  314.    (let (arglist)
  315.      (if (not (and (listp current-prefix-arg)
  316.            (numberp (car current-prefix-arg))))
  317.      nil
  318.        (if (>= (car current-prefix-arg) 16)
  319.        (setq arglist
  320.          (cons (cdr (assoc (completing-read "Encryption Scheme: "
  321.                             mc-schemes)
  322.                    mc-schemes))
  323.                arglist)))
  324.        (if (>= (car current-prefix-arg) 4)
  325.        (setq arglist (cons (read-string "User ID: ") arglist))))
  326.      arglist))
  327.  
  328. ;  (if (< (point) (mc-find-headers-end))
  329. ;      (error "Can't insert key inside message header"))
  330.   (or scheme (setq scheme mc-default-scheme))
  331.   (or userid (setq userid (cdr (assoc 'user-id (funcall scheme)))))
  332.     
  333.   ;; (goto-char (point-max))
  334.   (if (not (bolp))
  335.       (insert "\n"))
  336.   (funcall (cdr (assoc 'key-insertion-func (funcall scheme))) userid))
  337.  
  338. ;;}}}
  339. ;;{{{ mc-snarf-keys
  340.  
  341. (defun mc-snarf ()
  342.   "*Add all public keys in the buffer to your keyring.
  343.  
  344. Exact behavior depends on current major mode."
  345.   (interactive)
  346.   (let* ((mode-alist (cdr-safe (assq major-mode mc-modes-alist)))
  347.      (func (or (cdr-safe (assq 'snarf mode-alist))
  348.            'mc-snarf-keys)))
  349.     (funcall func)))
  350.  
  351. (defun mc-snarf-keys ()
  352.   "*Add all public keys in the buffer to your keyring."
  353.   (interactive)
  354.   (let ((schemes mc-schemes)
  355.     (start (point-min))
  356.     (found 0)
  357.     limits scheme)
  358.     (save-excursion
  359.       (catch 'done
  360.     (while t
  361.       (while (and schemes
  362.               (setq scheme (cdr (car schemes)))
  363.               (not
  364.                (setq
  365.             limits
  366.             (mc-message-delimiter-positions
  367.              (cdr (assoc 'key-begin-line (funcall scheme)))
  368.              (cdr (assoc 'key-end-line (funcall scheme)))
  369.              start))))
  370.         (setq schemes (cdr schemes)))
  371.       (if (null limits)
  372.           (throw 'done found)
  373.         (setq start (cdr limits))
  374.         (setq found (+ found (funcall (cdr (assoc 'snarf-func
  375.                               (funcall scheme))) 
  376.                       (car limits) (cdr limits)))))))
  377.       (message (format "%d new key%s found" found
  378.                (if (eq 1 found) "" "s"))))))
  379. ;;}}}
  380. ;;}}}
  381. ;;{{{ Mode specific functions
  382.  
  383. ;;{{{ RMAIL
  384. (defun mc-rmail-summary-verify-signature ()
  385.   "*Verify the signature in the current message."
  386.   (interactive)
  387.   (if (not (eq major-mode 'rmail-summary-mode))
  388.       (error
  389.        "mc-rmail-summary-verify-signature called in inappropriate buffer"))
  390.   (save-excursion
  391.     (set-buffer rmail-buffer)
  392.     (mc-verify)))
  393.  
  394. (defun mc-rmail-summary-decrypt-message ()
  395.   "*Decrypt the contents of this message"
  396.   (interactive)
  397.   (if (not (eq major-mode 'rmail-summary-mode))
  398.       (error
  399.        "mc-rmail-summary-decrypt-message called in inappropriate buffer"))
  400.   (save-excursion
  401.     (set-buffer rmail-buffer)
  402.     (mc-decrypt)))
  403.  
  404. (defun mc-rmail-summary-snarf-keys ()
  405.   "*Adds keys from current message to public key ring"
  406.   (interactive)
  407.   (if (not (eq major-mode 'rmail-summary-mode))
  408.       (error
  409.        "mc-rmail-summary-snarf-keys called in inappropriate buffer"))
  410.   (save-excursion
  411.     (set-buffer rmail-buffer)
  412.     (mc-snarf)))
  413.  
  414. (defun mc-rmail-verify-signature ()
  415.   "*Verify the signature in the current message."
  416.   (interactive)
  417.   (if (not (equal mode-name "RMAIL"))
  418.       (error "mc-rmail-verify-signature called in a non-RMAIL buffer"))
  419.   ;; Hack to load rmailkwd before verifying sig
  420.   (rmail-add-label "verified")
  421.   (rmail-kill-label "verified")
  422.   (if (mc-verify-signature)
  423.       (rmail-add-label "verified")))
  424.  
  425. (defun mc-rmail-decrypt-message ()
  426.   "*Decrypt the contents of this message"
  427.   (interactive)
  428.   (let (decryption-result)
  429.     (if (not (equal mode-name "RMAIL"))
  430.     (error "mc-rmail-decrypt-message called in a non-RMAIL buffer"))
  431.     (unwind-protect
  432.     (progn
  433.       (rmail-edit-current-message)
  434.       (setq decryption-result (mc-decrypt-message))
  435.       (cond ((not (car decryption-result))
  436.          (rmail-abort-edit))
  437.         ((and (not (eq mc-always-replace 'never))
  438.               (or mc-always-replace
  439.               (y-or-n-p
  440.                "Replace encrypted message with decrypted? ")))
  441.          (rmail-cease-edit)
  442.          (rmail-kill-label "edited")
  443.          (rmail-add-label "decrypted")
  444.          (if (cdr decryption-result)
  445.              (rmail-add-label "verified")))
  446.         (t
  447.          (let ((tmp (generate-new-buffer "*Mailcrypt Viewing*")))
  448.            (copy-to-buffer tmp (point-min) (point-max))
  449.            (rmail-abort-edit)
  450.            (switch-to-buffer tmp t)
  451.            (goto-char (point-min))
  452.            (insert "From Mailcrypt-" mc-version " "
  453.                (current-time-string) "\n")
  454.            (rmail-convert-file)
  455.            (rmail-mode)
  456.            (use-local-map (copy-keymap (current-local-map)))
  457.            (local-set-key "q" 'mc-rmail-view-quit)
  458.            (set-buffer-modified-p nil)))))
  459.       (if (eq major-mode 'rmail-edit-mode)
  460.       (rmail-abort-edit)))))
  461.  
  462. (defun mc-rmail-view-quit ()
  463.   (interactive)
  464.   (let ((buf (current-buffer)))
  465.     (set-buffer-modified-p nil)
  466.     (rmail-quit)
  467.     (kill-buffer buf)))
  468.  
  469. ;;}}}
  470. ;;{{{ VM
  471. (defun mc-vm-verify-signature ()
  472.   "*Verify the signature in the current VM message"
  473.   (interactive)
  474.   (if (interactive-p)
  475.       (vm-follow-summary-cursor))
  476.   (vm-select-folder-buffer)
  477.   (vm-check-for-killed-summary)
  478.   (vm-error-if-folder-empty)
  479.   (save-restriction
  480.     (vm-widen-page)
  481.     (mc-verify-signature)))
  482.  
  483. (defun mc-vm-decrypt-message ()
  484.   "*Decrypt the contents of the current VM message"
  485.   (interactive)
  486.   (let (from-line)
  487.     (if (interactive-p)
  488.     (vm-follow-summary-cursor))
  489.     (vm-select-folder-buffer)
  490.     (vm-check-for-killed-summary)
  491.     (vm-error-if-folder-read-only)
  492.     (vm-error-if-folder-empty)
  493.  
  494.     ;; store away a valid "From " line for possible later use.
  495.     (setq from-line (vm-leading-message-separator))
  496.     (vm-edit-message)
  497.     (cond ((not (condition-case condition-data
  498.             (car (mc-decrypt-message))
  499.           (error
  500.            (vm-edit-message-abort)
  501.            (error (message "Decryption failed: %s" 
  502.                    (car (cdr condition-data)))))))
  503.            (vm-edit-message-abort)
  504.        (error "Decryption failed."))
  505.       ((and (not (eq mc-always-replace 'never))
  506.         (or mc-always-replace
  507.             (y-or-n-p "Replace encrypted message with decrypted? ")))
  508.            (vm-edit-message-end))
  509.           (t
  510.            (let ((tmp (generate-new-buffer "*Mailcrypt Viewing*")))
  511.              (copy-to-buffer tmp (point-min) (point-max))
  512.              (vm-edit-message-abort)
  513.              (switch-to-buffer tmp t)
  514.          (goto-char (point-min))
  515.          (insert from-line)         
  516.          (set-buffer-modified-p nil)
  517.          (vm-mode t))))))
  518.  
  519. (defun mc-vm-snarf-keys ()
  520.   "*Snarf public key from the contents of the current VM message"
  521.   (interactive)
  522.   (if (interactive-p)
  523.       (vm-follow-summary-cursor))
  524.   (vm-select-folder-buffer)
  525.   (vm-check-for-killed-summary)
  526.   (vm-error-if-folder-empty)
  527.   (save-restriction
  528.     (vm-widen-page)
  529.     (mc-snarf-keys)))
  530.  
  531. ;;}}}
  532. ;;{{{ GNUS
  533.  
  534. (defun mc-gnus-summary-verify-signature ()
  535.   (interactive)
  536.   (gnus-summary-select-article)
  537.   (gnus-eval-in-buffer-window gnus-article-buffer
  538.     (save-restriction (widen) (mc-verify-signature))))
  539.  
  540. (defun mc-gnus-summary-snarf-keys ()
  541.   (interactive)
  542.   (gnus-summary-select-article)
  543.   (gnus-eval-in-buffer-window gnus-article-buffer
  544.     (save-restriction (widen) (mc-snarf-keys))))
  545.  
  546. (defun mc-gnus-summary-decrypt-message ()
  547.   (interactive)
  548.   (gnus-summary-select-article)
  549.   (if (or (not (boundp 'gnus-version))
  550.       (not (stringp gnus-version))
  551.       (not (string-match "(ding)" gnus-version)))
  552.       (gnus-eval-in-buffer-window gnus-article-buffer
  553.     (save-restriction (widen) (mc-decrypt-message)))
  554.     ;; (ding) Gnus allows editing of articles in mail groups.
  555.     (gnus-eval-in-buffer-window gnus-article-buffer
  556.       (gnus-summary-edit-article)
  557.       (save-restriction
  558.     (widen)
  559.     (cond ((not
  560.         (condition-case condition-data
  561.             (car (mc-decrypt-message))
  562.           (error
  563.            (gnus-article-show-summary)
  564.            (gnus-summary-show-article)
  565.            (error (message "Decryption failed: %s"
  566.                    (car (cdr condition-data)))))))
  567.            (message "Decryption failed.")
  568.            (gnus-article-show-summary)
  569.            (gnus-summary-show-article))
  570.  
  571.           ((and (not (eq mc-always-replace 'never))
  572.             (or mc-always-replace
  573.             (y-or-n-p
  574.              "Replace encrypted message on disk? ")))
  575.            (gnus-summary-edit-article-done))
  576.  
  577.           (t
  578.            (gnus-article-show-summary)))))))
  579.  
  580. ;;}}}        
  581. ;;{{{ MH
  582.  
  583. (defun mc-mh-decrypt-message ()
  584.   "Decrypt the contents of the current MH message in the show buffer."
  585.   (interactive "P")
  586.   (let* ((msg (mh-get-msg-num t))
  587.      (msg-filename (mh-msg-filename msg))
  588.      (show-buffer (get-buffer mh-show-buffer))
  589.      decrypt-okay decrypt-on-disk)
  590.     (setq
  591.      decrypt-on-disk
  592.      (and (not (eq mc-always-replace 'never))
  593.       (or mc-always-replace
  594.           (y-or-n-p "Replace encrypted message on disk? "))))
  595.     (if decrypt-on-disk
  596.     (progn
  597.       (save-excursion
  598.         (set-buffer (create-file-buffer msg-filename))
  599.         (insert-file-contents msg-filename t)
  600.         (if (setq decrypt-okay (car (mc-decrypt-message)))
  601.         (save-buffer)
  602.           (message "Decryption failed.")
  603.           (set-buffer-modified-p nil))
  604.         (kill-buffer nil))
  605.       (if decrypt-okay
  606.           (if (and show-buffer
  607.                (equal msg-filename (buffer-file-name show-buffer)))
  608.           (save-excursion
  609.             (save-window-excursion
  610.               (mh-invalidate-show-buffer)))))
  611.       (mh-show msg))
  612.       (mh-show msg)
  613.       (save-excursion
  614.     (set-buffer mh-show-buffer)
  615.     (if (setq decrypt-okay (car (mc-decrypt-message)))
  616.         (progn
  617.           (goto-char (point-min))
  618.           (set-buffer-modified-p nil))
  619.       (message "Decryption failed.")))
  620.       (if (not decrypt-okay)
  621.       (progn
  622.         (mh-invalidate-show-buffer)
  623.         (mh-show msg))))))
  624.  
  625. (defun mc-mh-verify-signature ()
  626.   "*Verify the signature in the current MH message."
  627.   (interactive)
  628.   (mh-show)
  629.   (mh-in-show-buffer (mh-show-buffer)
  630.     (mc-verify-signature)))
  631.     
  632.  
  633. (defun mc-mh-snarf-keys ()
  634.   (interactive)
  635.   (mh-show)
  636.   (mh-in-show-buffer (mh-show-buffer)
  637.     (mc-snarf-keys)))
  638.  
  639. ;;}}}
  640.  
  641. ;;}}}
  642.