#!/usr/bin/perl -Tw
# autodns 0.0.8
# Copyright 1999-2005 Project Purple. Written by Jonathan McDowell
# See ACKNOWLEDGEMENTS file for full details of contributors.
# http://www.earth.li/projectpurple/progs/autodns.html
# Released under the GPL.
#
# $Id: autodns.pl,v 1.13 2005/05/31 17:17:46 noodles Exp $
#

use strict;
use Fcntl qw(:flock);
use File::Temp qw(tempfile);
use IPC::Open3;
use MIME::Parser;

$ENV{'PATH'}="/usr/local/bin:/usr/bin:/bin:/usr/sbin";

my ($from, $subject, $gpguser, $gpggood, $priv);
my ($user, $server, $inprocess, $delcount, $addcount);
my ($domain, @MAIL, @GPGERROR, @COMMANDS, %zones, $VERSION);

use vars qw($me $ccreply $conffile $domainlistroot @cfgfiles $usersfile
	$lockfile $reload_command);

$VERSION="0.0.8";

#
# Load our config
#
my $file = '/etc/bind/autodns.conf';
unless (my $ret = do $file) {
	warn "Couldn't parse $file\n" if $@;
	warn "Couldn't do $file\n" unless defined $ret;
	warn "Couldn't run $file\n" unless $ret;
	die "Problem reading config file!\n";
}

###
### There should be no need to edit anything below (unless you're not
### using BIND). This statement might even be true now - let me know if not.
###

#
# Try to figure out what zones we currently know about by parsing config
# files. Sets the item in %zones to 1 for each zone it finds.
#
# Call with the name of a config file to read:
#
# getzones("/etc/named.conf");
#
sub getzones($) {
	my $namedfile = shift;

	open (NAMEDCONF, "< $namedfile") or
		fatalerror("Can't open $namedfile");

	while (<NAMEDCONF>) {
		if (/^\s*zone\s*"([^"]+)"/) {
			$zones{$1}=1;
		}
	}

	close NAMEDCONF;
}

#
# Check that a domain is only made up of valid characters.
#
# These are: a-z, 0-9, - or .
#
sub valid_domain($) {
	my $domain = shift;
	$domain = lc $domain;

	if ($domain =~ /^(?:[a-z0-9-]+\.)+[a-z]{2,4}$/) {
		return 1;
	} elsif ($domain =~ /^(?:[0-9\/-]+\.)+in-addr.arpa$/) {
		return 1;
	} else {
		return 0;
	}
}

#
# Deal with a fatal error by printing an error message, closing the pipe to
# sendmail and exiting.
#
# fatalerror("I'm melting!");
#
sub fatalerror($) {
	my $message = shift;

	print REPLY $message;
	close(REPLY);

	flock(LOCKFILE, LOCK_UN);
	close(LOCKFILE);
	unlink($lockfile);

#	die $message;
	exit;
}

