Commit 631c1206 authored by Matt Caswell's avatar Matt Caswell
Browse files

Add a libssl test harness 



This commit provides a set of perl modules that support the testing of
libssl. The test harness operates as a man-in-the-middle proxy between
s_server and s_client. Both s_server and s_client must be started using the
"-testmode" option which loads the new OSSLTEST engine.

The test harness enables scripts to be written that can examine the packets
sent during a handshake, as well as (potentially) modifying them so that
otherwise illegal handshake messages can be sent.

Reviewed-by: default avatarRichard Levitte <levitte@openssl.org>
parent 2d5d70b1

util/TLSProxy/ClientHello.pm

0 → 100644
+272 −0
Original line number Diff line number Diff line 
# Written by Matt Caswell for the OpenSSL project.

# ====================================================================

# Copyright (c) 1998-2015 The OpenSSL Project.  All rights reserved.

#

# Redistribution and use in source and binary forms, with or without

# modification, are permitted provided that the following conditions

# are met:

#

# 1. Redistributions of source code must retain the above copyright

#    notice, this list of conditions and the following disclaimer.

#

# 2. Redistributions in binary form must reproduce the above copyright

#    notice, this list of conditions and the following disclaimer in

#    the documentation and/or other materials provided with the

#    distribution.

#

# 3. All advertising materials mentioning features or use of this

#    software must display the following acknowledgment:

#    "This product includes software developed by the OpenSSL Project

#    for use in the OpenSSL Toolkit. (http://www.openssl.org/)"

#

# 4. The names "OpenSSL Toolkit" and "OpenSSL Project" must not be used to

#    endorse or promote products derived from this software without

#    prior written permission. For written permission, please contact

#    openssl-core@openssl.org.

#

# 5. Products derived from this software may not be called "OpenSSL"

#    nor may "OpenSSL" appear in their names without prior written

#    permission of the OpenSSL Project.

#

# 6. Redistributions of any form whatsoever must retain the following

#    acknowledgment:

#    "This product includes software developed by the OpenSSL Project

#    for use in the OpenSSL Toolkit (http://www.openssl.org/)"

#

# THIS SOFTWARE IS PROVIDED BY THE OpenSSL PROJECT ``AS IS'' AND ANY

# EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE

# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR

# PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE OpenSSL PROJECT OR

# ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT

# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;

# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)

# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,

# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)

# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED

# OF THE POSSIBILITY OF SUCH DAMAGE.

# ====================================================================

#

# This product includes cryptographic software written by Eric Young

# (eay@cryptsoft.com).  This product includes software written by Tim

# Hudson (tjh@cryptsoft.com).



use strict;



package TLSProxy::ClientHello;



use parent 'TLSProxy::Message';



use constant {

    EXT_ENCRYPT_THEN_MAC => 22

};



sub new

{

    my $class = shift;

    my ($server,

        $data,

        $records,

        $startoffset,

        $message_frag_lens) = @_;

    

    my $self = $class->SUPER::new(

        $server,

        1,

        $data,

        $records,

        $startoffset,

        $message_frag_lens);



    $self->{client_version} = 0;

    $self->{random} = [];

    $self->{session_id_len} = 0;

    $self->{session} = "";

    $self->{ciphersuite_len} = 0;

    $self->{ciphersuites} = [];

    $self->{comp_meth_len} = 0;

    $self->{comp_meths} = [];

    $self->{extensions_len} = 0;

    $self->{extensions_data} = "";



    return $self;

}



sub parse

