mailpostgw.in

#!/usr/bin/perl -T
# vi: set sw=3 ai sm:
=encoding UTF-8

=head1 Name

mailpostgw - mailpost gateway

=head1 Synopsis

B<mailpostgw>
[ B<-k> ]
[ B<-n> ]
[ B<-v> ]
[ B<--data-from=>I<file> ]
[ B<--debug> ]
[ B<--keep-going> ]
[ B<--dry-run> ]
[ B<--preserve-uid> ]
[ B<--tag=>I<tag> ]
[ B<--verbose> ]

B<mailpostgw> B<--help>

B<mailpostgw> B<--version>
=cut
# Copyright ©2020 by Ambrose Li <ambrose.li@gmail.com>

use strict;
use integer;

use Getopt::Long qw(:config no_auto_abbrev bundling no_ignore_case);
use Data::Dumper;
use POSIX;

use v5.14; # //u modifier
use utf8;
use open qw( :encoding(UTF-8) :std );
use charnames qw( :full :short );
use feature "unicode_strings";

use vars qw( $mailpost $newsuser );
$mailpost = '@@MAILPOST@@';
$newsuser = '@@NEWSUSER@@';

use vars qw( $mailing_list_definition_file );
$mailing_list_definition_file = '@@INPUT@@';

use vars qw( $appName $id );
use vars qw( $tag );
use vars qw( $tag2 );
use vars qw( $status );
use vars qw( %localgroups $lists );

use vars qw( @useless_tags );
@useless_tags = ('*****SPAM*****', '[BULK]');

use vars qw( @original_argv );
@original_argv = map { $1 if /^(.*)$/ } @ARGV; # untaint

$ENV{'PATH'} = '/bin:/usr/bin:/sbin:/usr/sbin:/usr/local/bin:/usr/local/sbin';

$appName = $& if $0 =~ /[^\/]+$/;

use vars qw( $debug_p $dry_run_p );
use vars qw( $force_delete_p );
use vars qw( $keep_going_p );
use vars qw( $preserve_uid_p );
use vars qw( $verbose_p );

$SIG{__DIE__} = sub {
};

sub show_version_then_exit () {
   print "$appName 0.1\n";
   exit(0);
}

sub show_usage_then_exit (;$) {
   my($status) = @_;
   my($default_inject, $summary);
   my $h = $status? *STDERR: *STDOUT;
   $summary = "Inject mail into news system if it came from a recognized mailing list";
   print $h <<EOF;
usage: $appName [OPTION] ...
$summary.

      --data-from=FILE  use mailing list definitions (lists.dat) from FILE
  -d, --debug           enable debugging messages
  -k, --keep-going      always keep reading until eof (INTERNAL USE ONLY)
  -n, --dry-run         do not actually modify the outbox
      --preserve-uid    do not sudo to $newsuser (TESTING USE ONLY)
      --tag=TAG         tag debug messages with given TAG (INTERNAL USE ONLY)
  -v, --verbose         explain what is being done
      --help            show this help and exit
      --version         output version information and exit

Report bugs to <https://github.com/acli/stupidweasel/issues>.
EOF
   exit($status);
}

sub debug_message ($) {
   my($msg) = @_;
   my $prefix = "$appName: ";
   $prefix .= "$tag: " if defined $tag;
   $prefix .= "$tag2: " if defined $tag2;
   chomp $msg;
   print STDERR "$prefix$msg\n";
   flush STDERR;
}

sub check_for_correct_user () {
   my $correct_uid = (getpwnam($newsuser))[2];
   debug_message "DEBUG: current uid is $<, euid $>; expecting uid $correct_uid" if $debug_p;
   if ($> != $correct_uid && !$preserve_uid_p) {
      my $flag = 'MAILPOSTGW_WAS_HERE';
      die "$appName: Failed to switch uid to $newsuser\n" if defined $ENV{$flag};
      $ENV{$flag} = '1';
      my $self = $1 if $0 =~ /^(.*)$/; # untaint
      my @cmd = ('@@SUDO@@', '-n', '-u', $newsuser, '--', $self);
      push @cmd, '-v' if $verbose_p; # from config file, maybe
      push @cmd, @original_argv;
      debug_message sprintf 'Executing command: %s', join(' ', @cmd) if $debug_p || $verbose_p;
      flush STDERR;
      exec { $cmd[0] } @cmd;
      die "$appName: $cmd[0]: $!\n";
   }
}

