#!/usr/bin/perl
# apache2cfg v1.3.4 (c) 8.7.2009 by Andreas Ley  (u) 23.2.2026
# Create apache2 config for multiuser multiserver setup

# FIXME: Implement something like ulimit -S -n `ulimit -H -n`

my $apache2 = '/usr/sbin/apache2';
my $ifconfig = '/sbin/ifconfig';
# There is a bug in /usr/sbin/service - it calls basename and systemctl without setting PATH, so we provide a safe default
$ENV{'PATH'} = '/bin:/usr/bin';
my $service = '/usr/sbin/service';
my $owner = '/usr/sbin/owner';
my $touch = '/usr/bin/touch';

my $systemctl = '/bin/systemctl';
my $systemd_run = '/run/systemd/system';
my $systemd_instances = '/etc/systemd/system/multi-user.target.wants';

my $run = '/run/apache2';

my $root = '/var/www';
my $templates = '/etc/apache2/templates';
my $user = catdir($root,'user');
#my $acme_live = '/var/lib/acme/live';
my $php_version = readlink('/etc/alternatives/php') =~ s/^\/usr\/bin\/php//r;
my $php_fpm = "/etc/php/${php_version}/fpm";
my $common_include = '/etc/apache2/include';
my $mods_available = '/etc/apache2/mods-available';
# May be removed when baumschule is dead
my $common_mods_available = '/etc/apache2/mods-available';

my $myaccesslog = '/usr/bin/myaccesslog';

my $logrotate = '/etc/logrotate.d';

my $shibboleth = '/etc/shibboleth';
my $shibboleth_xml = catfile($shibboleth,'shibboleth2.xml');

# Not needed while we use nullmailer
#my $trusted_users = '/etc/exim4/exim4.trusted_users';

my $direct_routing_if = 'lo';

#my $ua = 'BIG-IP/16.1.4.1';

use Getopt::Long;
use File::Path;
use File::Basename;
use File::Temp 'tempfile';
use File::Spec::Functions;
use NetAddr::IP ':lower';
use List::Util 'uniq';
use JSON;
require 'vip.pl';

sub usage
{
	my $image = $0;
	$image =~ s!.*/!!;
	#print  STDERR  "Usage: $image [options]\n";
	print  	STDERR  "Usage: $image [-v|-q] [-n] [[-m] -c|-C] [-t|-T] [-i] [-e|-E] [-k cmd] [-p|-l|-a|-s] [-A] [[-f|-F] -r command [args [...]] | -u user [...] | vhost [...]]\n";
	#print  STDERR  "-D, --debug		Specify debug tags\n";
	#print  STDERR  "-h, --help		This help\n";
	#print  STDERR  "-x, --trace		Trace execution\n";
	print  STDERR  "-v, --verbose		Verbose mode (may be used several times)\n";
	print  STDERR  "-q, --quiet		Quiet mode\n";
	print  STDERR  "-n, --dry-run		Dry run, don't write to database or files\n";
	print  STDERR  "-m, --multi		Force creation of multiserver configs\n";
	print  STDERR  "-c, --config		Create local configs\n";
	print  STDERR  "-C, --config-test	Create local test configs\n";
	print  STDERR  "-t, --test-config	Test generated config\n";
	print  STDERR  "-T, --test-config-test	Test generated test config\n";
	print  STDERR  "-i, --interfaces	Setup interfaces\n";
	print  STDERR  "-e, --enable		Forcibly enable all configured servers\n";
	print  STDERR  "-E, --start		Forcibly enable and start all configured servers\n";
	print  STDERR  "-k, --command		Run servers w/ cmd\n";
	print  STDERR  "-l, --list		List all vhost names\n";
	print  STDERR  "-p, --pid		List all running servers' pids (from pid files)\n";
	print  STDERR  "-I, --ip		List all vhost's ip addresses\n";
	print  STDERR  "-a, --account		List all user account names\n";
	print  STDERR  "-s, --systemd		List all systemd instances\n";
	print  STDERR  "-r, --run		Run command (with identity of VHost owner and in DocumentRoot)\n";
	print  STDERR  "-j, --json		Output in JSON\n";
	print  STDERR  "-f, --fail		Show VHosts where command failed\n";
	print  STDERR  "-F, --success		Show VHosts where command succeeded\n";
	print  STDERR  "-u, --user		Limit commands to the servers running as these users\n";
	print  STDERR  "-A, --all		Extend command to all IPs of the selected servers (relevant only for -i, -f and -I)\n";
	print  STDERR  "If VHosts are given, commands are limited to the servers hosting these VHosts\n";
	print  STDERR  "If a command is run, VHosts with output are shown, or all if -v is given. Output itself is shown unless -q is specified. If -f is given, only VHosts where command fails are shown; with -F the opposite.\n";
	exit(1);
}

my %opt;
@_ = @ARGV unless (defined($Devel::Trace::TRACE));
$Getopt::Long::ignorecase = 0;
GetOptions (\%opt,'debug|D:s','help|h','trace|x','verbose|v+','quiet|q','dry-run|n+',
	'multi|m','config|c','config-test|C','test-config|t','test-config-test|T',
	'interfaces|i',
	'enable|e','start|E',
	'command|k=s',
	'list|l','pid|p','ip|I','account|a','systemd|s','run|r','user|u','all|A',
	'db=s','db-local-only',
	'fail|f','success|F','json|j') or &usage();
exec($^X,'-d:Trace',$0,@_) if (defined($opt{'trace'}) && !defined($Devel::Trace::TRACE));

&usage if (defined($opt{'help'}) || 
	(defined($opt{'verbose'}) && defined($opt{'quiet'})) ||
	(defined($opt{'run'}) && defined($opt{'user'})) ||
	(defined($opt{'config-test'}) || defined($opt{'test-config-test'})) && (defined($opt{'interfaces'}) || defined($opt{'command'})) ||
	($opt{'pid'} + $opt{'list'} + $opt{'ip'} + $opt{'account'} + $opt{'systemd'} > 1) ||
	(defined($opt{'run'}) || defined($opt{'user'})) && !@ARGV);

if (defined($opt{'verbose'}) || defined($opt{'debug'}) || defined($opt{'trace'})) {
	$|=1;
	select((select(STDERR),$|=1)[0]);
}
#Devel::Trace::trace('on') if (defined($opt{'trace'}));

our %debug;

sub debug
{
	my $file = shift;
	my $line = shift;
	my $prefix = defined($debug{'path'})?$file:defined($debug{'file'})?basename($file):'';
	if (defined($debug{'line'})) {
		$prefix .= ':' if (length($prefix));
		$prefix .= $line;
	}
	$prefix .= '  ' if (length($prefix));
	warn $prefix.(@_>1 ? join(', ',map("\"$_\"",@_))."\n" : "@_\n");
	if (defined($debug{'stacktrace'})) {
		use Carp 'longmess';
		{	no warnings 'once';
			$Carp::MaxArgLen = 0;
			$Carp::MaxArgNum = 0;
		}
		warn longmess('debug called');
	}
}
$debug{undef} = \&debug;

