203 lines
4.8 KiB
Perl
203 lines
4.8 KiB
Perl
|
# 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 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 File::Spec;
|
||
|
use Time::Piece;
|
||
|
|
||
|
use lib ".";
|
||
|
use configuration;
|
||
|
|
||
|
use feature qw(switch);
|
||
|
use strict;
|
||
|
use warnings;
|
||
|
|
||
|
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 {
|
||
|
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"} = $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 = "<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 sendResponse {
|
||
|
my $aClient = $_[0];
|
||
|
my $aRequest = $_[1];
|
||
|
|
||
|
if($aRequest->{"version"} ne "HTTP/1.1") {
|
||
|
sendNotImplemented($aClient);
|
||
|
return;
|
||
|
}
|
||
|
|
||
|
given($aRequest->{"method"}) {
|
||
|
when(HTTP_METHOD_GET) {
|
||
|
my $path = File::Spec->canonpath($aRequest->{"path"});
|
||
|
if($path eq "/") {
|
||
|
$path = "/index.html";
|
||
|
}
|
||
|
my $filePath = "templates".$path;
|
||
|
my $result = open(my $file, "<", $filePath);
|
||
|
print($filePath);
|
||
|
if(!$result) {
|
||
|
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);
|
||
|
return;
|
||
|
}
|
||
|
my $content = "";
|
||
|
while(!eof($file)) {
|
||
|
$content.=readline($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;
|
||
|
print($response);
|
||
|
$aClient->send($response);
|
||
|
}
|
||
|
default {
|
||
|
sendNotImplemented($aClient);
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
|
||
|
sub httpServerWorker {
|
||
|
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);
|
||
|
close($client);
|
||
|
}
|
||
|
}
|
||
|
|
||
|
httpServerWorker();
|