#! /usr/bin/env perl

# $Id: facedin 38779 2013-02-15 14:16:04Z wsl $
# $URL: https://svn.uvt.nl/its-id/trunk/sources/facedin/bin/facedin $

#	facedin - manage user accounts
#	Copyright © 2012,2013 Wessel Dankers <wsl@uvt.nl>
#
#	This program is free software: you can redistribute it and/or modify
#	it under the terms of the GNU General Public License as published by
#	the Free Software Foundation, either version 3 of the License, or
#	(at your option) any later version.
#
#	This program is distributed in the hope that it will be useful,
#	but WITHOUT ANY WARRANTY; without even the implied warranty of
#	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#	GNU General Public License for more details.
#
#	You should have received a copy of the GNU General Public License
#	along with this program.  If not, see <http://www.gnu.org/licenses/>.

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

package Facedin::Config;

use POSIX qw(mktime);
use IO::File;
use IO::Dir;

sub validate_anr {
	my $self = shift;
	local $_ = shift;
	die "anr '$_' is not a number\n"
		unless /^\d+$/;
	die "anr '$_' not valid\n"
		unless /^[1-9]\d{3,5}$/;
	$_ = int($_);
	#die "anr '$_' not valid\n"
	#	unless $_ >= 100000 && $_ % 11 == 0;
	return $_;
}

sub validate_cidr {
	my $self = shift;
	local $_ = shift;

	die "ip '$_' not valid\n"
		unless /^(
			(
				(?:[1-9]\d?|1\d\d|2([01]\d|2[0-3]))
				\.
				(?:\d\d?|1\d\d|2([0-4]\d|5[0-5]))
				\.
				(?:\d\d?|1\d\d|2([0-4]\d|5[0-5]))
				\.
				(?:\d\d?|1\d\d|2([0-4]\d|5[0-5]))
			) | (
				[0-9a-f]{1,4}:(
					:([0-9a-f]{1,4}(:[0-9a-f]{1,4}){0,5})?
				|
					[0-9a-f]{1,4}:(
						:([0-9a-f]{1,4}(:[0-9a-f]{1,4}){0,4})?
					|
						[0-9a-f]{1,4}:(
							:([0-9a-f]{1,4}(:[0-9a-f]{1,4}){0,3})?
						|
							[0-9a-f]{1,4}:(
								:([0-9a-f]{1,4}(:[0-9a-f]{1,4}){0,2})?
							|
								[0-9a-f]{1,4}:(
									:([0-9a-f]{1,4}(:[0-9a-f]{1,4})?)?
								|
									[0-9a-f]{1,4}:(
										:([0-9a-f]{1,4})?
									|
										[0-9a-f]{1,4}:(
											:
										|
											[0-9a-f]{1,4}
										)
									)
								)
							)
						)
					)
				)
			|
				::([0-9a-f]{1,4}(:[0-9a-f]{1,4}){0,6})?
			)
		)(\/(0|[1-9]\d*))?$/ix;

	return $_;
}

sub validate_name {
	my $self = shift;
	local $_ = lc(shift);
	die "Invalid name '$_'\n"
		unless /^\w+(?:-\w+)*$/;
	return $_;
}

sub validate_gecos {
	my $self = shift;
	local $_ = shift;
	s/\s+/ /g;
	s/^ | $//g;
	die "Invalid name '$_'\n"
		if $_ eq '';
	return $_;
}

sub validate_shell {
	my $self = shift;
	local $_ = shift;
	s/\s+/ /g;
	s/^ | $//g;
	die "Invalid shell '$_'\n"
		if m{ } || m{/$} || !m{^/};
	return $_;
}

sub validate_bool {
	my $self = shift;
	local $_ = shift;
	die "missing boolean value\n" unless defined;
	return 1 if /^(?:1|yes|true|on|enabled?)$/i;
	return 0 if /^(?:0|no|false|off|disabled?)$/i;
	die "unknown boolean value '$_'\n";
}

sub validate_date {
	my $self = shift;
	local $_ = shift;
	die "can't parse date '$_'\n" unless /^(\d\d\d\d)-(\d\d)-(\d\d)$/;
	my $unix = mktime(0, 0, 12, $3, $2-1, $1-1900);
	my $days = int($unix / 86400);
	die "invalid date '$_'\n" unless $days > 0;
	return $days;
}

sub handle_link {
	my $self = shift;
	my $link = shift;
	my $links = $self->{links};
	die "Link '$link' already defined\n"
		if exists $links->{$link};
	my $ctx = {users => {}, groups => {}};
	local $_;
	foreach(@_) {
		if(/^\w\S*$/) {
			my $uid = $self->validate_name($_);
			die "Unknown user '$_'\n" unless exists $self->{users}{$uid};
			undef $ctx->{users}{$uid};
		} elsif(/^\+(\S+)$/) {
			my $gid = $self->validate_name($1);
			$self->{groups}{$gid} ||= {};
			undef $ctx->{groups}{$gid};
		} elsif(/^\%(\S+)$/) {
			my $l = $self->{links}{$self->validate_name($1)}
				or die "Unknown link '$_'\n";
			@{$ctx->{users}}{keys %{$l->{users}}} = ();
			@{$ctx->{groups}}{keys %{$l->{groups}}} = ();
		} else {
			die "Unknown entity type '$_'\n";
		}
	}
	$links->{$link} = $ctx;
	return $ctx;
}

# probeer te raden wat in deze regel de base64 rsa-blob is
sub guess_rsa {
	my $self = shift;
	my $line = shift;
	my @elements =
		grep { /^[a-zA-Z0-9\/+]{100,}={0,4}$/ }
		sort { length($a) < length($b) }
		split(' ', $line);
	return shift @elements;
}

