diff options
| -rw-r--r-- | mailer.pl | 152 |
1 files changed, 114 insertions, 38 deletions
@@ -4,6 +4,7 @@ use warnings; use utf8; use Time::Piece; use Sys::Syslog qw(:standard :macros); +use Socket qw(AF_UNIX SOCK_STREAM PF_UNSPEC); use OpenBSD::Pledge; use OpenBSD::Unveil; @@ -17,21 +18,11 @@ my $sendmail = '/usr/sbin/sendmail'; my $syslog_tag = 'lex-mail'; my $max_interval = 365; # Upper bound limit (1 year) +my $timeout_sec = 30; # Execution timeout for child/sendmail -# Connect to /dev/log before pledge/unveil so no late 'unix' -# socket creation occurs +# Connect to syslog before pledge/unveil openlog($syslog_tag, 'ndelay,pid', LOG_MAIL); -unveil($dict_dir, 'r') or log_die("unveil $dict_dir: $!"); -unveil($state_file, 'rwc') or log_die("unveil $state_file: $!"); -unveil($sendmail, 'rx') or log_die("unveil $sendmail: $!"); -unveil('/etc/mailer.conf', 'r') or log_die("unveil /etc/mailer.conf: $!"); -unveil('/var/run/smtpd.sock', 'rw') or log_die("unveil smtpd.sock: $!"); -unveil('/dev/log', 'w') or log_die("unveil /dev/log: $!"); # Writing to pre-opened socket handle -unveil(); # Lock unveil rules - -pledge(qw(stdio rpath wpath cpath proc exec)) or log_die("pledge: $!"); - sub log_die { my ($msg) = @_; syslog(LOG_ERR, "%s", $msg); @@ -39,6 +30,62 @@ sub log_die { die $msg; } +# Socket pair for parent/child IPC +socketpair(my $parent_sock, my $child_sock, AF_UNIX, SOCK_STREAM, PF_UNSPEC) + or log_die("socketpair failed: $!"); + +my $pid = fork(); +log_die("fork failed: $!") unless defined $pid; + +if ($pid == 0) { + # Child process for handling mail pipe + close($parent_sock); + + # 'exec' no longer exposed to parent proc + pledge(qw(stdio proc exec)) or die "child pledge failed"; + + # Read email message from socket + my $raw_email; + { + local $/; + $raw_email = <$child_sock>; + } + close($child_sock); + + if (!$raw_email) { + exit 0; # Parent aborted or sent no mail + } + + open(my $mail_pipe, '|-', $sendmail, '-i', '-f', $from, $to) + or die "child failed to exec $sendmail: $!"; + + binmode($mail_pipe, ':utf8'); + print $mail_pipe $raw_email; + + if (!close($mail_pipe)) { + my $status = $?; + my $exit_val = $status >> 8; + my $sig_num = $status & 127; + if ($sig_num) { + die "sendmail killed by signal $sig_num"; + } + die "sendmail exited with status $exit_val"; + } + + exit 0; +} + +# Parent process: spaced-repetition + fair scheduling +close($child_sock); + +unveil($dict_dir, 'r') or log_die("unveil $dict_dir: $!"); +unveil($state_file, 'rwc') or log_die("unveil $state_file: $!"); +unveil('/dev/log', 'w') or log_die("unveil /dev/log: $!"); +unveil(); # Lock unveil rules + +# Main process drops 'exec' +pledge(qw(stdio rpath wpath cpath proc)) or log_die("parent pledge: $!"); + # Read dictionary files my $dh; if (!opendir($dh, $dict_dir)) { @@ -49,7 +96,6 @@ closedir($dh); if (!@current_files) { syslog(LOG_WARNING, "No files found in %s", $dict_dir); - # Truncate state file if it exists if (-f $state_file) { if (open(my $clear_fh, '>', $state_file)) { close($clear_fh); @@ -57,7 +103,8 @@ if (!@current_files) { syslog(LOG_ERR, "Failed to clear %s: %s", $state_file, $!); } } - + close($parent_sock); + waitpid($pid, 0); closelog(); exit 0; } @@ -88,7 +135,7 @@ if (-f $state_file) { close($sfh); } -# Initialize new files not yet in tsv +# Initialize new files foreach my $file (@current_files) { if (!$state{$file}) { $state{$file} = { @@ -100,24 +147,24 @@ foreach my $file (@current_files) { } } -# Select candidate file (spaced repetition + fair scheduling) +# Candidate selection (spaced repetition + fair scheduling) my @due_files = grep { $state{$_}{next_due} le $today } @current_files; my $selected_file; if (@due_files == 1) { $selected_file = $due_files[0]; } elsif (@due_files > 1) { - # Weighted random choice: files with fewer reviews get higher probability weights my %weights; my $total_weight = 0; foreach my $file (@due_files) { - # Inversely proportional weight (1 / (reviews + 1)) my $w = 1.0 / ($state{$file}{reviews} + 1); $weights{$file} = $w; $total_weight += $w; } + # Weighted random selection (roulette wheel algorithm) + # Higher weight = larger target segment = higher probability of selection my $rand_point = rand($total_weight); my $accum = 0; foreach my $file (@due_files) { @@ -127,41 +174,71 @@ if (@due_files == 1) { last; } } - $selected_file //= $due_files[-1]; # Fallback + + # Guard against IEEE 754 floating-point rounding edge cases at boundary + $selected_file //= $due_files[-1]; } else { @current_files = sort { $state{$a}{next_due} cmp $state{$b}{next_due} } @current_files; $selected_file = $current_files[0]; syslog(LOG_INFO, "No files due today; falling back to nearest due file: %s", $selected_file); } -# Read content +# Read candidate file content my $file_path = "$dict_dir/$selected_file"; my $fh; if (!open($fh, '<:utf8', $file_path)) { log_die("Cannot open $file_path: $!"); } -local $/; # slurp mode -my $body = <$fh>; +my $body; +{ + local $/; # slurp mode + $body = <$fh>; +} close($fh); -# Send email via direct pipe -my $mail_pipe; -if (!open($mail_pipe, '|-', $sendmail, '-i', '-f', $from, $to)) { - log_die("Cannot execute $sendmail: $!"); +# Construct payload and send to helper process over socket +my $email_data = "From: $from_header\n" + . "To: $to\n" + . "Subject: $subject - $selected_file\n" + . "Content-Type: text/plain; charset=UTF-8\n\n" + . $body; + +binmode($parent_sock, ':utf8'); +print $parent_sock $email_data; +close($parent_sock); + +# Wait for child execution to complete +eval { + local $SIG{ALRM} = sub { die "TIMEOUT\n" }; + alarm($timeout_sec); + + waitpid($pid, 0); + + alarm(0); +}; + +if ($@) { + if ($@ eq "TIMEOUT\n") { + kill('KILL', $pid); + log_die("Mailer child process timed out after ${timeout_sec}s"); + } else { + log_die("Error waiting for mailer child process: $@"); + } } -binmode($mail_pipe, ':utf8'); -print $mail_pipe "From: $from_header\n"; -print $mail_pipe "To: $to\n"; -print $mail_pipe "Subject: $subject - $selected_file\n"; -print $mail_pipe "Content-Type: text/plain; charset=UTF-8\n\n"; -print $mail_pipe $body; +if ($? != 0) { + my $status = $?; + my $exit_val = $status >> 8; + my $sig_num = $status & 127; -if (!close($mail_pipe)) { - log_die("Error closing pipe to sendmail: $!"); + if ($sig_num) { + log_die("Mailer child process killed by signal $sig_num"); + } else { + log_die("Mailer child process exited with status $exit_val"); + } } -# Update schedule +# Update schedule state my $item = $state{$selected_file}; my $interval = $item->{interval}; my $factor = $item->{factor}; @@ -174,7 +251,6 @@ if ($item->{reviews} == 0) { $interval = int($interval * $factor); } -# Cap interval if ($interval > $max_interval) { $interval = $max_interval; } @@ -185,12 +261,12 @@ $item->{reviews} += 1; my $now = localtime; $item->{next_due} = ($now + ($interval * 86400))->ymd; -# Toss deleted files from the tsv. +# Cleanup deleted items foreach my $file (keys %state) { delete $state{$file} unless $active_files{$file}; } -# Atomic write using a temporary state file +# Atomic write update my $tmp_file = "$state_file.tmp"; my $out_fh; if (!open($out_fh, '>', $tmp_file)) { |