# irclogger_web # Copyright (C) 2023 mrkubax10 # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU Affero General Public License as # published by the Free Software Foundation, either version 3 of the # License, or (at your option) any later version. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Affero General Public License for more details. # You should have received a copy of the GNU Affero General Public License # along with this program. If not, see . package logger; use IO::Socket; use IO::Select; use List::Util; use Time::Piece; use File::Path; use threads; use threads::shared; use lib "."; use configuration; use feature qw(switch); use strict; use warnings; no warnings qw(experimental::smartmatch); sub connectToServer { my $aServer = $_[0]; my $aPort = $_[1]; my $aServerName = $_[2]; my $socket = IO::Socket::INET->new(PeerAddr=>$aServer, PeerPort=>$aPort, Proto=>"tcp"); $socket->send(sprintf("PASS %s\r\n", $configuration::botPassword)); $socket->send(sprintf("NICK %s\r\n", $configuration::botNick)); $socket->send(sprintf("USER %s %s %s :%s\r\n", $configuration::botUsername, $configuration::botHostname, $aServerName, $configuration::botName)); return $socket; } sub readLineFromBuffer { my $aBuffer = $_[0]; my $output = ""; my $bufferLength = length($aBuffer); foreach my $i (0..$bufferLength-1) { my $char = substr($aBuffer, $i, 1); if($char eq "\n" || ($char eq "\r" && $i+1<$bufferLength && substr($aBuffer, $i+1, 1) eq "\n")) { my $outputLength = length($output); if($char eq "\r" && $i+1<$bufferLength && substr($aBuffer, $i+1, 1) eq "\n") { $outputLength+=2; } else { $outputLength++; } return ($output, substr($aBuffer, $outputLength, $bufferLength-$outputLength)); } $output.=$char; } return ("", $aBuffer); } sub stripPrefix { my $aLine = $_[0]; my $inPrefix = 0; my $prefix = ""; my $line = ""; foreach my $i (0..length($aLine)-1) { my $char = substr($aLine, $i, 1); if($char eq ":" && ($i==0 || $inPrefix)) { $inPrefix = !$inPrefix; next; } if($inPrefix) { $prefix.=$char; next; } if($char ne "\r" && $char ne "\n") { $line.=$char; } } return ($prefix, $line); } sub parseIRCCommand { my $aCommand = $_[0]; my @output; my $inPrefix = 0; my $inLongArg = 0; my $currentString = ""; my $prefix = ""; foreach my $i (0..length($aCommand)-1) { my $char = substr($aCommand, $i, 1); if($char eq "\r" || $char eq "\n") { next; } if($char eq ":" && $i==0) { $inPrefix = 1; next; } if($char eq " " && $inPrefix) { $inPrefix = 0; next; } if($inPrefix) { $prefix.=$char; next; } if($char eq ":" && !$inLongArg) { $inLongArg = 1; next; } if($inLongArg) { $currentString.=$char; next; } if($char eq " " && length($currentString)>0) { push(@output, $currentString); $currentString = ""; next; } $currentString.=$char; } if(length($currentString)>0) { push(@output, $currentString); } if(length($prefix)>0) { push(@output, $prefix); } return @output; } sub getUsernameFromHost { my $aHost = $_[0]; my $output = ""; foreach my $i (0..length($aHost)-1) { my $char = substr($aHost, $i, 1); if($char eq "!") { last; } $output.=$char; } return $output; } sub prepareLogFile { my $aLogFiles = $_[0]; my $aServerName = $_[1]; my $aChannelName = $_[2]; if(exists($aLogFiles->{$aChannelName})) { my $filename = localtime->dmy("-").".txt"; if($filename ne $aLogFiles->{$aChannelName}{"filename"}) { close($aLogFiles->{$aChannelName}{"file"}); my $outputFileFolder = $configuration::logFolder."/".$aServerName."/".$aChannelName; my $outputFilePath = $outputFileFolder."/".$filename; open(my $file, ">>", $outputFilePath); if($file) { printf("[info] Outputting channel '%s' at '%s' to '%s'\n", $aChannelName, $aServerName, $outputFilePath); $aLogFiles->{$aChannelName}{"file"} = $file; $aLogFiles->{$aChannelName}{"filename"} = $filename; } else { print("[error] Failed to open '$outputFilePath' for writing\n"); return 0; } } } else { my $outputFileFolder = $configuration::logFolder."/".$aServerName."/".$aChannelName; if(!(-e $outputFileFolder)) { File::Path::make_path($outputFileFolder); } my $outputFilePath = $outputFileFolder."/".localtime->dmy("-").".txt"; open(my $file, ">>", $outputFilePath); if($file) { printf("[info] Outputting channel '%s' at '%s' to '%s'\n", $aChannelName, $aServerName, $outputFilePath); $aLogFiles->{$aChannelName}{"file"} = $file; $aLogFiles->{$aChannelName}{"filename"} = localtime->dmy("-").".txt"; $aLogFiles->{$aChannelName}{"names"} = []; } else { print("[error] Failed to open '$outputFilePath' for writing\n"); return 0; } } return 1; } sub handlePing { my $aStream = $_[0]; my $aCommand = $_[1]; my $aCommandLength = scalar(@$aCommand); if($aCommandLength!=2) { printf("[error] Encountered invalid PING command (2 arguments expected, %d provided)\n", $aCommandLength); return; } if($configuration::verboseLogging) { printf("[verbose] Response: PONG :%s\n", $aCommand->[1]); } $aStream->send(sprintf("PONG :%s\r\n", $aCommand->[1])); } sub handlePrivMsg { my $aStream = $_[0]; my $aCommand = $_[1]; my $aServerName = $_[2]; my $aJoinedChannels = $_[3]; my $aLogFiles = $_[4]; my $aCommandLength = scalar(@$aCommand); if($aCommandLength!=4) { printf("[error] Encountered invalid PRIVMSG command (4 arguments expected, %d provided)\n", $aCommandLength); return; } if(!prepareLogFile($aLogFiles, $aServerName, $aCommand->[1])) { return; } $aLogFiles->{$aCommand->[1]}{"file"}->print(sprintf("(%s) %s: %s\n", localtime->strftime("%H:%M:%S"), getUsernameFromHost($aCommand->[3]), $aCommand->[2])); $aLogFiles->{$aCommand->[1]}{"file"}->flush(); } sub handleJoin { my $aCommand = $_[0]; my $aServerName = $_[1]; my $aLogFiles = $_[2]; my $aCommandLength = scalar(@$aCommand); if($aCommandLength!=3) { printf("[error] Encountered invalid JOIN command (3 arguments expected, %d provided)\n", $aCommandLength); return; } if(!prepareLogFile($aLogFiles, $aServerName, $aCommand->[1])) { return; } my $username = getUsernameFromHost($aCommand->[2]); push(@{$aLogFiles->{$aCommand->[1]}{"names"}}, $username); $aLogFiles->{$aCommand->[1]}{"file"}->print(sprintf("(%s) %s has joined %s\n", localtime->strftime("%H:%M:%S"), $username, $aCommand->[1])); $aLogFiles->{$aCommand->[1]}{"file"}->flush(); } sub handleQuit { my $aCommand = $_[0]; my $aServerName = $_[1]; my $aLogFiles = $_[2]; my $aCommandLength = scalar(@$aCommand); if($aCommandLength!=3 && $aCommandLength!=2) { print("[error] Encountered invalid QUIT command (3 or 2 arguments expected, $aCommandLength provided)\n"); return; } my $reason = ""; if($aCommandLength==3) { $reason = $aCommand->[1]; } my $username = getUsernameFromHost($aCommand->[$aCommandLength-1]); foreach my $channel (keys(%$aLogFiles)) { my $found = 0; my $i = 0; foreach $i (0..scalar(@{$aLogFiles->{$channel}{"names"}})-1) { my $name = $aLogFiles->{$channel}{"names"}[$i]; if($name eq $username) { $found = 1; splice(@{$aLogFiles->{$channel}{"names"}}, $i, 1); last; } } if(!$found || !prepareLogFile($aLogFiles, $aServerName, $channel)) { next; } $aLogFiles->{$channel}{"file"}->print(sprintf("(%s) %s has quit (%s)\n", localtime->strftime("%H:%M:%S"), $username, $reason)); $aLogFiles->{$channel}{"file"}->flush(); } } sub handlePart { my $aCommand = $_[0]; my $aServerName = $_[1]; my $aLogFiles = $_[2]; my $aCommandLength = scalar(@$aCommand); if($aCommandLength!=3) { print("[error] Encountered invalid PART command (3 arguments expected, $aCommandLength provided)\n"); return; } if(!prepareLogFile($aLogFiles, $aServerName, $aCommand->[1])) { return; } my $username = getUsernameFromHost($aCommand->[2]); foreach my $i (0..scalar(@{$aLogFiles->{$aCommand->[1]}{"names"}})-1) { my $name = $aLogFiles->{$aCommand->[1]}{"names"}[$i]; if($name eq $username) { splice(@{$aLogFiles->{$aCommand->[1]}{"names"}}, $i, 1); last; } } $aLogFiles->{$aCommand->[1]}{"file"}->print(sprintf("(%s) %s has left %s\n", localtime->strftime("%H:%M:%S"), $username, $aCommand->[1])); $aLogFiles->{$aCommand->[1]}{"file"}->flush(); } sub handleNick { my $aCommand = $_[0]; my $aServerName = $_[1]; my $aLogFiles = $_[2]; my $aCommandLength = scalar(@$aCommand); if($aCommandLength!=3) { print("[error] Encountered invalid NICK command (3 arguments expected, $aCommandLength provided)\n"); return; } my $username = getUsernameFromHost($aCommand->[2]); foreach my $channel (keys(%$aLogFiles)) { my $found = 0; my $i = 0; foreach $i (0..scalar(@{$aLogFiles->{$channel}{"names"}})-1) { my $name = \$aLogFiles->{$channel}{"names"}[$i]; if($$name eq $username) { $found = 1; $$name = $aCommand->[1]; last; } } if(!$found || !prepareLogFile($aLogFiles, $aServerName, $channel)) { next; } $aLogFiles->{$channel}{"file"}->print(sprintf("(%s) %s is now known as %s\n", localtime->strftime("%H:%M:%S"), $username, $aCommand->[1])); $aLogFiles->{$channel}{"file"}->flush(); } } sub joinChannel { my $aStream = $_[0]; my $aChannel = $_[1]; $aStream->send(sprintf("JOIN %s\r\n", $aChannel)); } sub joinChannels { my $aStream = $_[0]; my $aChannels = $_[1]; foreach my $channel (@$aChannels) { joinChannel($aStream, $channel); } } sub partChannel { my $aStream = $_[0]; my $aChannel = $_[1]; $aStream->send(sprintf("PART %s\r\n", $aChannel)); } sub quitFromServer { my $aStream = $_[0]; $aStream->send("QUIT\r\n"); } sub handleNames { my $aCommand = $_[0]; my $aChannels = $_[1]; my $aLogFiles = $_[2]; my $aCommandLength = scalar(@$aCommand); if($aCommandLength!=6) { print("[error] Encountered invalid NAMES command (6 arguments expected, $aCommandLength provided)\n"); return; } my @names = split(" ", $aCommand->[4]); if(!defined($aLogFiles->{$aCommand->[3]})) { return; } push(@{$aLogFiles->{$aCommand->[3]}{"names"}}, @names); } sub handleTopic { my $aCommand = $_[0]; my $aServerName = $_[1]; my $aLogFiles = $_[2]; my $aChangedByUser = $_[3]; my $aCommandLength = scalar(@$aCommand); if($aCommandLength!=5) { print("[error] Encountered invalid TOPIC command (5 arguments expected, $aCommandLength provided)\n"); return; } if(!prepareLogFile($aLogFiles, $aServerName, $aCommand->[2])) { return; } if($aChangedByUser) { my $username = getUsernameFromHost($aCommand->[4]); $aLogFiles->{$aCommand->[2]}{"file"}->print(sprintf("(%s) %s changed topic for channel %s to: %s\n", localtime->strftime("%H:%M:%S"), $username, $aCommand->[2], $aCommand->[3])); } else { $aLogFiles->{$aCommand->[2]}{"file"}->print(sprintf("(%s) Topic for channel %s: %s\n", localtime->strftime("%H:%M:%S"), $aCommand->[2], $aCommand->[3])); } $aLogFiles->{$aCommand->[2]}{"file"}->flush(); } our @connections :shared; our $running :shared = 1; sub connectionWorker { my $aHost = $_[0]; my $aPort = $_[1]; my $aServerName = $_[2]; my $aChannels = $_[3]; my $buffer = ""; my @actionQueue :shared; my $running = 1; my @connection :shared = ($aServerName, \@actionQueue); push(@connections, \@connection); my %logFiles; while($running) { my $stream = connectToServer($aHost, $aPort, $aServerName); my $streamSelect = IO::Select->new($stream); while(!eof($stream) && $running) { if(scalar(@actionQueue)>0) { given($actionQueue[0]) { when("JOIN") { joinChannel($stream, $actionQueue[1]); } when("PART") { partChannel($stream, $actionQueue[1]); } when("QUIT") { quitFromServer($stream); $running = 0; } } @actionQueue = (); } my @canRead = $streamSelect->can_read(0); if(scalar(@canRead)==0) { next; } my $tempBuffer; $stream->recv($tempBuffer, 512); $buffer.=$tempBuffer; my ($line, $remaining) = readLineFromBuffer($buffer); $buffer = $remaining; while(length($line)>0) { my @command = parseIRCCommand($line); if($configuration::verboseLogging) { printf("[verbose] Server: %s\n", $line); } given($command[0]) { when("PING") { handlePing($stream, \@command); } when("PRIVMSG") { handlePrivMsg($stream, \@command, $aServerName, $aChannels, \%logFiles); } when("JOIN") { handleJoin(\@command, $aServerName, \%logFiles); } when("QUIT") { handleQuit(\@command, $aServerName, \%logFiles); } when("PART") { handlePart(\@command, $aServerName, \%logFiles); } when("NICK") { handleNick(\@command, $aServerName, \%logFiles); } when("TOPIC") { handleTopic(\@command, $aServerName, \%logFiles, 1); } when("376") { joinChannels($stream, $aChannels); } # end of MOTD when("353") { handleNames(\@command, $aChannels, \%logFiles); } # NAMES reply when("332") { handleTopic(\@command, $aServerName, \%logFiles, 0); } # TOPIC reply } ($line, $remaining) = readLineFromBuffer($buffer); $buffer = $remaining; } } close($stream); } foreach my $i (0..scalar(@connections)-1) { if($connections[$i][0] eq $aServerName) { $connections[$i][0] = ""; last; } } } sub createLogger { my $aName = $_[0]; my $aHost = $_[1]; my $aPort = $_[2]; my $aChannels = $_[3]; threads->create("connectionWorker", $aHost, $aPort, $aName, $aChannels); } sub getActionQueueByServerName { my $aServerName = $_[0]; foreach my $connection (@connections) { if($connection->[0] eq $aServerName) { return $connection->[1]; } } } my $db = DBI->connect("DBI:SQLite:dbname=$configuration::database", "", "", {RaiseError=>1}); my $query = $db->prepare(qq(select * from servers;)); $query->execute(); while(my @row = $query->fetchrow_array()) { my $id = $row[0]; my $name = $row[1]; my $host = $row[2]; my $port = $row[3]; my $enabled = $row[4]; if(!$enabled) { next; } my $channelQuery = $db->prepare(qq(select name, enabled from channels where server_id=$id;)); $channelQuery->execute(); my @channels; while(my @channelsRow = $channelQuery->fetchrow_array()) { my $name = $channelsRow[0]; my $enabled = $channelsRow[1]; if(!$enabled) { next; } push(@channels, $name); } createLogger($name, $host, $port, \@channels); } $db->disconnect(); 1;