tm-edit-tipgp.el

   1 ;;; tm-edit-tipgp.el -- TinyPgp.el PGP interface
   2
   3 ;; Copyright (C) 1996 Jari aalto
   4
   5 ;; Author: Jari Aalto <jari.aalto@poboxes.com>
   6 ;; Version: $Id: tm-edit-tipgp.el,v 1.1 1996/12/04 11:11:47 jaalto Beta $
   7 ;; Keywords: mail, news, MIME, multimedia, multilingual, security, PGP
   8
   9 ;; This file is part of tm (Tools for MIME).
  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 'tinypgpa.el)
  29
  30 (defun tm:tipgp-process-region (result-buffer boundary)
  31   (let ((obuf (current-buffer))
  32         )
  33     (cond
  34      (boundary
  35       (goto-char (point-min))
  36       (insert (format "--%s\n" boundary))
  37       (goto-char (point-max))
  38       (insert (format "\n--%s
  39 Content-Type: application/pgp-signature
  40 Content-Transfer-Encoding: 7bit
  41
  42 " boundary))
  43       (insert-buffer-substring result-buffer)
  44       (goto-char (point-max))
  45       (insert (format "\n--%s--\n" boundary))
  46       )
  47      (t
  48       (delete-region beg end)
  49       (goto-char beg)
  50       (insert-buffer-substring result-buffer)
  51       ))
  52   ))
  53
  54
  55
  56
  57 (defun tm:tipgp-sign-region (start end &optional id unclear boundary)
  58   ;; start end  = Region
  59   ;; id         =
  60   ;; unclear    =
  61   ;; boundary   = pgp-sign-Multipart_Wed_Dec__4_11:14:41_1996-1
  62
  63   (let (tipgp-:xpgp-header-mode         ;Do not use X-Pgp signing
  64         passwd
  65         ret
  66         )
  67
  68     (setq passwd (tipgp-password-get-old "Sign pass phrase: "))
  69
  70
  71     ;;  The region is already narrowed by TM, so we pass the
  72     ;;  point-min point-max
  73     ;;
  74     ;;  The macro tipgp-run-in-tmp-buffer cpies the contents to
  75     ;;  another buffer and when signing is over, it will
  76     ;;  contain fully signed message
  77     ;;
  78     (setq
  79      ret
  80      (tipgp-run-in-tmp-buffer nil
  81        (tipgp-sign-region
  82         (point-min) (point-max) passwd 'verb
  83         (format
  84          "+comment=\"Processed by TinyPgp.el %s\""
  85          (strmatget "[0-9][0-9.]+" 0 tipgp-version-id)
  86          )
  87         'noerr
  88         )))
  89
  90     (if ret
  91         (tm:tipgp-process-region tipgp-:buffer-tmp-copy boundary))
  92
  93     (cond
  94      ((and boundary ret)
  95       (goto-char (point-min))
  96       (insert
  97        (format "\
  98 --[[multipart/signed; protocol=\"application/pgp-signature\";
  99  boundary=\"%s\"; micalg=pgp-md5][7bit]]\n" boundary))
 100       ))
 101     ret
 102     ))
 103
 104
 105
 106 (defun tm:tipgp-pgp-encrypt-region (recipients start end &optional id sign)
 107   (let (;;  do not use these hooks while in TM
 108
 109         tipgp-cmd-macro-before-hook
 110         tipgp-cmd-macro-after-hook
 111
 112         ;; TinyPgp.el: has separate encrypt and signing functions.
 113         ;;
 114 ;;;     (mc-pgp-always-sign
 115 ;;;      (if (eq sign 'maybe)
 116 ;;;          mc-pgp-always-sign
 117 ;;;        'never))
 118
 119         (elist (ti::mt-email-from-string recipients))
 120         )
 121     (if (null elist)
 122         (error "TO,CC,BCC fields don't contain email addresses."))
 123     (tipgp-encrypt-region (point-min) (point-max) elist nil 'verb)
 124     ))
 125
 126
 127 ;;; @ end
 128 ;;;
 129
 130 (provide 'tm-edit-tipgp)
 131
 132 ;;; tm-edit-tipgp.el ends here