irclogger_web/frontend.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 frontend;

use IO::Socket;
use Digest::SHA;
use File::Spec;
use Time::Piece;
use DBI;

use lib ".";
use configuration;
use frontend_routes;

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

sub readFullFile {
	my $aFile = $_[0];

	my $content = "";
	while(!eof($aFile)) {
		$content.=readline($aFile);
	}
	return $content;
}

use constant {
	HTTP_METHOD_UNKNOWN => 0,
	HTTP_METHOD_GET => 1,
	HTTP_METHOD_POST => 2
};
sub stringToHTTPMethod {
	my $aMethod = $_[0];

	given($aMethod) {
	when("GET") { return HTTP_METHOD_GET; }
	when("POST") { return HTTP_METHOD_POST; }
	default { return HTTP_METHOD_UNKNOWN; }
	}
}

use constant {
	PPATH_URL => 0,
	PPATH_GET_KEY => 1,
	PPATH_GET_VALUE => 2
};
sub parsePathParameters {
	my $aPath = $_[0];

	my $pathLength = length($aPath);
	my $state = PPATH_GET_KEY;
	my $currentString = "";
	my $currentString2 = "";
	my %output;
	foreach my $i (0..$pathLength-1) {
		my $char = substr($aPath, $i, 1);
		given($state) {
		when(PPATH_GET_KEY) {
			if($char eq "=") {
				$state = PPATH_GET_VALUE;
				next;
			}
			$currentString.=$char;
		}
		when(PPATH_GET_VALUE) {
			if($char eq "&") {
				$state = PPATH_GET_KEY;
				$output{$currentString} = $currentString2;
				$currentString = "";
				$currentString2 = "";
				next;
			}
			$currentString2.=$char;
			if($i==$pathLength-1) {
				$output{$currentString} = $currentString2;
			}
		}
		}
	}
	return %output;
}
sub parsePath {
	my $aPath = $_[0];

	my $pathLength = length($aPath);
	my $state = PPATH_URL;
	my $currentString = "";
	my %output;
	my $index = 0;
	while($index<$pathLength) {
		my $char = substr($aPath, $index++, 1);
		if($char eq "?") {
			$output{"url"} = $currentString;
			$state = PPATH_GET_KEY;
			last;
		}
		$currentString.=$char;
	}
	$output{"url"} = $currentString;
	if($state==PPATH_GET_KEY) {
		$output{"parameters"} = { parsePathParameters(substr($aPath, $index, $pathLength-$index)) };
	}
	return %output;
}

use constant {
	PCOOKIE_NAME => 0,
	PCOOKIE_VALUE => 1
};
sub parseCookies {
	my $aCookies = $_[0];

	my $cookiesLength = length($aCookies);
	my $state = PCOOKIE_NAME;
	my $currentString = "";
	my $currentString2 = "";
	my %output;
	foreach my $i (0..$cookiesLength-1) {
		my $char = substr($aCookies, $i, 1);
		given($state) {
		when(PCOOKIE_NAME) {
			if($char eq " ") {
				next;
			}
			if($char eq "=") {
				$state = PCOOKIE_VALUE;
				next;
			}
			$currentString.=$char;
		}
		when(PCOOKIE_VALUE) {
			if($char eq ";" || $i==$cookiesLength-1) {
				if(length($currentString)>0 && length($currentString2)>0) {
					if($i==$cookiesLength-1) {
						$currentString2.=$char;
					}
					$output{$currentString} = $currentString2;
				}
				$currentString = "";
				$currentString2 = "";
				$state = PCOOKIE_NAME;
				next;
			}
			$currentString2.=$char;
		}
		}
	}
	return %output;
}

use constant {
	PHTTP_METHOD => 0,
	PHTTP_PATH => 1,
	PHTTP_VERSION => 2,
	PHTTP_HEADER => 3,
	PHTTP_VALUE => 4,
	PHTTP_CONTENT => 5
};
sub parseHTTPRequest {
	my $aRequest = $_[0];

	my $requestLength = length($aRequest);
	my $index = 0;
	my $state = PHTTP_METHOD;
	my $currentString = "";
	my $currentString2 = "";
	my %output;
	while($index<$requestLength) {
		my $char = substr($aRequest, $index++, 1);
		given($state) {
		when(PHTTP_METHOD) {
			if($char eq " ") {
				$output{"method"} = stringToHTTPMethod($currentString);
				$currentString = "";
				$state = PHTTP_PATH;
				next;
			}
			$currentString.=$char;
		}
		when(PHTTP_PATH) {
			if($char eq " ") {
				$output{"path"} = { parsePath($currentString) };
				$currentString = "";
				$state = PHTTP_VERSION;
				next;
			}
			$currentString.=$char;
		}
		when(PHTTP_VERSION) {
			if($char eq "\r") {
				$index++;
				$output{"version"} = $currentString;
				$currentString = "";
				$state = PHTTP_HEADER;
				next;
			}
			$currentString.=$char;
		}
		when(PHTTP_HEADER) {
			if($char eq ":") {
				while(substr($aRequest, ++$index, 1) eq " ") {}
				$state = PHTTP_VALUE;
				next;
			}
			$currentString.=$char;
		}
		when(PHTTP_VALUE) {
			if($char eq "\r") {
				$index++;
				if($currentString eq "Cookie") {
					$output{"cookies"} = { parseCookies($currentString2) };
				}
				else {
					$output{"headers"}{$currentString} = $currentString2;
				}
				if($index+1<$requestLength && substr($aRequest, $index, 1) eq "\r") {
					if(defined($output{"headers"}{"Content-Length"})) {
						$index+=2;
						$state = PHTTP_CONTENT;
						$output{"content"} = "";
					}
				}
				else {
					$currentString = "";
					$currentString2 = "";
					$state = PHTTP_HEADER;
				}
				next;
			}
			$currentString2.=$char;
		}
		when(PHTTP_CONTENT) {
			$output{"content"}.=$char;
		}
		}
	}
	return %output;
}