sub handle_item {
	my $self = shift;
	my $key = shift;
	my $value = shift;

	local $_ = $key;
	if(/^\w\S*$/) {
		my $uid = $self->validate_name($key);
		die "user '$uid' already declared\n"
			if exists $self->{users}{$uid};
		my ($anr, $name) = split(' ', $value, 2) if defined $value;
		my $dude = $self->{users}{$uid} = {uid => $uid};
		$dude->{anr} = $self->validate_anr($anr)
			if defined $anr;
		$dude->{name} = $self->validate_gecos($name)
			if defined $name;

		foreach(@_) {
			my ($cmd, $arg) = /^(\w+)\s*:\s*(\S.*)$/
				or die "Malformed declaration ($_)\n";
			$cmd = lc($cmd);
			if($cmd eq 'locked') {
				$dude->{locked} = $self->validate_bool($arg);
			} elsif($cmd eq 'anr') {
				$dude->{anr} = $self->validate_anr($arg);
			} elsif($cmd eq 'name') {
				$dude->{name} = $self->validate_gecos($arg);
			} elsif($cmd eq 'shell') {
				$dude->{shell} = $self->validate_shell($arg);
			} elsif($cmd eq 'expire') {
				$dude->{expire} = $self->validate_date($arg);
			} elsif($cmd eq 'ip') {
				push @{$dude->{ips}}, $self->validate_cidr($arg);
			} elsif($cmd eq 'authorized_key') {
				my $rsa = $self->guess_rsa($arg)
					or die "Can't find rsa/dsa key in this line\n";
				my $keys = $dude->{authorized_keys} ||= {};
				die "authorized_keys can't be duplicate\n"
					if exists $keys->{$rsa};
				$keys->{$rsa} = $arg;
			} else {
				die "Unknown attribute '$cmd'\n";
			}
		}
	} elsif(/^\+(\S+)$/) {
		my $gid = $self->validate_name($1);
		my $group = $self->{groups}{$gid};
		if($group) {
			die "group '$gid' already declared\n"
				if exists $group->{declared};
		} else {
			$group = $self->{groups}{$gid} = {gid => $gid};
		}

		undef $group->{declared};

		my $anr = $value;
		$group->{anr} = $self->validate_anr($anr)
			if defined $anr;

		foreach(@_) {
			my ($cmd, $arg) = /^(\w+)\s*:\s(\S.*)$/
				or die "Malformed declaration\n";
			$cmd = lc($cmd);
			if($cmd eq 'anr') {
				$group->{anr} = $self->validate_anr($arg);
			} else {
				die "Unknown attribute '$cmd'\n";
			}
		}
	} elsif(/^\%(\S+)$/) {
		my $link = $self->validate_name($1);
		unshift @_, $value if defined $value;
		$self->handle_link($link, map { split } @_);
	} else {
		die "Unrecognized configuration item\n";
	}
}

sub handle_item_wrapper {
	my $self = shift;
	my ($key) = @_;
	eval { $self->handle_item(@_) };
	die "in stanza for $key: $@" if $@;
	return;
}

sub read_config_file {
	my ($self, $configfile) = @_;
	my $fh = new IO::File($configfile, '<')
		or die "open($configfile): $!\n";
	binmode($fh, ':utf8');

	my $key;
	my @values;

	my $line = 0;
	eval {
		my $fileline;
		my $stanzaline;
		local $_;
		while(defined($_ = $fh->getline)) {
			$fileline = $line = $fh->input_line_number;
			s/\s+$//;
			next if $_ eq '';
			unless(/^\s/) {
				if(defined $key) {
					$line = $stanzaline;
					$self->handle_item_wrapper($key, @values);
					$line = $fileline;
					undef $key;
				}
			}
			next if /^\s*#/;
			if(s/^\s+//) {
				die "continuation without prior declaration\n"
					unless defined $key;
				push @values, $_;
			} else {
				if(defined $key) {
					$line = $stanzaline;
					$self->handle_item_wrapper($key, @values);
					$line = $fileline;
					undef $key;
				}
				if(/^(\S+)\s*:(?:\s+(\S.*))?$/) {
					($key, @values) = ($1, $2);
					$stanzaline = $line;
				} else {
					die "Can't find a valid key-value pair here\n";
				}
			}
		}
		if(defined $key) {
			$line = $stanzaline;
			$self->handle_item_wrapper($key, @values);
			$line = $fileline;
			undef $key;
		}
	};
	die "$configfile:$line: $@" if $@;

	$fh->eof or die "read($configfile): $!\n";
	$fh->close or die "close($configfile): $!\n";
	undef $fh;
}

sub new {
	my $class = shift;
	my $self = bless {users => {}, groups => {}, links => {}}, ref $class || $class;

	my $configdir = shift;

	$self->{configdir} = $configdir;

	my $dir = new IO::Dir($configdir)
		or die "open($configdir): $!\n";
	my @files = sort(grep { /\.conf$/ } $dir->read);
	$dir->close
		or die "close($configdir): $!\n";
	undef $dir;

	foreach my $configfile (@files) {
		$self->read_config_file("$configdir/$configfile");
	}

	my %anrs;
	while(my ($uid, $dude) = each(%{$self->{users}})) {
		my $anr = $dude->{anr};
		next unless defined $anr;
		die "zero anr for $uid\n" unless $anr;
		die "no gecos name specified for $uid\n" unless $dude->{name};
		die "duplicate anr specified for $uid\n" if exists $anrs{$anr};
		undef $anrs{$anr};
	}

	return $self;
}

package Facedin;

use Sys::Hostname;
use IO::File;
use POSIX qw(_exit setsid unlink);
use File::Glob qw(:glob);
use Encode;

use Data::Dumper;
$Data::Dumper::Indent = 1;

sub verbose {
	my $self = shift;
	return unless $self->{verbose};
	print $self->{dryrun} ? "(dryrun) @_" : "@_"
		or die $!;
}

sub write_file {
	my $file = shift;
	my $fh = new IO::File($file, '>')
		or die "open($file): $!\n";
	binmode($fh, ':utf8');
	$fh->print(@_) or die "write($file): $!\n";
	$fh->flush or die "write($file): $!\n";
	$fh->sync or die "write($file): $!\n";
	$fh->close or die "write($file): $!\n";
}