{

    my $self = shift;

    my $ptr = 2;

    my ($client_version) = unpack('n', $self->data);

    my $random = substr($self->data, $ptr, 32);

    $ptr += 32;

    my $session_id_len = unpack('C', substr($self->data, $ptr));

    $ptr++;

    my $session = substr($self->data, $ptr, $session_id_len);

    $ptr += $session_id_len;

    my $ciphersuite_len = unpack('n', substr($self->data, $ptr));

    $ptr += 2;

    my @ciphersuites = unpack('n*', substr($self->data, $ptr,

                                           $ciphersuite_len));

    $ptr += $ciphersuite_len;

    my $comp_meth_len = unpack('C', substr($self->data, $ptr));

    $ptr++;

    my @comp_meths = unpack('C*', substr($self->data, $ptr, $comp_meth_len));

    $ptr += $comp_meth_len;

    my $extensions_len = unpack('n', substr($self->data, $ptr));

    $ptr += 2;

    #For now we just deal with this as a block of data. In the future we will

    #want to parse this

    my $extension_data = substr($self->data, $ptr);

    

    if (length($extension_data) != $extensions_len) {

        die "Invalid extension length\n";

    }

    my %extensions = ();

    while (length($extension_data) >= 4) {

        my ($type, $size) = unpack("nn", $extension_data);

        my $extdata = substr($extension_data, 4, $size);

        $extension_data = substr($extension_data, 4 + $size);

        $extensions{$type} = $extdata;

    }



    $self->client_version($client_version);

    $self->random($random);

    $self->session_id_len($session_id_len);

    $self->session($session);

    $self->ciphersuite_len($ciphersuite_len);

    $self->ciphersuites(\@ciphersuites);

    $self->comp_meth_len($comp_meth_len);

    $self->comp_meths(\@comp_meths);

    $self->extensions_len($extensions_len);

    $self->extension_data(\%extensions);



    $self->process_extensions();



    print "    Client Version:".$client_version."\n";

    print "    Session ID Len:".$session_id_len."\n";

    print "    Ciphersuite len:".$ciphersuite_len."\n";

    print "    Compression Method Len:".$comp_meth_len."\n";

    print "    Extensions Len:".$extensions_len."\n";

}



#Perform any actions necessary based on the extensions we've seen

sub process_extensions

{

    my $self = shift;

    my %extensions = %{$self->extension_data};



    #Clear any state from a previous run

    TLSProxy::Record->etm(0);



    if (exists $extensions{&EXT_ENCRYPT_THEN_MAC}) {

        TLSProxy::Record->etm(1);

    }

}



#Reconstruct the on-the-wire message data following changes

sub set_message_contents

{

    my $self = shift;

    my $data;



    $data = pack('n', $self->client_version);

    $data .= $self->random;

    $data .= pack('C', $self->session_id_len);

    $data .= $self->session;

    $data .= pack('n', $self->ciphersuite_len);

    $data .= pack("n*", @{$self->ciphersuites});

    $data .= pack('C', $self->comp_meth_len);

    $data .= pack("C*", @{$self->comp_meths});

    $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;

    }



    $self->data($data);

}



#Read/write accessors

sub client_version

{

    my $self = shift;

    if (@_) {

      $self->{client_version} = shift;

    }

    return $self->{client_version};

}

sub random

{

    my $self = shift;

    if (@_) {

      $self->{random} = shift;

    }

    return $self->{random};

}

sub session_id_len

{

    my $self = shift;

    if (@_) {

      $self->{session_id_len} = shift;

    }

    return $self->{session_id_len};

}

sub session

{

    my $self = shift;

    if (@_) {

      $self->{session} = shift;

    }

    return $self->{session};

}

sub ciphersuite_len

{

    my $self = shift;

    if (@_) {

      $self->{ciphersuite_len} = shift;

    }

    return $self->{ciphersuite_len};

}

sub ciphersuites

{

    my $self = shift;

    if (@_) {

      $self->{ciphersuites} = shift;

    }

    return $self->{ciphersuites};

}

sub comp_meth_len

{

    my $self = shift;

    if (@_) {

      $self->{comp_meth_len} = shift;

    }

    return $self->{comp_meth_len};

}

sub comp_meths

{

    my $self = shift;

    if (@_) {

      $self->{comp_meths} = shift;

    }

    return $self->{comp_meths};

}

sub extensions_len

{

    my $self = shift;

    if (@_) {

      $self->{extensions_len} = shift;

    }

    return $self->{extensions_len};

}

sub extension_data

{

    my $self = shift;

    if (@_) {

      $self->{extension_data} = shift;

    }

    return $self->{extension_data};

}

