#!/usr/bin/perl
#
# traverses the vpopmail structure, and makes a list of valid addresses to
# use for MX front servers.
#
# normal addresses is added to a hash file for postfix, and mailinglists and such needing
# wildcarding makes a pcre file. make postfix use the hash one first, and fallback to the pcre.
#
# (c) 2003 - 2004 Andre Tomt <andre@skjellin.no>

use strict;
use warnings;
use Data::Dumper;

# Command line parsing
my $debug = 0;
my $dry   = 0;

while ( scalar @ARGV != 0 ) {
    my $option = shift;

    if ( $option eq '--debug' ) {
        $debug = 1;
    }

    elsif ( $option eq '--dry-run' ) {
        $dry = 1;
    }

    else {
        die "Unrecognized command line option: $option\n";
    }
}

my $exportroot    = '/var/lib/ato-vpop-glue/vpop-export';
my $p_filter      = "$exportroot/filter";
my $p_domains     = "$exportroot/domains";
my $p_amavis      = "$exportroot/domains_amavis";
my $p_transport   = "$exportroot/transport";
my $p_recips      = "$exportroot/recips";
my $p_recips_pcre = "$exportroot/recips.pcre";
my $p_assign      = '/var/qmail/users/assign';

my $DELIVER_BOUNCE   = 0;
my $DELIVER_DELETE   = 1;
my $DELIVER_CATCHALL = 2;

# Read in list of all domains
my $domains = {};

open my $fd_assign,  '<', $p_assign
  or die "could not open $p_assign for reading: $!\n";

while ( <$fd_assign> ) {
    if ( /^\+(.+)\-\:(.+)\:(\d+)\:(\d+)\:(.+)\:\-/ ) {
        my $l_domain1 = $1;
        my $l_domain2 = $2;
        my $l_dir     = $5;

        if ( !exists $domains->{$l_domain2} ) {
            $domains->{$l_domain2} = {
                directory     => $l_dir,
                domainnames   => [],
                recips        => {},
                recips_pcre   => {},
            };
        }
        push @{$domains->{$l_domain2}->{domainnames}}, $l_domain1;
    }
}
close $fd_assign;


# For every domain, parse structure
DOMAIN:
while ( my ($domain, $domaindata) = each %{$domains} ) {
    my $domdir      = $domaindata->{'directory'};
    my $recips      = $domaindata->{'recips'};
    my $recips_pcre = $domaindata->{'recips_pcre'};
    my $qdefault    = "$domdir/.qmail-default";
    my $vpasswd     = "$domdir/vpasswd";
    my $default     = $DELIVER_CATCHALL;
    
    eval {
        # Figure out if it is catchall, if it is all other processing is moot.
        my @content = slurp_list($qdefault);
        
        # | /home/vpopmail/bin/vdelivermail '' bounce-no-mailbox
        if ( "@content" =~ /vdelivermail '' bounce-no-mailbox/ ) {
            $default = $DELIVER_BOUNCE;
        }
        # | /home/vpopmail/bin/vdelivermail '' delete
        elsif ( "@content" =~ /vdelivermail '' delete/ ) {
            $default = $DELIVER_DELETE;
        }
        
        $domaindata->{'default'} = $default;
   
        # Skip further processing of domain if we're going to pass everything
        # to it anyway.
        if ( $default == $DELIVER_CATCHALL ) {
            return 1;
        }

        # Read all vpop users
        for my $l_vpasswd ( slurp_list($vpasswd) ) {
            my $recip = (split(/:/, $l_vpasswd))[0];
            $recips->{$recip} = 1;
        }

        # Scan directory for .qmail files, as they are valid recips
        opendir my $fd_domdir, $domdir
          or die "failed opening directory $domdir for reading: $!\n";
        
        while ( my $direntry = readdir $fd_domdir ) {
            next if substr($direntry, 0, 7) ne '.qmail-';
            my $direntry_fp = "$domdir/$direntry";

            # Get everything after .qmail-
            my $dotname = substr($direntry, 7);

            # The default file is already processed.
            next if $dotname eq 'default';

            # Translate dots
            $dotname =~ s/\:/\./g;

            # If its a symlink its a ezmlm list
            if ( -l $direntry_fp ) {
                # Use the return-default file to figure out the name
                if ( $dotname =~ /([\w\.\:\-]+)\-return\-default$/ ) {
                    $recips_pcre->{$1} = 1;
                }
            }
            else {
                $recips->{$dotname} = 1;
            }


            #print substr($direntry, 7), "\n";
        }

        closedir $fd_domdir;
    };
    if ( $@ ) {
        warn $@;
        warn "error occured during processing of $domain. setting catchall and continuing..\n";
        $domaindata->{'default'} = $DELIVER_CATCHALL;
    }

}

