Skip Menu |
 

This queue is for tickets about the Net-Async-IRC CPAN distribution.

Report information
The Basics
Id: 91777
Status: resolved
Priority: 0/
Queue: Net-Async-IRC

People
Owner: Nobody in particular
Requestors: kiyoshi.aman [...] gmail.com
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: 0.08



Subject: Implement CAP support
Download (untitled) / with headers
text/plain 214b
CAP support needs to be implemented so that users of Net::Async::IRC can take advantage of IRCv3 features such as SASL. Protocol snippets are available at http://paste.aerdan.org/show/201/ for ease of test-writing.
Download (untitled) / with headers
text/plain 186b
I believe the attached patch now implements an initial attempt at this. Doesn't completely cover all of CAP's abilities, but enough to negotiate optional CAPs on login. -- Paul Evans
Subject: rt91777.patch
Download rt91777.patch
text/x-diff 6.6k
=== modified file 'lib/Net/Async/IRC.pm' --- lib/Net/Async/IRC.pm 2014-01-19 18:45:36 +0000 +++ lib/Net/Async/IRC.pm 2014-01-19 20:25:50 +0000 @@ -90,6 +90,11 @@ C<change_nick>. Changing the other properties will not take effect until the next login. +=item use_caps => ARRAY of STRING + +Attempts to negotiate IRC v3.1 CAP at connect time. The array gives the names +of capabilities which will be requested, if the server supports them. + =back =cut @@ -99,7 +104,7 @@ my $self = shift; my %args = @_; - for (qw( user realname )) { + for (qw( user realname use_caps )) { $self->{$_} = delete $args{$_} if exists $args{$_}; } @@ -269,10 +274,10 @@ croak "Expected 'on_login' to be a CODE reference"; return $self->{login_f} ||= $self->connect( %args )->then( sub { + $self->send_message( "CAP", undef, "LS" ) if $self->{use_caps}; + $self->send_message( "PASS", undef, $pass ) if defined $pass; - $self->send_message( "USER", undef, $user, "0", "*", $realname ); - $self->send_message( "NICK", undef, $nick ); my $f = $self->loop->new_future; @@ -365,6 +370,126 @@ # Message handling methods # ############################ +=head1 IRC v3.1 CAPABILITIES + +The following methods relate to IRC v3.1 capabilities negotiations. + +=cut + +sub on_message_CAP +{ + my $self = shift; + my ( $message, $hints ) = @_; + + my $verb = $message->arg(1); + + my %hints = ( + %$hints, + verb => $verb, + caps => { map { $_ => 1 } split m/ /, $message->arg(2) }, + ); + + $self->invoke( "on_message_cap_$verb", $message, \%hints ) and $hints{handled} = 1; + $self->invoke( "on_message_cap", $verb, $message, \%hints ) and $hints{handled} = 1; + + return $hints{handled}; +} + +sub on_message_cap_LS +{ + my $self = shift; + my ( $message, $hints ) = @_; + + my $supported = $self->{caps_supported} = $hints->{caps}; + + my @request = grep { $supported->{$_} } @{$self->{use_caps}}; + + if( @request ) { + $self->{caps_enabled} = { map { $_ => undef } @request }; + $self->send_message( "CAP", undef, "REQ", join( " ", @request ) ); + } + else { + $self->send_message( "CAP", undef, "END" ); + } + + return 1; +} + +*on_message_cap_ACK = *on_message_cap_NAK = \&_on_message_cap_reply; +sub _on_message_cap_reply +{ + my $self = shift; + my ( $message, $hints ) = @_; + my $ack = $hints->{verb} eq "ACK"; + + $self->{caps_enabled}{$_} = $ack for keys %{ $hints->{caps} }; + + # Are any outstanding + !defined and return 1 for values %{ $self->{caps_enabled} }; + + $self->send_message( "CAP", undef, "END" ); + return 1; +} + +=head2 $caps = $irc->caps_supported + +Returns a HASH whose keys give the capabilities listed by the server as +supported in its C<CAP LS> response. If the server ignored the C<CAP> +negotiation then this method returns C<undef>. + +=cut + +sub caps_supported +{ + my $self = shift; + return $self->{caps_supported}; +} + +=head2 $supported = $irc->cap_supported( $cap ) + +Returns a boolean indicating if the server supports the named capability. + +=cut + +sub cap_supported +{ + my $self = shift; + my ( $cap ) = @_; + return !!$self->{caps_supported}{$cap}; +} + +=head2 $caps = $irc->caps_enabled + +Returns a HASH whose keys give the capabilities successfully enabled by the +server as part of the C<CAP REQ> login sequence. If the server ignored the +C<CAP> negotiation then this method returns C<undef>. + +=cut + +sub caps_enabled +{ + my $self = shift; + return $self->{caps_enabled}; +} + +=head2 $enabled = $irc->cap_enabled( $cap ) + +Returns a boolean indicating if the client successfully enabled the named +capability. + +=cut + +sub cap_enabled +{ + my $self = shift; + my ( $cap ) = @_; + return !!$self->{caps_enabled}{$cap}; +} + +=head1 MESSAGE HANDLING + +=cut + sub on_message_NICK { my $self = shift; === added file 't/31client-cap.t' --- t/31client-cap.t 1970-01-01 00:00:00 +0000 +++ t/31client-cap.t 2014-01-19 20:24:59 +0000 @@ -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;
Now in 0.08 -- Paul Evans


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.