Mercurial > emacs
annotate lisp/net/tls.el @ 70323:810cd69c168f
(tool-bar-setup): Put Help and Preferences items in the default tool-bar-map.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 01 May 2006 20:15:56 +0000 |
parents | 067115a6e738 |
children | e3694f1cb928 c5406394f567 |
rev | line source |
---|---|
50313 | 1 ;;; tls.el --- TLS/SSL support via wrapper around GnuTLS |
2 | |
64701
34bd8e434dd7
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64085
diff
changeset
|
3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2002, 2003, 2004, |
68648
067115a6e738
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
67643
diff
changeset
|
4 ;; 2005, 2006 Free Software Foundation, Inc. |
50313 | 5 |
6 ;; Author: Simon Josefsson <simon@josefsson.org> | |
7 ;; Keywords: comm, tls, gnutls, ssl | |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
13 ;; the Free Software Foundation; either version 2, or (at your option) | |
14 ;; any later version. | |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
64085 | 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
24 ;; Boston, MA 02110-1301, USA. | |
50313 | 25 |
26 ;;; Commentary: | |
27 | |
28 ;; This package implements a simple wrapper around "gnutls-cli" to | |
29 ;; make Emacs support TLS/SSL. | |
30 ;; | |
31 ;; Usage is the same as `open-network-stream', i.e.: | |
32 ;; | |
33 ;; (setq tmp (open-tls-stream "test" (current-buffer) "news.mozilla.org" 563)) | |
34 ;; ... | |
35 ;; #<process test> | |
36 ;; (process-send-string tmp "mode reader\n") | |
37 ;; 200 secnews.netscape.com Netscape-Collabra/3.52 03615 NNRP ready ... | |
38 ;; nil | |
39 ;; (process-send-string tmp "quit\n") | |
40 ;; 205 | |
41 ;; nil | |
42 | |
43 ;; To use this package as a replacement for ssl.el by William M. Perry | |
44 ;; <wmperry@cs.indiana.edu>, you need to evaluate the following: | |
45 ;; | |
46 ;; (defalias 'open-ssl-stream 'open-tls-stream) | |
47 | |
48 ;;; Code: | |
49 | |
50 (eval-and-compile | |
51 (autoload 'format-spec "format-spec") | |
52 (autoload 'format-spec-make "format-spec")) | |
53 | |
54 (defgroup tls nil | |
55 "Transport Layer Security (TLS) parameters." | |
56 :group 'comm) | |
57 | |
58 (defcustom tls-program '("gnutls-cli -p %p %h" | |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
59 "gnutls-cli -p %p %h --protocols ssl3" |
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
60 "openssl s_client -connect %h:%p -no_ssl2") |
50313 | 61 "List of strings containing commands to start TLS stream to a host. |
62 Each entry in the list is tried until a connection is successful. | |
63 %s is replaced with server hostname, %p with port to connect to. | |
64 The program should read input on stdin and write output to | |
65 stdout. Also see `tls-success' for what the program should output | |
66 after successful negotiation." | |
67 :type '(repeat string) | |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
68 :version "22.1" |
50313 | 69 :group 'tls) |
70 | |
71 (defcustom tls-process-connection-type nil | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
72 "*Value for `process-connection-type' to use when starting TLS process." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
57856
diff
changeset
|
73 :version "22.1" |
50313 | 74 :type 'boolean |
75 :group 'tls) | |
76 | |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
77 (defcustom tls-success "- Handshake was completed\\|SSL handshake has read " |
50313 | 78 "*Regular expression indicating completed TLS handshakes. |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
79 The default is what GNUTLS's \"gnutls-cli\" or OpenSSL's |
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
80 \"openssl s_client\" outputs." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
57856
diff
changeset
|
81 :version "22.1" |
50313 | 82 :type 'regexp |
83 :group 'tls) | |
84 | |
57448
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
85 (defcustom tls-certtool-program (executable-find "certtool") |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
86 "Name of GnuTLS certtool. |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
87 Used by `tls-certificate-information'." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
57856
diff
changeset
|
88 :version "22.1" |
57448
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
89 :type '(repeat string) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
90 :group 'tls) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
91 |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
92 (defun tls-certificate-information (der) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
93 "Parse X.509 certificate in DER format into an assoc list." |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
94 (let ((certificate (concat "-----BEGIN CERTIFICATE-----\n" |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
95 (base64-encode-string der) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
96 "\n-----END CERTIFICATE-----\n")) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
97 (exit-code 0)) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
98 (with-current-buffer (get-buffer-create " *certtool*") |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
99 (erase-buffer) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
100 (insert certificate) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
101 (setq exit-code (condition-case () |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
102 (call-process-region (point-min) (point-max) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
103 tls-certtool-program |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
104 t (list (current-buffer) nil) t |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
105 "--certificate-info") |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
106 (error -1))) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
107 (if (/= exit-code 0) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
108 nil |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
109 (let ((vals nil)) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
110 (goto-char (point-min)) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
111 (while (re-search-forward "^\\([^:]+\\): \\(.*\\)" nil t) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
112 (push (cons (match-string 1) (match-string 2)) vals)) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
113 (nreverse vals)))))) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
114 |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
115 (defun open-tls-stream (name buffer host port) |
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
116 "Open a TLS connection for a port to a host. |
50313 | 117 Returns a subprocess-object to represent the connection. |
118 Input and output work as for subprocesses; `delete-process' closes it. | |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
119 Args are NAME BUFFER HOST PORT. |
50313 | 120 NAME is name for process. It is modified if necessary to make it unique. |
121 BUFFER is the buffer (or buffer-name) to associate with the process. | |
122 Process output goes at end of that buffer, unless you specify | |
123 an output stream or filter function to handle the output. | |
124 BUFFER may be also nil, meaning that this process is not associated | |
125 with any buffer | |
126 Third arg is name of the host to connect to, or its IP address. | |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
127 Fourth arg PORT is an integer specifying a port to connect to." |
50313 | 128 (let ((cmds tls-program) cmd done) |
129 (message "Opening TLS connection to `%s'..." host) | |
130 (while (and (not done) (setq cmd (pop cmds))) | |
131 (message "Opening TLS connection with `%s'..." cmd) | |
132 (let* ((process-connection-type tls-process-connection-type) | |
133 (process (start-process | |
134 name buffer shell-file-name shell-command-switch | |
135 (format-spec | |
136 cmd | |
137 (format-spec-make | |
138 ?h host | |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
139 ?p (if (integerp port) |
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
140 (int-to-string port) |
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
141 port))))) |
50313 | 142 response) |
143 (while (and process | |
144 (memq (process-status process) '(open run)) | |
145 (save-excursion | |
146 (set-buffer buffer) ;; XXX "blue moon" nntp.el bug | |
147 (goto-char (point-min)) | |
148 (not (setq done (re-search-forward tls-success nil t))))) | |
149 (accept-process-output process 1) | |
150 (sit-for 1)) | |
151 (message "Opening TLS connection with `%s'...%s" cmd | |
152 (if done "done" "failed")) | |
153 (if done | |
154 (setq done process) | |
155 (delete-process process)))) | |
156 (message "Opening TLS connection to `%s'...%s" | |
157 host (if done "done" "failed")) | |
158 done)) | |
159 | |
160 (provide 'tls) | |
161 | |
52401 | 162 ;;; arch-tag: 5596d1c4-facc-4bc4-94a9-9863b928d7ac |
50313 | 163 ;;; tls.el ends here |