top_file("apps", "server.pem")
);
-plan tests => 6;
+plan tests => 8;
#Test 1: By default with no existing session we should get a session ticket
#Expected result: ClientHello extension seen; ServerHello extension seen
$proxy->start();
checkmessages(6, "Empty ticket test", 1, 1, 1, 1);
+#Test 7-8: Client keeps existing ticket on empty ticket.
+clearall();
+($fh, $session) = tempfile();
+$proxy->serverconnects(3);
+$proxy->filter(undef);
+$proxy->clientflags("-sess_out ".$session);
+$proxy->start();
+$proxy->clear();
+$proxy->clientflags("-sess_in ".$session." -sess_out ".$session);
+$proxy->filter(\&inject_empty_ticket_filter);
+$proxy->clientstart();
+#Expected result: ClientHello extension seen; ServerHello extension seen;
+# NewSessionTicket message seen; Abbreviated handshake.
+checkmessages(7, "Empty ticket resumption test", 1, 1, 1, 0);
+clearall();
+$proxy->clientflags("-sess_in ".$session);
+$proxy->filter(undef);
+$proxy->clientstart();
+#Expected result: ClientHello extension seen; ServerHello extension not seen;
+# NewSessionTicket message not seen; Abbreviated handshake.
+checkmessages(8, "Empty ticket resumption test", 1, 0, 0, 0);
+
sub ticket_filter
{
}
}
+sub inject_empty_ticket_filter {
+ my $proxy = shift;
+
+ foreach my $message (@{$proxy->message_list}) {
+ if ($message->mt == TLSProxy::Message::MT_NEW_SESSION_TICKET) {
+ # Only inject the message first time we're called.
+ return;
+ }
+ }
+
+ my @new_message_list = ();
+ foreach my $message (@{$proxy->message_list}) {
+ push @new_message_list, $message;
+ if ($message->mt == TLSProxy::Message::MT_SERVER_HELLO) {
+ $message->set_extension(TLSProxy::ClientHello::EXT_SESSION_TICKET, "");
+ $message->repack();
+ # Tack NewSessionTicket onto the ServerHello record.
+ # This only works if the ServerHello is exactly one record.
+ my $record = ${$message->records}[0];
+
+ my $offset = $message->startoffset + $message->encoded_length;
+ my $newsessionticket = TLSProxy::NewSessionTicket->new(
+ 1, "", [$record], $offset, []);
+ $newsessionticket->repack();
+ push @new_message_list, $newsessionticket;
+ }
+ }
+ $proxy->message_list([@new_message_list]);
+}
+
sub checkmessages($$$$$$)
{
my ($testno, $testname, $testch, $testsh, $testtickseen, $testhand) = @_;
$lenhi = length($self->data) >> 8;
$msgdata = pack('CnC', $self->mt, $lenhi, $lenlo).$self->data;
-
if ($numrecs == 0) {
#The message is fully contained within one record
my ($rec) = @{$self->records};
my $recdata = $rec->decrypt_data;
- if (length($msgdata) != ${$self->message_frag_lens}[0]
- + TLS_MESSAGE_HEADER_LENGTH) {
- #Message length has changed! Better adjust the record length
- my $diff = length($msgdata) - ${$self->message_frag_lens}[0]
- - TLS_MESSAGE_HEADER_LENGTH;
- $rec->len($rec->len + $diff);
+ my $old_length;
+
+ # We use empty message_frag_lens to indicates that pre-repacking,
+ # the message wasn't present. The first fragment length doesn't include
+ # the TLS header, so we need to check and compute the right length.
+ if (@{$self->message_frag_lens}) {
+ $old_length = ${$self->message_frag_lens}[0] +
+ TLS_MESSAGE_HEADER_LENGTH;
+ } else {
+ $old_length = 0;
}
- $rec->data(substr($recdata, 0, $self->startoffset)
- .($msgdata)
- .substr($recdata, ${$self->message_frag_lens}[0]
- + TLS_MESSAGE_HEADER_LENGTH));
+ my $prefix = substr($recdata, 0, $self->startoffset);
+ my $suffix = substr($recdata, $self->startoffset + $old_length);
+
+ $rec->decrypt_data($prefix.($msgdata).($suffix));
+ # TODO(openssl-team): don't keep explicit lengths.
+ # (If a length override is ever needed to construct invalid packets,
+ # use an explicit override field instead.)
+ $rec->decrypt_len(length($rec->decrypt_data));
+ $rec->len($rec->len + length($msgdata) - $old_length);
+ # Don't support re-encryption.
+ $rec->data($rec->decrypt_data);
#Update the fragment len in case we changed it above
${$self->message_frag_lens}[0] = length($msgdata)
}
return $self->{message_frag_lens};
}
+sub encoded_length
+{
+ my $self = shift;
+ return TLS_MESSAGE_HEADER_LENGTH + length($self->data);
+}
1;
flight => 0,
record_list => [],
message_list => [],
-
- #Private
- message_rec_list => []
};
return bless $self, $class;
$self->{flight} = 0;
$self->{record_list} = [];
$self->{message_list} = [];
- $self->{message_rec_list} = [];
$self->{serverflags} = "";
$self->{clientflags} = "";
$self->{serverconnects} = 1;
}
}
-
sub process_packet
{
my ($self, $server, $packet) = @_;
#list of messages in those records
my @ret = TLSProxy::Record->get_records($server, $self->flight, $packet);
push @{$self->record_list}, @{$ret[0]};
- $self->{message_rec_list} = $ret[0];
push @{$self->{message_list}}, @{$ret[1]};
print "\n";
my $self = shift;
return $self->{record_list};
}
-sub message_list
-{
- my $self = shift;
- return $self->{message_list};
-}
sub success
{
my $self = shift;
}
return $self->{serverconnects};
}
+# This is a bit ugly because the caller is responsible for keeping the records
+# in sync with the updated message list; simply updating the message list isn't
+# sufficient to get the proxy to forward the new message.
+# But it does the trick for the one test (test_sslsessiontick) that needs it.
+sub message_list
+{
+ my $self = shift;
+ if (@_) {
+ $self->{message_list} = shift;
+ }
+ return $self->{message_list};
+}
1;
$self->{session} = "";
$self->{ciphersuite} = 0;
$self->{comp_meth} = 0;
- $self->{extensions_len} = 0;
$self->{extensions_data} = "";
return $self;
$self->session($session);
$self->ciphersuite($ciphersuite);
$self->comp_meth($comp_meth);
- $self->extensions_len($extensions_len);
$self->extension_data(\%extensions);
$self->process_data();
{
my $self = shift;
my $data;
+ my $extensions = "";
$data = pack('n', $self->server_version);
$data .= $self->random;
$data .= $self->session;
$data .= pack('n', $self->ciphersuite);
$data .= pack('C', $self->comp_meth);
- $data .= pack('n', $self->extensions_len);
+
foreach my $key (keys %{$self->extension_data}) {
my $extdata = ${$self->extension_data}{$key};
- $data .= pack("n", $key);
- $data .= pack("n", length($extdata));
- $data .= $extdata;
+ $extensions .= pack("n", $key);
+ $extensions .= pack("n", length($extdata));
+ $extensions .= $extdata;
}
+ $data .= pack('n', length($extensions));
+ $data .= $extensions;
$self->data($data);
}
}
return $self->{comp_meth};
}
-sub extensions_len
-{
- my $self = shift;
- if (@_) {
- $self->{extensions_len} = shift;
- }
- return $self->{extensions_len};
-}
sub extension_data
{
my $self = shift;
}
return $self->{extension_data};
}
+sub set_extension
+{
+ my ($self, $ext_type, $ext_data) = @_;
+ $self->{extension_data}{$ext_type} = $ext_data;
+}
1;