|
14
|
1 ;;; ssl.el,v --- ssl functions for emacsen without them builtin
|
|
|
2 ;; Author: wmperry
|
|
118
|
3 ;; Created: 1997/03/31 16:22:42
|
|
|
4 ;; Version: 1.14
|
|
14
|
5 ;; Keywords: comm
|
|
|
6
|
|
|
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
8 ;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu)
|
|
16
|
9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
|
|
14
|
10 ;;;
|
|
|
11 ;;; This file is not part of GNU Emacs, but the same permissions apply.
|
|
|
12 ;;;
|
|
|
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.
|
|
|
17 ;;;
|
|
|
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.
|
|
|
22 ;;;
|
|
|
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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
28
|
|
36
|
29 (require 'cl)
|
|
|
30 (require 'base64)
|
|
|
31
|
|
|
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."
|
|
118
|
46 :group 'comm)
|
|
36
|
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)
|
|
22
|
58
|
|
36
|
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
|
|
118
|
77 (defcustom ssl-certificate-verification-policy 0
|
|
36
|
78 "*How far up the certificate chain we should verify."
|
|
|
79 :group 'ssl
|
|
118
|
80 :type '(choice (const :tag "No verification" :value 0)
|
|
|
81 (const :tag "Verification required" :value 1)
|
|
|
82 (const :tag "Reject connection if verification fails" :value 3)
|
|
|
83 (const :tag "SSL_VERIFY_CLIENT_ONCE" :value 5)))
|
|
36
|
84
|
|
|
85 (defcustom ssl-program-name "s_client"
|
|
|
86 "*The program to run in a subprocess to open an SSL connection."
|
|
|
87 :group 'ssl
|
|
|
88 :type 'string)
|
|
|
89
|
|
|
90 (defcustom ssl-program-arguments
|
|
44
|
91 '(;;"-quiet"
|
|
36
|
92 "-host" host
|
|
|
93 "-port" service
|
|
118
|
94 "-verify" (int-to-string ssl-certificate-verification-policy)
|
|
36
|
95 "-CApath" ssl-certificate-directory
|
|
|
96 )
|
|
22
|
97 "*Arguments that should be passed to the program `ssl-program-name'.
|
|
|
98 This should be used if your SSL program needs command line switches to
|
|
32
|
99 specify any behaviour (certificate file locations, etc).
|
|
|
100 The special symbols 'host and 'port may be used in the list of arguments
|
|
|
101 and will be replaced with the hostname and service/port that will be connected
|
|
36
|
102 to."
|
|
|
103 :group 'ssl
|
|
|
104 :type 'list)
|
|
|
105
|
|
|
106 (defun ssl-accept-ca-certificate ()
|
|
|
107 "Ask if the user is willing to accept a new CA certificate. The buffer-name
|
|
|
108 should be the intended name of the certificate, and the buffer should probably
|
|
|
109 be in DER encoding"
|
|
|
110 ;; TODO, check if it is really new or if we already know it
|
|
|
111 (let* ((process-connection-type nil)
|
|
|
112 (tmpbuf (generate-new-buffer "X509 CA Certificate Information"))
|
|
|
113 (response (save-excursion
|
|
|
114 (and (eq 0
|
|
|
115 (apply 'call-process-region
|
|
|
116 (point-min) (point-max)
|
|
|
117 ssl-view-certificate-program-name
|
|
|
118 nil tmpbuf t
|
|
|
119 ssl-view-certificate-program-arguments))
|
|
|
120 (switch-to-buffer tmpbuf)
|
|
|
121 (goto-char (point-min))
|
|
|
122 (or (recenter) t)
|
|
|
123 (yes-or-no-p
|
|
|
124 "Accept this CA to vouch for secure server identities? ")
|
|
|
125 (kill-buffer tmpbuf)))))
|
|
|
126 (if (not response)
|
|
|
127 nil
|
|
|
128 (if (not (file-directory-p ssl-certificate-directory))
|
|
|
129 (make-directory ssl-certificate-directory))
|
|
|
130 (case ssl-certificate-directory-style
|
|
|
131 (ssleay
|
|
|
132 (base64-encode-region (point-min) (point-max))
|
|
|
133 (goto-char (point-min))
|
|
|
134 (insert "-----BEGIN CERTIFICATE-----\n")
|
|
|
135 (goto-char (point-max))
|
|
|
136 (insert "-----END CERTIFICATE-----\n")
|
|
|
137 (let ((f (expand-file-name
|
|
|
138 (concat (file-name-sans-extension (buffer-name)) ".pem")
|
|
|
139 ssl-certificate-directory)))
|
|
|
140 (write-file f)
|
|
|
141 (call-process ssl-rehash-program-name
|
|
|
142 nil nil nil
|
|
|
143 (expand-file-name ssl-certificate-directory))))))))
|
|
14
|
144
|
|
|
145 (defun open-ssl-stream (name buffer host service)
|
|
|
146 "Open a SSL connection for a service to a host.
|
|
|
147 Returns a subprocess-object to represent the connection.
|
|
|
148 Input and output work as for subprocesses; `delete-process' closes it.
|
|
|
149 Args are NAME BUFFER HOST SERVICE.
|
|
|
150 NAME is name for process. It is modified if necessary to make it unique.
|
|
|
151 BUFFER is the buffer (or buffer-name) to associate with the process.
|
|
|
152 Process output goes at end of that buffer, unless you specify
|
|
|
153 an output stream or filter function to handle the output.
|
|
|
154 BUFFER may be also nil, meaning that this process is not associated
|
|
|
155 with any buffer
|
|
|
156 Third arg is name of the host to connect to, or its IP address.
|
|
|
157 Fourth arg SERVICE is name of the service desired, or an integer
|
|
32
|
158 specifying a port number to connect to."
|
|
|
159 (if (integerp service) (setq service (int-to-string service)))
|
|
44
|
160 (let* ((process-connection-type nil)
|
|
32
|
161 (port service)
|
|
|
162 (proc (eval
|
|
|
163 (`
|
|
|
164 (start-process name buffer ssl-program-name
|
|
|
165 (,@ ssl-program-arguments))))))
|
|
14
|
166 (process-kill-without-query proc)
|
|
|
167 proc))
|
|
|
168
|
|
|
169 (provide 'ssl)
|
