From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.user/4389 Path: news.gmane.org!not-for-mail From: david.goldberg6@verizon.net (David S. Goldberg) Newsgroups: gmane.emacs.gnus.user Subject: Re: Automatic retrieval of certificates (S/MIME) Date: Thu, 27 Jan 2005 14:31:40 -0500 Organization: I Yam What I Yam Message-ID: References: <85vf9jw2e2.fsf@news.individual.de> NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: sea.gmane.org 1138670321 23039 80.91.229.2 (31 Jan 2006 01:18:41 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Tue, 31 Jan 2006 01:18:41 +0000 (UTC) Original-X-From: nobody Tue Jan 17 17:33:41 2006 Original-Path: quimby.gnus.org!news.ccs.neu.edu!news.dfci.harvard.edu!news.cis.ohio-state.edu!malgudi.oar.net!news.glorb.com!news-feed01.roc.ny.frontiernet.net!nntp.frontiernet.net!uunet!dca.uu.net!ash.uu.net!news.tufts.edu!newstransit.mitre.org!news.mitre.org!not-for-mail Original-Newsgroups: gnu.emacs.gnus Original-NNTP-Posting-Host: blackbird.mitre.org Original-X-Trace: newslocal.mitre.org 1106854317 25342 129.83.50.102 (27 Jan 2005 19:31:57 GMT) Original-X-Complaints-To: news@mitre.org Original-NNTP-Posting-Date: Thu, 27 Jan 2005 19:31:57 +0000 (UTC) Mail-Copies-To: nobody User-Agent: Gnus/5.110003 (No Gnus v0.3) XEmacs/21.4.15 (cygwin32) Cancel-Lock: sha1:LnAY+KKQe8RjdqmourXTVchQPW0= Original-Xref: bridgekeeper.physik.uni-ulm.de gnus-emacs-gnus:4530 Original-Lines: 328 X-Gnus-Article-Number: 4530 Tue Jan 17 17:33:41 2006 Xref: news.gmane.org gmane.emacs.gnus.user:4389 Archived-At: --=-=-= >>>>> On Thu, 27 Jan 2005 19:33:02 +0100, Simon Josefsson >>>>> said: > Yes, although I'm not sure how to implement that. Mapping e-mail > addresses to S/MIME certificates is not well standardized under Unix. > There is no per-user S/MIME directory on the local machine to use. > If you want to think about how this would work, and perhaps implement > it, that would be very useful. It's not trivial. At work we keep keys in an LDAP database and I use EUDC to fetch those I need into a local directory. Then I've got some helper functions I wrote (attached to the end of this message) that map the addresses in the To and CC headers to keys in the directory, verify the keys, and build the necessary mml. The main entry point for signing and encrypting is dsg-message-smime-message. This works fine for me, but I expect it's not a general solution. > Your analysis is correct. There is a variable that you can set so the > GCC'd copy contain the raw MML tags instead of the encoded version. > The reason for encoding things twice is that encoding a message for > mail/news is in theory different from encoding it for GCC. The same > formatting logic cannot always be used. So that's why Gnus encode the > message twice. It is arguable a bug. On the other hand, a better > solution might be to make S/MIME sign/encrypt so smooth that you > wouldn't care that it is encoded twice. I also find it annoying to have to type my passphrase twice per message. I keep hearing that gpg will soon support s/mime. If/when that happens, would the pgg interface then take care of this? > You can specify the key/cert in the MML tags, if that is what you > meant. See 'MML Definition' in the Emacs MIME manual. You can say, > e.g.: > <#part sign=smime keyfile="~/cacert.user.key"> I use <#multipart> which ends up being a complete replacement the <#secure> tag in that the signature applies to the entire message. I've never got the <#secure> tat to work if there are multiple recipients. -- Dave Goldberg david.goldberg6@verizon.net --=-=-= Content-Type: application/emacs-lisp Content-Disposition: inline Content-Transfer-Encoding: quoted-printable (eudc-server-set 'eudc-default-return-attributes '(cn mitrebusinesstitle mitrejobtitle mitreassignedorg mitreassignedorgdescription mitrecentername telephonenumber facsimiletelephonenumber roomnumber mitremailstop employeenumber mail mitreemailmailbox mitreoriginalhiredate mitreprimarysitedescription mitresaladminplan mitrejoblevel mitrenonemployeeorganization usercertificate\;binary) ldap-host) (setq eudc-duplicate-attribute-handling-method (append eudc-duplicate-attribute-handling-method (list (cons 'usercertificate\;binary 'list)))) (eudc-protocol-set 'eudc-attribute-display-method-alist '(("cert" . dsg-eudc-display-cert-or-certs)) 'ldap) (add-hook 'eudc-mode-hook '(lambda () (define-key eudc-mode-map "B" 'dsg-eudc-display-pic) (define-key eudc-mode-map "T" 'dsg-eudc-get-transfer) (add-local-hook 'kill-buffer-hook 'delete-frame))) (autoload 'eudc-bob-make-button "eudc-bob" "" nil) (defconst dsg-eudc-bob-certificate-menu `("Certificate ops" ["---" nil nil] ["Save certificate" dsg-eudc-bob-save-cert t] ["Print certificate" dsg-eudc-bob-print-cert t] ["Verify certificate" dsg-eudc-bob-verify-cert t])) (defvar dsg-eudc-bob-certificate-keymap nil "Keymap for certificate buttons") (setq dsg-eudc-bob-certificate-keymap (let ((map (make-sparse-keymap))) (define-key map "S" 'dsg-eudc-bob-save-cert) (define-key map "P" 'dsg-eudc-bob-print-cert) (define-key map "V" 'dsg-eudc-bob-verify-cert) (define-key map (if eudc-xemacs-p [button3] [down-mouse-3]) 'eudc-bob-popup-menu) map)) (defun dsg-eudc-bob-save-cert () "Save the certificate associated with the button at point" (interactive) (let* ((record (eudc-bob-get-overlay-prop 'eudc-record)) (mail (cdr (assoc 'mail record))) (sui (substring mail 0 (string-match "@" mail))) (certfile (read-file-name "Save certificate in: " smime-certificate-directory nil nil (format "%s.pem" mail))) (data (eudc-bob-get-overlay-prop 'object-data)) (buffer (generate-new-buffer "*cert-tmp*"))) (save-excursion (if (fboundp 'set-buffer-file-coding-system) (set-buffer-file-coding-system 'binary)) (set-buffer buffer) (insert data) (call-process-region (point-min) (point-max) "openssl" nil nil nil "x509" "-inform" "DER" "-out" (expand-file-name certfile) "-outform" "PEM")))) (defun dsg-eudc-bob-print-cert () "Display the certificate associated with the button at point" (interactive) (let ((data (eudc-bob-get-overlay-prop 'object-data)) (buffer (generate-new-buffer "*cert-tmp*"))) (save-excursion (if (fboundp 'set-buffer-file-coding-system) (set-buffer-file-coding-system 'binary)) (set-buffer buffer) (insert data) (call-process-region (point-min) (point-max) "openssl" t t nil "x509" "-inform" "DER" "-outform" "PEM") (call-process-region (point-min) (point-max) "openssl" t t nil "x509" "-text") (goto-char (point-min))) (let ((pop-up-frames t)) (display-buffer buffer)))) (defvar dsg-cert-buffer "*cert-verify-tmp*" "buffer to hold openssl output") (defvar dsg-eudc-cert-buffer "*eudc-cert-verify-tmp*" "buffer to hold openssl output generated from EUDC returns") (defun dsg-eudc-bob-verify-cert () "Verify the certificate associated with the button at point" (interactive) (let ((data (eudc-bob-get-overlay-prop 'object-data)) (buffer (generate-new-buffer dsg-eudc-cert-buffer))) (save-excursion (if (fboundp 'set-buffer-file-coding-system) (set-buffer-file-coding-system 'binary)) (set-buffer buffer) (make-local-hook 'kill-buffer-hook) (add-hook 'kill-buffer-hook 'delete-window nil t) (insert data) (call-process-region (point-min) (point-max) "openssl" t t nil "x509" "-inform" "DER" "-outform" "PEM") (call-process-region (point-min) (point-max) "openssl" t t nil "verify" "-CApath" smime-CA-directory)) (display-buffer buffer) (shrink-window-if-larger-than-buffer (get-buffer-window buffer)))) (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)))) (defun dsg-verify-all-certs (CERTS) (interactive (list (let ((certlist nil) (response (read-string "All certs? (y/n)[y] " nil nil "y"))) (if (string=3D response "y") (setq certlist (directory-files smime-certificate-directory t "pem$")) (while (string=3D response "n") (add-to-list 'certlist (read-file-name "Cert file: " smime-certificate-directory) t) (setq response (read-string "Done? (y/n)[n] " nil nil "n")))) certlist))) (mapcar 'dsg-verify-cert CERTS)) (defun dsg-get-address-cert (ADDRESS) (concat (expand-file-name ADDRESS smime-certificate-directory) ".pem")) =20=20=20=20 (defun dsg-verify-address-cert (ADDRESS) (dsg-verify-cert (dsg-get-address-cert ADDRESS))) (defun dsg-message-verify-certs () (interactive) (save-excursion (save-restriction (message-narrow-to-headers) (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)))) (mapcar 'dsg-verify-address-cert certlist) (if gcc-key (dsg-verify-cert gcc-key)))))) (defun dsg-message-eudc-query-all () (interactive) (let ((addrs (mapcar (function (lambda (arg) (cons 'email (replace-in-string (cadr arg) "\\([^@]+\\)@\\([^.]+\\)\\.mitre.org" "\\1@mitre.org")))) (append (mail-extract-address-components (mail-fetch-field "From") t) (append (mail-extract-address-components (mail-fetch-field "To") t) (and (mail-fetch-field "Cc") (mail-extract-address-components (mail-fetch-field "Cc") t))))))) (dsg-eudc-query-emails addrs))) (defun dsg-eudc-query-emails (addrs) ;; go through the list of addrs, query each with eudc and then display a = buffer with all the results (let (results) (while addrs (setq results (append results (condition-case nil (eudc-multi-query (list (list (car addrs))) 'eudc-echo-progress nil t) (error nil)))) (setq addrs (cdr addrs))) (select-frame (make-frame)) (eudc-setup-record-display-buffer) (mapcar (function (lambda (server-matches) (eudc-display-records server-matches eudc-use-raw-directory-names))) results) (eudc-close-record-display-buffer))) (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-message-smime-message () (interactive) (let ((mml-encrypt-alist '(("smime" mml-smime-encrypt-buffer dsg-message-make-cert-tags))) (pt (point)) here) ;; first verify we have all necessary certs (if (get-buffer dsg-cert-buffer) (erase-buffer dsg-cert-buffer)) (dsg-message-verify-certs) (save-window-excursion (set-buffer dsg-cert-buffer) (goto-char (point-min)) (while (not (=3D (point) (point-max))) (if (looking-at ".*OK$\\|^$") (forward-line 1) (error "Bad cert, fix or don't encrypt")))) ;; then set up the message as a multipart/mixed (message-goto-body) (setq here (- pt (point))) (kill-region (point) (point-max)) (mml-insert-multipart "mixed") ;; next secure the part (mml-secure-encrypt-smime) (mml-secure-sign-smime) ;; put the message body back (yank) ;; put the cursor back where it was (message-goto-body) (if (< here 0) (goto-char (+ (point) here)) (forward-line 1) ; skip over MML (goto-char (+ (point) here))))) (defun dsg-eudc-display-cert-or-certs (data) "Display a button (or buttons, if > 1) for a user's cert(s)" (if (not (listp data)) (eudc-bob-make-button "[Certificate]" dsg-eudc-bob-certificate-keymap dsg-eudc-bob-certificate-menu (list 'duplicable t 'start-open t 'end-open t 'object-data data)) (let ((certs data) (ncerts 1)) (while certs (eudc-bob-make-button (format "[Certificate %d]" ncerts) dsg-eudc-bob-certificate-keymap dsg-eudc-bob-certificate-menu (list 'duplicable t 'start-open t 'end-open t 'object-data (car certs))) (setq certs (cdr certs)) (setq ncerts (1+ ncerts)))))) --=-=-=--