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