if ( $debug ) {
    print Dumper($domains);
}

if ( $dry ) {
    print "dry run in effect, not updating..\n";
    exit 0;
}

# Update data files for postfix and amavis
open my $fd_domains, '>', "$p_domains.tmp"
  or die "could not open $p_domains.tmp for writing: $!\n";

open my $fd_amavis, '>', "$p_amavis.tmp"
  or die "could not open $p_amavis.tmp for writing: $!\n";

open my $fd_filter, '>', "$p_filter.tmp"
  or die "could not open $p_filter.tmp for writing: $!\n";

open my $fd_transport, '>', "$p_transport.tmp"
  or die "could not open $p_transport.tmp for writing: $!\n";

open my $fd_recips, '>', "$p_recips.tmp"
  or die "could not open $p_recips.tmp for writing: $!\n";

open my $fd_recips_pcre, '>', "$p_recips_pcre.tmp"
  or die "could not open $p_recips_pcre.tmp for writing: $!\n";

while ( my ($domain, $domaindata) = each %{$domains} ) {
    my $domainnames = $domaindata->{'domainnames'};
    my $default     = $domaindata->{'default'};
    my $recips      = $domaindata->{'recips'};
    my $recips_pcre = $domaindata->{'recips_pcre'};

    for my $domainname ( @{$domainnames} ) {
        my $pcredomname = $domainname;
        $pcredomname =~ s/\./\\./g;

        # Transport
        print {$fd_transport} "$domainname\tvpop:\n";

        # (Relay) domains
        print {$fd_domains} "$domainname\tOK\n";

        # Amavis domains
        print {$fd_amavis} "$domainname\n";

        # Filter domains
        print {$fd_filter} "$domainname\tFILTER smtp-amavis:[127.0.0.1]:10024\n";

        # Recips
        if ( $default == $DELIVER_CATCHALL ) {
            print {$fd_recips} "\@$domainname\tOK\n";
        }
        else {
            while ( my ($name) = (each(%{$recips}))[0] ) {
                print {$fd_recips} "$name\@$domainname\tOK\n";
            }

            while ( my ($name) = (each(%{$recips_pcre}))[0] ) {
                print {$fd_recips_pcre} "/^$name(\\-.+)?\\@", "$pcredomname\$/\tOK\n";
            }
        }
    }
}

close $fd_domains;
close $fd_amavis;
close $fd_filter;
close $fd_transport;
close $fd_recips;
close $fd_recips_pcre;

postmap($p_filter);
postmap($p_domains);
postmap($p_transport);
postmap($p_recips);
cmpmove("$p_recips_pcre.tmp", $p_recips_pcre);

if ( cmpmove("$p_amavis.tmp", $p_amavis) == 1 ) {
    system('/etc/init.d/amavis', 'restart');
}

sub slurp_list {
    my ($file) = @_;
    my @data;

    open my $fd, '<', $file
      or die "failed to open $file for reading: $!\n";
    @data = <$fd>;
    close $fd;

    return @data;
}

# If $file.tmp differs from $file, rename and postmap it.
sub postmap {
    my ($file) = @_;
   
    # If cmpmove reported it did an ACTUAL move (eg files differs)
    # then we run postmap on it.
    if ( cmpmove("$file.tmp", $file) == 1 ) {
        system('/usr/sbin/postmap', $file);
    }

    return 1;

}


sub cmpmove {
    my ($source, $dest) = @_;
    my $ret;

    if ( ! -e $dest ) {
        # Pretend it differs
        $ret = 256;
    }
    else {
        $ret = system('/usr/bin/cmp', '--quiet', $source, $dest);
    } 

    # Does not differ, leave alone, but pretend we did it system wise
    if ( $ret == 0 ) {
        unlink $source;
        return 2;
    }

    # Differs
    # XXX print diff to stderr for mailing?
    # or log it somehow with a full diff?
    elsif ( $ret == 256 ) {
        print "file $source and $dest differs, replacing.\n";
        unlink $dest;
        rename $source, $dest;
        return 1;
    }

    # Other error
    else {
       die "cmp exited with status $ret\n";
    }
}