/lib/Helm/Log/Channel/irc.pm
Perl | 272 lines | 235 code | 22 blank | 15 comment | 17 complexity | 119a31598272d84d6cdd8b8906f4d2c4 MD5 | raw file
- package Helm::Log::Channel::irc;
- use strict;
- use warnings;
- use Moose;
- use namespace::autoclean;
- use DateTime;
- use AnyEvent;
- use IO::Pipe;
- BEGIN {
- eval { require AnyEvent::IRC::Client };
- die "Could not load AnyEvent::IRC::Client. It must be installed to use Helm's irc logging"
- if $@;
- }
- extends 'Helm::Log::Channel';
- has irc_pipe => (is => 'ro', writer => '_irc_pipe');
- has pipes => (is => 'ro', writer => '_pipes', isa => 'HashRef');
- has is_parallel => (is => 'rw', isa => 'Bool', default => 0);
- has irc_pause => (is => 'ro', writer => '_irc_pause', isa => 'Int', default => 0);
- has prefix => (is => 'rw', isa => 'Str', default => '');
- my $DISCONNECT = 'Disconnecting';
- # first parse the IRC URI into some parts that we can use to create an IRC connection.
- # Then fork off an IRC worker process to go into an event loop that will read input
- # from the main process via a pipe and then output that to the IRC server. We need
- # to do it in an event loop because it needs to also respond asynchronously to the
- # IRC server for pings and such.
- sub initialize {
- my ($self, $helm) = @_;
- my $options = $helm->extra_options;
- my $pause = $options->{'irc-pause'} || $options->{'irc_pause'};
- $self->_irc_pause($pause) if $pause;
- my %irc_info;
- # file the file and open it for appending
- my $uri = $self->uri;
- if ($uri->authority =~ /@/) {
- my ($nick, $host) = split(/@/, $uri->authority);
- $irc_info{nick} = $nick;
- $irc_info{server} = $host;
- } else {
- $irc_info{nick} = 'helm';
- $irc_info{server} = $uri->authority;
- }
- $helm->die("No IRC server given in URI $uri") unless $irc_info{server};
- # get the channel
- my $channel = $uri->path;
- $helm->die("No IRC channel given in URI $uri") unless $channel;
- $channel =~ s/^\///; # remove leading slash
- $channel = "#$channel" unless $channel =~ /^#/;
- $irc_info{channel} = $channel;
- # do we need a password
- my $query = $uri->query;
- if ($query && $query =~ /(?:^|&|;)(pass|pw|password|passw|passwd)=(.*)(?:$|&|;)/) {
- $irc_info{password} = $1;
- }
- # do we have a port?
- if ($irc_info{server} =~ /:(\d+)$/) {
- $irc_info{port} = $1;
- $irc_info{server} =~ s/:(\d+)$//;
- } else {
- $irc_info{port} = 6667;
- }
- # setup a pipe for communicating
- my $irc_pipe = IO::Pipe->new();
- # fork off a child process
- my $pid = fork();
- $helm->die("Couldn't fork IRC bot process") if !defined $pid;
- if ($pid) {
- # parent here
- $irc_pipe->writer;
- $irc_pipe->autoflush(1);
- $self->_irc_pipe($irc_pipe);
- Helm->debug("Parent IRC pipe set up");
- } else {
- Helm->debug("Child IRC worker process");
- # child here
- $irc_pipe->reader;
- $irc_pipe->autoflush(1);
- Helm->debug("Child IRC pipe set up");
- $self->_irc_events($irc_pipe, %irc_info);
- }
- }
- sub finalize {
- my ($self, $helm) = @_;
- Helm->debug("IRC channel finalized: Nothing to do");
- }
- sub start_server {
- my ($self, $server) = @_;
- $self->SUPER::start_server($server);
- $self->_say("BEGIN Helm task \"" . $self->task . "\" on $server");
- }
- sub end_server {
- my ($self, $server) = @_;
- $self->SUPER::end_server($server);
- $self->_say("END Helm task \"" . $self->task . "\" on $server");
- }
- sub debug {
- my ($self, $msg) = @_;
- $self->_say("[debug] $msg");
- }
- sub info {
- my ($self, $msg) = @_;
- $self->_say("$msg");
- }
- sub warn {
- my ($self, $msg) = @_;
- $self->_say("[warn] $msg");
- }
- sub error {
- my ($self, $msg) = @_;
- $self->_say("[error] $msg");
- }
- sub _say {
- my ($self, $msg) = @_;
- my $prefix = $self->prefix;
- Helm->debug("Sending message to IO worker: $prefix$msg");
- $self->irc_pipe->print("MSG: $prefix$msg\n") or CORE::die("Could not print message to IO Worker: $!");
- }
- sub _irc_events {
- my ($self, $irc_pipe, %args) = @_;
- my $irc = AnyEvent::IRC::Client->new();
- my $done = AnyEvent->condvar;
- my $io_watcher;
- $irc->reg_cb(
- join => sub {
- my ($irc, $nick, $channel, $is_myself) = @_;
- Helm->debug("IRC worker joined channel $channel");
- # send the initial message
- if ($is_myself && $channel eq $args{channel}) {
- $io_watcher = AnyEvent->io(
- fh => $irc_pipe,
- poll => 'r',
- cb => sub {
- my $msg = <$irc_pipe>;
- if(!$msg) {
- Helm->debug("IRC worker ran out of pipe");
- $irc->send_msg(PRIVMSG => $channel, $DISCONNECT);
- undef $io_watcher;
- } else {
- chomp($msg);
- if ($msg =~ /^MSG: (.*)/) {
- my $content = $1;
- chomp($content);
- if( my $secs = $self->irc_pause ) {
- Helm->debug("IRC worker sleeping for $secs seconds");
- sleep($secs);
- }
- Helm->debug("IRC worker sending message to IRC channel: $content");
- $irc->send_msg(PRIVMSG => $channel, $content);
- }
- }
- }
- );
- }
- }
- );
- # we aren't done until the server acknowledges the send disconnect message
- $irc->reg_cb(
- sent => sub {
- my ($irc, $junk, $type, $channel, $msg) = @_;
- if( $type eq 'PRIVMSG' && $msg eq $DISCONNECT ) {
- Helm->debug("IRC channel received DISCONNECT message");
- $done->send();
- }
- }
- );
- Helm->debug("IRC worker connecting to server $args{server}");
- $irc->connect($args{server}, $args{port}, {nick => $args{nick}});
- Helm->debug("IRC worker trying to join channel $args{channel}");
- $irc->send_srv(JOIN => ($args{channel}));
- Helm->debug("IRC worker waiting for work");
- $done->recv;
- Helm->debug("IRC worker done with work, disconnecting");
- $irc->disconnect();
- exit(0);
- }
- # we already have an IRC bot forked off which has a pipe to our main process for
- # communication. But if we then share that pipe in all our children we'll end up
- # with garbled messages. So we need to fork off another worker process which has
- # multiple pipes, one for each possible server that we'll be executing tasks on.
- # This extra IO worker process will multi-plex the output coming from those pipes
- # into something reasonable for the IRC bot to handle.
- sub parallelize {
- my ($self, $helm) = @_;
- $self->is_parallel(1);
- # if we're going to do parallel stuff, then create a pipe for each server now
- # that we can use to communicate with the child processes later
- my %pipes = map { $_->name => IO::Pipe->new } (@{$helm->servers});
- $self->_pipes(\%pipes);
- # fork off an IO worker process
- my $pid = fork();
- $helm->die("Couldn't fork IRC IO worker process") if !defined $pid;
- if (!$pid) {
- Helm->debug("IO worker forked");
- # child here
- my %pipe_cleaners;
- my $all_clean = AnyEvent->condvar;
- foreach my $server (keys %pipes) {
- my $pipe = $pipes{$server};
- $pipe->reader;
- # create an IO watcher for this pipe
- Helm->debug("IO worker setting up AnyEvent reads on pipe for $server");
- $pipe_cleaners{$server} = AnyEvent->io(
- fh => $pipe,
- poll => 'r',
- cb => sub {
- my $msg = <$pipe>;
- if ($msg) {
- Helm->debug("Printing message to IRC PIPE: $msg");
- $self->irc_pipe->print($msg) or CORE::die "Could not print message to IRC PIPE: $!";
- } else {
- delete $pipe_cleaners{$server};
- Helm->debug("Removing IO pipe for $server");
- # tell the main program we're done if this is the last broom
- $all_clean->send unless %pipe_cleaners;
- }
- },
- );
- }
- Helm->debug("Waiting for IO to send to IRC worker process");
- $all_clean->recv;
- Helm->debug("All done with IO to send to IRC worker process");
- exit(0);
- }
- }
- # we've been forked, and if it's a child we want to initialize the pipe
- # for this worker child's server
- sub forked {
- my ($self, $type) = @_;
- if ($type eq 'child') {
- Helm->debug("Forked worker process for " . $self->current_server->name);
- my $pipes = $self->pipes;
- my $pipe = $pipes->{$self->current_server->name};
- $pipe->writer();
- $pipe->autoflush(1);
- $self->_irc_pipe($pipe);
- $self->prefix('[' . $self->current_server->name . '] ');
- }
- }
- __PACKAGE__->meta->make_immutable;
- 1;