Add server side support for supported_versions extension
[openssl.git] / util / TLSProxy / Record.pm
1 # Copyright 2016 The OpenSSL Project Authors. All Rights Reserved.
2 #
3 # Licensed under the OpenSSL license (the "License").  You may not use
4 # this file except in compliance with the License.  You can obtain a copy
5 # in the file LICENSE in the source distribution or at
6 # https://www.openssl.org/source/license.html
7
8 use strict;
9
10 use TLSProxy::Proxy;
11
12 package TLSProxy::Record;
13
14 my $server_ccs_seen = 0;
15 my $client_ccs_seen = 0;
16 my $etm = 0;
17
18 use constant TLS_RECORD_HEADER_LENGTH => 5;
19
20 #Record types
21 use constant {
22     RT_APPLICATION_DATA => 23,
23     RT_HANDSHAKE => 22,
24     RT_ALERT => 21,
25     RT_CCS => 20,
26     RT_UNKNOWN => 100
27 };
28
29 my %record_type = (
30     RT_APPLICATION_DATA, "APPLICATION DATA",
31     RT_HANDSHAKE, "HANDSHAKE",
32     RT_ALERT, "ALERT",
33     RT_CCS, "CCS",
34     RT_UNKNOWN, "UNKNOWN"
35 );
36
37 use constant {
38     VERS_TLS_1_4 => 773,
39     VERS_TLS_1_3 => 772,
40     VERS_TLS_1_2 => 771,
41     VERS_TLS_1_1 => 770,
42     VERS_TLS_1_0 => 769,
43     VERS_SSL_3_0 => 768,
44     VERS_SSL_LT_3_0 => 767
45 };
46
47 my %tls_version = (
48     VERS_TLS_1_3, "TLS1.3",
49     VERS_TLS_1_2, "TLS1.2",
50     VERS_TLS_1_1, "TLS1.1",
51     VERS_TLS_1_0, "TLS1.0",
52     VERS_SSL_3_0, "SSL3",
53     VERS_SSL_LT_3_0, "SSL<3"
54 );
55
56 #Class method to extract records from a packet of data
57 sub get_records
58 {
59     my $class = shift;
60     my $server = shift;
61     my $flight = shift;
62     my $packet = shift;
63     my @record_list = ();
64     my @message_list = ();
65     my $data;
66     my $content_type;
67     my $version;
68     my $len;
69     my $len_real;
70     my $decrypt_len;
71
72     my $recnum = 1;
73     while (length ($packet) > 0) {
74         print " Record $recnum";
75         if ($server) {
76             print " (server -> client)\n";
77         } else {
78             print " (client -> server)\n";
79         }
80         #Get the record header
81         if (length($packet) < TLS_RECORD_HEADER_LENGTH) {
82             print "Partial data : ".length($packet)." bytes\n";
83             $packet = "";
84         } else {
85             ($content_type, $version, $len) = unpack('CnnC*', $packet);
86             $data = substr($packet, 5, $len);
87
88             print "  Content type: ".$record_type{$content_type}."\n";
89             print "  Version: $tls_version{$version}\n";
90             print "  Length: $len";
91             if ($len == length($data)) {
92                 print "\n";
93                 $decrypt_len = $len_real = $len;
94             } else {
95                 print " (expected), ".length($data)." (actual)\n";
96                 $decrypt_len = $len_real = length($data);
97             }
98
99             my $record = TLSProxy::Record->new(
100                 $flight,
101                 $content_type,
102                 $version,
103                 $len,
104                 0,
105                 $len_real,
106                 $decrypt_len,
107                 substr($packet, TLS_RECORD_HEADER_LENGTH, $len_real),
108                 substr($packet, TLS_RECORD_HEADER_LENGTH, $len_real)
109             );
110
111             if (($server && $server_ccs_seen)
112                      || (!$server && $client_ccs_seen)) {
113                 if ($version != VERS_TLS_1_3() && $etm) {
114                     $record->decryptETM();
115                 } else {
116                     $record->decrypt();
117                 }
118             }
119
120             push @record_list, $record;
121
122             #Now figure out what messages are contained within this record
123             my @messages = TLSProxy::Message->get_messages($server, $record);
124             push @message_list, @messages;
125
126             $packet = substr($packet, TLS_RECORD_HEADER_LENGTH + $len_real);
127             $recnum++;
128         }
129     }
130
131     return (\@record_list, \@message_list);
132 }
133
134 sub clear
135 {
136     $server_ccs_seen = 0;
137     $client_ccs_seen = 0;
138 }
139
140 #Class level accessors
141 sub server_ccs_seen
142 {
143     my $class = shift;
144     if (@_) {
145       $server_ccs_seen = shift;
146     }
147     return $server_ccs_seen;
148 }
149 sub client_ccs_seen
150 {
151     my $class = shift;
152     if (@_) {
153       $client_ccs_seen = shift;
154     }
155     return $client_ccs_seen;
156 }
157 #Enable/Disable Encrypt-then-MAC
158 sub etm
159 {
160     my $class = shift;
161     if (@_) {
162       $etm = shift;
163     }
164     return $etm;
165 }
166
167 sub new
168 {
169     my $class = shift;
170     my ($flight,
171         $content_type,
172         $version,
173         $len,
174         $sslv2,
175         $len_real,
176         $decrypt_len,
177         $data,
178         $decrypt_data) = @_;
179     
180     my $self = {
181         flight => $flight,
182         content_type => $content_type,
183         version => $version,
184         len => $len,
185         sslv2 => $sslv2,
186         len_real => $len_real,
187         decrypt_len => $decrypt_len,
188         data => $data,
189         decrypt_data => $decrypt_data,
190         orig_decrypt_data => $decrypt_data
191     };
192
193     return bless $self, $class;
194 }
195
196 #Decrypt using encrypt-then-MAC
197 sub decryptETM
198 {
199     my ($self) = shift;
200
201     my $data = $self->data;
202
203     if($self->version >= VERS_TLS_1_1()) {
204         #TLS1.1+ has an explicit IV. Throw it away
205         $data = substr($data, 16);
206     }
207
208     #Throw away the MAC (assumes MAC is 20 bytes for now. FIXME)
209     $data = substr($data, 0, length($data) - 20);
210
211     #Find out what the padding byte is
212     my $padval = unpack("C", substr($data, length($data) - 1));
213
214     #Throw away the padding
215     $data = substr($data, 0, length($data) - ($padval + 1));
216
217     $self->decrypt_data($data);
218     $self->decrypt_len(length($data));
219
220     return $data;
221 }
222
223 #Standard decrypt
224 sub decrypt()
225 {
226     my ($self) = shift;
227     my $mactaglen = 20;
228     my $data = $self->data;
229
230     #Throw away any IVs
231     if ($self->version >= VERS_TLS_1_3()) {
232         #8 bytes for a GCM IV
233         $data = substr($data, 8);
234         $mactaglen = 16;
235     } elsif ($self->version >= VERS_TLS_1_1()) {
236         #16 bytes for a standard IV
237         $data = substr($data, 16);
238
239         #Find out what the padding byte is
240         my $padval = unpack("C", substr($data, length($data) - 1));
241
242         #Throw away the padding
243         $data = substr($data, 0, length($data) - ($padval + 1));
244     }
245
246     #Throw away the MAC or TAG
247     $data = substr($data, 0, length($data) - $mactaglen);
248
249     $self->decrypt_data($data);
250     $self->decrypt_len(length($data));
251
252     return $data;
253 }
254
255 #Reconstruct the on-the-wire record representation
256 sub reconstruct_record
257 {
258     my $self = shift;
259     my $data;
260
261     if ($self->sslv2) {
262         $data = pack('n', $self->len | 0x8000);
263     } else {
264         $data = pack('Cnn', $self->content_type, $self->version, $self->len);
265     }
266     $data .= $self->data;
267
268     return $data;
269 }
270
271 #Read only accessors
272 sub flight
273 {
274     my $self = shift;
275     return $self->{flight};
276 }
277 sub content_type
278 {
279     my $self = shift;
280     return $self->{content_type};
281 }
282 sub sslv2
283 {
284     my $self = shift;
285     return $self->{sslv2};
286 }
287 sub len_real
288 {
289     my $self = shift;
290     return $self->{len_real};
291 }
292 sub orig_decrypt_data
293 {
294     my $self = shift;
295     return $self->{orig_decrypt_data};
296 }
297
298 #Read/write accessors
299 sub decrypt_len
300 {
301     my $self = shift;
302     if (@_) {
303       $self->{decrypt_len} = shift;
304     }
305     return $self->{decrypt_len};
306 }
307 sub data
308 {
309     my $self = shift;
310     if (@_) {
311       $self->{data} = shift;
312     }
313     return $self->{data};
314 }
315 sub decrypt_data
316 {
317     my $self = shift;
318     if (@_) {
319       $self->{decrypt_data} = shift;
320     }
321     return $self->{decrypt_data};
322 }
323 sub len
324 {
325     my $self = shift;
326     if (@_) {
327       $self->{len} = shift;
328     }
329     return $self->{len};
330 }
331 sub version
332 {
333     my $self = shift;
334     if (@_) {
335       $self->{version} = shift;
336     }
337     return $self->{version};
338 }
339 1;