sub getBaseResponse {
	my $aStatusCode = $_[0];
	my $aStatusText = $_[1];

	my $response = "HTTP/1.1 $aStatusCode $aStatusText\r\n";
	$response.="Date: ".localtime->strftime("%a, %d %b %Y %H:%M:%S %Z")."\r\n";
	$response.="Server: irclogger_web\r\n";
	return $response;
}

sub sendNotImplemented {
	my $aClient = $_[0];

	my $content = "<h1>501 Not Implemented</h1><h6>irclogger_web</h6>";
	my $response = getBaseResponse(501, "Not Implemented");
	$response.="Content-Type: text/html, charset=utf-8\r\n";
	$response.="Content-Length: ".length($content)."\r\n\r\n";
	$response.=$content;
	$aClient->send($response);
}

sub sendNotFound {
	my $aClient = $_[0];

	my $content = "<h1>404 Not Found</h1><h6>irclogger_web</h6>";
	my $response = getBaseResponse(404, "Not Found");
	$response.="Content-Type: text/html, charset=utf-8\r\n";
	$response.="Content-Length: ".length($content)."\r\n\r\n";
	$response.=$content;
	$aClient->send($response);
}

sub sendBadRequest {
	my $aClient = $_[0];
	my $aMessage = $_[1];

	my $content = "<h1>400 Bad Request</h1><h6>irclogger_web</h6>Error: $aMessage";
	my $response = getBaseResponse(400, "Bad Request");
	$response.="Content-Type: text/html, charset=utf-8\r\n";
	$response.="Content-Length: ".length($content)."\r\n\r\n";
	$response.=$content;
	$aClient->send($response);
}

sub sendUnauthorized {
	my $aClient = $_[0];
	my $aMessage = $_[1];

	my $content = "<h1>401 Unauthorized</h1><h6>irclogger_web</h6>Error: $aMessage";
	my $response = getBaseResponse(401, "Unauthorized");
	$response.="Content-Type: text/html, charset=utf-8\r\n";
	$response.="Content-Length: ".length($content)."\r\n\r\n";
	$response.=$content;
	$aClient->send($response);
}

sub sendForbidden {
	my $aClient = $_[0];
	my $aMessage = $_[1];

	my $content = "<h1>403 Forbidden</h1><h6>irclogger_web</h6>Error: $aMessage";
	my $response = getBaseResponse(403, "Forbidden");
	$response.="Content-Type: text/html, charset=utf-8\r\n";
	$response.="Content-Length: ".length($content)."\r\n\r\n";
	$response.=$content;
	$aClient->send($response);
}

sub sendConflict {
	my $aClient = $_[0];
	my $aMessage = $_[1];

	my $content = "<h1>409 Conflict</h1><h6>irclogger_web</h6>Error: $aMessage";
	my $response = getBaseResponse(409, "Conflict");
	$response.="Content-Type: text/html, charset=utf-8\r\n";
	$response.="Content-Length: ".length($content)."\r\n\r\n";
	$response.=$content;
	$aClient->send($response);

}

sub redirect {
	my $aClient = $_[0];
	my $aLocation = $_[1];

	my $response = getBaseResponse(307, "Temporary Redirect");
	$response.="Content-Length: 0\r\n";
	$response.="Location: $aLocation\r\n";
	$aClient->send($response);
}

