#!/usr/bin/perl use strict; use warnings; use Email::MIME; use Fcntl qw(:flock); use File::Spec; use File::Find; use File::Path qw(make_path); use OpenBSD::Pledge; use OpenBSD::Unveil; use Time::HiRes qw(time); my $start_time = time(); # Load Crypt::OpenPGP and all Crypt:: sub-modules before unveil() BEGIN { require Crypt::OpenPGP; for my $inc_dir (@INC) { next unless -d $inc_dir; my $crypt_dir = File::Spec->catdir($inc_dir, 'Crypt'); next unless -d $crypt_dir; find(sub { return unless /\.pm$/; my $rel = File::Spec->abs2rel($File::Find::name, $inc_dir); $rel =~ s/\.pm$//; my $module = join('::', File::Spec->splitdir($rel)); eval "require $module;"; }, $crypt_dir); } # Trigger backend instantiation (Math::BigInt, AutoLoader, Ciphers) eval { my $pgp = Crypt::OpenPGP->new(); }; } my $base_dir = "/var/lex"; my $keyring_file = "$base_dir/pubring.gpg"; unveil("/dev/null", "rw") or die "unveil /dev/null failed: $!"; unveil($base_dir, "rwc") or die "unveil $base_dir failed: $!"; unveil() or die "unveil lock failed: $!"; pledge('stdio rpath wpath cpath flock') or die "pledge failed: $!"; my $dop = 5; my $log_file = "$base_dir/debug.log"; my $max_log_bytes = 1024 * 1024; # 1 MB cap sub log_msg { my ($msg) = @_; # Truncate if >$max_log_bytes 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: No keyring at $keyring_file"); return 0; } # Ensure CRLF line endings per OpenPGP canonical specification $signed_data =~ s/\r?\n/\r\n/g; my $pgp = Crypt::OpenPGP->new( PubRing => $keyring_file, ); unless ($pgp) { log_msg("ERROR: Failed to initialize PGP"); return 0; } my $verified = $pgp->verify( Data => $signed_data, Signature => $signature, ); return $verified ? 1 : 0; } sub acquire_lock { my ($max_slots) = @_; my $lock_dir = "$base_dir/locks"; unless (-d $lock_dir) { make_path($lock_dir) or do { log_msg("ERROR: Failed to create lock dir $lock_dir: $!"); return undef; }; } for my $i (1 .. $max_slots) { my $slot_file = "$lock_dir/slot_$i.lock"; my $fh; unless (open($fh, '>>', $slot_file)) { next; } if (flock($fh, LOCK_EX | LOCK_NB)) { return $fh; } close($fh); } return undef; # All slots full } my $lock_fh = acquire_lock($dop); unless ($lock_fh) { log_msg("WARN: Concurrency limit ($dop) reached. Dropping request."); respond_ok(); } 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: New request 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: No MIME message in payload"); 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 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: Message 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 $elapsed_ms = sprintf("%.2fms", (time() - $start_time) * 1000); my $msg_id = sprintf("msg_%.6f_$$", time()); my $content_length_kb = sprintf("%.2f KB", $content_length / 1024); log_msg("INFO: Processed $msg_id ($content_length_kb) in $elapsed_ms"); respond_ok();