package MyDNS;

use strict;
use DBI;
use Data::Validate::IP qw(is_ipv4);
#use Data::Validate::Domain qw(is_domain);


=pod

=head1 NAME

MyDNS - help with MyDNS management

=head1 SYNOPSIS

	use MyDNS;

	# supply the DB location, or a DB handle
	my $mydns=MyDNS->new($dbhost,$dbname,$dbuser,$dbpass);

	# needed if you plan on creating anything
	$mydns->set_defaults({
		nameservers	=>	['ns1.domain.com','ns2.domain.com'],
		mailbox		=>	'dnsadmin.domain.com',
	});

	$mydns->write_soa($domain);

	# create a new reseource record
	my $error=$mydns->write_rr($domain,{
		name	=>	'',
		type	=>	'MX',
		data	=>	"mail.$domain.",
		aux	=>	10,
		ttl	=>	900,
	});

	$mydns->update_serial($domain);

	if ($mydns->check_exists($domain)){
		print "$domain exists!\n";
		my $soa=$mydns->read_soa($domain);
		foreach my $key (sort keys %$soa){
			print "\t$key\t$soa->{$key}\n";
		}
		my @rrs=$mydns->get_all_rr($domain);
		foreach my $rr (@rrs){
			print "\t\t-----\n";
			foreach my $key (sort keys %$rr){
				print "\t\t$key\t$rr->{$key}\n";
			}
		}
	}
	else{
		print "$domain not there!\n";
	}

	# delete the domain and all records
	$mydns->delete_soa($domain);

=head1 DESCRIPTION

The purpose for this module is to provide a simple and clean way to interface with a MyDNS database to manage zones and records.  The module depends on Data::Validate::IP, DBI, and DBD::mysql.

=head2 Methods

=over 12

=item C<new>

Returns a new MyDNS object.  You can optionally provide database connection args at this time (see db_connect).

=item C<db_connect>

Establish a DB connetion with the mydns server DB.  You can supply either an existing database handle, or the host, name, user and pass to use to make a new one.

=item C<set_defaults>

Setup some default values that will be needed when creating records.  Any writing for SOA or RR types will require this, and missing fields will be printing to STDERR when invoked.
This can be skipped/ignored if no writing is to be done.

=item C<check_exists>

Given a domain name, check to see if the zone exists in the database.

=item C<read_soa>

Given a domain name, return the SOA record for it.

=item C<write_soa>

Given a domain name, write or update a SOA record with the default information provided in set_defaults as the basis for the SOA info and a single NS record for each nameserver.

=item C<delete_soa>

Given a domain name, delete the soa and all resource records.

=item C<update_serial>

Given a domain name, update the serial for that domain.

=item C<get_all_rr>

Given a domain name, returns an array of hashrefs, one for each resource record in that zone.  An optional type filer can be provided that will limit the records to the type requested.

=item C<get_rr_by_id>

Given an id number, retrieve the resource record that matches.

=item C<get_rr_by_info>

Given a domain name, a resource record name, a type, and the rdata, return a resource record.

=item C<write_rr>

Given a domain name and a properly built hash, create or update a resource record in the zone.

=item C<delete_rr>

Given a domain name and a resource record id, delete the record. 

=back

=head1 CAVEATS

This currently only works with the mysql schema defined in the mydns manual.  No additional fields are used, but will be returned as normal with all other information.

=head1 AUTHOR

Steve Bradford (steve at geek pro tem dot com)

=head1 SEE ALSO

http://mydns.bboy.net/



=cut




sub new{
	my $class=shift;
	my @db_cx=@_;
	my $self={};
	bless $self, $class;
	if (scalar(@db_cx)==1 || scalar(@db_cx)==4){
		$self->db_connect(@db_cx);
	}
	return $self;
}

