8a14dea211da56f1ce5720e546e918418503d8ab
[openssl.git] / util / TLSProxy / Message.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 package TLSProxy::Message;
11
12 use constant TLS_MESSAGE_HEADER_LENGTH => 4;
13
14 #Message types
15 use constant {
16     MT_HELLO_REQUEST => 0,
17     MT_CLIENT_HELLO => 1,
18     MT_SERVER_HELLO => 2,
19     MT_NEW_SESSION_TICKET => 4,
20     MT_CERTIFICATE => 11,
21     MT_SERVER_KEY_EXCHANGE => 12,
22     MT_CERTIFICATE_REQUEST => 13,
23     MT_SERVER_HELLO_DONE => 14,
24     MT_CERTIFICATE_VERIFY => 15,
25     MT_CLIENT_KEY_EXCHANGE => 16,
26     MT_FINISHED => 20,
27     MT_CERTIFICATE_STATUS => 22,
28     MT_NEXT_PROTO => 67
29 };
30
31 #Alert levels
32 use constant {
33     AL_LEVEL_WARN => 1,
34     AL_LEVEL_FATAL => 2
35 };
36
37 #Alert descriptions
38 use constant {
39     AL_DESC_CLOSE_NOTIFY => 0,
40     AL_DESC_UNEXPECTED_MESSAGE => 10,
41     AL_DESC_NO_RENEGOTIATION => 100
42 };
43
44 my %message_type = (
45     MT_HELLO_REQUEST, "HelloRequest",
46     MT_CLIENT_HELLO, "ClientHello",
47     MT_SERVER_HELLO, "ServerHello",
48     MT_NEW_SESSION_TICKET, "NewSessionTicket",
49     MT_CERTIFICATE, "Certificate",
50     MT_SERVER_KEY_EXCHANGE, "ServerKeyExchange",
51     MT_CERTIFICATE_REQUEST, "CertificateRequest",
52     MT_SERVER_HELLO_DONE, "ServerHelloDone",
53     MT_CERTIFICATE_VERIFY, "CertificateVerify",
54     MT_CLIENT_KEY_EXCHANGE, "ClientKeyExchange",
55     MT_FINISHED, "Finished",
56     MT_CERTIFICATE_STATUS, "CertificateStatus",
57     MT_NEXT_PROTO, "NextProto"
58 );
59
60 use constant {
61     EXT_STATUS_REQUEST => 5,
62     EXT_ENCRYPT_THEN_MAC => 22,
63     EXT_EXTENDED_MASTER_SECRET => 23,
64     EXT_SESSION_TICKET => 35,
65     EXT_SUPPORTED_VERSIONS => 43,
66     # This extension does not exist and isn't recognised by OpenSSL.
67     # We use it to test handling of duplicate extensions.
68     EXT_DUPLICATE_EXTENSION => 1234
69 };
70
71 my $payload = "";
72 my $messlen = -1;
73 my $mt;
74 my $startoffset = -1;
75 my $server = 0;
76 my $success = 0;
77 my $end = 0;
78 my @message_rec_list = ();
79 my @message_frag_lens = ();
80 my $ciphersuite = 0;
81
82 sub clear
83 {
84     $payload = "";
85     $messlen = -1;
86     $startoffset = -1;
87     $server = 0;
88     $success = 0;
89     $end = 0;
90     @message_rec_list = ();
91     @message_frag_lens = ();
92 }
93
94 #Class method to extract messages from a record
95 sub get_messages
96 {
97     my $class = shift;
98     my $serverin = shift;
99     my $record = shift;
100     my @messages = ();
101     my $message;
102
103     @message_frag_lens = ();
104
105     if ($serverin != $server && length($payload) != 0) {
106         die "Changed peer, but we still have fragment data\n";
107     }
108     $server = $serverin;
109
110     if ($record->content_type == TLSProxy::Record::RT_CCS) {
111         if ($payload ne "") {
112             #We can't handle this yet
113             die "CCS received before message data complete\n";
114         }
115         if ($server) {
116             TLSProxy::Record->server_ccs_seen(1);
117         } else {
118             TLSProxy::Record->client_ccs_seen(1);
119         }
120     } elsif ($record->content_type == TLSProxy::Record::RT_HANDSHAKE) {
121         if ($record->len == 0 || $record->len_real == 0) {
122             print "  Message truncated\n";
123         } else {
124             my $recoffset = 0;
125
126             if (length $payload > 0) {
127                 #We are continuing processing a message started in a previous
128                 #record. Add this record to the list associated with this
129                 #message
130                 push @message_rec_list, $record;
131
132                 if ($messlen <= length($payload)) {
133                     #Shouldn't happen
134                     die "Internal error: invalid messlen: ".$messlen
135                         ." payload length:".length($payload)."\n";
136                 }
137                 if (length($payload) + $record->decrypt_len >= $messlen) {
138                     #We can complete the message with this record
139                     $recoffset = $messlen - length($payload);
140                     $payload .= substr($record->decrypt_data, 0, $recoffset);
141                     push @message_frag_lens, $recoffset;
142                     $message = create_message($server, $mt, $payload,
143                                               $startoffset);
144                     push @messages, $message;
145
146                     $payload = "";
147                 } else {
148                     #This is just part of the total message
149                     $payload .= $record->decrypt_data;
150                     $recoffset = $record->decrypt_len;
151                     push @message_frag_lens, $record->decrypt_len;
152                 }
153                 print "  Partial message data read: ".$recoffset." bytes\n";
154             }
155
156             while ($record->decrypt_len > $recoffset) {
157                 #We are at the start of a new message
158                 if ($record->decrypt_len - $recoffset < 4) {
159                     #Whilst technically probably valid we can't cope with this
160                     die "End of record in the middle of a message header\n";
161                 }
162                 @message_rec_list = ($record);
163                 my $lenhi;
164                 my $lenlo;
165                 ($mt, $lenhi, $lenlo) = unpack('CnC',
166                                                substr($record->decrypt_data,
167                                                       $recoffset));
168                 $messlen = ($lenhi << 8) | $lenlo;
169                 print "  Message type: $message_type{$mt}\n";
170                 print "  Message Length: $messlen\n";
171                 $startoffset = $recoffset;
172                 $recoffset += 4;
173                 $payload = "";
174                 
175                 if ($recoffset < $record->decrypt_len) {
176                     #Some payload data is present in this record
177                     if ($record->decrypt_len - $recoffset >= $messlen) {
178                         #We can complete the message with this record
179                         $payload .= substr($record->decrypt_data, $recoffset,
180                                            $messlen);
181                         $recoffset += $messlen;
182                         push @message_frag_lens, $messlen;
183                         $message = create_message($server, $mt, $payload,
184                                                   $startoffset);
185                         push @messages, $message;
186
187                         $payload = "";
188                     } else {
189                         #This is just part of the total message
190                         $payload .= substr($record->decrypt_data, $recoffset,
191                                            $record->decrypt_len - $recoffset);
192                         $recoffset = $record->decrypt_len;
193                         push @message_frag_lens, $recoffset;
194                     }
195                 }
196             }
197         }
198     } elsif ($record->content_type == TLSProxy::Record::RT_APPLICATION_DATA) {
199         print "  [ENCRYPTED APPLICATION DATA]\n";
200         print "  [".$record->decrypt_data."]\n";
201     } elsif ($record->content_type == TLSProxy::Record::RT_ALERT) {
202         my ($alertlev, $alertdesc) = unpack('CC', $record->decrypt_data);
203         #A CloseNotify from the client indicates we have finished successfully
204         #(we assume)
205         if (!$end && !$server && $alertlev == AL_LEVEL_WARN
206             && $alertdesc == AL_DESC_CLOSE_NOTIFY) {
207             $success = 1;
208         }
209         #All alerts end the test
210         $end = 1;
211     }
212
213     return @messages;
214 }
215
216 #Function to work out which sub-class we need to create and then
217 #construct it
218 sub create_message
219 {
220     my ($server, $mt, $data, $startoffset) = @_;
221     my $message;
222
223     #We only support ClientHello in this version...needs to be extended for
224     #others
225     if ($mt == MT_CLIENT_HELLO) {
226         $message = TLSProxy::ClientHello->new(
227             $server,
228             $data,
229             [@message_rec_list],
230             $startoffset,
231             [@message_frag_lens]
232         );
233         $message->parse();
234     } elsif ($mt == MT_SERVER_HELLO) {
235         $message = TLSProxy::ServerHello->new(
236             $server,
237             $data,
238             [@message_rec_list],
239             $startoffset,
240             [@message_frag_lens]
241         );
242         $message->parse();
243     } elsif ($mt == MT_SERVER_KEY_EXCHANGE) {
244         $message = TLSProxy::ServerKeyExchange->new(
245             $server,
246             $data,
247             [@message_rec_list],
248             $startoffset,
249             [@message_frag_lens]
250         );
251         $message->parse();
252     } elsif ($mt == MT_NEW_SESSION_TICKET) {
253         $message = TLSProxy::NewSessionTicket->new(
254             $server,
255             $data,
256             [@message_rec_list],
257             $startoffset,
258             [@message_frag_lens]
259         );
260         $message->parse();
261     } else {
262         #Unknown message type
263         $message = TLSProxy::Message->new(
264             $server,
265             $mt,
266             $data,
267             [@message_rec_list],
268             $startoffset,
269             [@message_frag_lens]
270         );
271     }
272
273     return $message;
274 }
275
276 sub end
277 {
278     my $class = shift;
279     return $end;
280 }
281 sub success
282 {
283     my $class = shift;
284     return $success;
285 }
286 sub fail
287 {
288     my $class = shift;
289     return !$success && $end;
290 }
291 sub new
292 {
293     my $class = shift;
294     my ($server,
295         $mt,
296         $data,
297         $records,
298         $startoffset,
299         $message_frag_lens) = @_;
300     
301     my $self = {
302         server => $server,
303         data => $data,
304         records => $records,
305         mt => $mt,
306         startoffset => $startoffset,
307         message_frag_lens => $message_frag_lens
308     };
309
310     return bless $self, $class;
311 }
312
313 sub ciphersuite
314 {
315     my $class = shift;
316     if (@_) {
317       $ciphersuite = shift;
318     }
319     return $ciphersuite;
320 }
321
322 #Update all the underlying records with the modified data from this message
323 #Note: Does not currently support re-encrypting
324 sub repack
325 {
326     my $self = shift;
327     my $msgdata;
328
329     my $numrecs = $#{$self->records};
330
331     $self->set_message_contents();
332
333     my $lenhi;
334     my $lenlo;
335
336     $lenlo = length($self->data) & 0xff;
337     $lenhi = length($self->data) >> 8;
338     $msgdata = pack('CnC', $self->mt, $lenhi, $lenlo).$self->data;
339
340     if ($numrecs == 0) {
341         #The message is fully contained within one record
342         my ($rec) = @{$self->records};
343         my $recdata = $rec->decrypt_data;
344
345         my $old_length;
346
347         # We use empty message_frag_lens to indicates that pre-repacking,
348         # the message wasn't present. The first fragment length doesn't include
349         # the TLS header, so we need to check and compute the right length.
350         if (@{$self->message_frag_lens}) {
351             $old_length = ${$self->message_frag_lens}[0] +
352               TLS_MESSAGE_HEADER_LENGTH;
353         } else {
354             $old_length = 0;
355         }
356
357         my $prefix = substr($recdata, 0, $self->startoffset);
358         my $suffix = substr($recdata, $self->startoffset + $old_length);
359
360         $rec->decrypt_data($prefix.($msgdata).($suffix));
361         # TODO(openssl-team): don't keep explicit lengths.
362         # (If a length override is ever needed to construct invalid packets,
363         #  use an explicit override field instead.)
364         $rec->decrypt_len(length($rec->decrypt_data));
365         $rec->len($rec->len + length($msgdata) - $old_length);
366         # Don't support re-encryption.
367         $rec->data($rec->decrypt_data);
368
369         #Update the fragment len in case we changed it above
370         ${$self->message_frag_lens}[0] = length($msgdata)
371                                          - TLS_MESSAGE_HEADER_LENGTH;
372         return;
373     }
374
375     #Note we don't currently support changing a fragmented message length
376     my $recctr = 0;
377     my $datadone = 0;
378     foreach my $rec (@{$self->records}) {
379         my $recdata = $rec->decrypt_data;
380         if ($recctr == 0) {
381             #This is the first record
382             my $remainlen = length($recdata) - $self->startoffset;
383             $rec->data(substr($recdata, 0, $self->startoffset)
384                        .substr(($msgdata), 0, $remainlen));
385             $datadone += $remainlen;
386         } elsif ($recctr + 1 == $numrecs) {
387             #This is the last record
388             $rec->data(substr($msgdata, $datadone));
389         } else {
390             #This is a middle record
391             $rec->data(substr($msgdata, $datadone, length($rec->data)));
392             $datadone += length($rec->data);
393         }
394         $recctr++;
395     }
396 }
397
398 #To be overridden by sub-classes
399 sub set_message_contents
400 {
401 }
402
403 #Read only accessors
404 sub server
405 {
406     my $self = shift;
407     return $self->{server};
408 }
409
410 #Read/write accessors
411 sub mt
412 {
413     my $self = shift;
414     if (@_) {
415       $self->{mt} = shift;
416     }
417     return $self->{mt};
418 }
419 sub data
420 {
421     my $self = shift;
422     if (@_) {
423       $self->{data} = shift;
424     }
425     return $self->{data};
426 }
427 sub records
428 {
429     my $self = shift;
430     if (@_) {
431       $self->{records} = shift;
432     }
433     return $self->{records};
434 }
435 sub startoffset
436 {
437     my $self = shift;
438     if (@_) {
439       $self->{startoffset} = shift;
440     }
441     return $self->{startoffset};
442 }
443 sub message_frag_lens
444 {
445     my $self = shift;
446     if (@_) {
447       $self->{message_frag_lens} = shift;
448     }
449     return $self->{message_frag_lens};
450 }
451 sub encoded_length
452 {
453     my $self = shift;
454     return TLS_MESSAGE_HEADER_LENGTH + length($self->data);
455 }
456
457 1;