commit - e12c3d6c1d3836c88da14cf59054950f3b53ed64
commit + ff0d12a109d43481f4538dec7dc10749c488449a
blob - ce2a03efb3fece41b60fb4e1812609abc90e636a
blob + 05eb6b7cba0f37f0a97b84ad82c318f937d6e78a
--- crybot.pl
+++ crybot.pl
use autodie qw(:socket :io);
use Socket qw(AF_INET PF_INET SOCK_STREAM inet_aton inet_ntoa sockaddr_in);
+use IO::Select;
use IO::Socket::SSL qw(debug4);
use Digest::MD5 qw(md5_hex);
use IP::Country::Fast;
use HTML::Entities qw(decode_entities);
use LWP::Simple qw(get $ua);
use HTTP::Tiny;
-use JSON::PP qw(decode_json);
+use JSON::PP qw(decode_json encode_json);
use URI::Escape qw(uri_escape);
use MIME::Base64 qw(encode_base64);
use Encode qw(decode);
+use Time::HiRes qw(time);
+use File::Spec;
+use FindBin qw($Bin);
binmode STDOUT, ':encoding(UTF-8)';
binmode STDERR, ':encoding(UTF-8)';
debug => $ENV{CRYBOT_DEBUG} // 0,
sasl_user => $ENV{CRYBOT_SASL_USER},
sasl_pass => $ENV{CRYBOT_SASL_PASS},
+ feed_poll_interval => $ENV{CRYBOT_FEED_INTERVAL} // 60,
+ feed_state_file => $ENV{CRYBOT_FEED_STATE} // 'crybot-feed-state.json',
+ feed_sources => [
+ {
+ key => 'articles',
+ label => $ENV{CRYBOT_ARTICLE_LABEL} // 'Article',
+ url => $ENV{CRYBOT_ARTICLE_FEED} // 'https://www.Cryogenix.org/library/feed.rss',
+ },
+ {
+ key => 'forums',
+ label => $ENV{CRYBOT_FORUM_LABEL} // 'Forum',
+ url => $ENV{CRYBOT_FORUM_FEED} // 'https://www.Cryogenix.org/forum/feed.rss',
+ },
+ ],
);
$config{channels} = [ uniq( $config{channel}, '#cryogenix', '#cryogenix' ) ];
$config{silence} = uc $config{silence};
+$config{feed_poll_interval} =
+ ($config{feed_poll_interval} && $config{feed_poll_interval} =~ /^\d+$/)
+ ? 0 + $config{feed_poll_interval}
+ : 60;
+$config{feed_sources} =
+ [ grep { defined $_->{url} && length $_->{url} } @{ $config{feed_sources} // [] } ];
+$config{feed_state_file} ||= 'crybot-feed-state.json';
+if ( $config{feed_state_file} !~ m{^/} ) {
+ $config{feed_state_file} = File::Spec->catfile( $Bin, $config{feed_state_file} );
+}
+$config{feed_state} = load_feed_state( $config{feed_state_file} );
$ua->agent('Cryogenix IRC Bot');
$ua->timeout(5);
sub event_loop {
my ( $sock, $config ) = @_;
- while ( my $raw = <$sock> ) {
- chomp $raw;
- $raw =~ s/\r$//;
- debug_log( $config, "<< $raw" );
- handle_line( $sock, $config, $raw );
+ my $selector = IO::Select->new($sock);
+ my $have_feeds = @{ $config->{feed_sources} // [] } ? 1 : 0;
+ my $next_poll = time;
+
+ while (1) {
+ my $now = time;
+
+ if ( $have_feeds && $now >= $next_poll ) {
+ eval { poll_feeds( $sock, $config ); };
+ warn "Feed poll failed: $@" if $@;
+ $next_poll = $now + $config->{feed_poll_interval};
+ }
+
+ my @ready;
+ if ( $have_feeds ) {
+ my $timeout = $next_poll - $now;
+ if ( $timeout <= 0 ) {
+ @ready = $selector->can_read(0);
+ }
+ else {
+ @ready = $selector->can_read($timeout);
+ }
+ }
+ else {
+ @ready = $selector->can_read;
+ }
+
+ if (@ready) {
+ my $raw = <$sock>;
+ last unless defined $raw;
+ chomp $raw;
+ $raw =~ s/\r$//;
+ debug_log( $config, "<< $raw" );
+ handle_line( $sock, $config, $raw );
+ }
+
+ if ( !@ready && !$have_feeds ) {
+ next;
+ }
}
}
}
}
+sub poll_feeds {
+ my ( $sock, $config ) = @_;
+ return unless @{ $config->{feed_sources} // [] };
+
+ my $state = $config->{feed_state} //= {};
+ my $send_output = $config->{silence} eq 'NO';
+ my $state_changed = 0;
+
+ for my $feed ( @{ $config->{feed_sources} } ) {
+ my $feed_url = $feed->{url};
+ next unless $feed_url;
+
+ debug_log( $config, "[feed] polling $feed_url" );
+ my $body = http_get(
+ $feed_url,
+ 'Accept' => 'application/rss+xml, application/xml;q=0.9,*/*;q=0.8',
+ max_bytes => 256 * 1024
+ );
+
+ unless ( defined $body ) {
+ debug_log( $config, "[feed] no response from $feed_url" );
+ next;
+ }
+
+ my @items = parse_rss_items($body);
+ next unless @items;
+
+ my $key = $feed->{key} // $feed_url;
+ my $last_guid = $state->{$key}{last_guid};
+
+ unless ( defined $last_guid ) {
+ my $initial = $items[0];
+ my $guid = $initial->{guid} // $initial->{link};
+ if ($guid) {
+ $state->{$key}{last_guid} = $guid;
+ $state_changed = 1;
+ }
+ next;
+ }
+
+ my @announce;
+ for my $item (@items) {
+ my $guid = $item->{guid} // $item->{link};
+ next unless $guid;
+ last if defined $last_guid && $guid eq $last_guid;
+ push @announce, $item;
+ }
+
+ next unless @announce;
+ @announce = reverse @announce;
+
+ for my $item (@announce) {
+ my $guid = $item->{guid} // $item->{link};
+ if ($guid) {
+ $state->{$key}{last_guid} = $guid;
+ $state_changed = 1;
+ }
+
+ next unless $send_output;
+
+ my $title = $item->{title} // '(untitled)';
+ my $link = $item->{link} // $guid;
+ my $label = $feed->{label} // 'Update';
+ my $message = sprintf '[%s] %s - %s', $label, $title, $link;
+
+ for my $chan ( @{ $config->{channels} // [] } ) {
+ next unless $chan;
+ irc_print( $sock, "PRIVMSG $chan :$message" );
+ }
+ }
+ }
+
+ save_feed_state( $config->{feed_state_file}, $state )
+ if $state_changed;
+}
+
+sub parse_rss_items {
+ my ($xml) = @_;
+ return unless defined $xml;
+
+ my @items;
+ while ( $xml =~ m{<item\b[^>]*>(.*?)</item>}gsi ) {
+ my $chunk = $1 // next;
+ my %item;
+ $item{title} = _rss_value( $chunk, 'title' );
+ $item{link} = _rss_value( $chunk, 'link' );
+ $item{guid} = _rss_value( $chunk, 'guid' );
+ $item{pubDate} = _rss_value( $chunk, 'pubDate' );
+
+ $item{guid} ||= $item{link};
+ push @items, \%item if $item{guid};
+ }
+
+ return @items;
+}
+
+sub _rss_value {
+ my ( $xml, $tag ) = @_;
+ return unless defined $xml && defined $tag;
+
+ if ( $xml =~ m{<$tag\b[^>]*>(.*?)</$tag>}is ) {
+ my $value = $1 // '';
+ $value =~ s{<!\[CDATA\[(.*?)\]\]>}{$1}gs;
+ $value =~ s/^\s+|\s+$//g;
+ $value = decode_entities($value);
+ $value =~ s/\s{2,}/ /g;
+ $value =~ s/[\r\n\t]+/ /g;
+ $value =~ s/^\s+|\s+$//g;
+ return length $value ? $value : undef;
+ }
+
+ return;
+}
+
sub cmd_banner {
my ( $sock, $config, $nick, $target, $args, $is_private ) = @_;
my ( $host, $port ) = split /\s+/, $args;
return grep { defined $_ && !$seen{ lc $_ }++ } @items;
}
+sub load_feed_state {
+ my ($path) = @_;
+ return {} unless defined $path && length $path;
+ return {} unless -e $path;
+
+ my $json = eval {
+ open my $fh, '<:encoding(UTF-8)', $path;
+ local $/;
+ my $content = <$fh>;
+ close $fh;
+ $content;
+ };
+ if ($@) {
+ warn "Failed to load feed state from $path: $@";
+ return {};
+ }
+ return {} unless defined $json && length $json;
+
+ my $data = eval { decode_json($json) };
+ if ($@ || ref $data ne 'HASH' ) {
+ warn "Feed state in $path is invalid JSON: $@";
+ return {};
+ }
+
+ return $data;
+}
+
+sub save_feed_state {
+ my ( $path, $state ) = @_;
+ return unless defined $path && length $path;
+ return unless defined $state && ref $state eq 'HASH';
+
+ my $json = eval { encode_json($state) };
+ if ($@) {
+ warn "Failed to encode feed state: $@";
+ return;
+ }
+
+ my $tmp = "$path.tmp";
+ my $ok = eval {
+ open my $fh, '>:encoding(UTF-8)', $tmp;
+ print {$fh} $json;
+ close $fh;
+ 1;
+ };
+
+ if ( !$ok || $@ ) {
+ warn "Failed to write feed state to $tmp: $@";
+ return;
+ }
+
+ rename $tmp, $path or warn "Failed to move $tmp to $path: $!";
+}
+
sub http_client {
state $client = HTTP::Tiny->new(
agent => 'Cryogenix IRC Bot',