package L3TDE::Bot::IRC; use v5.34.1; use strict; use warnings; use Moo; use IO::Socket::SSL; use Crypt::URandom qw/urandom/; use List::AllUtils qw/none any/; with 'L3TDE::Bot::Role'; has [qw/password username hostname port parent/] => ( is => 'rw', required => 1, ); # 221 stands for mode. has once_221_login => ( is => 'rw' ); has socket => ( is => 'rw', ); # Not lazy because we may do it more than once. sub _generate_socket { my $self = shift; my $username = $self->username; my $hostname = $self->hostname; my $password = $self->password; my $port = $self->port; my $random_nick = unpack( 'H*', urandom(10) ); my $return = IO::Socket::SSL->new( PeerHost => $hostname, PeerPort => $port, Proto => 'tcp', Timeout => 5 ) or die $!; $self->socket($return); $self->_print_socket("USER $username 0 * :L3TDE Bot"); if ( $self->parent->is_registered ) { $self->_print_socket("NICK ${username}_${random_nick}"); } else { $self->_print_socket("NICK ${username}"); } return $self; } sub _print_socket { my $self = shift; my $message = shift; my $socket = $self->socket; $message =~ s/\s+$//; say "SENT ($message)"; print $socket "$message\r\n"; } sub _try_reply_ping { my $self = shift; my $line = shift; if ( $line =~ /^PING (.+?)\s+$/ ) { $self->_print_socket("PONG $1"); return 1; } return 0; } sub _try_reply_user_interaction { my $self = shift; my $line = shift; if ( ( my $params_line = $line =~ s/^:(\S+?)(?:!\S+)?@(?:\S+) (\w+)\s+//r ) && $1 ) { my $sender_username = $1; my $command = $2; say "Received interaction ($sender_username -> $command)"; if ( $command eq 'PRIVMSG' ) { my ( $dest, $message ) = $params_line =~ /^(\S+) :(.*?)\s+$/; my $prefered_reply_to = $sender_username; if ( $dest =~ /^#/ ) { $prefered_reply_to = $dest; } $self->parent->process_msg( $sender_username, $prefered_reply_to, $message ); } return 1; } return 0; } sub _try_reply_server_action { my $self = shift; my $line = shift; if ( my ( $server, $protocol_message ) = $line =~ /^:(\S+) (\d+)/ ) { # We silence the annoying motd. if ( $protocol_message == 221 ) { if ( !$self->once_221_login ) { $self->once_221_login(1); if ( $self->parent->is_registered ) { $self->login; } else { $self->register; } $self->_join_saved_channels; } } return 1; } return 0; } sub start { my $self = shift; $self->once_221_login(0); while (1) { eval { $self->_generate_socket; while ( defined( my $line = $self->_read ) ) { { next if !$self->once_221_login; print $line; } !$self->_try_reply_ping($line) && !$self->_try_reply_user_interaction($line) && $self->_try_reply_server_action($line); } }; if ($@) { die($@); } } return 1; } sub login { my $self = shift; $self->msg( NickServ => "identify @{[$self->username]} @{[$self->password]}" ); } sub register { my $self = shift; $self->msg( NickServ => "register @{[$self->password]} @{[$self->password]}" ); $self->parent->mark_registered; } sub _read { my $self = shift; local $/ = "\r\n"; my $socket = $self->socket; my $line = <$socket>; return $line; } sub try_to_join { my $self = shift; my $class = $self->get_class; my $prefered_reply_to = shift; my $channel = shift; my $parent = $self->parent; $parent->data->{channels} //= []; my $channels = $parent->data->{channels}; if ( none { $_ eq $channel } @$channels ) { $self->_join_channel($channel); push @{ $parent->data->{channels} }, $channel; $parent->update( [qw/data/] ); $self->msg( $prefered_reply_to, "Succesfully joined $channel" ); } else { die "I am already in $channel."; } } sub _join_saved_channels { my $self = shift; my $parent = $self->parent; my $channels = $parent->data->{channels}; return if !defined $channels; for my $channel (@$channels) { eval { $self->_join_channel($channel); }; if ($@) { say STDERR $@; } } } sub _join_channel { my $self = shift; my $channel = shift // die("Channel not defined"); die "$channel should start by #." if $channel !~ /^#/; $self->_print_socket("JOIN $channel"); } sub get_class { my $self = shift; return $self if !ref $self; return ref $self; } sub msg { my $self = shift; my $username = shift; my $message = shift; warn "Bad username $username", return if $username =~ /\s+|:/; $self->_print_socket("PRIVMSG $username :$message"); } 1;