AnyEvent-IRC-Server

 view release on metacpan or  search on metacpan

lib/AnyEvent/IRC/Server.pm  view on Meta::CPAN

my $CRLF = "\015\012";

BEGIN {
    no strict 'refs';
    while (my ($code, $name) = each %AnyEvent::IRC::Util::RFC_NUMCODE_MAP) {
        *{"${name}"} = sub () { $code };
    }
};

sub debugf {
    return unless $ENV{AEIS_DEBUG};
    require Data::Dumper;
    require Term::ANSIColor;
    local $Data::Dumper::Terse=1;
    local $Data::Dumper::Indent=0;
    my $fmt = shift;
    my $s = sprintf $fmt, (map {
        ref($_) ? (
            Data::Dumper::Dumper($_)
        ) : (defined($_) ? $_ : '<<UNDEF>>')

lib/AnyEvent/IRC/Server.pm  view on Meta::CPAN

            my ($self, $host, $port) = @_;
            print "$class is ready on : $host:$port\n";
        },
        @_,
    );

    
    my $say = sub {
        my ($handle, $cmd, @args) = @_;
        my $msg = mk_msg_ex($self->host, $cmd, $handle->{nick}, @args);
        debugf("Sending '%s'", $msg);
        $msg .= $CRLF;
        $handle->push_write($msg)
    };
    my $need_more_params = sub {
        my ($handle, $cmd) = @_;
        $say->($handle, ERR_NEEDMOREPARAMS, $cmd, 'Not enough parameters');
    };
    $self->reg_cb(
        nick => sub {
            my ($self, $msg, $handle) = @_;
            my ($nick) = @{$msg->{params}};
            unless (defined $nick) {
                return $need_more_params->($handle, 'NICK');
            }
            if ($self->nick2handle->{$nick}) {
                return $say->($handle, ERR_NICKNAMEINUSE, $nick, 'Nickname already in use');
            }
            debugf("Set nick: %s", $nick);
            $handle->{nick} = $nick;
            $self->nick2handle->{$nick} = $handle;
            # TODO: broadcast to each user
        },
        user => sub {
            my ($self, $msg, $handle) = @_;
            my ($user, $host, $server, $realname) = @{$msg->{params}};
            # TODO: Note that hostname and servername are normally ignored by the IRC server when the USER command comes from a directly connected client (for security reasons)
            $handle->{user} = $user;
            $handle->{hostname} = $host;

lib/AnyEvent/IRC/Server.pm  view on Meta::CPAN

            $say->( $handle, ERR_NOMOTD(), "MOTD File is missing" );
        },
        'join' => sub {
            my ($self, $msg, $handle) = @_;
            my ($chans) = @{$msg->{params}};
            unless ($chans) {
                return $need_more_params->($handle, 'JOIN');
            }
            for my $chan ( split /,/, $chans ) {
                my $nick = $handle->{nick};
                debugf("%s joined to %s", $nick, $chans);
                $self->channels->{$chan}->{handles}->{$nick} = $handle;

                # server reply
                $say->( $handle, RPL_TOPIC(), $chan, $self->topics->{$chan} || '' );
                for my $handle (values %{$self->channels->{$chan}->{handles}}) {
                    next unless $handle->{nick};
                    next if $self->spoofed_nick->{$handle->{nick}};
                    $say->( $handle, RPL_NAMREPLY(), $chan, $handle->{nick} );
                }
                $say->( $handle, RPL_ENDOFNAMES(), $chan, 'End of NAMES list.' );

lib/AnyEvent/IRC/Server.pm  view on Meta::CPAN

            my ($chans, $msg) = @{$raw->{params}};
            $self->_intern_list($handle, $chans);
        },
        who => sub {
            my ($irc, $msg, $handle) = @_;
            my ($name) = @{$msg->{params}};

             unless ( $self->channels->{$name} ) {
                 # TODO: ZNC calls '*'.
                 # AEIS should process it.
                debugf("The channel is not listed: $name");
                $say->( $handle, RPL_ENDOFWHO(), 'END of /WHO list');
                return;
                # return $need_more_params->($handle, 'WHO'); # TODO
             }

            $say->( $handle, RPL_WHOREPLY(), $name, $handle->{user}, $handle->{hostname}, $handle->{servername}, $handle->{nick},"H:1", $handle->{realname});
            $say->( $handle, RPL_ENDOFWHO(), 'END of /WHO list');
        },
        ping => sub {
            my ($irc, $msg, $handle) = @_;

lib/AnyEvent/IRC/Server.pm  view on Meta::CPAN

    my ($self, $nick) = @_;
    return sprintf '%s!~%s@%s', $nick, $nick, $self->servername;
}

sub _send_chan_msg {
    my ($self, $nick, $chan, @args) = @_;
    # send join message
    my $handle = $self->channels->{$chan}->{handles}->{$nick};
    my $comment = sprintf '%s!%s@%s', $nick, $handle->{user} || $nick, $handle->{servername} || $self->servername;
    my $raw = mk_msg_ex($comment, @args);
    debugf("_send_chan_msg: %s", $raw);
    $raw .= $CRLF;
    if ($self->is_channel_name($chan)) {
        for my $handle (values %{$self->channels->{$chan}->{handles}}) {
            next unless $handle->{nick};
            next if $handle->{nick} eq $nick;
            next if $self->spoofed_nick->{$handle->{nick}};
            $handle->push_write($raw);
        }
    } else {
        # private talk

lib/AnyEvent/IRC/Server.pm  view on Meta::CPAN

            });
        });
        $self->handles->{refaddr($handle)} = $handle;
    }, $self->prepared_cb();
}