#
# Get user details from usersfile based on a PGP ID.
#
# A users entry looks like:
#
# <username>:<keyid>:<priviledge level>:<master server ip>
#
# Priviledge level is not currently used.
#
# ($user, $priv, $server) = getuserinfo("5B430367");
#
sub getuserinfo($) {
	my $gpguser = shift;
	my ($user, $priviledge, $server);

	open (CONFIGFILE, "< $usersfile") or
		fatalerror("Couldn't open user configuration file.");

	foreach (<CONFIGFILE>) {
		if (/^([^#.]+):$gpguser:(\d+):(.+)$/) {
			$user=$1;
			$priviledge=$2;
			$server=$3;
			chomp $user;
			chomp $priviledge;
			chomp $server;
	
			if ($user !~ /^.+$/) {
				close(CONFIGFILE);
				fatalerror("Error in user configuration file: Can't get username.\n");
			}

			if ($server !~ /^(\d{1,3}\.){3}\d{1,3}$/) {
				$server =~ s/\d\.]//g;
				close(CONFIGFILE); 
				fatalerror("Error in user configuration file: Invalid primary server IP address ($server)\n");
				exit;
			} 
		}
	} 
	close(CONFIGFILE);

	if ($user =~ /^$/) {
		fatalerror("User not found.\n");
	}

	return ($user, $priviledge, $server);
}

$delcount=$addcount=$inprocess=0;

# Read in the mail from stdin.
@MAIL=<>;

$subject = "Reply from AutoDNS";
# Now lets try to find out who it's from.
foreach (@MAIL) {
	if (/^$/) { last; }
	if (/^From: (.*)/i) { $from=$1; chomp $from;}
	if (/^Subject:\s+(re:)?(.*)$/i) { $subject="Re: ".$2 if ($2);}
}

if ((! defined($from)) || $from =~ /^$/ ) {
	die "Couldn't find a from address.";
} elsif ($from =~ /mailer-daemon@/i) {
	die "From address is mailer-daemon, ignoring.";
}

if (! defined($subject)) { $subject="Reply from AutoDNS"; };

# We've got a from address. Start a reply.

open(REPLY, "|sendmail -t -oem -oi") or die "Couldn't spawn sendmail";

print REPLY "From: $me\n";
print REPLY "To: $from\n";
#
# Check to see if our CC address is the same as the from address and if so
# don't CC.
#
if ($from ne $ccreply) {
	print REPLY "Cc: $ccreply\n";
}
print REPLY <<EOF;
Subject: $subject

AutoDNS $VERSION
Copyright 1999-2004 Project Purple. Written by Jonathan McDowell.
Released under the GPL.

EOF

#
# Throw the mail at MIME::Parser and see if it accepts it.
#
my $parser = new MIME::Parser;
$parser->output_to_core(1); # No temporary files
my $entity = $parser->parse_data(\@MAIL);

#
# Make sure locale is set to C so we get messages in English as we expect.
#
$ENV{'LC_ALL'}="C";

if ($entity->parts) {
	# MIME

	my ($got_sig, $got_text) = (0, 0);
	my ($sig_name,$sig_fh,$text_name,$text_fh);
	($sig_fh, $sig_name) = tempfile();
	($text_fh, $text_name) = tempfile();

	foreach my $subent ($entity->parts) {
		if ($subent->effective_type eq "text/plain") {
			@COMMANDS = split /\n/,$subent->bodyhandle->as_string;

			my $str = $subent->as_string;
			$str =~ s/=\n$//;
			$str =~ s/\n/\r\n/g;
			print $text_fh $str;
			close($text_fh);
			$got_text++;
		} elsif ($subent->effective_type eq
				"application/pgp-signature") {
			print $sig_fh $subent->as_string;
			close($sig_fh);
			$got_sig++;
		}
	}

	if ($got_sig && $got_text) {
		my $pid = open3(\*GPGIN, \*GPGOUT, \*GPGERR,
			"gpg --batch --verify ".
			$sig_name." ".$text_name);

		close GPGIN;

		@GPGERROR=<GPGERR>;
		my @GPGOUTPUT=<GPGOUT>;
		close GPGERR;
		close GPGOUT;
		waitpid $pid, 0;

		unlink($text_name);
		unlink($sig_name);
	}
} else {
	# Clear text.

	my $pid = open3(\*GPGIN, \*GPGOUT, \*GPGERR, "gpg --batch");

	# Feed it the mail.
	print GPGIN $entity->bodyhandle->as_string;
	close GPGIN;

	# And grab what it has to say.
	@GPGERROR=<GPGERR>;
	@COMMANDS=<GPGOUT>;
	close GPGERR;
	close GPGOUT;
	waitpid $pid, 0;
}

# Check who it's from and if the signature was a good one.
$gpggood=1;
foreach (@GPGERROR) {
	chomp;
	if (/Signature made.* (.*)$/) {
		$gpguser=$1; 
	} elsif (/error/) {
		$gpggood = 0;
		print REPLY "Some errors ocurred\n";
	} elsif (/BAD signature/) {
		$gpggood = 0;
		print REPLY "BAD signature!\n";
	} elsif (/public key not found/) {
		$gpggood = 0;
		print REPLY "Public Key not found\n";
	}
}

# If we have an empty user it probably wasn't signed.
if (! $gpguser) {
	print REPLY "Message appears not to be GPG signed.\n";
	close REPLY;
	exit;
}

# Check the signature we got was ok.
if ($gpggood) {
	print REPLY "Good GPG signature found. ($gpguser)\n";
} else {
	print REPLY "Bad GPG signature!\n";
	close REPLY;
	exit;
}

# Now let's check if we know this person.
($user, $priv, $server) = getuserinfo($gpguser);

if (! defined($user) || ! $user) {
	print REPLY "Unknown user.\n";
	close REPLY;
	exit;
}

print REPLY "Got user '$user'\n";

# Right. We know this is a valid user. Get a lock to ensure we have exclusive
# access to the configs from here on in.
open (LOCKFILE,">$lockfile") ||
	 fatalerror("Couldn't open lock file\n");
fatalerror("Couldn't get lock\n") unless(flock(LOCKFILE,LOCK_EX));

# Ok, now we should figure out what domains we already know about.
foreach my $cfgfile (@cfgfiles) {
	getzones($cfgfile);
}

# Force existance of the $domainlistroot$user file
if (! -e $domainlistroot.$user) {
	open (DOMAINLIST, ">>$domainlistroot$user") or
			fatalerror("Couldn't create domains file.\n");
	close DOMAINLIST;
}

foreach (@COMMANDS) {
	# Remove trailing CRs and leading/trailing whitespace
	chomp;
	s/\r//;
	s/^\s*//;
	s/\s*$//;

	if ($inprocess) {
		print REPLY ">>>$_\n";
	}

	if (/^$/) {
		#
		# Empty line, so ignore it.
		# 
	} elsif (/^END$/) {
		$inprocess=0;
	} elsif (/^BEGIN$/) {
		$inprocess=1;
	} elsif ($inprocess && /^ADD\s+(.*)$/) {
		$domain = $1;

		# Convert domain to lower case.
		$domain =~ tr/[A-Z]/[a-z]/;
		if (! valid_domain($domain)) {
			$domain =~ s/[-a-z0-9.]//g;
			print REPLY "Invalid character(s) in domain name: $domain\n";
		} elsif (defined($zones{$domain}) && $zones{$domain}) {
			print REPLY "We already secondary $domain\n";
		} else {
			print REPLY "Adding domain $domain\n";
			$zones{$domain}=1;

			my $df = $domain;
			$df =~ tr,/,:,;

			open (DOMAINSFILE, ">>$conffile");
			print DOMAINSFILE "
### Domain added for '$user'

zone \"$domain\" {
	type slave;
	masters { $server; };
	file \"secondary/$user/$df\";
	allow-transfer { none; };
	allow-query { any; };
};\n";
			close DOMAINSFILE;

			open (DOMAINLIST, ">>$domainlistroot$user") or
				fatalerror("Couldn't open file.\n");
			print DOMAINLIST "$domain\n";
			close DOMAINLIST;
			$addcount++;
		}
	} elsif ($inprocess && /^DEL\s(.*)$/) {
		$domain = $1;

		# Convert domain to lower case.
		$domain =~ tr/[A-Z]/[a-z]/;
		if (!valid_domain($domain)) {
			$domain =~ s/[-a-z0-9.]//g;
			print REPLY "Invalid character(s) in domain name: $domain\n";
		} elsif (!defined($zones{$domain}) || !$zones{$domain}) {
				print REPLY "$domain does not exist!\n";
		} else {
			print REPLY "Deleting domain $domain\n";
			my (@newcfg,$found);

			open (DOMAINLIST, "<$domainlistroot$user") or
				fatalerror("Couldn't open file $domainlistroot$user for reading: $!.\n");
			my @cfg = <DOMAINLIST>;
			close(DOMAINLIST);
			@newcfg = grep { ! /^$domain$/ } @cfg;
			if (scalar @cfg == scalar @newcfg) {
				print REPLY "Didn't find $domain in $domainlistroot$user!\n";
				print REPLY "You are only allowed to delete your own domains that exist.\n";
				next;
			}

			open (DOMAINLIST, ">$domainlistroot$user") or 
				fatalerror("Couldn't open file $domainlistroot$user for writing: $!.\n");
			print DOMAINLIST @newcfg;
			close DOMAINLIST;

			$found=0;
			@newcfg=();
			open (DOMAINSFILE, "<$conffile") or
				fatalerror("Couldn't open file $conffile for reading: $!\n");
			{
			local $/ = ''; # eat whole paragraphs
			while (<DOMAINSFILE>) {
				unless (/^\s*zone\s+"$domain"/) {
					push @newcfg, $_;
				} else {
					$found=1;
					if ($newcfg[-1] =~ /^###/) {
						# remove comment and \n
						pop @newcfg;
					}
				}
			}
			} # end of paragraph eating

			if (!$found) {
				print REPLY "Didn't find $domain in $conffile!\n";
				next;
			}

			open (DOMAINSFILE, ">$conffile") or
				fatalerror("Couldn't open $conffile for writing: $!\n");
			print DOMAINSFILE @newcfg;
			close DOMAINSFILE;
			$delcount++;
			$zones{$domain} = 0;
		}
	} elsif ($inprocess && /^LIST$/) {
		print REPLY "Listing domains for user $user\n";
		print REPLY "------\n";
		if (open (DOMAINLIST, "<$domainlistroot$user")) {
			my $count = 0;
			while (<DOMAINLIST>) {
				$count++;
				print REPLY;
			}
			close (DOMAINLIST);
			print REPLY "------\n";
			print REPLY "Total of $count domains.\n";
		} else {
			print REPLY "Couldn't open $domainlistroot$user: $!\n";
		}
	} elsif ($inprocess && /^MASTER\s(.*)$/) {
		if (($priv & 1) != 1) {
			print REPLY "You're not authorised to use the MASTER ",
				"command.\n";
		} elsif ($1 =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/) {
			$server = $1;
			print REPLY "Set master IP address to $1\n";
		} else {
			print REPLY "$1 doesn't look like a valid IPv4 ",
				"address to me.\n";
		}
	} elsif ($inprocess && /^HELP$/) {
		print REPLY "In order to use the service, you will need to send GPG signed\n";
		print REPLY "messages.\n\n";
		print REPLY "The format of the text in these messages is important, as they represent\n";
		print REPLY "commands to autodns. Commands are formatted one per line, and enclosed\n";
		print REPLY "by \"BEGIN\" and \"END\" commands (without the quotes).\n";
		print REPLY "Current valid commands are:\n";
		print REPLY "BEGIN - begin processing.\n";
		print REPLY "END - end processing.\n";
		print REPLY "HELP - display this message.\n";
		print REPLY "LIST - show all the zones currently held by you.\n";
		print REPLY "ADD <domain> - adds the domain <domain> for processing.\n";
		print REPLY "DEL <domain> - removes the domain <domain> if you own it.\n";
	} elsif ($inprocess) {
		print REPLY "Unknown command!\n";
	}
}
flock(LOCKFILE, LOCK_UN);
close(LOCKFILE);
unlink($lockfile);

print REPLY "Added $addcount domains.\n" if $addcount;
print REPLY "Removed $delcount domains.\n" if $delcount;
if ($addcount || $delcount) {
	print REPLY "Reloading nameserver config.\n";
	print REPLY `$reload_command`;
}
close REPLY;

exit 0;
