File Coverage

blib/lib/Protocol/TLS/Client.pm

Criterion	Covered	Total	%
statement	76	78	97.4
branch	7	12	58.3
condition			n/a
subroutine	14	14	100.0
pod	0	2	0.0
total	97	106	91.5

package Protocol::TLS::Client;
use strict;
use warnings;
use Carp;
use Protocol::TLS::Trace qw(tracer bin2hex);
use Protocol::TLS::Context;
use Protocol::TLS::Connection;
use Protocol::TLS::Constants qw(const_name :state_types :end_types :c_types
  :versions :hs_types :ciphers cipher_type :alert_desc);

sub new {
    my ( $class, %opts ) = @_;
    my $self = bless { %opts, sid => {}, }, $class;
}

sub new_connection {
    my ( $self, $server_name, %opts ) = @_;
    croak "Specify server name of host" unless defined $server_name;

    my $ctx = Protocol::TLS::Context->new( type => CLIENT );
    my $con = Protocol::TLS::Connection->new($ctx);

    # Grab random session_id from cache (if exists)
    if ( exists $self->{sid}->{$server_name} ) {
        my $s   = $self->{sid}->{$server_name};
        my $sid = ( keys %$s )[0];

        $ctx->{proposed} = {
            session_id  => $sid,
            tls_version => $s->{$sid}->{tls_version},
            ciphers     => [ $s->{$sid}->{cipher} ],
            compression => [ $s->{$sid}->{compression} ],
        };
    }
    else {
        $ctx->{proposed} = {
            session_id => '',
            ciphers    => [
                TLS_RSA_WITH_AES_128_CBC_SHA, TLS_RSA_WITH_NULL_SHA256,
                TLS_RSA_WITH_NULL_SHA,
            ],
            tls_version => TLS_v12,
            compression => [0],
        };
    }

    if ( exists $opts{on_data} ) {
        $ctx->{on_data} = $opts{on_data};
    }

    $ctx->enqueue( [ CTYPE_HANDSHAKE, HSTYPE_CLIENT_HELLO, $ctx->{proposed} ] );

    $ctx->{on_change_state} = sub {
        my ( $ctx, $prev_state, $new_state ) = @_;
        tracer->debug( "State changed from "
              . const_name( 'state_types', $prev_state ) . " to "
              . const_name( 'state_types', $new_state ) );
    };

    # New session
    $ctx->state_cb(
        STATE_HS_HALF,
        sub {
            my $ctx    = shift;
            my $p      = $ctx->{pending};
            my $pro    = $ctx->{proposed};
            my $sp     = $p->{securityParameters};
            my $crypto = $ctx->crypto;

            # Server invalidate our session
            if ( $pro->{session_id} ne '' ) {
                delete $self->{sid}->{$server_name}->{ $pro->{session_id} };
            }

            my $pub_key = $crypto->cert_pubkey( $p->{cert}->[0] );

            my ( $da, $ca, $mac ) = cipher_type( $p->{cipher} );

            if ( $da eq 'RSA' ) {
                my $preMasterSecret =
                  pack( "n", $p->{tls_version} ) . $crypto->random(46);

                $sp->{master_secret} = $crypto->PRF(
                    $preMasterSecret,
                    "master secret",
                    $sp->{client_random} . $sp->{server_random}, 48
                );

                my $encoded =
                  $crypto->rsa_encrypt( $pub_key, $preMasterSecret );
                $ctx->enqueue(
                    [ CTYPE_HANDSHAKE, HSTYPE_CLIENT_KEY_EXCHANGE, $encoded ] );
            }
            else {
                die "not implemented";
            }

            $ctx->enqueue( [CTYPE_CHANGE_CIPHER_SPEC],
                [ CTYPE_HANDSHAKE, HSTYPE_FINISHED, $ctx->finished ] );
        }
    );

    $ctx->state_cb( STATE_SESS_RESUME,
        sub {
            my $ctx = shift;
            my $p   = $ctx->{pending};

            #my $pro    = $ctx->{proposed};
            my $sp = $p->{securityParameters};

            my $s = $self->{sid}->{$server_name}->{ $p->{session_id} };
            $p->{tls_version} = $s->{tls_version};
            $p->{cipher}      = $s->{cipher};
            $sp->{$_}         = $s->{securityParameters}->{$_}
              for keys %{ $s->{securityParameters} },

              tracer->debug( "Resume session: " . bin2hex( $p->{session_id} ) );
        }
    );

    $ctx->state_cb( STATE_HS_RESUME,
        sub {
            my $ctx = shift;
            $ctx->enqueue( [CTYPE_CHANGE_CIPHER_SPEC],
                [ CTYPE_HANDSHAKE, HSTYPE_FINISHED, $ctx->finished ] );
        }
    );

    $ctx->state_cb( STATE_OPEN,
        sub {
            my $ctx = shift;
            my $p   = $ctx->{pending};

            # add sid to client's cache
            $self->{sid}->{$server_name}->{ $p->{session_id} } =
              $ctx->copy_pending;
            tracer->debug( "Saved sid: " . bin2hex( $p->{session_id} ) );
            $ctx->{session_id}  = $p->{session_id};
            $ctx->{tls_version} = $p->{tls_version};
            $ctx->clear_pending;

            # Handle callbacks
            if ( exists $opts{on_handshake_finish} ) {
                $opts{on_handshake_finish}->($ctx);
            }
        }
    );

    $con;
}

1
__END__