#!/usr/bin/perl -wT
#
# vim:set ts=4:
# vim:set shiftwidth=4:

=pod

=head1 NAME

ldap2analog - create analog config files

=head1 SYNOPSIS

ldap2apache [-vnshf]

=head1 DESCRIPTION

ldap2apache reads the configuration from LDAP and writes
config files for analog

=head1 OPTIONS

=over

=item -v

Be verbose.

=back

=head1 AUTHOR

Peter Palfrader E<lt>pp@3node.com<gt>

=head1 FILES

/etc/3node/ldap2apache

=head1 REQUIREMENTS

libxml-parser-perl, libxml-dumper-perl, libnet-ldap-perl, libhtml-template-perl

=head1 SEE ALSO

Dokumentation fuer Webhosting.

=cut

use strict;
use Net::LDAP;
use XML::Parser;
use XML::Dumper;
use HTML::Template;
use Getopt::Long;
use English;
use Carp qw{cluck};

$ENV{'PATH'} = '/bin:/usr/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

my $TEMP_DIR_MODE = 03775;
my $TEMP_DIR_GROUP = getgrnam('www-data')
	or die ("$PROGRAM_NAME: Cannot get gid of data");

my $PROGNAME = $0;
my $CONFIG;
{
	my $parser = new XML::Parser(Style => 'Tree');
	my $tree = $parser->parsefile('/etc/3node/ldap2analog');
	my $dump = new XML::Dumper;
	$CONFIG = $dump->xml2pl($tree);
}


Getopt::Long::config('bundling');
if (!GetOptions (
	'v'	=>	\$CONFIG->{'verbose'},
	'h'	=>	\$CONFIG->{'help'},
	)) {
	die ("Usage: $PROGNAME [-vshfn]\n");
};
if ($CONFIG->{'help'}) {
	print ("Usage: $PROGNAME [-vshfn]\n");
	exit 0;
};




my $ldap = Net::LDAP->new($CONFIG->{'ldapserver'}) or
	die ("$PROGNAME: Cannot create LDAP object: $@");

my $code;
if ($CONFIG->{'binddn'} ne '') {
	$code = $ldap->bind(
		dn       => $CONFIG->{'binddn'},
		password => $CONFIG->{'bindpw'});
} else {
	$code = $ldap->bind();
};
die "$PROGNAME: can't connect to ldap server '$CONFIG->{'ldapserver'}': ".$code->error."\n" if ($code->code);


$code = $ldap->search(
	filter    => "(objectclass=$CONFIG->{'client_objectclass'})",
	base      => $CONFIG->{'basedn'},
	timelimit => $CONFIG->{'timeout'}
);
die "$PROGNAME: Problem to search '(objectclass=$CONFIG->{'client_objectclass'})' in $CONFIG->{'basedn'}: ".$code->error."\n" if ($code->code);


my %FILELIST;
my @entries = $code->entries;
for my $client (@entries) {
	$code = $ldap->search(
		filter    => "(&(objectclass=$CONFIG->{'webvhost_objectclass'})(tnHost=$CONFIG->{'thishost'}))",
		base      => $client->dn,
		timelimit => $CONFIG->{'timeout'}
	);
	if ($code->code) {
		warn "$PROGNAME: Problem to search '(&(objectclass=$CONFIG->{'webvhost_objectclass'})(tnHost=$CONFIG->{'thishost'}))' in $client->dn: ".$code->error."\n";
		next;
	};

	my $home_base = $client->get_value('homeDirectory');
	my @vhosts = $code->entries;
	for my $entry (@vhosts) {
		my $host;
		# FIXME - check whether we serve this domain at this server

		# *** ServerName
		$host->{'ServerName'} = $entry->get_value('tnWebVHostServerName');

		my $log_dir = $home_base . '/logs';
		$log_dir =~ s,//+,/,g;

		$host->{'CombinedLog'} = $log_dir.'/'.$host->{'ServerName'}.'-combined.log*';
		$host->{'TransferLog'} = $log_dir.'/'.$host->{'ServerName'}.'-access.log*';
		$host->{'RefererLog'} = $log_dir.'/'.$host->{'ServerName'}.'-referer.log*';
		$host->{'AgentLog'} = $log_dir.'/'.$host->{'ServerName'}.'-agent.log*';

		for my $tool (qw{analog rmagic}) {
			printf STDERR "Doing template magic for $tool at host $host->{'ServerName'}.\n" if $CONFIG->{'verbose'};

			my $tmpl = HTML::Template->new(
				filename => $CONFIG->{$tool.'template'},
				strict => 0,
				die_on_bad_params => 0
				);
			$tmpl->param( %$host );
			my $new_config = $tmpl->output();

			my $filename = $CONFIG->{$tool.'confdir'}.'/'.$host->{'ServerName'};
			open (F, '>'.$filename) or
				die ("Cannot open $filename\n");
			print F $new_config;
			close (F);
		};
		$FILELIST{$host->{'ServerName'}} = 1;
	};
};




# Get rid of old zonefiles
for my $tool (qw{analog rmagic}) {
	opendir(DIR, $CONFIG->{$tool.'confdir'}) || die ("$PROGNAME: Cannot open dir ".$CONFIG->{$tool.'confdir'}.": $!\n");
	my @files = grep { ! /^\./ } readdir (DIR);
	closedir(DIR);
	@files = grep { ! $FILELIST{$_} } @files;
	for my $file (@files) {
		($file) = $file =~ /(.*)/; #untaint
		unlink ($CONFIG->{$tool.'confdir'}.'/'.$file) || warn ("Cannot unlink $file: $!\n");
	};
};

$ldap->unbind;