#!/usr/bin/perl
# VHosts v1.2.5  (c) 29.1.2008 by Andreas Ley  (u) 24.2.2026
# Show active VHosts

my $author = 'apache@scc.kit.edu';
my $root = '/var/www';
my $acme = '/var/lib/acme/live';

use strict;
#no strict 'vars';
use warnings;
no warnings 'uninitialized';
use sigtrap;
use diagnostics;

# 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 File::Spec::Functions;
use CGI::Carp 'fatalsToBrowser';
use CGI '-utf8',':standard';
use JSON;
use Data::Dumper;

my $le = img({'height'=>14,'src'=>'//www.scc.kit.edu/img/SYS/le-logo-lockonly.png'});
my (%proto,%mailaddr,%account,%acme);
if (opendir(DIR,$root)) {
	while (my $host = readdir(DIR)) {
		next if ($host =~ /^\.\.?$/);
		$proto{$host} = 'http';
		for my $conf ('httpd.conf','vhost.conf','identity.conf') {
			my $file = catfile($root,$host,'conf',$conf);
			if (-s $file) {
				if (open(FILE,$file)) {
					while (<FILE>) {
						chomp;
						#$define{$host}{$define} = $1 if (m!^\s*Define\s+(\S+)\s+"*(\S*?[^"])"*\s*$!i);
						$account{$host} = $1 if (m!^\s*Define\s+CONTENT_ROOT\s+"*/home/ws/([^/]+)/$host"*\s*$!i);
						$mailaddr{$host} = $' if (m!^\s*ServerAdmin\s+!i);
						#$account{$host} = $1 if (m!^\s*DocumentRoot\s+/home/ws/([^/]+)/$host/htdocs!i);
						$account{$host} = $1 if (m!^\s*DocumentRoot\s+"*/home/ws/([^/]+)/$host/htdocs!i);
						$proto{$host} = 'https' if (m!^\s*Include\s+/etc/apache2/include/ssl-only!i);
					}
					close(FILE);
				}
			}
		}
		$acme{$host} = 1 if (-e catfile($acme,$host));
		$acme{$host} = 1 if (-e catfile($root,$host,'conf','ssl','dehydrated','cert.pem'));
	}
	closedir(DIR);
}

my $query = new CGI;
my $sort = $query->param('sort');
my @list;
if ($sort eq 'account') {
	@list = sort { $account{$a} cmp $account{$b} } keys %account;
}
elsif ($sort eq 'mailaddr') {
	@list = sort { $mailaddr{$a} cmp $mailaddr{$b} } keys %mailaddr;
}
else {
	@list = sort keys %mailaddr;
}

charset('utf-8');

my $format = $query->param('format');
if ($format eq 'json') {
	print header({'type'=>'application/json', 'access-control-allow-origin'=>'*'});
	my @json = map({'vhost'=>$_,'account'=>$account{$_},'serveradmin'=>$mailaddr{$_}},@list);
	print to_json(\@json);
}
else {
	print header;
	print start_html(-title=>'VHosts',-author=>$author,-bgcolor=>'#ffffff');
	print h1('VHosts');
	#print table({-border=>1},Tr([th([a({'href'=>url.'?sort=vhost'},'VHost'),a({'href'=>url.'?sort=account'},'Account'),a({'href'=>url.'?sort=mailaddr'},'ServerAdmin')]),sort @td]));
	print table({-border=>1},Tr([th([a({'href'=>url.'?sort=vhost'},'VHost'),a({'href'=>url.'?sort=account'},'Account'),a({'href'=>url.'?sort=mailaddr'},'ServerAdmin')]),map(td([($acme{$_}?$le:'').($proto{$_} eq 'https'?'🔒 ':'').a({'href'=>"$proto{$_}://$_/"},$_),a({'href'=>'mailto:'.$account{$_}.'@sysmail.kit.edu'},$account{$_}),a({'href'=>'mailto:'.$mailaddr{$_}},$mailaddr{$_})]),@list)]));
	print p('A total of',scalar(keys %account),'VHosts ('.scalar(keys %acme),"Let's Encrypt",$le.',',scalar(grep($proto{$_} eq 'https',keys %proto)),'HTTPS only 🔒) on',scalar(&uniq(values %account)),'Accounts for',scalar(&uniq(values %mailaddr)),'webmasters.');
	print hr, a({-href=>'mailto:'.$author},em('Apache Server Administrator'));
	print end_html;
}

sub uniq
{
        my (%uniq);

        map($uniq{$_}=undef,@_);
        return(keys %uniq);
}
