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