# 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 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 . package frontend; use IO::Socket; use File::Spec; use Time::Piece; use DBI; use lib "."; use configuration; 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 parsePath { my $aPath = $_[0]; my $pathLength = length($aPath); my $state = PPATH_URL; my $currentString = ""; my $currentString2 = ""; my %output; foreach my $i (0..$pathLength-1) { my $char = substr($aPath, $i, 1); given($state) { when(PPATH_URL) { if($char eq "?") { $output{"url"} = $currentString; $currentString = ""; $state = PPATH_GET_KEY; next; } $currentString.=$char; if($i==$pathLength-1) { $output{"url"} = $currentString; } } 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{"parameters"}{$currentString} = $currentString2; $currentString = ""; $currentString2 = ""; next; } $currentString2.=$char; if($i==$pathLength-1) { $output{"parameters"}{$currentString} = $currentString2; } } } } return %output; } use constant { PHTTP_METHOD => 0, PHTTP_PATH => 1, PHTTP_VERSION => 2, PHTTP_HEADER => 3, PHTTP_VALUE => 4 }; 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++; $output{"headers"}{$currentString} = $currentString2; $currentString = ""; $currentString2 = ""; $state = PHTTP_HEADER; next; } $currentString2.=$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 = "

501 Not Implemented

irclogger_web
"; 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 = "

404 Not Found

irclogger_web
"; 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 = "

400 Bad Request

irclogger_web
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); } 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; print("$response\n"); $aClient->send($response); } sub handlePath { my $aClient = $_[0]; my $aPath = $_[1]; my $aRequest = $_[2]; my $aConnection = $_[3]; given($aPath) { when("/") { my $query = $aConnection->prepare(qq(select channels.id, channels.name, servers.name from channels inner join servers on channels.server_id=servers.id where channels.public=1;)); $query->execute(); my $table = ""; while(my @row = $query->fetchrow_array()) { my $channelID = $row[0]; my $channelName = $row[1]; my $serverName = $row[2]; $table.="$channelName$serverName"; } sendTemplate("templates/index.html", $aClient, {"publicChannels"=>$table}); return 1; } when("/view_logs") { my $channelID = $aRequest->{"path"}{"parameters"}{"channel"}; if(!defined($channelID)) { sendBadRequest($aClient, "view_log requires channel URL parameter"); return 1; } my $query = $aConnection->prepare(qq(select channels.name, servers.name from channels inner join servers on channels.server_id=servers.id where channels.id=?;)); $query->execute($channelID); my @row = $query->fetchrow_array(); if(scalar(@row)==0) { sendBadRequest($aClient, "Unknown channel with ID $channelID"); return 1; } my $channelName = $row[0]; my $serverName = $row[1]; my $logsPath = "logs/".$serverName."/".$channelName; my $result = opendir(my $folder, $logsPath); if(!$result) { sendBadRequest($aClient, "Channel $channelName on $serverName doesn't have any logs"); return 1; } my @entries = grep(!/^\.\.?$/, readdir($folder)); my $table = ""; foreach my $entry (@entries) { $table.="$entry"; } sendTemplate("templates/view_logs.html", $aClient, {"channel"=>$channelName, "server"=>$serverName, "logs"=>$table}); return 1; } } return 0; } sub sendResponse { my $aClient = $_[0]; my $aRequest = $_[1]; my $aConnection = $_[2]; if($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(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); } default { sendNotImplemented($aClient); } } } sub httpServerWorker { my $db = DBI->connect("DBI:SQLite:dbname=$configuration::database", "", "", {RaiseError=>1}); 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;