#!/usr/bin/perl
# fix_vhost v1.3  (c) 27.11.2015 by Andreas Ley  (u) 5.3.2024
# Migrate vhost config from mod_auth_kerb to mod_auth_gssapi

use locale;
use Getopt::Std;
use File::Basename;
use File::Spec::Functions;

#use Data::Dumper;
#$Data::Dumper::Indent = 1;
#$Data::Dumper::Terse = 1;
#$Data::Dumper::Sortkeys = 1;
#$Data::Dumper::Deepcopy = 1;
#warn Data::Dumper->Dump([\%hash],['*hash']) if ($opt_D>0);

$root = '/var/www';
$conf = '/etc/apache2';
$templates = catdir($conf,'templates');

$owner = '/usr/sbin/owner';
$touch = '/usr/bin/touch';
$systemctl = '/usr/bin/systemctl';

sub usage
{
	my $image = $0;
	$image =~ s!.*/!!;
	print STDERR "Usage: $image [-v] fqdn [...]]\n";
	exit(1);
}

getopts('DL:hxv') or &usage;

&usage if (defined($opt_h) || !scalar(@ARGV));

$opt_D = $opt_L if (defined($opt_L));
if (defined($opt_v) || defined($opt_D)) {
	$|=1;
	select((select(STDERR),$|=1)[0]);
}

for $fqdn (@ARGV) {
	for $file ('local.conf','access.conf','user.conf','test-user.conf') {
		$dest = catfile($root,$fqdn,'conf',$file);
		if (-e $dest) {
			my $content = &read_file($dest);
			# Include and LogLevel
			$content =~ s!auth_kerb!auth_gssapi!g;
			$content =~ s!Krb5KeyTab\s+!GssapiCredStore\tkeytab:!g;
			$content =~ s!#*KrbServiceName!#KrbServiceName!g;
			&write_file($content,$dest);
		}
	}
}

################################################################################
#
# Copy a template to an instance, substituting given tokens
#
sub read_file
{
	my ($file) = @_;
	print STDERR "Reading $file\n" if ($opt_D);

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

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

sub template
{
	my ($template,$substitutions) = @_;

	my $content;
	LINE: for (split(/^/m,$template)) {
		# Conditions get ANDed
		while (/^%(!)?([^%]+)%/) {
			next LINE if (($1 eq '!') != !($substitutions->{$2}));
			$_ = $';
		}
		while (/&(!)?([^&]+)&([^&]+)&/) {
			$_ = $`.(($1 eq '!') != !($substitutions->{$2}) ? '' : $3).$';
		}
		# 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!
		while (/@\[([^@\]]+)\]@/) {
			#warn Data::Dumper->new([\$substitutions],['*'])->Indent(0)->Dump if ($opt_D>4);
			$_ = join('',map($`.$_.$',@{$substitutions->{$1}}));
		}
		$content .= $_;
	}
	return($content);
}

sub write_file
{
	my ($content,$dst,$append) = @_;
	print STDERR "Writing $dst\n" if ($opt_D);

	# 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);
	}

# We once had to recreate files with the owner of the containing directory – dunno if this is needed any longer, but it mangles local.conf group ownership :-(
#	unless ($append) {
#		my $mode = (stat($dst))[2] if (-e $dst);
#		unlink($dst);
#		system($owner,'-i',dirname($dst),'--',$touch,$dst);
#		chmod($mode,$dst) if (defined($mode));
#	}

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

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

sub template_file
{
	my ($src,$dst,$substitutions,$append) = @_;
	print STDERR "Creating $dst from $src\n" if ($opt_D);
	#warn Data::Dumper->new([\$substitutions],['*'])->Indent(0)->Dump if ($opt_D>3);

	if (defined(wantarray)) {
		return(&write_file(&template(&read_file($src),$substitutions),$dst,$append));
	}
	if (&write_file(&template(&read_file($src),$substitutions),$dst,$append)) {
		# This is a script-generated file, don't change manually
		chmod(0444,$dst);
	}
}