my ($on,$off);
if (defined($opt{'debug'})) {
	for (split(',',$opt{'debug'})) {
		if (/=/) {
			$debug{$`} = $';
		}
		else {
			$debug{$_} = 1;
		}
	}
	&debug(__FILE__,__LINE__,'%debug = '.Data::Dumper->Dump([\%debug],['*'])) if (defined($debug{'debug'}));
	&debug(__FILE__,__LINE__,'%opt = '.Data::Dumper->Dump([\%opt],['*'])) if (defined($debug{'opt'}));
	if (defined($ENV{'TERM'})) {
		use Term::Cap;
		my $term = Tgetent Term::Cap { 'OSPEED'=>9600 };
		$on = $term->Tputs('md');
		$off = $term->Tputs('me');
	}
}

# Enable UTF-8 encoding for already open handles
# ":utf8" would enable perl native coding which happens to be UTF-8 only on ASCII platforms
binmode(STDIN,':encoding(utf8)');
binmode(STDOUT,':encoding(utf8)');
# Triggers "syswrite() is deprecated on :utf8 handles. This will be a fatal error in Perl 5.30 at /usr/share/perl/5.28/sigtrap.pm line 86." when a signal is received
#binmode(STDERR,':encoding(utf8)') unless (defined($Devel::Trace::TRACE));

##############################################################################################################################################################################################

$; = '/' if (%debug);

if (defined($opt{'config-test'}) || defined($opt{'test-config-test'})) {
	$prefix = 'test-';
	$text = 'test ';
}

# Check for multiserver configuration
$multi = -d $user || defined($opt{'multi'});

umask(022);

# Used in debian default configuration for CustomLog
# See /etc/apache2/apache2.conf and /etc/apache2/conf-enabled/other-vhosts-access-log.conf
$ENV{'APACHE_LOG_DIR'} = 'log';

# Used in debian default configuration for SSLSessionCache and ScriptSock
# See /etc/apache2/mods-available/ssl.conf and
# /etc/apache2/mods-available/cgid.conf
$ENV{'APACHE_RUN_DIR'} = 'run';

# Used in debian default configuration for Mutex and DAVLockDB
# See /etc/apache2/apache2.conf and /etc/apache2/mods-available/dav_fs.conf
$ENV{'APACHE_LOCK_DIR'} = $ENV{'APACHE_RUN_DIR'};

################################################################################
#
# Read VHosts configs
#
# Data structures:
#	%vhosts		UID,GID to VHost
#	%uid_gid	VHost to UID,GID
#	%listen		IP to VHost
#	%vhost_ip	VHost to IP(s)
#	%required	UID,GID,IP,Port for all VHosts
#	%provided	UID,GID,IP,Port for IP-based VHosts
#
opendir(ROOT,$root) || die "Can't opendir $root: $!\n";
while ($vhost = readdir(ROOT)) {
	next if ($vhost =~ /^\.\.?$/ || $vhost !~ /\./);

	my $config = catfile($root,$vhost,'conf','httpd.conf');
	if (!open(CONFIG,$config)) {
		warn "Can't read $config: $!\n";
		next;
	}

	&debug(__FILE__,__LINE__,"Reading $config") if (defined($debug{'read'}));
	while (<CONFIG>) {
		# FIXME: There's a pcre syntax for paired quotes...
		if (/^\s*Define\s+(\S+)\s+"*(\S*?[^"])"*\s*$/i) {
			print STDERR "Found: $_" if (defined($debug{'read'}));
			my $define = $1;
			$define{$vhost}{$define} = $2;
			&debug(__FILE__,__LINE__,"Define",$define,$define{$vhost}{$define}) if (defined($debug{'define'}));
			while ($define{$vhost}{$define} =~ /\$\{([^}]+)\}/) {
				my $replace = $1;
				&debug(__FILE__,__LINE__,"Replace",$replace) if (defined($debug{'define'}));
				$define{$vhost}{$define} =~ s/\${$replace}/$define{$vhost}{$replace}/g;
				&debug(__FILE__,__LINE__,"Define",$define,$define{$vhost}{$define}) if (defined($debug{'define'}));
			}
		}
	}
	close(CONFIG);

	my $config = catfile($root,$vhost,'conf','vhost.conf');
	if (!open(CONFIG,$config)) {
		warn "Can't read $config: $!\n";
		next;
	}

	&debug(__FILE__,__LINE__,"Reading $config") if (defined($debug{'read'}));
	while (<CONFIG>) {
		# FIXME: There's a pcre syntax for paired quotes...
		if (/^\s*DocumentRoot\s+"*(\S*?[^"])"*\s*$/i) {
			print STDERR "Found: $_" if (defined($debug{'read'}));
			$docroot{$vhost} = $1;
			while ($docroot{$vhost} =~ /\$\{([^}]+)\}/) {
				my $replace = $1;
				$docroot{$vhost} =~ s/\${$replace}/$define{$vhost}{$replace}/g;
			}
			last;
		}
	}
	close(CONFIG);

	if (!defined($docroot{$vhost})) {
		warn "Can't find DocumentRoot in $config\n";
		next;
	}

	# Stat DocumentRoot for VHost's owner UID/GID
	# This is due to the fact that not every VHost is
	# located in a dedicated user home directory (e.g.
	# on imkwww1) and moving from one UID's server to
	# another one is done by chowning the DocumentRoot
	my $base = ($docroot{$vhost} =~ m!^(/home/ws/(?:[^/]+))/!) ? $1 : $docroot{$vhost};
	&debug(__FILE__,__LINE__,"Statting $base") if (defined($debug{'read'}));
	my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
	if (!(($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($base))) {
		warn "$config: Can't stat $base: $!\n";
		next;
	}
	&debug(__FILE__,__LINE__,"stat($base) = ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)") if (defined($debug{'read'}));

	if (!defined($uid)||!defined($gid)) {
		die "INTERNAL ERROR! $config: Can't find UID/GID for ".$docroot{$vhost}."\n";
	}
	# CHECK: Either die here, or change
	#	if ($multi && -d $php_fpm && $uid && $gid) {
	# to if ($multi && -d $php_fpm) { die "errormessage" unless ($uid && $gid);
	if (!$uid) {
		die "INTERNAL ERROR! $config: ${base} is owned by root!\n";
	}
	if (!$gid) {
		die "INTERNAL ERROR! $config: ${base}'s group is root!\n";
	}

	push(@{$vhosts{$uid,$gid}},$vhost);
	$uid_gid{$vhost} = $uid.$;.$gid;
	&debug(__FILE__,__LINE__,"\$uid_gid{$vhost} = $uid_gid{$vhost}") if (defined($debug{'read'}));

	my $config = catfile($root,$vhost,'conf','httpd.conf');
	if (!open(CONFIG,$config)) {
		warn "Can't read $config: $!\n";
		next;
	}

	&debug(__FILE__,__LINE__,"Reading $config") if (defined($debug{'read'}));
	while (<CONFIG>) {
		# When only a single apache runs, no Listen statements appear in httpd.conf
		# The same holds true for SNI VHosts in multi mode, so to differentiate, we need to register the Listen statements
		if (/^\s*Listen\s+(?:(\d+\.\d+\.\d+\.\d+):|\[([0-9a-f:]+)\]:)?(\d+)/i) {	# IP is optional
			print STDERR "Found $_" if (defined($debug{'read'}));
			# FIXME: Handle case where no IP is defined
			my $ip = NetAddr::IP->new($1.$2);
			my $port = $3;
			&debug(__FILE__,__LINE__,'Found: '.$ip->canon.' '.$port) if (defined($debug{'read'}));
			if (defined($listen{$ip}) && $listen{$ip} ne $vhost) {
				warn "Duplicate IP: $ip used by $listen{$ip} and $vhost\n";
			}
			$listen{$ip} = $vhost;
			# Unfortunatly, objects can't be used as keys
			$provided{$uid,$gid}{$ip->canon}{$port} = 1;
		}
		elsif (/^\s*<VirtualHost\s+(.*\S)?\s*>\s*$/i) {
			print STDERR "Found $_" if (defined($debug{'read'}));
			my $addrs = $1;
			while ($addrs =~ /(?:(\d+\.\d+\.\d+\.\d+)|\[([0-9a-fA-F:]+)\])(?::(\d+))?\s*/) {	# Port is optional
				# FIXME: Handle case where no port is defined
				my $ip = NetAddr::IP->new($1.$2);
				my $port = $3;
				&debug(__FILE__,__LINE__,'Found: '.$ip->canon.' '.$port) if (defined($debug{'read'}));
				$addrs = $';
#				if (defined($vhost{$ip}) && $vhost{$ip} ne $vhost) {
#					warn "Duplicate IP: $ip used by $vhost{$ip} and $vhost\n";
#				}
#				$vhost{$ip} = $vhost;
				#&add_ip(\@{$vhost_ip{$vhost}},$ip);
				# We uniq this later
				push(@{$vhost_ip{$vhost}},$ip->canon);
				# Unfortunatly, objects can't be used as keys
				$required{$uid,$gid}{$ip->canon}{$port} = 1;
			}
		}
	}
	close(CONFIG);

	if (defined($opt{'json'}) || defined($opt{'db'}) && !defined($opt{'db-local-only'})) {
		my $config = catfile($root,$vhost,'conf','identity.conf');
		if (!open(CONFIG,$config)) {
			warn "Can't read $config: $!\n";
			next;
		}

		&debug(__FILE__,__LINE__,"Reading $config") if (defined($debug{'read'}));
		while (<CONFIG>) {
			# FIXME: There's a pcre syntax for paired quotes...
			if (/^\s*ServerAlias\s+(\S*[^\s.])\s*$/i) {
				print STDERR "Found: $_" if (defined($debug{'read'}));
				push(@{$alias{$vhost}},$1);
			}
			elsif (/^\s*ServerAdmin\s+(\S+)\s*$/i) {
				print STDERR "Found: $_" if (defined($debug{'read'}));
				$admin{$vhost} = $1;
			}
		}
		close(CONFIG);
		if (!defined($admin{$vhost})) {
			warn "Can't find ServerAdmin in $config\n";
			next;
		}
	}
}
closedir(ROOT);

################################################################################
#
# Select VHosts
#

# FIXME: Use NetAddr::IP
if ($#ARGV < 0) {
	@selected_uid_gid = sort {$a <=> $b}(keys %vhosts);
	# Huh, perl should have @{values %vhost_ip} ;-)
	#@selected_ip = sort {$a <=> $b} map(@{$_},values %vhost_ip);
	# CHECK: Do we need to sort IPs?
			use Data::Dumper;
	print STDERR "\@vhost_ip = ",Data::Dumper->Dump([\%vhost_ip],['*']) if (defined($debug{'select'}));
	#map(&add_ip(\@selected_ip,$_),map(@{$_},values %vhost_ip)) unless (defined($opt{'all'}));
	@selected_ip = uniq(map(@{$_},values %vhost_ip)) unless (defined($opt{'all'}));
	&debug(__FILE__,__LINE__,'@selected_ip = '.join(' ',@selected_ip).' ('.scalar(@selected_ip).')') if (defined($debug{'select'}));
}
elsif (defined($opt{'run'})) {
	my %json = ( 'run' => join(' ',@ARGV) ) if (defined($opt{'json'}));
	open(MAINOUT,'>&STDOUT');
	open(MAINERR,'>&STDERR');
	for my $vhost (sort keys %uid_gid) {
		print "\n###  $vhost  ###\n" if (defined($opt{'verbose'}) && !defined($opt{'json'}));
		my ($uid,$gid) = split($;,$uid_gid{$vhost});
		my ($tmp,$tmpname) = tempfile(basename($0).'.XXXXXX', TMPDIR => 1, UNLINK => 1);
		my @cmd = ($owner,'-i','-u',$uid.':'.$gid,'-c',$docroot{$vhost},'--',@ARGV);
		print join(' ',@cmd),"\n" if (defined($debug{'select'}));

		open(STDOUT,'>&',$tmp);
		open(STDERR,'>&',$tmp);
		system(@cmd);
		$return_code = $?;
		open(STDOUT,'>&MAINOUT');
		open(STDERR,'>&MAINERR');

		if (defined($opt{'json'})) {
			$json{'vhost'}{$vhost}{'alias'} = \@{$alias{$vhost}} if (@{$alias{$vhost}});
			$json{'vhost'}{$vhost}{'UID'} = $uid;
			$json{'vhost'}{$vhost}{'GID'} = $gid;
			$json{'vhost'}{$vhost}{'admin'} = $admin{$vhost} if (defined($admin{$vhost}));
			$json{'vhost'}{$vhost}{'return code'} = $return_code;
			if (-s $tmp) {
				seek($tmp,0,0);
				while (<$tmp>) {
					$json{'vhost'}{$vhost}{'output'} .= $_;
				}
			}
		}
		else {
			if (defined($opt{'fail'}) && $return_code) {
				print "\n---  $vhost  ---\n";
			}
			if (defined($opt{'success'}) && !$return_code) {
				print "\n+++  $vhost  +++\n";
			}
			unless (defined($opt{'fail'}) || defined($opt{'success'})) {
				if (-s $tmp) {
					print "\n***  $vhost  ***\n" unless (defined($opt{'verbose'}));
					if (!defined($opt{'quiet'})) {
						print "\n";
						seek($tmp,0,0);
						while (<$tmp>) {
							print;
						}
					}
				}
			}
		}
		close($tmp);
	}
	if (defined($opt{'json'})) {
		print JSON->new->pretty->canonical->encode((defined($opt{'fail'}) || defined($opt{'success'})) ? [sort keys %json] : \%json);
	}
}
elsif (defined($opt{'user'})) {
	my %uid_gids;
	for (@ARGV) {
		if (/:/) {
			my $user = $`;
			my $group = $';
			if ($user =~ /^\d+$/) {
				$uid = $user;
			}
			else {
				&debug(__FILE__,__LINE__,"getpwnam($user) = (".join(',',getpwnam($user)).')') if (defined($debug{'select'}));
				$uid = (getpwnam($user))[2] or die "No such user: $user\n";
			}
			if ($group =~ /^\d+$/) {
				$gid = $group;
			}
			else {
				&debug(__FILE__,__LINE__,"getgrnam($group) = (".join(',',getgrnam($group)).')') if (defined($debug{'select'}));
				$gid = (getgrnam($group))[2] or die "No such group: $group\n";
			}
		}
		else {
			if (/^\d+$/) {
				&debug(__FILE__,__LINE__,"getpwuid($_) = (".join(',',getpwuid($_)).')') if (defined($debug{'select'}));
				($uid,$gid) = (getpwuid($_))[2,3] or die "No such uid: $_\n";
			}
			else {
				&debug(__FILE__,__LINE__,"getpwnam($_) = (".join(',',getpwnam($_)).')') if (defined($debug{'select'}));
				($uid,$gid) = (getpwnam($_))[2,3] or die "No such user: $_\n";
			}
		}
		&debug(__FILE__,__LINE__,"$_ = ($uid,$gid)") if (defined($debug{'select'}));
		$uid_gids{$uid,$gid} = '';
	}
	@selected_uid_gid = sort {$a <=> $b}(keys %uid_gids);
	#@selected_ip = sort {$a <=> $b} map(@{$vhost_ip{$_}},map(@{$vhosts{$_}},@selected_uid_gid));
	# CHECK: Do we need to sort IPs?
	#map(&add_ip(\@selected_ip,$_),map(@{$vhost_ip{$_}},map(@{$vhosts{$_}},@selected_uid_gid))) unless (defined($opt{'all'}));
	@selected_ip = uniq(map(@{$vhost_ip{$_}},map(@{$vhosts{$_}},@selected_uid_gid))) unless (defined($opt{'all'}));
}
else {
	for (@ARGV) {
		if (!defined($vhost_ip{$_})) {
			exit(1) if (defined($opt{'quiet'}));
			die "No such VHost: $_\n";
		}
	}
	my %uid_gids;
	@uid_gids{@uid_gid{@ARGV}} = '';
	@selected_uid_gid = sort {$a <=> $b}(keys %uid_gids);
	#@selected_ip = sort {$a <=> $b} map(@{$vhost_ip{$_}},@ARGV);
	# CHECK: Do we need to sort IPs?
	#map(&add_ip(\@selected_ip,$_),map(@{$vhost_ip{$_}},@ARGV)) unless (defined($opt{'all'}));
	@selected_ip = uniq(map(@{$vhost_ip{$_}},@ARGV)) unless (defined($opt{'all'}));
}
#@selected_ip = sort {$a <=> $b} map(@{$vhost_ip{$_}},map(@{$vhosts{$_}},@selected_uid_gid)) if (defined($opt{'all'}));
# CHECK: Do we need to sort IPs?
#map(&add_ip(\@selected_ip,$_),map(@{$vhost_ip{$_}},map(@{$vhosts{$_}},@selected_uid_gid))) if (defined($opt{'all'}));
@selected_ip = uniq(map(@{$vhost_ip{$_}},map(@{$vhosts{$_}},@selected_uid_gid))) if (defined($opt{'all'}));
&debug(__FILE__,__LINE__,'@selected_ip = '.join(' ',@selected_ip).' ('.scalar(@selected_ip).')') if (defined($debug{'select'}));
&debug(__FILE__,__LINE__,'@selected_uid_gid = '.join(' ',@selected_uid_gid).' ('.scalar(@selected_uid_gid).')') if (defined($debug{'select'}));
#undef %vhost_ip;
undef %uid_gid;

################################################################################
#
# Check system resources
#
$instances = scalar(keys %vhosts);
&debug(__FILE__,__LINE__,"Instances: $instances") if (defined($debug{'sem'}));

if (open(SEM,'<','/proc/sys/kernel/sem')) {
	($semmsl,$semmns,$semopm,$semmni) = split(' ',<SEM>);
	close(SEM);
	# For description, see ipcs -s -l
	&debug(__FILE__,__LINE__,"Sem: $semmsl $semmns $semopm $semmni") if (defined($debug{'sem'}));

	$set = 0;
	# Apache 2.2: Each apache instance requires 4 semaphore sets (using just one semaphore per set), two in the root owned listener process and two in the cgi handling process(?)
	# Apache 2.4: Each apache instance requires 5 semaphore sets (using just one semaphore per set), two in some vanishing startup process, two in the root owned listener process and one in the cgi handling process(?)
	# System requires at least 1 semaphore in addition to apache instances
	# Beware: crashing apaches don't free their semaphores! So double the limits...
	# See ipcs -u
	if ($semmni < $instances*10+32) {
		$semmni = $instances*10+32;
		$set = 1;
	}
	if ($semmns < $semmsl*$semmni) {
		$semmns = $semmsl*$semmni;
		$set = 1;
	}

	if ($set) {
		if (open(SEM,'>','/proc/sys/kernel/sem')) {
			&debug(__FILE__,__LINE__,"Sem set: $semmsl $semmns $semopm $semmni") if (defined($debug{'sem'}));
			print SEM "$semmsl\t$semmns\t$semopm\t$semmni\n" or warn "Can't write \"$semmsl $semmns $semopm $semmni\" to /proc/sys/kernel/sem: $!\n";
			close(SEM) or warn "Can't close /proc/sys/kernel/sem: $!\n";
		}
		else {
			warn "Can't write to /proc/sys/kernel/sem: $!\n";
		}
	}
}
else {
	warn "Can't read /proc/sys/kernel/sem: $!\n";
}

################################################################################
#
# Setup virtual interfaces
#

if (defined($opt{'interfaces'})) {
	&init_rc_values();
	&init_interfaces();
	#&add_vip(0,@selected_ip);
	&add_vip(0,map(NetAddr::IP->new($_),@selected_ip));
}

################################################################################
#
# Create configs
#
if (defined($opt{'config'}) || defined($opt{'config-test'})) {
	# FIXME: determine unused directories and only delete them - otherwise
	# we also loose the error.log's of active servers when restarting
	# In fact, we even don't have to delete them, since we use only active
	# servers for commands, not the list of subdirectories in $user
	# FIXME: add a cleanup option
	#rmtree($user,0,1);
	#my ($dev,$ino,$mode,$nlink,$uid,$wwwadm,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($myaccesslog) or warn "Can't stat $myaccesslog: $!\nLogs won't be accessible!\n";

	# Create /etc/shibboleth/shibboleth2.xml
	# CHECK: Does this work in a non-multi environment?
	# May be referenced in httpd.conf, so this must be run before apache2 -t
	if (-d $shibboleth) {
		my ($ApplicationOverride,$RequestMap);
		my $template_ApplicationOverride = &read_file(catfile($templates,'shibboleth.ApplicationOverride'));
		my $template_RequestMap = &read_file(catfile($templates,'shibboleth.RequestMap'));
		my $template_Rewrite = &read_file(catfile($templates,'shibboleth.Rewrite'));

		for $vhost (sort byvhost map { @{$vhosts{$_}} } keys %vhosts) {
			my $vhost_root = catdir($root,$vhost);
			my $vhost_conf = catdir($vhost_root,'conf');
			my $vhost_ssl = catdir($vhost_conf,'ssl');
			my $key = catfile($vhost_ssl,'sp.key');
			my $crt = catfile($vhost_ssl,'sp.crt');
			if (-s $crt) {
				my $entityID = &read_file(catfile($vhost_conf,'shibboleth.id'),1) =~ s/\n.*//r // 'https://'.$vhost.'/shibboleth';
				$ApplicationOverride .= &template($template_ApplicationOverride,{'FQDN'=>$vhost,'ENTITYID'=>$entityID,'KEY'=>$key,'CRT'=>$crt});
				$RequestMap .= &template($template_RequestMap,{'FQDN'=>$vhost});
				if (-s catfile($vhost_conf,'shibboleth.conf')) {
					# Create shibboleth rewrite configuration from shibboleth authentication configuration
					$authentication = &read_file(catfile($vhost_conf,'shibboleth.conf'));
					$rewrite = &read_file(catfile($templates,'shibboleth-rewrite.conf'));
					for (split(/^/m,$authentication)) {
						if (/^\s*<(?:Directory|Files|Location)(?:Match)?\s+([^>]+)>\s*$/i) {
							$rewrite .= $_;
							$rewrite .= &template($template_Rewrite,{'TOPLEVEL'=>($1 eq $docroot{$vhost})});
						}
						elsif (/^\s*<\/(?:Directory|Files|Location)(?:Match)?>\s*$/i) {
							$rewrite .= $_;
						}
					}
					&write_file($rewrite,catfile($vhost_conf,'shibboleth-rewrite.conf'));
				}
			}
		}

		if (&template_file(catfile($templates,'shibboleth2.xml'),$shibboleth_xml,{'APPLICATIONOVERRIDE'=>$ApplicationOverride,'REQUESTMAP'=>$RequestMap})) {
			system($service,'shibd','restart') and die "Can't restart shibd service\n";
		}
	}

	if ($multi) {
		for $uid_gid (@selected_uid_gid) {
			my ($uid,$gid) = split($;,$uid_gid);
			#my $server_root = catdir($user,$uid,$gid);
			# To allow for a unique syntax for -u and pathnames for systemd service files
			my $server_root = catdir($user,$uid.':'.$gid);
			my $server_conf = catdir($server_root,'conf');
			my $server_log = catdir($server_root,'log');
			my $server_log_fpm = catfile($server_log,'php-fpm_slow.log');
			my $server_run = catdir($server_root,'run');
			my $config = catfile($server_conf,$prefix.'httpd.conf');
			my $run = catdir('/run','httpd',$uid.':'.$gid);
			&debug(__FILE__,__LINE__,"UID: $uid  GID: $gid") if (defined($debug{'config'}));

			mkpath($server_conf);
			mkpath($server_log,0,0750);
			# CHECK: Is this still required with user access to the logs? Or is it needed for cgi-bin/myaccesslog?
			#chown(-1,$wwwadm,$server_log) if (defined($wwwadm));
			chown(0,$gid,$server_log);
			# FIXME: touch it so it's available on the first run
			chmod(0644,$server_log_fpm) if (-d $php_fpm);
			mkpath($server_run) unless (-d $php_fpm);
			if (-d $php_fpm) {
				my $server_php = catdir($server_root,'php');
				mkpath($server_php,0,0750);
				chown($uid,$gid,$server_php);
				# For PHP configuration by external web-master tool
				my $php_conf = catfile($server_conf,$prefix.'local-php.conf');
				unless (-e $php_conf) {
					open(PHP,'>',$php_conf) || die "Can't write to $php_conf: $!\n";
					close(PHP);
				}
			}

			# Convenience links
			#symlink(catdir($uid,$gid),catfile($user,$name)) if (($name,$ngid) = (getpwuid($uid))[0,3] and $gid == $ngid);
			symlink($uid.':'.$gid,catfile($user,$name)) if (($name,$ngid) = (getpwuid($uid))[0,3] and $gid == $ngid);
			# Read modules config
			my @modules;
			for my $vhost (@{$vhosts{$uid_gid}}) {
				&debug(__FILE__,__LINE__,"Configuring $vhost") if (defined($debug{'config'}));
				my $vhost_root = catdir($root,$vhost);
				my $vhost_conf = catdir($vhost_root,'conf');
#				my $dehydrated = catdir($vhost_conf,'ssl','dehydrated');
#				my $acme = catfile($acme_live,$vhost,'cert');

#				# FIXME: This must also be done in the non-multi case - perhaps move to the ssl certificate handling scripts?
#				# TEST: Force a return value to avoid rewriting (and redistributing) ssl.conf all the time
#				# FIXME: Remove the wantarray from template_file and write_file and always do this check?
#				# FIXME: If everything is >= buster, change ssl.conf to a static version with <IfFile>
#				my @force_check = &template_file(catfile($templates,'ssl.conf'),catfile($vhost_conf,'ssl.conf'),
#					{'FQDN'=>$vhost,
#					'SERVER_CONF'=>$vhost_conf,
#					'DEHYDRATED'=>-s catfile($dehydrated,'cert.pem'),
#					'ACME'=>-s $acme});

				my $link = catfile($vhost_root,'server');
				&debug(__FILE__,__LINE__,join(' ','ln','-s',$server_root,$link)) if (defined($debug{'config'}));
				unlink($link);
				symlink($server_root,$link);

				# Generate named systemd aliases
				# Does not work any more
				# Bullseye said:
				#  Jul 19 16:16:40 web5 systemd[1]: Suspicious symlink /run/systemd/system/httpd@www.chiranet.kit.edu.serviceâ/etc/systemd/system/multi-user.target.wants/httpd@204333:44479.service, treating as alias.
				#  Jul 19 16:16:40 web5 systemd[1]: /run/systemd/system/httpd@www.chiranet.kit.edu.service: unit symlink target "httpd@204333:44479.service" instance name doesn't match, rejecting.
				# Bookworm said:
				#  Jul 19 16:33:45 web1 systemd[1]: httpd@stage.dnmfnet.eu.service: unit symlink target "httpd@208337:45228.service" instance name doesn't match, rejecting.
				# systemd.unit(1):
				#  A template instance may only be aliased by another template instance, and the instance part must be identical.
				# However, "sc" will look at these symlinks and emulate toe former behavior
				my $link = catfile($systemd_run,'httpd@'.$vhost.'.service');
				my $instance = catfile($systemd_instances,'httpd@'.$uid.':'.$gid.'.service');
				&debug(__FILE__,__LINE__,join(' ','ln','-s',$instance,$link)) if (defined($debug{'config'}));
				unlink($link);
				symlink($instance,$link);

				if (open(MODULES,'<',catfile($vhost_conf,'modules'))) {
					&debug(__FILE__,__LINE__,'Reading '.catfile($vhost_conf,'modules')) if (defined($debug{'config'}));
					while (<MODULES>) {
						chomp;
						s/\s*#.*$//;
						next if (/^\s*$/);
						&debug(__FILE__,__LINE__,"Module: $_") if (defined($debug{'config'}));
						for my $file (catfile($common_include,$_),catfile($common_mods_available,$_.'.load'),catfile($common_mods_available,$_.'.conf'),catfile($mods_available,$_.'.load'),catfile($mods_available,$_.'.conf')) {
							&debug(__FILE__,__LINE__,"Module path: $file") if (defined($debug{'config'}));
							push(@modules,$file) if (-e $file && !grep($_ eq $file,@modules));
						}
					}
					close(MODULES);
					&debug(__FILE__,__LINE__,'Modules: '.join(', ',@modules)) if (defined($debug{'config'}));
				}
			}

			my @listen;
			use Data::Dumper;
			$Data::Dumper::Indent = 1;
			$Data::Dumper::Terse = 1;
			$Data::Dumper::Sortkeys = 1;
			$Data::Dumper::Deepcopy = 1;
			#warn Data::Dumper->Dump([\%provided],['*']) if (defined($debug{'config'}));
			#warn Data::Dumper->new([\%hash],['*'])->Indent(0)->Dump if (defined($debug{'config'}));

			warn '%required = '.Data::Dumper->Dump([$required{$uid_gid}],['*']) if (defined($debug{'config'}));
			warn '%provided = '.Data::Dumper->Dump([$provided{$uid_gid}],['*']) if (defined($debug{'config'}));
			# Generate list of Listen addresses for SNI VHosts
			# Unfortunatly, objects can't be used as keys
			for my $ip (sort map(NetAddr::IP->new($_),keys %{$required{$uid_gid}})) {
				warn "Check $ip" if (defined($debug{'config'}));
				for my $port (sort {$a<=>$b} keys %{$required{$uid_gid}{$ip->canon}}) {
					warn "Check $port" if (defined($debug{'config'}));
					push(@listen,($ip->version==6?'['.$ip->canon.']':$ip->canon).':'.$port) unless (defined($provided{$uid_gid}{$ip->canon}{$port}));
				}
			}
			warn '@listen = '.Data::Dumper->Dump([\@listen],['*']) if (defined($debug{'config'}));

			# Create server config
			# Beware that here SERVER_ROOT refers to the apache instance, while in vhost it refers to the VHost
			# (but apache itself uses SERVER_NAME environment variable derived from ServerName which is a VHost directive while ServerRoot is an instance directive)
			&template_file(catfile($templates,$prefix.'server.conf'),$config,
				{'UID'=>$uid,
				'GID'=>$gid,
				'SNI'=>!!@listen,
				'LISTEN'=>\@listen,
				'ROOT'=>$root,
				'SERVER_ROOT'=>$server_root,
				'MODULES'=>\@modules,
				'PHP_FPM'=>-d $php_fpm,
				'VHOSTS'=>$vhosts{$uid_gid}});

# Tests must be requested explicitly with -t:
# DefaultRuntimeDir must be a valid directory, but it gets only created by httpd@.service, so when httpd.service starts, a test would fail

		}

		if (defined($trusted_users)) {
			open(TRUSTED_USERS,'>',$trusted_users) or die "Can't write to $trusted_users: $!\n";
			print TRUSTED_USERS join(':',sort map((split($;,$_))[0],keys %vhosts)),"\n";
			close(TRUSTED_USERS);
		}
	}

	# Now the configs that have to be created for multi-user and single server
	for $uid_gid (@selected_uid_gid) {
		for my $vhost (@{$vhosts{$uid_gid}}) {
			&debug(__FILE__,__LINE__,"Configuring $vhost for SSL") if (defined($debug{'config'}));
			my $vhost_root = catdir($root,$vhost);
			my $vhost_conf = catdir($vhost_root,'conf');
#			my $acme = catfile($acme_live,$vhost,'cert');
			my $dehydrated = catdir($vhost_conf,'ssl','dehydrated');
			&debug(__FILE__,__LINE__,"dehydrated: $dehydrated") if (defined($debug{'config'}));

			# TEST: Force a return value to avoid rewriting (and redistributing) ssl.conf all the time
			# FIXME: Remove the wantarray from template_file and write_file and always do this check?
			# FIXME: If everything is >= buster, change ssl.conf to a static version with <IfFile>
			my @force_check = &template_file(catfile($templates,'ssl.conf'),catfile($vhost_conf,'ssl.conf'),
				{'FQDN'=>$vhost,
				'SERVER_CONF'=>$vhost_conf,
#				'ACME'=>-s $acme,
				'DEHYDRATED'=>-s catfile($dehydrated,'cert.pem')});
		}
	}

	# Create single entry or uid-specific entries in /etc/logrotate.d/ and /etc/php/${php_version}/fpm/pool.d
	my $append;
	#for $uid_gid (sort {$a <=> $b} ($uid_specific_entries ? @selected_uid_gid : keys %vhosts)) {
	my @uid_gid = (sort {$a <=> $b} ($uid_specific_entries ? @selected_uid_gid : keys %vhosts));
	my $last_uid_gid = $uid_gid[$#uid_gid];
	for $uid_gid (@uid_gid) {
		my ($uid,$gid) = split($;,$uid_gid);
		#my $server_root = catdir($user,$uid,$gid) if ($multi);
		my $server_root = catdir($user,$uid.':'.$gid) if ($multi);
		my @vhosts = sort byvhost @{$vhosts{$uid_gid}};

		if (defined($logrotate)) {
			&template_file(catfile($templates,'logrotate'),
				catfile($logrotate,($uid_specific_entries ? 'apache2-'.$uid.'-'.$gid : 'httpd')),
				{'LOGFILES'=>'"'.join("\"\n\"",
					map((catfile($root,$_,'log','access.log'),
						catfile($root,$_,'log','error.log'),
						catfile($root,$_,'log','csp-report.log'),
						catfile($root,$_,'php','error.log')),@vhosts),
					$multi?(catfile($server_root,'log','other_vhosts_access.log'),
						catfile($server_root,'log','error.log'),
					-d $php_fpm?(catfile($server_root,'log','php-fpm_slow.log'),
						catfile($server_root,'php','php-fpm_error.log')) : ()) : (),
					).'"',
				'OPTS'=>$multi?' -u '.$uid.':'.$gid:'',
				'SLEEP'=>($uid_gid eq $last_uid_gid),
				'FQDNS'=>'"'.join('" "',@vhosts).'"'},$append);
		}

		# PHP-FPM fails if user or group is root:
		# php-fpm7.3[164893]: [08-Feb-2021 16:49:27] ERROR: [pool 238960:0] please specify user and group other than root
		if ($multi && -d $php_fpm && $uid && $gid) {
			my $user = getpwuid($uid) or die "Can't resolve UID $uid: $!\n";
			#&template_file(catfile($templates,"php${php_version}-fpm.conf"),
			&template_file(catfile($templates,'php-fpm.conf'),
				catfile($php_fpm,$prefix.'pool.d',($uid_specific_entries ? $uid.':'.$gid : 'www').'.conf'),
				{'UID'=>$uid,
				'GID'=>$gid,
				# https://bugs.php.net/bug.php?id=77062
				# For PHP FPM < 7.4, we can't use numeric uid for listen.owner
				# This is a BAD hack: We can't guarantee that this is the user with the given uid AND gid
				# However, this is only used to set the uid on the domain socket, so we only need ANY user with the given uid
				'OWNER'=>($php_version>=7.4?$uid:$user),
				'USER'=>$user,
				'ROOT'=>$root,
				'PREFIX'=>$prefix,
				'VHOSTS'=>$vhosts{$uid_gid}},$append);
		}

		$append = !$uid_specific_entries;
	}
	# FIXME: Check if (appended) logrotate config actually changed
	# FIXME CHECK: Does logrotate really need to restart to use the new config? This is timer triggered, no daemon, and should use the new config _for the next run_. Also restarting triggers an additional logrotate run even if it already has been started today. Perhaps the observed usage of an old config resulted from an earlier, still running logrotate instance â¦
	#system($service,'logrotate','restart') and die "Can't restart logrotate service\n";
}

################################################################################
#
# Check configs
#
if (defined($opt{'test-config'}) || defined($opt{'test-config-test'})) {
	if ($multi) {
		for $uid_gid (@selected_uid_gid) {
			my ($uid,$gid) = split($;,$uid_gid);
			#my $server_root = catdir($user,$uid,$gid);
			my $server_root = catdir($user,$uid.':'.$gid);
			my $config = catfile($server_root,'conf',$prefix.'httpd.conf');
			if (-d $php_fpm) {
				my $run = catdir('/run','httpd',$uid.':'.$gid);
				$ENV{'APACHE_RUN_DIR'} = $run;
				$ENV{'APACHE_LOCK_DIR'} = $ENV{'APACHE_RUN_DIR'};
			}
			print "Testing ${test}config for $uid:$gid\n",map(" - $_\n", @{$vhosts{$uid_gid}}) if (defined($opt{'verbose'}));
			my @opts=('-DDUMP_CONFIG') if (defined($debug{'test'}));
			# Avoid "AH00112: Warning: DocumentRoot [/home/ws/scc-web-0015/test.scc.kit.edu/htdocs] does not exist"
			my @cmd = ($apache2,'-f',$config,'-T','-t',@opts);
			&debug(__FILE__,__LINE__,join(' ','+',@cmd)) if (defined($debug{'exec'}) || defined($debug{'test'}));
			system(@cmd) and die "Can't run ".join(' ',@cmd).": $!\n";
			#@cmd = ($owner,'-i','-u',$uid.':'.$gid,'--',$apache2,'-f',$config,'-t',@opts) && exit(1);
			#&debug(__FILE__,__LINE__,join(' ','+',@cmd)) if (defined($debug{'exec'}) || defined($debug{'test'}));
			#system(@cmd) and die "Can't run ".join(' ',@cmd).": $!\n";
		}
	}
	else {
		warn 'Not yet implemented!';
	}
}

################################################################################
#
# Enable / start instances
#
if (defined($opt{'enable'}) || defined($opt{'start'})) {
	if ($multi) {
		for $uid_gid (@selected_uid_gid) {
			my ($uid,$gid) = split($;,$uid_gid);
			print "Enabling servers for $uid:$gid\n",map(" - $_\n", @{$vhosts{$uid_gid}}) if (defined($opt{'verbose'}));
			my @cmd = ($systemctl,'enable','httpd@'.$uid.':'.$gid.'.service');
			&debug(__FILE__,__LINE__,join(' ','+',@cmd)) if (defined($debug{'exec'}) || defined($debug{'enable'}));
			system(@cmd) and die "Can't run ".join(' ',@cmd).": $!\n";
			if (defined($opt{'start'})) {
				print "Starting servers for $uid:$gid\n",map(" - $_\n", @{$vhosts{$uid_gid}}) if (defined($opt{'verbose'}));
				my @cmd = ($systemctl,'start','httpd@'.$uid.':'.$gid.'.service');
				&debug(__FILE__,__LINE__,join(' ','+',@cmd)) if (defined($debug{'exec'}) || defined($debug{'start'}));
				system(@cmd) and die "Can't run ".join(' ',@cmd).": $!\n";
			}
		}
	}
	else {
		warn 'Makes no sense!';
	}
}

################################################################################
#
# Run apache command
#
if (defined($opt{'command'})) {
	# /etc/apache2/mods-available/ssl.conf requires run directory
	# In fact, it requires ${APACHE_RUN_DIR}, and this is more complex nowadays
	#mkpath($run);
	if ($multi) {
		for $uid_gid (@selected_uid_gid) {
			my ($uid,$gid) = split($;,$uid_gid);
			#my $server_root = catdir($user,$uid,$gid);
			my $server_root = catdir($user,$uid.':'.$gid);
			my $config = catfile($server_root,'conf','httpd.conf');
			if (-d $php_fpm) {
				my $run = catdir('/run','httpd',$uid.':'.$gid);
				$ENV{'APACHE_RUN_DIR'} = $run;
				$ENV{'APACHE_LOCK_DIR'} = $ENV{'APACHE_RUN_DIR'};
			}
			if (defined($opt{'verbose'})) {
				print 'Starting' if ($opt{'command'} eq 'start');
				print 'Restarting' if ($opt{'command'} eq 'restart');
				print 'Gracefully restarting' if ($opt{'command'} eq 'graceful');
				print 'Gracefully stopping' if ($opt{'command'} eq 'graceful-stop');
				print 'Stopping' if ($opt{'command'} eq 'stop');
				print " servers for $uid:$gid\n",map(" - $_\n", @{$vhosts{$uid_gid}});
			}
			my @cmd = ($apache2,'-f',$config,'-T','-k',$opt{'command'});
			&debug(__FILE__,__LINE__,join(' ','+',@cmd)) if (defined($debug{'exec'}) || defined($debug{'command'}));
			system(@cmd) and die "Can't run ".join(' ',@cmd).": $!\n";
		}
	}
	else {
		warn 'Not yet implemented!';
	}
}

################################################################################
#
# List apache pids
#
if (defined($opt{'pid'})) {
	my (@pids);
	if ($multi) {
		for $uid_gid (@selected_uid_gid) {
			my ($uid,$gid) = split($;,$uid_gid);
			#my $server_root = catdir($user,$uid,$gid);
			my $server_root = catdir($user,$uid.':'.$gid);
			my $pid = catfile($server_root,'run','httpd.pid');
			if (open(PID,$pid)) {
				while (<PID>) {
					chomp;
					push(@pids,$_);
				}
				close(PID);
			}
		}
	}
	else {
		warn 'Not yet implemented!';
	}
	for $pid (sort {$a <=> $b} @pids) {
		print $pid,"\n";
	}
}

################################################################################
#
# List apache instances
#
if (defined($opt{'list'})) {
	for $vhost (sort byvhost map(@{$vhosts{$_}},@selected_uid_gid)) {
		print $vhost,"\n";
	}
}

################################################################################
#
# List apache ips
#
if (defined($opt{'ip'})) {
	for my $ip (sort @selected_ip) {
		print $ip->canon,"\n";
	}
}

################################################################################
#
# List apache users
#
if (defined($opt{'account'}) || defined($opt{'systemd'})) {
	for $uid_gid (@selected_uid_gid) {
		my ($uid,$gid) = split($;,$uid_gid);
		printf "%s\t%d:%d\n",(getpwuid($uid))[0],$uid,$gid if (defined($opt{'account'}));
		printf "httpd@%d:%d\n",$uid,$gid if (defined($opt{'systemd'}));
	}
}

################################################################################
#
# Populate DB
#
sub quote
{
	my ($text) = @_;

	$text =~ s/'/''/g;

	return($text);
}

if (defined($opt{'db'})) {
	my $cluster = &read_file('/etc/cluster/name');
	chomp $cluster;
	print "USE `$opt{'db'}`\n";
	for $uid_gid (@selected_uid_gid) {
		my ($uid,$gid) = split($;,$uid_gid);
		my $account = (getpwuid($uid))[0];
		$account{$uid_gid} = $account;
		$account_account_len = length($account) if (length($account) > $account_account_len);
		my $server_root = catdir($user,$uid.':'.$gid);
		my $server_conf = catdir($server_root,'conf');
		if (open(MODULES,'<',catfile($server_conf,'modules.conf'))) {
			$account_module_account_len = length($account) if (length($account) > $account_module_account_len);
			while (<MODULES>) {
				chomp;
				if (m!^Include\s*"/etc/apache2/mods-available/(\S+).load"$!) {
					&debug(__FILE__,__LINE__,"Module: $1") if (defined($debug{'config'}));
					$account_module_module_len = length($1) if (length($1) > $account_module_module_len);
					push(@{$account_module{$account}},$1);
				}
			}
			close(MODULES);
		}
		if (!defined($opt{'db-local-only'})) {
			$conf{$uid_gid} .= &read_file(catfile($server_conf,'local.conf'),1);
			$account_conf_len = length($conf{$uid_gid}) if (length($conf{$uid_gid}) > $account_conf_len);
			$php{$uid_gid} .= &read_file(catfile($server_conf,'local-php.conf'),1);
			$account_php_len = length($php{$uid_gid}) if (length($php{$uid_gid}) > $account_php_len);
		}
		for my $vhost (@{$vhosts{$uid_gid}}) {
			$vhost_vhost_len = length($vhost) if (length($vhost) > $vhost_vhost_len);
			$vhost_account_len = length($account) if (length($account) > $vhost_account_len);
			$vhost_admin_len = length($admin{$vhost}) if (length($admin{$vhost}) > $vhost_admin_len);

			for my $alias (@{$alias{$vhost}}) {
				$alias_alias_len = length($alias) if (length($alias) > $alias_alias_len);
				$alias_vhost_len = length($vhost) if (length($vhost) > $alias_vhost_len);
			}

			my $vhost_root = catdir($root,$vhost);
			my $vhost_conf = catdir($vhost_root,'conf');

			$key{$vhost} = &read_file(catfile($vhost_conf,'ssl','dehydrated','privkey.pem'),1);
			$vhost_key_len = length($key{$vhost}) if (length($key{$vhost}) > $vhost_key_len);
			$crt{$vhost} = &read_file(catfile($vhost_conf,'ssl','dehydrated','cert.pem'),1);
			$vhost_crt_len = length($crt{$vhost}) if (length($crt{$vhost}) > $vhost_crt_len);
			$chn{$vhost} = &read_file(catfile($vhost_conf,'ssl','dehydrated','chain.pem'),1);
			$vhost_chn_len = length($chn{$vhost}) if (length($chn{$vhost}) > $vhost_chn_len);

			if (open(MODULES,'<',catfile($vhost_conf,'modules'))) {
				$account_module_account_len = length($account) if (length($account) > $account_module_account_len);
				while (<MODULES>) {
					chomp;
					s/\s*#.*$//;
					next if (/^\s*$/);
					&debug(__FILE__,__LINE__,"Module: $_") if (defined($debug{'config'}));
					$account_module_module_len = length($_) if (length($_) > $account_module_module_len);
					push(@{$account_module{$account}},$_);
				}
				close(MODULES);
			}

			if (!defined($opt{'db-local-only'})) {
				if (open(CONF,'<',catfile($vhost_conf,'local.conf'))) {
					my $p;
					while (<CONF>) {
						chomp;
						next if (/^ServerAlias\s+test-/);
						$p = 1 unless (/^(#.*|\s*)$/);
						$conf{$vhost} .= $_."\n" if ($p);
					}
					close(CONF);
					$vhost_conf_len = length($conf{$vhost}) if (length($conf{$vhost}) > $vhost_conf_len);
				}

				if (open(PHP,'<',catfile($vhost_conf,'local-php.conf'))) {
					my $p;
					while (<PHP>) {
						chomp;
						$p = 1 unless (/^(;.*|\s*)$/);
						$php{$uid_gid} .= $_."\n" if ($p);
					}
					close(PHP);
					$account_php_len = length($php{$uid_gid}) if (length($php{$uid_gid}) > $account_php_len);
				}

				if (-s catfile($vhost_conf,'http.keytab')) {
					$keytab{$uid_gid} = &read_file(catfile($vhost_conf,'http.keytab'),1);
					$account_keytab_len = length($keytab{$uid_gid}) if (length($keytab{$uid_gid}) > $account_keytab_len);
				}

			}
		}
	}

	use File::Find;
	find(\&wanted,'/etc/apache2/mods-available','/etc/apache2/mods-enabled');
	sub wanted
	{
		if (/\.load$/) {
			my $module = $`;
			# This is the only case where the config filename differs from the loaded module filename :facepalm:
			$module =~ s/dump_io/dumpio/;
			$module_module_len = length($module) if (length($module) > $module_module_len);
			#&debug(__FILE__,__LINE__,$File::Find::dir);
			push(@{$module{$File::Find::dir}},$module);
		}
	}

	my @servers;
	open(SERVERS,'<','/etc/apache2/servers') or die;
	while (<SERVERS>) {
		chomp;
		$host_host_len = length($_) if (length($_) > $host_host_len);
		push(@servers,$_);
	}
	close(SERVERS);

	if ($alter_table) {
		print "ALTER TABLE `account` CHANGE `Account` `Account` VARCHAR($account_account_len);\n";
		print "ALTER TABLE `account` CHANGE `PHP` `PHP` VARCHAR($account_php_len);\n";
		print "ALTER TABLE `account` CHANGE `Keytab` `Keytab` VARBINARY($account_keytab_len);\n";
		print "ALTER TABLE `vhost` CHANGE `VHost` `VHost` VARCHAR($vhost_vhost_len);\n";
		print "ALTER TABLE `vhost` CHANGE `Account` `Account` VARCHAR($vhost_account_len);\n";
		print "ALTER TABLE `vhost` CHANGE `Admin` `Admin` VARCHAR($vhost_admin_len);\n";
		print "ALTER TABLE `vhost` CHANGE `Conf` `Conf` VARCHAR($vhost_conf_len);\n";
		print "ALTER TABLE `vhost` CHANGE `Key` `Key` VARCHAR($vhost_key_len);\n";
		print "ALTER TABLE `vhost` CHANGE `Cert` `Cert` VARCHAR($vhost_crt_len);\n";
		print "ALTER TABLE `vhost` CHANGE `Chain` `Chain` VARCHAR($vhost_chn_len);\n";
		print "ALTER TABLE `alias` CHANGE `Alias` `Alias` VARCHAR($alias_alias_len);\n";
		print "ALTER TABLE `alias` CHANGE `VHost` `VHost` VARCHAR($alias_vhost_len);\n";
		print "ALTER TABLE `module` CHANGE `Module` `Module` VARCHAR($module_module_len);\n";
		print "ALTER TABLE `account_module` CHANGE `Account` `Account` VARCHAR($account_module_account_len);\n";
		print "ALTER TABLE `account_module` CHANGE `Module` `Module` VARCHAR($account_module_module_len);\n";
		print "ALTER TABLE `host` CHANGE `Host` `Host` VARCHAR($host_host_len);\n";
	}
	for $uid_gid (@selected_uid_gid) {
		my ($uid,$gid) = split($;,$uid_gid);
		my $account = $account{$uid_gid};

		if (!defined($opt{'db-local-only'})) {
			my ($ipv4,$ipv6);
			for my $vhost (@{$vhosts{$uid_gid}}) {
				for my $addr (@{$vhost_ip{$vhost}}) {
					$ip = NetAddr::IP->new($addr);
					if ($ip->version == 4) {
						$ipv4 = unpack('H*',$ip->aton);
					}
					else {
						$ipv6 = unpack('H*',$ip->aton);
					}
				}
				print "INSERT INTO `vhost` (`VHost`,`Account`,`Admin`".(defined($conf{$vhost})?",`Conf`":'').",`Key`,`Cert`,`Chain`) VALUES ('$vhost','$account','$admin{$vhost}'".(defined($conf{$vhost})?",'".&quote($conf{$vhost})."'":'').",'$key{$vhost}','$crt{$vhost}','$chn{$vhost}');\n";

				for my $alias (@{$alias{$vhost}}) {
					print "INSERT INTO `alias` (`Alias`,`VHost`) VALUES ('$alias','$vhost');\n" unless ($alias =~ /^test-/);
				}

			}
			print "INSERT INTO `account` (`Account`,`UID`,`GID`,`IPv4`,`IPv6`,`Cluster`".(defined($conf{$uid_gid})?",`Conf`":'').(defined($php{$uid_gid})?",`PHP`":'').(defined($keytab{$uid_gid})?",`Keytab`":'').") VALUES ('$account',$uid,$gid,UNHEX('$ipv4'),UNHEX('$ipv6'),'$cluster'".(defined($conf{$uid_gid})?",'".&quote($conf{$uid_gid})."'":'').(defined($php{$uid_gid})?",'".&quote($php{$uid_gid})."'":'').(defined($keytab{$uid_gid})?",UNHEX('".unpack('H*',$keytab{$uid_gid})."')":'').");\n";
			for my $module (uniq @{$account_module{$account}}) {
				print "INSERT INTO `account_module` (`Account`,`Module`) VALUES ('$account','$module');\n";
			}
		}
	}
	for my $module (@{$module{'/etc/apache2/mods-available'}}) {
		print "INSERT INTO `module` (`Cluster`,`Module`) VALUES ('$cluster','$module');\n";
	}
	for my $module (@{$module{'/etc/apache2/mods-enabled'}}) {
		print "UPDATE `module` SET `Enabled` = TRUE WHERE `Cluster` = '$cluster' AND `Module` = '$module';\n";
	}
	for my $host (@servers) {
		print "INSERT INTO `host` (`Cluster`,`Host`,`Tasks`) VALUES ('$cluster','$host',TRUE);\n";
	}
	#warn keys %module;
	#&debug(__FILE__,__LINE__,Data::Dumper->new([\%module],['*'])->Indent(0)->Dump);
}

################################################################################
#
# Copy a template to an instance, substituting given tokens
#
sub read_file
{
	my ($file,$ignore) = @_;
	&debug(__FILE__,__LINE__,"Reading $file") if (defined($debug{'read_file'}));

	return ($cache{$file}) if (exists($cache{$file}));

	my ($content);
	if (open(FILE,$file)) {
		while (<FILE>) {
			$content .= $_;
		}
		close(FILE);
		$cache{$file} = $content;
		return($content);
	}
	return if ($ignore);
	die "Can't read $file: $!\n";
}

sub template
{
	my ($template,$substitutions) = @_;
	if (defined($debug{'template'})) {
		&debug(__FILE__,__LINE__,"Template: \"$template\"");
		for my $key (sort keys %{$substitutions}) {
			if (ref($substitutions->{$key})) {
				&debug(__FILE__,__LINE__,"$key: ".join(', ',@{$substitutions->{$key}}));
			}
			else {
				&debug(__FILE__,__LINE__,"$key: $substitutions->{$key}");
			}
		}
	}

	my $content;
	for (split(/^/m,$template)) {
		if (/^%!([^%]+)%/) {
			next if ($substitutions->{$1});
			$_ = $';
		}
		elsif (/^%([^%]+)%/) {
			next unless ($substitutions->{$1});
			$_ = $';
		}
		# FIXME: should this be .../g ?!
		while (/@([^[@][^@]*)@/) {
			$_ = $`.$substitutions->{$1}.$';
		}
		# Do not use multiple @[VARIABLE]@ within one line!
		# This will replace the first instance, but would not
		# re-line-parse the multi-line result!
		# No need to sort, but humans like some kind of order ;-)
		# Beware! Some lists like MODULES MUST NOT be sorted since .load has to come before .conf!!!
		while (/@\[([^@\]]+)\]@/) {
			#$_ = join('',map($`.$_.$',sort @{$substitutions->{$1}}));
			$_ = join('',map($`.$_.$',@{$substitutions->{$1}}));
		}
		$content .= $_;
	}
	return($content);
}

sub write_file
{
	my ($content,$dst,$append) = @_;
	&debug(__FILE__,__LINE__,"Writing $dst") if (defined($debug{'write_file'}));

	# If a return value is requested, read the old file content to check wether it would change
	if (defined(wantarray) && -r $dst) {
		my $old_content = &read_file($dst);
		return(0) if ($content eq $old_content);
	}

	if ($append) {
		chmod(0644,$dst);
	}
	else {
		unlink($dst);
		my @cmd = ($owner,'-i',dirname($dst),'--',$touch,$dst);
		&debug(__FILE__,__LINE__,join(' ','+',@cmd)) if (defined($debug{'exec'}) || defined($debug{'write_file'}));
		system(@cmd); # and die "Can't run ".join(' ',@cmd).": $!\n";
	}

	open(DST,($append?'>>':'>'),$dst) || die "Can't write to $dst: $!\n";
	# FIXME: die with a better error message
	print DST $content or die;
	close(DST) or die;

	# This is a script-generated file, don't change manually
	chmod(0444,$dst);

	# A new file has been written
	return(1);
}

sub template_file
{
	my ($src,$dst,$substitutions,$append) = @_;
	&debug(__FILE__,__LINE__,"Creating $dst from $src") if (defined($debug{'template_file'}));

	if (defined(wantarray)) {
		return(&write_file(&template(&read_file($src),$substitutions),$dst,$append));
	}
	&write_file(&template(&read_file($src),$substitutions),$dst,$append);
}

################################################################################
#
# Sort by VHost
#
#sub byvhost
#{
#	my $retval = &_byvhost;
#	&debug(__FILE__,__LINE__,"byvhost: \"$a\" vs. \"$b\": $retval");
#	return($retval);
#}

sub byvhost
{
	return(0) if ($a eq $b);

	my $cmp = &base_vhost($a) cmp &base_vhost($b);
	return($cmp) if ($cmp);

	return($a =~ /^stage[-.]/ ? 1 : -1);
}

sub base_vhost
{
	my ($vhost) = @_;

	return($') if ($vhost =~ /^stage-/);
	#print STDERR "base_vhost: \"$vhost\" -> ";
	$vhost =~ s/^([^.]*)stage/$1www/;
	#&debug(__FILE__,__LINE__,"\"$vhost\"");
	return($vhost);
}

#sub add
#{
#	my ($array,@values) = @_;
#
#	VALUE: for my $value (@values) {
#		for my $entry (@{$array}) {
#			next VALUE if ($value == $entry);
#		}
#		push(@{$array},$value);
#	}
#}
