1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
|
;;; rudel-tls.el --- Start TLS protocol.
;;
;; Copyright (C) 2008, 2009 Jan Moringen
;;
;; Author: Jan Moringen <scymtym@users.sourceforge.net>
;; Keywords: Rudel, TLS, encryption, starttls, gnutls
;; X-RCS: $Id:$
;;
;; This file is part of Rudel.
;;
;; Rudel is free software: you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Rudel is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with rudel. If not, see <http://www.gnu.org/licenses>.
;;; Commentary:
;;
;; This contains a simple implementation of the so calls Start TLS
;; protocol, which means enabling TLS encryption for an existing
;; network connection.
;;; History:
;;
;; 0.1 - Initial revision.
;;; Code:
;;
(require 'format-spec)
(require 'rudel)
(require 'rudel-util)
;;; Customization
;;
(defcustom rudel-tls-client-program
"gnutls-cli"
"The gnutls client program to use for encrypted connections."
:group 'rudel
:type 'file)
(defcustom rudel-tls-client-arguments
"--starttls --kx ANON_DH --port %p %h"
"Arguments passed to the gnutls client program."
:group 'rudel
:type 'string)
;;; TLS functions
;;
(defun rudel-tls-make-process (&rest args)
"Make a network process with keyword arguments ARGS.
This function works similar to `make-network-process'. Supported
keyword arguments are :name (ignore), :host, :port, :filter
and :sentinel. The returned process object is suitable for
start-TLS. Once the enclosing protocol indicates TLS encryption
should start, `rudel-tls-start-tls' can be called to enabled TLS
for the network connection."
(let* ((host (plist-get args :host)) ;; TODO clumsy
(port (plist-get args :service))
(filter (plist-get args :filter))
(sentinel (plist-get args :sentinel))
;; Compile the command to start the TLS binary.
(arguments (format-spec rudel-tls-client-arguments
(format-spec-make
?h host
?p (number-to-string port))))
;; Start the TLS program.
(process (apply #'start-process
(format "*tls-%s*" host) nil
rudel-tls-client-program
(split-string arguments " "))))
;; Store filter function and attach proxy filter to handle TLS
;; handshake.
(when filter
(rudel-set-process-object process filter :old-filter))
(set-process-filter process #'rudel-tls-wait-init)
;; Attach sentinel function.
(when sentinel
(set-process-sentinel process sentinel))
;; Mark the process as supporting TLS encryption
(rudel-set-process-object process t :supports-tls)
process)
)
(defun rudel-tls-start-tls (process)
"Enable TLS encryption for the network connection PROCESS.
This only works if PROCESS has been created by
`rudel-tls-make-process'."
;; Save current filter function.
(rudel-set-process-object
process (process-filter process) :old-filter)
;; Install TLS handshake filter function and signal program to start
;; TLS handshake.
(message "tls-start-tls: switching to \"handshake\" filter")
(set-process-filter process #'rudel-tls-wait-handshake)
(signal-process process 'sigalrm)
)
(defun rudel-tls-wait-init (process data)
"Is installed as process filter on PROCESS until gnutls is done printing messages."
;; Retrieve complete lines.
(let ((buffer (rudel-process-object process :buffer)))
(rudel-assemble-line-fragments data buffer)
(rudel-set-process-object process buffer :buffer))
(let ((client-data)
(old-filter (rudel-process-object process :old-filter))
(client-mode))
;; Assemble lines that were not generated by gnutls. It is very
;; brittle to wait for last line of gnutls output like, but it
;; cannot be helped.
(rudel-loop-lines data line
(if client-mode
(setq client-data (concat client-data line "\n"))
(when (string-match-p "- Simple Client Mode.*" line)
(setq client-mode t))))
;; When there are any lines not generated by gnutls,
;; initialization is over. Process the data and install the old
;; filter function.
(when client-data
(funcall old-filter process client-data))
(when client-mode
(message "tls-wait-init: switching back to old filter")
(set-process-filter process old-filter)))
)
(defun rudel-tls-wait-handshake (process data)
"Is installed as process filter on PROCESS while gnutls is doing the TLS handshake."
;; Retrieve complete lines.
(let ((buffer (rudel-process-object process :buffer)))
(rudel-assemble-line-fragments data buffer)
(rudel-set-process-object process buffer :buffer))
(let ((client-data)
(old-filter (rudel-process-object process :old-filter))
(client-mode))
;; Assemble lines that were not generated by gnutls. It is very
;; brittle to wait for last line of gnutls output like, but it
;; cannot be helped.
(rudel-loop-lines data line
(if client-mode
(setq client-data (concat client-data line "\n"))
(when (string-match-p "- Compression.*" line)
(setq client-mode t))))
;; When there are any lines not generated by gnutls, handshake is
;; over. Process the data and install `established' filter
;; function.
(when client-data
(funcall old-filter process client-data))
(when client-mode
(message "tls-wait-handshake: switching to \"established\" filter")
(set-process-filter process #'rudel-tls-established)
(rudel-set-process-object process t :encryption)))
)
(defun rudel-tls-established (process data)
"Is installed as process filter on PROCESS after gnutls has established TLS encryption."
;; Retrieve complete lines.
(let ((buffer (rudel-process-object process :buffer)))
(rudel-assemble-line-fragments data buffer)
(rudel-set-process-object process buffer :buffer))
(let ((client-data)
(old-filter (rudel-process-object process :old-filter)))
;; Assemble lines that were not generated by gnutls.
(rudel-loop-lines data line
(unless (string-match-p "- Peer has closed the GNUTLS connection" line)
(setq client-data (concat client-data line "\n"))))
;; When there are any lines not generated by gnutls, pass those to
;; the old filter function.
(when client-data
(funcall old-filter process client-data)))
)
(provide 'rudel-tls)
;;; rudel-tls.el ends here
|
