bug#67931: [PATCH] Use S/MIME key from content for mail signing via OpenSSL

[Illia Ostapyshyn <illia@yshyn.com>]

[-- Attachment #1: Type: text/plain, Size: 789 bytes --]

Eli Zaretskii <eliz@gnu.org> writes:

>> Cc: Lars Ingebrigtsen <larsi@gnus.org>, 17780@debbugs.gnu.org,
>>  Stefan Kangas <stefankangas@gmail.com>, Jan Beich <jbeich@vfemail.net>,
>>  67931@debbugs.gnu.org
>> From: Illia Ostapyshyn <illia@yshyn.com>
>> Date: Mon, 06 May 2024 20:46:33 +0200
>> 
>> Sorry, forgot to attach the patch, sending it with this email.
>
> Thanks, I'm adding Eric to the discussion.

Thanks!

I've realized that reusing certfile parameter for signing will have
unintended side-effects when encrypting and signing a message.  When a
single signencrypt MML tag is used for both this results in all
certfiles passed to both `smime-encrypt-buffer' and `smime-sign-buffer'.

I'm sending a new patch that introduces a parameter called chainfile for
signatures instead.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: PATCH --]
[-- Type: text/x-patch, Size: 6446 bytes --]

From 6b6fb491247506becacb7a217e994b828be2ea2d Mon Sep 17 00:00:00 2001
From: Illia Ostapyshyn <illia@yshyn.com>
Date: Mon, 6 May 2024 20:24:22 +0200
Subject: [PATCH] Use proper smime-keys entry for S/MIME signatures using
 OpenSSL

* doc/misc/emacs-mime.texi (MML Definition):
* lisp/gnus/mml.el (mml-parse-1): Add chainfile parameter to sign tags.
* lisp/gnus/mml-smime.el (mml-smime-openssl-sign-query): Include the
additional certificates from smime-keys in MML tag generation as
chainfile parameters.
(mml-smime-openssl-sign): Forward chainfile entries from the parsed tag
alist to smime-sign-buffer.
; * lisp/gnus/smime.el (smime-sign-region): Fix typo in documentation.
; (smime-sign-buffer): Improve documentation to match smime-sign-region.
---
 doc/misc/emacs-mime.texi |  4 ++++
 lisp/gnus/mml-smime.el   | 46 +++++++++++++++++++++++-----------------
 lisp/gnus/mml.el         |  8 +++++++
 lisp/gnus/smime.el       |  7 ++++--
 4 files changed, 43 insertions(+), 22 deletions(-)

diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi
index 96a6328cd47..ef7ea614f8b 100644
--- a/doc/misc/emacs-mime.texi
+++ b/doc/misc/emacs-mime.texi
@@ -787,6 +787,10 @@ MML Definition
 @item keyfile
 File containing key and certificate for signer.
 
+@item chainfile
+File containing an additional certificate to be included with the
+message.
+
 @end table
 
 Parameters for @samp{encrypt=smime}:
diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el
index 3064c46d2a3..9218bc079db 100644
--- a/lisp/gnus/mml-smime.el
+++ b/lisp/gnus/mml-smime.el
@@ -129,11 +129,15 @@ mml-smime-verify-test
     (if func
 	(funcall func handle ctl))))
 
