#!/usr/bin/perl
# vhost v3.6.3  (c) 23.11.2009 by Andreas Ley  (u) 23.2.2026
# Install new or delete old server(s for a reddot project)

# On Wed, Dec 16, 2020 at 10:55:17AM +0100, Klara Mall wrote:
# Du mÃ¼sstest den externen DNS fragen, also "dig @dns1.kit.edu" - dann wÃ¼rde das
# richtige rauskommen. Also das was in der Datenbank steht und nur das ist
# relevant fÃ¼r Webmaster. Sorry, das ist ein kaputtes
# CN-Altlast-Zwischenkonstrukt, von dem wir weg wollen.

my @local_resolver = ('resolver-ext-1.scc.kit.edu');

my $server_user = 'www-data';
my $root = '/var/www';
#my $conf = catdir($root,'conf');
my $conf = '/etc/apache2';
my $vhost_ini = catfile($conf,'vhost.ini');
my $httpd = 'httpd.conf';
my $templates = '/etc/apache2/templates';
my @templates = ($httpd,'test-'.$httpd,'identity.conf','ssl.conf','vhost.conf','test-vhost.conf');
push(@templates,'local.conf') if (-e catfile($templates,'local.conf'));
push(@templates,'user.conf','test-user.conf') if (-e catfile($templates,'user.conf'));
my $mods_available = '/etc/apache2/mods-available';
my $common_mods_available = '/etc/apache2/mods-available';
my $mods_enabled = '/etc/apache2/mods-enabled';
my $wsgi = (-e catfile($mods_available,'wsgi.load'));
my $common_htdocs = '/etc/apache2/htdocs';
my $common_include = '/etc/apache2/include';
my $common_cgibin = '/usr/lib/cgi-bin';
my $available = '/etc/apache2/sites-available';
my $enabled = '/etc/apache2/sites-enabled';
#my $php_fpm_pools = '/etc/php/7.3/fpm/pool.d';
# Or we could use phpquery -V
my $php_version = readlink('/etc/alternatives/php') =~ s/^\/usr\/bin\/php//r;
my $php_fpm_pools = "/etc/php/${php_version}/fpm/pool.d";
# This can only be done after reading the config
#push(@templates,'local-php.conf') if ($start eq 'uid' && -d $php_fpm_pools);
#my $logrotate = '/etc/logrotate.d';
my $awstats = '/etc/awstats';
my $all = '/etc/ssl/certs/ISRG_Root_X1.pem';

my $myaccesslog = '/usr/bin/myaccesslog';
my $vip_setup = '/usr/sbin/vip_setup';
my @vip_setup = ('/usr/bin/env','PATH=/usr/sbin:/usr/machine/sbin','vip_setup');
my $apache2cfg = '/usr/sbin/apache2cfg';
my @apache2cfg = ('/usr/bin/env','PATH=/usr/sbin:/usr/machine/sbin','apache2cfg');

#my $init_httpd = '/etc/init.d/httpd';
#my $init_apache2 = '/etc/init.d/apache2';
#my $init_apache2vip = '/etc/init.d/apache2vip';
my $systemctl = '/bin/systemctl';
my $sc = '/usr/bin/sc';

# Use SSL files provided in /run in the case of pre-existing certificates
# /run/FQDN/conf/ssl/server.*
# cd /var/www; tar cf /tmp/ssl.tar */conf/ssl/server.*
# cd /run; tar xf /tmp/ssl.tar
my $pre = '/run';

my %access = (
##	'KAUNIRZ\\reddot' => 'S-1-5-21-288834573-1782988554-625696398-3755',
#	'KIT\\scc-reddot' => 'S-1-5-21-1202744845-3101423955-345487624-116991',
	);

my $cms_dir = catdir($root,'share','php');

my $base_domain = 'scc.kit.edu';

my $shibboleth = '/etc/shibboleth';
my $shibboleth_log = '/var/log/shibboleth';
#my $shibd_user = '_shibd';
my $shibboleth_host = 'scc-idp-mgmt-01.scc.kit.edu';

delete $ENV{'SSH_AUTH_SOCK'};
my @ssh = ('/usr/bin/ssh','-o','BatchMode=yes','-a','-k','-x');
my $from = 'webmaster@kit.edu';
my $bcc = 'apache@scc.kit.edu';

# Specifies master (1, failure results in error) and slaves (0, failure results in warning)
#%f5 = (
#	'root@scc-big-ip-01.scc.kit.edu' => 1,
#	'root@scc-big-ip-02.scc.kit.edu' => 0,
#	);
my $monitor = "apache";
my $profile = "nPath";
my $persist = "source_addr_2h";
my $v4 = '';
my $v6 = '-IPv6';
# https://support.f5.com/kb/en-us/products/big-ip_ltm/manuals/product/ltm-monitors-reference-11-6-0/2.html
my $f5_monitor_maxlen = 63;
# Seems to be historic... Now a name (including partition) can grow to 255 chars
my $f5_monitor_maxlen = 255-length('/Web/');

my @reddot = ('/usr/sbin/ssh_access','RedDot');
my $owner = '/usr/sbin/owner';
my $emcsetsdonce = '/usr/sbin/emcsetsdonce';
my $a2enmod = '/usr/sbin/a2enmod';
my $mkdir = '/bin/mkdir';
my $sh = '/bin/sh';
my $rm = '/bin/rm';
my $cp = '/bin/cp';
my @symlink = ('/bin/ln','-s');
my $chmod = '/bin/chmod';
my $chown = '/bin/chown';
my $scp = '/usr/bin/scp';
my $touch = '/usr/bin/touch';
my $ssl_request = '/usr/bin/ssl-request';
my $ssl_chain = '/usr/bin/ssl-chain';
#@ssl_opts = ('-r','Web Server');
my @ssl_opts = ('-r','Webserver MustStaple','-U');
my $host = '/usr/bin/host';
my $sendmail = '/usr/lib/sendmail';
my $dist = '/usr/bin/dist';
my $clcmd = '/usr/bin/clcmd';
#my $acmetool = '/usr/bin/acmetool';
my $acme_cert = '/usr/sbin/acme_cert';

my $cmdlog = '/var/log/vhost.log';

use strict;
use warnings;
no warnings 'uninitialized';

# The script itself may use utf-8 encoded identifiers and literals
use utf8;
# Latin-1 codepoints are considered characters
use feature 'unicode_strings';
use locale;
# Enable UTF-8 encoding for all files (but not already open handles)
use open ':encoding(utf8)';
use strict 'refs';

use Getopt::Long;
use File::Path;
use File::Basename;
use File::Spec::Functions;
use Net::Domain 'hostfqdn';
use NetAddr::IP ':lower';
use Template;

use Term::Cap;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Terse = 1;
$Data::Dumper::Sortkeys = 1;
#warn Data::Dumper->Dump([\%hash],['*']) if ($opt{'debug'}>0);
#warn Data::Dumper->new([\%hash],['*'])->Indent(0)->Dump if ($opt{'debug'}>0);
#use Devel::Peek;

#use lib '/home/sys/source/andy/Local/webapi-2.0';
use NET::WebAPI ('ip');

my $msglog;
#Dump($msglog);
if (open($msglog,'>>',$cmdlog)) {
	print $msglog scalar(localtime)," ",$ENV{'LOGNAME'},"/",$ENV{'SUDO_USER'},"/",$ENV{'REMOTEUSER'}," ",$0," '",join("' '",@ARGV),"'\n";
}
else {
	# Yes, it get's defined, even if the open failed!!!
	undef $msglog;
}
#Dump($msglog);

my (%opt,$start,$live_base_v4,$live_base_v6,$stage_base_v4,$stage_base_v6,$live_prefix,$min_slot,$max_slot,$precedence,$sni,%auth,%identity,%key,%cert,%f5);

sub read_config
{
	# ARGH, config is read before command line switches have been evaluated
	#&debug(__FILE__,__LINE__,'+ &read_config('.join(',',map("'$_'",@_)).')') if (defined($debug{'call'}) && $debug{'call'}>1 || defined($debug{'read_config'}));
	my ($config) = @_;

	my $subsystem;
	open(CONFIG,'<',$config) or &quit("Can't read $config: $!");
	while (<CONFIG>) {
		chomp;
		# ARGH, config is read before command line switches have been evaluated
		#&debug(__FILE__,__LINE__,$.,$_) if (defined($debug{'read_config'}) && $debug{'read_config'}>2);
		#&debug(__FILE__,__LINE__,$.,$_);
		if (/^\s*\[\s*(.*\S)\s*\]\s*$/) {
			$subsystem = $1;
			# ARGH, config is read before command line switches have been evaluated
			#&debug(__FILE__,__LINE__,"Subsystem: \"$subsystem\"") if (defined($debug{'read_config'}) && $debug{'read_config'}>1);
		}
		elsif (/^\s*start\s*=\s*(\S+)\s*$/) {
			$start = $1;
		}
		elsif (/^\s*base(?:_v4)?\s*=\s*([0-9.]+)\s*$/) {
			$live_base_v4 = &ip($1,0);
		}
		elsif (/^\s*base_v6\s*=\s*([0-9a-f:]+)\s*$/i) {
			$live_base_v6 = &ip($1,0);
		}
		elsif (/^\s*stage_base(?:_v4)?\s*=\s*([0-9.]+)\s*$/) {
			$stage_base_v4 = &ip($1,0);
			$live_prefix = "Live ";
		}
		elsif (/^\s*stage_base_v6\s*=\s*([0-9a-f:]+)\s*$/i) {
			$stage_base_v6 = &ip($1,0);
			$live_prefix = "Live ";
		}
		elsif (/^\s*min_slot\s*=\s*(\d+)\s*$/) {
			$min_slot = $1;
		}
		elsif (/^\s*max_slot\s*=\s*(\d+)\s*$/) {
			$max_slot = $1;
			# $masklen = POSIX::ceil(log($max_slot)/log(2));
		}
		elsif (/^\s*precedence\s*=\s*(\S+)\s*$/) {
			$precedence = $1;
		}
		elsif (/^\s*sni\s*=\s*(\S+)\s*$/) {
			$sni = $1;
		}
		elsif (/^\s*auth\s*=\s*(\S+)\s*$/) {
			$auth{$subsystem} = $1;
		}
		elsif (/^\s*identity\s*=\s*(\S+)\s*$/) {
			$identity{$subsystem} = $1;
		}
		elsif (/^\s*key\s*=\s*(\S+)\s*$/) {
			$key{$subsystem} = $1;
		}
		elsif (/^\s*cert\s*=\s*(\S+)\s*$/) {
			$cert{$subsystem} = $1;
		}
		elsif (/^\s*master\s*=\s*(\S+)\s*$/) {
			$f5{$1} = 1;
		}
		elsif (/^\s*slave\s*=\s*(\S+)\s*$/) {
			$f5{$1} = 0;
		}
		elsif (/^\s*print_cmd\s*=\s*(.*\S)\s*$/) {
			push(@ssl_opts,($1 eq '{accumulative sheet}') ? '-u' : ('-p',$1));
		}
		elsif (/^\s*owner\s*=\s*(.*\S)\s*$/) {
			push(@ssl_opts,'-o',$1);
		}
		elsif (/^\s*mail\s*=\s*(.*\S)\s*$/) {
			push(@ssl_opts,'-m',$1);
		}
		elsif (/^\s*phone\s*=\s*(.*\S)\s*$/) {
			push(@ssl_opts,'-t',$1);
		}
		elsif (/^\s*idcard\s*=\s*(.*\S)\s*$/) {
			push(@ssl_opts,'-l',$1);
		}
		elsif (/^\s*department\s*=\s*(.*\S)\s*$/) {
			push(@ssl_opts,'-d',$1);
		}
		elsif (/^\s*street\s*=\s*(.*\S)\s*$/) {
			push(@ssl_opts,'-s',$1);
		}
		elsif (/^\s*zip\s*=\s*(.*\S)\s*$/) {
			push(@ssl_opts,'-z',$1);
		}
	}
	close(CONFIG);
}

&read_config($vhost_ini);
push(@templates,'local-php.conf') if ($start eq 'uid' && -d $php_fpm_pools);

my $home = defined($ENV{'SUDO_USER'}) ? (getpwnam($ENV{'SUDO_USER'}))[7] : $ENV{'HOME'};
my $config = $identity{'webapi'} // catfile($home,'.config','netdb_client.ini');

