commit e12c3d6c1d3836c88da14cf59054950f3b53ed64 from: int16h date: Thu Oct 16 23:08:02 2025 UTC Refactored, rewritten the 2009 code commit - 942be4a188b77bebaf9d1bba1324f679fb9b7049 commit + e12c3d6c1d3836c88da14cf59054950f3b53ed64 blob - /dev/null blob + ce2a03efb3fece41b60fb4e1812609abc90e636a (mode 644) --- /dev/null +++ crybot.pl @@ -0,0 +1,800 @@ +#!/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 ' ); + 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 " ); + 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 " ); + 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{
\s*(.+?)\s*
}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{(.+?)//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{
(.+?)//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{(.+?)//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 - Grab banner', + '- !md5 - MD5 Hash', + '- !ipinfo - IP Whois', + '- !resolve - Resolve IP/Host', + '- !ns - Lookup NS of domain', + '- !axfr - Transfer Req', + '- !ud - 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{(.+?)}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{]+charset=["']?([\w\-]+)}i ) { + my $meta_charset = lc $1; + if ( $meta_charset ne $charset ) { + $decoded = decode_bytes( $body, $meta_charset ); + } + } + + my $title; + if ( $decoded =~ m{]*content=["'](.+?)["']}i ) { + $title = $1; + } + elsif ( $decoded =~ m{]*>(.+?)}is ) { + $title = $1; + } + elsif ( $decoded =~ m{]*>(.+?)}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; +}