Bug#6654

[Dave Goldberg <david.goldberg6@verizon.net>]

I updated today and was excited to see the ChangeLog entry referring
to the subject bug report, about the inability to encrypt to multiple
recipients using s/mime.  I've posted here about that before (which I
mistakenly thought was the same as submitting a bug report) and I've
long had a workaround for it, which I'm pretty sure I've posted here
as well, and am glad to no longer need it.

Well mostly.  With the fix, I am indeed now able to use
mml-secure-encrypt-smime and the resulting #secure tag rather than
manually building a multipart.  However, by default I am prompted not
only to provide a key (or rather tell Gnus where to look) but also
have to manually figure out which recipient's key I need to specify
for each prompt.  For a short list, that's not horrible, but for a
long one, which is something I often have to deal with at work, it's
not hard to miss someone and end up messing up the encryption for
subsequent users on the list.  This is a problem I solved as part of
my workaround, which parses the To: Cc: and Gcc: headers to come up
with the list of recipients and fill in the certfile tags based on
that (the Gcc check just results in a call for my personal key if Gcc
exists)

I notice in mml-smime.el a couple of relevant functions with this comment

  ;; todo: deal with comma separated multiple recipients

so I'm hoping that my code proves useful toward that end.  As written
it's tied too closely to a personal cert caching setup I have, which
in turn is tied to how PKI is done at work, so I can't offer it as a
patch, at least not now.  It's also only been tested on XEmacs 21.4.
However it does fit the structure of the current mml-smime code in
that it integrates via mml-encrypt-alist.

So with that here is the code.

(setq mml-encrypt-alist
      '(("smime" mml-smime-encrypt-buffer dsg-message-make-cert-tags)))

(defun dsg-message-make-cert-tags ()
  (let ((certlist
	 (mapcar 'cadr (mail-extract-address-components
			(concat (message-fetch-field "to") ","
				(message-fetch-field "cc")) t)))
	(gcc-key (if (message-fetch-field "gcc")
		     (cadar smime-keys)))
	certtags)
    (while certlist
      (setq certtags (append certtags (list 'certfile (dsg-get-address-cert
						       (car certlist)))))
      (setq certlist (cdr certlist)))
    (append certtags (list 'certfile gcc-key))))

(defun dsg-get-address-cert (ADDRESS)
  ;; return expected certificate file name.  If non-existent, attempt
  ;; to get it from LDAP.  
  (let* ((mailaddr (downcase ADDRESS))
	 (certfilename
	  (concat
	   (expand-file-name mailaddr smime-certificate-directory) ".pem"))
	 (certbuf  (smime-cert-by-ldap mailaddr)))
    (cond ((not (or (file-exists-p certfilename) certbuf))
	   (error "No certificate available for %s" mailaddr))
	  ((and certbuf (not (file-exists-p certfilename)))
	   (save-excursion
	     (set-buffer certbuf)
	     (write-file certfilename))
	   (kill-buffer certbuf)
	   certfilename)
	  (certbuf
	   (if (get-buffer dsg-cert-buffer)
	       (progn
		 (save-excursion
		   (set-buffer (get-buffer-create dsg-cert-history))
		   (goto-char (point-max))
		   (insert-buffer dsg-cert-buffer))
		 (erase-buffer dsg-cert-buffer)))
	   (dsg-verify-cert certfilename)
	   (save-window-excursion
	     (set-buffer dsg-cert-buffer)
	     (goto-char (point-min))
	     (if (looking-at ".*OK$\\|^$")
		 certfilename
	       (delete-file certfilename)
	       (save-excursion
		 (set-buffer certbuf)
		 (write-file certfilename)))
	     (kill-buffer certbuf)
	     certfilename))
	  (t certfilename))))

(defun dsg-verify-cert (PEM)
  "Verify the certificate stored in PEM"
  (interactive (list (read-file-name "Cert file: "
				     smime-certificate-directory)))
  (let ((buffer (get-buffer-create dsg-cert-buffer)))
    (save-excursion
      (if (fboundp 'set-buffer-file-coding-system)
	  (set-buffer-file-coding-system 'binary))
      (set-buffer buffer)
      (goto-char (point-max))
      (call-process "openssl" nil t t
		    "verify" "-CApath" smime-CA-directory
		    (expand-file-name PEM))
      (recenter -1 (get-buffer-window buffer)))
    (display-buffer buffer)
    (shrink-window-if-larger-than-buffer (get-buffer-window buffer))))

-- 
Dave Goldberg
david.goldberg6@verizon.net