sub usage
{
	my ($message) = @_;

	my $image = $0;
	$image =~ s!.*/!!;

	my @dirs = ('htdocs','cgi-bin');
	push (@dirs,'wsgi-scripts') if ($wsgi);
	my $dirs = join('/, ',@dirs).'/';
	$dirs =~ s/,([^,]*)$/ and$1/;

	print  STDERR  "$message\n" if (defined($message));
	print  STDERR  "Usage: $image [-v [-v]] [-n|-N] [-s] [-S]";
	print  STDERR  " [-r|-R]" if ($sni||defined($stage_base_v4)||defined($stage_base_v6));
	print  STDERR  " [-c|-C] [-A] [-M module[,module...]] [-[Uu] user [-w]] [-m mailaddress] [-b ca] [-B base] [-f] [-F|-E] fqdn [slot]\n";
	print  STDERR  "Or:    $image -d [-v [-v]] [-O] [-n|-N] [-s]";
	print  STDERR  " [-r|-R]" if ($sni||defined($stage_base_v4)||defined($stage_base_v6));
	print  STDERR  " [-[Uu] user] fqdn\n";
	print  STDERR  "-v, --verbose		Verbose mode (may be repeated to select very verbose mode)\n";
	print  STDERR  "-n, --dry-run		Dry run\n";
	print  STDERR  "-N, --human-dry-run	Human dry run (skip activities involving human interaction)\n";
	print  STDERR  "--config		Specify NetVS token config (use - for stdin)\n";
#SNI#	print  STDERR  "--sni			Use SNI\n" unless ($sni);
#SNI#	print  STDERR  "--nosni			Create IP-based VHosts\n" if ($sni);
#	print  STDERR  "--default		Make this the default VHost\n" if ($sni);
	print  STDERR  "-s, --skip-systemctl	Do not systemctl (enable/disable/start/stop/reload/restart) web server(s)\n";
	print  STDERR  "-k, --keep-running	When migrating VHosts, do not reload origin web server\n";
	print  STDERR  "-S, --ssl-optional	Allow HTTP access (default is HTTPS-only)\n";
	if ($sni||defined($stage_base_v4)||defined($stage_base_v6)) {
		print  STDERR  "-r, --stage		Reddot project, also install/delete stage-server\n";
		print  STDERR  "-R, --stage-only	Reddot project, install/delete only stage-server\n";
#		print  STDERR  "-p, --reddot		Add reddot.conf\n";
	}
	print  STDERR  "-a, --alias		Additional aliases (i.e. DNSVS-external CNAMEs(!)) to this server (may be used more than once)\n";
	print  STDERR  "-A, --no-domain-alias	Do not automatically add the domain as an alias to a server named www.*\n";
	print  STDERR  "--force-domain-alias	Add the domain as an alias to a server named www.* even for a (DNSVS-)external domain\n";
	print  STDERR  "-c, --canon-to-homepage	Canonicalize the server name to the servers homepage\n";
	print  STDERR  "			(default is to canonicalize the server name while keeping the path)\n";
	print  STDERR  "-C, --skip-canon	Do not canonicalize the server name (except domain addressing)\n";
	print  STDERR  "--skip-awstats		Disable advanced web statistics\n";
	print  STDERR  "--skip-mail		Don't send requests to external SOA contacts\n";
	print  STDERR  "-M, --module		Activate (comma-separated list of) module(s)\n";
	# FIXME: Where is this CGI executor defined?!!
	print  STDERR  "-U, --owner		This user will be owner of the VHost's $dirs (and CGI executor)\n";
	print  STDERR  "-u, --user		The VHost's $dirs get created in the given user's home directory\n";
	print  STDERR  "-w, --only-user-dirs	Only create user-based directories (implies -s)\n";
	print  STDERR  "-m, --mail		Server admin's mail address for non-generic VHost (defaults to webmaster@<domain>)\n";
	print  STDERR  "-b, --ca		CA (for external certificates)\n";
	print  STDERR  "-B, --base		DN base (for external certificates)\n";
	print  STDERR  "-f, --force		Force creation even if some minor errors are detected\n";
	#print  STDERR  "			(Currently, this includes SSL certificate signing request submission and slave loadbalancer configuration)\n";
	print  STDERR  "			(Currently, this includes SSL certificate signing request submission and Shibboleth IdP configuration)\n";
	print  STDERR  "-F, --force-migration	Force creation for external domain authority (domain not yet migrated)\n";
	print  STDERR  "-E, --force-external	Force creation for external domain authority (domain will not be migrated)\n";
	#print  STDERR  "-G, --force-sni		Force migration to GRE/SNI (define CNAMEs as aliases, change A/AAAA to CNAMEs)\n";
	#print  STDERR  "-W, --skip-webapi	Skip WebAPI interaction / DNS configuration\n";
	#print  STDERR  "-5, --skip-f5		Skip F5 configuration\n";
	#print  STDERR  "-L, --skip-cluster	Skip configuration on remote cluster nodes\n";
	print  STDERR  "--challenge		Force challenge type (e.g. dns-01 for firewalled VHost)\n";
	print  STDERR  "-d, --delete		Delete VHost (default is to install a new VHost)\n";
	print  STDERR  "-O, --old		Consider only old-* DNS RRs (delete an old VHost)\n";
	print  STDERR  "Your NetVS-Token must be readable from $config\n" unless ($config eq '-' || -r $config);
	print  STDERR  "If a slot is given, the VHost's IP address(es) are calculated from the slot, and DNS entries will be created if not yet defined\n";
	print  STDERR  "An FQDN can be at most ",$f5_monitor_maxlen-length($v4.$v6)," characters long (for RedDot projects, this also refers to the correspondent stage server)\n";
	exit(1);
}

@_ = @ARGV;
$Getopt::Long::ignorecase = 0;
GetOptions (\%opt,'debug|D:s','help|h','trace|x','verbose|v+','dry-run|n','human-dry-run|N','test|T',
	'config=s','skip-systemctl|s','keep-running|k','ssl-optional|S',
#SNI#	'sni!',
#	'default',
	($sni||defined($stage_base_v4)||defined($stage_base_v6))?('stage|r','stage-only|R'):(),
	'alias|a=s@','no-domain-alias|A','force-domain-alias',
	'canon-to-homepage|c','skip-canon|C',
	'skip-awstats','skip-mail',
	'module|M=s',
	'user|u=s','owner|U=s','only-user-dirs|w',
	'mail|m=s',
	'ca|b=s',
	'base|B=s',
	'force|f','force-migration|F','force-external|E', # 'force-sni|G',
	'skip-webapi|W','skip-f5|5','skip-cluster|L',
	'challenge=s',
	'delete|d',
	'old|O',
	);
exec($^X,'-d:Trace',$0,@_) if (defined($opt{'trace'}) && !defined($Devel::Trace::TRACE));

$config = $opt{'config'} if (defined($opt{'config'}));

&usage() if (defined($opt{'help'}) || @ARGV < 1 || @ARGV > 2);
&usage("Your NetVS-Token must be readable from $config") unless (defined($opt{'skip-webapi'}) || defined($opt{'only-user-dirs'}) || $config eq '-' || -r $config || $ARGV[1] eq 'default');
&usage("Can't specify both -r and -R") if (defined($opt{'stage'}) && defined($opt{'stage-only'}));
&usage("Can't specify both -A and --force-domain-alias") if (defined($opt{'no-domain-alias'}) && defined($opt{'force-domain-alias'}));
&usage("Can't specify both -c and -C") if (defined($opt{'canon-to-homepage'}) && defined($opt{'skip-canon'}));
&usage("Can't specify both -u and -U") if (defined($opt{'owner'}) && defined($opt{'user'}));
&usage("-w requires either -u or -U") if (!defined($opt{'owner'}) && !defined($opt{'user'}) && defined($opt{'only-user-dirs'}));
&usage("Can't specify -d with -S, -c -C, -A") if (defined($opt{'delete'}) && (defined($opt{'ssl-optional'}) || defined($opt{'canon-to-homepage'}) || defined($opt{'skip-canon'}) || defined($opt{'skip-awstats'})));
&usage("Can't specify -O without -d") if (defined($opt{'old'}) && !defined($opt{'delete'}));

if (defined($opt{'verbose'}) || defined($opt{'debug'})) {
	$|=1;
	select((select(STDERR),$|=1)[0]);
}

my (%debug,$on,$off);

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;

