mime-mc.el

   1 ;;; mime-mc.el --- Mailcrypt interface for SEMI
   2
   3 ;; Copyright (C) 1996,1997,1998,1999 MORIOKA Tomohiko
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;;         Katsumi Yamaoka  <yamaoka@jpl.org>
   7 ;; Keywords: PGP, GnuPG, security, MIME, multimedia, mail, news
   8
   9 ;; This file is part of SEMI (Secure Emacs MIME Interface).
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or (at
  14 ;; your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Code:
  27
  28 (require 'semi-def)
  29 (require 'mailcrypt)
  30
  31 (eval-and-compile
  32   (mapcar
  33    (function (lambda (elem) (apply 'autoload elem)))
  34    '(
  35      (mc-gpg-debug-print        "mc-gpg")
  36      (mc-gpg-encrypt-region     "mc-gpg")
  37      (mc-gpg-lookup-key         "mc-gpg")
  38      (mc-pgp50-encrypt-region   "mc-pgp5")
  39      (mc-pgp50-lookup-key       "mc-pgp5")
  40      (mc-pgp-encrypt-region     "mc-pgp")
  41      (mc-pgp-lookup-key         "mc-pgp")
  42      (mc-snarf-keys             "mc-toplev")
  43      )))
  44
  45 (defvar mc-gpg-comment)
  46 (defvar mc-gpg-extra-args)
  47 (defvar mc-gpg-path)
  48 (defvar mc-gpg-user-id)
  49 (defvar mc-pgp50-comment)
  50 (defvar mc-pgp50-pgps-path)
  51 (defvar mc-pgp50-user-id)
  52 (defvar mc-pgp-comment)
  53 (defvar mc-pgp-path)
  54 (defvar mc-pgp-user-id)
  55
  56
  57 ;;; @ Generic functions
  58 ;;;
  59
  60 (defun mime-mc-setversion (&optional version)
  61   "Select `pgp-version' and `mc-default-scheme' if possible.
  62 VERSION should be a string or a symbol."
  63   (interactive)
  64   (let ((oldversion pgp-version)
  65         (table '(("GnuPG" . gpg) ("PGP 5.0i" . pgp50) ("PGP 2.6" . pgp)
  66                  ("gnupg" . gpg) ("gpg" . gpg) ("pgp5" . pgp50)
  67                  ("pgp50" . pgp50) ("pgp2" . pgp) ("pgp" . pgp)
  68                  ("5.0" . pgp50) ("2.6" . pgp))))
  69     (if (interactive-p)
  70         (setq version (completing-read
  71                        (format "Select PGP version (currently %s): "
  72                                (car (rassoc oldversion table)))
  73                        table nil t)
  74               pgp-version (or (cdr (assoc version table))
  75                               oldversion))
  76       (if (stringp version)
  77           (setq pgp-version (or (cdr (assoc version table)) oldversion))
  78         (if (memq version '(gpg pgp50 pgp))
  79             (setq pgp-version version)
  80           )))
  81     (condition-case nil
  82         (mc-setversion
  83          (cdr (assq pgp-version
  84                     '((gpg . "gpg") (pgp50 . "5.0") (pgp . "2.6"))))
  85          )
  86       (error nil))
  87     (message "PGP version set to %s." (car (rassq pgp-version table)))
  88     ))
  89
  90 (defun mime-mc-insert-public-key (&optional userid scheme)
  91   (mc-insert-public-key
  92    userid
  93    (or scheme (intern (format "mc-scheme-%s" pgp-version)))
  94    ))
  95
  96 (defun mime-mc-verify ()
  97   (let ((mc-default-scheme (intern (format "mc-scheme-%s" pgp-version))))
  98     (mc-verify)
  99     ))
 100
 101 (defun mime-mc-decrypt ()
 102   (let ((mc-default-scheme (intern (format "mc-scheme-%s" pgp-version))))
 103     (mc-decrypt)
 104     ))
 105
 106 (defun mime-mc-snarf-keys ()
 107   (let ((mc-default-scheme (intern (format "mc-scheme-%s" pgp-version))))
 108     (mc-snarf-keys)
 109     ))
 110
 111
 112 ;;; @ GnuPG functions
 113 ;;;
 114
 115 (defun mime-mc-gpg-process-region
 116   (beg end passwd program args parser bufferdummy boundary)
 117   (let ((obuf (current-buffer))
 118         (process-connection-type nil)
 119         (shell-file-name "/bin/sh") ;; ??? force? need sh (not tcsh) for "2>"
 120         ; other local vars
 121         mybuf
 122         stderr-tempfilename stderr-buf
 123         status-tempfilename status-buf
 124         proc rc status parser-result
 125         )
 126     (mc-gpg-debug-print (format
 127                          "(mc-gpg-process-region beg=%s end=%s passwd=%s program=%s args=%s parser=%s bufferdummy=%s)"
 128                          beg end passwd program args parser bufferdummy))
 129     (setq stderr-tempfilename
 130           (make-temp-name (expand-file-name "mailcrypt-gpg-stderr-"
 131                                             mc-temp-directory)))
 132     (setq status-tempfilename
 133           (make-temp-name (expand-file-name "mailcrypt-gpg-status-"
 134                                             mc-temp-directory)))
 135     (unwind-protect
 136         (progn
 137           ;; get output places ready
 138           (setq mybuf (get-buffer-create " *mailcrypt stdout temp"))
 139           (set-buffer mybuf)
 140           (erase-buffer)
 141           (set-buffer obuf)
 142           (buffer-disable-undo mybuf)
 143
 144           (if passwd
 145               (setq args (append '("--passphrase-fd" "0") args)))
 146           (setq args (append (list (concat "2>" stderr-tempfilename)) args))
 147           (setq args (append (list (concat "3>" status-tempfilename)) args))
 148           (setq args (append '("--status-fd" "3") args))
 149
 150           (if mc-gpg-extra-args
 151               (setq args (append mc-gpg-extra-args args)))
 152
 153           (mc-gpg-debug-print (format "prog is %s, args are %s"
 154                                       program
 155                                       (mapconcat '(lambda (x)
 156                                                     (format "'%s'" x))
 157                                                  args " ")))
 158
 159           (setq proc
 160                 (apply 'start-process-shell-command "*GPG*" mybuf
 161                        program args))
 162           ;; send in passwd if necessary
 163           (if passwd
 164               (progn
 165                 (process-send-string proc (concat passwd "\n"))
 166                 (or mc-passwd-timeout (mc-deactivate-passwd t))))
 167           ;; send in the region
 168           (process-send-region proc beg end)
 169           ;; finish it off
 170           (process-send-eof proc)
 171           ;; wait for it to finish
 172           (while (eq 'run (process-status proc))
 173             (accept-process-output proc 5))
 174           ;; remember result codes
 175           (setq status (process-status proc))
 176           (setq rc (process-exit-status proc))
 177           (mc-gpg-debug-print (format "prog finished, rc=%s" rc))
 178
 179           ;; Hack to force a status_notify() in Emacs 19.29
 180           (delete-process proc)
 181
 182           ;; remove the annoying "yes your process has finished" message
 183           (set-buffer mybuf)
 184           (goto-char (point-max))
 185           (if (re-search-backward "\nProcess \\*GPG.*\n\\'" nil t)
 186               (delete-region (match-beginning 0) (match-end 0)))
 187           (goto-char (point-min))
 188           ;; CRNL -> NL
 189           (while (search-forward "\r\n" nil t)
 190             (replace-match "\n"))
 191
 192           ;; ponder process death: signal, not just rc!=0
 193           (if (or (eq 'stop status) (eq 'signal status))
 194               ;; process died
 195               (error "%s exited abnormally: '%s'" program rc) ;;is rc a string?
 196             )
 197
 198           (if (= 127 rc)
 199               (error "%s could not be found" program) ;; at least on my system
 200             )
 201
 202           ;; fill stderr buf
 203           (setq stderr-buf (get-buffer-create " *mailcrypt stderr temp"))
 204           (buffer-disable-undo stderr-buf)
 205           (set-buffer stderr-buf)
 206           (erase-buffer)
 207           (insert-file-contents stderr-tempfilename)
 208
 209           ;; fill status buf
 210           (setq status-buf (get-buffer-create " *mailcrypt status temp"))
 211           (buffer-disable-undo status-buf)
 212           (set-buffer status-buf)
 213           (erase-buffer)
 214           (insert-file-contents status-tempfilename)
 215
 216           ;; feed the parser
 217           (set-buffer mybuf)
 218           (setq parser-result (funcall parser mybuf stderr-buf status-buf rc))
 219           (mc-gpg-debug-print (format " parser returned %s" parser-result))
 220
 221           ;; what did the parser tell us?
 222           (if (car parser-result)
 223               ;; yes, replace region
 224               (progn
 225                 (set-buffer obuf)
 226                 (if boundary
 227                     (save-restriction
 228                       (narrow-to-region beg end)
 229                       (goto-char beg)
 230                       (insert (format "--%s\n" boundary))
 231                       (goto-char (point-max))
 232                       (insert (format "\n--%s
 233 Content-Type: application/pgp-signature
 234 Content-Transfer-Encoding: 7bit
 235
 236 " boundary))
 237                       (insert-buffer-substring mybuf)
 238                       (goto-char (point-max))
 239                       (insert (format "\n--%s--\n" boundary))
 240                       )
 241                   (delete-region beg end)
 242                   (goto-char beg)
 243                   (insert-buffer-substring mybuf)
 244                   )))
 245
 246           ;; return result
 247           (cdr parser-result)
 248           )
 249       ;; cleanup forms
 250       (if (and proc (eq 'run (process-status proc)))
 251           ;; it is still running. kill it.
 252           (interrupt-process proc))
 253       (set-buffer obuf)
 254       (delete-file stderr-tempfilename)
 255       (delete-file status-tempfilename)
 256       ;; kill off temporary buffers (which would be useful for debugging)
 257       (if t ;; nil for easier debugging
 258           (progn
 259             (if (get-buffer " *mailcrypt stdout temp")
 260                 (kill-buffer " *mailcrypt stdout temp"))
 261             (if (get-buffer " *mailcrypt stderr temp")
 262                 (kill-buffer " *mailcrypt stderr temp"))
 263             (if (get-buffer " *mailcrypt status temp")
 264                 (kill-buffer " *mailcrypt status temp"))
 265             ))
 266       )))
 267
 268 (defun mime-mc-gpg-sign-region (start end &optional id unclear boundary)
 269   (if (not (fboundp 'mc-gpg-insert-parser))
 270       (load "mc-gpg")
 271     )
 272   (let ((buffer (get-buffer-create mc-buffer-name))
 273         passwd args key
 274         (parser (function mc-gpg-insert-parser))
 275         (pgp-path mc-gpg-path)
 276         )
 277     (setq key (mc-gpg-lookup-key (or id mc-gpg-user-id)))
 278     (setq passwd
 279           (mc-activate-passwd
 280            (cdr key)
 281            (format "GnuPG passphrase for %s (%s): " (car key) (cdr key))))
 282     (setq args
 283           (cons
 284            (if boundary
 285                "--detach-sign"
 286              (if unclear
 287                  "--sign"
 288                "--clearsign"))
 289            (list "--passphrase-fd" "0"
 290                  "--armor" "--batch" "--textmode" "--verbose"
 291                  "--local-user" (cdr key))))
 292     (if mc-gpg-comment
 293         (setq args (nconc args
 294                           (list "--comment"
 295                                 (format "\"%s\"" mc-gpg-comment))))
 296       )
 297     (if (and boundary
 298              (string-match "^pgp-" boundary))
 299         (setq boundary
 300               (concat "gpg-" (substring boundary (match-end 0))))
 301       )
 302     (message "Signing as %s ..." (car key))
 303     (if (mime-mc-gpg-process-region
 304          start end passwd pgp-path args parser buffer boundary)
 305         (progn
 306           (if boundary
 307               (progn
 308                 (goto-char (point-min))
 309                 (insert
 310                  (format "\
 311 --[[multipart/signed; protocol=\"application/pgp-signature\";
 312  boundary=\"%s\"; micalg=pgp-sha1][7bit]]\n" boundary))
 313                 ))
 314           (message "Signing as %s ... Done." (car key))
 315           t)
 316       nil)))
 317
 318 (defun mime-mc-gpg-encrypt-region (recipients start end &optional id sign)
 319   (if (not (fboundp 'mc-gpg-encrypt-region))
 320       (load "mc-gpg")
 321     )
 322   (let ((mc-pgp-always-sign (if (eq sign 'maybe)
 323                                 mc-pgp-always-sign
 324                               'never)))
 325     (mc-gpg-encrypt-region
 326      (mc-split "\\([ \t\n]*,[ \t\n]*\\)+" recipients)
 327      start end id nil)
 328     ))
 329
 330
 331 ;;; @ PGP 5.0i functions
 332 ;;;
 333
 334 (defun mime-mc-pgp50-process-region
 335   (beg end passwd program args parser &optional buffer boundary)
 336   (let ((obuf (current-buffer))
 337         (process-connection-type nil)
 338         (shell-file-name "/bin/sh")
 339         mybuf result rgn proc results)
 340     (unwind-protect
 341         (progn
 342           (setq mybuf (or buffer (generate-new-buffer " *mailcrypt temp")))
 343           (set-buffer mybuf)
 344           (erase-buffer)
 345           (set-buffer obuf)
 346           (buffer-disable-undo mybuf)
 347           (setq proc
 348                 (apply 'start-process-shell-command "*PGP*" mybuf program
 349                        "2>&1" args))
 350
 351           ;; Now hand the process to the parser, which returns the exit
 352           ;; status of the dead process and the limits of the region
 353           ;; containing the PGP results.
 354           (setq results (funcall parser proc obuf beg end mybuf passwd))
 355           (setq result  (car results))
 356           (setq rgn     (cadr results))
 357
 358           ;; Hack to force a status_notify() in Emacs 19.29
 359           (set-buffer mybuf)
 360
 361           ;; Hurm.  FIXME; must get better result codes.
 362           (if (stringp result)
 363               (mc-message result))
 364
 365           ;; If the parser found something, migrate it to the old
 366           ;; buffer.  In particular, the parser's job is to return
 367           ;; a cons of the form ( beg . end ) delimited the result
 368           ;; of PGP in the new buffer.
 369           (if (consp rgn)
 370               (progn
 371                 (set-buffer obuf)
 372                 (if boundary
 373                     (save-restriction
 374                       (narrow-to-region beg end)
 375                       (goto-char beg)
 376                       (insert (format "--%s\n" boundary))
 377                       (goto-char (point-max))
 378                       (insert (format "\n--%s
 379 Content-Type: application/pgp-signature
 380 Content-Transfer-Encoding: 7bit
 381
 382 " boundary))
 383                       (insert-buffer-substring mybuf (car rgn) (cdr rgn))
 384                       (goto-char (point-max))
 385                       (insert (format "\n--%s--\n" boundary))
 386                       )
 387                   (delete-region beg end)
 388                   (goto-char beg)
 389                   (insert-buffer-substring mybuf (car rgn) (cdr rgn))
 390                   )
 391                 (set-buffer mybuf)
 392                 (delete-region (car rgn) (cdr rgn))))
 393
 394           ;; Return nil on failure and exit code on success
 395           (if rgn result nil))
 396
 397       ;; Cleanup even on nonlocal exit
 398       (if (and proc (eq 'run (process-status proc)))
 399           (interrupt-process proc))
 400       (set-buffer obuf)
 401       (or buffer (null mybuf) (kill-buffer mybuf))
 402       rgn)))
 403
 404 (defun mime-mc-pgp50-sign-parser (proc oldbuf start end newbuf passwd)
 405   ;; This function is a copy of `mc-pgp50-sign-parser', however it is
 406   ;; modified for parsing a detached sign.
 407   (let (result results rgn)
 408     ;; (setenv "PGPPASSFD" "0")
 409     (set-buffer newbuf)
 410     (goto-char (point-max))
 411     (progn
 412       (unwind-protect
 413           (with-expect proc
 414             (message "Sending passphrase...")
 415             (expect-send (concat passwd "\n"))
 416             (or mc-passwd-timeout (mc-deactivate-passwd t))
 417             (expect "No files specified.  Using stdin."
 418               (message "Passphrase sent.  Signing...")
 419               (set-buffer oldbuf)
 420               (process-send-region proc start end)
 421               (set-buffer newbuf)
 422               (process-send-eof proc)
 423
 424               ;; Test output of the program, looking for
 425               ;; errors.
 426               (expect-cond
 427
 428                ;; OPTION 1:  Great!  The data is now signed!
 429                ("-----END PGP SIGNATURE-----"
 430
 431                 ;; Catch the exit status.
 432                 (setq result (process-exit-status proc))
 433                 (delete-process proc)
 434                 (message "Signing complete.")
 435
 436                 ;; Delete everything preceding the signed data.
 437                 (goto-char (point-max))
 438                 (re-search-backward
 439                  ;; "-----BEGIN PGP SIGNED MESSAGE-----" nil t)
 440                  "-----BEGIN PGP SIGNATURE-----" nil t)
 441                 (delete-region (point-min) (match-beginning 0))
 442                 (setq rgn (point-min))
 443
 444                 ;; Convert out CR/NL -> NL
 445                 (goto-char (point-min))
 446                 (while (search-forward "\r\n" nil t)
 447                   (replace-match "\n"))
 448
 449                 ;; Delete everything after the signature.
 450                 (goto-char (point-min))
 451                 (re-search-forward
 452                  "-----END PGP SIGNATURE-----\n" nil t)
 453                 (delete-region (match-end 0) (point-max))
 454
 455                 ;; Return the exit status, with the region
 456                 ;; limits!
 457                 (setq rgn (cons rgn (point-max)))
 458                 (setq results (list result rgn)))
 459
 460
 461                ;; OPTION 1.a:  The data is now signed, but is 8bit data.
 462                ("-----END PGP MESSAGE-----"
 463
 464                 ;; Catch the exit status.
 465                 (setq result (process-exit-status proc))
 466                 (delete-process proc)
 467                 (message "Signing complete.")
 468
 469                 ;; Delete everything preceding the signed data.
 470                 (goto-char (point-max))
 471                 (re-search-backward
 472                  "-----BEGIN PGP MESSAGE-----" nil t)
 473                 (delete-region (point-min) (match-beginning 0))
 474                 (setq rgn (point-min))
 475
 476                 ;; Convert out CR/NL -> NL
 477                 (goto-char (point-min))
 478                 (while (search-forward "\r\n" nil t)
 479                   (replace-match "\n"))
 480
 481                 ;; Delete everything after the signature.
 482                 (goto-char (point-min))
 483                 (re-search-forward
 484                  "-----END PGP MESSAGE-----\n" nil t)
 485                 (delete-region (match-end 0) (point-max))
 486
 487                 ;; Return the exit status, with the region
 488                 ;; limits!
 489                 (setq rgn (cons rgn (point-max)))
 490                 (setq results (list result rgn)))
 491
 492
 493                ;; OPTION 2:  Awww...bad passphrase!
 494                ("Enter pass phrase:"
 495                 (mc-deactivate-passwd t)
 496                 (interrupt-process proc)
 497                 (delete-process proc)
 498
 499                 ;; Return the bad news.
 500                 (setq results '("Incorrect passphrase" nil)))
 501
 502                ;; OPTION 3:  The program exits.
 503                (exit
 504                 (setq results (list
 505                                (process-exit-status proc) nil)))))))
 506       results)))
 507
 508 (defun mime-mc-pgp50-sign-region (start end &optional id unclear boundary)
 509   (if (not (fboundp 'mc-pgp50-sign-parser))
 510       (load "mc-pgp5")
 511     )
 512   (let ((process-environment process-environment)
 513         (buffer (get-buffer-create mc-buffer-name))
 514         passwd args key
 515         (parser (if boundary
 516                     (function mime-mc-pgp50-sign-parser)
 517                   (function mc-pgp50-sign-parser)))
 518         (pgp-path mc-pgp50-pgps-path)
 519         )
 520     (setq key (mc-pgp50-lookup-key (or id mc-pgp50-user-id)))
 521     (setq passwd
 522           (mc-activate-passwd
 523            (cdr key)
 524            (format "PGP passphrase for %s (%s): " (car key) (cdr key))))
 525     (setenv "PGPPASSFD" "0")
 526     (setq args
 527           (cons
 528            (if boundary
 529                "-fbat"
 530              "-fat")
 531            (list "+verbose=1" "+language=us"
 532                  (format "+clearsig=%s" (if unclear "off" "on"))
 533                  "+batchmode" "-u" (cdr key))))
 534     (if mc-pgp50-comment
 535         (setq args (cons (format "+comment=\"%s\"" mc-pgp50-comment) args))
 536       )
 537     (message "Signing as %s ..." (car key))
 538     (if (mime-mc-pgp50-process-region
 539          start end passwd pgp-path args parser buffer boundary)
 540         (progn
 541           (if boundary
 542               (progn
 543                 (goto-char (point-min))
 544                 (insert
 545                  (format "\
 546 --[[multipart/signed; protocol=\"application/pgp-signature\";
 547  boundary=\"%s\"; micalg=pgp-sha1][7bit]]\n" boundary))
 548                 ))
 549           (message "Signing as %s ... Done." (car key))
 550           t)
 551       nil)))
 552
 553 (defun mime-mc-pgp50-encrypt-region (recipients start end &optional id sign)
 554   (if (not (fboundp 'mc-pgp50-encrypt-region))
 555       (load "mc-pgp5")
 556     )
 557   (let ((mc-pgp-always-sign (if (eq sign 'maybe)
 558                                 mc-pgp-always-sign
 559                               'never)))
 560     (mc-pgp50-encrypt-region
 561      (mc-split "\\([ \t\n]*,[ \t\n]*\\)+" recipients)
 562      start end id nil)
 563     ))
 564
 565
 566 ;;; @ PGP 2.6 functions
 567 ;;;
 568
 569 (defun mime-mc-process-region
 570   (beg end passwd program args parser &optional buffer boundary)
 571   (let ((obuf (current-buffer))
 572         (process-connection-type nil)
 573         mybuf result rgn proc)
 574     (unwind-protect
 575         (progn
 576           (setq mybuf (or buffer (generate-new-buffer " *mailcrypt temp")))
 577           (set-buffer mybuf)
 578           (erase-buffer)
 579           (set-buffer obuf)
 580           (buffer-disable-undo mybuf)
 581           (setq proc
 582                 (apply 'start-process "*PGP*" mybuf program args))
 583           (if passwd
 584               (progn
 585                 (process-send-string proc (concat passwd "\n"))
 586                 (or mc-passwd-timeout (mc-deactivate-passwd t))))
 587           (process-send-region proc beg end)
 588           (process-send-eof proc)
 589           (while (eq 'run (process-status proc))
 590             (accept-process-output proc 5))
 591           (setq result (process-exit-status proc))
 592           ;; Hack to force a status_notify() in Emacs 19.29
 593           (delete-process proc)
 594           (set-buffer mybuf)
 595           (goto-char (point-max))
 596           (if (re-search-backward "\nProcess \\*PGP.*\n\\'" nil t)
 597               (delete-region (match-beginning 0) (match-end 0)))
 598           (goto-char (point-min))
 599           ;; CRNL -> NL
 600           (while (search-forward "\r\n" nil t)
 601             (replace-match "\n"))
 602           ;; Hurm.  FIXME; must get better result codes.
 603           (if (stringp result)
 604               (error "%s exited abnormally: '%s'" program result)
 605             (setq rgn (funcall parser result))
 606             ;; If the parser found something, migrate it
 607             (if (consp rgn)
 608                 (progn
 609                   (set-buffer obuf)
 610                   (if boundary
 611                       (save-restriction
 612                         (narrow-to-region beg end)
 613                         (goto-char beg)
 614                         (insert (format "--%s\n" boundary))
 615                         (goto-char (point-max))
 616                         (insert (format "\n--%s
 617 Content-Type: application/pgp-signature
 618 Content-Transfer-Encoding: 7bit
 619
 620 " boundary))
 621                         (insert-buffer-substring mybuf (car rgn) (cdr rgn))
 622                         (goto-char (point-max))
 623                         (insert (format "\n--%s--\n" boundary))
 624                         )
 625                     (delete-region beg end)
 626                     (goto-char beg)
 627                     (insert-buffer-substring mybuf (car rgn) (cdr rgn))
 628                     )
 629                   (set-buffer mybuf)
 630                   (delete-region (car rgn) (cdr rgn)))))
 631           ;; Return nil on failure and exit code on success
 632           (if rgn result))
 633       ;; Cleanup even on nonlocal exit
 634       (if (and proc (eq 'run (process-status proc)))
 635           (interrupt-process proc))
 636       (set-buffer obuf)
 637       (or buffer (null mybuf) (kill-buffer mybuf)))))
 638
 639 (defun mime-mc-pgp-sign-region (start end &optional id unclear boundary)
 640   (if (not (fboundp 'mc-pgp-generic-parser))
 641       (load "mc-pgp")
 642     )
 643   (let ((process-environment process-environment)
 644         (buffer (get-buffer-create mc-buffer-name))
 645         passwd args key
 646         (parser (function mc-pgp-generic-parser))
 647         (pgp-path mc-pgp-path)
 648         )
 649     (setq key (mc-pgp-lookup-key (or id mc-pgp-user-id)))
 650     (setq passwd
 651           (mc-activate-passwd
 652            (cdr key)
 653            (format "PGP passphrase for %s (%s): " (car key) (cdr key))))
 654     (setenv "PGPPASSFD" "0")
 655     (setq args
 656           (cons
 657            (if boundary
 658                "-fbast"
 659              "-fast")
 660            (list "+verbose=1" "+language=en"
 661                  (format "+clearsig=%s" (if unclear "off" "on"))
 662                  "+batchmode" "-u" (cdr key))))
 663     (if mc-pgp-comment
 664         (setq args (cons (format "+comment=%s" mc-pgp-comment) args))
 665       )
 666     (message "Signing as %s ..." (car key))
 667     (if (mime-mc-process-region
 668          start end passwd pgp-path args parser buffer boundary)
 669         (progn
 670           (if boundary
 671               (progn
 672                 (goto-char (point-min))
 673                 (insert
 674                  (format "\
 675 --[[multipart/signed; protocol=\"application/pgp-signature\";
 676  boundary=\"%s\"; micalg=pgp-md5][7bit]]\n" boundary))
 677                 ))
 678           (message "Signing as %s ... Done." (car key))
 679           t)
 680       nil)))
 681
 682 (defun mime-mc-pgp-encrypt-region (recipients start end &optional id sign)
 683   (if (not (fboundp 'mc-pgp-encrypt-region))
 684       (load "mc-pgp")
 685     )
 686   (let ((mc-pgp-always-sign (if (eq sign 'maybe)
 687                                 mc-pgp-always-sign
 688                               'never)))
 689     (mc-pgp-encrypt-region
 690      (mc-split "\\([ \t\n]*,[ \t\n]*\\)+" recipients)
 691      start end id nil)
 692     ))
 693
 694
 695 ;;; @ end
 696 ;;;
 697
 698 (provide 'mime-mc)
 699
 700 ;;; mime-mc.el ends here