sub db_connect{
	my $self=shift;
	my @db_cx=@_;
	if (scalar(@db_cx)==1){
		$self->{dbh}=$db_cx[0];
	}
	elsif (scalar(@db_cx)==4){
		$self->{dbh}=dbopen(@db_cx);
	}
	else{
		return 1;
	}
}

sub set_defaults{
# needed if doing ANY creating
	my $self=shift;
	my $defaults=shift;
# required stuff
	$self->{nameservers}=$defaults->{nameservers};
	$self->{mailbox}=$defaults->{mailbox};
	$self->{ttl}=$defaults->{ttl};
	$self->{ttl}=86400 unless $self->{ttl};
# optional stuff
	$self->{minttl}=$defaults->{minttl};
	$self->{minttl}=300 unless $self->{minttl};
	if ($defaults->{maxttl} && $defaults->{maxttl}>$self->{minttl}){
		$self->{maxttl}=$defaults->{maxttl};
	}
}

sub check_for_defaults{
# return 0 if all requisite values are present
# otherwise return an array of the missing values
	my $self=shift;
	my @needed;
	if (!ref ($self->{nameservers})){
		push @needed, 'nameservers';
	}
	if (!$self->{mailbox}){
		push @needed, 'mailbox';
	}
	if (!$self->{ttl}){
		push @needed, 'ttl';
	}
	if (!$self->{minttl}){
		push @needed, 'minttl';
	}
	if (!$self->{dbh}){
		push @needed, 'DB Handle';
	}
	if (@needed){
		print STDERR join "\n",@needed, "\n";
		return @needed;
	}
	return 0;
}

sub check_exists{
# returns 1 if the domain exists in the db
	my $self=shift;
	my $domain=shift;
	if (dbquery($self->{dbh},'select origin from soa where origin=?',$domain)){
		return 1;
	}
	return 0;
}

sub read_soa{
	my $self=shift;
	my $domain=shift;
	if ($self->check_exists($domain)){
		my ($soa)=dbquery($self->{dbh},'select * from soa where origin=?',$domain);
		if ($soa->{id}){
			return $soa;
		}
	}
	return 0;
}

sub write_soa{
	my $self=shift;
	my $domain=shift;
	my $soa=shift;
	return if $self->check_for_defaults;
	if ($self->check_exists($domain)){
		my $old_soa=$self->read_soa($domain);
		if (ref $soa){
			if (dbquery($self->{dbh},'update soa set ns=?,mbox=?,refresh=?,retry=?,expire=?,minimum=?,ttl=? where id=?',$soa->{ns},$soa->{mbox},$soa->{refresh},$soa->{retry},$soa->{expire},$soa->{minimum},$soa->{ttl},$old_soa->{id})){
				$self->update_serial($domain);
				return 0;
			}
		}
	}
	elsif ($self->{nameservers}->[0] && $self->{mailbox}){
		if (dbquery($self->{dbh},'insert into soa (origin,ns,mbox,serial) values (?,?,?,?)',$domain,$self->{nameservers}->[0],$self->{mailbox},1)){
			foreach my $nameserver (@{$self->{nameservers}}){
				$self->write_rr($domain,{
					name	=>	$domain,
					type	=>	'NS',
					data	=>	$nameserver.'.',
					aux	=>	0,
					ttl	=>	$self->{ttl},
				});
			}
			$self->update_serial($domain);
			return 0;
		}
	}
	return 1;
}

sub update_serial{
	my $self=shift;
	my $domain=shift;
	return if $self->check_for_defaults;
	my ($sec,$min,$hour,$mon,$mday,$year)=localtime(time);
	$year+=1900;
	$mon++;
	$mon='0'.$mon unless $mon>9;
	$mday='0'.$mday unless $mday>9;
	$hour='0'.$hour unless $hour>9;
	my $serial=$year.$mon.$mday.$hour;
	if ($self->check_exists($domain)){
		my $old_soa=$self->read_soa($domain);
		while ($old_soa->{serial}>=$serial){
			$serial++;
		}
		if (dbquery($self->{dbh},'update soa set serial=? where id=?',$serial,$old_soa->{id})){
			return 1;
		}
	}
}

