#!/usr/bin/perl

#
# Generate valid_recipients email list.
# This script will attempt to go through your qmail configuration
# and build a list of all valid email recipients that you can then
# use to add a frontend check to either qmail or postfix to allow you
# to reject bogus email addresses.
# This script was built because I found that 99.8% of all emails to my
# qmail server were to bogus addresses (and spam), so by rejecting those
# at the SMTP conversation level I significantly dropped the amount of SMTP
# traffic and CPU processing (antivirus and antispam) my server had to do.
#
# Version 1.0 - July 2008
# (c) 2008, Paul Gregg <pgregg@pgregg.com>
# http://www.pgregg.com/projects/qmail/makevalidrecipients/
#
# No warranty is implied or given with this software. Use at your own risk.
#


$root = "/var/qmail";

$virtualdomains = "$root/control/virtualdomains";
$usersassign = "$root/users/assign";

$outputformat = "%-40s\tOK\n"; # 40 space padded email address, tab, OK

#Are there any addresses you want to hard code?, these are appended to the end
#@hardcodeallow = ("exampleuser\@pgregg.com");
@hardcodeallow = ();

open(DOMAINS, "<$virtualdomains") || die "Can't read control/virtualdomains file '$virtualdomains': $!\n";
while ($virtualdomain = <DOMAINS>) {
  next if $virtualdomain =~ /^#/;
  chomp($virtualdomain);
  ($domain,$usermap) = split(/:/, $virtualdomain);
  print "# $domain   $usermap\n";

  # Scan users/assign looking for entries for this domain.
  # Kinda wasteful because we are doing multiple pass scans for every domain
  # but it is the easist way to do it :)
  open(ASSIGN, "<$usersassign")  || die "Can't read users/assign file '$assign': $!\n";
  while ($assign = <ASSIGN>) {
    next if $assign =~ /^#/;
    next if $assign =~ /^.$/;
    ($pat, $username, $uid, $gid, $path, undef, undef, undef) = split(/:/, $assign);
    if ($pat =~ /^=$usermap/) { # match on =domain-com
      $pat =~ s/^=$usermap-//;
      printf($outputformat, "$pat\@$domain");
    } else {
      if ($pat =~ /^\+$usermap/) { # match on +domain-com
        $pat =~ s/^\+$usermap-?//;
        # we need to look in $path for .qmail- files
        #print "# ...Opening path: $path for read\n";
        opendir(DIR,"$path") || die "Error: $!\n";
        @tmpfiles = grep { /^.qmail-/ && -f "$path/$_" } readdir(DIR);
        closedir(DIR);
        for $file (sort(@tmpfiles)) {
          if ($file =~ /^.qmail-/) {
            $ignore=0;
            # special handling for .qmail-default
            if ($file eq ".qmail-default") {
              open(QMAILDEFAULT, "<$path/$file") || warn "Couldn't read $path/$file: $!\n";
              while($dotqmail = <QMAILDEFAULT>) {
                $ignore = 1 if $dotqmail =~ /^\|bouncesaying/;
              }
              close(QMAILDEFAULT);
            }
            if ($ignore == 0) {
              $file =~ s/^.qmail-//;
              if ($file =~ /^default-?/) {
                $file =~ s/^default-?//;
              }
              $file =~ s/:/./g;   # qmail uses a : for a . in an email
              $luser = $pat;
              $luser .= "-" if ($file ne "" && $pat ne "");
              $luser .=  $file if ($file ne "");
              printf($outputformat, "$luser\@$domain");
            } else {
              print "# bypass $path/$file\n";
            }
          } # end  if ($file =~ /^.qmail-/)
        } # end for $file (sort(@files))
      } # end if ($pat =~ /^+$usermap/)
    } # end (else) if ($pat =~ /^+$usermap/)
  } # end while ($assign = <ASSIGN>)
  close(ASSIGN);
}
close(DOMAINS);

print "# Hard coded allow list:\n";
for $ad (@hardcodeallow) {
  printf($outputformat, $ad);
}

exit;