sub read_line {
	my $file = shift;
	my $fh = new IO::File($file, '<')
		or die "open($file): $!\n";
	binmode($fh, ':utf8');
	my $line = $fh->getline;
	unless(defined $line) {
		die "$file is empty\n" if $fh->eof;
		die "read($file): $!\n";
	}
	$fh->close or die "close($file): $!\n";
	$line =~ s/\s+/ /;
	$line =~ s/^ | $//g;
	die "$file is empty\n" if $line eq '';
	return $line;
}

sub print_uruk {
	my $self = shift;
	my $destdir = $self->{destdir};
	my $conf = $self->{conf};
	my $users = $conf->{users};
	my @users;
	foreach my $dude (sort keys %$users) {
		my $ips = $conf->{users}{$dude}{ips} or next;
		my @ip4 = grep { /\./ } @$ips;
		push @users, "my_user_$dude='".join(' ', @ip4)."'\n" if @ip4;
		my @ip6 = grep { /:/ } @$ips;
		push @users, "my_user6_$dude='".join(' ', @ip6)."'\n" if @ip6;
	}
	write_file("$destdir/etc/uruk/.users.facedin-new", @users);
	$self->commit("$destdir/etc/uruk/users");

	my @dudes = sort keys %{$self->{users}};

	mkdir "$destdir/etc/uruk/extra.d"
		or $!{EEXIST} or die "mkdir($destdir/etc/uruk/extra.d): $!\n";
	if(@dudes) {
		write_file("$destdir/etc/uruk/extra.d/.facedin.facedin-new",
			". \$etcdir/users\nsources_eth0_default_tcp_admin=\"\$sources_eth0_default_tcp_admin",
			(map { " \$my_user_$_" } @dudes),
			"\"\nsources6_eth0_default_tcp_admin=\"\$sources6_eth0_default_tcp_admin",
			(map { " \$my_user6_$_" } @dudes),
			"\"\n"
		);
	} else {
		write_file("$destdir/etc/uruk/extra.d/.facedin.facedin-new",
			"# This space intentionally not left blank\n");
	}

	$self->commit("$destdir/etc/uruk/extra.d/facedin");
}

sub print_ssh {
	my $self = shift;
	my $conf = $self->{conf};
	my $users = $self->{users};
	my @allowusers = "# generated file\n\n";
	foreach my $uid (sort keys %$users) {
		my %ips;
		my $dude = $conf->{users}{$uid};
		next unless $dude->{ips};
		@ips{@{$dude->{ips}}} = ();
		next unless %ips;
		my $line = "AllowUsers";
		foreach my $ip (sort keys %ips) {
			$line .= " $uid\@$ip";
		}
		push @allowusers, "$line\n";
	}
	my $destdir = $self->{destdir};
	write_file("$destdir/etc/ssh/sshd_config.d/.facedin.conf.facedin-new", @allowusers);
	$self->commit("$destdir/etc/ssh/sshd_config.d/facedin.conf");
}

use Data::Dumper;

sub print_sudo {
	my $self = shift;
	my $conf = $self->{conf};
	my $links = $conf->{links};
	my @sudoers = "# generated file\n\n";

	foreach my $name (sort keys %$links) {
		my $link = $links->{$name};
		my @users = sort keys %{$link->{users}};
		next unless @users;
		$name =~ tr/A-Za-z0-9/_/cs;
		$name = 'FACEDIN_' . uc($name);
		push @sudoers, "User_Alias $name = ", join(', ', @users), "\n";
	}

	my $destdir = $self->{destdir};
	write_file("$destdir/etc/sudoers.d/.10-facedin.facedin-new", @sudoers);
	chmod(0440, "$destdir/etc/sudoers.d/.10-facedin.facedin-new")
		or die "chmod($destdir/etc/sudoers.d/.10-facedin.facedin-new): $!\n";
	$self->commit("$destdir/etc/sudoers.d/10-facedin");
}

# perl split stript lege trailing fields, grrr
sub unix_split {
	my $line = shift;
	my @res = split(qr/:/, "$line:x");
	pop @res;
	return @res;
}

sub alloc_anr {
	my ($self, $anr) = @_;
	my $used = $self->{used_id};
	while(exists $used->{$anr}) {
		$anr++;
	}
	undef $used->{$anr};
	return $anr;
}

