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