commit - 942be4a188b77bebaf9d1bba1324f679fb9b7049
commit + e12c3d6c1d3836c88da14cf59054950f3b53ed64
blob - /dev/null
blob + ce2a03efb3fece41b60fb4e1812609abc90e636a (mode 644)
--- /dev/null
+++ crybot.pl
+#!/usr/bin/env perl
+
+use v5.24;
+use strict;
+use warnings;
+use utf8;
+use feature qw(say state);
+use autodie qw(:socket :io);
+
+use Socket qw(AF_INET PF_INET SOCK_STREAM inet_aton inet_ntoa sockaddr_in);
+use IO::Socket::SSL qw(debug4);
+use Digest::MD5 qw(md5_hex);
+use IP::Country::Fast;
+use Net::Whois::IP qw(whoisip_query);
+use Net::DNS;
+use HTML::Entities qw(decode_entities);
+use LWP::Simple qw(get $ua);
+use HTTP::Tiny;
+use JSON::PP qw(decode_json);
+use URI::Escape qw(uri_escape);
+use MIME::Base64 qw(encode_base64);
+use Encode qw(decode);
+
+binmode STDOUT, ':encoding(UTF-8)';
+binmode STDERR, ':encoding(UTF-8)';
+$| = 1;
+
+my $channel_arg = shift;
+my $pass_arg = shift;
+
+my %config = (
+ server => $ENV{CRYBOT_SERVER} // 'irc.libera.chat',
+ port => $ENV{CRYBOT_PORT} // 6697,
+ nick => $ENV{CRYBOT_NICK} // 'GCHQ',
+ altnick => $ENV{CRYBOT_ALTNICK} // 'GCHQ2',
+ login => $ENV{CRYBOT_LOGIN} // 'GCHQ',
+ version => $ENV{CRYBOT_VERSION} // 'GCHQ Bot',
+ channel => $channel_arg // $ENV{CRYBOT_CHANNEL} // '#cryogenix',
+ pass => $pass_arg // $ENV{CRYBOT_PASSWORD} // '123456',
+ silence => $ENV{CRYBOT_SILENCE} // 'No',
+ debug => $ENV{CRYBOT_DEBUG} // 0,
+ sasl_user => $ENV{CRYBOT_SASL_USER},
+ sasl_pass => $ENV{CRYBOT_SASL_PASS},
+);
+
+$config{channels} = [ uniq( $config{channel}, '#cryogenix', '#cryogenix' ) ];
+$config{silence} = uc $config{silence};
+
+$ua->agent('Cryogenix IRC Bot');
+$ua->timeout(5);
+
+my $reg = IP::Country::Fast->new();
+
+my %COMMANDS = (
+ banner => \&cmd_banner,
+ axfr => \&cmd_axfr,
+ md5 => \&cmd_md5,
+ resolve => \&cmd_resolve,
+ ud => \&cmd_ud,
+ sicksearch => \&cmd_sicksearch,
+ confession => \&cmd_confession,
+ sickjoke => \&cmd_sickjoke,
+ ns => \&cmd_ns,
+ ipinfo => \&cmd_ipinfo,
+ help => \&cmd_help,
+);
+
+main();
+
+sub main {
+ my $sock = connect_to_server(\%config);
+ register_with_server($sock, \%config);
+ identify_services($sock, \%config);
+ join_channels($sock, \%config);
+ event_loop($sock, \%config);
+}
+
+sub connect_to_server {
+ my ($config) = @_;
+ IO::Socket::SSL->new(
+ PeerAddr => $config->{server},
+ PeerPort => $config->{port},
+ Proto => 'tcp',
+ Family => AF_INET,
+ ) or die sprintf "Can't connect: %s (errno=%s) ssl=%s\n",
+ "$!", 0 + $!, IO::Socket::SSL::errstr();
+}
+
+sub register_with_server {
+ my ( $sock, $config ) = @_;
+ debug_log( $config, '[register] Negotiating capabilities' );
+ my @pending_cap;
+
+ if ( defined $config->{sasl_user} && defined $config->{sasl_pass} ) {
+ push @pending_cap, 'sasl';
+ }
+
+ debug_log( $config, '>> CAP LS 302' );
+ irc_print( $sock, 'CAP LS 302' );
+ debug_log( $config, ">> NICK $config->{nick}" );
+ irc_print( $sock, "NICK $config->{nick}" );
+ debug_log( $config, sprintf '>> USER %s 8 * :%s', $config->{login}, $config->{version} );
+ irc_print( $sock, sprintf 'USER %s 8 * :%s', $config->{login}, $config->{version} );
+
+ my $registered = 0;
+ my $last_input = '';
+ my $awaiting_authenticate = 0;
+
+ while ( my $input = <$sock> ) {
+ chomp $input;
+ $input =~ s/\r$//;
+ $last_input = $input;
+ debug_log( $config, "<< $input" );
+
+ my ( undef, $command, @params ) = parse_irc_line($input);
+ $command = uc $command;
+
+ if ( $command eq 'PING' ) {
+ my $payload = $params[-1] // '';
+ irc_print( $sock, "PONG :$payload" );
+ next;
+ }
+
+ if ( $command eq 'CAP' ) {
+ my $subcommand = uc( $params[1] // $params[0] // '' );
+ if ( $subcommand eq 'LS' ) {
+ my $capabilities = lc( $params[-1] // '' );
+ debug_log( $config, "[register] Server capabilities: $capabilities" );
+ if ( @pending_cap && $capabilities =~ /\bsasl\b/ ) {
+ debug_log( $config, '>> CAP REQ :sasl' );
+ irc_print( $sock, 'CAP REQ :sasl' );
+ }
+ else {
+ debug_log( $config, '[register] Ending capability negotiation (no SASL)' );
+ irc_print( $sock, 'CAP END' );
+ }
+ }
+ elsif ( $subcommand eq 'ACK' ) {
+ my $ack = lc( $params[-1] // '' );
+ debug_log( $config, "[register] CAP ACK $ack" );
+ if ( $ack =~ /sasl/ ) {
+ debug_log( $config, '>> AUTHENTICATE PLAIN' );
+ irc_print( $sock, 'AUTHENTICATE PLAIN' );
+ $awaiting_authenticate = 1;
+ }
+ }
+ elsif ( $subcommand eq 'NAK' ) {
+ die "Server rejected requested capabilities: $params[-1]\n";
+ }
+ next;
+ }
+
+ if ( $command eq 'AUTHENTICATE' ) {
+ if ( !$awaiting_authenticate ) {
+ debug_log( $config, '[register] Unexpected AUTHENTICATE frame' );
+ next;
+ }
+ if ( !defined $config->{sasl_user} || !defined $config->{sasl_pass} ) {
+ die "SASL credentials not configured. Set CRYBOT_SASL_USER and CRYBOT_SASL_PASS.\n";
+ }
+ my $response = sasl_plain_response( $config->{sasl_user}, $config->{sasl_pass} );
+ debug_log( $config, '>> AUTHENTICATE <credentials>' );
+ irc_print( $sock, "AUTHENTICATE $response" );
+ $awaiting_authenticate = 0;
+ next;
+ }
+
+ if ( $command eq '903' ) { # SASL success
+ debug_log( $config, '[register] SASL authentication succeeded' );
+ irc_print( $sock, 'CAP END' );
+ next;
+ }
+
+ if ( $command eq '904' || $command eq '905' ) { # SASL fail
+ die "SASL authentication failed: $params[-1]\n";
+ }
+
+ if ( $command eq '433' ) {
+ $config->{nick} = $config->{altnick};
+ debug_log( $config, "[register] Nick in use, switching to $config->{altnick}" );
+ irc_print( $sock, "NICK $config->{altnick}" );
+ next;
+ }
+
+ if ( $command eq '001' || $command eq '004' ) {
+ say '[Connected]';
+ $registered = 1;
+ last;
+ }
+
+ if ( $command eq 'ERROR' ) {
+ die "Server returned ERROR during registration: $params[-1]\n";
+ }
+ }
+
+ die "Server closed connection before completing registration\nLast server line: $last_input\n"
+ unless $registered;
+}
+
+sub identify_services {
+ my ( $sock, $config ) = @_;
+ return unless $config->{pass};
+ debug_log( $config, '>> PRIVMSG NickServ :IDENTIFY ******' );
+ irc_print( $sock, "PRIVMSG NickServ :IDENTIFY $config->{pass}" );
+ debug_log( $config, '>> PRIVMSG HostServ :on' );
+ irc_print( $sock, 'PRIVMSG HostServ :on' );
+ sleep 3;
+}
+
+sub join_channels {
+ my ( $sock, $config ) = @_;
+ my %seen;
+ for my $chan ( @{ $config->{channels} } ) {
+ next if !$chan || $seen{ lc $chan }++;
+ debug_log( $config, ">> JOIN $chan" );
+ irc_print( $sock, "JOIN $chan" );
+ }
+}
+
+sub event_loop {
+ my ( $sock, $config ) = @_;
+ while ( my $raw = <$sock> ) {
+ chomp $raw;
+ $raw =~ s/\r$//;
+ debug_log( $config, "<< $raw" );
+ handle_line( $sock, $config, $raw );
+ }
+}
+
+sub handle_line {
+ my ( $sock, $config, $raw ) = @_;
+ if ( $raw =~ /^PING\s*:(.+)$/i ) {
+ irc_print( $sock, "PONG :$1" );
+ return;
+ }
+
+ my ( $prefix, $command, @params ) = parse_irc_line($raw);
+
+ if ( $command eq 'PRIVMSG' ) {
+ my ( $target, $message ) = @params;
+ handle_privmsg( $sock, $config, $prefix, $target, $message );
+ return;
+ }
+
+ if ( $command eq 'INVITE' ) {
+ my ( $nick, $channel ) = @params;
+ irc_print( $sock, "JOIN $channel" ) if defined $channel;
+ return;
+ }
+
+ if ( $command eq 'ERROR' ) {
+ die "Server error: $params[-1]\n";
+ }
+}
+
+sub handle_privmsg {
+ my ( $sock, $config, $prefix, $target, $message ) = @_;
+ my $nick = parse_nick($prefix) // return;
+
+ if ( $message =~ /^\001VERSION\001$/ ) {
+ irc_print( $sock, "NOTICE $nick :\001VERSION $config->{version}\001" );
+ return;
+ }
+
+ if ( $message =~ /^\001PING (.+)\001$/ ) {
+ irc_print( $sock, "NOTICE $nick :\001PING $1\001" );
+ return;
+ }
+
+ my $is_private = lc $target eq lc $config->{nick};
+
+ if ( my ( $command, $args ) = parse_command($message) ) {
+ dispatch_command( $sock, $config, $nick, $target, $command, $args, $is_private );
+ return;
+ }
+
+ return if $is_private;
+ handle_channel_text( $sock, $config, $nick, $target, $message );
+}
+
+sub parse_command {
+ my ($message) = @_;
+ return unless $message =~ /^!(\w+)(?:\s+(.*))?$/;
+ return ( lc $1, defined $2 ? $2 : '' );
+}
+
+sub dispatch_command {
+ my ( $sock, $config, $nick, $target, $command, $args, $is_private ) = @_;
+ my $handler = $COMMANDS{$command};
+ return unless $handler;
+
+ eval { $handler->( $sock, $config, $nick, $target, $args, $is_private ); };
+ warn "Command $command failed: $@" if $@;
+}
+
+sub handle_channel_text {
+ my ( $sock, $config, $nick, $channel, $message ) = @_;
+ if ( $message =~ /b0rk/i ) {
+ irc_print( $sock, "PRIVMSG $channel :$nick, b0rk b0rk" );
+ return;
+ }
+
+ if ( my ($video_id) = $message =~ m{youtube\.com/watch\?v=([\w-]+)}i ) {
+ my $title = fetch_youtube_title($video_id);
+ if ( $title && $config->{silence} eq 'NO' ) {
+ irc_print( $sock, "PRIVMSG $channel :$video_id: $title" );
+ }
+ return;
+ }
+
+ if ( my ($url) = $message =~ m{(https?://[^\s>]+)}i ) {
+ my $title = fetch_title($url);
+ if ( $title && $config->{silence} eq 'NO' ) {
+ irc_print( $sock, "PRIVMSG $channel :-> $title" );
+ }
+ }
+
+ elsif ( my ($bare_url) = $message =~ m{(?:https?://)?([A-Za-z0-9\.\-]+\.[A-Za-z]{2,}[^\s>]*)}i ) {
+ my $full_url = $bare_url =~ m{^https?://}i ? $bare_url : "http://$bare_url";
+ my $title = fetch_title($full_url);
+ if ( $title && $config->{silence} eq 'NO' ) {
+ irc_print( $sock, "PRIVMSG $channel :-> $title" );
+ }
+ }
+}
+
+sub cmd_banner {
+ my ( $sock, $config, $nick, $target, $args, $is_private ) = @_;
+ my ( $host, $port ) = split /\s+/, $args;
+ unless ( $host && $port ) {
+ my $out = response_target( $nick, $target, $is_private );
+ irc_print( $sock, "PRIVMSG $out :Usage: !banner <host> <port>" );
+ return;
+ }
+
+ my $banner = eval { pbanner( $host, $port ) } // 'No banner';
+ if ($@) {
+ $banner = "Error fetching banner: $@";
+ }
+
+ $banner =~ s/\s+$// if defined $banner;
+
+ my $out = response_target( $nick, $target, $is_private );
+ irc_print( $sock, "PRIVMSG $out :Host: $host:$port | $banner" );
+ say "[ $target ] <$nick> [banner] $host:$port | $banner";
+}
+
+sub cmd_axfr {
+ my ( $sock, $config, $nick, $target, $args, $is_private ) = @_;
+ my ( $domain, $nameserver ) = split /\s+/, $args;
+ unless ( $domain && $nameserver ) {
+ my $out = response_target( $nick, $target, $is_private );
+ irc_print( $sock, "PRIVMSG $out :Usage: !axfr <domain> <ns>" );
+ return;
+ }
+
+ my $resolver = Net::DNS::Resolver->new( nameservers => [$nameserver], recurse => 0 );
+ $resolver->tcp_timeout(10);
+ my @zone = $resolver->axfr($domain);
+ my $out = response_target( $nick, $target, $is_private );
+
+ if (@zone) {
+ for my $rr (@zone) {
+ irc_print( $sock, "PRIVMSG $out :" . $rr->string );
+ }
+ }
+ else {
+ irc_print( $sock, "PRIVMSG $out :AXFR Failed: " . $resolver->errorstring );
+ say 'Zone transfer failed: ' . $resolver->errorstring;
+ }
+}
+
+sub cmd_md5 {
+ my ( $sock, $config, $nick, $target, $args, $is_private ) = @_;
+ my $input = defined $args ? $args : '';
+ my $hash = md5_hex($input);
+ my $out = response_target( $nick, $target, $is_private );
+ irc_print( $sock, "PRIVMSG $out :$input = $hash" );
+ say "[ $target ] <$nick> [getmd5] $input";
+}
+
+sub cmd_resolve {
+ my ( $sock, $config, $nick, $target, $args, $is_private ) = @_;
+ my $resolved = resolve_host($args);
+ my $out = response_target( $nick, $target, $is_private );
+ irc_print( $sock, "PRIVMSG $out :$args = $resolved" );
+ say "[ $target ] <$nick> [resolvehost] $args";
+}
+
+sub cmd_ud {
+ my ( $sock, $config, $nick, $target, $args, $is_private ) = @_;
+ my $body = get("http://www.urbandictionary.com/define.php?term=$args");
+ return unless $body;
+
+ if ( $body =~ m{<div class='definition'>\s*(.+?)\s*</div>}is ) {
+ my $definition = decode_entities($1);
+ $definition =~ s/<.*?>//g;
+ if ( $definition eq $nick ) {
+ my $dest = $is_private ? $nick : $target;
+ irc_print( $sock, "PRIVMSG $dest :I don't fucking know, $nick" );
+ }
+ else {
+ my $respond_to_channel = $config->{silence} eq 'NO' && !$is_private;
+ my $response_target = $respond_to_channel ? $target : $nick;
+ my $verb = $config->{silence} eq 'YES' ? 'NOTICE' : 'PRIVMSG';
+ irc_print( $sock, "$verb $response_target :$args: $definition" );
+ }
+ }
+}
+
+sub cmd_sicksearch {
+ my ( $sock, $config, $nick, $target, $args, $is_private ) = @_;
+ my $body = get("http://www.sickipedia.org/search.php?q=$args");
+ return unless $body;
+
+ if ( $body =~ m{<tr><td>(.+?)</td><td}is ) {
+ my $joke = decode_entities($1);
+ $joke =~ s/<.*?>//g;
+ my $respond_to_channel = $config->{silence} eq 'NO' && !$is_private;
+ my $response_target = $respond_to_channel ? $target : $nick;
+ irc_print( $sock, "PRIVMSG $response_target :$joke" );
+ }
+}
+
+sub cmd_confession {
+ my ( $sock, $config, $nick, $target, $args, $is_private ) = @_;
+ my $body = get('http://www.unburdened.net/view-confessions.php');
+ return unless $body;
+
+ if ( $body =~ m{</a><br>(.+?)<a href}is ) {
+ my $confession = decode_entities($1);
+ $confession =~ s/<.*?>//g;
+ my $respond_to_channel = $config->{silence} eq 'NO' && !$is_private;
+ my $response_target = $respond_to_channel ? $target : $nick;
+ irc_print( $sock, "PRIVMSG $response_target :$confession" );
+ }
+}
+
+sub cmd_sickjoke {
+ my ( $sock, $config, $nick, $target, $args, $is_private ) = @_;
+ my $body = get('http://www.sickipedia.org/get.php?rand');
+ return unless $body;
+
+ if ( $body =~ m{<tr><td>(.+?)</}is ) {
+ my $joke = decode_entities($1);
+ $joke =~ s/<.*?>//g;
+ my $respond_to_channel = $config->{silence} eq 'NO' && !$is_private;
+ my $response_target = $respond_to_channel ? $target : $nick;
+ irc_print( $sock, "PRIVMSG $response_target :$joke" );
+ }
+}
+
+sub cmd_ns {
+ my ( $sock, $config, $nick, $target, $args, $is_private ) = @_;
+ my $domain = $args // return;
+ my $resolver = Net::DNS::Resolver->new;
+ my $packet = $resolver->query( $domain, 'NS' );
+ my $out = response_target( $nick, $target, $is_private );
+
+ if ($packet) {
+ for my $rr ( grep { $_->type eq 'NS' } $packet->answer ) {
+ irc_print( $sock, "PRIVMSG $out :$domain IN NS " . $rr->nsdname );
+ }
+ }
+ else {
+ irc_print( $sock, "PRIVMSG $out :No NS records found for $domain" );
+ }
+}
+
+sub cmd_ipinfo {
+ my ( $sock, $config, $nick, $target, $args, $is_private ) = @_;
+ my $host = $args // return;
+ my ( $ip, $cc, $org ) = check_ip($host);
+ my $resolved = resolve_host($host);
+ $org //= 'Unknown';
+
+ my $out = response_target( $nick, $target, $is_private );
+ irc_print( $sock, "PRIVMSG $out :IP: $ip ($resolved) | Country: $cc | Owner: $org" );
+ say "[ $target ] <$nick> [checkip] $host | $cc:$org";
+}
+
+sub cmd_help {
+ my ( $sock, $config, $nick, $target, $args, $is_private ) = @_;
+ my @lines = (
+ 'Commands:',
+ '- !banner <host> <port> - Grab banner',
+ '- !md5 <string> - MD5 Hash',
+ '- !ipinfo <IP> - IP Whois',
+ '- !resolve <IP|Host> - Resolve IP/Host',
+ '- !ns <domain> - Lookup NS of domain',
+ '- !axfr <domain> <NS> - Transfer Req',
+ '- !ud <word> - UrbanDictionary',
+ '- !sickjoke - Sickipedia Joke',
+ '- !confession - Confession',
+ );
+
+ my $out = response_target( $nick, $target, $is_private );
+ irc_print( $sock, "PRIVMSG $out :$_" ) for @lines;
+}
+
+sub fetch_youtube_title {
+ my ($video_id) = @_;
+ return unless defined $video_id;
+
+ $video_id =~ s/[^\w\-].*$//;
+ return unless length $video_id;
+
+ my $watch_url = "https://www.youtube.com/watch?v=$video_id";
+ my $oembed_url = 'https://www.youtube.com/oembed?format=json&url=' . uri_escape($watch_url);
+
+ if ( my $title = _fetch_youtube_oembed($oembed_url) ) {
+ return $title;
+ }
+
+ if ( my $title = _fetch_youtube_watch_html($watch_url) ) {
+ return $title;
+ }
+
+ if ( my $title = _fetch_youtube_noembed($watch_url) ) {
+ return $title;
+ }
+
+ return;
+}
+
+sub _fetch_youtube_oembed {
+ my ($url) = @_;
+ my $body = http_get( $url, 'Accept' => 'application/json' );
+ return unless defined $body;
+
+ my $data = eval { decode_json($body) };
+ return if $@;
+ return unless ref $data eq 'HASH';
+ return unless $data->{title};
+
+ return decode_entities( $data->{title} );
+}
+
+sub _fetch_youtube_watch_html {
+ my ($url) = @_;
+ my $body = http_get($url);
+ return unless $body;
+
+ if ( $body =~ m{<meta\s+(?:property|name)=["']og:title["']\s+content=["'](.+?)["']}i ) {
+ return decode_entities($1);
+ }
+
+ if ( $body =~ m{<title>(.+?)</title>}is ) {
+ my $title = $1;
+ $title =~ s/[\r\n]+/ /g;
+ $title =~ s/\s{2,}/ /g;
+ $title =~ s/\s+-\s+YouTube$//i;
+ $title =~ s/\s*$//;
+ return decode_entities($title);
+ }
+
+ return;
+}
+
+sub _fetch_youtube_noembed {
+ my ($url) = @_;
+ my $endpoint = 'https://noembed.com/embed?url=' . uri_escape($url);
+ my $body = http_get( $endpoint, 'Accept' => 'application/json' );
+ return unless defined $body;
+
+ my $data = eval { decode_json($body) };
+ return if $@;
+ return unless ref $data eq 'HASH';
+ return unless $data->{title};
+
+ return decode_entities( $data->{title} );
+}
+
+sub fetch_title {
+ my ($url) = @_;
+ return unless defined $url && length $url;
+
+ my ( $body, $headers ) = http_get( $url, max_bytes => 200_000 );
+ return unless defined $body;
+
+ my $content_type = lc( $headers->{'content-type'} // '' );
+ if ( $content_type
+ && $content_type !~ m{text/html}
+ && $content_type !~ m{application/xhtml\\+xml}
+ && $content_type !~ m{text/plain} )
+ {
+ return;
+ }
+
+ my $charset = 'utf-8';
+ if ( $content_type =~ /charset=([\w\-]+)/ ) {
+ $charset = lc $1;
+ }
+
+ my $decoded = decode_bytes( $body, $charset );
+ if ( $decoded =~ m{<meta[^>]+charset=["']?([\w\-]+)}i ) {
+ my $meta_charset = lc $1;
+ if ( $meta_charset ne $charset ) {
+ $decoded = decode_bytes( $body, $meta_charset );
+ }
+ }
+
+ my $title;
+ if ( $decoded =~ m{<meta\s+(?:property|name)=["']og:title["'][^>]*content=["'](.+?)["']}i ) {
+ $title = $1;
+ }
+ elsif ( $decoded =~ m{<title[^>]*>(.+?)</title>}is ) {
+ $title = $1;
+ }
+ elsif ( $decoded =~ m{<h1[^>]*>(.+?)</h1>}is ) {
+ $title = $1;
+ }
+
+ return unless defined $title;
+
+ $title = decode_entities($title);
+ $title =~ s/<[^>]+>//g;
+ $title =~ s/[\r\n\t]+/ /g;
+ $title =~ s/\s{2,}/ /g;
+ $title =~ s/^\s+|\s+$//g;
+ $title =~ s/[\x00-\x08\x0B\x0C\x0E-\x1F]+//g;
+ return unless length $title;
+
+ if ( length $title > 200 ) {
+ $title = substr( $title, 0, 200 );
+ $title =~ s/\s+\S*$//;
+ }
+
+ return $title;
+}
+
+sub pbanner {
+ my ( $host, $port ) = @_;
+ my $service_port = $port =~ /\D/ ? getservbyname( $port, 'tcp' ) : $port;
+ die "Unknown port: $port" unless $service_port;
+ my $iaddr = inet_aton($host) or die "Unable to resolve $host";
+ my $paddr = sockaddr_in( $service_port, $iaddr );
+ my $proto = getprotobyname('tcp');
+ socket( my $sock, PF_INET, SOCK_STREAM, $proto );
+ connect( $sock, $paddr );
+
+ if ( $service_port != 80 ) {
+ my $banner = <$sock> // 'No banner';
+ close $sock;
+ return $banner;
+ }
+
+ my $submit = "HEAD / HTTP/1.0\r\n\r\n";
+ send( $sock, $submit, 0 );
+ while ( my $line = <$sock> ) {
+ if ( $line =~ /Server: (.*)/i ) {
+ close $sock;
+ return $line;
+ }
+ }
+ close $sock;
+ return 'No banner';
+}
+
+sub resolve_host {
+ my ($host) = @_;
+ return '' unless $host;
+ if ( $host =~ /^([1]?\d{1,2}|2[0-4]\d|25[0-5])(\.([1]?\d{1,2}|2[0-4]\d|25[0-5])){3}$/ ) {
+ return gethostbyaddr( inet_aton($host), AF_INET ) // 'Unknown';
+ }
+
+ my $packed = inet_aton($host);
+ return $packed ? inet_ntoa($packed) : 'Unknown';
+}
+
+sub check_ip {
+ my ($host) = @_;
+ my $packed = inet_aton($host);
+ my $ip = $packed ? inet_ntoa($packed) : $host;
+ my $cc = $packed ? ( $reg->inet_atocc($ip) // 'XX' ) : 'XX';
+ my $response = $packed ? whoisip_query( $ip, 'true' ) : {};
+
+ my $org = $response->{descr} && $response->{descr}[0]
+ || $response->{'org-name'} && $response->{'org-name'}[0]
+ || $response->{'OrgName'} && $response->{'OrgName'}[0]
+ || undef;
+
+ return ( $ip, $cc, $org );
+}
+
+sub parse_irc_line {
+ my ($line) = @_;
+ my $prefix = '';
+ if ( $line =~ s/^:([^\s]+)\s+// ) {
+ $prefix = $1;
+ }
+
+ my @params;
+ while ( length $line ) {
+ if ( $line =~ s/^:([^\0]*)$// ) {
+ push @params, $1;
+ last;
+ }
+ $line =~ s/^(\S+)\s*//;
+ push @params, $1;
+ }
+
+ my $command = shift @params // '';
+ return ( $prefix, $command, @params );
+}
+
+sub parse_nick {
+ my ($prefix) = @_;
+ return unless defined $prefix;
+ my ($nick) = split /!/, $prefix;
+ return $nick;
+}
+
+sub irc_print {
+ my ( $sock, $message ) = @_;
+ print {$sock} "$message\r\n";
+}
+
+sub uniq {
+ my (@items) = @_;
+ my %seen;
+ return grep { defined $_ && !$seen{ lc $_ }++ } @items;
+}
+
+sub http_client {
+ state $client = HTTP::Tiny->new(
+ agent => 'Cryogenix IRC Bot',
+ timeout => 8,
+ max_redirect => 5,
+ default_headers => {
+ 'Accept-Language' => 'en-US,en;q=0.9',
+ 'Connection' => 'close',
+ },
+ );
+ return $client;
+}
+
+sub http_get {
+ my ( $url, %extra_headers ) = @_;
+ my $max_bytes = delete $extra_headers{max_bytes} // 256 * 1024;
+
+ my %headers = (
+ 'Accept' => 'text/html,application/xhtml+xml;q=0.9,*/*;q=0.8',
+ 'Accept-Encoding' => 'identity',
+ %extra_headers,
+ );
+
+ my $content = '';
+ my $response = http_client()->request(
+ 'GET',
+ $url,
+ {
+ headers => \%headers,
+ data_callback => sub {
+ my ($chunk) = @_;
+ return if length($content) >= $max_bytes;
+ my $remaining = $max_bytes - length $content;
+ $content .= length($chunk) <= $remaining ? $chunk : substr( $chunk, 0, $remaining );
+ },
+ }
+ );
+
+ return unless $response->{success};
+ $response->{content} = $content;
+ return wantarray ? ( $content, $response->{headers} // {} ) : $content;
+}
+
+sub response_target {
+ my ( $nick, $target, $is_private ) = @_;
+ return $is_private ? $nick : $target;
+}
+
+sub debug_log {
+ my ( $config, $message ) = @_;
+ return unless $config->{debug};
+ say $message;
+}
+
+sub sasl_plain_response {
+ my ( $user, $pass ) = @_;
+ my $payload = join chr(0), ( $user // q{}, $user // q{}, $pass // q{} );
+ my $encoded = encode_base64( $payload, '' );
+ return $encoded || '+';
+}
+
+sub decode_bytes {
+ my ( $bytes, $charset ) = @_;
+ $charset ||= 'utf-8';
+ my $decoded;
+ eval {
+ $decoded = decode( $charset, $bytes, Encode::FB_DEFAULT );
+ 1;
+ } or do {
+ eval {
+ $decoded = decode( 'utf-8', $bytes, Encode::FB_DEFAULT );
+ 1;
+ } or $decoded = $bytes;
+ };
+ return $decoded;
+}