sub tweak_passwd {
	my $self = shift;

	my %changed;

	my $conf = $self->{conf};
	my $users = $self->{users};
	my $groups = $self->{groups};
	my $used_id = $self->{used_id};
	my $known_anr = $self->{known_anr};
	my $known_uid = $self->{known_uid};
	my $known_gid = $self->{known_gid};
	my $all_users = $conf->{users};
	my $all_groups = $conf->{groups};

	# create a list of all users not on this host:
	my %remove;
	@remove{keys %$all_users} = ();
	delete @remove{keys %$users};

	my $destdir = $self->{destdir};

	my %seen_passwd; # needs to be created if not in this hash
	my @passwd;
	my $fh = new IO::File("$destdir/etc/passwd", '<')
		or die "open($destdir/etc/passwd): $!\n";
	binmode($fh, ':utf8');
	eval {
		local $_;
		while(defined($_ = $fh->getline)) {
			chomp;
			my @fields = unix_split($_);
			die "unexpected number of fields\n"
				if @fields != 7;
			my ($uid, $locked, $num_uid, $num_gid, $gecos, $home, $shell) = @fields;

			die "Can't parse numeric uid '$num_uid' for $uid\n"
				unless $num_uid =~ /^(?:0|[1-9]\d{0,5})+$/;
			$num_uid = int($num_uid);
			die "Can't parse numeric gid '$num_gid' for $uid\n"
				unless $num_gid =~ /^(?:0|[1-9]\d{0,5})+$/;
			$num_gid = int($num_gid);

			die "password field '$locked' not recognized for $uid\n"
				if length($locked) > 1;

			$uid = $conf->validate_name($uid);
			my $dude = $all_users->{$uid};

			if(my $used = $known_uid->{$num_uid}) {
				die "Numeric user ID $num_uid of $uid conflicts with user $used\n"
					if $used ne $uid;
			}

			$known_uid->{$num_uid} = $uid;
			$known_anr->{$uid} = $num_uid;

			$gecos =~ s/,+$//;

			# indien user volstrekt onbekend, ongewijzigd printen
			unless($dude) {
				undef $used_id->{$num_uid};
				push @passwd, join(':', $uid, $locked, $num_uid, $num_gid, $gecos, $home, $shell)."\n";
				next;
			}

			# anders, indien niet bekend voor deze host, overslaan
			unless(exists $users->{$uid}) {
				# effectief dus een delete
				$self->verbose("deleting passwd entry for $uid\n");
				$changed{passwd} = 1;
				next;
			}

			undef $seen_passwd{$uid};
			undef $used_id->{$num_uid};

			if(my $anr = $dude->{anr}) {
				die "existing numeric uid '$num_uid' does not match anr '$anr' for $uid\n"
					unless $num_uid == $anr;
			}
			die "existing numeric gid '$num_gid' does not match numeric uid '$num_uid' for $uid\n"
				unless $num_gid == $num_uid;
			$gecos = $dude->{name};

			$locked = $dude->{locked} ? '!' : '*';

			die "home directory for $uid has an unexpected value ($home)\n"
				unless $home eq "/home/$uid";

			my $new = "$uid:$locked:$num_uid:$num_gid:$gecos:/home/$uid:$shell";
			push @passwd, "$new\n";

			if($new ne $_) {
				$self->verbose("changing passwd entry for $uid\n");
				$changed{passwd} = 1;
			}
		}
	};
	die "$destdir/etc/passwd:".$fh->input_line_number.": $@" if $@;
	die "read($destdir/etc/passwd): $!\n" unless $fh->eof;
	$fh->close;
	undef $fh;

	my %seen_group; # needs to be created if not in this hash
	my @group;
	$fh = new IO::File("$destdir/etc/group", '<')
		or die "open($destdir/etc/group): $!\n";
	binmode($fh, ':utf8');
	eval {
		local $_;
		while(defined($_ = $fh->getline)) {
			chomp;
			my @fields = unix_split($_);
			die "unexpected number of fields\n"
				if @fields != 4;
			my ($gid, $locked, $num_gid, $members) = @fields;

			die "Can't parse numeric gid '$num_gid' for $gid\n"
				unless $num_gid =~ /^(?:0|[1-9]\d{0,5})+$/;
			$num_gid = int($num_gid);

			die "unexpected value in password field for group $gid\n"
				if length($locked) > 1;

			$known_gid->{$gid} = $num_gid;
			$known_anr->{$num_gid} = $gid;

			$gid = $conf->validate_name($gid);
			my $dude = $all_users->{$gid};
			my $group = $all_groups->{$gid};

			my %members;
			@members{grep { $_ ne '' } split(/,+/, $members)} = ();
			if($group && exists $group->{declared}) {
				delete @members{keys %$all_users};
			} else {
				delete @members{keys %remove};
			}
			my %expired = %members;
			delete @expired{keys %$known_anr};
			delete @members{keys %expired};

			if($dude || $group) {
				# indien leeg en niet bekend voor deze host, overslaan
				my $undeclared = $group && !exists $group->{declared};
				unless(%members || exists $users->{$gid} || exists $groups->{$gid} || $undeclared) {
					# effectief dus een delete
					$self->verbose("deleting group entry for $gid\n");
					$changed{group} = 1;
					next;
				}

				undef $used_id->{$num_gid};
				undef $seen_group{$gid};

				if($dude and my $anr = $known_uid->{$gid}) {
					die "existing numeric gid '$num_gid' does not match existing numeric uid '$anr' for group $gid\n"
						unless $num_gid == $anr;
				}

				if($dude and my $anr = $dude->{anr}) {
					die "existing numeric gid '$num_gid' does not match anr '$anr' for group $gid\n"
						unless $num_gid == $anr;
				}

				@members{$dude ? $gid : keys %{$groups->{$gid}}} = ();

				$locked = '!' if $locked !~ /^[x*!]{1,2}$/;
			} else {
				undef $used_id->{$num_gid};
			}

			$members = join(',', sort keys %members);

			my $new = "$gid:$locked:$num_gid:$members";
			push @group, "$new\n";

			if($new ne $_) {
				$self->verbose("changing group entry for $gid\n");
				$changed{group} = 1;
			}
		}
	};
	die "$destdir/etc/group:".$fh->input_line_number.": $@" if $@;
	die "read($destdir/etc/group): $!\n" unless $fh->eof;
	$fh->close;
	undef $fh;

	my %seen_shadow; # needs to be created if not in this hash
	my @shadow;
	$fh = new IO::File("$destdir/etc/shadow", '<')
		or die "open($destdir/etc/shadow): $!\n";
	binmode($fh, ':utf8');
	eval {
		local $_;
		while(defined($_ = $fh->getline)) {
			chomp;
			my @fields = unix_split($_);
			die "unexpected number of fields\n"
				if @fields != 9;
			my ($uid, $pwd, undef, undef, undef, undef, undef, undef, $reserved) = @fields;

			die "password field empty for $uid\n"
				if $pwd eq '';
			if($pwd =~ /^[x*!]{1,2}$/) {
				warn "root user has no password\n"
					if $uid eq 'root';
			} else {
				warn "user $uid has a password, this is likely NOT intended\n"
					if $uid ne 'root';
			}

			$uid = $conf->validate_name($uid);
			my $dude = $all_users->{$uid};

			# indien user volstrekt onbekend, ongewijzigd printen
			unless($dude) {
				push @shadow, $_."\n";
				next;
			}

			# anders, indien niet bekend voor deze host, overslaan
			unless(exists $users->{$uid}) {
				# effectief dus een delete
				$changed{shadow} = 1;
				next;
			}

			undef $seen_shadow{$uid};

			$pwd = $dude->{locked} ? '!' : '*';
			my $expire = defined $dude->{expire} ? $dude->{expire} : '';

			my $new = "$uid:${pwd}::::::$expire:$reserved";
			push @shadow, "$new\n";

			if($new ne $_) {
				$self->verbose("changing shadow entry for $uid\n");
				$changed{shadow} = 1;
			}
		}
	};
	die "$destdir/etc/shadow:".$fh->input_line_number.": $@" if $@;
	die "read($destdir/etc/shadow): $!\n" unless $fh->eof;
	$fh->close;
	undef $fh;

	my %seen_gshadow; # needs to be created if not in this hash
	my @gshadow;
	$fh = new IO::File("$destdir/etc/gshadow", '<')
		or die "open($destdir/etc/gshadow): $!\n";
	binmode($fh, ':utf8');
	eval {
		local $_;
		while(defined($_ = $fh->getline)) {
			chomp;
			my @fields = unix_split($_);
			die "unexpected number of fields\n"
				if @fields != 4;
			my ($gid, $pwd, $admins, $members) = @fields;

			warn "group(!) $gid has a password, this is likely NOT intended\n"
				if $pwd !~ /^[x*!]{0,2}$/;

			$gid = $conf->validate_name($gid);
			my $dude = $all_users->{$gid};
			my $group = $all_groups->{$gid};

			my %members;
			@members{grep { $_ ne '' } split(/,+/, $members)} = ();
			if($group && exists $group->{declared}) {
				delete @members{keys %$all_users};
			} else {
				delete @members{keys %remove};
			}
			my %expired = %members;
			delete @expired{keys %$known_anr};
			delete @members{keys %expired};

			if($dude || $group) {
				# indien leeg en niet bekend voor deze host, overslaan
				my $undeclared = $group && !exists $group->{declared};
				unless(%members || exists $users->{$gid} || exists $groups->{$gid} || $undeclared) {
					# effectief dus een delete
					$changed{gshadow} = 1;
					next;
				}

				undef $seen_gshadow{$gid};

				@members{$dude ? $gid : keys %{$groups->{$gid}}} = ();

				die "admin field not empty for $gid\n"
					if $admins ne '';

				$pwd = '!' if $pwd !~ /^[x*!]{1,2}$/;
			}

			$members = join(',', sort keys %members);

			my $new = "$gid:${pwd}::$members";
			push @gshadow, "$new\n";

			if($new ne $_) {
				$self->verbose("changing gshadow entry for $gid\n");
				$changed{gshadow} = 1;
			}
		}
	};
	die "$destdir/etc/gshadow:".$fh->input_line_number.": $@" if $@;
	die "read($destdir/etc/gshadow): $!\n" unless $fh->eof;
	$fh->close;
	undef $fh;

	# voor alle users van deze host, indien niet gezien, toevoegen.
	foreach my $uid (keys %$users) {
		my $dude = $all_users->{$uid};
		my ($anr, $gecos, $shell, $locked) = @{$dude}{qw(anr name shell locked)};
		$locked = $locked ? '!' : '*';
		$shell = $self->{default_shell} unless defined $shell;
		if(!$anr) {
			# als er al een group is met deze naam, pak daar de anr van
			# anders: alloceer en registreer er één
			$anr = $known_gid->{$uid} || $self->alloc_anr(1000);
			$known_uid->{$uid} = $anr;
			$known_gid->{$uid} = $anr;
		}
		unless(exists $seen_passwd{$uid}) {
			$self->verbose("add user $uid ($anr)\n");
			push @passwd, "$uid:$locked:$anr:$anr:$gecos:/home/$uid:$shell\n";
			$changed{passwd} = 1;
		}
		unless(exists $seen_shadow{$uid}) {
			push @shadow, "$uid:${locked}:::::::\n";
			$changed{shadow} = 1;
		}
		unless(exists $seen_group{$uid}) {
			push @group, "$uid:!:$anr:$uid\n";
			$changed{group} = 1;
		}
		unless(exists $seen_gshadow{$uid}) {
			push @gshadow, "$uid:!::$uid\n";
			$changed{gshadow} = 1;
		}
	}

	# voor alle groups van deze host, indien niet gezien, toevoegen.
	foreach my $gid (keys %$groups) {
		my $members = join(',', sort keys %{$groups->{$gid}});
		unless(exists $seen_group{$gid}) {
			my $group = $all_groups->{$gid};
			die "group '$gid' neither declared nor already present\n"
				unless exists $group->{declared};
			my ($anr) = @{$group}{qw(anr)};
			if(!$anr) {
				$anr = $known_gid->{$gid} || $self->alloc_anr(100);
				$known_gid->{$gid} = $anr;
			}
			$self->verbose("add group $gid ($anr)\n");
			push @group, "$gid:!:$anr:$members\n";
			$changed{group} = 1;
		}
		unless(exists $seen_gshadow{$gid}) {
			push @gshadow, "$gid:!::$members\n";
			$changed{gshadow} = 1;
		}
	}

	my @commit;

	if($changed{passwd}) {
		write_file("$destdir/etc/.passwd.facedin-new", @passwd);
		push @commit, "$destdir/etc/passwd";
	} else {
		unlink("$destdir/etc/.passwd.facedin-new") or $!{ENOENT}
			or die "unlink(destdir/etc/.passwd.facedin-new): $!\n";
	}

	if($changed{shadow}) {
		write_file("$destdir/etc/.shadow.facedin-new", @shadow);
		push @commit, "$destdir/etc/shadow";
	} else {
		unlink("$destdir/etc/.shadow.facedin-new") or $!{ENOENT}
			or die "unlink(destdir/etc/.shadow.facedin-new): $!\n";
	}

	if($changed{group}) {
		write_file("$destdir/etc/.group.facedin-new", @group);
		push @commit, "$destdir/etc/group";
	} else {
		unlink("$destdir/etc/.group.facedin-new") or $!{ENOENT}
			or die "unlink(destdir/etc/.group.facedin-new): $!\n";
	}

	if($changed{gshadow}) {
		write_file("$destdir/etc/.gshadow.facedin-new", @gshadow);
		push @commit, "$destdir/etc/gshadow";
	} else {
		unlink("$destdir/etc/.gshadow.facedin-new") or $!{ENOENT}
			or die "unlink(destdir/etc/.gshadow.facedin-new): $!\n";
	}

	$self->commit(@commit);
}

