#!/usr/bin/perl -w
# qmail-all: sets up an email address for distribution to every user 
# within an email domain
#
# written by Rob Martin, IT Services Manager, Nexus Builders Group, In
+c.
# rob@nxsbg.com, rob@grokd.org
# designed especially to work with Matt's Toaster
# released under GPL v2 or later

my $version = "1.01";
# Version notes
# 1.01 (5 March 2004):
# add support for replying to messages when the sender is not authoriz
+ed
# replace any "die" error reports with diagnostic responses by email
# get domain from incoming email
# $oksendersfile is now $conffile
# provide support in $conffile for addresses to exclude
# cleaned up the code considerably
# 1.00 (3 March 2004):
# first release

use strict;
use Mail::Internet;

# Local settings
# set to 1 for debuging
my $DEBUG = 0;
# or set an environment variable for $DEBUG
$DEBUG = 1 if exists $ENV{"DEBUG"};

# What's the local naming convention for Maildirs?
my $maildir = "Maildir";

# $conffile = files containing list of people who can use this
# Lines beginning with "+" can send to all
# Lines beginning with "-" are excluded from emails to all
my @conffile = ("/usr/local/vpopmail/etc/sendtoall", "./.sendtoall");
# @oksenders = array of more people who can use this
my @oksenders = ("rob\@nxsbg.com", "rob.martin\@nxsbg.com");
# @excluded = array of more people excluded from emails to all
my @excluded = ("root", "postmaster", "webmaster", "hostmaster");

# parse conf to populate @oksenders and @excluded
&parse_conf;

# Read incoming message and parse the header
my ($to, $sender, $domain);
my $message = new Mail::Internet \*STDIN;
my $header = $message->head();
&parse;

# Grab all of the forwards for this domain
my %recips;
&get_recips;

# validate sender
&validate;

# Finally, get the job done.
while (my ($key, $value) = each (%recips)) {
  $message->smtpsend( MailFrom => $to, To => $value) || fail("Couldn't
+ send message.");
  &debug("Sending to $value");
}

exit 0;

sub parse_conf {
  foreach my $conf (@conffile) {
    if (-e $conf) {
      open CONF, "<$conf" || fail("Couldn't open $conf");
      while (<CONF>) { 
        chomp; 
        s/^\+// and push @oksenders, $_; 
        s/^\-// and push @excluded, $_;
} } } }

sub parse {
  $to = $header->get("To"); chomp $to;
  $sender = $header->get("From"); chomp $sender;
  $domain = $to; $domain =~ s/^.*\@//g;
  &debug("Sent to $to.");
  &debug("Sender is $sender.");
  &debug("Domain is $domain.");
  &debug("Authorized senders are @oksenders.");
  &debug("Excluded recipients are @excluded.");
}

sub get_recips {
  my @files = glob ".qmail-*";
  &debug(".qmail- files globbed are @files.");
  foreach (@files) {
    s/\.qmail-//;
    " @excluded " =~ / $_ / and next;
    $_ = ".qmail-$_";
    open DOTQMAIL,"<$_" || fail("Couldn't open file $_");
    while (<DOTQMAIL>) {
      chomp;
      s/^\&// or next; # an email forward
      " @excluded " =~ / $_ / and next;
      " @excluded " =~ / $_\@$domain / and next;
      if (/\@/) { $recips{$_} = $_;} # fully qualified}
      else { $recips{"$_\@$domain"} = "$_\@$domain";} # local domain
  } }

  @files = glob "*";
  foreach (@files) {
    " @excluded " =~ / $_ / and next;
    " @excluded " =~ / $_\@$domain / and next;
    # just the directory name is needed here, if it's a true mailbox
    ((-d $_) && (-e "$_/$maildir")) and $recips{"$_\@$domain"} = "$_\@
+$domain";
} }

sub validate {
  my $valid = 0;
  foreach (@oksenders) {
    if ($sender =~ /$_/) {
      &debug("$sender is an ok sender.");
      $valid = 1;
  } }
  return if $valid;
  error_reply("Sender $sender is not authorized.", 
                "You are not authorized to send mail to $to.");
}

sub error_reply {
  my ($fault, $error) = @_;
  &debug("Failed message: $fault");
  undef %recips;
  $recips{$sender} = $sender;
  $header->replace("From", $to);
  $header->replace("Subject", $error);
}

sub fail {
  my $reason = @_;
  &debug("Program failure: $reason");
  die;
}

sub debug {
  $DEBUG and print STDERR "qmail-all.pl: @_\n";
}