irclogger_web/logger.pl

# irclogger
# 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 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 General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

use IO::Socket;
use List::Util;
use Time::Piece;
use File::Path;
use DBI;
use threads;

use lib ".";
use configuration;

use feature qw(switch);
use strict;
use warnings;

sub connectToServer {
	my $aServer = $_[0];
	my $aPort = $_[1];
	my $aServerName = $_[2];

	my $socket = new IO::Socket::INET(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 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 $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(":: Logger -> Outputting channel '%s' at '%s' to '%s'\n", $aChannelName, $aServerName, $outputFilePath);
			$aLogFiles->{$aChannelName} = $file;
		}
		else {
			print(":: Logger -> 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("Encountered invalid PING command (2 arguments expected, %d provided)\n", $aCommandLength);
		return;
	}
	printf(":: 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("Encountered invalid PRIVMSG command (4 arguments expected, %d provided)\n", $aCommandLength);
		return;
	}
	if(!prepareLogFile($aLogFiles, $aServerName, $aCommand->[1])) {
		return;
	}
	$aLogFiles->{$aCommand->[1]}->print(sprintf("(%s) %s: %s\n", localtime->strftime("%H:%M:%S"), getUsernameFromHost($aCommand->[3]), $aCommand->[2]));
	$aLogFiles->{$aCommand->[1]}->flush();
}

sub handleJoin {
	my $aCommand = $_[0];
	my $aServerName = $_[1];
	my $aLogFiles = $_[2];

	my $aCommandLength = scalar(@$aCommand);
	if($aCommandLength!=3) {
		printf("Encountered invalid JOIN command (3 arguments expected, %d provided)\n", $aCommandLength);
		return;
	}
	if(!prepareLogFile($aLogFiles, $aServerName, $aCommand->[1])) {
		return;
	}
	$aLogFiles->{$aCommand->[1]}->print(sprintf("(%s) %s has joined %s\n", localtime->strftime("%H:%M:%S"), getUsernameFromHost($aCommand->[2]), $aCommand->[1]));
	$aLogFiles->{$aCommand->[1]}->flush();
}

sub handleQuit {
	my $aCommand = $_[0];
	my $aServerName = $_[1];
	my $aJoinedChannels = $_[2];
	my $aLogFiles = $_[3];

	my $aCommandLength = scalar(@$aCommand);
	if($aCommandLength!=3 && $aCommandLength!=2) {
		print("Encountered invalid QUIT command (3 or 2 arguments expected, $aCommandLength provided)\n");
		return;
	}
	my $reason = "";
	if($aCommandLength==3) {
		$reason = $aCommand->[1];
	}
	foreach my $channel (@$aJoinedChannels) {
		if(!prepareLogFile($aLogFiles, $aServerName, $channel)) {
			next;
		}
		$aLogFiles->{$channel}->print(sprintf("(%s) %s has quit (%s)\n", localtime->strftime("%H:%M:%S"), getUsernameFromHost($aCommand->[2]), $reason));
		$aLogFiles->{$channel}->flush();
	}
}

sub handlePart {
	my $aCommand = $_[0];
	my $aServerName = $_[1];
	my $aLogFiles = $_[2];

	my $aCommandLength = scalar(@$aCommand);
	if($aCommandLength!=3) {
		print("Encountered invalid PART command (3 arguments expected, $aCommandLength provided)\n");
		return;
	}
	if(!prepareLogFile($aLogFiles, $aServerName, $aCommand->[1])) {
		return;
	}
	$aLogFiles->{$aCommand->[1]}->print(sprintf("(%s) %s has left %s\n", localtime->strftime("%H:%M:%S"), getUsernameFromHost($aCommand->[2]), $aCommand->[1]));
	$aLogFiles->{$aCommand->[1]}->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 connectionWorker {
	my $aHost = $_[0];
	my $aPort = $_[1];
	my $aServerName = $_[2];
	my $aChannels = $_[3];

	my %logFiles;
	my $stream = connectToServer($aHost, $aPort, $aServerName);
	while(!eof($stream)) {
		my $line = readline($stream);
		my @command = parseIRCCommand($line);
		printf(":: Server -> %s", $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, $aChannels, \%logFiles); }
		when("PART") { handlePart(\@command, $aServerName, \%logFiles); }
		when("376") { joinChannels($stream, $aChannels); } # end of MOTD
		}
	}
	close($stream);
}

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];

	$query = $db->prepare(qq(select name from channels where server_id=$id;));
	$query->execute();
	my @channels;
	while(my @channelsRow = $query->fetchrow_array()) {
		my $name = $channelsRow[0];
		push(@channels, $name);
	}

	threads->create("connectionWorker", $host, $port, $name, \@channels);
}

foreach my $thread (threads->list(threads::running)) {
	$thread->join();
}