sub seteuid {
	my $anr = shift;
	local $!;
	$) = $anr;
	die "setegid($anr): $!\n" if $!;
	$> = $anr;
	die "seteuid($anr): $!\n" if $!;
}

sub run {
	my $prog = join(' ', @_);
	my $code = system {$_[0]} @_;
	if(POSIX::WIFEXITED($?)) {
		my $status = POSIX::WEXITSTATUS($?);
		die sprintf("%s exited with status %d\n", $prog, $status)
			if $status;
	} elsif(POSIX::WIFSIGNALED($?)) {
		my $sig = POSIX::WTERMSIG($?);
		die sprintf("%s killed with signal %d%s\n", $prog, $sig & 127, ($sig & 128) ? ' (core dumped)' : '')
	} elsif(POSIX::WIFSTOPPED($?)) {
		my $sig = POSIX::WSTOPSIG($?);
		warn sprintf("%s stopped with signal %d\n", $prog, $sig)
	}
}

sub tweak_homes {
	my $self = shift;
	my $conf = $self->{conf};
	my $users = $self->{users};
	my $known_anr = $self->{known_anr};
	foreach my $uid (keys %$users) {
		my $dude = $conf->{users}{$uid};
		my $anr = $known_anr->{$uid};
		my $destdir = $self->{destdir};
		my $home = "$destdir/home/$uid";
		my $skel;

		unless(-e $home) {
			$self->verbose("create home directory $home\n");
			next if $self->{dryrun};
			mkdir $home or die "mkdir($home): $!\n";
			chmod 0755, $home or die "chmod($home): $!\n";
			chown $anr, $anr, $home or die "chown($home): $!\n";
			$skel = 1;
		}

		next if $self->{dryrun};

		# drop permissies om niet in symlink-vallen te trappen
		seteuid($anr);

		run('/bin/cp', '-rP', '--preserve=links,mode,timestamps', '--', '/etc/skel/.', "$home/")
			if $skel;

		unless(-e "$home/.ssh") {
			mkdir "$home/.ssh" or die "mkdir($home/.ssh): $!\n";
			chmod 0750, "$home/.ssh" or die "chmod($home/.ssh): $!\n";
		}

		my %authorized_keys;
		my @authorized_keys;
		my $new;

		if(my $fh = new IO::File("$home/.ssh/authorized_keys", '<')) {
			if(my $authorized_keys = $dude->{authorized_keys}) {
				%authorized_keys = %$authorized_keys;
				eval {
					local $_;
					while(defined($_ = $fh->getline)) {
						Encode::_utf8_on($_);
						Encode::_utf8_off($_) unless utf8::valid($_);
						push @authorized_keys, $_;
						chomp;
						delete @authorized_keys{split()};
					}
				};
				die "$home/.ssh/authorized_keys:".$fh->input_line_number.": $@" if $@;
				die "read($home/.ssh/authorized_keys): $!\n" unless $fh->eof;
			}
			$fh->close;
			undef $fh;
		} else {
			$!{ENOENT} or die "open($home/.ssh/authorized_keys): $!\n";
			if(my $authorized_keys = $dude->{authorized_keys}) {
				@authorized_keys = "# see sshd(8) for syntax\n";
				%authorized_keys = %$authorized_keys;
			} else {
				%authorized_keys = (undef => "# see sshd(8) for syntax");
			}
			$new = 1;
		}

		if(%authorized_keys) {
			write_file("$home/.ssh/.authorized_keys.facedin-new", @authorized_keys,
				map { "$_\n" } values(%authorized_keys)
			);
			if($new) {
				chmod 0640, "$home/.ssh/.authorized_keys.facedin-new"
					or die "chmod($home/.ssh/.authorized_keys.facedin-new): $!\n";
			}
			$self->commit("$home/.ssh/authorized_keys");
		}

		# permissies weer terugpakken
		seteuid(0);
	}
}