-(defun mml-smime-openssl-sign (_cont)
-  (when (null smime-keys)
-    (customize-variable 'smime-keys)
-    (error "No S/MIME keys configured, use customize to add your key"))
-  (smime-sign-buffer (cdar smime-keys))
+(defun mml-smime-openssl-sign (cont)
+  (smime-sign-buffer
+   ;; List with key and certificate as its car, and a list of additional
+   ;; certificates to include in its cadr for smime-sign-region
+   (list
+    (cdr (assq 'keyfile cont))
+    (mapcar #'cdr (cl-remove-if-not (apply-partially #'equal 'chainfile)
+                                    cont
+                                    :key #'car-safe))))
   (goto-char (point-min))
   (while (search-forward "\r\n" nil t)
     (replace-match "\n" t t))
@@ -167,21 +171,23 @@ mml-smime-openssl-sign-query
   (when (null smime-keys)
     (customize-variable 'smime-keys)
     (error "No S/MIME keys configured, use customize to add your key"))
-  (list 'keyfile
-	(if (= (length smime-keys) 1)
-	    (cadar smime-keys)
-	  (or (let ((from (cadr (mail-extract-address-components
-				 (or (save-excursion
-				       (save-restriction
-					 (message-narrow-to-headers)
-					 (message-fetch-field "from")))
-				     "")))))
-		(and from (smime-get-key-by-email from)))
-	      (smime-get-key-by-email
-	       (gnus-completing-read "Sign this part with what signature"
-                                     (mapcar #'car smime-keys) nil nil nil
-                                     (and (listp (car-safe smime-keys))
-                                          (caar smime-keys))))))))
+  (let ((key-with-certs
+	 (if (= (length smime-keys) 1)
+	     (cdar smime-keys)
+	   (or (let ((from (cadr (mail-extract-address-components
+				  (or (save-excursion
+				        (save-restriction
+					  (message-narrow-to-headers)
+					  (message-fetch-field "from")))
+				      "")))))
+		 (and from (smime-get-key-with-certs-by-email from)))
+	       (smime-get-key-with-certs-by-email
+	        (gnus-completing-read "Sign this part with what signature"
+                                      (mapcar #'car smime-keys) nil nil nil
+                                      (and (listp (car-safe smime-keys))
+                                           (caar smime-keys))))))))
+    (append (list 'keyfile (car key-with-certs))
+            (mapcan (apply-partially #'list 'chainfile) (cadr key-with-certs)))))
 
 (defun mml-smime-get-file-cert ()
   (ignore-errors
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index edb3c286242..e3bc3932529 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -233,6 +233,10 @@ mml-parse-1
 					      (if (eq (car-safe tag) 'certfile)
 						  (cdr tag)))
 					    taginfo)))
+               (chainfiles (delq nil (mapcar (lambda (tag)
+                                               (if (eq (car-safe tag) 'chainfile)
+                                                   (cdr tag)))
+                                             taginfo)))
 	       (recipients (cdr (assq 'recipients taginfo)))
 	       (sender (cdr (assq 'sender taginfo)))
 	       (location (cdr (assq 'tag-location taginfo)))
@@ -267,6 +271,10 @@ mml-parse-1
 			    (mapcar (lambda (certfile)
 				      (list "certfile" certfile))
 				    certfiles))
+                   ,@(apply #'append
+                            (mapcar (lambda (chainfile)
+                                      (list "chainfile" chainfile))
+                                    chainfiles))
 		   ,(if recipients "recipients")
 		   ,recipients
 		   ,(if sender "sender")
diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el
index b61579912dd..987bc7273db 100644
--- a/lisp/gnus/smime.el
+++ b/lisp/gnus/smime.el
@@ -261,7 +261,7 @@ smime-sign-region
 If signing fails, the buffer is not modified.  Region is assumed to
 have proper MIME tags.  KEYFILE is expected to contain a PEM encoded
 private key and certificate as its car, and a list of additional
-certificates to include in its caar.  If no additional certificates is
+certificates to include in its cadr.  If no additional certificates are
 included, KEYFILE may be the file containing the PEM encoded private
 key and certificate itself."
   (smime-new-details-buffer)
@@ -327,7 +327,10 @@ smime-encrypt-region
 
 (defun smime-sign-buffer (&optional keyfile buffer)
   "S/MIME sign BUFFER with key in KEYFILE.
-KEYFILE should contain a PEM encoded key and certificate."
+KEYFILE is expected to contain a PEM encoded private key and certificate
+as its car, and a list of additional certificates to include in its
+cadr.  If no additional certificates are included, KEYFILE may be the
+file containing the PEM encoded private key and certificate itself."
   (interactive)
   (with-current-buffer (or buffer (current-buffer))
     (unless (smime-sign-region
-- 
2.39.2