From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/59875 Path: main.gmane.org!not-for-mail From: =?utf-8?Q?Arne_J=C3=B8rgensen?= Newsgroups: gmane.emacs.gnus.general Subject: Patch for smime-stuff Date: Tue, 22 Feb 2005 17:24:04 +0100 Organization: Arne Joergensen -- http://arnested.dk/ Message-ID: <87d5uszhp7.fsf@seamus.arnested.dk> NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: sea.gmane.org 1109089855 12548 80.91.229.2 (22 Feb 2005 16:30:55 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Tue, 22 Feb 2005 16:30:55 +0000 (UTC) Original-X-From: ding-owner+M8416@lists.math.uh.edu Tue Feb 22 17:30:54 2005 Original-Received: from malifon.math.uh.edu ([129.7.128.13] ident=mail) by ciao.gmane.org with esmtp (Exim 4.43) id 1D3cvu-0000zq-QJ for ding-account@gmane.org; Tue, 22 Feb 2005 17:30:47 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.math.uh.edu ident=lists) by malifon.math.uh.edu with smtp (Exim 3.20 #1) id 1D3cq6-00077U-00; Tue, 22 Feb 2005 10:24:46 -0600 Original-Received: from util2.math.uh.edu ([129.7.128.23]) by malifon.math.uh.edu with esmtp (Exim 3.20 #1) id 1D3cpz-00077P-00 for ding@lists.math.uh.edu; Tue, 22 Feb 2005 10:24:39 -0600 Original-Received: from quimby.gnus.org ([80.91.224.244]) by util2.math.uh.edu with esmtp (Exim 4.30) id 1D3cpr-0001ip-Gp for ding@lists.math.uh.edu; Tue, 22 Feb 2005 10:24:31 -0600 Original-Received: from main.gmane.org ([80.91.229.2] helo=ciao.gmane.org) by quimby.gnus.org with esmtp (Exim 3.35 #1 (Debian)) id 1D3cpp-0008Td-00 for ; Tue, 22 Feb 2005 17:24:29 +0100 Original-Received: from list by ciao.gmane.org with local (Exim 4.43) id 1D3cmE-0006zx-CS for ding@gnus.org; Tue, 22 Feb 2005 17:20:46 +0100 Original-Received: from 213.237.94.152 ([213.237.94.152]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Tue, 22 Feb 2005 17:20:46 +0100 Original-Received: from arne by 213.237.94.152 with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Tue, 22 Feb 2005 17:20:46 +0100 X-Injected-Via-Gmane: http://gmane.org/ Original-To: ding@gnus.org Original-Lines: 308 Original-X-Complaints-To: usenet@sea.gmane.org X-Gmane-NNTP-Posting-Host: 213.237.94.152 X-Face: 5t,7/Y$&<1A_t.$vC2{pWZ{m@3_06;kcm]no{hgEL/}Uz(>XV6cl4}xO\v?-h3%>znNaZtq `~rf,GY1T%r=a.zH`hOb(-]'x)nI088Z&|e;V^h;/TShou User-Agent: Gnus/5.110003 (No Gnus v0.3) Emacs/22.0.50 (gnu/linux) Cancel-Lock: sha1:JLWVytN2ULivrCo2GAx/MCvOJng= X-Spam-Score: -4.9 (----) Precedence: bulk Original-Sender: ding-owner@lists.math.uh.edu X-MailScanner-From: ding-owner+m8416@lists.math.uh.edu X-MailScanner-To: ding-account@gmane.org Xref: main.gmane.org gmane.emacs.gnus.general:59875 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:59875 --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit Hi, The attached patch has some changes for the S/MIME handling i Gnus (inncluding the changes in the patch I posted four days ago). >From the ChangeLog: * smime.el (smime-ldap-host-list): Doc fix. (smime-ask-passphrase): Use `password-read-and-add' to read (and cache) password. (smime-sign-region): Use it. (smime-decrypt-region): Use it. (smime-sign-buffer): Signal an error if `smime-sign-region' fails. (smime-encrypt-buffer): Signal an error if `smime-encrypt-region' fails. (smime-cert-by-ldap-1): Use `base64-encode-string' to convert certificate from DER to PEM format rather than calling openssl. * mml-smime.el (mml-smime-encrypt-query): Remove obsolete comment. * mml-sec.el (mml-secure-message): Insert keyfile/certfile tags for signing/encryption. * mml.el (mml-parse-1): Use them. The changes to mml-sec.el and mml.el makes "S/MIME Sign" and "S/MIME Encrypt" work like "S/MIME Sign Part" and "S/MIME Encrypt Part" (it will fetch the certificates). Maybe that will be removed later if we/I postpone this until we send the message (as discussed ealier). Kind regards, -- Arne Jørgensen --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=smime.patch Content-Transfer-Encoding: 8bit Index: lisp/ChangeLog =================================================================== RCS file: /usr/local/cvsroot/gnus/lisp/ChangeLog,v retrieving revision 7.637 diff -u -p -r7.637 ChangeLog --- lisp/ChangeLog 21 Feb 2005 15:51:07 -0000 7.637 +++ lisp/ChangeLog 21 Feb 2005 23:30:08 -0000 @@ -1,3 +1,23 @@ +2005-02-22 Arne J,Ax(Brgensen + + * smime.el (smime-ldap-host-list): Doc fix. + (smime-ask-passphrase): Use `password-read-and-add' to read (and + cache) password. + (smime-sign-region): Use it. + (smime-decrypt-region): Use it. + (smime-sign-buffer): Signal an error if `smime-sign-region' fails. + (smime-encrypt-buffer): Signal an error if `smime-encrypt-region' + fails. + (smime-cert-by-ldap-1): Use `base64-encode-string' to convert + certificate from DER to PEM format rather than calling openssl. + + * mml-smime.el (mml-smime-encrypt-query): Remove obsolete comment. + + * mml-sec.el (mml-secure-message): Insert keyfile/certfile tags + for signing/encryption. + + * mml.el (mml-parse-1): Use them. + 2005-02-21 Arne J,Ax(Brgensen * nnrss.el (nnrss-verbose): Removed. Index: lisp/mml-sec.el =================================================================== RCS file: /usr/local/cvsroot/gnus/lisp/mml-sec.el,v retrieving revision 7.6 diff -u -p -r7.6 mml-sec.el --- lisp/mml-sec.el 13 Feb 2005 04:44:40 -0000 7.6 +++ lisp/mml-sec.el 21 Feb 2005 23:30:08 -0000 @@ -1,5 +1,5 @@ ;;; mml-sec.el --- A package with security functions for MML documents -;; Copyright (C) 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. ;; Author: Simon Josefsson @@ -224,6 +224,13 @@ You can also customize or set `mml-signe ;; defuns that add the proper <#secure ...> tag to the top of the message body (defun mml-secure-message (method &optional modesym) (let ((mode (prin1-to-string modesym)) + (tags (append + (if (or (eq modesym 'sign) + (eq modesym 'signencrypt)) + (funcall (nth 2 (assoc method mml-sign-alist)))) + (if (or (eq modesym 'encrypt) + (eq modesym 'signencrypt)) + (funcall (nth 2 (assoc method mml-encrypt-alist)))))) insert-loc) (mml-unsecure-message) (save-excursion @@ -232,8 +239,8 @@ You can also customize or set `mml-signe (concat "^" (regexp-quote mail-header-separator) "\n") nil t) (goto-char (setq insert-loc (match-end 0))) (unless (looking-at "<#secure") - (mml-insert-tag - 'secure 'method method 'mode mode))) + (apply 'mml-insert-tag + 'secure 'method method 'mode mode tags))) (t (error "The message is corrupted. No mail header separator")))) (when (eql insert-loc (point)) Index: lisp/mml-smime.el =================================================================== RCS file: /usr/local/cvsroot/gnus/lisp/mml-smime.el,v retrieving revision 7.5 diff -u -p -r7.5 mml-smime.el --- lisp/mml-smime.el 14 Feb 2005 15:22:17 -0000 7.5 +++ lisp/mml-smime.el 21 Feb 2005 23:30:08 -0000 @@ -135,7 +135,6 @@ result)) (defun mml-smime-encrypt-query () - ;; todo: add ldap support (xemacs ldap api?) ;; todo: try dns/ldap automatically first, before prompting user (let (certs done) (while (not done) Index: lisp/mml.el =================================================================== RCS file: /usr/local/cvsroot/gnus/lisp/mml.el,v retrieving revision 7.24 diff -u -p -r7.24 mml.el --- lisp/mml.el 19 Feb 2005 01:23:10 -0000 7.24 +++ lisp/mml.el 21 Feb 2005 23:30:09 -0000 @@ -158,6 +158,8 @@ one charsets.") ;; included in the message (let* (secure-mode (taginfo (mml-read-tag)) + (keyfile (cdr (assq 'keyfile taginfo))) + (certfile (cdr (assq 'certfile taginfo))) (recipients (cdr (assq 'recipients taginfo))) (sender (cdr (assq 'sender taginfo))) (location (cdr (assq 'tag-location taginfo))) @@ -181,6 +183,10 @@ one charsets.") (setq tags (list "sign" method "encrypt" method)))) (eval `(mml-insert-tag ,secure-mode ,@tags + ,(if keyfile "keyfile") + ,keyfile + ,(if certfile "certfile") + ,certfile ,(if recipients "recipients") ,recipients ,(if sender "sender") Index: lisp/smime.el =================================================================== RCS file: /usr/local/cvsroot/gnus/lisp/smime.el,v retrieving revision 7.8 diff -u -p -r7.8 smime.el --- lisp/smime.el 14 Feb 2005 15:24:44 -0000 7.8 +++ lisp/smime.el 21 Feb 2005 23:30:10 -0000 @@ -121,6 +121,7 @@ (require 'dig) (require 'smime-ldap) +(require 'password) (eval-when-compile (require 'cl)) (defgroup smime nil @@ -218,7 +219,9 @@ If nil, use system defaults." :group 'smime) (defcustom smime-ldap-host-list nil - "A list of LDAP hosts with S/MIME user certificates." + "A list of LDAP hosts with S/MIME user certificates. +If needed search base, binddn, passwd, etc. for the LDAP host +must be set in `ldap-host-parameters-alist'." :type '(repeat (string :tag "Host name")) :group 'smime) @@ -238,11 +241,13 @@ If nil, use system defaults." ;; Password dialog function -(defun smime-ask-passphrase () - "Asks the passphrase to unlock the secret key." +(defun smime-ask-passphrase (&optional cache-key) + "Asks the passphrase to unlock the secret key. +If `cache-key' and `password-cache' is non-nil then cache the +password under `cache-key'." (let ((passphrase - (read-passwd - "Passphrase for secret key (RET for no passphrase): "))) + (password-read-and-add + "Passphrase for secret key (RET for no passphrase): " cache-key))) (if (string= passphrase "") nil passphrase))) @@ -274,11 +279,11 @@ certificates to include in its caar. If included, KEYFILE may be the file containing the PEM encoded private key and certificate itself." (smime-new-details-buffer) - (let ((keyfile (or (car-safe keyfile) keyfile)) - (certfiles (and (cdr-safe keyfile) (cadr keyfile))) - (buffer (generate-new-buffer (generate-new-buffer-name " *smime*"))) - (passphrase (smime-ask-passphrase)) - (tmpfile (smime-make-temp-file "smime"))) + (let* ((certfiles (and (cdr-safe keyfile) (cadr keyfile))) + (keyfile (or (car-safe keyfile) keyfile)) + (buffer (generate-new-buffer (generate-new-buffer-name " *smime*"))) + (passphrase (smime-ask-passphrase (expand-file-name keyfile))) + (tmpfile (smime-make-temp-file "smime"))) (if passphrase (setenv "GNUS_SMIME_PASSPHRASE" passphrase)) (prog1 @@ -339,16 +344,17 @@ is expected to contain of a PEM encoded KEYFILE should contain a PEM encoded key and certificate." (interactive) (with-current-buffer (or buffer (current-buffer)) - (smime-sign-region - (point-min) (point-max) - (if keyfile - keyfile - (smime-get-key-with-certs-by-email - (completing-read - (concat "Sign using which key? " - (if smime-keys (concat "(default " (caar smime-keys) ") ") - "")) - smime-keys nil nil (car-safe (car-safe smime-keys)))))))) + (unless (smime-sign-region + (point-min) (point-max) + (if keyfile + keyfile + (smime-get-key-with-certs-by-email + (completing-read + (concat "Sign using which key? " + (if smime-keys (concat "(default " (caar smime-keys) ") ") + "")) + smime-keys nil nil (car-safe (car-safe smime-keys)))))) + (error "Signing failed")))) (defun smime-encrypt-buffer (&optional certfiles buffer) "S/MIME encrypt BUFFER for recipients specified in CERTFILES. @@ -357,11 +363,12 @@ a PEM encoded key and certificate. Uses nil." (interactive) (with-current-buffer (or buffer (current-buffer)) - (smime-encrypt-region - (point-min) (point-max) - (or certfiles - (list (read-file-name "Recipient's S/MIME certificate: " - smime-certificate-directory nil)))))) + (unless (smime-encrypt-region + (point-min) (point-max) + (or certfiles + (list (read-file-name "Recipient's S/MIME certificate: " + smime-certificate-directory nil)))) + (error "Encryption failed")))) ;; Verify+decrypt region @@ -409,7 +416,7 @@ Any details (stderr on success, stdout a in the buffer specified by `smime-details-buffer'." (smime-new-details-buffer) (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*"))) - CAs (passphrase (smime-ask-passphrase)) + CAs (passphrase (smime-ask-passphrase (expand-file-name keyfile))) (tmpfile (smime-make-temp-file "smime"))) (if passphrase (setenv "GNUS_SMIME_PASSPHRASE" passphrase)) @@ -567,21 +574,21 @@ A string or a list of strings is returne "Get cetificate for MAIL from the ldap server at HOST." (let ((ldapresult (smime-ldap-search (concat "mail=" mail) host '("userCertificate") nil)) - (retbuf (generate-new-buffer (format "*certificate for %s*" mail)))) + (retbuf (generate-new-buffer (format "*certificate for %s*" mail))) + cert) (if (> (length ldapresult) 1) (with-current-buffer retbuf - (set-buffer-multibyte nil) - (insert (nth 1 (car (nth 1 ldapresult)))) - (goto-char (point-min)) - (if (smime-call-openssl-region (point-min) (point-max) t "x509" - "-inform" "DER" "-outform" "PEM") - (progn - (delete-region (point) (point-max)) - retbuf) - (kill-buffer retbuf) - nil)) + (setq cert (base64-encode-string (nth 1 (car (nth 1 ldapresult))) t)) + (insert "-----BEGIN CERTIFICATE-----\n") + (let ((i 0) (len (length cert))) + (while (> (- len 64) i) + (insert (substring cert i (+ i 64)) "\n") + (setq i (+ i 64))) + (insert (substring cert i len) "\n")) + (insert "-----END CERTIFICATE-----\n")) (kill-buffer retbuf) - nil))) + (setq retbuf nil)) + retbuf)) (defun smime-cert-by-ldap (mail) "Find certificate via LDAP for address MAIL." --=-=-=--