2000-11-13 15:29:58 ShengHuo ZHU <zsh@cs.rochester.edu>

[gnus] / lisp / smime.el

diff --git a/lisp/smime.el b/lisp/smime.el
index 364b4d9..530ed8d 100644 (file)
--- a/lisp/smime.el
+++ b/lisp/smime.el
@@ -26,9 +26,9 @@
 ;; This library perform S/MIME operations from within Emacs.
 ;;
 ;; Functions for fetching certificates from public repositories are
-;; NOT provided (yet).
+;; provided, currently only from DNS.  LDAP support (via EUDC) is planned.
 ;;
-;; It uses OpenSSL (tested with version 0.9.5a) for signing,
+;; It uses OpenSSL (tested with version 0.9.5a and 0.9.6) for signing,
 ;; encryption and decryption.
 ;;
 ;; Some general knowledge of S/MIME, X.509, PKCS#12, PEM etc is
@@ -102,6 +102,9 @@
 
 ;;; Code:
 
+(require 'dig)
+(eval-when-compile (require 'cl))
+
 (defgroup smime nil
   "S/MIME configuration.")
 
@@ -137,11 +140,24 @@ manually."
   :type 'directory
   :group 'smime)
 
-(defcustom smime-openssl-program "openssl"
+(defcustom smime-openssl-program 
+  (and (condition-case () 
+          (eq 0 (call-process "openssl" nil nil nil "version"))
+        (error nil))
+       "openssl")
   "Name of OpenSSL binary."
   :type 'string
   :group 'smime)
 
+(defcustom smime-dns-server nil
+  "DNS server to query certificates from.
+If nil, use system defaults."
+  :type '(choice (const :tag "System defaults")
+                string)
+  :group 'dig)
+
+(defvar smime-details-buffer "*S/MIME OpenSSL output*")
+
 ;; OpenSSL wrappers.
 
 (defun smime-call-openssl-region (b e buf &rest args)
@@ -169,6 +185,9 @@ private key and certificate."
          (when (looking-at "^MIME-Version: 1.0$")
            (delete-region (point) (progn (forward-line 1) (point))))
          t)
+      (with-current-buffer (get-buffer-create smime-details-buffer)
+       (goto-char (point-max))
+       (insert-buffer buffer))
       (kill-buffer buffer))))
 
 (defun smime-encrypt-region (b e certfiles)
@@ -185,6 +204,9 @@ is expected to contain of a PEM encoded certificate."
          (when (looking-at "^MIME-Version: 1.0$")
            (delete-region (point) (progn (forward-line 1) (point))))
          t)
+      (with-current-buffer (get-buffer-create smime-details-buffer)
+       (goto-char (point-max))
+       (insert-buffer buffer))
       (kill-buffer buffer))))
 
 ;; Sign+encrypt buffer
@@ -230,6 +252,9 @@ nil."
            (message "S/MIME message verified succesfully.")
          (message "S/MIME message NOT verified successfully.")
          nil)
+      (with-current-buffer (get-buffer-create smime-details-buffer)
+       (goto-char (point-max))
+       (insert-buffer buffer))
       (kill-buffer buffer))))
   
 (defun smime-decrypt-region (b e keyfile)
@@ -239,6 +264,9 @@ nil."
                 "-recip" keyfile)
       
       )
+    (with-current-buffer (get-buffer-create smime-details-buffer)
+      (goto-char (point-max))
+      (insert-buffer buffer))
     (kill-buffer buffer)))
   
 ;; Verify+Decrypt buffer
@@ -263,6 +291,34 @@ Uses current buffer if BUFFER is nil, queries user of KEYFILE is nil."
                           (and (listp (car-safe smime-keys)) 
                                (caar smime-keys))))))))
 
+;; Find certificates
+
+(defun smime-mail-to-domain (mailaddr)
+  (if (string-match "@" mailaddr)
+      (replace-match "." 'fixedcase 'literal mailaddr)
+    mailaddr))
+
+(defun smime-cert-by-dns (mail)
+  (let* ((dig-dns-server smime-dns-server)
+        (digbuf (dig-invoke (smime-mail-to-domain mail) "cert" nil nil "+vc"))
+        (retbuf (generate-new-buffer (format "*certificate for %s*" mail)))
+        (certrr (with-current-buffer digbuf
+                  (dig-extract-rr (smime-mail-to-domain mail) "cert")))
+        (cert (and certrr (dig-rr-get-pkix-cert certrr))))
+      (if cert
+         (with-current-buffer retbuf
+           (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)
+       (setq retbuf nil))
+      (kill-buffer digbuf)
+      retbuf))
+
 ;; User interface.
 
 (defvar smime-buffer "*SMIME*")