iContact-cPanel-Plugins/lib/Cpanel/iContact/Provider/IRC.pm

package Cpanel::iContact::Provider::IRC;

use strict;
use warnings;

use parent 'Cpanel::iContact::Provider';

sub send {
    my ($self) = @_;
    my @missing = grep { !defined $self->{'contact'}{$_} } qw{IRCSERVER};
    die "Kit not complete! Missing: " . join( ", ", @missing ) if scalar( @missing );

    my $args_hr = $self->{'args'};
    my @errs;

    my $subject = $args_hr->{'subject'};
    my $body    = ${ $args_hr->{'text_body'} };

	local $@;
	eval {
		my $response;
		$self->_send(
			'destination' => $args_hr->{'to'}[0],
			'subject'     => $subject,
			'content'     => $body
		);
	};
	push( @errs, $@ ) if $@;

    if (@errs) {
        die "One or more notification attempts failed. Details below:\n"
          . join( "\n", @errs );
    }

    return 1;
}

my $conn;
sub _send {
    my ( $self, %args ) = @_;

    if( $ENV{'AUTHOR_TESTS'} ) {
        my $debugmsg = "# Attempting connection to $self->{'contact'}{'IRCSERVER'}:$self->{'contact'}{'IRCPORT'} as $self->{'contact'}{'IRCNICK'} in channel $args{'destination'}";
        $debugmsg   .= " using SSL" if $self->{'contact'}{'IRCUSESSL'};
        print $debugmsg, "\n";
    }
    my @message_lines = _format_message_for_irc( $args{'subject'}, $args{'content'}, $args{'destination'} );

    require IO::Socket::INET;
    require IO::Socket::SSL;
    require Time::HiRes;

    # Don't laugh, some of these notices are so long (and the server so laggy at printing) that this actually is reasonable.
    # Usually messages are delayed as a flood limiting action.
    local $SIG{'ALRM'} = sub { die "Timed out waiting for notification to post to IRC channel!" };
    alarm(60);

    $conn = IO::Socket::INET->new("$self->{'contact'}{'IRCSERVER'}:$self->{'contact'}{'IRCPORT'}", ) or die $!;
    binmode( $conn, ":utf8" );
    if( $self->{'contact'}{'IRCUSESSL'} ) {
        print "# Upgrading connection to use SSL...\n" if $ENV{'AUTHOR_TESTS'};
        IO::Socket::SSL->start_SSL( $conn, 'SSL_HOSTNAME' => $self->{'contact'}{'IRCSERVER'}, 'SSL_verify_mode' => 0 ) or die $IO::Socket::SSL::ERROR;
    }
    print "# [SENT] NICK $self->{'contact'}{'IRCNICK'}\r\n" if $ENV{'AUTHOR_TESTS'};
    print $conn "NICK $self->{'contact'}{'IRCNICK'}\r\n";
    print "# [SENT] USER cpsaurus * 8 :cPanel & WHM Notification Bot v0.1 (github.com/troglodyne/iContact-cPanel-Plugins)\r\n" if $ENV{'AUTHOR_TESTS'};
    print $conn "USER cpsaurus * 8 :cPanel & WHM Notification Bot v0.1 (github.com/troglodyne/iContact-cPanel-Plugins)\r\n";
  
    my %got;
    while( $conn ) {

        last if !scalar(@message_lines);
        
        # Print it all then leave like a bad smell
        if( $got{'366'} && $got{'332'} ) {
            foreach my $shake_line ( @message_lines ) {
                print "# [SENT] $shake_line" if $ENV{'AUTHOR_TESTS'};
                print $conn $shake_line;
            }
            last;
        }

        my $line= readline( $conn ) || "";
        #$line =~ s/^[^[:print:]]+$//; # Collapse blank lines
        next if !$line;
        print "# [GOT][" . length($line) . "] $line" if $ENV{'AUTHOR_TESTS'};
        my @msgparts = split( ' ', $line );
        $msgparts[1] ||= '';
        # PING handler
        if( $msgparts[0] eq 'PING' ) {
            print "# [SENT] PONG $msgparts[1]\r\n" if $ENV{'AUTHOR_TESTS'};
            print $conn "PONG $msgparts[1]\r\n";
            next;
        }
        # MOTD/JOIN handler
        if( grep { $_ eq $msgparts[1] } qw{376 422} ) {
            print "# [SENT] JOIN $args{'destination'}\r\n" if $ENV{'AUTHOR_TESTS'};
            print $conn "JOIN $args{'destination'}\r\n";
            next;
        }
        # Channel join handler, gotta wait for NAMES and TOPIC
        if( grep { $_ eq $msgparts[1] } qw{366 332} ) {
            print "# [INFO] Noticed we got $msgparts[1] above. Noting that so we can know when to start spamming messages.\n" if $ENV{'AUTHOR_TESTS'};

            $got{"$msgparts[1]"} = 1 ;
            next;
        }
    }
    print "# [SENT] QUIT :Done sending notification\r\n" if $ENV{'AUTHOR_TESTS'};
    print $conn "QUIT :Done sending notification\r\n";
    # The connection won't properly un-block until you read the response from QUIT.
    # Unfortunately, just setting it to non-block leads to your messages not being processed.
    # As such, just read here and let it do it's thing even though you don't actually need the data.
    readline( $conn );
    $conn->shutdown(2);

    return;
}

# https://tools.ietf.org/html/rfc2812#section-2.3
sub _format_message_for_irc {
    my ( $subj, $body, $chan ) = @_;
    my @msg_lines;

    my $prefix = "NOTICE $chan :";
    my $suffix = "\r\n"; # 2 chars
    my $msglen = 510 - length $prefix; # 512 chars total

    # Subject is one line
    while( $subj ) {
        if( length $subj <= 510 ) {
            push( @msg_lines, $prefix . $subj . $suffix );
            undef $subj;
        } else {
            push( @msg_lines, $prefix . substr( $subj, 0, 510, "" ) . $suffix );
        }
    }

    # Body is multiline
    my @body_lines = split( "\n", $body );
    foreach my $line (@body_lines) {
        while( $line ) {
            if( length $line <= 510 ) {
                push( @msg_lines, $prefix . $line . $suffix );
                undef $line;
            } else {
                push( @msg_lines, $prefix . substr( $line, 0, 510, "" ) . $suffix );
            }
        }
    }

    return @msg_lines;
}

sub DESTROY {
    $conn->shutdown(2) if $conn;
}

1;