view release on metacpan or  search on metacpan

t/leak.t  view on Meta::CPAN

    my ($Server_SSL, $Client_SSL);
    $Server_SSL = Crypt::MatrixSSL3::Server->new($Server_Keys, undef);
    $Client_SSL = Crypt::MatrixSSL3::Client->new($Client_Keys, undef, undef, \&_cb_validate, undef, undef, undef);

    my ($client2server, $server2client) = (q{}, q{});
    my ($client_rc, $server_rc);
    while (1) {
        # quiet warnings about dying in certValidate callback
        open my $oldstderr, '>&', \*STDERR  or die "can't dup STDERR: $!";
        close STDERR                        or die "can't close STDERR: $!";
        open STDERR, '>', \(my $stderr)     or die "can't open STDERR: $!";

        $server_rc = _decode($Server_SSL, $client2server, $server2client);
        $client_rc = _decode($Client_SSL, $server2client, $client2server);

        open STDERR, '>&', $oldstderr       or die "can't reopen STDERR: $!";
        close $oldstderr                    or die "can't close oldstderr: $!";

        last if $client_rc || $server_rc;
    }
    if ($client_rc == -1 && !$server_rc) {
        $server_rc = _decode($Server_SSL, $client2server, $server2client);
    }
    my $rc = (defined $VALIDATE[-1] && ($VALIDATE[-1] == 0 || $VALIDATE[-1] == SSL_ALLOW_ANON_CONNECTION)) ? 1 : -1;
    if ($client_rc != $rc || $server_rc != $rc) {
        die "handshake: expect: $rc, got: $client_rc, $server_rc\n";
    }
}

sub client_server {
    my ($Server_SSL, $Client_SSL);
    $Server_SSL = Crypt::MatrixSSL3::Server->new($Server_Keys, undef);
    $Client_SSL = Crypt::MatrixSSL3::Client->new($Client_Keys, $SessionID, undef, undef, undef, undef, undef);

    my ($client2server, $server2client) = (q{}, q{});
    my ($client_rc, $server_rc);
    while (1) {
        $server_rc = _decode($Server_SSL, $client2server, $server2client);
        $client_rc = _decode($Client_SSL, $server2client, $client2server);
        last if $client_rc || $server_rc;
    }
    $server_rc ||= _decode($Server_SSL, $client2server, $server2client);
    $client_rc == 1
        or die 'client: handshake failed';
    $server_rc == 1
        or die 'server: handshake failed';
    length($client2server) == 0
        or die 'client2server non-empty after handshake';
    length($server2client) == 0
        or die 'server2client non-empty after handshake';

    my $buf;

    $Client_SSL->encode_to_outdata($client_server_s) > 0
        or die 'encode_to_outdata';
    $Client_SSL->encode_to_outdata($client_server_s) > 0
        or die 'encode_to_outdata';
    assert _decode($Client_SSL, $server2client, $client2server);
    assert _decode($Server_SSL, $client2server, $server2client, $buf);
    $buf eq $client_server_s . $client_server_s
        or die 'packets 1+2 decoded incorrectly';

    $Client_SSL->encode_to_outdata($client_server_s16k) > 0
        or die 'encode_to_outdata';
    $Client_SSL->encode_to_outdata($client_server_s16k) > 0
        or die 'encode_to_outdata';
    assert _decode($Client_SSL, $server2client, $client2server);
    assert _decode($Server_SSL, $client2server, $server2client, $buf);
    $buf eq $client_server_s . $client_server_s . $client_server_s16k
        or die 'packet 3 decoded incorrectly';
    assert _decode($Client_SSL, $server2client, $client2server);
    assert _decode($Server_SSL, $client2server, $server2client, $buf);
    $buf eq $client_server_s . $client_server_s . $client_server_s16k . $client_server_s16k
        or die 'packet 4 decoded incorrectly';

    undef $client2server;
    undef $server2client;
    undef $client_rc;
    undef $server_rc;
    undef $buf;
    undef $Client_SSL;
    undef $Server_SSL;
}

sub _cb_validate {
    my ($crt, $alert) = @_;
    push @VALIDATE, shift @VALIDATE;
    die "I'm tired of validating!\n" if !defined $VALIDATE[-1];
    return $VALIDATE[-1];
}

sub _decode {
    my ($ssl) = @_; # other 3 params must be modified in place
    while (length $_[1]) {
        my $rc = $ssl->received_data($_[1], my $buf);
RC:
        if    ($rc == MATRIXSSL_REQUEST_SEND)       { last          }
        elsif ($rc == MATRIXSSL_REQUEST_RECV)       { next          }
        elsif ($rc == MATRIXSSL_HANDSHAKE_COMPLETE) { return 1      }
        elsif ($rc == MATRIXSSL_RECEIVED_ALERT)     { alert($buf); return -1 }
        elsif ($rc == MATRIXSSL_APP_DATA)           { $_[3].=$buf   }
        elsif ($rc == MATRIXSSL_SUCCESS)            { last          }
        else                                        { die error($rc)}
        $rc = $ssl->processed_data($buf);
        goto RC;
    }
    while (my $n = $ssl->get_outdata($_[2])) {
        my $rc = $ssl->sent_data($n);
        if    ($rc == MATRIXSSL_REQUEST_SEND)       { next          }
        elsif ($rc == MATRIXSSL_SUCCESS)            { last          }
        elsif ($rc == MATRIXSSL_REQUEST_CLOSE)      { return -1     }
        elsif ($rc == MATRIXSSL_HANDSHAKE_COMPLETE) { return 1      }
        else                                        { die error($rc)}
    }
    return;
}

sub error {
    my $rc = get_ssl_error($_[0]);
    return sprintf "MatrixSSL error %d: %s\n", $rc, $rc;
}

sub alert {
    my ($level, $descr) = get_ssl_alert($_[0]);
#     diag sprintf "MatrixSSL alert: level %d: %s, desc %d: %s\n", $level, $level, $descr, $descr;
    return;
}


##############################################################################

sub leaktest {
    my $test = shift;
    my %arg  = (init=>10, test=>100, max_mem_diff=>288, diag=>0, @_);