1;

util/TLSProxy/Message.pm

0 → 100644
+423 −0
Original line number Diff line number Diff line 
# Written by Matt Caswell for the OpenSSL project.

# ====================================================================

# Copyright (c) 1998-2015 The OpenSSL Project.  All rights reserved.

#

# Redistribution and use in source and binary forms, with or without

# modification, are permitted provided that the following conditions

# are met:

#

# 1. Redistributions of source code must retain the above copyright

#    notice, this list of conditions and the following disclaimer.

#

# 2. Redistributions in binary form must reproduce the above copyright

#    notice, this list of conditions and the following disclaimer in

#    the documentation and/or other materials provided with the

#    distribution.

#

# 3. All advertising materials mentioning features or use of this

#    software must display the following acknowledgment:

#    "This product includes software developed by the OpenSSL Project

#    for use in the OpenSSL Toolkit. (http://www.openssl.org/)"

#

# 4. The names "OpenSSL Toolkit" and "OpenSSL Project" must not be used to

#    endorse or promote products derived from this software without

#    prior written permission. For written permission, please contact

#    openssl-core@openssl.org.

#

# 5. Products derived from this software may not be called "OpenSSL"

#    nor may "OpenSSL" appear in their names without prior written

#    permission of the OpenSSL Project.

#

# 6. Redistributions of any form whatsoever must retain the following

#    acknowledgment:

#    "This product includes software developed by the OpenSSL Project

#    for use in the OpenSSL Toolkit (http://www.openssl.org/)"

#

# THIS SOFTWARE IS PROVIDED BY THE OpenSSL PROJECT ``AS IS'' AND ANY

# EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE

# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR

# PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE OpenSSL PROJECT OR

# ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT

# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;

# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)

# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,

# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)

# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED

# OF THE POSSIBILITY OF SUCH DAMAGE.

# ====================================================================

#

# This product includes cryptographic software written by Eric Young

# (eay@cryptsoft.com).  This product includes software written by Tim

# Hudson (tjh@cryptsoft.com).



use strict;



package TLSProxy::Message;



use constant TLS_MESSAGE_HEADER_LENGTH => 4;



#Message types

use constant {

    MT_HELLO_REQUEST => 0,

    MT_CLIENT_HELLO => 1,

    MT_SERVER_HELLO => 2,

    MT_NEW_SESSION_TICKET => 4,

    MT_CERTIFICATE => 11,

    MT_SERVER_KEY_EXCHANGE => 12,

    MT_CERTIFICATE_REQUEST => 13,

    MT_SERVER_HELLO_DONE => 14,

    MT_CERTIFICATE_VERIFY => 15,

    MT_CLIENT_KEY_EXCHANGE => 16,

    MT_FINISHED => 20,

    MT_CERTIFICATE_STATUS => 22,

    MT_NEXT_PROTO => 67

};

my %message_type = (

    MT_HELLO_REQUEST, "HelloRequest",

    MT_CLIENT_HELLO, "ClientHello",

    MT_SERVER_HELLO, "ServerHello",

    MT_NEW_SESSION_TICKET, "NewSessionTicket",

    MT_CERTIFICATE, "Certificate",

    MT_SERVER_KEY_EXCHANGE, "ServerKeyExchange",

    MT_CERTIFICATE_REQUEST, "CertificateRequest",

    MT_SERVER_HELLO_DONE, "ServerHelloDone",

    MT_CERTIFICATE_VERIFY, "CertificateVerify",

    MT_CLIENT_KEY_EXCHANGE, "ClientKeyExchange",

    MT_FINISHED, "Finished",

    MT_CERTIFICATE_STATUS, "CertificateStatus",

    MT_NEXT_PROTO, "NextProto"

);



my $payload = "";

my $messlen = -1;

my $mt;

my $startoffset = -1;

my $server = 0;

my $success = 0;

my $end = 0;

my @message_rec_list = ();

my @message_frag_lens = ();



sub clear

