view release on metacpan or  search on metacpan

t/leak.t  view on Meta::CPAN

    while (matrixSslHandshakeIsComplete($Client_SSL) != 1 and
            (length $client2server or length $server2client)) {
        _decode($Server_SSL, $client2server, $server2client) or last;
        _decode($Client_SSL, $server2client, $client2server) or last;
    }
    matrixSslHandshakeIsComplete($Client_SSL)
        == ($VALIDATE[0]==-1 ? 0 : 1)
        or die diag sprintf 'wrong handshake result';
    
    matrixSslGetAnonStatus($Client_SSL, my $anonArg=0);
    $anonArg
        == ($VALIDATE[0]==$SSL_ALLOW_ANON_CONNECTION ? 1 : 0)
        or die diag sprintf 'wrong certificate validate result';

    matrixSslDeleteSession($Server_SSL);
    matrixSslDeleteSession($Client_SSL);
}

sub cb_validate {
    my ($cert, $arg) = @_;
    push @VALIDATE, shift @VALIDATE;
    return $VALIDATE[0];
}

sub client_server {
    my ($client2server, $server2client) = (q{}, q{});

    my ($Server_SSL, $Client_SSL, $Client_sessionId);
    matrixSslNewSession($Server_SSL, $Server_Keys, undef, $SSL_FLAGS_SERVER)
        == 0 or die diag sprintf 'matrixSslNewSession (server)';
    matrixSslNewSession($Client_SSL, $Client_Keys, $Client_sessionId, 0)
        == 0 or die diag sprintf 'matrixSslNewSession (client)';

    my $cipherSuite = 0;
    matrixSslEncodeClientHello($Client_SSL, $client2server, $cipherSuite)
        == 0 or die diag sprintf 'matrixSslEncodeClientHello';
    while (matrixSslHandshakeIsComplete($Client_SSL) != 1 and
            (length $client2server or length $server2client)) {
        _decode($Server_SSL, $client2server, $server2client) or last;
        _decode($Client_SSL, $server2client, $client2server) or last;
    }
    matrixSslHandshakeIsComplete($Client_SSL)
        == 1 or die diag sprintf 'handshake failed';
    length($client2server)
        == 0 or die diag sprintf 'client2server non-empty after handshake';
    length($server2client)
        == 0 or die diag sprintf 'server2client non-empty after handshake';

    my $s   = "Hello MatrixSSL!\n".("\0" x 16000);

    matrixSslEncode($Client_SSL, $s, $client2server)
        >= 0 or die diag sprintf 'matrixSslEncode (client)';
    matrixSslEncode($Client_SSL, $s, $client2server)
        >= 0 or die diag sprintf 'matrixSslEncode (client)';

    my ($rc, $error, $alertLevel, $alertDescription);
    matrixSslDecode($Server_SSL, $client2server, $server2client,
        $error, $alertLevel, $alertDescription)
        == $SSL_PROCESS_DATA or die diag sprintf 'matrixSslDecode (first)';
    $server2client
        eq $s or die diag sprintf 'first string decoded incorrectly';
    matrixSslDecode($Server_SSL, $client2server, $server2client,
        $error, $alertLevel, $alertDescription)
        == $SSL_PROCESS_DATA or die diag sprintf 'matrixSslDecode (second)';;
    $server2client
        eq $s.$s or die diag sprintf 'second string decoded incorrectly or was not appended to output buffer';
    length($client2server)
        == 0 or die diag sprintf 'client2server non-empty';

    matrixSslDeleteSession($Server_SSL);
    matrixSslGetSessionId($Client_SSL, $Client_sessionId)
        == 0 or die diag sprintf 'matrixSslGetSessionId';
    matrixSslDeleteSession($Client_SSL);
    matrixSslFreeSessionId($Client_sessionId);
}

sub _decode {
    my ($ssl, $in, $out) = @_;
    if (length $in) {
        my ($rc, $error, $alertLevel, $alertDescription);
        $rc = matrixSslDecode($ssl, $in, $out,
            $error, $alertLevel, $alertDescription);
        if ($rc == $SSL_SUCCESS || $rc == $SSL_SEND_RESPONSE) {
            @_[1,2] = ($in, $out);
        }
        elsif ($rc == $SSL_ERROR && $error == $SSL_ALERT_BAD_CERTIFICATE) {
            return;
        }
        else {
            warn sprintf "DECODE_Client handshake error:\n".
                "\trc=%s error=%s\n".
                "\talertLevel=%s alertDescription=%s\n",
                $rc, $Crypt::MatrixSSL::mxSSL_RETURN_CODES{$rc},
                $SSL_alertDescription{$error},
                $SSL_alertLevel{$alertLevel},
                $SSL_alertDescription{$alertDescription};
            return;
        }
    }
    return 1;
}

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

sub leaktest {
    my $test = shift;
    my %arg  = (init=>10, test=>1000, max_mem_diff=>100, diag=>1, @_);
    my $code = do { no strict 'refs'; \&$test };
    $code->() for 1 .. $arg{init};
    my $mem = MEM_used();
    my $fd  = FD_used();
    $code->() for 1 .. $arg{test};
    diag sprintf "---- MEM $test\nWAS: %d\nNOW: %d\n", $mem, MEM_used() if $arg{diag};
    ok( MEM_used() - $mem < $arg{max_mem_diff},  "MEM: $test" );
    is( FD_used() - $fd, 0,                      " FD: $test" );
}

#########################
# General-purpose utils #
#########################
use Carp;
sub Cat {
    croak 'usage: Cat( FILENAME )' if @_ != 1;
    my ($filename) = @_;
    open my $f, '<', $filename or croak "open: $!";
    local $/ if !wantarray;