sub handle_msg {
    my ($self, $msg, $handle) = @_;
    my $event = lc($msg->{command});
       $event =~ s/^(\d+)$/irc_$1/g;
    debugf("%s %s", $event, $msg);
    $self->event($event, $msg, $handle);
}

# -------------------------------------------------------------------------

sub add_spoofed_nick {
    my ($self, $nick) = @_;
    $self->{spoofed_nick}->{$nick} = 1;
}

lib/AnyEvent/IRC/Server.pm  view on Meta::CPAN

    $self->_intern_part($nick, $chan, $msg);
}

sub daemon_cmd_privmsg {
    my ($self, $nick, $chan, $msg) = @_;
    $self->_intern_privmsg($nick, $chan, $msg);
}

sub daemon_cmd_notice {
    my ($self, $nick, $chan, $msg) = @_;
    debugf('%s', [$nick, $chan, $msg]);
    $self->_intern_notice($nick, $chan, $msg);
}

# -------------------------------------------------------------------------

sub _intern_list {
    my ($self, $handle, $chans) = @_;

    my $nick = $handle->{nick};
    my $comment = $self->_server_comment($nick);

lib/AnyEvent/IRC/Server.pm  view on Meta::CPAN

    $send->(RPL_LISTEND, $nick, 'End of /LIST');
}

sub _intern_privmsg {
    my ($self, $nick, $chan, $text) = @_;
    $self->_send_chan_msg($nick, $chan, 'PRIVMSG', $chan, $text);
}

sub _intern_notice {
    my ($self, $nick, $chan, $text) = @_;
    debugf('%s', [$nick, $chan, $text]);
    $self->_send_chan_msg($nick, $chan, 'NOTICE', $chan, $text);
}

sub _intern_topic {
    my ($self, $nick, $chan, $topic) = @_;
    $self->topics->{$chan} = $topic;
    $self->_send_chan_msg($nick, $chan, 'TOPIC', $chan, $self->topics->{$chan});
}

sub _intern_join {

lib/AnyEvent/IRC/Server.pm  view on Meta::CPAN

}

sub mk_msg_ex {
    my ( $prefix, $command, @params ) = @_;
    my $msg = "";

    $msg .= defined $prefix ? ":$prefix " : "";
    $msg .= "$command";

    my $trail;
    debugf("%s", \@params);
    if ( @params >= 2 ) {
        $trail = pop @params;
    }

    # FIXME: params must be counted, and if > 13 they have to be
    # concationated with $trail
    map { $msg .= " $_" } @params;

    $msg .= defined $trail ? " :$trail" : "";

t/03-notice.t  view on Meta::CPAN

use Test::TCP;
use AnyEvent::IRC::Server;
use AE;
use AnyEvent::Debug;

plan tests => 10;

test_tcp(
    server => sub {
        my $port = shift;
        our $SHELL = AnyEvent::Debug::shell "unix/", "/tmp/aedebug.shell";

        my $ircd = AnyEvent::IRC::Server->new(
            port         => $port,
            'servername' => 'fushihara.anyevent.server.irc',
            prepared_cb  => sub {
                my ( $self, $host, $port ) = @_;
            },
        );
        $ircd->reg_cb(
            'on_eof' => sub {

t/06-nick.t  view on Meta::CPAN

use Test::TCP;
use AnyEvent::IRC::Server;
use AE;
use AnyEvent::Debug;

plan tests => 2;

test_tcp(
    server => sub {
        my $port = shift;
        our $SHELL = AnyEvent::Debug::shell "unix/", "/tmp/aedebug.shell";

        my $ircd = AnyEvent::IRC::Server->new(
            port         => $port,
            'servername' => 'fushihara.anyevent.server.irc',
            prepared_cb  => sub {
                my ( $self, $host, $port ) = @_;
            },
        );
        $ircd->reg_cb();
        $ircd->run();