sub delete_soa{
	my $self=shift;
	my $domain=shift;
	if ($self->check_exists($domain)){
		$self->delete_all_rr($domain);
		if (dbquery($self->{dbh},'delete from soa where origin=?',$domain)){
			return 1;
		}
	}
}

sub get_all_rr{
# return an array of all found records on success
	my $self=shift;
	my $domain=shift;
# optional pseudosearch
	my $type=shift;
	if ($self->check_exists($domain)){
		my $soa=$self->read_soa($domain);
		my @rrs;
		if ($type){
			@rrs=dbquery($self->{dbh},'select * from rr where zone=? and type=?',$soa->{id},$type);
		}
		else{
			@rrs=dbquery($self->{dbh},'select * from rr where zone=?',$soa->{id});
		}
		return @rrs;
	}
}

sub delete_all_rr{
# return 1 on success
	my $self=shift;
	my $domain=shift;
	if ($self->check_exists($domain)){
		my $soa=$self->read_soa($domain);
		if (dbquery($self->{dbh},'delete from rr where zone=?',$soa->{id})){
			return 1;
		}
	}
}

sub check_rr_exists{
# returns 1 on success
	my $self=shift;
	my $rr_id=shift;
	if (dbquery($self->{dbh},'select id from rr where id=?',$rr_id)){
		return 1;
	}
}

sub get_rr_by_id{
# returns hashref of record on success
	my $self=shift;
	my $rr_id=shift;
	if ($self->check_rr_exists($rr_id)){
		my $rr=dbquery($self->{dbh},'select * from rr where id=?',$rr_id);
		return $rr;
	}
}

sub get_rr_by_info{
# returns hashref of record on success
	my $self=shift;
	my ($domain,$name,$type,$data)=@_;
	if (!$self->check_exists($domain)){
		return 0;
	}
	my $soa=$self->read_soa($domain);
	my $rr=dbquery($self->{dbh},'select * from rr where zone=? and name=? and type=? and data=?',$soa->{id},$name,$type,$data);
	return $rr;
}

sub delete_rr{
# returns 1 on success
	my $self=shift;
	my ($domain,$rr)=@_;
	if ($self->get_rr_by_id($rr->{id})){
		if (dbquery($self->{dbh},'delete from rr where id=?',$rr->{id})){
			return 1;
		}
	}
}

sub write_rr{
	my $self=shift;
	my $domain=shift;
	my $rr=shift;
	return if $self->check_for_defaults;
	if (ref $rr){
		$rr=$self->sanitize_rr($domain,$rr);
		if (!ref $rr){
			return $rr;
		}
	}
	if (!$self->check_exists($domain)){
		return 0;
	}
	my $soa=$self->read_soa($domain);
	if ($rr->{data}){
		if ($self->check_rr_exists($rr->{id})){
			if (dbquery($self->{dbh},'update rr set name=?,type=?,data=?,aux=?,ttl=? where id=?',$rr->{name},$rr->{type},$rr->{data},$rr->{aux},$rr->{ttl})){
				$self->update_serial($domain);
				return 0;
			}
		}
		else{
			if (dbquery($self->{dbh},'select * from rr where zone=? and name=? and type=? and data=? and aux=? and ttl=?',$soa->{id},$rr->{name},$rr->{type},$rr->{data},$rr->{aux},$rr->{ttl})){
				return qq(Record already exists);
			}
			if (dbquery($self->{dbh},'insert into rr (zone,name,type,data,aux,ttl) values (?,?,?,?,?,?)',$soa->{id},$rr->{name},$rr->{type},$rr->{data},$rr->{aux},$rr->{ttl})){
				$self->update_serial($domain);
				return 0;
			}
		}
	}
}

