--- a/lisp/w3/ssl.el	Mon Aug 13 08:53:21 2007 +0200
+++ b/lisp/w3/ssl.el	Mon Aug 13 08:53:38 2007 +0200
@@ -1,7 +1,7 @@
 ;;; ssl.el,v --- ssl functions for emacsen without them builtin
 ;; Author: wmperry
-;; Created: 1997/03/09 23:02:56
-;; Version: 1.8
+;; Created: 1997/03/15 00:29:34
+;; Version: 1.11
 ;; Keywords: comm
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -26,16 +26,118 @@
 ;;; Boston, MA 02111-1307, USA.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defvar ssl-program-name "ssl"
-  "*The program to run in a subprocess to open an SSL connection.")
+(require 'cl)
+(require 'base64)
+
+(eval-and-compile
+  (condition-case ()
+      (require 'custom)
+    (error nil))
+  (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
+      nil ;; We've got what we needed
+    ;; We have the old custom-library, hack around it!
+    (defmacro defgroup (&rest args)
+      nil)
+    (defmacro defcustom (var value doc &rest args) 
+      (` (defvar (, var) (, value) (, doc))))))
+
+(defgroup ssl nil
+  "Support for `Secure Sockets Layer' encryption."
+  :group 'emacs)
+  
+(defcustom ssl-certificate-directory "~/.w3/certs/"
+  "*Directory to store CA certificates in"
+  :group 'ssl
+  :type 'directory)
+
+(defcustom ssl-rehash-program-name "c_rehash"
+  "*Program to run after adding a cert to a directory .
+Run with one argument, the directory name."
+  :group 'ssl
+  :type 'string)
 
-(defvar ssl-program-arguments '(host port)
+(defcustom ssl-view-certificate-program-name "x509"
+  "*The program to run to provide a human-readable view of a certificate."
+  :group 'ssl
+  :type 'string)
+
+(defcustom ssl-view-certificate-program-arguments '("-text" "-inform" "DER")
+  "*Arguments that should be passed to the certificate viewing program.
+The certificate is piped to it.
+Maybe a way of passing a file should be implemented"
+  :group 'ssl
+  :type 'list)
+
+(defcustom ssl-certificate-directory-style 'ssleay
+  "*Style of cert database to use, the only valid value right now is `ssleay'.
+This means a directory of pem encoded certificates with hash symlinks."
+  :group 'ssl
+  :type '(choice (const :tag "SSLeay" :value ssleay)))  
+
+(defcustom ssl-certificate-verification-depth 0
+  "*How far up the certificate chain we should verify."
+  :group 'ssl
+  :type 'integer)
+
+(defcustom ssl-program-name "s_client"
+  "*The program to run in a subprocess to open an SSL connection."
+  :group 'ssl
+  :type 'string)
+
+(defcustom ssl-program-arguments
+  '("-quiet"
+    "-host" host
+    "-port" service
+    "-verify" ssl-certificate-verification-depth
+    "-CApath" ssl-certificate-directory
+    )
   "*Arguments that should be passed to the program `ssl-program-name'.
 This should be used if your SSL program needs command line switches to
 specify any behaviour (certificate file locations, etc).
 The special symbols 'host and 'port may be used in the list of arguments
 and will be replaced with the hostname and service/port that will be connected
-to.")
+to."
+  :group 'ssl
+  :type 'list)
+
+(defun ssl-accept-ca-certificate ()
+  "Ask if the user is willing to accept a new CA certificate. The buffer-name
+should be the intended name of the certificate, and the buffer should probably
+be in DER encoding"
+  ;; TODO, check if it is really new or if we already know it
+  (let* ((process-connection-type nil)
+	 (tmpbuf (generate-new-buffer "X509 CA Certificate Information"))
+	 (response (save-excursion
+		     (and (eq 0 
+			      (apply 'call-process-region
+				     (point-min) (point-max) 
+				     ssl-view-certificate-program-name 
+				     nil tmpbuf t
+				     ssl-view-certificate-program-arguments))
+			  (switch-to-buffer tmpbuf)
+			  (goto-char (point-min))
+			  (or (recenter) t)
+			  (yes-or-no-p
+			   "Accept this CA to vouch for secure server identities? ")
+			  (kill-buffer tmpbuf)))))
+    (if (not response)
+	nil
+      (if (not (file-directory-p ssl-certificate-directory))
+	  (make-directory ssl-certificate-directory))
+      (case ssl-certificate-directory-style
+	(ssleay
+	 (base64-encode-region (point-min) (point-max))
+	 (goto-char (point-min))
+	 (insert "-----BEGIN CERTIFICATE-----\n")
+	 (goto-char (point-max))
+	 (insert "-----END CERTIFICATE-----\n")
+	 (let ((f (expand-file-name
+		   (concat (file-name-sans-extension (buffer-name)) ".pem")
+		   ssl-certificate-directory)))
+	   (write-file f)
+	   (call-process ssl-rehash-program-name
+			 nil nil nil
+			 (expand-file-name ssl-certificate-directory))))))))
 
 (defun open-ssl-stream (name buffer host service)
   "Open a SSL connection for a service to a host.