From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/33508 Path: main.gmane.org!not-for-mail From: "Georg C. F. Greve" Newsgroups: gmane.emacs.gnus.general Subject: MIME/Crypto functions for Emacs Date: 28 Nov 2000 18:54:05 +0100 Organization: GNU Project Sender: owner-ding@hpc.uh.edu Message-ID: NNTP-Posting-Host: coloc-standby.netfonds.no Mime-Version: 1.0 Content-Type: multipart/signed; boundary="==-=-="; micalg=pgp-sha1; protocol="application/pgp-signature" X-Trace: main.gmane.org 1035169601 25514 80.91.224.250 (21 Oct 2002 03:06:41 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Mon, 21 Oct 2002 03:06:41 +0000 (UTC) Return-Path: Original-Received: from spinoza.math.uh.edu (spinoza.math.uh.edu [129.7.128.18]) by mailhost.sclp.com (Postfix) with ESMTP id 14D7ED049A for ; Tue, 28 Nov 2000 12:55:47 -0500 (EST) Original-Received: from sina.hpc.uh.edu (lists@Sina.HPC.UH.EDU [129.7.3.5]) by spinoza.math.uh.edu (8.9.1/8.9.1) with ESMTP id LAB29546; Tue, 28 Nov 2000 11:55:29 -0600 (CST) Original-Received: by sina.hpc.uh.edu (TLB v0.09a (1.20 tibbs 1996/10/09 22:03:07)); Tue, 28 Nov 2000 11:54:49 -0600 (CST) Original-Received: from mailhost.sclp.com (postfix@66-209.196.61.interliant.com [209.196.61.66] (may be forged)) by sina.hpc.uh.edu (8.9.3/8.9.3) with ESMTP id LAA11756 for ; Tue, 28 Nov 2000 11:54:35 -0600 (CST) Original-Received: from mail.arcor-ip.de (mail-ffm-p.arcor-ip.de [145.253.2.10]) by mailhost.sclp.com (Postfix) with ESMTP id 14D6AD049A for ; Tue, 28 Nov 2000 12:54:56 -0500 (EST) Original-Received: from fusebox.gnu-hamburg (145.253.176.32) by mail.arcor-ip.de; 28 Nov 2000 18:54:55 +0100 Original-Received: from reason.gnu-hamburg (root@reason.gnu-hamburg [10.129.4.1]) by fusebox.gnu-hamburg (8.11.1/8.11.1) with ESMTP id eASHsYw19799 for ; Tue, 28 Nov 2000 18:54:50 +0100 Original-Received: (from greve@localhost) by reason.gnu-hamburg (8.11.1/8.11.1/Debian 8.11.0-6) id eASHs9q02972; Tue, 28 Nov 2000 18:54:09 +0100 Original-To: ding@gnus.org X-Home-Page: http://www.gnu.org/people/greve.html X-PGP-Affinity: will accept encrypted messages for GNU Privacy Guard X-PGP-Fingerprint: 2D68 D553 70E5 CCF9 75F4 9CC9 6EF8 AFC2 8657 4ACA User-Agent: Gnus/5.0808 (Gnus v5.8.8) Emacs/20.7 Original-Lines: 69 Precedence: list X-Majordomo: 1.94.jlt7 Xref: main.gmane.org gmane.emacs.gnus.general:33508 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:33508 --==-=-= Content-Type: multipart/mixed; boundary="=-=-=" --=-=-= Content-Transfer-Encoding: quoted-printable Hi Everyone! Okay, I checked into the problems that gnus has with Crypto MIME and modified message-options-set-recipient by reusing some mailcrypt functionality as well as some own little additions. I also made specifying recipients in the encryption tag work. It is still very much a cludge - but at least it makes the stuff work for now. Furthermore I have modified the bbdb-gpg.el stuff to integrate better with the new way of handling it and wrote a bunch of functions to make it more comfortable. Some of them are meant for being used as keybindings. Personally I use F1 gnus-set-pgp-sign F2 gnus-set-pgp-encrypt F3 gnus-set-pgp-encrypt-with-recipients F4 gnus-set-pgp-none when composing mail. This code generates the following behaviour: When composing mail you can toggle the crypto setting between signed / encrypted / encrypted with explicit recipients / nothing by pressing F1, F2, F3, F4. When sending mail it checks the BBDB for the pgp-mail field of the recipient. If it is set to encrypt, the encryption tag is automatically inserted and the mail is being sent. If the pgp-mail field is set to sign, it is set to sign and the mail is being sent.=20 If nothing can be found in the BBDB and it doesn't see any crypto tag specification, it asks whether it should sign the mail. Yes sets signing tag and sends it out. No makes it ask whether it should maybe be encrypted. Yes sets the encryption tag and sends it out. No sends it out plain. In case of an encryption tag when sending the mail, the user is prompted for recipients. The default is normally the contents of the To, Cc and Bcc fields - if the recipients have been specified explicitly, that is the default to prompt with. I made it always prompt as I like making sure that the crypto settings are correct. You can disable the "if there is no setting I probably forgot" behaviour by simply leaving out some of the hooks. This is _almost_ what I want. Now I would love some sort of crypto-mail-aliases that allows translating certain recipients into others or even groups of recipients. Then I'd be entirely happy.=20 All my code is under the GPL (of course) so in case you want to try it out or use it as the basis for a better solution, you'll find it appended here. It isn't beautiful but it works... ,-) Regards, Georg --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=lispstuff Content-Description: some hacks... ;; ;; cludge for the Mailcrypt/gnus interoperability insufficiency: ;; replacement for function to get recipients from gnus in CVS ;; Copyright (C) 1996, 1997, 1998, 1999, 2000 ;; Free Software Foundation, Inc. ;; Copyright (C) 2000 Georg C. F. Greve ;; (defun message-options-set-recipient () ;; ;; function to get default recipients from mailcrypt 3.5.5 ;; Copyright (C) 1995 Jin Choi ;; Patrick LoPresti ;; licensed under the GNU General Public License ;; --begin-- (setq default-recipients (save-restriction (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (narrow-to-region (point-min) (point)) (and (featurep 'mailalias) (not (featurep 'mail-abbrevs)) mail-aliases (expand-mail-aliases (point-min) (point-max))) (mc-strip-addresses (mapcar 'cdr (mc-get-fields "to\\|cc\\|bcc"))))) ;; --end-- ;; find crypto tag and extract possible recipients (setq crypto-tag (gnus-look-for-pgp-crypto-tag)) (message-goto-body) ;; if crypto-tag exists: what about specified recipients? (if (and (setq p (search-forward "recipients=\"" crypto-tag t)) crypto-tag) (setq default-recipients (buffer-substring p (- (search-forward "\"" crypto-tag t) 1)))) ;; slightly modified original function (save-restriction (message-narrow-to-headers-or-head) (message-options-set 'message-sender (mail-strip-quoted-names (message-fetch-field "from"))) (message-options-set 'message-recipients (mail-strip-quoted-names (if crypto-tag (read-string "Recipients: " default-recipients ) (message-fetch-field "to")))))) ;; ;; some functions for nicer crypto usability in gnus ;; ;; Copyright (C) 2000 Georg C. F. Greve greve@gnu.org ;; license: GNU General Public License ;; (defun gnus-look-for-pgp-tag () "Checks whether this mail does have any PGP tags set. If the first line of the mail begins with something that appears to be a MIME crypto tag, it returns the position of the end of that line. nil if no tag could be found." (interactive) (message-goto-body) (setq p (point-marker)) (search-forward "=" nil 2) (if (or (string= "<#part sign=" (buffer-substring p (point))) (string= "<#part encrypt=" (buffer-substring p (point))) (string= "<#multipart sign=" (buffer-substring p (point))) (string= "<#multipart encrypt=" (buffer-substring p (point)))) (search-forward "\n") nil)) (defun gnus-look-for-pgp-crypto-tag () "Checks whether this mail does have any PGP crypto tags set. If the first line of the mail begins with something that appears to be a MIME crypto tag, it returns the position of the end of that line. nil if no tag could be found." (interactive) (message-goto-body) (setq p (point-marker)) (search-forward "=" nil 2) (if (or (string= "<#part encrypt=" (buffer-substring p (point))) (string= "<#multipart encrypt=" (buffer-substring p (point)))) (search-forward "\n") nil)) (defun gnus-set-pgp-none () "Removes the tag for PGP signing or encrypting if there is one." (interactive) (message-goto-body) (setq p (point-marker)) (if (setq q (gnus-look-for-pgp-tag)) (delete-region p q)) (goto-char p)) (defun gnus-set-pgp-sign () "Inserts the tag for PGP signature after removing old tag (if necessary)." (interactive) (gnus-set-pgp-none) (if (not (bolp)) (insert ?\n)) (insert (format "<#multipart sign=pgpmime>\n"))) (defun gnus-set-pgp-encrypt () "Inserts the tag for PGP encryption after removing old tag (if necessary)." (interactive) (gnus-set-pgp-none) (if (not (bolp)) (insert ?\n)) (insert (format "<#multipart encrypt=pgpmime>\n"))) (defun gnus-set-pgp-encrypt-with-recipients (&optional default-recipients) "Removes the old tag (if necessary) and then asks for the recipients of the encrypted mail. If those are non-empty, a new PGP encryption tag is inserted." (interactive) (gnus-set-pgp-none) (setq recipients (read-from-minibuffer "Recipients: " (if default-recipients default-recipients ;; function to get default recipients from mailcrypt 3.5.5 ;; mc-toplev.el, entry point functions for Mailcrypt ;; Copyright (C) 1995 Jin Choi ;; Patrick LoPresti ;; license: GNU General Public License (save-restriction (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (narrow-to-region (point-min) (point)) (and (featurep 'mailalias) (not (featurep 'mail-abbrevs)) mail-aliases (expand-mail-aliases (point-min) (point-max))) (mc-strip-addresses (mapcar 'cdr (mc-get-fields "to\\|cc\\|bcc"))))))) (message-goto-body) (if (not (string= recipients "")) (insert (format "<#multipart encrypt=pgpmime recipients=\"%s\">\n" recipients)) nil )) (defun gnus-set-pgp-encrypt-if-nothing (&optional ask) "Inserts the tag for encryption via PGP if nothing else is set." (interactive) (if (not (gnus-look-for-pgp-tag)) (if (if ask (y-or-n-p "Should this mail be encrypted?") t ) (gnus-set-pgp-encrypt)))) (defun gnus-set-pgp-sign-if-nothing (&optional ask) "Inserts the tag for signing via PGP if nothing else is set. Optionally asks whether this is desired." (interactive) (if (not (gnus-look-for-pgp-tag)) (if (if ask (y-or-n-p "Should this mail be signed?") t ) (gnus-set-pgp-sign)))) (defun gnus-set-pgp-sign-interactively () "Inserts the PGP signing tag after asking. To be used mainly for hook fun. Asks for encryption if signing is declined." (interactive) (gnus-set-pgp-sign-if-nothing t) (gnus-set-pgp-encrypt-if-nothing t)) ;; ;; pgp-mail field support for BBDB ;; ;; from bbdb-gpg.el by Kevin Davidson ;; Copyright (C) 1997 Kevin Davidson ;; Copyright (C) 2000 Georg C. F. Greve ;; license: GNU General Public License ;; (require 'message) (require 'bbdb) (require 'mailcrypt) (defconst bbdb-pgp-version (substring "$Revision: 1.3P $" 11 -2) "$Id: bbdb-pgp.el,v 1.3 1997/11/10 15:20:29 tkld Exp $ Patched by: Georg C. F. Greve greve@gnu.org Report bugs to: Kevin Davidson tkld@quadstone.com") (defvar bbdb-pgp-field 'pgp-mail "*Field to use in BBDB to store PGP preferences. If the value is \"encrypt\" then messages are encrypted. If the value is \"sign\" then messages are signed.") (defun bbdb/pgp-get-pgp (name address) "Look up user NAME and ADDRESS in BBDB and return the PGP preference." (let* ((record (bbdb-search-simple name address)) (pgp (and record (bbdb-record-getprop record bbdb-pgp-field)))) pgp)) (defun bbdb/pgp-hook-fun () "Function to be added to message-send-hook Uses PGP to encrypt messages to users marked in the BBDB with the field bbdb-pgp-field." (save-restriction (save-excursion (message-narrow-to-headers) (let* ((to-field (mail-fetch-field "To" nil t)) (address (mail-extract-address-components (or to-field "")))) (widen) (if (not (equal address '(nil nil))) (let ((pgp-p (bbdb/pgp-get-pgp (car address) (car (cdr address))))) (cond ((string= "encrypt" pgp-p) (gnus-set-pgp-encrypt-if-nothing)) ((string= "sign" pgp-p) (gnus-set-pgp-sign-if-nothing)) (t nil)))))))) ;; first check the field from the BBDB (add-hook 'message-send-hook 'bbdb/pgp-hook-fun) (add-hook 'mail-send-hook 'bbdb/pgp-hook-fun) ;; if it isn't signed now, I _probably_ forgot. Ask me. (add-hook 'message-send-hook 'gnus-set-pgp-sign-interactively) (add-hook 'mail-send-hook 'gnus-set-pgp-sign-interactively) --=-=-= Content-Transfer-Encoding: quoted-printable =2D-=20 Georg C. F. Greve the monthly GNU forum in English, German,=20 French, Spanish and Japanese. Check it out=20 at http://brave-gnu-world.org/ --=-=-=-- --==-=-= Content-Type: application/pgp-signature -----BEGIN PGP MESSAGE----- Version: GnuPG v1.0.4 (GNU/Linux) Comment: Processed by Mailcrypt 3.5.5 and Gnu Privacy Guard iD8DBQE6I/FBbvivwoZXSsoRAn84AJ4zKQbh2t3Tvs9LFT9NdoMKluiJ4ACeJ66l h+RSd8VcJVPs2AEHiTX1iZU= =ytvt -----END PGP MESSAGE----- --==-=-=--