irclogger_web/logger.pm

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

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 $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"} = $file;
			$aLogFiles->{$aChannelName}{"names"} = [];
		}
		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]}{"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("Encountered invalid JOIN command (3 arguments expected, %d provided)\n", $aCommandLength);
		return;
	}
	if(!prepareLogFile($aLogFiles, $aServerName, $aCommand->[1])) {
		return;
	}
	$aLogFiles->{$aCommand->[1]}{"file"}->print(sprintf("(%s) %s has joined %s\n", localtime->strftime("%H:%M:%S"), getUsernameFromHost($aCommand->[2]), $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("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;
		foreach my $name (@{$aLogFiles->{$channel}{"names"}}) {
			if($name eq $username) {
				$found = 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("Encountered invalid PART command (3 arguments expected, $aCommandLength provided)\n");
		return;
	}
	if(!prepareLogFile($aLogFiles, $aServerName, $aCommand->[1])) {
		return;
	}
	$aLogFiles->{$aCommand->[1]}{"file"}->print(sprintf("(%s) %s has left %s\n", localtime->strftime("%H:%M:%S"), getUsernameFromHost($aCommand->[2]), $aCommand->[1]));
	$aLogFiles->{$aCommand->[1]}{"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 handleNames {
	my $aCommand = $_[0];
	my $aChannels = $_[1];
	my $aLogFiles = $_[2];

	my $aCommandLength = scalar(@$aCommand);
	if($aCommandLength!=6) {
		print("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);
}

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 @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)) {
			if(scalar(@actionQueue)>0) {
				given($actionQueue[0]) {
					when("JOIN") {
						joinChannel($stream, $actionQueue[1]);
					}
				}
				@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);
				printf(":: 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("376") { joinChannels($stream, $aChannels); } # end of MOTD
					when("353") { handleNames(\@command, $aChannels, \%logFiles); } # NAMES reply
				}
				($line, $remaining) = readLineFromBuffer($buffer);
				$buffer = $remaining;
			}
		}
		close($stream);
	}
}

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

	$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);
	}
	createLogger($name, $host, $port, \@channels);
}
$db->disconnect();
1;