{

    $payload = "";

    $messlen = -1;

    $startoffset = -1;

    $server = 0;

    $success = 0;

    $end = 0;

    @message_rec_list = ();

    @message_frag_lens = ();

}



#Class method to extract messages from a record

sub get_messages

{

    my $class = shift;

    my $serverin = shift;

    my $record = shift;

    my @messages = ();

    my $message;



    if ($serverin != $server && length($payload) != 0) {

        die "Changed peer, but we still have fragment data\n";

    }

    $server = $serverin;



    if ($record->content_type == TLSProxy::Record::RT_CCS) {

        if ($payload ne "") {

            #We can't handle this yet

            die "CCS received before message data complete\n";

        }

        if ($server) {

            TLSProxy::Record->server_ccs_seen(1);

        } else {

            TLSProxy::Record->client_ccs_seen(1);

        }

    } elsif ($record->content_type == TLSProxy::Record::RT_HANDSHAKE) {

        if ($record->len == 0 || $record->len_real == 0) {

            print "  Message truncated\n";

        } else {

            my $recoffset = 0;



            if (length $payload > 0) {

                #We are continuing processing a message started in a previous

                #record. Add this record to the list associated with this

                #message

                push @message_rec_list, $record;



                if ($messlen <= length($payload)) {

                    #Shouldn't happen

                    die "Internal error: invalid messlen: ".$messlen

                        ." payload length:".length($payload)."\n";

                }

                if (length($payload) + $record->decrypt_len >= $messlen) {

                    #We can complete the message with this record

                    $recoffset = $messlen - length($payload);

                    $payload .= substr($record->decrypt_data, 0, $recoffset);

                    push @message_frag_lens, $recoffset;

                    $message = create_message($server, $mt, $payload,

                                              $startoffset);

                    push @messages, $message;



                    #Check if we have finished the handshake

                    if ($mt == MT_FINISHED && $server) {

                        $success = 1;

                        $end = 1;

                    }

                    $payload = "";

                } else {

                    #This is just part of the total message

                    $payload .= $record->decrypt_data;

                    $recoffset = $record->decrypt_len;

                    push @message_frag_lens, $record->decrypt_len;

                }

                print "  Partial message data read: ".$recoffset." bytes\n";

            }



            while ($record->decrypt_len > $recoffset) {

                #We are at the start of a new message

                if ($record->decrypt_len - $recoffset < 4) {

                    #Whilst technically probably valid we can't cope with this

                    die "End of record in the middle of a message header\n";

                }

                @message_rec_list = ($record);

                my $lenhi;

                my $lenlo;

                ($mt, $lenhi, $lenlo) = unpack('CnC',

                                               substr($record->decrypt_data,

                                                      $recoffset));

                $messlen = ($lenhi << 8) | $lenlo;

                print "  Message type: $message_type{$mt}\n";

                print "  Message Length: $messlen\n";

                $startoffset = $recoffset;

                $recoffset += 4;

                $payload = "";

                

                if ($recoffset < $record->decrypt_len) {

                    #Some payload data is present in this record

                    if ($record->decrypt_len - $recoffset >= $messlen) {

                        #We can complete the message with this record

                        $payload .= substr($record->decrypt_data, $recoffset,

                                           $messlen);

                        $recoffset += $messlen;

                        push @message_frag_lens, $messlen;

                        $message = create_message($server, $mt, $payload,

                                                  $startoffset);

                        push @messages, $message;



                        #Check if we have finished the handshake

                        if ($mt == MT_FINISHED && $server) {

                            $success = 1;

                            $end = 1;

                        }

                        $payload = "";

                    } else {

                        #This is just part of the total message

                        $payload .= substr($record->decrypt_data, $recoffset,

                                           $record->decrypt_len - $recoffset);

                        $recoffset = $record->decrypt_len;

                        push @message_frag_lens, $recoffset;

                    }

                }

            }

        }

    } elsif ($record->content_type == TLSProxy::Record::RT_APPLICATION_DATA) {

        print "  [ENCRYPTED APPLICATION DATA]\n";

        print "  [".$record->decrypt_data."]\n";

    } elsif ($record->content_type == TLSProxy::Record::RT_ALERT) {

        #For now assume all alerts are fatal

        $end = 1;

    }



    return @messages;

}