if (defined($opt{'debug'})) {
	for (split(',',$opt{'debug'})) {
		if (/=/) {
			$debug{$`} = $';
		}
		else {
			$debug{$_} = 1;
		}
	}
	if (defined($debug{'all'})) {
		$debug{'call'} = $debug{'dist'} = $debug{'dns'} = $debug{'exec'} = $debug{'find_slot'} = $debug{'handle_a'} = $debug{'ssh'} = $debug{'ssl'} = $debug{'template'} = $debug{'user'} = $debug{'all'};
	}
	&debug(__FILE__,__LINE__,'%debug = '.Data::Dumper->Dump([\%debug],['*'])) if (defined($debug{'debug'}));
	&debug(__FILE__,__LINE__,'%opt = '.Data::Dumper->Dump([\%opt],['*'])) if (defined($debug{'opt'}));
	# Calls sh -c infocmp without setting a PATH :-(
	$ENV{'PATH'} = defined($ENV{'PATH'}) ? $ENV{'PATH'}.':/usr/bin' : '/usr/bin';
	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)');
binmode(STDERR,':encoding(utf8)') unless (defined($Devel::Trace::TRACE));

push(@ssh,defined($debug{'ssh'})?'-v':'-q');

push(@ssl_opts,'-x') if (defined($opt{'x'}));
push(@ssl_opts,'-v') if (defined($debug{'ssl'}));
# If the domain is and will be external, we only upload the CSR to DFN PKI, if both CA and DN base have been specified
push(@ssl_opts,'-n') if (defined($opt{'human-dry-run'}) || (defined($opt{'force-external'}) && !(defined($opt{'ca'}) && defined($opt{'base'}))));
push(@ssl_opts,'-b',$opt{'ca'}) if (defined($opt{'ca'}));
push(@ssl_opts,'-B',$opt{'base'}) if (defined($opt{'base'}));

my %mod = map {s/^shibboleth$/shib/;s/^shib2$/shib/;($_=>1)} split(',',$opt{'module'}) if (defined($opt{'module'}));
push(@templates,'shibboleth.conf','shibboleth-rewrite.conf') if (($mod{'shib'} || -e catfile($mods_enabled,'shib.load')) && -d $shibboleth);

#SNI#if (defined($opt{'sni'})) {
#SNI#	if (-s $vhost_ini.'.sni') {
#SNI#		undef $start;
#SNI#		undef $live_base_v4;
#SNI#		undef $live_base_v6;
#SNI#		undef $stage_base_v4;
#SNI#		undef $stage_base_v6;
#SNI#		undef $live_prefix;
#SNI#		undef $min_slot;
#SNI#		undef $max_slot;
#SNI#		undef $precedence;
#SNI#		undef %auth;
#SNI#		undef %identity;
#SNI#		undef %key;
#SNI#		undef %cert;
#SNI#		undef %f5;
#SNI#		&read_config($vhost_ini.'.sni');
#SNI#	}
#SNI#}
if (defined($opt{'test'})) {
	&read_config($vhost_ini.'.test');
}
unless ($ARGV[1] eq 'default') {
	&quit("No base in $config") unless (defined($live_base_v4));
	&quit("No min_slot in $config") unless (defined($min_slot));
	&quit("No max_slot in $config") unless (defined($max_slot));
}

my ($user_uid,$user_gid,$user_home,$user_uid_gid,$server_uid,$server_gid,$server_home);
if (defined($opt{'user'}) || defined($opt{'owner'})) {
	($user_uid,$user_gid,$user_home) = (getpwnam($opt{'user'}.$opt{'owner'}))[2,3,7] or &quit("Invalid user: $opt{'user'}$opt{'owner'}");
	$user_uid_gid = $user_uid.':'.$user_gid;
}
if ($start ne 'uid') {
	# FIXME: Do we need anything else than $server_uid ?
	($server_uid,$server_gid,$server_home) = (getpwnam($server_user))[2,3,7] or &quit("Invalid user: $server_user");
}

my (@servers,@clcmd,@all,@bullseye,@bookworm);
if (!defined($opt{'only-user-dirs'}) && open(SERVERS,'<',catfile($conf,'servers'))) {
	while (<SERVERS>) {
		chomp;
		&debug(__FILE__,__LINE__,$.,$_) if (defined($debug{'server'}) && $debug{'server'}>1);
		s/\s*#.*//;
		push(@servers,$1) if (/^(\S+)/);
	}
	close(SERVERS);
	&debug(__FILE__,__LINE__,'@servers = '.Data::Dumper->new([\@servers],['*'])->Indent(0)->Dump) if (defined($debug{'server'}));
	# Exactly when does @servers differ from the default dist set?
	@clcmd = ($clcmd,defined($opt{'verbose'})?('-v'):(),'-f','-d',join(' ',@servers)) if (@servers);
	@all = ($clcmd,defined($opt{'verbose'})?('-v'):(),'-f','-s','all') if (@servers && !defined($opt{'skip-cluster'}));
	# Some fixup must be done on bullseye only
	@bullseye = ($clcmd,defined($opt{'verbose'})?('-v'):(),'-f','-s','bullseye') if (@servers && -e '/etc/cluster/nodes.bullseye');
	# Some fixup must be done on bookworm only
	@bookworm = ($clcmd,defined($opt{'verbose'})?('-v'):(),'-f','-s','bookworm') if (@servers && -e '/etc/cluster/nodes.bookworm');
}

#my ($dev,$ino,$mode,$nlink,$uid,$wwwadm,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($myaccesslog) or &quit("Can't stat $myaccesslog: $!");
my $wwwadm = 9998;

my $live_fqdn = lc($ARGV[0]) =~ s/\.+$//r;
my $stage_fqdn = ($live_fqdn =~ /^([^.]*)www/ ? $1.'stage'.$' : 'stage-'.$live_fqdn);
&usage("Can't specify -m for generic VHost") if (defined($opt{'mail'}) && $live_fqdn =~ /^www\./i);
# http://support.f5.com/kb/en-us/solutions/public/13000/200/sol13209.html
#&usage("VHost names must begin with an alphabetic character") if ($live_fqdn !~ /^[a-z]/i);
# https://support.f5.com/kb/en-us/products/big-ip_ltm/manuals/product/ltm-monitors-reference-11-6-0/2.html
if (length($live_fqdn.$v4.$v6) > $f5_monitor_maxlen) {
	&quit("Name too long: $live_fqdn exceeds F5 monitor length limits.");
}
if (length($stage_fqdn.$v4.$v6) > $f5_monitor_maxlen) {
	&quit("Name too long: $stage_fqdn exceeds F5 monitor length limits.");
}
if ($live_fqdn =~ /-web-\d+\./) {
	&quit("You sure? This very much looks like an SNI server instance name, not a VHost name!");
}

my ($webapi,$dnsvs);
unless (defined($opt{'skip-webapi'}) || defined($opt{'only-user-dirs'})) {
	my $opt = NET::WebAPI->read_config($config);
	$opt->{'debug'} = \%debug;
	$opt->{'url'} = 'test' if (defined($opt{'dry-run'}));

	print "Connecting to WebAPI\n" if (defined($opt{'verbose'}) && $opt{'verbose'}>1);
	$webapi = NET::WebAPI->new($opt) or die "Can't connect to WebAPI\n";

	$dnsvs = $webapi->is_dnsvs($live_fqdn);
	print "$live_fqdn is".($dnsvs?"":" not")." provided by DNSVS\n" if (defined($opt{'verbose'}) && $opt{'verbose'}>1);
}

#SNI#$sni = $opt{'sni'} if (defined($opt{'sni'}));

# Check wether this is a delegated domain

sub translate
{
	my ($infix,$fqdn) = @_;

	if ($fqdn =~ /^(\S+)\.kit\.edu$/) {
		return(join("-$infix-",split(/\./,$1)).'.'.$base_domain);
	}
	elsif ($fqdn =~ /^(\S+)\.uni-karlsruhe.de$/) {
		return(join("-$infix-",split(/\./,$1)).'.rz.uni-karlsruhe.de');
	}
	else {
		#&quit("Unknown domain: Translation for $fqdn not implemented. Please contact your administrator ;-)");
		# FIXME: This can't be right?!
		return(&external($fqdn.'.'.$infix));
	}
}

sub external
{
	my ($fqdn) = @_;

	return(join('-',split(/\./,$fqdn)).'.'.$base_domain);
}

my ($live_dns,$stage_dns,$ns,$canon_ip,$hostmaster);
if ($sni) {
	if ($start eq 'uid') {
		if (defined($opt{'user'}) || defined($opt{'owner'})) {
			$live_dns = $stage_dns = ($opt{'user'} // $opt{'owner'}).'.'.$base_domain;
			&quit("$live_dns is the DNS name for this user's server instance - choose another FQDN for the VHost name") if ($live_fqdn eq $live_dns);
		}
		# FIXME: Isn't a user required for start=uid aka multi-instance-mode anyway and should be handled getopts/usage?
		else {
			&quit("Currently, for SNI we also need a username");
		}
	}
	else {
		$live_dns = $stage_dns = hostfqdn();
	}
	unless ($dnsvs || defined($opt{'skip-webapi'}) || defined($opt{'only-user-dirs'})) {
		($ns,$hostmaster) = &soa(&domain($live_fqdn));
		&quit("Unknown authority: SOA for $live_fqdn not found. Please contact your administrator ;-) Usually this is an error, go to NET!") unless (defined($ns));
	}
	&debug(__FILE__,__LINE__,"$live_fqdn => $live_dns") if (defined($debug{'dns'}));
	&debug(__FILE__,__LINE__,"$stage_fqdn => $stage_dns") if (defined($debug{'dns'}) && (defined($opt{'stage'}) || defined($opt{'stage-only'})));
}
elsif (defined($opt{'force-migration'})) {
	&quit("Internal authority: specifying -F is neither required nor sensible") if ($dnsvs);
	$live_dns = $live_fqdn;
	$stage_dns = $stage_fqdn;
	$canon_ip = !$opt{'skip-canon'};
}
elsif (defined($opt{'force-external'})) {
	&quit("Internal authority: specifying -E is neither required nor sensible") if ($dnsvs);
	($ns,$hostmaster) = &soa(&domain($live_fqdn));
	&quit("Unknown authority: SOA $ns not implemented. Please contact your administrator ;-) Usually this is an error, go to NET!") unless (defined($ns));
	$live_dns = &external($live_fqdn);
	$stage_dns = &external($stage_fqdn);
	&debug(__FILE__,__LINE__,"$live_fqdn => $live_dns") if (defined($debug{'dns'}));
	&debug(__FILE__,__LINE__,"$stage_fqdn => $stage_dns") if (defined($debug{'dns'}));
}

$hostmaster = $bcc if (defined($opt{'human-dry-run'}));

my $live_fqdn_domain = &domain($live_fqdn);
my $live_dns_domain = &domain($live_dns);

if ($sni) {
	$stage_base_v4 = $live_base_v4;
	$stage_base_v6 = $live_base_v6;
	$live_prefix = "Live " if (defined($opt{'stage'}));
}

unless (defined($opt{'skip-webapi'}) || defined($opt{'only-user-dirs'})) {
	print "Checking wether $live_dns_domain is a defined domain\n" if (defined($opt{'verbose'}) && $opt{'verbose'}>1);
	&quit("Domain $live_dns_domain not defined within DNSVS") unless ($webapi->is_domain($live_dns_domain));
}

# Hint to myself: Above, we only require that the $live_dns domain is in DNSVS - if we were to use &soa_dnsvs, the $live_fqdn domain would have to be in DNSVS!

# Find predefined or free DNS slot

sub find_slot
{
	&debug(__FILE__,__LINE__,'+ &find_slot('.join(',',map("'$_'",@_)).')') if (defined($debug{'call'}) && $debug{'call'}>1 || defined($debug{'find_slot'}));
	#&debug(__FILE__,__LINE__,'+ &find_slot'.Data::Dumper->new([\@_],['*'])->Indent(0)->Dump) if (defined($debug{'call'}) && $debug{'call'}>1 || defined($debug{'find_slot'}));
	my ($fqdn,$base_v4,$base_v6) = @_;
	# FIXME: also search for v6 addresses

	my $prefix = ($precedence eq 'test' || defined($opt{'force-migration'})) ? 'test-' : defined($opt{'old'}) ? 'old-' : '' unless ($sni);

	# Check if host already has an A RR
	# FIXME: Handle IPv6 responses
	print "Checking A RR for $prefix$fqdn\n" if ($opt{'verbose'}>1);
	my @primary_ip = $webapi->list_a($prefix.$fqdn,'A');
	&quit("Internal error: Can't handle multiple A RRs for $prefix$fqdn: ".join(', ',@primary_ip)) if (@primary_ip>2);
	my $primary_ip = $primary_ip[1];
	&debug(__FILE__,__LINE__,"$prefix$fqdn: Primary IP: ".$primary_ip->canon) if (defined($debug{'find_slot'}) && $debug{'find_slot'}>2 && defined($primary_ip));

	# There might as well be a CNAME...
	my @cname;
	unless (defined($primary_ip)) {
		print "Checking CNAME RR for $prefix$fqdn\n" if ($opt{'verbose'}>1);
		@cname = $webapi->list_cname($prefix.$fqdn);
		if (@cname) {
			&debug(__FILE__,__LINE__,"$prefix$fqdn: Primary CNAME: ".$cname[0]) if (defined($debug{'find_slot'}) && $debug{'find_slot'}>2);
			print "Checking A RR for $cname[0]\n" if ($opt{'verbose'}>1);
			my @primary_ip = $webapi->list_a($cname[0],'A');
			$primary_ip = $primary_ip[1];
			&debug(__FILE__,__LINE__,"$prefix$fqdn: Primary IP: ".$primary_ip->canon) if (defined($debug{'find_slot'}) && $debug{'find_slot'}>2 && defined($primary_ip));
		}
	}

	# CHECK: To get the difference between two IPs, we must enlarge the subnet mask
	my $slot = (&ip($primary_ip->canon,0)-$base_v4) if (defined($primary_ip) && !@cname);
	&debug(__FILE__,__LINE__,"$prefix$fqdn: Primary DNS-Slot: $slot") if (defined($debug{'find_slot'}) && $debug{'find_slot'}>2);
	undef $slot if ($slot < $min_slot || $slot > $max_slot);

	my $secondary_ip;
	unless (defined($slot)) {
		$prefix = ($precedence ne 'test' && !defined($opt{'force-migration'})) ? 'test-' : defined($opt{'old'}) ? 'old-' : '';
		# FIXME: Handle IPv6 responses
		print "Checking A RR for $prefix$fqdn\n" if ($opt{'verbose'}>1);
		my @secondary_ip = $webapi->list_a($prefix.$fqdn,'A');
		&quit("Internal error: Can't handle multiple A RRs for $prefix$fqdn: ".join(', ',@secondary_ip)) if (@secondary_ip>2);
		$secondary_ip = $secondary_ip[1];
		&debug(__FILE__,__LINE__,"$prefix$fqdn: Secondary IP: ".$secondary_ip->canon) if (defined($debug{'find_slot'}) && $debug{'find_slot'}>2 && defined($secondary_ip));

		# There might as well be a CNAME...
		my @cname;
		unless (defined($secondary_ip)) {
			print "Checking CNAME RR for $prefix$fqdn\n" if ($opt{'verbose'}>1);
			@cname = $webapi->list_cname($prefix.$fqdn);
			if (@cname) {
				&debug(__FILE__,__LINE__,"$prefix$fqdn: Secondary CNAME: ".$cname[0]) if (defined($debug{'find_slot'}) && $debug{'find_slot'}>2);
				print "Checking A RR for $cname[0]\n" if ($opt{'verbose'}>1);
				my @secondary_ip = $webapi->list_a($cname[0],'A');
				$secondary_ip = $secondary_ip[1];
				&debug(__FILE__,__LINE__,"$prefix$fqdn: Secondary IP: ".$secondary_ip->canon) if (defined($debug{'find_slot'}) && $debug{'find_slot'}>2 && defined($secondary_ip));
			}
		}

		$slot = (&ip($secondary_ip->canon,0)-$base_v4) if (defined($secondary_ip) && !@cname); # There is an A RR
		&debug(__FILE__,__LINE__,"$prefix$fqdn: Secondary DNS-Slot: $slot") if (defined($debug{'find_slot'}) && $debug{'find_slot'}>2);
		undef $slot if ($slot < $min_slot || $slot > $max_slot);
	}
	&debug(__FILE__,__LINE__,"$fqdn: DNS-Slot: $slot") if (defined($debug{'find_slot'}) && $debug{'find_slot'}>2);

	if (!defined($slot)) {
		my $old = 'old-' if (defined($opt{'old'}));
		&quit("Can't find server $old$fqdn or test-$fqdn within our range") if (defined($opt{'delete'}));
		&quit("Can't select server IP: Both $fqdn and test-$fqdn already have DNS entries outside our range") if (defined($primary_ip) && defined($secondary_ip));
	}

	&debug(__FILE__,__LINE__,'+ &find_slot = ('.$slot.',"'.$prefix.'","'.$primary_ip.'","'.$secondary_ip.'")') if (defined($debug{'return'}) && $debug{'return'}>1 || defined($debug{'find_slot'}) && $debug{'find_slot'}>1);
	return($slot,$prefix,$primary_ip,$secondary_ip);
}

my ($slot,$prefix);
unless (defined($opt{'only-user-dirs'})) {
	if (@ARGV > 1) {
		$slot = $ARGV[1];
		unless ($slot eq 'default') {
			if ($slot < $min_slot || $slot > $max_slot) {
				&usage("$live_fqdn: Slot value $slot out of range $min_slot-$max_slot");
			}
		}
	}
	else {
		&usage("Slot specification required when we can't look it up in DNSVS") if (defined($opt{'skip-webapi'}));
		# Look for a live server unless we need only a stage
		my ($primary,$primary_ip,$secondary_ip);
		# When using SNI, $stage_dns is defined but $stage_base_* are not, so we have to look it up here
		if ($sni || !defined($opt{'stage-only'})) {
			($slot,$prefix,$primary_ip,$secondary_ip) = &find_slot($live_dns,$live_base_v4,$live_base_v6);
			$primary |= defined($primary_ip);
		}
		if (!$primary && !$sni && defined($stage_dns) && (defined($stage_base_v4)||defined($stage_base_v6))) {
			# If we didn't search or didn't find a live server, have a look for a stage server
			if (!defined($slot)) {
				($slot,$prefix,$primary_ip,$secondary_ip) = &find_slot($stage_dns,$stage_base_v4,$stage_base_v6);
				$primary |= defined($primary_ip);
			}
			# If we skipped the search for a live server, but didn't find a stage server, now try to find a live server anyway
			if (defined($opt{'stage-only'}) && !$primary && !defined($slot)) {
				($slot,$prefix,$primary_ip,$secondary_ip) = &find_slot($live_dns,$live_base_v4,$live_base_v6);
				$primary |= defined($primary_ip);
			}
		}

		unless (defined($slot)) {
			$prefix = ($primary xor ($precedence eq 'test') || defined($opt{'force-migration'})) ? 'test-' : '';
			# We only need to request $min_slot..$max_slot, but most of the time this will be a majority of 0..$max_slot, so we skip the work to get the right base address and netmask (WebAPI throws an error if any masked bits are still set!)
			print "Getting A RRs for live servers\n" if ($opt{'verbose'}>1);
			my %live = $webapi->list_a(&ip($live_base_v4->canon,31-int(log($max_slot)/log(2))));
			my %live_ip = map(($_->canon=>1),values %live);
			my (%stage,%stage_ip);
			if (!$sni && defined($stage_dns) && defined($stage_base_v4)) {
				print "Getting A RRs for stage servers\n" if ($opt{'verbose'}>1);
				%stage = $webapi->list_a(&ip($stage_base_v4->canon,31-int(log($max_slot)/log(2))));
				%stage_ip = map(($_->canon=>1),values %stage);
			}
			# Search for an empty slot
			for my $s ($min_slot..$max_slot) {
				# FIXME: Also check v6 addresses!
				next if (defined($live_ip{($live_base_v4+$s)->canon}));
				next if (defined($stage_base_v4) && defined($stage_ip{($stage_base_v4+$s)->canon}));
				$slot = $s;
				last;
			}
		}

		&debug(__FILE__,__LINE__,"Slot: $slot") if (defined($debug{'find_slot'}) && $debug{'find_slot'}>2);
		print "Slot: $slot\n" if (defined($opt{'verbose'}) && $opt{'verbose'}>1);

		&quit("Can't select server IP: all slots are used :-( Please delete some VHosts or enlarge IP subnet") unless (defined($slot));

		# HACK: In the SNI case, use the prefix only for the CNAMEs, not for the slot-defining instance IP address
		$prefix = ($precedence eq 'test' || defined($opt{'force-migration'})) ? 'test-' : defined($opt{'old'}) ? 'old-' : '' if ($sni);
	}
}

# FIXME: 077 and explicit &mod
umask(077);

#
# If we should restart the server, first get a list of current VHost users - we may have to restart these later too, if the VHost user has changed
# We need this if:
#  - SNI (when exactly? --only-user-dirs ?)
#  - We have separate instances (by account) and we actually will restart them (we don't skip systemctl explicitly or implicitly by only creating user dirs)
#
my (%action,$full_config,$keep_instance_address);
if (($sni || $start eq 'uid') && !$opt{'skip-reload'} && !$opt{'only-user-dirs'}) {
	my (%user,%vhosts);
	for my $fqdn ($opt{'stage-only'}?():($live_fqdn),($opt{'stage'}||$opt{'stage-only'})?($stage_fqdn):()) {
		&debug(__FILE__,__LINE__,join(' ','+',$apache2cfg,'-q','-a',$fqdn)) if (defined($debug{'exec'}));
		open(APACHE2CFG,'-|',$apache2cfg,'-q','-a',$fqdn) or &quit("Can't run $apache2cfg -a $fqdn: $!");
		while(<APACHE2CFG>) {
			chomp;
			my ($name,$uid_gid) = split;
			if (defined($user{$fqdn})) {
				&quit("Internal error: multiple users (".$user{$fqdn}."vs. $uid_gid) for $fqdn");
			}
			$user{$fqdn} = $uid_gid;
		}
		close(APACHE2CFG);
		&debug(__FILE__,__LINE__,"User $fqdn: ".$user{$fqdn}) if (defined($debug{'user'}));
		&quit("Can't find the user running $fqdn (is this valid?)") if ($opt{'delete'} && !exists($user{$fqdn}));
		&quit("User specified ($user_uid_gid) differs from user running the server (".$user{$fqdn}.")") if ($opt{'delete'} && $user{$fqdn} ne $user_uid_gid);
	}

	# Also get a list of VHosts to decide wether to stop (no remaining vhost), to start (no existing vhosts) or to reload the (upcoming) server (still vhosts remaining for this user), and also a list of users

	for my $user (&uniq(values %user,$user_uid_gid)) {
		&debug(__FILE__,__LINE__,join(' ','+',$apache2cfg,'-l','-u',$user)) if (defined($debug{'exec'}));
		open(APACHE2CFG,'-|',$apache2cfg,'-l','-u',$user) or &quit("Can't run $apache2cfg -l -u $user: $!");
		while(<APACHE2CFG>) {
			chomp;
			push(@{$vhosts{$user}},$_);
		}
		close(APACHE2CFG);
		&debug(__FILE__,__LINE__,"VHosts $user: ".join(', ',sort @{$vhosts{$user}})) if (defined($debug{'user'}));
	}

	# Start user servers with no VHosts yet, reload if already running

	$action{$user_uid_gid} = defined($vhosts{$user_uid_gid}) ? 'reload' : 'start' unless ($opt{'delete'});

	# Since at least one server is either started or reloaded, it is guaranteed that apache2cfg -c is run and thus global monit config is rebuilt
	# Since jessie, we have systemd and no apache2cfg -c in /etc/init.d, but also no monit!
	# However, we need it not only for monit, but also for global logrotate and shibboleth config!
	$full_config = !defined($vhosts{$user_uid_gid}) unless ($opt{'delete'});

	# Construct the destination state

	for my $fqdn ($opt{'stage-only'}?():($live_fqdn),($opt{'stage'}||$opt{'stage-only'})?($stage_fqdn):()) {
		for my $i (0..$#{$vhosts{$user{$fqdn}}}) {
			if ($vhosts{$user{$fqdn}}->[$i] eq $fqdn) {
				splice(@{$vhosts{$user{$fqdn}}},$i,1);
			}
			push(@{$vhosts{$user_uid_gid}},$fqdn) unless ($opt{'delete'});
		}
	}

	# If we delete a VHost and thus would drop its IP, in the SNI case this is an instance address, so keep it if there are still other VHosts on this instance
	$keep_instance_address = 1 if ($opt{'delete'} && $sni && @{$vhosts{$user_uid_gid}});

	# Stop all users (going to be) without VHosts

	unless (defined($opt{'keep-running'})) {
		for my $user (&uniq(values %user)) {
			&debug(__FILE__,__LINE__,$user) if (defined($debug{'user'}) && $debug{'user'}>1);
			unless (defined($action{$user})) {
				if (@{$vhosts{$user}}) {
					$action{$user} = 'reload'
				}
				else {
					# Stop going-to-be VHost-less servers now before we invalidate their configuration
					# (since /etc/init.d/httpd stop doesn't call apache2cfg -c)
					print "Disable httpd\@$user.service...\n" if (defined($opt{'verbose'}));
					&shell("Can't disable httpd",1,undef,@all,$systemctl,'disable','httpd@'.$user.'.service');
					print "Stop httpd\@$user.service...\n" if (defined($opt{'verbose'}));
					&shell("Can't stop httpd",1,undef,@all,$systemctl,'stop','httpd@'.$user.'.service');
					$full_config = 1;
				}
			}
		}
	}
	&debug(__FILE__,__LINE__,Data::Dumper->new([\%action],['*'])->Indent(0)->Dump) if (defined($debug{'user'}));
}

sub handle_a
{
	&debug(__FILE__,__LINE__,'+ &handle_a('.join(',',map("'$_'",@_)).')') if (defined($debug{'call'}) || defined($debug{'handle_a'}));
	my ($fqdn,$ip,$domain) = @_;

	return if (defined($opt{'skip-webapi'}));

	my $a = ($ip->version==4) ? 'A' : 'AAAA';
	print "Checking $a RR $fqdn -> ".($ip->canon)."\n" if (defined($opt{'verbose'}) && $opt{'verbose'}>1);
	my %fqdn = $webapi->list_a($ip);
	&debug(__FILE__,__LINE__,'+ &handle_a: %fqdn = '.Data::Dumper->new([\%fqdn],['*'])->Indent(0)->Dump) if (defined($debug{'handle_a'}) && $debug{'handle_a'}>2);
	if (defined($opt{'delete'})) {
		if (defined($fqdn{$fqdn})) {
			# Handle case that there is still a CNAME to this entry
			print "Getting CNAME RRs pointing to $fqdn\n" if (defined($opt{'verbose'}) && $opt{'verbose'}>1);
			for my $cname ($webapi->list_cname_target($fqdn)) {
				print "Deleting CNAME RR $cname -> $fqdn\n" if (defined($opt{'verbose'}));
				$webapi->delete_cname($cname);
			}
			print "Deleting $a RR $fqdn -> ".($ip->canon)."\n" if (defined($opt{'verbose'}));
			$webapi->delete_a($fqdn,$ip);
		}
	}
	else {
		unless (defined($fqdn{$fqdn})) {
			# This might still be a CNAME
			my @cname = $webapi->list_cname($fqdn);
			if (@cname) {
				# FIXME: We should check the cname's addresses and bail out if none match the new one
				print "Deleting CNAME RR $fqdn -> $cname[0]\n" if (defined($opt{'verbose'}));
				$webapi->delete_cname($fqdn);
			}
			# The fqdn might still be around (FQDN garbage collection not yet implemented in 3.2) and be something else than a host/domain â e.g. an alias
			# We might not have the right to change the FQDN type, so first check and only try when it's required
			my @type = $webapi->fqdn_type($fqdn);
			$webapi->update_fqdn_type($fqdn,'domain') if (@type && $type[0] ne 'domain' && $type[0] ne 'wildcard');
			print "Creating $a RR $fqdn -> ".($ip->canon)."\n" if (defined($opt{'verbose'}));
			my %options = ( 'set' => 1, 'domain' => 1 ) if ($domain);
			$webapi->create_a(\%options,$fqdn,$ip);
		}
	}
}

sub handle_cname
{
	&debug(__FILE__,__LINE__,'+ &handle_cname('.join(',',map("'$_'",@_)).')') if (defined($debug{'call'}) || defined($debug{'handle_cname'}));
	my ($fqdn,$alias,$prefix) = @_;

	return if (defined($opt{'skip-webapi'}));

	print "Checking CNAME RR $alias -> $fqdn\n" if (defined($opt{'verbose'}) && $opt{'verbose'}>1);
	# FIXME: Currently, we don't check for an A RR (but create_cname() should fail then â¦)
	my @fqdn = $webapi->list_cname($alias);
	&debug(__FILE__,__LINE__,'+ &handle_cname: @fqdn = '.Data::Dumper->new([\@fqdn],['*'])->Indent(0)->Dump) if (defined($debug{'handle_cname'}) && $debug{'handle_cname'}>2);
	if (defined($opt{'delete'})) {
		if (@fqdn) {
			&quit("CNAME RR $alias defined but points to $fqdn[0] instead of $fqdn") if ($fqdn[0] ne $fqdn);
			print "Deleting CNAME RR $alias -> $fqdn\n" if (defined($opt{'verbose'}));
			$webapi->delete_cname($alias);
		}
	}
	else {
		if (@fqdn) {
			&quit("CNAME RR $alias already defined but points to $fqdn[0] instead of $fqdn") if ($fqdn[0] ne $fqdn);
		}
		else {
			my @type = $webapi->fqdn_type($alias);
			if (@type && $type[0] ne 'alias' && $type[0] ne 'wildcard') {
				if ($type[0] eq 'host' || $type[0] eq 'domain' || $type[0] eq 'wildcard') {
					print "Getting A RRs for $alias\n" if (defined($opt{'verbose'}) && $opt{'verbose'}>1);
					my @fqdn = $webapi->list_a($alias);
					&debug(__FILE__,__LINE__,'+ &handle_cname: @fqdn = '.Data::Dumper->new([\@fqdn],['*'])->Indent(0)->Dump) if (defined($debug{'handle_cname'}) && $debug{'handle_cname'}>2);
					my $odd = 0;
					&quit("DNSVS: $alias is type \"".($type[0])."\" and points to ".join(', ',map($_->canon,grep($odd++%2,@fqdn)))) if (@fqdn);
				}
				print "Changing pre-existing FQDN $alias to type alias\n" if (defined($opt{'verbose'}) && $opt{'verbose'}>1);
				$webapi->update_fqdn_type($alias,'alias');
			}
			print "Creating CNAME RR $alias -> $fqdn\n" if (defined($opt{'verbose'}));
			$webapi->create_cname($alias,$fqdn);
		}
	}
}

# Not related to SNI but to BIG-IP 16.1 â but this corelates
if ($sni) {
	$v4 = '-IPv4';
	$v6 = '';
}

#
# Create/delete live server
#
my %vips;
unless (defined($opt{'stage-only'})) {
	my @alias = @{$opt{'alias'}} if (defined($opt{'alias'}));
	my ($live_ip_v4,$live_ip_v6);
	unless (defined($opt{'only-user-dirs'})) {
		# This would have been a good idea, but not only the FQDN may be already in use, but in the CNAME case also the DNS entry, so use test- in both names
		#my $test_dns = $prefix if ($live_fqdn eq $live_dns);
		my $prefix_dns = $prefix unless ($sni);

		print "${live_prefix}FQDN: $prefix$live_fqdn\n" if (defined($opt{'verbose'}));
		print "${live_prefix}DNS: $prefix_dns$live_dns\n" if (defined($opt{'verbose'}) && $live_fqdn ne $live_dns);
		if (defined($live_base_v4)) {
			# Unfortunatly, to reduce the mask to /32, we have to go all the way from NetAddr::IP to ASCII and back again
			$live_ip_v4 = &ip(($live_base_v4+$slot)->canon);
			print "${live_prefix}IPv4: ",$live_ip_v4->canon,"\n" if (defined($opt{'verbose'}));
			$vips{$live_ip_v4->canon} = 1 unless ($keep_instance_address);
			&handle_a($prefix_dns.$live_dns,$live_ip_v4) unless ($keep_instance_address);
			# FIXME: Handle live_fqdn if SNI
			# FIXME: &handle_a  with domain=1_adds_ addresses while non-domain entries get overwritten â thus migration piles up domain addresses :-(
			&handle_a($live_fqdn_domain,$live_ip_v4,1) if ($dnsvs && !length($prefix) && $live_fqdn =~ /^www\./i && !defined($opt{'no-domain-alias'}));
		}
		if (defined($live_base_v6)) {
			# Unfortunatly, to reduce the mask to /128, we have to go all the way from NetAddr::IP to ASCII and back again
			$live_ip_v6 = &ip(($live_base_v6+$slot)->canon);
			print "${live_prefix}IPv6: ",$live_ip_v6->canon,"\n" if (defined($opt{'verbose'}));
			$vips{$live_ip_v6->canon} = 1 unless ($keep_instance_address);
			&handle_a($prefix_dns.$live_dns,$live_ip_v6) unless ($keep_instance_address);
			# FIXME: Handle live_fqdn if SNI
			# FIXME: &handle_a  with domain=1_adds_ addresses while non-domain entries get overwritten â thus migration piles up domain addresses :-(
			&handle_a($live_fqdn_domain,$live_ip_v6,1) if ($dnsvs && !length($prefix) && $live_fqdn =~ /^www\./i && !defined($opt{'no-domain-alias'}));
		}

		#&dns_mail_extern($hostmaster,$prefix.$live_fqdn,$prefix_dns.$live_dns,defined($opt{'delete'})) if ($live_fqdn ne $live_dns);
		if ($dnsvs) {
			if ($live_fqdn ne $live_dns) {
				if (defined($opt{'force-sni'}) && !defined($opt{'skip-webapi'})) {
					my @cnames = $webapi->list_cname_target($prefix.$live_fqdn);
					push(@alias,@cnames);
					for my $cname (@cnames) {
						print "Updating CNAME RR $cname -> $prefix_dns$live_dns\n" if (defined($opt{'verbose'}));
						$webapi->update_cname($cname,$prefix_dns.$live_dns);
					}
					my @a = $webapi->list_a($prefix.$live_fqdn);
					while (@a) {
						my $fqdn = shift(@a);
						my $ip = shift(@a);
						my $a = ($ip->version==4) ? 'A' : 'AAAA';
						print "Deleting $a RR $fqdn -> ".($ip->canon)."\n" if (defined($opt{'verbose'}));
						$webapi->delete_a($fqdn,$ip);
					}
					if (!length($prefix) && $live_fqdn =~ /^www\./i && !defined($opt{'no-domain-alias'})) {
						my @a = $webapi->list_a($live_fqdn_domain);
						while (@a) {
							my $fqdn = shift(@a);
							my $ip = shift(@a);
							next if (defined($live_ip_v4) && $ip == $live_ip_v4 || defined($live_ip_v6) && $ip == $live_ip_v6);
							my $a = ($ip->version==4) ? 'A' : 'AAAA';
							print "Deleting $a RR $fqdn -> ".($ip->canon)."\n" if (defined($opt{'verbose'}));
							$webapi->delete_a($fqdn,$ip);
						}
					}
				}
				&handle_cname($prefix_dns.$live_dns,$prefix.$live_fqdn);
			}
		}
		else {
			&dns_mail_extern($hostmaster,$prefix.$live_fqdn,$prefix_dns.$live_dns,defined($opt{'delete'}));
			&dns_mail_extern($hostmaster,$live_fqdn_domain,$prefix_dns.$live_dns,defined($opt{'delete'})) if (defined($opt{'force-domain-alias'}) && !length($prefix) && $live_fqdn =~ /^www\./i);
		}

		for my $alias (@alias) {
			# FIXME: We would need code here to check for internal or external alias (&dns_mail_extern then?!) and to set a prefix if already defined different
			# FIXME: For not yet existing A/AAAA/CNAME entries, we would have to use &soa(&domain($alias)) â¦
			if ($dnsvs) {
				#&handle_cname($prefix_dns.$live_dns,$alias);
				&handle_a($alias,$live_ip_v4,1) if (defined($live_ip_v4) && !length($prefix));
				&handle_a($alias,$live_ip_v6,1) if (defined($live_ip_v6) && !length($prefix));
			}
			else {
				($ns,$hostmaster) = &soa($alias);
				&quit("Unknown authority: SOA for $alias not found. Please contact your administrator ;-) Usually this is an error, go to NET!") unless (defined($ns));
				&dns_mail_extern($hostmaster,$alias,$prefix_dns.$live_dns,defined($opt{'delete'}));
			}
		}

		# Only if we are authoritative, we are able to provide a domain A RR
		# Only if this is not a test, we will actually add such a domain A RR
		#push(@alias,$live_fqdn_domain) if ($dnsvs && !length($prefix) && $live_fqdn =~ /^www\./i && !defined($opt{'no-domain-alias'}));
		# However, eventually such a domain A RR will be introduced within the lifetime of the certificate, so add it anyway
		#push(@alias,$live_fqdn_domain) if ($dnsvs && $live_fqdn =~ /^www\./i && !defined($opt{'no-domain-alias'}));
		# Ahh, but we can't fulfill an ACME challenge for a not-yet-defined domain, so we'll have to wait for it
		# FIXME: If we want to use the host's IP for the (only) running apache, we specify --skip-webapi and provide a slot â this prevents us from automatically adding the domain alias :-( so in this case we should either check DNS if the domain is defined or add a special option to use the base IP address. Workaround: explicitly list the domain as an alias
		push(@alias,$live_fqdn_domain) if (($dnsvs || defined($opt{'force-domain-alias'})) && !length($prefix) && $live_fqdn =~ /^www\./i && !defined($opt{'no-domain-alias'}));
		print "${live_prefix}Alias(es): ",join(', ',@alias),"\n" if (defined($opt{'verbose'}) && @alias);

		# Bad hack: exclude conf/httpd.conf from recreation, thus avoid prematurly dropping the Listen/VirtualHost from the old IP address
		shift(@templates) if (defined($opt{'force-sni'}));
	}
	&server('LIVE',$live_fqdn,$live_ip_v4,$live_ip_v6,@alias);
	&loadbalancer($sni?$live_dns:$live_fqdn,$live_ip_v4,$live_ip_v6) if (@servers && !defined($opt{'skip-f5'}) && !$keep_instance_address);
}

#
# Create/delete stage server
#
if (defined($opt{'stage'}) || defined($opt{'stage-only'})) {
	my ($stage_ip_v4,$stage_ip_v6);
	unless (defined($opt{'only-user-dirs'})) {
		# This would have been a good idea, but not only the FQDN may be already in use, but in the CNAME case also the DNS entry, so use test- in both names
		#my $test_dns = $prefix if ($stage_fqdn eq $stage_dns);
		my $prefix_dns = $prefix unless ($sni);
		print "Stage FQDN: $prefix$stage_fqdn\n" if (defined($opt{'verbose'}));
		# CHECK: When will we have a stage server but no $stage_dns ?! Should we skip any of the other steps also?
#		if (defined($stage_dns)) {
		print "Stage DNS: $prefix_dns$stage_dns\n" if (defined($opt{'verbose'}) && $stage_fqdn ne $stage_dns);
		# FIXME? Unless stage-only, we already determined the IPs while creating the live server
		if (defined($stage_base_v4)) {
			# Unfortunatly, to reduce the mask to /32, we have to go all the way from NetAddr::IP to ASCII and back again
			$stage_ip_v4 = &ip(($stage_base_v4+$slot)->canon);
			print "Stage IPv4: ",$stage_ip_v4->canon,"\n" if (defined($opt{'verbose'}));
			$vips{$stage_ip_v4->canon} = 1 unless ($keep_instance_address && !defined($opt{'stage-only'}));
			&handle_a($prefix_dns.$stage_dns,$stage_ip_v4) unless ($keep_instance_address);
		}
		if (defined($stage_base_v6)) {
			# Unfortunatly, to reduce the mask to /128, we have to go all the way from NetAddr::IP to ASCII and back again
			$stage_ip_v6 = &ip(($stage_base_v6+$slot)->canon);
			print "Stage IPv6: ",$stage_ip_v6->canon,"\n" if (defined($opt{'verbose'}));
			$vips{$stage_ip_v6->canon} = 1 unless ($keep_instance_address && !defined($opt{'stage-only'}));
			&handle_a($prefix_dns.$stage_dns,$stage_ip_v6) unless ($keep_instance_address);
		}
		#&dns_mail_extern($hostmaster,$prefix.$stage_fqdn,$prefix_dns.$stage_dns,defined($opt{'delete'})) if ($stage_fqdn ne $stage_dns);
		if ($dnsvs) {
			if ($stage_fqdn ne $stage_dns) {
				if (defined($opt{'force-sni'})) {
					my @a = $webapi->list_a($prefix.$stage_fqdn);
					while (@a) {
						my $fqdn = shift(@a);
						my $ip = shift(@a);
						my $a = ($ip->version==4) ? 'A' : 'AAAA';
						print "Deleting $a RR $fqdn -> ".($ip->canon)."\n" if (defined($opt{'verbose'}));
						$webapi->delete_a($fqdn,$ip);
					}
				}
				&handle_cname($prefix_dns.$stage_dns,$prefix.$stage_fqdn);
			}
		}
		else {
			&dns_mail_extern($hostmaster,$prefix.$stage_fqdn,$prefix_dns.$stage_dns,defined($opt{'delete'}));
		}
#		}
	}
	&server('STAGE',$stage_fqdn,$stage_ip_v4,$stage_ip_v6);
	# No need to run this when SNI and we didn't skip the live server
	&loadbalancer($sni?$stage_dns:$stage_fqdn,$stage_ip_v4,$stage_ip_v6) if (@servers && !defined($opt{'skip-f5'}) && !$keep_instance_address && !($sni && !defined($opt{'stage-only'})));
	&shell("Can't set reddot access to $opt{'user'}",1,undef,@reddot,$opt{'user'}) if (defined($opt{'user'}) && !defined($opt{'delete'}));
}

#
# Restart httpd
#
unless ($opt{'skip-reload'} || $opt{'only-user-dirs'}) {
	if ($start eq 'uid') {
		if (%action) {
			# Give other involved servers a chance to be reloaded (with lesser VHosts) before the new user's server is initiated
			print "Create apache configuration files...\n" if (defined($opt{'verbose'}));
			# FIXME: We could skip this step if reloading and only $user_uid_gid is involved â will be run as ExecReload in the service anyway
			&shell("Can't configure httpd",1,undef,@all,@apache2cfg,'-m','-c','-i','-u',keys %action);
			for my $user (keys %action) {
				unless ($user eq $user_uid_gid) {
					print ucfirst($action{$user})." httpd\@$user.service...\n" if (defined($opt{'verbose'}));
					&shell("Can't ".$action{$user}." httpd",1,undef,@all,$systemctl,$action{$user},'httpd@'.$user.'.service');
				}
			}
		}
		# If this is the first time a server is started, also enable it to keep it being started on reboots
		# Since we might think the server is already enabled when the installation process just failed, we do this unconditionally
		#if ($action{$user_uid_gid} eq 'start') {
		unless ($opt{'delete'}) {
			# FIXME: A server that is going be deleted should be disabled?!
			print "Enable httpd\@$user_uid_gid.service...\n" if (defined($opt{'verbose'}));
			&shell("Can't enable httpd",1,undef,@all,$systemctl,'enable','httpd@'.$user_uid_gid.'.service');
		}
		if (defined($action{$user_uid_gid})) {
			my $action = $action{$user_uid_gid};
			print ucfirst($action)." httpd\@$user_uid_gid.service...\n" if (defined($opt{'verbose'}));
			# Just to be on the safe side
			$action = 'reload-or-restart' if ($action eq 'reload');
			&shell("Can't ".$action{$user_uid_gid}." httpd",1,undef,@all,$systemctl,$action,'httpd@'.$user_uid_gid.'.service');
		}
	}
	else {
#		unless ($opt{'delete'}) {
#			print "Reconfigure virtual IPs...\n" if (defined($opt{'verbose'}));
#			&shell("Can't reconfigure virtual IPs",1,undef,@all,$systemctl,'restart','apache2vip.service');
#			# Does this trigger a restart of apache2?! We seem to run into a race condition...
#			sleep(2);
#		}
		print "Reload apache...\n" if (defined($opt{'verbose'}));
		#&shell("Can't reload apache2",1,undef,@all,$init_apache2,'reload-or-restart');
		&shell("Can't reload apache2",1,undef,@all,$systemctl,'reload-or-restart','apache2.service');
	}
	if ($opt{'delete'} && %vips) {
		# apache2cfg doesn't shut down unneeded IPs
		print "Unconfigure ".join(', ',keys %vips)."...\n" if (defined($opt{'verbose'}));
		&shell("Can't unconfigure virtual IPs",1,undef,@all,@vip_setup,'-u',keys %vips);
	}
}

if ($full_config) {
	print "Update global apache configs...\n" if (defined($opt{'verbose'}));
	&shell("Can't update global apache configs",1,undef,@all,@apache2cfg,'-c',$start eq 'uid'?'-m':());

	if ($start eq 'uid' && -d $php_fpm_pools) {
		print "Reload PHP FPM...\n" if (defined($opt{'verbose'}));
		&shell("Can't reload PHP FPM",1,undef,@clcmd,$systemctl,'reload-or-restart',"php${php_version}-fpm");

		print "Reload PHP FPM on bullseye...\n" if (defined($opt{'verbose'}) && @bullseye);
		&shell("Can't reload PHP FPM on bullseye",1,undef,@bullseye,$systemctl,'reload-or-restart','php7.4-fpm') if (@bullseye);

		print "Reload PHP FPM on bookworm...\n" if (defined($opt{'verbose'}) && @bookworm);
		&shell("Can't reload PHP FPM on bookworm",1,undef,@bookworm,$systemctl,'reload-or-restart','php8.2-fpm') if (@bookworm);
	}
}

#
# Get ACME certificate
#

# WONT DO: until we get immediate nameserver updates, we can't start ACME here since it would try dns-01 with live servers, making them unusable as CNAME destinations :(
#my @alias = ($live_fqdn_domain) if ($live_fqdn eq $live_dns && $live_fqdn =~ /^www\./i && !defined($opt{'no-domain-alias'}));
#push(@alias,$webapi->list_cname_target($live_fqdn));
#push(@alias,@{$opt{'alias'}}) if (defined($opt{'alias'}));
#if ($opt{'delete'}) {
#	#print join(' ','+',$acmetool,'unwant',$live_fqdn,@alias)."\n";
#	print "Dropping ACME certificate for ".join(', ',$live_fqdn,@alias)."...\n" if (defined($opt{'verbose'}));
#	&shell("Failed to drop ACME certificate for $live_fqdn",1,undef,$acmetool,'unwant',$live_fqdn,@alias);
#	#print "Dropping ACME certificate for $stage_fqdn...\n" if (defined($opt{'verbose'}));
#	#&shell("Failed to drop ACME certificate for $stage_fqdn",1,undef,$acmetool,'unwant',$stage_fqdn);
#}
#else {
#	# Reconcile would be useless as A RRs won't be published yet
#	#print join(' ','+',$acmetool,'want','--no-reconcile',$live_fqdn,@alias)."\n";
#	print "Request ACME certificate for ".join(', ',$live_fqdn,@alias)."...\n" if (defined($opt{'verbose'}));
#	&shell("Failed to request ACME certificate for $live_fqdn",1,undef,$acmetool,'want','--no-reconcile',$live_fqdn,@alias);
#	#print "Request ACME certificate for $stage_fqdn...\n" if (defined($opt{'verbose'}));
#	#&shell("Failed to request ACME certificate for $stage_fqdn",1,undef,$acmetool,'want','--no-reconcile',$stage_fqdn);
#}

# If we have to force server generation for a not-yet-migrated FQDN, there is little chance an ACME request would succeed at this point in time...
# If we specify challenge type, this would be dns-01 and would wait for two hours :-(
unless (defined($opt{'delete'}) || defined($opt{'force-migration'}) || defined($opt{'only-user-dirs'}) || defined($opt{'challenge'})) {
	my $reconfigure;
	unless (defined($opt{'stage-only'})) {
#		# If server name and DNS entry differ, this requires an external and manual DNS entry which will not yet have been defined at this point in time...
#		if ($live_dns eq $live_fqdn) {
			my $crt = catfile($root,$live_fqdn,'conf','ssl','dehydrated','cert.pem');
			unless (-s $crt) {
				print "Request ACME certificate for $live_fqdn...\n" if (defined($opt{'verbose'}));
				$config = $webapi->write_config() or die "Can't write WebAPI config\n" if ($config eq '-');
				&shell("Failed to request ACME certificate for $live_fqdn (ignore this, if this is the first run for a new VHost - a request for an ACME certificate will be retried automatically)",1,undef,$acme_cert,'--config',$config,$live_fqdn);
				$reconfigure = 1;
			}
#		}
	}
	# FIXME: Do the same for the stage server
	if (defined($opt{'stage'}) || defined($opt{'stage-only'})) {
#		# If server name and DNS entry differ, this requires an external and manual DNS entry which will not yet have been defined at this point in time...
#		if ($stage_dns eq $stage_fqdn) {
		# With SNI, stages are no longer using private IPs, once forcing dns-01, but being CNAMEs, forcing http-01!
		if ($sni) {
			my $crt = catfile($root,$stage_fqdn,'conf','ssl','dehydrated','cert.pem');
			unless (-s $crt) {
				print "Request ACME certificate for $stage_fqdn...\n" if (defined($opt{'verbose'}));
				$config = $webapi->write_config() or die "Can't write WebAPI config\n" if ($config eq '-');
				&shell("Failed to request ACME certificate for $stage_fqdn (ignore this, if this is the first run for a new VHost - a request for an ACME certificate will be retried automatically)",1,undef,$acme_cert,'--config',$config,$stage_fqdn);
				$reconfigure = 1;
			}
		}
	}
	if ($reconfigure) {
		# If everything is >= buster, change ssl.conf to a static version with <IfFile>
		print "Update apache ssl configuration file...\n" if (defined($opt{'verbose'}));
		&shell("Can't update apache ssl configuration file",1,undef,@all,@apache2cfg,'-c',$live_fqdn);
		unless ($opt{'skip-reload'}) {
			my $service = ($start eq 'uid'?'httpd@'.$user_uid_gid:'apache2').'.service';
			print "Reload $service...\n" if (defined($opt{'verbose'}));
			&shell("Can't reload $service",1,undef,@all,$systemctl,'reload-or-restart',$service);
		}
	}
}

exit;

################################################################################
#
# Create/delete VHost
#
sub server
{
	my ($tag,$fqdn,$ip_v4,$ip_v6,@alias) = @_;
	&debug(__FILE__,__LINE__,'+ &server('.join(',',map("'$_'",@_)).')') if (defined($debug{'call'}) && $debug{'call'}>1 || defined($debug{'server'}));

	my $domain = &domain($fqdn);
	my $mail = defined($opt{'mail'}) ? $opt{'mail'} : 'webmaster@'.$domain;
	my $server_root = catdir($root,$fqdn);
	my $server_conf = catdir($server_root,'conf');

	my $ssl = catdir($server_conf,'ssl');
	my @dehydrated = (catdir($ssl,'dehydrated')) if (defined($opt{'challenge'}));
	my $log = catdir($server_root,'log');
	my $csp = catfile($log,'csp-report.log');
	my @php = (catdir($server_root,'php')) if (grep(-e,glob('/etc/apache2/mods-enabled/php*.load /etc/php/*/fpm')));
	my $run = catdir($server_root,'run');
	my $keytab = catfile($server_conf,'http.keytab');

	my ($user_root,$content_root,@owner,@owner_htdocs);
	if (defined($opt{'user'})) {
		$user_root = catdir($user_home,$fqdn);
		$content_root = $user_root;
	}
	else {
		$content_root = $server_root;
	}

	my $htdocs = catdir($content_root,'htdocs');
	my $cgibin = catdir($content_root,'cgi-bin');
	my $content_log = catdir($content_root,'log');
	my ($wsgiscripts,@wsgiscripts);
	if ($wsgi) {
		$wsgiscripts = catdir($content_root,'wsgi-scripts');
		@wsgiscripts = ($wsgiscripts);
	}

	my $awstats_conf = catfile($awstats,'awstats.'.$fqdn.'.conf') if (-d $awstats);
	my @awstats = (catdir($htdocs,'awstats')) if (!$opt{'skip-awstats'} && -e '/etc/apache2/conf-enabled/awstats.conf');

	if (defined($opt{'user'})) {
		@owner = ($owner,'-i',$user_home,'--');
		# Fails if homedir itself isn't accessible
		#@owner_htdocs = ($owner,'-i',$htdocs,'--');
		@owner_htdocs = ($owner,'-i',$user_home,'--');
	}
	elsif (defined($opt{'owner'})) {
		@owner_htdocs = ($owner,'-i',$htdocs,'--')
	}

	if (defined($opt{'delete'})) {
		# FIXME: check sp.crt, delete if found
		my $host = $auth{'shibboleth'} =~ s/.*@//r;
		&shell("Can't delete Shibboleth entry $fqdn on $host",!$opt{'force'},undef,@ssh,'-i',$identity{'shibboleth'},'-n',$auth{'shibboleth'},'delete',$fqdn) if (-d $shibboleth);
		# Should not revoke unless private key leaked!
		#&shell("Can't revoke SSL certificate $ssl/server.crt",!$opt{'force'},undef,$owner,'-i',$ssl,'--',$ssl_request,@ssl_opts,'-c',$fqdn,'-K',catfile($ssl,'server.key'),'-x');
		print "Remove $server_root...\n" if (defined($opt{'verbose'}));
		&shell("Can't remove $server_root",1,undef,@all,$rm,'-r','-f',catfile($enabled,$fqdn.'.conf'),catfile($available,$fqdn.'.conf'),$server_root);
		if (defined($awstats_conf)) {
			print "Remove $awstats_conf...\n" if (defined($opt{'verbose'}));
			&shell("Can't remove $awstats_conf",0,undef,@all,$rm,'-f',$awstats_conf);
		}
		if (defined($user_root)) {
			print "Remove $user_root...\n" if (defined($opt{'verbose'}));
			# Remove directories as the cms user, just in case
			if (defined($opt{'stage'}) || defined($opt{'stage-only'})) {
				&shell(undef,0,undef,$owner,'-e','/dev/null','-i',$cms_dir,'--',$rm,'-r','-f',$user_root);
			}
			# Remove directories as the server's user
			&shell("Can't remove $user_root",0,undef,@owner,$rm,'-r','-f',$user_root);
		}
	}
	else {
		my @distribute = ($server_root);
		unless (defined($opt{'only-user-dirs'})) {

			# FIXME: ?
			# Why do we run this as ServerRoot's owner?
			#  Doesn't work if ServerRoot is wwwadm but VHosts aren't
			#   Why should this happen?
			#&shell("Can't create $ssl, $log and $run",1,undef,$owner,'-i',$root,'--',$mkdir,'-p',$ssl,$log);
			&shell("Can't create ".join(', ',$ssl,@dehydrated,$log,@php)."and $run",1,undef,$mkdir,'-p',$ssl,@dehydrated,$log,@php,$run);
			&mod(0755,$server_root,$server_conf,$ssl);
#			# Allow access for myaccesslog
#			&own(0,$wwwadm,$log);
			# Allow access for run_awstats
			# Since apache opens the logs as root, we can't give away ownership
			# Group must be set to server GID so a CGI can write to $csp
			&own(0,$start eq 'uid'?$user_gid:$server_gid,$log);
			# php/ must be user-owned since mod_php reopens the error_log with every request
			# Since there may already be user-owned error.log files, we have to change their owner (e.g. when an already running server is migrated onto another account) FIXME: Should this be done at server startup time (e.g. within apache2cfg)?
			# BUGSME: What is run/ good for and why is it user-owned?
			##  ISEE: run_awstats used this to place a patched copy of awstats.pl
			#   ISEE: run_awstats uses this to collect the logfiles from all the cluster nodes
			# STILLUNKNOWN: Why is it group scc-web?!
			&own($user_uid,$wwwadm,@php,glob(catfile(@php,'error.log*')),$run) if (defined($user_uid));
			# Only in the multi-user case we can world-restrict the log since only then the server GID matches the docroot owner's GID
			&mod($start eq 'uid'?0750:0755,$log);
			&mod(0750,@php);
			&mod(0755,$run);
			# Since the csp-report CGI runs as user, but log directory is root-owned, we have to create the initial log
			&shell("Can't create $csp",1,undef,$touch,$csp);
			# FIXED: in the single-instance case, $user_uid is the owner of the docs, but not apache's user!
			&own($start eq 'uid'?$user_uid:$server_uid,0,$csp);
			&mod(0644,$csp);
		}

		# Create directories as the server's user
		&shell("Can't create $htdocs, $cgibin and $content_log",1,undef,@owner,$mkdir,'-p',$htdocs,@awstats,$cgibin,@wsgiscripts,$content_log);
		# FIXME: Is this valid for $content_log in the -U case?
		&own($user_uid,$user_gid,$htdocs,@awstats,$cgibin,@wsgiscripts,$content_log) if (defined($user_uid));
		&mod(0755,$htdocs,@awstats,$cgibin,@wsgiscripts);
		# FIXME: Is this valid for $content_log in the -U case?
		&mod(0700,$content_log);
		if (defined($opt{'user'}) && (defined($opt{'stage'}) || defined($opt{'stage-only'}))) {
			for my $user (keys %access) {
				my ($domain) = split('\\\\',$user);
				# emcsetsdonce-1.0.1
				#$user .= '='.$access{$user} if (defined($access{$user}));
				&shell("Can't set ACL: R-X--- OBJECT_INHERIT,CONTAINER_INHERIT to $user_home",1,undef,@owner,$emcsetsdonce,'-D',$domain,'-g',"$user,0x100021,0x3",$user_home);
				&shell("Can't set ACL: R-----,Read to $user_root",1,undef,@owner,$emcsetsdonce,'-D',$domain,'-g',"$user,0x120089,0x0",$user_root);
				&shell("Can't set ACL: RWXPDO OBJECT_INHERIT,INHERIT_ONLY to $htdocs",1,undef,@owner,$emcsetsdonce,'-D',$domain,'-g',"$user,0x10000000,0x9",$htdocs);
				&shell("Can't set ACL: RWXPDO,FullControl,Modify,ReadExecute,Read,Write,ListFolderContents CONTAINER_INHERIT to $htdocs",1,undef,@owner,$emcsetsdonce,'-D',$domain,'-g',"$user,0x1f01ff,0x2",$htdocs);
			}
		}

		if (opendir(COMMON,$common_htdocs)) {
			while ($_ = readdir(COMMON)) {
				next if (/^\.\.?$/);
				#next if (/\.php$/ && !@php);
				if (@php) {
					next if (/\.html$/ && (-e catfile($common_htdocs,$`.'.php') || -e catfile($htdocs,$`.'.php')));
				}
				else {
					next if (/\.php$/);
				}
				my $dst = catfile($htdocs,$_);
				my $test = 'test -e '.$dst;
				$test .= ' -o -e '.catfile($htdocs,basename($_,'.html').'.php') if (@php);
				# Doesn't work, root has no nfs access to $htdocs
				#&shell("Can't copy DocumentRoot skeleton $_ from $common_htdocs to $dst",1,undef,@owner,$cp,'--preserve=mode,timestamps',catfile($common_htdocs,$_),$dst) unless (-e $dst);
				&shell("Can't copy DocumentRoot skeleton $_ from $common_htdocs to $dst",1,undef,@owner_htdocs,$sh,'-c',$test.' || cp --preserve=mode,timestamps '.catfile($common_htdocs,$_).' '.$dst);
			}
			closedir(COMMON);
		}
# We don't need no pre-linked CGIs any more
# (and we certainly do not want to link my.*log scripts since they're only
# access protected in their global-cgi-bin incarnation!)
#		if (opendir(COMMON,$common_cgibin)) {
#			while ($_ = readdir(COMMON)) {
#				next if (/^\.\.?$/);
#				my $dst = catfile($cgibin,$_);
#				&shell("Can't link ScriptAlias skeleton $_ from $common_cgibin to $dst",1,undef,@owner_htdocs,$sh,'-c',"test -e $dst || ln -s ".catfile($common_cgibin,$_)." $dst");
#			}
#			closedir(COMMON);
#		}

		unless (defined($opt{'only-user-dirs'})) {
			# Activate modules
			if (%mod) {
				if ($start ne 'uid') {
					&shell("Can't enable modules",1,undef,$a2enmod,'--quiet',keys %mod);
				}
				else {
					&template(catfile($templates,'modules'),catfile($server_conf,'modules'),{'MODULES'=>[sort keys %mod]});
				}
			}

			# Unfortunatly, CANON_DOMAIN'=>($fqdn =~ /^www\./) gives only one list element, but no undef or empty or false...
			# CANON_DOMAIN: Not required if CANON_FQDN is set (also handles the domain case)
			&debug(__FILE__,__LINE__,'@alias = '.Data::Dumper->new([\@alias],['*'])->Indent(0)->Dump) if (defined($debug{'sni'}) && $debug{'sni'}>1);
			# Beware that here SERVER_ROOT refers to the VHost, while in apache2cfg it refers to the apache instance
			my $replace = {$tag=>1,'FQDN'=>$fqdn,'ALIAS'=>\@alias,'DOMAIN'=>$domain,'DEFAULT'=>($slot eq 'default'),defined($ip_v4)?('IPV4'=>$ip_v4->canon):(),defined($ip_v6)?('IPV6'=>$ip_v6->canon):(),'MAIL'=>$mail,'SERVER_ROOT'=>$server_root,'CONTENT_ROOT'=>$content_root,'USER'=>$opt{'user'},'UID'=>$user_uid,'GID'=>$user_gid,'HTDOCS'=>$htdocs,'LOG'=>$content_log,'WSGI'=>$wsgi,'SNI'=>$sni,'MULTI'=>($start eq 'uid'),'WWW_KIT_EDU'=>($fqdn eq 'www.kit.edu'),'SSL_ONLY'=>!$opt{'ssl-optional'},'SHIBBOLETH'=>(($mod{'shib'} || -e catfile($mods_enabled,'shib.load')) && -d $shibboleth),'CANON'=>($opt{'canon-to-homepage'} ? '/' : '$1'),'CANON_DOMAIN'=>!($fqdn !~ /^www\./ || !$opt{'skip-canon'}),'CANON_IP'=>$canon_ip,'CANON_FQDN'=>!$opt{'skip-canon'},'KEYTAB'=>-f $keytab,'PHP_FPM'=>-d $php_fpm_pools};
			&debug(__FILE__,__LINE__,'$replace = '.Data::Dumper->new([\$replace],['*'])->Indent(0)->Dump) if (defined($debug{'sni'}) && $debug{'sni'}>1);
			for my $file (@templates) {
				my $dest = catfile($server_conf,$file);
				next if ($file =~ /^(?:test-)?(?:ssl|local(?:-php)?|shibboleth|user)\.conf/ && -s $dest);
				&template(catfile($templates,$file),$dest,$replace);
				if ($file =~ /^(?:local(?:-php)?|shibboleth)\.conf/) {
					# replaced by myapacheconf
					#&own($user_uid,$user_gid,$dest);
					&own(-1,$wwwadm,$dest);
					&mod(0664,$dest);
				}
			}

			&template(catfile($templates,'canon.conf'),catfile($server_conf,'canon.conf'),$replace);

			# FIXME: Check for deleted accounts, build from scratch, all in one include file, one file to include all /var/www/user/.../conf/php-fpm.conf, whatever
			# Well, for one UID, we want to include ALL local-php.conf, so we need the list of VHOSTS - not available here but in apache2cfg
			#if (-d $php_fpm_pools) {
			#		&template(catfile($templates,'php-fpm.conf'),catfile($php_fpm_pools,$user_uid_gid.'.conf'),$replace);
			#}

		#	&template(catfile($templates,'vhost.logrotate'),catfile($logrotate,'apache2-'.$fqdn),{'FQDN'=>$fqdn});
			if (!$opt{'skip-awstats'} && defined($awstats_conf)) {
				&template(catfile($templates,@servers?'awstats-cluster.conf':'awstats.conf'),$awstats_conf,{'FQDN'=>$fqdn,'HTDOCS'=>$htdocs});
				push(@distribute,$awstats_conf);
			}

			my $aliases = catfile($server_conf,'aliases');
			if (@alias) {
				&template(catfile($templates,'aliases'),$aliases,{'ALIASES'=>\@alias});
			}
			else {
				print "Remove $aliases...\n" if (defined($opt{'verbose'}));
				&shell("Can't remove $aliases",0,undef,@all,$rm,'-f',$aliases);
			}

			# Use SSL files provided in /run in the case of pre-existing certificates
			my $pre_ssl = catdir($pre,$fqdn,'conf','ssl');
			if (-d $pre_ssl) {
				&shell(undef,0,undef,$cp,'--preserve=mode,timestamps',glob("$pre_ssl/server.*"),$ssl);
			}
			else {
				$pre_ssl = catdir($pre,$fqdn,'conf');
				&shell(undef,0,undef,$cp,'--preserve=mode,timestamps',glob("$pre_ssl/server.*"),$ssl) if (-d $pre_ssl);
			}
			#
			my $crt = catfile($ssl,'server.crt');
			my $chn = catfile($ssl,'server.chn');
			if (! -e $chn) {
				# If generation of the certificate fails (which could happen easily, e.g. "Result fault: Server-Domain nicht erlaubt"), avoid leaving an unrunable VHost (better: use -f)
				my @command = ($owner,'-i',$ssl,'--',$cp,$all,$chn);
				&shell("Can't pre-fill SSL chain $chn",0,undef,@command);
			}
			# The generation of the chain could eventually be integrated into ssl-request...
			my @chain = ($ssl_chain,'-c','-o',$chn,$crt);
			my @notify = ($sc,'reload',($start eq 'uid'?'httpd@'.$fqdn:'apache2').'.service');
			my @san = ('-k',join(',',@alias)) if (@alias);
			my @command = ($owner,'-i',$ssl,'--',$ssl_request,@ssl_opts,'-c',$fqdn,@san,'-K',catfile($ssl,'server.key'),'-a',join(' ',@chain,'&&',@notify));
			# In the SNI case, we no longer have private IPs for stage servers, so normally we don't really need a trusted DFN certificate since ACME is on it's way
			push(@command,'-g','30') if ($sni);
			&shell("Can't create SSL key and certificate $ssl/server.*, retrying",0,undef,@command) and
				&shell("Can't create SSL key and certificate $ssl/server.*",1,undef,@command,'-n');	# WHY?!
			# Is this ever to be entered, if we copy $all above?
			if (! -s $chn) {
				my @command = ($owner,'-i',$ssl,'--',@chain);
				&shell("Can't create SSL chain $chn",1,undef,@command);
				if (! -s $chn) {
					# At this point, this is a fake chain (we're self signed)
					# (we couldn't copy an existing certificate from an old server)
					# So don't use '-c' since this ends in an empty chain file and would lead to
					# SSLCertificateChainFile: file '.../server.chn' does not exist or is empty
					my @command = ($owner,'-i',$ssl,'--',$ssl_chain,'-o',$chn,$crt);
					&shell("Can't create SSL chain $chn",1,undef,@command);
				}
			}
			&mod(0644,$chn);
			if (defined($opt{'challenge'})) {
				my $file = catfile(@dehydrated,'type');
				open(TYPE,'>',$file) or &quit("Can't create $file: $!");
				print TYPE $opt{'challenge'},"\n";
				close(TYPE);
			}

			if (($mod{'shib'} || -e catfile($mods_enabled,'shib.load')) && -d $shibboleth) {
				# Create SP certificate
				my $crt = catfile($ssl,'sp.crt');
				# 1096 days is DFN-AAI requirement
				my @command = ($owner,'-i',$ssl,'--',$ssl_request,@ssl_opts,'-c',$fqdn,'-K',catfile($ssl,'sp.key'),'-g','1096');
				&shell("Can't create Shibboleth key and certificate $ssl/sp.*",!$opt{'force'},undef,@command);
				my $shibboleth_user = (stat($shibboleth_log))[4];
				&own($shibboleth_user,-1,catfile($ssl,'sp.key')) if ($shibboleth_user);
				# Send certificate to IdP
				my $host = $auth{'shibboleth'} =~ s/.*@//r;
				&shell("Can't create Shibboleth entry $fqdn on $host",!$opt{'force'},$crt,@ssh,'-i',$identity{'shibboleth'},$auth{'shibboleth'},'create',$fqdn);
			}

			# In a multi-user scenario, we include the VHosts from /var/www/user/.../conf/httpd.conf
			# In a single-user multi-VHost scenario, we use /etc/apache2/sites-enabled
			if ($start ne 'uid') {
				&sym(catfile($server_conf,$httpd),catfile($available,$fqdn.'.conf'));
				push(@distribute,catfile($available,$fqdn.'.conf'));
				&sym(catfile($available,$fqdn.'.conf'),catfile($enabled,$fqdn.'.conf'));
				push(@distribute,catfile($enabled,$fqdn.'.conf'));
			}

			&distribute(@distribute) unless (defined($opt{'skip-cluster'}));

			print "Fix apache configuration files on bullseye...\n" if (defined($opt{'verbose'}) && @bullseye);
			&shell("Can't fix apache config for bullseye",1,undef,@bullseye,'/usr/sbin/fix_vhost.bookworm',$fqdn) if (@bullseye);

			print "Fix apache configuration files on bookworm...\n" if (defined($opt{'verbose'}) && @bookworm);
			&shell("Can't fix apache config for bookworm",1,undef,@bookworm,'/usr/sbin/fix_vhost.bookworm',$fqdn) if (@bookworm);
		}
	}
}

################################################################################
#
# Run chmod command
#
sub mod
{
	my ($perm,@files) = @_;

	if (@files) {
		if ($opt{'dry-run'}) {
			print join(' ',$chmod,sprintf('%o',$perm),@files),"\n";
		}
		else {
			&debug(__FILE__,__LINE__,join(' ','+',$chmod,sprintf('%o',$perm),@files)) if (defined($debug{'exec'}));
			chmod($perm,@files);
		}
	}
}

################################################################################
#
# Run chown command
#
sub own
{
	my ($uid,$gid,@files) = @_;

	if (@files) {
		if ($opt{'dry-run'}) {
			print join(' ',$chown,$uid.':'.$gid,@files),"\n";
		}
		else {
			&debug(__FILE__,__LINE__,join(' ','+',$chown,$uid.':'.$gid,@files)) if (defined($debug{'exec'}));
			chown($uid,$gid,@files);
		}
	}
}

################################################################################
#
# Run symlink command
#
sub sym
{
	my ($old,$new) = @_;

	if ($opt{'dry-run'}) {
		print join(' ',@symlink,$old,$new),"\n";
	}
	else {
		&debug(__FILE__,__LINE__,join(' ','+',@symlink,$old,$new)) if (defined($debug{'exec'}));
		symlink($old,$new);
	}
}

################################################################################
#
# Run shell command
#
sub shell
{
	my ($errmsg,$fatal,$stdin,@cmd) = @_;
	&debug(__FILE__,__LINE__,'+ &shell('.join(',',map("'$_'",@_)).')') if (defined($debug{'call'}) && $debug{'call'}>1 || defined($debug{'shell'}));
	#&debug(__FILE__,__LINE__,'+ &shell'.Data::Dumper->new([\@_],['*'])->Indent(0)->Dump) if (defined($debug{'call'}) && $debug{'call'}>1 || defined($debug{'shell'}));

	if ($opt{'dry-run'}) {
		print join(' ',@cmd),"\n";
		&debug(__FILE__,__LINE__,'+ &shell =') if (defined($debug{'return'}) && $debug{'return'}>1 || defined($debug{'shell'}) && $debug{'shell'}>1);
		return;
	}

	&debug(__FILE__,__LINE__,join(' ','+',map(/\s/?"'$_'":$_,@cmd))) if (defined($debug{'exec'}));
	if (defined($stdin)) {
		open(OLDIN,'<&',\*STDIN) or &quit("Can't dup STDIN: $!") if (defined(fileno(STDIN)));
		open(STDIN,'<',$stdin) or &quit("Can't read $stdin: $!");
	}
	#if (system(@cmd) && defined($errmsg)) {
	my $rc = system(@cmd);
	&debug(__FILE__,__LINE__,'+ => rc = '.$rc) if (defined($debug{'exec'}));
	if ($rc && defined($errmsg)) {
		open(STDIN,'<&',\*OLDIN) or &quit("Can't re-dup STDIN: $!") if (defined($stdin));
		&quit('Error: '.$errmsg) if ($fatal);
		print $msglog 'Warning: '.$errmsg."\n" if (defined($msglog));
		warn('Warning: '.$errmsg."\n");
		&debug(__FILE__,__LINE__,'+ &shell = '.$rc) if (defined($debug{'return'}) && $debug{'return'}>1 || defined($debug{'shell'}) && $debug{'shell'}>1);
		return($rc);
	}
	open(STDIN,'<&',\*OLDIN) or &quit("Can't re-dup STDIN: $!") if (defined($stdin) && defined(fileno(OLDIN)));
	&debug(__FILE__,__LINE__,'+ &shell = 0') if (defined($debug{'return'}) && $debug{'return'}>1 || defined($debug{'shell'}) && $debug{'shell'}>1);
	return(0);
}

################################################################################
#
# Distribute config
#
sub distribute
{
	my (@files) = @_;

	# Exactly when does @servers differ from the default dist set?
	#&shell("Can't distribute ".join(' ',@files)." within cluster",1,undef,$dist,defined($debug{'dist'})?'-v':'-q','-u','-d',join(' ',@servers),@files) if (@servers);
	# We need to distribute a new server in all clusters, including test and legacy clusters...
	# CHECK: Really with legacy or only test? What is the definition of subset 'all'?
	&shell("Can't distribute ".join(' ',@files)." within cluster(s)",1,undef,$dist,defined($debug{'dist'})?'-v':'-q','-u','-s','all',@files) if (@servers);
}

################################################################################
#
# Create F5 configuration
#
sub loadbalancer
{
	&debug(__FILE__,__LINE__,'+ &loadbalancer('.join(',',map("'$_'",@_)).')') if (defined($debug{'call'}) || defined($debug{'loadbalancer'}));
	my ($fqdn,$ip_v4,$ip_v6) = @_;

	my $command = defined($opt{'delete'}) ? 'delete' : 'create';
	# Not really required because there still is a http stub that
	# serves /server-status
	#$command .= '-ssl' unless (defined($opt{'ssl-optional'}));

	# Processes the slaves first and the master last so that for Config Sync, the sync source is the last changed and won't refuse to sync
	for my $auth (grep(!$f5{$_},keys %f5),grep($f5{$_},keys %f5)) {
		my $host = $auth;
		$host =~ s/.*@//;
		print ucfirst($command)," F5 virtual server $fqdn on $host\n" if (defined($opt{'verbose'}));
		# This presumes SNI is on 16.1 and non-SNI is on 11.6
		if ($sni) {
			&shell("Can't $command F5 virtual server $fqdn on $host",$f5{$auth}||!$opt{'force'},undef,@ssh,'-i',$identity{'f5'},'-n',$auth,$command,$fqdn,$ip_v4->canon,$ip_v6->canon,@servers);
		}
		else {
			&shell("Can't $command F5 IPv4 virtual server $fqdn on $host",$f5{$auth}||!$opt{'force'},undef,@ssh,'-i',$identity{'f5'},'-n',$auth,$command,$fqdn.$v4,$ip_v4->canon,map($_.$v4,@servers));
			&shell("Can't $command F5 IPv6 virtual server $fqdn on $host",$f5{$auth}||!$opt{'force'},undef,@ssh,'-i',$identity{'f5'},'-n',$auth,$command,$fqdn.$v6,$ip_v6->canon,map($_.$v6,@servers));
		}
	}
}

################################################################################
#
# Copy a template to an instance, substituting given tokens
#
sub template
{
	&debug(__FILE__,__LINE__,'+ &template'.Data::Dumper->new([\@_],['*'])->Indent(0)->Dump) if (defined($debug{'call'}) && $debug{'call'}>1 || defined($debug{'template'}));
	my ($src,$dst,$substitutions) = @_;

	&debug(__FILE__,__LINE__,"Creating $dst from $src") if (defined($debug{'template'}) && $debug{'template'}>2 || $opt{'dry-run'});
	#&debug(__FILE__,__LINE__,map("\t$_ => ".$substitutions->{$_}."\n",sort keys %{$substitutions})) if (defined($debug{'template'}) && $debug{'template'}>2);

	open(SRC,'<',$src) || &quit("Can't read $src: $!");
	unless ($opt{'dry-run'}) {
		unlink($dst);
		&shell("Can't create $dst",1,undef,$owner,'-i',dirname($dst),'--',$touch,$dst);
		open(DST,'>',$dst) || &quit("Can't write to $dst: $!");

		LINE: while (<SRC>) {
			#chomp;
			&debug(__FILE__,__LINE__,'Line '.$..': '.$_) if (defined($debug{'template'}) && $debug{'template'}>2);
			# Conditions get ANDed
			while (/^%(!)?([^%]+)%/) {
				&debug(__FILE__,__LINE__,'%-Match:',$1,$2,$substitutions->{$2},($1 eq '!'),!($substitutions->{$2})) if (defined($debug{'template'}) && $debug{'template'}>1);
				next LINE if (($1 eq '!') != !($substitutions->{$2}));
				$_ = $';
				&debug(__FILE__,__LINE__,'Line '.$..': '.$_) if (defined($debug{'template'}) && $debug{'template'}>2);
			}
			while (/&(!)?([^&]+)&([^&]+)&/) {
				&debug(__FILE__,__LINE__,'&-Match:',$1,$2,$substitutions->{$2},($1 eq '!'),!($substitutions->{$2})) if (defined($debug{'template'}) && $debug{'template'}>1);
				$_ = $`.(($1 eq '!') != !($substitutions->{$2}) ? '' : $3).$';
				&debug(__FILE__,__LINE__,'Line '.$..': '.$_) if (defined($debug{'template'}) && $debug{'template'}>2);
			}
			# FIXME: should this be .../g ?!
			#while (/@([^@]+)@/) {
			while (/@([^[@][^@]*)@/) {
				&debug(__FILE__,__LINE__,'@-Match:',$1,$substitutions->{$1}) if (defined($debug{'template'}) && $debug{'template'}>1);
				$_ = $`.$substitutions->{$1}.$';
				&debug(__FILE__,__LINE__,'Line '.$..': '.$_) if (defined($debug{'template'}) && $debug{'template'}>2);
			}
			# 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 ;-)
			while (/@\[([^@\]]+)\]@/) {
				&debug(__FILE__,__LINE__,'@[-Match:',$1,sort @{$substitutions->{$1}}) if (defined($debug{'template'}) && $debug{'template'}>1);
				$_ = join('',map($`.$_.$',sort @{$substitutions->{$1}}));
				&debug(__FILE__,__LINE__,'Line '.$..': '.$_) if (defined($debug{'template'}) && $debug{'template'}>2);
			}
			print DST $_;
		}

		close(DST);
	}
	&mod(0444,$dst);
	close(SRC);
}

sub dns_mail_extern
{
	&debug(__FILE__,__LINE__,'+ &dns_mail_extern('.join(',',map("'$_'",@_)).')') if (defined($debug{'call'}) && $debug{'call'}>1 || defined($debug{'dns_mail_extern'}));
	my ($to,$fqdn,$cname,$delete) = @_;

	return if ($opt{'skip-mail'});

	if (my $rc = `$host -t CNAME $fqdn. 2>/dev/null`) {
		chomp $rc;
		&debug(__FILE__,__LINE__,"dns_mail_extern: rc = \"$rc\"") if (defined($debug{'dns'}));
		# has no $rr record: means that other RRs exist
		# not found: 3(NXDOMAIN): means that there are no RRs at all
		if ($rc =~ /has no \S+ record$|not found: 3\(NXDOMAIN\)$/) {
			return if ($delete);
		}
		else {
			# Global to delete over multilines (e.g. for alias)
			$rc =~ s/.*\s//g;
			$rc =~ s/\.$//;
			&debug(__FILE__,__LINE__,"dns_mail_extern: rc = \"$rc\"") if (defined($debug{'dns'}));
			if ($delete) {
				$cname = $rc;
			}
			else {
				return if ($rc eq $cname);
			}
			&debug(__FILE__,__LINE__,"dns_mail_extern: rc = \"$rc\"") if (defined($debug{'dns'}));
			&debug(__FILE__,__LINE__,"dns_mail_extern: cname = \"$cname\"") if (defined($debug{'dns'}));
			# Fallthrough to sending a mail requesting a change then
			#&quit("Cannot cname $fqdn to $cname\n - $fqdn has address $rc");
		}
	}

	if (!$opt{'human-dry-run'}) {
		&debug(__FILE__,__LINE__,join(' ','+',$sendmail,'-i','-t','-f',$from)) if (defined($debug{'exec'}));
		if ($opt{'dry-run'}) {
			#open(MAIL,">&STDOUT") or &quit("Can't dup STDOUT: $!");
			open(MAIL,'|-','sed','s/^/MAIL: /') or &quit("Can't run sed 's/^/MAIL: /': $!");
		}
		else {
			open(MAIL,'|-',$sendmail,'-i','-t','-f',$from) or &quit("Can't run $sendmail -i -t -f $from: $!");
		}
		print MAIL "From: $from\n";
		print MAIL "To: $to\n";
		print MAIL "Bcc: $from,$bcc\n";
		print MAIL "Subject: Bitte CNAME fuer Web-Server ".($delete?"loeschen":"eintragen")."\n";
		print MAIL "\n";
		print MAIL "Liebe Hostmaster!\n";
		print MAIL "\n";
		print MAIL $delete ? "Bitte loescht doch folgenden CNAME:\n" : "Bitte tragt doch folgenden CNAME ein/um:\n";
		print MAIL "\n";
		print MAIL "$fqdn -> $cname\n";
		print MAIL "\n";
		print MAIL "Mit freundlichen Gruessen, das neue Web-Server-Anlege-Script\n";
		close(MAIL);
	}
}

sub domain
{
	my ($fqdn) = @_;

	$fqdn =~ s/^[^.]+\.//;

	return($fqdn);
}

sub soa_dnsvs
{
	&debug(__FILE__,__LINE__,'+ &soa('.join(',',map("'$_'",@_)).')') if (defined($debug{'call'}) && $debug{'call'}>1 || defined($debug{'soa'}) || defined($debug{'dns'}));
	my ($name) = @_;

	while ($name =~ /\./) {
		$name =~ s/^[^.]*\.+//;
		for ($webapi->list_soa($name)) {
			if (/^(\S+)\s+(\S+)/) {
				my $ns = $1;
				my $mail = $2;
				$ns =~ s/\.$//;
				$mail =~ s/\.$//;
				$mail =~ s/\./\@/;
				&debug(__FILE__,__LINE__,"+ soa(\"$name\") = (\"$ns\",\"$mail\")") if (defined($debug{'return'}) && $debug{'return'}>1 || defined($debug{'soa'}) && $debug{'soa'}>1 || defined($debug{'dns'}) && $debug{'dns'}>2);
				return($ns,$mail);
			}
		}
	}
	return;
}

sub soa
{
	&debug(__FILE__,__LINE__,'+ &soa('.join(',',map("'$_'",@_)).')') if (defined($debug{'call'}) && $debug{'call'}>1 || defined($debug{'soa'}) || defined($debug{'dns'}));
	my ($name) = @_;

	while ($name =~ /\./) {
		&debug(__FILE__,__LINE__,join(' ','+',$host,'-t','SOA',$name.'.',@local_resolver)) if (defined($debug{'soa'}) && $debug{'soa'}>2 || defined($debug{'exec'}) || defined($debug{'dns'}));
		open(HOST,'-|',$host,'-t','SOA',$name.'.',@local_resolver) or &quit("Can't run $host -t SOA $name.: $!");
		while (<HOST>) {
			chomp;
			&debug(__FILE__,__LINE__,"> $_") if (defined($debug{'soa'}) && $debug{'soa'}>2 || defined($debug{'exec'}) && $debug{'exec'}>2 || defined($debug{'dns'}) && $debug{'dns'}>1);
			if (/NXDOMAIN/) {
				&quit("Domain $name doesn't exist");
			}
			if (/^$name has SOA record (\S+)\s+(\S+)/) {
				my $ns = $1;
				my $mail = $2;
				close(HOST);
				$ns =~ s/\.$//;
				$mail =~ s/\.$//;
				$mail =~ s/\./\@/;
				&debug(__FILE__,__LINE__,"+ soa(\"$name\") = (\"$ns\",\"$mail\")") if (defined($debug{'return'}) && $debug{'return'}>1 || defined($debug{'soa'}) && $debug{'soa'}>1 || defined($debug{'exec'}) && $debug{'exec'}>2 || defined($debug{'dns'}) && $debug{'dns'}>2);
				return($ns,$mail);
			}
		}
		close(HOST);
		$name =~ s/^[^.]*\.+//;
	}
	return;
}

sub uniq
{
	my %uniq = map(($_=>1),@_);
	return(keys %uniq);
}

sub quit
{
	my ($msg) = @_;

	print $msglog "$msg\n" if (defined($msg) && defined($msglog));
	die "$msg\n" if (defined($msg));
	exit;
}
