# Copyright (c) 2004 Anthony D. Urso. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

package Mail::DomainKeys::Policy;

use strict;

our $VERSION = "0.18";

sub new {
	my $type = shift;
	my %prms = @_;

	my $self = {};


	$self->{'NOTE'} = $prms{'Note'};
	$self->{'PLCY'} = $prms{'Policy'};
	$self->{'ADDR'} = $prms{'Address'};
	$self->{'TEST'} = $prms{'Testing'};

	bless $self, $type;
}

sub fetch {
	use Net::DNS;

	my $type = shift;
	my %prms = @_;

	my $strn;


	($prms{'Protocol'} eq "dns") or
		return;

	# FIXME - why is there a preceding period here?
	my $host = "._domainkey." . $prms{'Domain'};

	my $rslv = new Net::DNS::Resolver or
		return;
	
	#
	# perform DNS query for domain policy...
	#   if the query takes too long, we should catch it and generate
	#   an error
	#
	my $resp;
	eval
	{
		# set a 10 second timeout
		local $SIG{ALRM} = sub { die "DNS query timeout for $host\n" };
		alarm 10;

		$resp = $rslv->query($host, "TXT") or
		alarm 0;
	};
	if ($@)
	{
		my $E = $@;
		chomp $E;
		die "$E\n";
	}
	unless ($resp)
	{
		# no response => NXDOMAIN
		return;
	}

	foreach my $ans ($resp->answer) {
		next unless $ans->type eq "TXT";
		$strn = join "", $ans->char_str_list;
	}

	$strn or
		return;

	my $self = &parse_string($strn) or
		return;

	bless $self, $type;	
}

sub parse {
	my $type = shift;
	my %prms = @_;


	my $self = &parse_string($prms{'String'}) or
		return;

	bless $self, $type;	
}

sub as_string {
	my $self = shift;

	my $text;


	$self->testing and
		$text .= "t=y; ";

	$self->policy and
		$text .= "o=" . $self->policy . "; ";
	
	$self->note and
		$text .= "n=" . $self->note . "; ";
	
	$self->address and
		$text .= "r=" . $self->address;

	$text =~ s/;\s*$//;

	length $text and
		return $text;

	return;
}

sub address {
	my $self = shift;

	(@_) and
		$self->{'ADDR'} = shift;

	$self->{'ADDR'};
}

sub note {
	my $self = shift;

	(@_) and 
		$self->{'NOTE'} = shift;

	$self->{'NOTE'};
}

sub policy {
	my $self = shift;

	(@_) and
		$self->{'PLCY'} = shift;

	$self->{'PLCY'};
}

sub signall {
	my $self = shift;

	$self->policy and $self->policy eq "-" and
		return 1;

	return;
}

sub signsome {
	my $self = shift;

	$self->policy or
		return 1;

	$self->policy eq "~" and
		return 1;

	return;
}

sub testing {
	my $self = shift;

	(@_) and 
		$self->{'TEST'} = shift;

	$self->{'TEST'};
}

sub parse_string {
	my $text = shift;

	my %tags;


	foreach my $tag (split /;/, $text) {
		$tag =~ s/^\s*|\s*$//g;

		foreach ($tag) {
			/^n=(.*)$/ and
				$tags{'NOTE'} = $1;
			/^o=(\~|\-)$/ and
				$tags{'PLCY'} = $1;
			/^r=([\w\@\.]+)$/ and
				$tags{'ADDR'} = $1;
			/^t=y$/ and
				$tags{'TEST'} = 1;
		}
	}

	return \%tags;
}

1;
