#! /usr/bin/perl

# $Id: import 37652 2012-08-27 15:36:20Z wsl $
# $URL: https://svn.uvt.nl/its-id/trunk/sources/kiki/bin/import $

use strict;
use warnings FATAL => 'all';

use DBI;
use Encode;
use IO::File;

my $dsn = $ENV{DSN} // 'dbi:Pg:dbname=kiki';
my $user = $ENV{DBUSER} // 'kiki';
my $pass = $ENV{DBPASS};
my $options = {
	PrintError => 0,
	RaiseError => 1,
	AutoCommit => 0,
	ShowErrorStatement => 1,
	pg_enable_utf8 => 1
};

my $funcspecfile = "func.spec";
my $mailspecfile = "mail.spec";
my $virtspecfile = "virt.spec";
my $tiasspecfile = "tias.spec";

my %aliases; @aliases{qw(
	root
	devnull
	postmaster
	backup
)} = ();

my $db = DBI->connect($dsn, $user, $pass, $options);

sub perform {
	my $q = $db->prepare_cached(shift);
	$q->execute(@_);
	$q->finish;
}

sub query {
	my $q = $db->prepare_cached(shift);
	$q->execute(@_);
	my $res = $q->fetchall_arrayref;
	$q->finish;
	return $res;
}

my %func;
my %addressbook;
my %domains;

sub wellformed {
	foreach(@_) {
		return 0 unless
			/
				^
					[a-z_][a-z_0-9]*(?:[.-][a-z_0-9]+)*
				@
					(?:(?:[a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]+|localhost)
				$
			/ixo;
	}
	return 1
}

sub splitaddrs {
	my @addrs =
		map { s/\@.*/\L$&/; $_ }
		grep { $_ ne '' }
		map { s/^\s|\s$//g; $_ }
		map { s/\s\s+/ /g; $_ }
		map { split(',') }
		@_;
	return \@addrs;
}

sub readspecline {
	my $isfunc = shift;
	my $specfile = shift;
	my $specline = join ' ', @_;
	my ($k, $v) = split /\s*:\s*/, $specline, 2;
	my $key = lc($k);

	if($key =~ s/\@uvt\.nl$//) {
		warn "\@uvt.nl suffix stripped from $key\@uvt.nl at $specfile\n\t$specline\n"
	}

	if($key =~ /^\@/) {
		warn "Skipping catch-all address $key at $specfile\n\t$specline\n";
		return;
	}

	if(!defined $v or $v =~ /^(\s|,)*$/) {
		warn "Malformed line at $specfile, skipped.\n\t$specline\n";
		return;
	}

	my @addrs = grep {
		my $valid;
		if(!wellformed($_)) {
			warn "Malformed address $_ at $specfile, skipped.\n\t$specline\n";
		} else {
			$valid = 1;
		}
		$valid
	} map {
		/\@/ ? $_ : "$_\@uvt.nl"
	} @{splitaddrs($v)};

	my $domain = $key;
	if($domain =~ s/^.*\@//) {
		undef $domains{$key};
	} else {
		$key .= '@uvt.nl';
	}

	undef $addressbook{$key} if $isfunc;
	$func{$key} = \@addrs;
}

sub readspecfile {
	my $isfunc = shift;

	foreach my $specfile (@_) {
		my $spec = new IO::File($specfile, '<:utf8')
			or die "$0: open($specfile): $!\n";

		my @buf = ();
		my $specline = 1;

		while(defined($_ = $spec->getline)) {
			s/\s+$//g;
			next if $_ eq '' || ord == 35; # '#'
			if(s/^\s+//) {
				push @buf, $_;
				next
			}
			readspecline $isfunc, "$specfile:$specline", @buf if @buf;
			@buf = ($_);
			$specline = $.;
		}
		readspecline $isfunc, "$specfile:$specline", @buf if @buf;

		$spec->eof
			or die "$0: read($specfile): $!\n";
		$spec->close
			or die "$0: close($specfile): $!\n";
	}
}

readspecfile 1, $funcspecfile;
readspecfile 0, $mailspecfile, $virtspecfile, $tiasspecfile;

my %destinations;
my %destination_names;

while(my ($key, $addrs) = each(%func)) {
	my $res = query('SELECT create_alias(?, ?)', $key, exists $addressbook{$key} ? 't' : 'f');
	my ($a) = $res->[0][0];
	$destinations{$a} = $addrs;
	$destination_names{$a} = $key;
}

while(my ($key, $addrs) = each(%destinations)) {
	foreach my $addr (@$addrs) {
		unless(eval { perform('SELECT create_destination(?, ?)', $key, $addr); 1 }) {
			my $err = $@;
			die $err if ref $err;
			die "$destination_names{$key}: $err";
		}
	}
}

foreach my $domain (keys %domains) {
	perform('SELECT internalize_domain(?)', $domain);
}

$db->commit;
