Make sure to escape backslashes and single quotes for buildinf.h
[openssl.git] / util / TLSProxy / ServerHello.pm
1 # Written by Matt Caswell for the OpenSSL project.
2 # ====================================================================
3 # Copyright (c) 1998-2015 The OpenSSL Project.  All rights reserved.
4 #
5 # Redistribution and use in source and binary forms, with or without
6 # modification, are permitted provided that the following conditions
7 # are met:
8 #
9 # 1. Redistributions of source code must retain the above copyright
10 #    notice, this list of conditions and the following disclaimer.
11 #
12 # 2. Redistributions in binary form must reproduce the above copyright
13 #    notice, this list of conditions and the following disclaimer in
14 #    the documentation and/or other materials provided with the
15 #    distribution.
16 #
17 # 3. All advertising materials mentioning features or use of this
18 #    software must display the following acknowledgment:
19 #    "This product includes software developed by the OpenSSL Project
20 #    for use in the OpenSSL Toolkit. (http://www.openssl.org/)"
21 #
22 # 4. The names "OpenSSL Toolkit" and "OpenSSL Project" must not be used to
23 #    endorse or promote products derived from this software without
24 #    prior written permission. For written permission, please contact
25 #    openssl-core@openssl.org.
26 #
27 # 5. Products derived from this software may not be called "OpenSSL"
28 #    nor may "OpenSSL" appear in their names without prior written
29 #    permission of the OpenSSL Project.
30 #
31 # 6. Redistributions of any form whatsoever must retain the following
32 #    acknowledgment:
33 #    "This product includes software developed by the OpenSSL Project
34 #    for use in the OpenSSL Toolkit (http://www.openssl.org/)"
35 #
36 # THIS SOFTWARE IS PROVIDED BY THE OpenSSL PROJECT ``AS IS'' AND ANY
37 # EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
38 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
39 # PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE OpenSSL PROJECT OR
40 # ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
41 # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
42 # NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
43 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
44 # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
45 # STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
46 # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
47 # OF THE POSSIBILITY OF SUCH DAMAGE.
48 # ====================================================================
49 #
50 # This product includes cryptographic software written by Eric Young
51 # (eay@cryptsoft.com).  This product includes software written by Tim
52 # Hudson (tjh@cryptsoft.com).
53
54 use strict;
55
56 package TLSProxy::ServerHello;
57
58 use parent 'TLSProxy::Message';
59
60 sub new
61 {
62     my $class = shift;
63     my ($server,
64         $data,
65         $records,
66         $startoffset,
67         $message_frag_lens) = @_;
68     
69     my $self = $class->SUPER::new(
70         $server,
71         TLSProxy::Message::MT_SERVER_HELLO,
72         $data,
73         $records,
74         $startoffset,
75         $message_frag_lens);
76
77     $self->{server_version} = 0;
78     $self->{random} = [];
79     $self->{session_id_len} = 0;
80     $self->{session} = "";
81     $self->{ciphersuite} = 0;
82     $self->{comp_meth} = 0;
83     $self->{extensions_data} = "";
84
85     return $self;
86 }
87
88 sub parse
89 {
90     my $self = shift;
91     my $ptr = 2;
92     my ($server_version) = unpack('n', $self->data);
93     my $random = substr($self->data, $ptr, 32);
94     $ptr += 32;
95     my $session_id_len = unpack('C', substr($self->data, $ptr));
96     $ptr++;
97     my $session = substr($self->data, $ptr, $session_id_len);
98     $ptr += $session_id_len;
99     my $ciphersuite = unpack('n', substr($self->data, $ptr));
100     $ptr += 2;
101     my $comp_meth = unpack('C', substr($self->data, $ptr));
102     $ptr++;
103     my $extensions_len = unpack('n', substr($self->data, $ptr));
104     $ptr += 2;
105     #For now we just deal with this as a block of data. In the future we will
106     #want to parse this
107     my $extension_data = substr($self->data, $ptr);
108     
109     if (length($extension_data) != $extensions_len) {
110         die "Invalid extension length\n";
111     }
112     my %extensions = ();
113     while (length($extension_data) >= 4) {
114         my ($type, $size) = unpack("nn", $extension_data);
115         my $extdata = substr($extension_data, 4, $size);
116         $extension_data = substr($extension_data, 4 + $size);
117         $extensions{$type} = $extdata;
118     }
119
120     $self->server_version($server_version);
121     $self->random($random);
122     $self->session_id_len($session_id_len);
123     $self->session($session);
124     $self->ciphersuite($ciphersuite);
125     $self->comp_meth($comp_meth);
126     $self->extension_data(\%extensions);
127
128     $self->process_data();
129
130     print "    Server Version:".$server_version."\n";
131     print "    Session ID Len:".$session_id_len."\n";
132     print "    Ciphersuite:".$ciphersuite."\n";
133     print "    Compression Method:".$comp_meth."\n";
134     print "    Extensions Len:".$extensions_len."\n";
135 }
136
137 #Perform any actions necessary based on the data we've seen
138 sub process_data
139 {
140     my $self = shift;
141
142     TLSProxy::Message->ciphersuite($self->ciphersuite);
143 }
144
145 #Reconstruct the on-the-wire message data following changes
146 sub set_message_contents
147 {
148     my $self = shift;
149     my $data;
150     my $extensions = "";
151
152     $data = pack('n', $self->server_version);
153     $data .= $self->random;
154     $data .= pack('C', $self->session_id_len);
155     $data .= $self->session;
156     $data .= pack('n', $self->ciphersuite);
157     $data .= pack('C', $self->comp_meth);
158
159     foreach my $key (keys %{$self->extension_data}) {
160         my $extdata = ${$self->extension_data}{$key};
161         $extensions .= pack("n", $key);
162         $extensions .= pack("n", length($extdata));
163         $extensions .= $extdata;
164     }
165
166     $data .= pack('n', length($extensions));
167     $data .= $extensions;
168     $self->data($data);
169 }
170
171 #Read/write accessors
172 sub server_version
173 {
174     my $self = shift;
175     if (@_) {
176       $self->{client_version} = shift;
177     }
178     return $self->{client_version};
179 }
180 sub random
181 {
182     my $self = shift;
183     if (@_) {
184       $self->{random} = shift;
185     }
186     return $self->{random};
187 }
188 sub session_id_len
189 {
190     my $self = shift;
191     if (@_) {
192       $self->{session_id_len} = shift;
193     }
194     return $self->{session_id_len};
195 }
196 sub session
197 {
198     my $self = shift;
199     if (@_) {
200       $self->{session} = shift;
201     }
202     return $self->{session};
203 }
204 sub ciphersuite
205 {
206     my $self = shift;
207     if (@_) {
208       $self->{ciphersuite} = shift;
209     }
210     return $self->{ciphersuite};
211 }
212 sub comp_meth
213 {
214     my $self = shift;
215     if (@_) {
216       $self->{comp_meth} = shift;
217     }
218     return $self->{comp_meth};
219 }
220 sub extension_data
221 {
222     my $self = shift;
223     if (@_) {
224       $self->{extension_data} = shift;
225     }
226     return $self->{extension_data};
227 }
228 sub set_extension
229 {
230     my ($self, $ext_type, $ext_data) = @_;
231     $self->{extension_data}{$ext_type} = $ext_data;
232 }
233 sub delete_extension
234 {
235     my ($self, $ext_type) = @_;
236     delete $self->{extension_data}{$ext_type};
237 }
238 1;