From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/35709 Path: main.gmane.org!not-for-mail From: "Georg C. F. Greve" Newsgroups: gmane.emacs.gnus.general Subject: Crypto-MIME in GNUS Date: 10 Apr 2001 10:52:56 +0200 Organization: GNU Project Sender: "Georg C. F. Greve" 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 1035171408 4540 80.91.224.250 (21 Oct 2002 03:36:48 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Mon, 21 Oct 2002 03:36:48 +0000 (UTC) Return-Path: Original-Received: (qmail 17409 invoked by alias); 10 Apr 2001 08:54:00 -0000 Original-Received: (qmail 17402 invoked from network); 10 Apr 2001 08:54:00 -0000 Original-Received: from mail-ffm-p.arcor-ip.de (HELO mail.arcor-ip.de) (145.253.2.10) by gnus.org with SMTP; 10 Apr 2001 08:54:00 -0000 Original-Received: from fusebox.gnu-hamburg (145.253.176.65) by mail.arcor-ip.de; 10 Apr 2001 10:53:36 +0200 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 f3A8rYu05597 for ; Tue, 10 Apr 2001 10:53:34 +0200 Original-Received: (from greve@localhost) by reason.gnu-hamburg (8.11.2/8.11.2/Debian 8.11.2-1) id f3A8quM01143; Tue, 10 Apr 2001 10:52:56 +0200 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.090001 (Oort Gnus v0.01) Emacs/20.7 Original-Lines: 55 Xref: main.gmane.org gmane.emacs.gnus.general:35709 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:35709 --==-=-= Content-Type: multipart/mixed; boundary="=-=-=" --=-=-= Content-Transfer-Encoding: quoted-printable Hi guys, since I have received so much help revising my mail schemes and once again I'm very satisified with how things work, I thought I should contribute something that some people might useful. I don't think I posted this here, yet. There is a lot of encrypted mail coming in/going out here and I needed gnus to be able to handle it completely transparent and MIME compliant. Unfortunately there were some problems. The biggest problem was that the gnus crypto function didn't work since it gave mailcrypt the buffer to encrypt that didn't contain headers so mailcrypt had no way to determine who to encrypt it for. Also when I got it to work half-way I realized that CC and BCC were ignored. Also I wanted a nice way to determine whether to encrypt or sign that I could toggle while composing the mail. AND I wanted it to interface with the BBDB. I havethe "pgp-mail" field that if set to sign/encrypt automatically signs/encrypts everything to this person. What is also nice is an easy way to include public keys into the mail with correct MIME type. The solution I have is ugly but I didn't have time to think about something better and for now it works. The following code fixes/does all this. It is probably more a cludge than a solution but it does the job and I have been using it successfully for a few months now. Maybe someone will find it useful. Personally I have set: --=-=-= Content-Type: application/emacs-lisp Content-Disposition: inline ( local-set-key [f1] 'gnus-set-pgp-sign ) ( local-set-key [f2] 'gnus-set-pgp-encrypt ) ( local-set-key [f3] 'gnus-set-pgp-encrypt-with-recipients ) ( local-set-key [f4] 'gnus-set-pgp-none ) --=-=-= Content-Disposition: inline Content-Transfer-Encoding: quoted-printable which means that when writing mail, F1 sets it to sign, F2 to encrypt and F4 removes the tag. F3 (encrypt with recipients) doesn't work for some reason... didn't have time to investigate it further. Regards, Georg --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=crypto.el Content-Description: The crypto-related routines in my .gnus ;; ;; Mailcrypt ;; (load-library "mailcrypt") ; provides "mc-setversion" (mc-setversion "gpg") ;; 2.6 for PGP 2.6, 5.0 for PGP 5.0 (autoload 'mc-install-write-mode "mailcrypt" nil t) (autoload 'mc-install-read-mode "mailcrypt" nil t) (add-hook 'mail-mode-hook 'mc-install-write-mode) (add-hook 'gnus-summary-mode-hook 'mc-install-read-mode) (add-hook 'message-mode-hook 'mc-install-write-mode) (add-hook 'news-reply-mode-hook 'mc-install-write-mode) ;; USER SPECIFIC OPTIONS ;; this is my normal identity to use: (setq mc-pgp-user-id "greve@gnu.org") (setq mc-gpg-user-id "greve@gnu.org") ;; timeouts (setq mc-passwd-timeout 2400) ;; do we always want to sign encrypted messages? you bet! (setq mc-pgp-always-sign t) ;; pop up the GPG output window when snarfing keys. (setq mc-gpg-display-snarf-output t) ;; Assume that the message should be encoded for ;; everyone listed in the To, Cc, and Bcc fields. (setq mc-use-default-recipients t) ;; Encrypt all outgoing messages with user's public key. ;; since I want to be able to read it, this seems like a ;; good idea... ,-) (setq mc-encrypt-for-me t) ;; MML: (setq mml2015-use 'mailcrypt) (setq mm-verify-option 'known) (setq mm-decrypt-option 'always) ;; gpg-ring.el (require 'gpg-ring) ;; ;; 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)) (defun gnus-insert-kill-as-mime-public-key () "Inserts a public key from the kill buffer as MIME part in the current mail." (interactive) (let ((oldbuf (current-buffer))) (save-current-buffer (set-buffer (setq keybuf (buffer-name (generate-new-buffer "*Public-PGP-Key-Data*")))) (yank) )) (if (not (bolp)) (insert ?\n)) (mml-attach-buffer keybuf "application/pgp-keys")) ;; ;; 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 pay attention to the BBDB field and then ask me ;; if there is still nothing set as I probably forgot ;; (add-hook 'message-send-hook 'gnus-set-pgp-sign-interactively) (add-hook 'mail-send-hook 'gnus-set-pgp-sign-interactively) (add-hook 'message-send-hook 'bbdb/pgp-hook-fun) (add-hook 'mail-send-hook 'bbdb/pgp-hook-fun) --=-=-= Content-Transfer-Encoding: quoted-printable =2D-=20 Georg C. F. Greve Free Software Foundation Europe (http://fsfeurope.org) Brave GNU World (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 iD8DBQE60snobvivwoZXSsoRAlQBAJ4kUg7KiYqFCe8sxzFIjigKvJAuygCfb+YL xnIWl5iEqMoi3UKZU0kESa4= =ztCo -----END PGP MESSAGE----- --==-=-=--