sub ffs {
	my $s = shift;
	return 0 unless $s;
	my $lg = 0;
	until($s & 1<<$lg++) {}
	return $lg;
}

sub discard {
	my @gen;
	return grep { $gen[ffs($_)]++ } sort { $b <=> $a } @_;
}

sub max {
	return 0 unless @_;
	my $max = shift;
	foreach my $x (@_) {
		$max = $x if $x > $max;
	}
	return $max;
}

sub new {
	my $class = shift;
	my $self = bless {}, ref $class || $class;
	my $conf = $self->{conf} = shift;

	my %users;
	my %groups;
	my %used_id; # IDs that are not available for dynamic allocation
	my %known_anr;
	my %known_uid;
	my %known_gid;

	foreach my $link (values %{$conf->{links}}) {
		foreach my $user (keys %{$link->{users}}) {
			@{$users{$user}}{keys %{$link->{groups}}} = ();
		}
		foreach my $group (keys %{$link->{groups}}) {
			@{$groups{$group}}{keys %{$link->{users}}} = ();
			die "A functional group '$group' is defined with the same name as a user\n"
				if exists $users{$group};
		}
	}

	# even checken of er geen ongewenste uid/gid combinaties voorkomen
	# en meteen een lijstje opbouwen van de uids/gids die moeten bestaan
	foreach my $uid (keys %users) {
		my $dude = $conf->{users}{$uid};
		my $anr = $dude->{anr};
		next unless defined $anr;
		$known_anr{$uid} = $anr;
		$known_uid{$anr} = $uid;
		undef $used_id{$anr};
	}

	foreach my $gid (keys %groups) {
		my $group = $conf->{groups}{$gid};
		my $anr = $group->{anr};
		next unless defined $anr;
		if(my $unr = $known_anr{$gid}) {
			die "Conflicting anrs for uid '$gid' and gid '$gid': $unr <> $anr\n"
				if $unr != $anr;
		}
		$known_anr{$gid} = $anr;
		$known_gid{$anr} = $gid;
		undef $used_id{$anr};
	}

	# %known_* bevatten nu de users/groups waarvan de anrs vastliggen

	$self->{users} = \%users;
	$self->{groups} = \%groups;
	$self->{used_id} = \%used_id;
	$self->{known_anr} = \%known_anr;
	$self->{known_uid} = \%known_uid;
	$self->{known_gid} = \%known_gid;

	$self->{commit} = [];

	$self->{default_shell} = '/bin/bash';
	$self->{destdir} = '';
	$self->{verbose} = 1;
	$self->{dryrun} = 1;
	$self->{filesonly} = 1;
	$self->{backups} = 1;

	return $self;
}

