path: root/lex.cgi

#!/usr/bin/perl

use strict;
use warnings;
use File::Path qw(make_path);
use Time::HiRes qw(time);
use Email::MIME;
use OpenBSD::Pledge;
use OpenBSD::Unveil;

my $base_dir = "/var/lex";
my $keyring_file = "$base_dir/pubring.gpg";

unveil("/usr/local/bin/gpg", "rx") or die "unveil gpg failed: $!";
unveil("/dev/null", "rw")            or die "unveil /dev/null failed: $!";
unveil("/tmp", "rwc")                or die "unveil /tmp failed: $!";
unveil($base_dir, "rwc")            or die "unveil $base_dir failed: $!";
unveil()                            or die "unveil lock failed: $!";

pledge('stdio rpath wpath cpath proc exec') or die "pledge failed: $!";

my $log_file = "$base_dir/debug.log";
my $max_log_bytes = 1024 * 1024; # 1 MB cap

sub log_msg {
	my ($msg) = @_;

	if (-e $log_file && -s $log_file >= $max_log_bytes) {
		my $clrh;
		if (open($clrh, '>', $log_file)) {
			close($clrh);
		}
	}

	my $lh;
	if (open($lh, '>>', $log_file)) {
		my $tz_offset = 8 * 3600;
		my ($sec, $min, $hour, $mday, $mon, $year) = gmtime(time() + $tz_offset);

		my $timestamp = sprintf(
			"%04d-%02d-%02d %02d:%02d:%02d",
			$year + 1900, $mon + 1, $mday, $hour, $min, $sec
		);
		print $lh "[$timestamp] [$$] $msg\n";
		close($lh);
	}
}

sub respond_ok {
	print "Status: 200 OK\r\n";
	print "Content-Type: text/plain; charset=utf-8\r\n\r\n";
	print "OK\n";
	exit 0;
}

sub verify_pgp_signature {
	my ($signed_data, $signature) = @_;

	unless (-f $keyring_file) {
		log_msg("ERROR: Keyring missing at $keyring_file");
		return 0;
	}

	my $tmp_dir = "/tmp/lex";
	unless (-d $tmp_dir) {
		make_path($tmp_dir);
	}

	my $msg_id   = sprintf("msg_%.6f_$$", time());
	my $tmp_data = "${tmp_dir}/${msg_id}.mime";
	my $tmp_sig  = "${tmp_dir}/${msg_id}.sig";

	# Ensure CRLF line endings on the signed data block
	$signed_data =~ s/\r?\n/\r\n/g;

	my $dh;
	unless (open($dh, '>:raw', $tmp_data)) {
		log_msg("ERROR: Could not create temp data file: $!");
		return 0;
	}
	print $dh $signed_data;
	close($dh);

	# Write sig file with trailing CRLF
	my $sh;
	unless (open($sh, '>:raw', $tmp_sig)) {
		log_msg("ERROR: Could not create temp sig file: $!");
		unlink($tmp_data);
		return 0;
	}
	print $sh $signature . "\r\n";
	close($sh);

	my $pipe;
	my $gpg_output = "";
	my $pid = open($pipe, "-|") // die "Cannot fork: $!";

	if ($pid == 0) {
		open(STDERR, '>&', STDOUT);
		exec(
			'/usr/local/bin/gpg',
			'--batch',
			'--no-default-keyring',
			'--keyring', $keyring_file,
			'--trust-model', 'always',
			'--verify',
			$tmp_sig,
			$tmp_data
		) or exit(127);
	}

	while (my $line = <$pipe>) {
		$gpg_output .= $line;
	}
	close($pipe);
	my $exit_code = $? >> 8;

	unlink($tmp_data, $tmp_sig);

	if ($exit_code == 0) {
		return 1;
	} else {
		$gpg_output =~ s/\r?\n/ /g;
		log_msg("DEBUG: gpg output: $gpg_output");
		log_msg("DEBUG: gpg exited with code $exit_code");
		return 0;
	}
}

my $content_type   = $ENV{'CONTENT_TYPE'} // '';
my $content_length = $ENV{'CONTENT_LENGTH'} // 0;

my $remote_ip  = $ENV{'REMOTE_ADDR'} // 'unknown';
my $user_agent = $ENV{'HTTP_USER_AGENT'} // 'unknown';
log_msg("INFO: Request received from $remote_ip [$user_agent]");

unless ($content_length > 0) {
	log_msg("WARN: content_length is 0 or missing");
	respond_ok();
}

binmode(STDIN);
my $raw_data = '';
read(STDIN, $raw_data, $content_length);

unless ($content_type =~ /application\/x-www-form-urlencoded/i) {
	log_msg("WARN: Content-Type is not urlencoded: '$content_type'");
	respond_ok();
}

my %params;
for my $pair (split(/&/, $raw_data)) {
	my ($key, $val) = split(/=/, $pair, 2);
	next unless defined $key;

	$key =~ tr/+/ /;
	$key =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/eg;

	$val //= '';
	$val =~ tr/+/ /;
	$val =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/eg;

	$params{$key} //= $val;
}

my $mime_raw = $params{'body-mime'} // '';
if ($mime_raw eq '') {
	log_msg("WARN: 'body-mime' parameter is empty or missing");
	respond_ok();
}

# Parse MIME message
my $parsed = Email::MIME->new($mime_raw);
my @parts  = $parsed->parts;

unless (@parts >= 2) {
	log_msg("WARN: MIME parts count < 2 (found " . scalar(@parts) . ")");
	respond_ok();
}

# Extract canonical signed part directly (Part 0 string representation)
my $signed_part = $parts[0]->as_string;

# Extract PGP signature block
my $sig_part_raw = $parts[1]->body_raw // '';
my ($pgp_sig)    = $sig_part_raw =~ /(-----BEGIN PGP SIGNATURE-----[\s\S]*?-----END PGP SIGNATURE-----)/;

unless ($pgp_sig) {
	my $sig_part_str = $parts[1]->body_str // '';
	($pgp_sig) = $sig_part_str =~ /(-----BEGIN PGP SIGNATURE-----[\s\S]*?-----END PGP SIGNATURE-----)/;
}

unless (length($signed_part) > 0 && $pgp_sig) {
	log_msg("WARN: Missing signed_part content or PGP signature block");
	respond_ok();
}

unless (verify_pgp_signature($signed_part, $pgp_sig)) {
	log_msg("WARN: PGP signature verification failed");
	respond_ok();
}

my $plain_text = $parts[0]->body_str // '';
$plain_text =~ s/\r\n/\n/g;
$plain_text =~ s/\n-- \n.*$//s;
$plain_text =~ s/^\s+|\s+$//g;

unless (length($plain_text) > 0) {
	log_msg("WARN: Extracted plain_text is empty after stripping");
	respond_ok();
}

my $queue_file = "$base_dir/queue.txt";
my $qfh;
unless (open($qfh, '>>:utf8', $queue_file)) {
	log_msg("ERROR: Failed to append to $queue_file: $!");
	respond_ok();
}
print $qfh $plain_text . "\n";
close($qfh);

my $msg_id            = sprintf("msg_%.6f_$$", time());
my $content_length_kb = sprintf("%.2f KB", $content_length / 1024);
log_msg("INFO: Processed $msg_id successfully ($content_length_kb)");
respond_ok();