#Function to work out which sub-class we need to create and then

#construct it

sub create_message

{

    my ($server, $mt, $data, $startoffset) = @_;

    my $message;



    #We only support ClientHello in this version...needs to be extended for

    #others

    if ($mt == MT_CLIENT_HELLO) {

        $message = TLSProxy::ClientHello->new(

            $server,

            $data,

            [@message_rec_list],

            $startoffset,

            [@message_frag_lens]

        );

        $message->parse();

    } else {

        #Unknown message type

        $message = TLSProxy::Message->new(

            $server,

            $mt,

            $data,

            [@message_rec_list],

            $startoffset,

            [@message_frag_lens]

        );

    }



    return $message;

}



sub end

{

    my $class = shift;

    return $end;

}

sub success

{

    my $class = shift;

    return $success;

}



sub new

{

    my $class = shift;

    my ($server,

        $mt,

        $data,

        $records,

        $startoffset,

        $message_frag_lens) = @_;

    

    my $self = {

        server => $server,

        data => $data,

        records => $records,

        mt => $mt,

        startoffset => $startoffset,

        message_frag_lens => $message_frag_lens

    };



    return bless $self, $class;

}



#Update all the underlying records with the modified data from this message

#Note: Does not currently support re-encrypting

sub repack

{

    my $self = shift;

    my $msgdata;



    my $numrecs = $#{$self->records};



    $self->set_message_contents();



    my $lenhi;

    my $lenlo;



    $lenlo = length($self->data) & 0xff;

    $lenhi = length($self->data) >> 8;

    my $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);

        }



        $rec->data(substr($recdata, 0, $self->startoffset)

                   .($msgdata)

                   .substr($recdata, ${$self->message_frag_lens}[0]

                                     + TLS_MESSAGE_HEADER_LENGTH));



        #Update the fragment len in case we changed it above

        ${$self->message_frag_lens}[0] = length($msgdata)

                                         - TLS_MESSAGE_HEADER_LENGTH;

        return;

    }



    #Note we don't currently support changing a fragmented message length

    my $recctr = 0;

    my $datadone = 0;

    foreach my $rec (@{$self->records}) {

        my $recdata = $rec->decrypt_data;

        if ($recctr == 0) {

            #This is the first record

            my $remainlen = length($recdata) - $self->startoffset;

            $rec->data(substr($recdata, 0, $self->startoffset)

                       .substr(($msgdata), 0, $remainlen));

            $datadone += $remainlen;

        } elsif ($recctr + 1 == $numrecs) {

            #This is the last record

            $rec->data(substr($msgdata, $datadone));

        } else {

            #This is a middle record

            $rec->data(substr($msgdata, $datadone, length($rec->data)));

            $datadone += length($rec->data);

        }

        $recctr++;

    }

}



#To be overridden by sub-classes

sub set_message_contents

{

}



#Read only accessors

sub server

{

    my $self = shift;

    return $self->{server};

}



#Read/write accessors

sub mt

{

    my $self = shift;

    if (@_) {

      $self->{mt} = shift;

    }

    return $self->{mt};

}

sub data

{

    my $self = shift;

    if (@_) {

      $self->{data} = shift;

    }

    return $self->{data};

}

sub records

{

    my $self = shift;

    if (@_) {

      $self->{records} = shift;

    }

    return $self->{records};

}

sub startoffset

{

    my $self = shift;

    if (@_) {

      $self->{startoffset} = shift;

    }

    return $self->{startoffset};

}

sub message_frag_lens

{

    my $self = shift;

    if (@_) {

      $self->{message_frag_lens} = shift;

    }

    return $self->{message_frag_lens};

}



1;

util/TLSProxy/Proxy.pm

0 → 100644
+364 −0

File added.

Preview size limit exceeded, changes collapsed.

util/TLSProxy/Record.pm

0 → 100644
+360 −0

File added.

Preview size limit exceeded, changes collapsed.