529 lines
14 KiB
Perl
529 lines
14 KiB
Perl
# irclogger_web
|
|
# Copyright (C) 2023 mrkubax10 <mrkubax10@onet.pl>
|
|
|
|
# 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 <https://www.gnu.org/licenses/>.
|
|
|
|
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;
|