sub lg2inc {
	my %st;
	@st{@_} = map { my @x = lstat($_) or die "$_: $!\n"; \@x } @_;

	my @files = sort { $st{$a}->[9] <=> $st{$b}->[9] } @_;

	my $count = 0;
	my %rename;

	foreach my $file (@files) {
		$file =~ /(\d+)$/ or die "$file: does not end in a number\n";
		my $lg = int($1);
		next unless $lg;
		my $num = 1 << $lg - 1;
		$count &= ~($num - 1);
		$count |= $num;
		my $rename = $file;
		$rename =~ s/\d+$/$count/;
		$rename{$file} = $rename;
	}

	foreach my $file (reverse @files) {
		next unless exists $rename{$file};
		rename $file, $rename{$file}
			or die "rename($file, $rename{$file}): $!\n";
	}
}

sub commit {
	my $self = shift;

	my %commit_stat;
	do {
		my %uniq;
		@uniq{@_} = ();
		die "internal error (duplicate commit)"
			if keys %uniq != @_;
	};

	foreach my $commit (@_) {
		my $dotfile = $commit;
		$dotfile =~ s{/\.?([^./][^/]*)$}{/.$1};
		if(my @st = lstat($commit)) {
			die "$commit is not a file\n" unless -f _;
			die "$commit is not writable\n" unless -w _;
			$commit_stat{$commit} = \@st;

			my ($mode, $uid, $gid) = @st[2, 4, 5];
			chown $uid, $gid, "$dotfile.facedin-new"
				or die "chown($dotfile.facedin-new, $uid, $gid): $!\n";
			chmod $mode, "$dotfile.facedin-new"
				or die "chmod($dotfile.facedin-new, $mode): $!\n";
		} else {
			die "$commit: $!\n" unless $!{ENOENT};
		}
		$self->verbose("commit $commit\n");
	}

	return if $self->{dryrun};

	# als files als /etc/passwd verbokt raken, is dat superirritant
	# daarom op veilig spelen met wegschrijven: backups maken en slim linken/renamen
	if($self->{backups}) {
		foreach my $commit (@_) {
			if(exists $commit_stat{$commit}) {	
				my $dotfile = $commit;
				$dotfile =~ s{/\.?([^./][^/]*)$}{/.$1};
				my $qdotfile = $dotfile;
				$qdotfile =~ s/([][\\?*{}])/\\$1/g;

				# ouwe troep opruimen
				if(-e "$dotfile.facedin-seq") {
					# converteer nummers naar nieuwe stijl
					lg2inc(bsd_glob("$qdotfile.facedin-*[0-9]",
						GLOB_ERR|GLOB_LIMIT|GLOB_NOSORT|GLOB_QUOTE));
					POSIX::unlink "$dotfile.facedin-seq"
						or die "unlink($dotfile.facedin-seq): $!\n";
				}

				# welke nummertjes hebben we al?
				my @existing = map { /-(\d+)$/ ? int($1) : () }
					bsd_glob("$qdotfile.facedin-*[0-9]",
						GLOB_ERR|GLOB_LIMIT|GLOB_NOSORT|GLOB_QUOTE);
				die "glob($qdotfile.facedin-*): $!\n"
					if File::Glob::GLOB_ERROR;

				my $seq = @existing ? max(@existing) + 1 : 0;

				link $commit, "$dotfile.facedin-$seq"
					or die "link($commit, $dotfile.facedin-$seq): $!\n";

				foreach my $rm (discard(@existing)) {
					unlink "$dotfile.facedin-$rm"
						or die "unlink($dotfile.facedin-$rm): $!\n";
				}
			}
		}
	}

	foreach my $commit (@_) {
		my $dotfile = $commit;
		$dotfile =~ s{/\.?([^./][^/]*)$}{/.$1};
		rename "$dotfile.facedin-new", $commit
			or die "rename($dotfile.facedin-new, $commit): $!\n";
	}
}

package main;

use Getopt::Long qw(:config gnu_getopt);
use POSIX qw(O_WRONLY O_NOCTTY);

sub print_version {
	my $id = '$Id: facedin 38779 2013-02-15 14:16:04Z wsl $';
	my $url = '$URL: https://svn.uvt.nl/its-id/trunk/sources/facedin/bin/facedin $';
	print "$id\n$url\n" or die $!;
}

sub version {
	print_version();
	exit 0;
}