sub sanitize_rr{
	my $self=shift;
	my $domain=shift;
	my $rr=shift;
# sanitize name
	$rr->{name}=$domain.'.' unless $rr->{name};
	if ($rr->{name}!~/\.$/){
		$rr->{name}=~s/$domain$/$domain./;
	}
# sanitize type and data
	if ($rr->{type} eq 'A'){
		if (!Data::Validate::IP::is_ipv4($rr->{data})){
			return "$rr->{data} is not a valid IP address";
		}
	}
	elsif ($rr->{type} eq 'AAAA'){
		if (!Data::Validate::IP::is_ipv4($rr->{data})){
			return qq($rr->{data} is not a valid IP address);
		}	
	}
	elsif ($rr->{type} eq 'ALIAS'){
		if ($rr->{data} eq $rr->{name}){
			return qq(NAME and DATA cannot be the same : "$rr->{name}");
		}
	}
	elsif ($rr->{type} eq 'CNAME'){
		if ($rr->{data} eq $rr->{name}){
			return qq(NAME and DATA cannot be the same : "$rr->{name}");
		}
	}
	elsif ($rr->{type} eq 'HINFO'){
# don't really care
	}
	elsif ($rr->{type} eq 'MX'){
		if ($rr->{data}=~m/\s/ || Data::Validate::IP::is_ipv4($rr->{data})){
			return qq(MX record data "$rr->{data}" is in an improper format, should be a hostname);
		}
	}
	elsif ($rr->{type} eq 'NS'){
		if ($rr->{data}=~m/\s/ || Data::Validate::IP::is_ipv4($rr->{data})){
			return qq(NS record data "$rr->{data}" is in an improper format, should be a hostname);
		}
	}
	elsif ($rr->{type} eq 'PTR'){
		if ($rr->{data}=~m/\s/ || Data::Validate::IP::is_ipv4($rr->{data})){
			return qq(PTR record data is in an improper format, should be a hostname);
		}
	}
	elsif ($rr->{type} eq 'RP'){
# don't really care
	}
	elsif ($rr->{type} eq 'SRV'){
		if (!$rr->{data}=~m/^.+ .+ .+$/){
			return qq(SRV data provided is in an improper format, should be "WEIGHT PORT TARGET");
		}
	}
	elsif ($rr->{type} eq 'TXT'){
		# nothing special to do
	}
	else{
		$rr->{type}='blank' unless $rr->{rr};
		return qq(TYPE "$rr->{type}" not supported);
	}
# sanitize ttl
	if (!$rr->{ttl} || $rr->{ttl}<$self->{minttl}){
		$rr->{ttl}=$self->{minttl};
	}
	elsif ($self->{maxttl} && $rr->{ttl}>$self->{maxttl}){
		$rr->{ttl}=$self->{maxttl};
	}
# sanitize aux
	$rr->{aux}=0 unless $rr->{aux};
	
	return $rr;
}

sub dbopen {
	my ($dbserver,$dbname,$dbuser,$dbpass)=@_;
	my $dbh=DBI->connect("dbi:mysql:$dbname:$dbserver","$dbuser","$dbpass") or die $!;
	return $dbh;
}

sub dbquery{
	my ($dbh,$sql,@data)=@_;
	my $data_req=($sql=~m/\?/);
	my $data_sup=scalar(@data);
	if ( $data_req > $data_sup ){
		return 0;
	}
	my $sth=$dbh->prepare($sql);
	$sth->execute(@data) or die "$sql";
	my @results;
	if ($sql =~ m/^select/i){
		while (my $row=$sth->fetchrow_hashref) {
			push @results, $row;
		}
	}
	elsif ($sql =~ m/^insert/i){
		my $key=$dbh->{'mysql_insertid'};
		@results=($key);
	}
	elsif ($sql =~ m/^update/i){
		my $changes=$sth->finish;
		return $changes;
	}
	$sth->finish;
	return @results;
}

sub dbclose{
	my $dbh=shift;
	$dbh->disconnect;
}

1;