use constant {
	PREPROCESSOR_STATE_TEXT => 0,
	PREPROCESSOR_STATE_VAR => 1,
	PREPROCESSOR_STATE_INC => 2
};
sub preprocessHTML {
	my $aContent = $_[0];
	my $aVariables = $_[1];

	my $contentLength = length($aContent);
	my $state = PREPROCESSOR_STATE_TEXT;
	my $currentString = "";
	my $index = 0;
	my $output = "";
	while($index<$contentLength) {
		my $char = substr($aContent, $index++, 1);
		given($state) {
		when(PREPROCESSOR_STATE_TEXT) {
			if($char eq "{" && $index<$contentLength) {
				my $nextChar = substr($aContent, $index, 1);
				if($nextChar eq "{") {
					$index++;
					$state = PREPROCESSOR_STATE_VAR;
					next;
				}
			}
			if($char eq "[" && $index<$contentLength) {
				my $nextChar = substr($aContent, $index, 1);
				if($nextChar eq "[") {
					$index++;
					$state = PREPROCESSOR_STATE_INC;
					next;
				}
			}
			$output.=$char;
		}
		when(PREPROCESSOR_STATE_VAR) {
			if($char eq "}" && $index<$contentLength) {
				my $nextChar = substr($aContent, $index, 1);
				if($nextChar eq "}") {
					$index++;
					$output.=$aVariables->{$currentString};
					$currentString = "";
					$state = PREPROCESSOR_STATE_TEXT;
					next;
				}
			}
			$currentString.=$char;
		}
		when(PREPROCESSOR_STATE_INC) {
			if($char eq "]" && $index<$contentLength) {
				my $nextChar = substr($aContent, $index, 1);
				if($nextChar eq "]") {
					$index++;
					if(open(my $file, "<", $currentString)) {
						$output.=preprocessHTML(readFullFile($file), $aVariables);
						close($file);
					}
					else {
						$output.="[[Include file not found]";
					}
					$currentString = "";
					$state = PREPROCESSOR_STATE_TEXT;
					next;
				}
			}
			$currentString.=$char;
		}
		}
	}
	return $output;
}

sub sendTemplate {
	my $aFilePath = $_[0];
	my $aClient = $_[1];
	my $aVariables = $_[2];

	my $result = open(my $file, "<", $aFilePath);
	if(!$result) {
		sendNotFound($aClient);
		return 0;
	}
	my $content = preprocessHTML(readFullFile($file), $aVariables);
	close($file);
	my $length = length($content);
	my $response = getBaseResponse(200, "OK");
	$response.="Content-Length: $length\r\n\r\n";
	$response.=$content;
	$aClient->send($response);
}

sub sendResponse {
	my $aClient = $_[0];
	my $aRequest = $_[1];
	my $aConnection = $_[2];

	if($aRequest->{"version"} ne "HTTP/1.0" && $aRequest->{"version"} ne "HTTP/1.1") {
		sendNotImplemented($aClient);
		return;
	}

	given($aRequest->{"method"}) {
	when(HTTP_METHOD_GET) {
		my $path = File::Spec->canonpath($aRequest->{"path"}{"url"});
		if($path eq "/index.html" || $path eq "/index.htm") {
			$path = "/";
		}
		if(frontend_routes::handlePath($aClient, $path, $aRequest, $aConnection)) {
			return;
		}
		my $filePath = "static".$path;
		my $result = open(my $file, "<", $filePath);
		if(!$result) {
			sendNotFound($aClient);
			return;
		}
		my $content = readFullFile($file);
		close($file);
		my $response = getBaseResponse(200, "OK");
		# TODO
		#my $mime = File::Type->new()->mime_type($filePath);
		#$response.="Content-Type: $mime\r\n";
		$response.="Content-Length: ".length($content)."\r\n\r\n";
		$response.=$content;
		$aClient->send($response);
	}
	when(HTTP_METHOD_POST) {
		my $path = File::Spec->canonpath($aRequest->{"path"}{"url"});
		if($path eq "/index.html" || $path eq "/index.htm") {
			$path = "/";
		}
		if(!frontend_routes::handlePath($aClient, $path, $aRequest, $aConnection)) {
			sendNotFound($aClient);
		}
	}
	default {
		sendNotImplemented($aClient);
	}
	}
}

sub httpServerWorker {
	my $db = DBI->connect("DBI:SQLite:dbname=$configuration::database", "", "", {RaiseError=>1});
	my $query = $db->prepare(qq(select id from users;));
	$query->execute();
	my @row = $query->fetchrow_array();
	if(scalar(@row)==0) {
		# Create default user
		my $password = Digest::SHA::sha256_hex("admin");
		$query = $db->prepare(qq(insert into users values(0, "admin", "$password", 2);));
		$query->execute();
	}

	my $server = new IO::Socket::INET(LocalHost=>"localhost", LocalPort=>$configuration::httpServerPort, Proto=>"tcp", Listen=>1, Reuse=>1);
	if(!$server) {
		print("Failed to open HTTP server on port $configuration::httpServerPort\n");
		return;
	}

	while(1) {
		my $client = $server->accept();
		my $buffer;
		$client->recv($buffer, 4096);
		if(length($buffer)==0) {
			close($client);
			next;
		}
		my %request = parseHTTPRequest($buffer);
		sendResponse($client, \%request, $db);
		close($client);
	}
}

1;