diff options
Diffstat (limited to 'lex.cgi')
| -rwxr-xr-x | lex.cgi | 183 |
1 files changed, 138 insertions, 45 deletions
@@ -4,6 +4,7 @@ use strict; use warnings; use File::Path qw(make_path); use Time::HiRes qw(time); +use Email::MIME; use OpenBSD::Pledge; use OpenBSD::Unveil; @@ -12,64 +13,156 @@ unveil() or die "unveil lock failed: $!"; pledge('stdio rpath wpath cpath') or die "pledge failed: $!"; -my $content_type = $ENV{'CONTENT_TYPE'} || ''; -my $content_length = $ENV{'CONTENT_LENGTH'} // 0; +my $log_file = "/tmp/lex.log"; +my $max_log_bytes = 1024 * 1024; # 1 MB cap -if ($content_length > 0) { - binmode(STDIN); +sub log_msg { + my ($msg) = @_; - my $raw_data = ''; - read(STDIN, $raw_data, $content_length); + if (-e $log_file && -s $log_file >= $max_log_bytes) { + my $clrh; + if (open($clrh, '>', $log_file)) { + close($clrh); + } + } - # Extract boundary string from CONTENT_TYPE or raw payload - my $boundary; - if ($content_type =~ /boundary="?([^";\s]+)"?/i) { - $boundary = $1; - } elsif ($raw_data =~ /^--([^\r\n]+)/) { - $boundary = $1; + my $lh; + if (open($lh, '>>', $log_file)) { + my $timestamp = sprintf("%d", time()); + print $lh "[$timestamp] [$$] $msg\n"; + close($lh); } +} - my %params; - if ($boundary) { - my @parts = split(/--\Q$boundary\E(?:--)?\r?\n/, $raw_data); +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; +} - for my $part (@parts) { - next unless $part =~ /\S/; +my $content_type = $ENV{'CONTENT_TYPE'} // ''; +my $content_length = $ENV{'CONTENT_LENGTH'} // 0; - my ($header_block, $body_block) = split(/\r?\n\r?\n/, $part, 2); - next unless defined $header_block && defined $body_block; +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]"); - $body_block =~ s/\r?\n$//; +unless ($content_length > 0) { + log_msg("WARN: content_length is 0 or missing"); + respond_ok(); +} - if ($header_block =~ /Content-Disposition:[^\n]*?\bname="([^"]+)"/i) { - my $name = $1; - $params{$name} //= $body_block; - } - } - } +binmode(STDIN); +my $raw_data = ''; +read(STDIN, $raw_data, $content_length); - my $mail_body = $params{'stripped-text'} // $params{'body-plain'} // ''; +# Parse application/x-www-form-urlencoded payload +unless ($content_type =~ /application\/x-www-form-urlencoded/i) { + log_msg("WARN: Content-Type is not urlencoded: '$content_type'"); + respond_ok(); +} - if ($mail_body ne '') { - my $dir = "/tmp/lex"; - unless (-d $dir) { - make_path($dir); - } +my %params; +for my $pair (split(/&/, $raw_data)) { + my ($key, $val) = split(/=/, $pair, 2); + next unless defined $key; - my $msg_id = sprintf("msg_%.6f_$$", time()); - my $filename = "${dir}/${msg_id}.txt"; + $key =~ tr/+/ /; + $key =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/eg; - if (open(my $fh, '>', $filename)) { - print $fh $mail_body; - close($fh); - } else { - warn "Failed to write $filename: $!"; - } - } + $val //= ''; + $val =~ tr/+/ /; + $val =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/eg; + + $params{$key} //= $val; +} + +# Extract MIME message for PGP check +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; + +# Signed content + PGP signature must be present +unless (@parts >= 2) { + log_msg("WARN: MIME parts count < 2 (found " . scalar(@parts) . ")"); + respond_ok(); +} + +# Part 0: canonical signed content (headers + body) +my $signed_part = $parts[0]->as_string; + +# Normalize line endings to \r\n for canonical PGP verification +$signed_part =~ s/\r?\n/\r\n/g; + +# Part 1: detached PGP signature +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(); } -print "Status: 200 OK\r\n"; -print "Content-Type: text/plain; charset=utf-8\r\n\r\n"; -print "OK\n"; -exit 0; +my $dir = "/tmp/lex"; +unless (-d $dir) { + make_path($dir); +} + +my $msg_id = sprintf("msg_%.6f_$$", time()); +my $sig_file = "${dir}/${msg_id}.sig"; +my $mime_file = "${dir}/${msg_id}.mime"; + +# Write MIME file +my $mfh; +unless (open($mfh, '>:raw', $mime_file)) { + log_msg("ERROR: Failed to write $mime_file: $!"); + respond_ok(); +} +print $mfh $signed_part; +close($mfh); + +# Write sig file +my $sfh; +unless (open($sfh, '>:raw', $sig_file)) { + log_msg("ERROR: Failed to write $sig_file: $!"); + respond_ok(); +} +print $sfh $pgp_sig . "\r\n"; +close($sfh); + +# Extract body, strip signature block, leading and trailing whitespaces +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(); +} + +# Append plain text to queue file +my $queue_file = "/tmp/lex_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 $content_length_kb = sprintf("%.2f KB", $content_length / 1024); +log_msg("INFO: Processed $msg_id successfully ($content_length_kb)"); +respond_ok(); |