## BEGIN: STOLEN STUFF FROM STUPIDWEASEL ################################################

sub read_data (;*) {
   my($h) = @_;
   my $it;
   my $section;
   my $state = 0;
   for (;;) {
      my $s = scalar <$h>;
   last unless defined $s;
      chomp $s;
      if ($s =~ /^\s*(?:\s*$|#|;|\/\/)/) {
         ;
      } elsif ($s =~ /^\s*\[(.*?)\]\s*$/) {
         die "$appName: $ARGV:$.: $1: duplicate section\n" if defined $it && defined $it->{$1};
         $section = $1;
      } elsif ($s =~ /^\s*([^=]+?)\s*=\s*(.*?)\s*$/) {
         $it->{$section} = { 'name' => [$section] } unless defined $it && defined $it->{$section};
         $it->{$section}->{$1} = [] unless defined $it->{$section}->{$1};
         push @{$it->{$section}->{$1}}, $2;
      } else {
         die "$appName: $ARGV:$.: sorry, can't parse ($s)\n";
      }
   }
   return $it;
}

sub get_scalar ($$) {
   my($key, $datum) = @_;
   return !(defined $datum && defined $datum->{$key} && defined $datum->{$key}->[0])? undef: $datum->{$key}->[0];
}

sub get_array ($$) {
   my($key, $datum) = @_;
   return !(defined $datum && defined $datum->{$key})? undef: $datum->{$key};
}

sub looks_like_email_address_p {
   my $it = 1; # assume it's true then disprove it
   for my $s (@_) {
      $it = 0 unless $s =~ /^[^\@]+\@[a-z][-0-9a-z]*(?:\.[a-z][-0-9a-z]*)+$/;
   last unless $it;
   }
   return $it;
}
for my $test (qw( abc@example.com abc.def@u-example.de abc.def-ghi@ocad.on.ca )) {
   die "Test case $test failed" unless looks_like_email_address_p $test;
}
for my $test (qw( abc@ @u-example.de @ foo )) {
   die "Test case $test failed" unless !looks_like_email_address_p $test;
}

sub scan_mbox_file ($$$$$) {
   my($filename, $f_from_, $f_header, $f_sep, $f_body) = @_;
   my $state = 0;			# State 0 - From_ or header; 1 - header, separator; 3 - body
   my($from_, @headers);
   my $h;
   if (!$filename || $filename eq '-') {
      ($filename, $h) = ('STDIN', *STDIN);
   } else {
      open MBOX, '<', $filename || die "$filename: $!\n";
      $h = *MBOX;
   }
   for (my $in_body_p = 0;;) {
      my $s = scalar <$h>;
   last unless defined $s;
      if ($state == 0 && $s =~ /^From /s) {
	 $from_ = [$s, $.];
	 $state = 1;
      } elsif ($state <= 1) {
	 $state = 1;
	 if ($s eq "\n") {
	    &$f_from_($from_->[0], $filename, $from_->[1]) if defined $from_ && defined $f_from_;
	    for my $header (@headers) {
	       &$f_header($header->[0], $filename, $header->[1]) if defined $f_header;
	    }
	    &$f_sep($s, $filename, $.) if defined $f_sep;
	    $state = 3;
	 } elsif ($s =~ /^\s/s) {
	    die "$filename: $.: Illegal continuation header \"$s\"\n" unless @headers;
	    $headers[$#headers]->[0] .= $s;
	 } elsif ($s !~ /:/s) {
	    die "$filename: $.: Malformed header, no colon\n";
	 } else {
	    push @headers, [$s, $.];
	 }
      } elsif ($state == 3) {
	 &$f_body($s, $filename, $.) if defined $f_body;
      } else {
	 die "$filename: $.: Internal error: Unexpected state $state\n";
      }
   }
   close MBOX;
}

## END OF STOLEN STUFF ################################################

sub read_config_file () {
   my $input = $mailing_list_definition_file;
   debug_message "Reading configuration fro $input" if $debug_p || $verbose_p;
   open INPUT, '<', $input || die "$input: $!\n";
   $lists = read_data INPUT;
   close INPUT;
}

sub extract_possible_email_address_from ($) {
   my($det) = @_;
   $det = $1 if $det =~ /^.*<([^<>]*)>/is || $det =~ /^(\S+?)\s*\(.*?\)\s*$/is || $det =~ /^(\S+)\s*$/is;
   return $det;
}

sub known_mailing_lists_for ($) {
   my($det) = @_;
   my %newsgroups;
   debug_message "DEBUG: candidate email ($det)" if $debug_p;
   for my $section (keys %$lists) {
      if ($section ne '') {
	 my $list = $lists->{$section};
	 for my $chk (($list->{'address'}? @{$list->{'address'}}: ()), ($list->{'id'})? @{$list->{'id'}}: ()) {
	    if (lc $det eq lc $chk) {
	       debug_message "DEBUG: $det matches $chk" if $debug_p;
	       for my $groups (get_array('localgroup', $list)) {
		  for my $group (@$groups) {
		     $newsgroups{$group} = { 'list' => $list };
		  }
	       }
	    }
	 }
      }
   }
   return %newsgroups;
}

sub determine_newsgroups_from_header_hash ($) {
   my($headers) = @_;
   my %newsgroups;
   my $subject = get_scalar('subject', $headers);
   for my $candidate ('from', 'to', 'cc', 'delivered-to', 'mailing-list', 'list-id') {
      my $candidates = get_array($candidate, $headers);
      if (defined $candidates) {
	 for my $det (@$candidates) {
	    my %det = known_mailing_lists_for(extract_possible_email_address_from($det));
	    for my $group (keys %det) {
	       my $ok_p;
	       my $select_subject = get_array('select subject', $det{$group}->{'list'});
	       if ($select_subject) {
		  $ok_p = 0;
		  for my $filter (@$select_subject) {
		     $ok_p = 1 if $subject =~ $filter;
		     debug_message "DEBUG: $group: subject filter /$filter/ on ($subject) -> $ok_p" if $debug_p;
		  last if $ok_p;
		  }
	       } else {
		  debug_message "DEBUG: ok, no subject filter for $group" if $debug_p;
		  $ok_p = 1;
	       }
	       $newsgroups{$group} = $det{$group} if $ok_p;
	    }
	 }
      }
   }
   if (!%newsgroups && (defined $headers->{'list-id'} || defined $headers->{'list-unsubscribe'})) {
      my $junk = get_scalar('junk', $lists->{''});
      $junk = 'junk' unless defined $junk;
      $newsgroups{$junk} = { 'list' => $lists->{''} };
      debug_message "DEBUG: no lists recognized but List-Id or List-Unsubscribe header found, putting in $junk" if $debug_p;
   }
   debug_message sprintf "DEBUG: newsgroups: %s", join(', ', sort keys %newsgroups) if $debug_p;
   return %newsgroups;
}

sub post_article_and_leave_OUTPUT_open ($$$$) {
   my($newsgroups, $headers, $sep, $body) = @_;
   my @cmdline = (
	    $mailpost,
	       '-d', 'local',
	       sort keys %$newsgroups
	 );

   if ($dry_run_p) {
      debug_message sprintf 'Pretending to execute command: %s', join(' ', @cmdline) if $debug_p || $verbose_p;
      open(OUTPUT, ($debug_p > 1? '>&STDERR': '>/dev/null'));
   } else {
      debug_message sprintf 'Executing command: %s', join(' ', @cmdline) if $debug_p || $verbose_p;
      flush STDERR;
      my $st = open(OUTPUT, '|-');
      die "$appName: $mailpost: fork: $!\n" unless defined $st;
      if (!$st) {
	 exec { $cmdline[0] } @cmdline;
	 die "$appName: $mailpost: exec: $!\n";
      }
   }
   if (defined $headers) {
      for my $header (@$headers) {
	 print OUTPUT $header;
      }
   }
   if (defined $sep) {
      for my $s (@$sep) {
	 print OUTPUT $s;
      }
   }
   if (defined $body) {
      for my $s (@$body) {
	 print OUTPUT $s;
      }
   }
}

sub newsgroups_list_is_the_blackhole_p ($) {
   my($newsgroups) = @_;
   return defined $newsgroups && keys %$newsgroups == 1 && (keys %$newsgroups)[0] eq '/dev/null';
}

sub decode_qp ($) {
   my($s) = @_;
   $s =~ s{_}{ }gs;
   $s =~ s{=([0-9a-f][0-9a-f])}{ chr(hex($1)) }egis;
   return $s;
}

sub strip_carriage_return_from ($) {
   my($s) = @_;
   $s = "$1$2" if $s =~ /^(.*?)\r(\n)$/s;
   return $s;
}

sub sanitize_header ($) {
   my($s0) = @_;
   my $s;
   # If we get ?us-ascii?q? or ?utf-8?q? but everything inside is just ASCII, just decode it and replace with bare ASCII
   # because while trn(1) knows how to decode these, nn(1) doesn't so nn output looks like crap.
   for (; $s0;) {
      if ($s0 =~ /^(.*?)(=\?([a-z][-0-9a-z]+)\?q\?([^\?]*)\?=)(.*)$/is) {
	 my($before, $item, $encoding, $encoded, $after) = ($1, $2, $3, $4, $5);
	 my $decoded = decode_qp $encoded;
	 if ($decoded =~ /^[\040-\176]*$/s && $decoded !~ /(?:"|\?=)/s) {
	    $s .= $before . $decoded;
	    $s0 = $after;
	    debug_message "replacing ($item) with ($decoded)" if $debug_p > 2;
	 } else {
	    $s .= $before . $item;
	    $s0 = $after;
	 }
      } else {
	 $s .= $s0;
	 undef $s0;
      }
   }
   return $s;
}

sub inject_header ($$$;$) {
   my($s, $headers, $header_dict, $announce_p) = @_; # $s, \@headers, \%headers
   if ($s =~ /^([^:]+)\s*:\s*(.*?)\s*$/s) {
      my($key, $val) = ($1, sanitize_header $2);
      if ($key =~ /^(?:Status$|X-Evolution-)/i) {
	 debug_message "DEBUG: Discarding meaningless header $s" if $debug_p > 1;
	 undef $s;
      } elsif ($key =~ /^(?:(?:ARC|X-BHAM-STAMP|DKIM|X-CHCH|X-IPAS|Iron[Pp]ort|X-Iron[Pp]ort)-)/
	    || $key =~ /^(?:X-CHA)$/
	    || $key =~ /^(?:X-Google-DKIM-Signature|Received-SPF)$/) {

	 debug_message "DEBUG: Discarding unwanted header $s" if $debug_p > 1;
	 undef $s;
      } elsif ($val) {
	 push @$headers, "$key: $val\n";
	 push @{$header_dict->{+lc $key}}, $val;
	 debug_message "DEBUG: Injecting $s" if $announce_p && $debug_p;
      } else {
	 debug_message "Discarding $key header with no value" if $debug_p;
	 undef $s;
      }
   } else {
      debug_message "INTERNAL ERROR: Received invalid header \"$s\" from scan_mbox_file" if $debug_p;
      undef $s;
   }
   return $s;
}

sub inject_organization_header_if_not_present ($$$) {
   my($newsgroups, $headers, $header_dict) = @_; # \%newsgroups, \@headers, \%headers
   my $it;
   if (!defined $header_dict->{'organization'}) {
      my $organization = get_scalar('organization', $newsgroups->{+(keys(%$newsgroups))[0]}->{'list'});
      $it = inject_header sprintf("Organization: %s\n", ($organization || 'Unknown')), $headers, $header_dict, 1;
   }
   return $it;
}

sub remove_header ($$$) {
   my($key, $headers, $header_dict) = @_; # $key, \@headers, \%headers
   my $re = sprintf('^%s:', quotemeta($key));
   my $n;
   for (my $j = scalar(@$headers); $j; $j -= 1) {
      my $i = $j - 1;
      if ($headers->[$i] =~ /$re/) {
	 splice @$headers, $i, 1;
	 $n += 1;
      }
   }
   delete $header_dict->{$key};
   debug_message "$n \"$key\" header(s) removed" if $debug_p;
}

sub remove_tag_from_subject_header ($$$) {
   my($newsgroups, $headers, $header_dict) = @_; # \%newsgroups, \@headers, \%headers
   my $it;
   my $subject = get_scalar('subject', $header_dict);
   my $tags = get_array('tag', $newsgroups->{+(keys(%$newsgroups))[0]}->{'list'});
   $tags = [] unless defined $tags; # force @useless_tags processing
   if ($subject && $tags) {
      for my $tag (@useless_tags, @$tags) {
	 my $re = quotemeta($tag) . '\s+';
	 $subject =~ s/$re//gs;
      }
      remove_header('Subject', $headers, $header_dict);
      $it = inject_header "Subject: $subject\n", $headers, $header_dict, 1;
   }
   return $it;
}

sub look_at_stdin () {
   my(@headers, %headers);
   my %newsgroups;
   my $blackhole_p;
   my($multipart_mixed_p, $boundary, @preamble, @mime_parts, $hold_p, $digest_p);
   my($L2_state, $L2_headers, $L2_number);
   my($L3_state, $L3_headers, @L3_headers, $L3_partial_header);
   scan_mbox_file('-',
	 # From_
	 undef,

	 # headers
	 sub {
	    my($s, $filename, $lineno) = @_;
	    $s = strip_carriage_return_from $s;
	    inject_header($s, \@headers, \%headers);

	 # separator
	 }, sub {
	    my($s, $filename, $lineno) = @_;
	    $s = strip_carriage_return_from $s;

	    # Figure out if this came from some mailing list
	    %newsgroups = determine_newsgroups_from_header_hash \%headers;
	    if (%newsgroups && !newsgroups_list_is_the_blackhole_p(\%newsgroups)) {
	       # If it didn't come with an Organization header fabricate a reasonable one because having ours in the post makes no sense.
	       inject_organization_header_if_not_present(\%newsgroups, \@headers, \%headers);

	       # If the mailing list uses a tag in the subject header, remove it
	       remove_tag_from_subject_header(\%newsgroups, \@headers, \%headers);

	       # Post the article unless it MIGHT be a MIME digest
	       if (get_scalar('mime-version', \%headers) eq '1.0'
			&& get_scalar('content-type', \%headers) =~ /^multipart\/mixed;.*?\bboundary=(["'])?([^\1]+)\1/is) {

		  ($hold_p, $multipart_mixed_p, $boundary) = (1, 1, $2);
		  debug_message "Delaying article post due to detected multipart/mixed, boundary $boundary" if $debug_p || $verbose_p;
	       } else {
		  post_article_and_leave_OUTPUT_open(\%newsgroups, \@headers, [$s], undef);
	       }
	    } else {
	       debug_message sprintf 'No mailing list detected in input, %s.', ($keep_going_p? 'discarding rest': 'terminating') if $debug_p || $verbose_p;
	       exit unless $keep_going_p;
	       $blackhole_p = 1
	    }

	 # body
	 }, sub {
	    my($s, $filename, $lineno) = @_;
	    $s = strip_carriage_return_from $s;
	    if ($blackhole_p) {
	       ;
	    } elsif (!$hold_p && !$digest_p) {
	       print OUTPUT $s;
	    } else {
	       if ($L2_state == 0) { # preamble before blank line
		  push @preamble, $s;
		  $L2_state = 1 if $s =~ /^\r?\n$/s;
	       } elsif ($L2_state == 1) { # preamble after blank line
		  push @preamble, $s;
		  if ($s =~ /^--$boundary\r?\n$/s) {
		     $L2_state = 2;
		     $L2_headers = {}; push @mime_parts, {'headers' => [], 'sep' => [], 'body' => []}; # create blank attachment
		     debug_message sprintf 'DEBUG: attachment %d', scalar @mime_parts if $debug_p;
		  } elsif ($s =~ /^--$boundary--\r?\n$/s) {
		     $hold_p = 0;
		  }
	       } elsif ($L2_state == 2) { # attachment header
		  my $this_part = $mime_parts[$#mime_parts];
		  if ($s =~ /^\r?\n$/s) {
		     push @{$this_part->{'sep'}}, $s;
		     $L2_state = 3;

		     # If we're in digest mode already, check if the attachment is message/rfc822
		     if ($digest_p) {
			my $type = lc $1 if get_scalar('content-type', $L2_headers) =~ /^([^;\s]+)/;
			if ($type eq 'message/rfc822') {
			   debug_message sprintf 'DEBUG: posting attachment %d', scalar @mime_parts if $debug_p;
			   $L2_number += 1;
			   $tag2 = "post $L2_number";
			   ($L3_state, $L3_headers, $L3_partial_header, @L3_headers) = (0, {});
			} else {
			   debug_message sprintf "DEBUG: ignoring attachment %d of wrong type %s", scalar @mime_parts, $type if $debug_p;
			   undef $tag2;
			}

		     # Otherwise check if this attachment is a MIME digest, in which case we activate digest mode
		     } else {
			my $L2_boundary = $2 if get_scalar('content-type', $L2_headers) =~ /^multipart\/digest\s*;.*?\bboundary=(["'])?([^\1]+)\1/is;
			if ($L2_boundary) {
			   debug_message sprintf "DEBUG: resetting MIME state because found MIME digest, boundary $L2_boundary" if $debug_p;
			   ($L2_state, $digest_p, $boundary) = (4, 1, $L2_boundary);
			}
		     }
		  } else {
		     inject_header($s, $this_part->{'headers'}, $L2_headers);
		  }
	       } elsif ($L2_state == 3) { # attachment body
		  if ($digest_p) {
		     if ($s =~ /^--$boundary(?:--)?\r?\n$/s) {
			;
		     } else {
			if ($L3_state == 0) {			# L3 header or sep
			   if ($s =~ /^\r?\n$/s) {		# L3 sep
			      inject_header($L3_partial_header, \@L3_headers, $L3_headers) if defined $L3_partial_header;
			      inject_organization_header_if_not_present(\%newsgroups, \@L3_headers, $L3_headers);
			      remove_tag_from_subject_header(\%newsgroups, \@L3_headers, $L3_headers);
			      post_article_and_leave_OUTPUT_open(\%newsgroups, \@L3_headers, [$s], undef);
			      $L3_state = 1;
			   } elsif ($s =~ /^\S/) {		# L3 header
			      inject_header($L3_partial_header, \@L3_headers, $L3_headers) if defined $L3_partial_header;
			      $L3_partial_header = $s;
			   } else {				# L3 header continuation
			      $L3_partial_header .= $s;
			   }
			} else {				# L3 body
			   print OUTPUT $s;
			}
		     }
		  } else {
		     push @{$mime_parts[$#mime_parts]->{'body'}}, $s;
		  }
		  if ($s =~ /^--$boundary\r?\n$/s) {
		     close OUTPUT if $digest_p;
		     $L2_state = 2;
		     $L2_headers = {}; push @mime_parts, {'headers' => [], 'sep' => [], 'body' => []}; # create blank attachment
		     debug_message sprintf 'DEBUG: attachment %d', scalar @mime_parts if $debug_p;
		  } elsif ($s =~ /^--$boundary--\r?\n$/s) {
		     if ($digest_p) {
			$blackhole_p = 1;
		     } else {
			$hold_p = 0;
		     }
		  }
	       } elsif ($L2_state == 4) { # MIME digest preamble
		  if ($s =~ /^--$boundary\r?\n$/s) {
		     $L2_state = 2;
		     $L2_headers = {}; @mime_parts = ({'headers' => [], 'sep' => [], 'body' => []}); # reinitialize and create blank attachment
		     debug_message sprintf 'DEBUG: attachment %d', scalar @mime_parts if $debug_p;
		  } elsif ($s =~ /^--$boundary--\r?\n$/s) { # this should never happen
		     $blackhole_p = 0;
		  }
	       } else {
		  die "INTERNAL ERROR: L2_state $L2_state not handled!\n";
	       }
	       if (!$hold_p) {
		  debug_message sprintf 'DEBUG: releasing hold and posting article' if $debug_p;
		  post_article_and_leave_OUTPUT_open(\%newsgroups, \@headers, ["\n"], \@preamble);
		  for my $part (@mime_parts) {
		     for my $key ('headers', 'sep', 'body') {
			for my $s (@{$part->{$key}}) {
			   print OUTPUT $s;
			}
		     }
		  }
	       }
	    }
	 });
   close OUTPUT;
}

printf STDERR "DEBUG: $appName: called with arguments [(%s)]\n", join(') (', @ARGV) if join('', map { "!$_!" } @ARGV) =~ /!(?:-d|--debug)!/; # detect --debug before calling GetOptions

GetOptions(
   'data-from=s'	=> \$mailing_list_definition_file,
   'd|debug'		=> sub { $debug_p += 1; },
   'k|keep-going'	=> \$keep_going_p,
   'n|dry-run'		=> \$dry_run_p,
   'preserve-uid'	=> \$preserve_uid_p,
   'tag=s'		=> \$tag,
   'v|verbose'		=> \$verbose_p,
   'help'		=> \&show_usage_then_exit,
   'version'		=> \&show_version_then_exit,
) || show_usage_then_exit(1);

die "$appName: Unknown options @ARGV\n" if @ARGV;

$ENV{LANG} = 'C';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV', 'LC_CTYPE', 'LC_ALL'};

read_config_file;
$verbose_p = 1 if get_scalar('verbose', $lists->{''}) =~ /^(?:1|[ty]\w*)$/i;

print STDERR "$appName started as user $>\n" if $verbose_p;

check_for_correct_user;
look_at_stdin;
exit $status;

=head1 Description

F<mailpostgw> is an Evolution filter that allows mail to be gatewayed into a local news system
on a system with no functional L<sendmail(8)>.
How the gatewaying works is controlled by a systemwide configuration file.

After receiving a maildir-formatted mail (the format used by Evolution) from standard input,
F<mailpostgw> analyzes the mail headers to see if it detects a mailing list described by the configuration file.
If it detects a recognized mailing list,
it opens a pipe to L<sudo(8)> to run L<mailpost(8)> to send the headers,
then continues to pipe it rest of the mail;
if no mailing list is detected it simply exits.

Because F<mailpostgw> runs as an Evolution filter, L<sudo(8)> must be configured
to allow the installed copy of F<mailpostgw> to run as the system’s I<@@NEWSUSER@@> user
without requiring a password.

F<mailpostgw> uses an ini-style configuration file, L<lists.dat(5)>, to determine
how what addresses and List-Id’s should be fed into which newsgroups.
You can specify what tags should be removed from the Subject header and,
in case of read-only broadcast lists, you can specify what should go into the Organization header.

=head1 Files

=over

=item @@MAILPOST@@

The real mailpost script (that needs to be run as the I<@@NEWSUSER@@> user), from INN

=item @@INPUT@@

Configuration file that maps how mailing lists you receive should be fed into your local news spool

=back

=head1 See also

L<lists.dat>,
L<mailpost(8)>,
L<stupidweasel(8)>,
L<sudo(8)>

=head1 Reporting bugs

Please report bugs through L<Github|https://github.com/acli/stupidweasel/issues>.
=cut