From d72f41647a08d0940b2c69ca0ab9f975fd773b5b Mon Sep 17 00:00:00 2001
From: Emil Williams
Date: Thu, 21 Aug 2025 01:01:39 +0000
Subject: Hide Everything, Hyde!

---
 perl/cgi.pl  | 121 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 perl/fcgi.pl |  23 ++++++++++++
 2 files changed, 144 insertions(+)
 create mode 100755 perl/cgi.pl
 create mode 100755 perl/fcgi.pl

(limited to 'perl')

diff --git a/perl/cgi.pl b/perl/cgi.pl
new file mode 100755
index 0000000..3cbed42
--- /dev/null
+++ b/perl/cgi.pl
@@ -0,0 +1,121 @@
+#!/usr/bin/env perl
+
+# XXX
+# why are we passing around root like a cheap whore?                            because root is where things are (f(x) -> y)
+# looking into it, i think we should have a global config object using
+# https://metacpan.org/pod/Readonly                                             fuck read only, constants are for faggots
+#
+# i modified the routing heavily, this is how people do it;                     very scary
+# pretty clean
+# you must also realize that not all routes are necessarily templates,          then they are routed by nginx.
+# it could be a redirect for example, so the original solution would
+# complicate beyond comprehension                                               ACK.
+
+use strict;
+use warnings;
+use CGI;
+use Template;
+use URI::Escape;
+use Cwd;
+use Data::Dumper;
+use Git::Repository;
+
+use lib qw(. ..);
+BEGIN { require 'config.default.pl'; }
+BEGIN { require 'config.pl'; }
+
+sub info {
+    warn join(' ', @_);
+}
+
+
+sub serve_template {
+    my $template = Template->new({INCLUDE_PATH => 'template'});
+    my ($template_name, $data) = @_;
+
+    $template->process($template_name, $data)
+        or info("Template: " . $template->error());
+}
+
+# significant dirs only
+sub GN::directories {
+    my $root = $_[0];
+    opendir my $dir, $root or die "$root: $!";
+    my @directories;
+    my %drop = (
+        '.'  => 0,
+        '..' => 0,
+        );
+    foreach (readdir $dir) {
+        push(@directories, $_) if (-d join('/', $_[0], $_) && ($drop{$_} // 1));
+    }
+    closedir $dir;
+    return \@directories;
+}
+
+# probably should output all repos recursively, currently just outputs list of users
+sub GN::index { # /
+    my ($root) = @_;
+    my %data;
+
+    my @directories = map { my $i = $_; map { join('/', $i, $_) } @{GN::directories(join('/', $root, $i))} } @{GN::directories($root)};
+    $data{directories} = \@directories;
+    if ($data{directories}) { $data{found} = 1; }
+
+    serve_template("index.tt", \%data);
+}
+
+sub GN::user { # /$username/
+    my ($root, $username) = @_;
+
+    my %data;
+    my @directories = @{GN::directories(join('/', $root, $data{username}))};
+    $data{directories} = \@directories;
+    if ($data{directories}) { $data{found} = 1; }
+
+    serve_template("index_user.tt", \%data);
+}
+
+sub GN::repository { # /$username/$repository
+    my ($root, $username, $repository) = @_;
+
+    die 'not implemented';
+}
+
+my $root = GIT_ROOT;
+my $dbfile = DB_FILE;
+
+my %data = (
+    found => 0,
+);
+
+my %routes = (
+    '/'                   => sub { GN::index($root); },
+    '/~([\w.]+)'          => sub { GN::user($root, @_) },
+    '/~([\w.]+)/([\w.]+)' => sub { GN::repository($root, @_) },
+);
+my %route_regex_cache = map { $_ => qr{^$_$} } keys %routes;
+
+sub master {
+	my $cgi = CGI->new;
+	my %header = (
+		-Content_Type => 'text/html',
+		-charset      => 'UTF-8',
+		);
+	my $method = $ENV{'REQUEST_METHOD'} || '';
+	my $uri = $ENV{'REQUEST_URI'} || '/';
+
+	for my $pattern (keys %routes) {
+		if ($uri =~ $route_regex_cache{$pattern}) {
+			my $handler = $routes{$pattern};
+			$handler->($uri, $1, $2, $3);
+            return;
+		}
+	}
+
+	serve_template("404.tt", {}); # XXX missing code
+}
+
+master() if !caller;
+
+1;
diff --git a/perl/fcgi.pl b/perl/fcgi.pl
new file mode 100755
index 0000000..0f3dff8
--- /dev/null
+++ b/perl/fcgi.pl
@@ -0,0 +1,23 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Syntax::Keyword::Try;
+use FCGI;
+
+use lib qw(perl);
+BEGIN { require 'cgi.pl'; }
+
+while (1) {
+    try {
+        open STDERR, '>', LOG_FILE or die LOG_FILE . ": $!";
+        my $request = FCGI::Request( \*STDIN, \*STDOUT, \*STDERR, \%ENV, BARE_REQUEST ? 0 : FCGI::OpenSocket(SOCKET_FILE, SOCKET_MAX_CONNECTIONS));
+        while($request->Accept() >= 0) {
+            master();
+        }
+    } catch ($error) {
+        info("Crashed: $error");
+    }
+    exit 1 unless (IMMORTAL);
+}
-- 
cgit v1.2.3