1
;;; ssl.el,v --- ssl functions for emacsen without them builtin
3
;; Created: 1999/10/14 12:44:18
7
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8
;;; Copyright (c) 1995, 1996 by William M. Perry <wmperry@cs.indiana.edu>
9
;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
11
;;; This file is part of GNU Emacs.
13
;;; GNU Emacs is free software; you can redistribute it and/or modify
14
;;; it under the terms of the GNU General Public License as published by
15
;;; the Free Software Foundation; either version 2, or (at your option)
16
;;; any later version.
18
;;; GNU Emacs is distributed in the hope that it will be useful,
19
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21
;;; GNU General Public License for more details.
23
;;; You should have received a copy of the GNU General Public License
24
;;; along with GNU Emacs; see the file COPYING. If not, write to the
25
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26
;;; Boston, MA 02111-1307, USA.
27
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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)
41
(defmacro defcustom (var value doc &rest args)
42
(` (defvar (, var) (, value) (, doc))))))
45
"Support for `Secure Sockets Layer' encryption."
48
(defcustom ssl-certificate-directory "~/.w3/certs/"
49
"*Directory to store CA certificates in"
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."
59
(defcustom ssl-view-certificate-program-name "x509"
60
"*The program to run to provide a human-readable view of a certificate."
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"
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."
75
:type '(choice (const :tag "SSLeay" :value ssleay)
76
(const :tag "OpenSSL" :value openssl)))
78
(defcustom ssl-certificate-verification-policy 0
79
"*How far up the certificate chain we should verify."
81
:type '(choice (const :tag "No verification" :value 0)
82
(const :tag "Verification required" :value 1)
83
(const :tag "Reject connection if verification fails" :value 3)
84
(const :tag "SSL_VERIFY_CLIENT_ONCE" :value 5)))
86
(defcustom ssl-program-name "openssl"
87
"*The program to run in a subprocess to open an SSL connection."
91
(defcustom ssl-program-arguments
96
"-verify" (int-to-string ssl-certificate-verification-policy)
97
"-CApath" ssl-certificate-directory
99
"*Arguments that should be passed to the program `ssl-program-name'.
100
This should be used if your SSL program needs command line switches to
101
specify any behaviour (certificate file locations, etc).
102
The special symbols 'host and 'port may be used in the list of arguments
103
and will be replaced with the hostname and service/port that will be connected
108
(defun ssl-certificate-information (der)
109
"Return an assoc list of information about a certificate in DER format."
110
(let ((certificate (concat "-----BEGIN CERTIFICATE-----\n"
111
(base64-encode-string der)
112
"\n-----END CERTIFICATE-----\n"))
115
(set-buffer (get-buffer-create " *openssl*"))
118
(setq exit-code (condition-case ()
119
(call-process-region (point-min) (point-max)
121
t (list (current-buffer) nil) t
123
"-subject" ; Print the subject DN
124
"-issuer" ; Print the issuer DN
125
"-dates" ; Both before and after dates
126
"-serial" ; print out serial number
127
"-noout" ; Don't spit out the certificate
133
(goto-char (point-min))
134
(while (re-search-forward "^\\([^=\n\r]+\\)\\s *=\\s *\\(.*\\)" nil t)
135
(push (cons (match-string 1) (match-string 2)) vals))
138
(defun ssl-accept-ca-certificate ()
139
"Ask if the user is willing to accept a new CA certificate. The buffer-name
140
should be the intended name of the certificate, and the buffer should probably
142
;; TODO, check if it is really new or if we already know it
143
(let* ((process-connection-type nil)
144
(tmpbuf (generate-new-buffer "X509 CA Certificate Information"))
145
(response (save-excursion
147
(apply 'call-process-region
148
(point-min) (point-max)
149
ssl-view-certificate-program-name
151
ssl-view-certificate-program-arguments))
152
(switch-to-buffer tmpbuf)
153
(goto-char (point-min))
156
"Accept this CA to vouch for secure server identities? ")
157
(kill-buffer tmpbuf)))))
160
(if (not (file-directory-p ssl-certificate-directory))
161
(make-directory ssl-certificate-directory))
162
(case ssl-certificate-directory-style
164
(base64-encode-region (point-min) (point-max))
165
(goto-char (point-min))
166
(insert "-----BEGIN CERTIFICATE-----\n")
167
(goto-char (point-max))
168
(insert "-----END CERTIFICATE-----\n")
169
(let ((f (expand-file-name
170
(concat (file-name-sans-extension (buffer-name)) ".pem")
171
ssl-certificate-directory)))
173
(call-process ssl-rehash-program-name
175
(expand-file-name ssl-certificate-directory))))))))
177
(defun open-ssl-stream (name buffer host service)
178
"Open a SSL connection for a service to a host.
179
Returns a subprocess-object to represent the connection.
180
Input and output work as for subprocesses; `delete-process' closes it.
181
Args are NAME BUFFER HOST SERVICE.
182
NAME is name for process. It is modified if necessary to make it unique.
183
BUFFER is the buffer (or buffer-name) to associate with the process.
184
Process output goes at end of that buffer, unless you specify
185
an output stream or filter function to handle the output.
186
BUFFER may be also nil, meaning that this process is not associated
188
Third arg is name of the host to connect to, or its IP address.
189
Fourth arg SERVICE is name of the service desired, or an integer
190
specifying a port number to connect to."
191
(if (integerp service) (setq service (int-to-string service)))
192
(let* ((process-connection-type nil)
196
(start-process name buffer ssl-program-name
197
(,@ ssl-program-arguments))))))
198
(process-kill-without-query proc)
added
removed
utils/ssl.el
