From 6f2043a1b1f79598af3eef286c2ed542195ffefd Mon Sep 17 00:00:00 2001 From: Illia Ostapyshyn Date: Mon, 6 May 2024 20:24:22 +0200 Subject: [PATCH] Use proper smime-keys entry for S/MIME signatures using OpenSSL bug#67931 * 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. (cherry picked from commit 8074c08cd553ab6ee5ffe61cc2e56fb1e0a4fe34) --- 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 @@ Parameters for @samp{sign=smime}: @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 @@ Whether the passphrase is cached at all is controlled by (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 @@ Whether the passphrase is cached at all is controlled by (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 @@ part. This is for the internal use, you should never modify the value.") (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 @@ part. This is for the internal use, you should never modify the value.") (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 @@ password under `cache-key'." 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 @@ is expected to contain of a PEM encoded certificate." (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.5