view release on metacpan or  search on metacpan

t/channel.t  view on Meta::CPAN

use strict;
use warnings;

use Test::More;

BEGIN { $ENV{PROTOCOL_OTR_ENABLE_QUICK_RANDOM} = 1 }

use Protocol::OTR qw( :constants );
use File::Temp qw( tempdir );

my $tmpdir1 = tempdir( 'XXXXXXXX', DIR => "t/", CLEANUP => 1 );
my $tmpdir2 = tempdir( 'XXXXXXXX', DIR => "t/", CLEANUP => 1 );

my %FLAGS;
my %SWITCHES;
my %RWHANDLERS;

my @Q;

my $SMP_QUESTION = "W Paryżu najlepsze kasztany są na placu Pigalle";
my $SMP_WRONG_ANSWER = "Na placu Pigalle najlepsze sÄ… nie kasztany, ale burdele";
my $SMP_CORRECT_ANSWER = "Zuzanna lubi je tylko jesieniÄ….";

# messages need to be sent/received in order
sub send_messages {
    my $action = shift || sub { 0 };
    my $result = $action->();
    while (my $e = shift @Q) {
        $e->();
    }

    return $result;
}

my $otr = Protocol::OTR->new(
    {
        privkeys_file => "$tmpdir1/otr.private_key",
        contacts_file => "$tmpdir1/otr.fingerprints",
        instance_tags_file => "$tmpdir1/otr.instance_tags",

    }
);

my $otr2 = Protocol::OTR->new(
    {
        privkeys_file => "$tmpdir2/otr.private_key",
        contacts_file => "$tmpdir2/otr.fingerprints",
        instance_tags_file => "$tmpdir2/otr.instance_tags",

    }
);

my ($msg_a2b, $msg_b2a);

my $alice = $otr->account('alice', "protocol");
my $bob = $otr2->account('bob', "protocol");

# alice has Bob's fingerprint from his business card
my $alice2bob = $alice->contact( 'bob', '12345678 90ABCDEF 12345678 90ABCDEF 12345678');
# bob never talked with Alice over OTR
my $bob2alice = $bob->contact('alice');

my @alice2bob_fingerprints = $alice2bob->fingerprints();
is(scalar @alice2bob_fingerprints, 1, "Alice knows Bob's fingerprint");

my @bob2alice_fingerprints = $bob2alice->fingerprints();
is(scalar @bob2alice_fingerprints, 0, "Bob doesn't know Alice's fingerprint");

my %common_handlers = (
    policy => POLICY_ALWAYS,
    max_message_size => 1024,
    on_is_contact_logged_in => sub {
        my ($c) = @_;

        my $slot = join('2', $c->account->name, $c->contact->name);

        $FLAGS{$slot}->{on_is_contact_logged_in} = 1;

        return 1;
    },
    on_before_encrypt => sub {
        my ($c, $message) = @_;

        my $slot = join('2', $c->account->name, $c->contact->name);

        $FLAGS{$slot}->{on_before_encrypt} = {
            message => $message,
        };

        return $message unless $SWITCHES{enable_convert};

        my $enc = reverse $message;

        return $enc;
    },
    on_after_decrypt => sub {
        my ($c, $message) = @_;

        my $slot = join('2', $c->account->name, $c->contact->name);

        $FLAGS{$slot}->{on_after_decrypt} = {
            message => $message,
        };

        return $message unless $SWITCHES{enable_convert};