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