|
|
@@ -7,29 +7,25 @@ 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_copy = $args_hr->{'subject'};
|
|
|
- my $body_copy = ${ $args_hr->{'text_body'} };
|
|
|
-
|
|
|
- require Encode;
|
|
|
- my $subject = Encode::decode_utf8( $subject_copy, $Encode::FB_QUIET );
|
|
|
- my $body = Encode::decode_utf8( $body_copy, $Encode::FB_QUIET );
|
|
|
-
|
|
|
- foreach my $destination ( @{ $args_hr->{'to'} } ) {
|
|
|
- local $@;
|
|
|
- eval {
|
|
|
- my $response;
|
|
|
- $self->_send(
|
|
|
- 'destination' => $destination,
|
|
|
- 'subject' => $subject,
|
|
|
- 'content' => $body
|
|
|
- );
|
|
|
- };
|
|
|
- push( @errs, $@ ) if $@;
|
|
|
- }
|
|
|
+ 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"
|
|
|
@@ -39,11 +35,125 @@ sub send {
|
|
|
return 1;
|
|
|
}
|
|
|
|
|
|
+my $conn;
|
|
|
sub _send {
|
|
|
my ( $self, %args ) = @_;
|
|
|
- # TODO research what is installed on cP boxes to see what I can use here
|
|
|
+
|
|
|
+ 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;
|
Andy Baugh