#! /usr/bin/perl
use strict;
use warnings;
no warnings qw(once);
use DBI;
use AppConfig;
use lib qw(. /etc/itkacl);
require 'config.pm';

my $conf = AppConfig->new();
$conf->define('force!');
$conf->getopt(\@ARGV);

exit 0 if (!should_run());

my $dbh = DBI->connect("dbi:Pg:" .
	"dbname=" . $itkaclsyncconfig::db_name . ";" .
	"host= " . $itkaclsyncconfig::db_host,
	$itkaclsyncconfig::db_user,
	$itkaclsyncconfig::db_pass)
or die "Couldn't connect to database: " . DBI::errstr();
$dbh->{RaiseError} = 1;

# Fetch members of all groups.
my %members = ();
while (my ($name,$passwd,$gid,$members) = getgrent()) {
	push @{$members{$name}}, ( split /\s+/, $members );
}

my %access = ();
while (my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$dir,$shell,$expire) = getpwent()) {
	# No system users, except those that are explicitly included
	next if ($uid < $itkaclsyncconfig::minimum_uid && (grep { $name eq $_ } (@itkaclsyncconfig::force_include_users)) == 0);

	# No Samba machine accounts
	next if $name =~ /\$$/;

	# Initially, nobody has access.
	$access{$name} = 0;

	# The user is implicitly a member in his/her primary group.
	my ($grnam) = getgrgid($gid);
	if (defined($grnam)) {
		push @{$members{$grnam}}, $name;
	} else {
		warn "User $name has unknown gid $gid";
	}
		
	# Everybody is a member of the "<everyone>" group.
	push @{$members{'<everyone>'}}, $name;
}

my %entries = ();
dump_recursively($itkaclsyncconfig::dns_zone . ".", undef, \%access, \%entries);

do { } while (update_zone() == 0);

# Don't run again before we've got updates
utime(time(), time(), $itkaclsyncconfig::last_sync_file);

sub update_zone {
	# Dump the zone in its current form.
	my %current_entries = ();
	open ZONE, "dig +nocmd +nostats +nocomments -t axfr $itkaclsyncconfig::dns_zone. \@$itkaclsyncconfig::dns_server |"
		or die "dig failed: $!";
	while (<ZONE>) {
		chomp;
		/( .*? \Q$itkaclsyncconfig::dns_zone\E \. ) \s+ 10 \s+ IN \s+ A \s+ 127\.0\.0\.1 \s* $/x or next;
		$current_entries{$1} = 1;

	}
	close ZONE;

	if ($? != 0) {
		die "dig failed with \$\? = $?";
	}
	if (scalar keys %current_entries < 1) {
		die "No entries in zone, transfer probably failed.";
	}

	# Call nsupdate to update DNS.
	# Note: We limit ourselves to 1000 records at a time due to nsupdate limitations.
	# If we hit the limit, we'll return 0 to signal that we should try again.
	my $num_lines = 0;

	open NSUPDATE, "| nsupdate -y $itkaclsyncconfig::dns_key"
		or die "nsupdate failed: $!";
	print NSUPDATE "zone $itkaclsyncconfig::dns_zone.\n";
	print NSUPDATE "server $itkaclsyncconfig::dns_server\n";

	for my $entry (keys %entries) {
		next if (exists($current_entries{$entry}));
		last if (++$num_lines == $itkaclsyncconfig::max_updates_per_transaction);
		print NSUPDATE "update add $entry 10 A 127.0.0.1\n";
	}
	for my $entry (keys %current_entries) {
		next if (exists($entries{$entry}));
		last if (++$num_lines == $itkaclsyncconfig::max_updates_per_transaction);
		print NSUPDATE "update delete $entry\n";
	}
	print NSUPDATE "send\n";
	close NSUPDATE;

	print "Made $num_lines updates.\n";
	if ($num_lines >= $itkaclsyncconfig::max_updates_per_transaction) {
		print "Note: Hit limit of $itkaclsyncconfig::max_updates_per_transaction updates, will continue in a separate transaction.\n";
		return 0;
	}
	return 1;
}

sub dump_recursively {
	my ($path, $id, $allowed, $entries) = @_;

	if (defined($id)) {
		# Find all changes to the access tree at this level in the tree.
		my $q = $dbh->prepare('SELECT entity_type,entity,allow FROM aclentries WHERE object=? ORDER BY entity_type ASC, allow DESC');
		$q->execute($id);

		while (my $ref = $q->fetchrow_hashref) {
			my $entity_type = $ref->{'entity_type'};
			my $entity = $ref->{'entity'};
			my $allow = ($ref->{'allow'} eq 'grant');

			if ($entity_type eq 'user') {
				if (!exists($allowed->{$entity})) {
					warn "$path has an ACL entry for non-existant user $entity";
				} else {
					$allowed->{$entity} = $allow;
				}
			} elsif ($entity_type eq 'group') {
				if (!exists($members{$entity})) {
					warn "$path has an ACL entry for non-existant group $entity";
				} else {
					for my $member (@{$members{$entity}}) {
						$allowed->{$member} = $allow;
					}
				}
			}
		}
	}

	# Output everyone who has access to this path.
	for my $user (keys %$allowed) {
		next if (!$allowed->{$user});
		$entries->{"$user.$path"} = 1;
	}

	# Now, find all children.
	my $q;
	if (defined($id)) {
		$q = $dbh->prepare('SELECT id,name FROM objects WHERE parent=?');
		$q->execute($id);
	} else {
		$q = $dbh->prepare('SELECT id,name FROM objects WHERE parent IS NULL');
		$q->execute;
	}

	while (my $ref = $q->fetchrow_hashref) {
		my %allowed_copy = %$allowed;
		dump_recursively($ref->{'name'} . "." . $path, $ref->{'id'}, \%allowed_copy, $entries);
	}
}

# Check if we have updates since last run (or if we're forced)
sub should_run {
	return 1 if ($conf->force);
	my $last_update = (stat($itkaclsyncconfig::updated_file))[10] or die "Can't get mtime for $itkaclsyncconfig::updated_file";
	my $last_sync = (stat($itkaclsyncconfig::last_sync_file))[10] or die "Can't get mtime for $itkaclsyncconfig::last_sync_file";
	my $last_group = (stat('/etc/group'))[10] or die "Can't get mtime for /etc/group";
	my $last_group_db = (stat('/var/lib/misc/group.db'))[10] or die "Can't get mtime for /etc/group";
	my $last_passwd = (stat('/etc/passwd'))[10] or die "Can't get mtime for /etc/passwd";
	return 1 if ($last_sync - 10 < $last_update);
	return 1 if ($last_sync - 10 < $last_group);
	return 1 if ($last_sync - 10 < $last_group_db);
	return 1 if ($last_sync - 10 < $last_passwd);

	return 0;
}
