From b81d3ccf7f7faa092c6aab3eb5f4670d0171d34d Mon Sep 17 00:00:00 2001 From: Andrej Shadura Date: Mon, 2 Jul 2018 14:25:26 +0200 Subject: Import original source of Net-Async-IRC 0.11 --- t/00use.t | 11 ++++++ t/30client-connect.t | 107 ++++++++++++++++++++++++++++++++++++++++++++++++++ t/31client-cap.t | 100 ++++++++++++++++++++++++++++++++++++++++++++++ t/32client-encoding.t | 84 +++++++++++++++++++++++++++++++++++++++ t/33client-nick.t | 100 ++++++++++++++++++++++++++++++++++++++++++++++ t/40methods-basic.t | 40 +++++++++++++++++++ t/50client-pingpong.t | 86 ++++++++++++++++++++++++++++++++++++++++ t/99pod.t | 11 ++++++ t/privkey.pem | 15 +++++++ t/server.pem | 17 ++++++++ 10 files changed, 571 insertions(+) create mode 100644 t/00use.t create mode 100644 t/30client-connect.t create mode 100644 t/31client-cap.t create mode 100644 t/32client-encoding.t create mode 100644 t/33client-nick.t create mode 100644 t/40methods-basic.t create mode 100644 t/50client-pingpong.t create mode 100644 t/99pod.t create mode 100644 t/privkey.pem create mode 100644 t/server.pem (limited to 't') diff --git a/t/00use.t b/t/00use.t new file mode 100644 index 0000000..8bb8681 --- /dev/null +++ b/t/00use.t @@ -0,0 +1,11 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use_ok( "Net::Async::IRC" ); +use_ok( "Net::Async::IRC::Protocol" ); + +done_testing; diff --git a/t/30client-connect.t b/t/30client-connect.t new file mode 100644 index 0000000..bee0327 --- /dev/null +++ b/t/30client-connect.t @@ -0,0 +1,107 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; +use IO::Async::Listener; + +use Net::Async::IRC; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $client; +my $listener = IO::Async::Listener->new( + on_stream => sub { + ( undef, $client ) = @_; + }, +); +$loop->add( $listener ); + +$listener->listen( + addr => { family => "inet" }, +)->get; + +my @errors; + +my $irc = Net::Async::IRC->new( + user => "defaultuser", + realname => "Default Real name", + + on_message => sub { "IGNORE" }, + + on_irc_error => sub { + my $self = shift; + my ( $err ) = @_; + + push @errors, $err; + }, +); + +$loop->add( $irc ); + +ok( !$irc->is_connected, 'not $irc->is_connected' ); + +$irc->connect( + addr => { + family => "inet", + ip => $listener->read_handle->sockhost, + port => $listener->read_handle->sockport, + }, +)->get; + +ok( $irc->is_connected, '$irc->is_connected' ); +ok( !$irc->is_loggedin, 'not $irc->is_loggedin' ); + +wait_for { $client }; +$client->configure( on_read => sub { 0 } ); # using read futures +$loop->add( $client ); + +# Now see if we can send a message +$irc->send_message( "HELLO", undef, "world" ); + +my $read_f; + +$read_f = $client->read_until( $CRLF ); +wait_for { $read_f->is_ready }; + +is( scalar $read_f->get, "HELLO world$CRLF", 'Server stream after initial client message' ); + +my $logged_in = 0; + +my $login_f = $irc->login( + nick => "MyNick", + + on_login => sub { $logged_in = 1 }, +); + +$read_f = $client->read_until( qr/$CRLF.*$CRLF/ ); +wait_for { $read_f->is_ready }; + +is( scalar $read_f->get, + "USER defaultuser 0 * :Default Real name$CRLF" . + "NICK MyNick$CRLF", + 'Server stream after login' ); + +$client->write( ":irc.example.com 001 MyNick :Welcome to IRC MyNick!defaultuser\@your.host.here$CRLF" ); + +wait_for { $login_f->is_ready }; + +ok( !$login_f->failure, 'Client logs in without failure' ); + +ok( $logged_in, 'Client receives logged in event' ); +ok( $irc->is_connected, '$irc->is_connected' ); +ok( $irc->is_loggedin, '$irc->is_loggedin' ); + +$client->write( ":something invalid-here$CRLF" ); + +wait_for { scalar @errors }; + +ok( defined shift @errors, 'on_error invoked' ); + +done_testing; diff --git a/t/31client-cap.t b/t/31client-cap.t new file mode 100644 index 0000000..f2035ad --- /dev/null +++ b/t/31client-cap.t @@ -0,0 +1,100 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; +use IO::Async::Stream; + +use Net::Async::IRC; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my ( $S1, $S2 ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + +# Normal CAP login +{ + my $irc = Net::Async::IRC->new( + handle => $S1, + use_caps => [qw( multi-prefix )], + ); + $loop->add( $irc ); + + my $login_f = $irc->login( + nick => "MyNick", + user => "me", + realname => "My real name", + ); + + my $serverstream = ""; + wait_for_stream { $serverstream =~ m/(?:.*$CRLF){3}/ } $S2 => $serverstream; + + is( $serverstream, "CAP LS$CRLF" . + "USER me 0 * :My real name$CRLF" . + "NICK MyNick$CRLF", 'Server stream negotiates CAP' ); + $serverstream = ""; + + $S2->syswrite( ':irc.example.com CAP * LS :multi-prefix sasl' . $CRLF ); + + wait_for_stream { $serverstream =~ m/.*$CRLF/ } $S2 => $serverstream; + + is( $serverstream, "CAP REQ multi-prefix$CRLF", 'Client requests caps' ); + $serverstream = ""; + + is_deeply( $irc->caps_supported, + { 'multi-prefix' => 1, + 'sasl' => 1 }, + '$irc->caps_supported' ); + ok( $irc->cap_supported( "multi-prefix" ), '$irc->cap_supported' ); + + $S2->syswrite( ':irc.example.com CAP * ACK :multi-prefix' . $CRLF ); + + wait_for_stream { $serverstream =~ m/.*$CRLF/ } $S2 => $serverstream; + + is( $serverstream, "CAP END$CRLF", 'Client finishes CAP' ); + + is_deeply( $irc->caps_enabled, + { 'multi-prefix' => 1 }, + '$irc->caps_enabled' ); + ok( $irc->cap_enabled( "multi-prefix" ), '$irc->cap_enabled' ); + + $S2->syswrite( ':irc.example.com 001 MyNick :Welcome to IRC MyNick!me@your.host' . $CRLF ); + + wait_for { $login_f->is_ready }; + $login_f->get; + + $loop->remove( $irc ); +} + +# CAP ignored by server +{ + my $irc = Net::Async::IRC->new( + handle => $S1, + use_caps => [qw( multi-prefix )], + ); + $loop->add( $irc ); + + my $login_f = $irc->login( + nick => "MyNick", + user => "me", + realname => "My real name", + ); + + my $serverstream = ""; + wait_for_stream { $serverstream =~ m/(?:.*$CRLF){3}/ } $S2 => $serverstream; + + $S2->syswrite( ':irc.example.com 001 MyNick :Welcome to IRC MyNick!me@your.host' . $CRLF ); + + wait_for { $login_f->is_ready }; + $login_f->get; + + is( $irc->caps_supported, undef, '$irc->caps_supported undef for CAPless server' ); + is( $irc->caps_enabled, undef, '$irc->caps_enabled undef for CAPless server' ); +} + +done_testing; diff --git a/t/32client-encoding.t b/t/32client-encoding.t new file mode 100644 index 0000000..7110ab7 --- /dev/null +++ b/t/32client-encoding.t @@ -0,0 +1,84 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use utf8; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; +use IO::Async::Listener; + +use Encode qw( encode_utf8 ); + +use Net::Async::IRC; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +SKIP: foreach my $SSL ( 0, 1 ) { + if( $SSL ) { + eval { require IO::Async::SSL } or skip "No IO::Async::SSL", 1; + } + + my $client; + my $listener = IO::Async::Listener->new( + on_stream => sub { + ( undef, $client ) = @_; + }, + ); + $loop->add( $listener ); + + $listener->listen( + addr => { family => "inet" }, + ( $SSL ? + ( extensions => [ 'SSL' ], + SSL_key_file => "t/privkey.pem", + SSL_cert_file => "t/server.pem", ) : + () ), + )->get; + + my $irc = Net::Async::IRC->new( + user => "defaultuser", + realname => "Default Real name", + + encoding => "UTF-8", + + on_message => sub { "IGNORE" }, + + on_irc_error => sub {}, + ); + $loop->add( $irc ); + + $irc->connect( + addr => { + family => "inet", + ip => $listener->read_handle->sockhost, + port => $listener->read_handle->sockport, + }, + ( $SSL ? + ( extensions => [ 'SSL' ], + SSL_verify_mode => 0 ) : + () ), + )->get; + + wait_for { $client }; + $client->configure( on_read => sub { 0 } ); # using read futures + $loop->add( $client ); + + $irc->send_message( "PRIVMSG", undef, "target", "Ĉu vi ĉi tio vidas?" ); + + my $read_f = $client->read_until( $CRLF ); + wait_for { $read_f->is_ready }; + + is( scalar $read_f->get, encode_utf8( "PRIVMSG target :Ĉu vi ĉi tio vidas?$CRLF" ), + 'Stream is encoded over ' . ( $SSL ? "SSL" : "plaintext" ) ); + + $loop->remove( $irc ); + $loop->remove( $client ); + $loop->remove( $listener ); +} + +done_testing; diff --git a/t/33client-nick.t b/t/33client-nick.t new file mode 100644 index 0000000..078f5dc --- /dev/null +++ b/t/33client-nick.t @@ -0,0 +1,100 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::OS; +use IO::Async::Loop; +use IO::Async::Stream; + +use Net::Async::IRC; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my ( $S1, $S2 ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + +my $in_use = 0; +my $err_nick = 0; +my $irc = Net::Async::IRC->new( + handle => $S1, + + user => "defaultuser", + realname => "Default Real name", + + nick => "AlreadyUsedNick", + + on_message_ERR_NICKNAMEINUSE => sub { shift->change_nick( "1stNick" ); $in_use = 1; }, + on_message_ERR_ERRONEUSNICKNAME => sub { shift->change_nick( "FirstNickTOOLONG" ); $err_nick = 1; }, + on_message => sub { "IGNORE" }, +); + +$loop->add( $irc ); + +is( $irc->nick, "AlreadyUsedNick", 'Initial nick is set' ); + +ok( $irc->is_nick_me( "AlreadyUsedNick" ), 'Client recognises initial nick' ); +ok( !$irc->is_nick_me( "SomeoneElse" ), 'Client does not recognise other nick' ); + +my $login_f = $irc->login; + +my $serverstream = ""; + +wait_for_stream { $serverstream =~ m/$CRLF.*$CRLF/ } $S2 => $serverstream; + +is( $serverstream, "USER defaultuser 0 * :Default Real name$CRLF" . + "NICK AlreadyUsedNick$CRLF", 'Server stream after attempt to login with nick already in use' ); + +$S2->syswrite( ":irc.example.com 433 * AlreadyUsedNick :Nickname is already in use$CRLF" ); + +wait_for { $in_use }; + +ok( $in_use, 'Client recieves ERR_NICKNAMEINUSE error' ); + +$S2->syswrite( ":irc.example.com 432 * 1stNick :Erroneous nickname$CRLF" ); + +wait_for { $err_nick }; + +ok( $err_nick, 'Client recieves ERR_ERRONEUSNICK error' ); + +$S2->syswrite( ":irc.example.com 001 FirstNick :Welcome to IRC FirstNick!defaultuser\@your.host.here$CRLF" ); + +wait_for { $login_f->is_ready }; +$login_f->get; + +is( $irc->nick, "FirstNick", 'Nick was updated correctly even after multiple errors' ); + +$serverstream = ""; + +wait_for_stream { $serverstream =~ m/$CRLF/ } $S2 => $serverstream; + +is( $serverstream, "NICK 1stNick$CRLF" . + "NICK FirstNickTOOLONG$CRLF", 'Server stream after login' ); + +$irc->change_nick( "SecondNick" ); + +is( $irc->nick, "FirstNick", 'Nick still old until server confirms' ); + +ok( $irc->is_nick_me( "FirstNick" ), 'Client recognises still old nick' ); +ok( !$irc->is_nick_me( "SecondNick" ), 'Client does not recognise new nick' ); + +$serverstream = ""; + +wait_for_stream { $serverstream =~ m/$CRLF/ } $S2 => $serverstream; + +is( $serverstream, "NICK SecondNick$CRLF", 'Server stream after NICK command' ); + +$S2->syswrite( ":FirstNick!defaultuser\@your.host.here NICK SecondNick$CRLF" ); + +wait_for { not $irc->is_nick_me( "FirstNick" ) }; + +is( $irc->nick, "SecondNick", 'Object now confirms new nick' ); + +ok( !$irc->is_nick_me( "FirstNick" ), 'Client no longer recognises old nick' ); +ok( $irc->is_nick_me( "SecondNick" ), 'Client now recognises new nick' ); + +done_testing; diff --git a/t/40methods-basic.t b/t/40methods-basic.t new file mode 100644 index 0000000..dd36500 --- /dev/null +++ b/t/40methods-basic.t @@ -0,0 +1,40 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; +use IO::Async::Stream; + +use Net::Async::IRC; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my ( $S1, $S2 ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + +my $irc = Net::Async::IRC->new( + handle => $S1, +); +$loop->add( $irc ); + +# privmsg +{ + my $f = $irc->do_PRIVMSG( target => "#target", text => "Your message here" ); + + isa_ok( $f, "Future", '$f' ); + + my $serverstream = ""; + wait_for_stream { $serverstream =~ m/(?:.*$CRLF)/ } $S2 => $serverstream; + + is( $serverstream, "PRIVMSG #target :Your message here$CRLF", + '->privmsg' ); + + ok( $f->is_ready, '$f is ready' ); +} + +done_testing; diff --git a/t/50client-pingpong.t b/t/50client-pingpong.t new file mode 100644 index 0000000..4f715bf --- /dev/null +++ b/t/50client-pingpong.t @@ -0,0 +1,86 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Time::HiRes qw(); # Empty import, just there to let IO::Async and Net::Async::IRC use it + +use IO::Async::Test; +use IO::Async::OS; +use IO::Async::Loop; +use IO::Async::Stream; + +use Net::Async::IRC; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my ( $S1, $S2 ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + +my $lag; +my $pingout; + +my $irc = Net::Async::IRC->new( + handle => $S1, + on_message => sub { "IGNORE" }, + + pingtime => 2, + pongtime => 1, + + on_pong_reply => sub { $lag = $_[1] }, + on_ping_timeout => sub { $pingout = 1 }, +); + +$loop->add( $irc ); + +# This is all tricky timing-related code. Pay attention + +# First [the server] will send three messages, separated by 1sec, and assert +# that the client didn't send a PING + +my $serverstream = ""; + +my $msgcount = 0; + +sub tick { + $msgcount++; + $S2->syswrite( "HELLO client$CRLF" ); + + $loop->enqueue_timer( + delay => 1, + code => \&tick + ) if $msgcount < 3; +} + +tick(); + +wait_for_stream { $msgcount == 3 } $S2 => $serverstream; + +is( $serverstream, "", 'client quiet after server noise' ); + +# Now [the server] will be quiet and assert that the client sends a PING + +wait_for_stream { $serverstream =~ m/$CRLF/ } $S2 => $serverstream; + +like( $serverstream, qr/^PING .*$CRLF$/, 'client sent PING after server idle' ); + +# Now lets be a good server and reply to the PING +my ( $pingarg ) = $serverstream =~ m/^PING (.*)$CRLF$/; +$S2->syswrite( ":irc.example.com PONG $pingarg$CRLF" ); + +undef $lag; +wait_for { defined $lag }; + +ok( $lag >= 0 && $lag <= 1, 'client acknowledges PONG reply' ); + +# Now [the server] won't reply to a PING at all, and hope for an event to note +# that it failed + +wait_for { defined $pingout }; +ok( $pingout, 'client reports PING timeout' ); + +done_testing; diff --git a/t/99pod.t b/t/99pod.t new file mode 100644 index 0000000..eb319fb --- /dev/null +++ b/t/99pod.t @@ -0,0 +1,11 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +eval "use Test::Pod 1.00"; +plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; + +all_pod_files_ok(); diff --git a/t/privkey.pem b/t/privkey.pem new file mode 100644 index 0000000..a7eb3d0 --- /dev/null +++ b/t/privkey.pem @@ -0,0 +1,15 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXAIBAAKBgQDddpSdw0V5emmrozEq3LkTiILDUeUk4MiTmoug1bcfgbQwld4r +U/Dyl1oT8bonEzIcf7002HAQmhPae+9XdQOxnqyzamRBNwuypO895g5EPswTh9Rr +PohJse3qWs4yVP1PVeatBwxIvug+6+0XXAymNBVJmQfcCbLX4i/b27NtmwIDAQAB +AoGAcz93XZY1/F6oyQo21wBgS/r5WZ2vqn5TwwRk70DoeDvuQm5rXI7lT8lVthVQ +c284373V/782ql0UQdnHFvMtBPT14fPdfysBSFIwjPdAZMG6EqTtYy30o8Hk1N34 +CcBTqS4nt+MvxW3xdvQd/hVZgoWRbdCZ6p11Ky9ylmJgt6kCQQD3cRkKNjeF//8j +eG/L0OykpTivy0peDCWOZCyRIME45+L/eYaYKMdhQ4YNeaguMC2Z8GrbXf2oRZce +t2jxn6tdAkEA5R92e5jC3dT+S1SCCSzdr1+IGF8PF5EnPCGtQMl+pfCleAo/aiPK +pM2lmoUaOoMj8j655mq5gdUxxshPFl7lVwJBAJmo2D3pMU27jbt/PR263lnYaH1y +pvoEXQYx2yM8zgECr4qq8xRmrnoOLp8Ln48fSBJCpHkZwz3OCWx/xWHXH9kCQEH+ +3wTYyoBVAm42SEJWTwBdtvi2IMW8BJ4YYSwBHd60QyUhZoSvDIaNyX6JijWCYo87 +LBbHdOmFvBGyzrz11n8CQCmlyhmF2xe1xUrYnGgnfIj29KPFmJik2qeDTfxACv4Z +MzPtOWOEdZjc5h6JTnQTl0fcko35l5FaUeflvw2uBGM= +-----END RSA PRIVATE KEY----- diff --git a/t/server.pem b/t/server.pem new file mode 100644 index 0000000..54b5b51 --- /dev/null +++ b/t/server.pem @@ -0,0 +1,17 @@ +-----BEGIN CERTIFICATE----- +MIICsDCCAhmgAwIBAgIJAOLBB28kRrw6MA0GCSqGSIb3DQEBBQUAMEUxCzAJBgNV +BAYTAkFVMRMwEQYDVQQIEwpTb21lLVN0YXRlMSEwHwYDVQQKExhJbnRlcm5ldCBX +aWRnaXRzIFB0eSBMdGQwHhcNMTAxMTIxMjIwMjM5WhcNMTAxMjIxMjIwMjM5WjBF +MQswCQYDVQQGEwJBVTETMBEGA1UECBMKU29tZS1TdGF0ZTEhMB8GA1UEChMYSW50 +ZXJuZXQgV2lkZ2l0cyBQdHkgTHRkMIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKB +gQDddpSdw0V5emmrozEq3LkTiILDUeUk4MiTmoug1bcfgbQwld4rU/Dyl1oT8bon +EzIcf7002HAQmhPae+9XdQOxnqyzamRBNwuypO895g5EPswTh9RrPohJse3qWs4y +VP1PVeatBwxIvug+6+0XXAymNBVJmQfcCbLX4i/b27NtmwIDAQABo4GnMIGkMB0G +A1UdDgQWBBQKCmQV0xTMGtYoalfHFbpDr3kgszB1BgNVHSMEbjBsgBQKCmQV0xTM +GtYoalfHFbpDr3kgs6FJpEcwRTELMAkGA1UEBhMCQVUxEzARBgNVBAgTClNvbWUt +U3RhdGUxITAfBgNVBAoTGEludGVybmV0IFdpZGdpdHMgUHR5IEx0ZIIJAOLBB28k +Rrw6MAwGA1UdEwQFMAMBAf8wDQYJKoZIhvcNAQEFBQADgYEAIjrc8INv1WxIq0kV +yDEmcBeot1RRiCQJJxy3xq6eZZcTkT+YvEVrR/hOWPGL0qFInltBKcp0To0w+Esz +SQfvieWW1U/aAfcBNJ26HRyzh8N98ZST9k4LlDJbneHB8McF1G5n/D71wmHm1llh +cIX3gRpAkOW5gnjXUYpgsviJxUQ= +-----END CERTIFICATE----- -- cgit v1.2.3