1 ;;; ssl.el,v --- ssl functions for Emacsen without them builtin
2 ;; Author: William M. Perry <wmperry@cs.indiana.edu>
6 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7 ;;; Copyright (c) 1995, 1996 by William M. Perry <wmperry@cs.indiana.edu>
8 ;;; Copyright (c) 1996, 97, 98, 99, 2001 Free Software Foundation, Inc.
10 ;;; This file is part of GNU Emacs.
12 ;;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;;; it under the terms of the GNU General Public License as published by
14 ;;; the Free Software Foundation; either version 3, or (at your option)
15 ;;; any later version.
17 ;;; GNU Emacs is distributed in the hope that it will be useful,
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;;; GNU General Public License for more details.
22 ;;; You should have received a copy of the GNU General Public License
23 ;;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;;; Boston, MA 02111-1307, USA.
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 (eval-when-compile (require 'cl))
30 (require 'url) ; for `url-configuration-directory'
33 "Support for `Secure Sockets Layer' encryption."
36 (defcustom ssl-certificate-directory "~/.w3/certs/"
37 "*Directory in which to store CA certificates."
41 (defcustom ssl-rehash-program-name "c_rehash"
42 "*Program to run after adding a cert to a directory .
43 Run with one argument, the directory name."
47 (defcustom ssl-view-certificate-program-name "x509"
48 "*The program to run to provide a human-readable view of a certificate."
52 (defcustom ssl-view-certificate-program-arguments '("-text" "-inform" "DER")
53 "*Arguments that should be passed to the certificate viewing program.
54 The certificate is piped to it.
55 Maybe a way of passing a file should be implemented"
57 :type '(repeat string))
59 (defcustom ssl-certificate-directory-style 'ssleay
60 "*Style of cert database to use, the only valid value right now is `ssleay'.
61 This means a directory of pem encoded certificates with hash symlinks."
63 :type '(choice (const :tag "SSLeay" :value ssleay)
64 (const :tag "OpenSSL" :value openssl)))
66 (defcustom ssl-certificate-verification-policy 0
67 "*How far up the certificate chain we should verify."
69 :type '(choice (const :tag "No verification" :value 0)
70 (const :tag "Verification required" :value 1)
71 (const :tag "Reject connection if verification fails" :value 3)
72 (const :tag "SSL_VERIFY_CLIENT_ONCE" :value 5)))
74 (defcustom ssl-program-name "openssl"
75 "*The program to run in a subprocess to open an SSL connection."
79 (defcustom ssl-program-arguments
84 "-verify" (int-to-string ssl-certificate-verification-policy)
85 "-CApath" ssl-certificate-directory
87 "*Arguments that should be passed to the program `ssl-program-name'.
88 This should be used if your SSL program needs command line switches to
89 specify any behaviour (certificate file locations, etc).
90 The special symbols 'host and 'port may be used in the list of arguments
91 and will be replaced with the hostname and service/port that will be connected
96 (defcustom ssl-view-certificate-program-name ssl-program-name
97 "*The program to run to provide a human-readable view of a certificate."
101 (defcustom ssl-view-certificate-program-arguments
102 '("x509" "-text" "-inform" "DER")
103 "*Arguments that should be passed to the certificate viewing program.
104 The certificate is piped to it.
105 Maybe a way of passing a file should be implemented."
109 (defun ssl-certificate-information (der)
110 "Return an assoc list of information about a certificate in DER format."
111 (let ((certificate (concat "-----BEGIN CERTIFICATE-----\n"
112 (base64-encode-string der)
113 "\n-----END CERTIFICATE-----\n"))
116 (set-buffer (get-buffer-create " *openssl*"))
121 (call-process-region (point-min) (point-max)
123 t (list (current-buffer) nil) t
125 "-subject" ; Print the subject DN
126 "-issuer" ; Print the issuer DN
127 "-dates" ; Both before and after dates
128 "-serial" ; print out serial number
129 "-noout" ; Don't spit out the certificate
135 (goto-char (point-min))
136 (while (re-search-forward "^\\([^=\n\r]+\\)\\s *=\\s *\\(.*\\)" nil t)
137 (push (cons (match-string 1) (match-string 2)) vals))
140 (defun ssl-accept-ca-certificate ()
141 "Ask if the user is willing to accept a new CA certificate.
142 The buffer name should be the intended name of the certificate, and
143 the buffer should probably be in DER encoding"
144 ;; TODO, check if it is really new or if we already know it
145 (let* ((process-connection-type nil)
146 (tmpbuf (generate-new-buffer "X509 CA Certificate Information"))
147 (response (save-excursion
149 (apply 'call-process-region
150 (point-min) (point-max)
151 ssl-view-certificate-program-name
153 ssl-view-certificate-program-arguments))
154 (switch-to-buffer tmpbuf)
155 (goto-char (point-min))
158 "Accept this CA to vouch for secure server identities? ")
159 (kill-buffer tmpbuf)))))
162 (if (not (file-directory-p ssl-certificate-directory))
163 (make-directory ssl-certificate-directory))
164 (case ssl-certificate-directory-style
166 (base64-encode-region (point-min) (point-max))
167 (goto-char (point-min))
168 (insert "-----BEGIN CERTIFICATE-----\n")
169 (goto-char (point-max))
170 (insert "-----END CERTIFICATE-----\n")
171 (let ((f (expand-file-name
172 (concat (file-name-sans-extension (buffer-name)) ".pem")
173 ssl-certificate-directory)))
175 (call-process ssl-rehash-program-name
177 (expand-file-name ssl-certificate-directory))))))))
179 (defvar ssl-exec-wrapper nil)
181 (defun ssl-get-command ()
182 (if (memq system-type '(ms-dos ms-windows axp-vms vax-vms))
183 ;; Nothing to do on DOS, Windows, or VMS!
184 (cons ssl-program-name ssl-program-arguments)
185 (if (not ssl-exec-wrapper)
187 (expand-file-name "exec_ssl_quietly" url-configuration-directory)))
188 (if (not (file-executable-p script))
189 ;; Need to create our handy-dandy utility script to shut OpenSSL
192 (write-region "#!/bin/sh\n\nexec \"$@\" 2> /dev/null\n" nil
194 (set-file-modes script 493))) ; (rwxr-xr-x)
195 (setq ssl-exec-wrapper script)))
196 (cons ssl-exec-wrapper (cons ssl-program-name ssl-program-arguments))))
198 (defun open-ssl-stream (name buffer host service)
199 "Open a SSL connection for a service to a host.
200 Returns a subprocess-object to represent the connection.
201 Input and output work as for subprocesses; `delete-process' closes it.
202 Args are NAME BUFFER HOST SERVICE.
203 NAME is name for process. It is modified if necessary to make it unique.
204 BUFFER is the buffer (or buffer name) to associate with the process.
205 Process output goes at end of that buffer, unless you specify
206 an output stream or filter function to handle the output.
207 BUFFER may be also nil, meaning that this process is not associated
209 Third arg is name of the host to connect to, or its IP address.
210 Fourth arg SERVICE is name of the service desired, or an integer
211 specifying a port number to connect to."
212 (if (integerp service) (setq service (int-to-string service)))
213 (let* ((process-connection-type nil)
215 (proc (eval `(start-process name buffer ,@(ssl-get-command)))))
216 (process-kill-without-query proc)