Mercurial > hg > xemacs-beta

comparison lisp/w3/ssl.el @ 36:c53a95d3c46d r19-15b101

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b101
author cvs
date Mon, 13 Aug 2007 08:53:38 +0200
parents e04119814345
children 8d2a9b52c682
comparison
equal deleted inserted replaced
35:279432d5c479 36:c53a95d3c46d
1 ;;; ssl.el,v --- ssl functions for emacsen without them builtin 1 ;;; ssl.el,v --- ssl functions for emacsen without them builtin
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/03/09 23:02:56 3 ;; Created: 1997/03/15 00:29:34
4 ;; Version: 1.8 4 ;; Version: 1.11
5 ;; Keywords: comm 5 ;; Keywords: comm
6 6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu) 8 ;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu)
9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. 9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
24 ;;; along with GNU Emacs; see the file COPYING. If not, write to the 24 ;;; along with GNU Emacs; see the file COPYING. If not, write to the
25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;;; Boston, MA 02111-1307, USA. 26 ;;; Boston, MA 02111-1307, USA.
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 28
29 (defvar ssl-program-name "ssl" 29 (require 'cl)
30 "*The program to run in a subprocess to open an SSL connection.") 30 (require 'base64)
31 31
32 (defvar ssl-program-arguments '(host port) 32 (eval-and-compile
33 (condition-case ()
34 (require 'custom)
35 (error nil))
36 (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
37 nil ;; We've got what we needed
38 ;; We have the old custom-library, hack around it!
39 (defmacro defgroup (&rest args)
40 nil)
41 (defmacro defcustom (var value doc &rest args)
42 (` (defvar (, var) (, value) (, doc))))))
43
44 (defgroup ssl nil
45 "Support for `Secure Sockets Layer' encryption."
46 :group 'emacs)
47
48 (defcustom ssl-certificate-directory "~/.w3/certs/"
49 "*Directory to store CA certificates in"
50 :group 'ssl
51 :type 'directory)
52
53 (defcustom ssl-rehash-program-name "c_rehash"
54 "*Program to run after adding a cert to a directory .
55 Run with one argument, the directory name."
56 :group 'ssl
57 :type 'string)
58
59 (defcustom ssl-view-certificate-program-name "x509"
60 "*The program to run to provide a human-readable view of a certificate."
61 :group 'ssl
62 :type 'string)
63
64 (defcustom ssl-view-certificate-program-arguments '("-text" "-inform" "DER")
65 "*Arguments that should be passed to the certificate viewing program.
66 The certificate is piped to it.
67 Maybe a way of passing a file should be implemented"
68 :group 'ssl
69 :type 'list)
70
71 (defcustom ssl-certificate-directory-style 'ssleay
72 "*Style of cert database to use, the only valid value right now is `ssleay'.
73 This means a directory of pem encoded certificates with hash symlinks."
74 :group 'ssl
75 :type '(choice (const :tag "SSLeay" :value ssleay)))
76
77 (defcustom ssl-certificate-verification-depth 0
78 "*How far up the certificate chain we should verify."
79 :group 'ssl
80 :type 'integer)
81
82 (defcustom ssl-program-name "s_client"
83 "*The program to run in a subprocess to open an SSL connection."
84 :group 'ssl
85 :type 'string)
86
87 (defcustom ssl-program-arguments
88 '("-quiet"
89 "-host" host
90 "-port" service
91 "-verify" ssl-certificate-verification-depth
92 "-CApath" ssl-certificate-directory
93 )
33 "*Arguments that should be passed to the program `ssl-program-name'. 94 "*Arguments that should be passed to the program `ssl-program-name'.
34 This should be used if your SSL program needs command line switches to 95 This should be used if your SSL program needs command line switches to
35 specify any behaviour (certificate file locations, etc). 96 specify any behaviour (certificate file locations, etc).
36 The special symbols 'host and 'port may be used in the list of arguments 97 The special symbols 'host and 'port may be used in the list of arguments
37 and will be replaced with the hostname and service/port that will be connected 98 and will be replaced with the hostname and service/port that will be connected
38 to.") 99 to."
100 :group 'ssl
101 :type 'list)
102
103 (defun ssl-accept-ca-certificate ()
104 "Ask if the user is willing to accept a new CA certificate. The buffer-name
105 should be the intended name of the certificate, and the buffer should probably
106 be in DER encoding"
107 ;; TODO, check if it is really new or if we already know it
108 (let* ((process-connection-type nil)
109 (tmpbuf (generate-new-buffer "X509 CA Certificate Information"))
110 (response (save-excursion
111 (and (eq 0
112 (apply 'call-process-region
113 (point-min) (point-max)
114 ssl-view-certificate-program-name
115 nil tmpbuf t
116 ssl-view-certificate-program-arguments))
117 (switch-to-buffer tmpbuf)
118 (goto-char (point-min))
119 (or (recenter) t)
120 (yes-or-no-p
121 "Accept this CA to vouch for secure server identities? ")
122 (kill-buffer tmpbuf)))))
123 (if (not response)
124 nil
125 (if (not (file-directory-p ssl-certificate-directory))
126 (make-directory ssl-certificate-directory))
127 (case ssl-certificate-directory-style
128 (ssleay
129 (base64-encode-region (point-min) (point-max))
130 (goto-char (point-min))
131 (insert "-----BEGIN CERTIFICATE-----\n")
132 (goto-char (point-max))
133 (insert "-----END CERTIFICATE-----\n")
134 (let ((f (expand-file-name
135 (concat (file-name-sans-extension (buffer-name)) ".pem")
136 ssl-certificate-directory)))
137 (write-file f)
138 (call-process ssl-rehash-program-name
139 nil nil nil
140 (expand-file-name ssl-certificate-directory))))))))
39 141
40 (defun open-ssl-stream (name buffer host service) 142 (defun open-ssl-stream (name buffer host service)
41 "Open a SSL connection for a service to a host. 143 "Open a SSL connection for a service to a host.
42 Returns a subprocess-object to represent the connection. 144 Returns a subprocess-object to represent the connection.
43 Input and output work as for subprocesses; `delete-process' closes it. 145 Input and output work as for subprocesses; `delete-process' closes it.