sub usage {
	my $fh = shift;
	print $fh "Usage: facedin [options]\n",
			" -V, --version        Show version information\n",
			" -h, --help           Show usage information\n",
			" -v, --verbose        Show what happens\n",
			" -c, --config <dir>   Use <dir> as the configuration directory\n",
			" -d, --destdir <dir>  Use <dir> as the filesystem root\n",
			" -n, --dry-run        Simulate only; don't commit changes\n",
			" -N, --files-only     Write files only, do not reload daemons\n",
			" -B, --no-backups     Do not backup files before overwriting\n"
		or die $!;
}

sub help {
	print_version();
	usage(*STDOUT);
	exit 0;
}

do {
	my ($destdir, $verbose, $dryrun, $filesonly, $nobackups, $configdir) = '';

	unless(GetOptions(
		'v|verbose' => \$verbose,
		'V|version' => \&version,
		'h|help' => \&help,
		'c|config=s' => \$configdir,
		'd|destdir=s' => \$destdir,
		'n|dry-run' => \$dryrun,
		'N|files-only' => \$filesonly,
		'B|no-backups' => \$nobackups,
	)) {
		usage(*STDERR);
		exit 1;
	}

	if(@ARGV) {
		usage(*STDERR);
		exit 1;
	}

	umask(077) || die "Can't set umask: $!\n";

	unless(defined $configdir) {
		$configdir = -d '/usr/local/etc/facedin'
			? '/usr/local/etc/facedin'
			: '/etc/facedin';
	}
	my $conf = new Facedin::Config($configdir);
	my $facedin = new Facedin($conf);

	unless($verbose) {
		# redirect stdout to /dev/null
		my $fd = POSIX::open("/dev/null", O_WRONLY | O_NOCTTY);
		die "open(/dev/null): $!\n" unless defined $fd;
		unless($fd == 1) {
			POSIX::dup2($fd, 1)
				or die "dup2($fd, 1): $!\n";
			POSIX::close($fd)
				or die "close($fd, 1): $!\n";
		}
	}

	$facedin->{verbose} = $verbose;
	$facedin->{destdir} = $destdir;
	$facedin->{dryrun} = $dryrun;
	$facedin->{filesonly} = $filesonly;
	$facedin->{backups} = !$nobackups;

	$facedin->print_ssh;
	$facedin->print_uruk;
	$facedin->print_sudo;
	$facedin->tweak_passwd;
	$facedin->tweak_homes;
	$facedin->commit;

	unless($filesonly || $dryrun || $destdir) {
		Facedin::run(qw(sync));

		if(-e '/usr/sbin/nscd') {
			eval {
				Facedin::run(qw(/usr/sbin/nscd -i passwd -i shadow -i group -i gshadow))
			};
			warn $@ if $@;
		}

		Facedin::run(qw(/usr/local/sbin/make-sudoers))
			if -e '/usr/local/sbin/make-sudoers';

		Facedin::run(qw(make -sC /etc/ssh));

		Facedin::run(qw(service uruk force-reload));
	}
};

__END__

=head1 NAME

facedin - manage user accounts

=head1 DESCRIPTION

Accounts are managed by editing OpenSSH configuration files, Uruk iptables
rules files, /etc/passwd and other Unix user account information files, by
creating users' homedirectories, and by
updating ssh authorized_keys files in users' home directories.

=head2 Command line options

=head3 -v, --verbose

Print all actions that are performed.

=head3 -V, --version

Print the software version and exit.

=head3 -h, --help

Print a short option summary.

=head3 -c, --config I<file>

Use I<file> as the configuration directory instead of the default.

=head3 -n, --dry-run

Go through all the motions but do not actually modify the system configuration.
However, files C</etc/.passwd.facedin-new>, C</etc/.shadow.facedin-new>,
C</etc/.group.facedin-new>, C</etc/.gshadow.facedin-new>,
C</etc/ssh/sshd_config.d/.facedin.conf.facedin-new>,
C</etc/uruk/.users.facedin-new> and C</etc/uruk/extra.d/.facedin.facedin-new> are
created.

Use with -v to see what would happen.

=head3 -d, --destdir I<dir>

Use I<dir> as the filesystem root. Useful for testing and debugging.

=head2 Configuration file

The configuration directories /usr/local/etc/facedin and /etc/facedin
are searched for files ending in .conf. They are read in sorted order.

The configuration file for facedin follows a pure declarative style.
Order only matters in the sense that declarations for entities must
precede their use.

Three types of entities are recognized: users, groups and sets.

=head2 Users

Users are declared with simply their unix username as the identifier.

Syntax:

	<uid>: [<anr> [<Full Name>]]
		locked: <yes|no>
		anr: <123456>
		name: <Full Name>
		shell: </bin/zsh>
		expire: 2012-02-29
		ip: 192.0.2.3
		authorized_key: <ssh-rsa J54qdU1VaAvxWtQNu8hLq5EnnEjmVz3QzYJc8vBdMuLbmvLSmFL1moYubB2gGVbX...>

The anr (numeric user ID) and name may be specified either on the same
line as the uid or explicitly in the attribute list (but not both).
The ip and authorized_key attributes are multi-valued.

Typically, users are defined for human useraccounts, I<not> for system
users.

=head2 Groups

Unix groups are declared using a + sign and their unix name.

Syntax:

	<gid>: [<anr>]
		anr: <123>

The anr (numeric group ID) may be specified either on the same line as
the group name or explicitly in the attribute list (but not both).

You can use a group without explicitly declaring it, but in such a case
the group is required to be already present on all hosts that use it.
Such an undeclared group will not be created (nor will it be removed)
automatically.

=head2 Sets

Sets define (possibly empty) sets of users and groups. They may be used
to create sets of users or groups that belong together.

If a set contains users, then facedin will conclude that those users need
to exist.

If a user account that is defined in the configuration exists but is
not defined in any set, it will be removed from that host.

Membership of non-facedin system users of a group on a host is not touched
by facedin. Only facedin-managed users are added to (or removed from)
groups.

Sets are denoted by a % in front of their hostname.

Syntax:

	%dbas: bob jane joe
	%webmasters: jack

	%web: %webmasters +www-data
