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.
This commit is contained in:
Illia Ostapyshyn 2024-05-06 20:24:22 +02:00 committed by Eric Abrahamsen
parent 52287b8697
commit 8074c08cd5
4 changed files with 43 additions and 22 deletions

View file

@ -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}:

View file

@ -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

View file

@ -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")

View file

@ -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