# 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 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 . 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 = "

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); } sub redirect { my $aClient = $_[0]; my $aLocation = $_[1]; my $response = getBaseResponse(301, "Moved Permanently"); $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.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;