package LMAP::CID2SPF;

=head1 NAME

LMAP::CID2SPF - Converts a MS Caller-ID entry (XML) to a SPF entry

=head1 SYNOPSIS

 require LMAP::CID2SPF;
 $c2s = LMAP::CID2SPF->new();
 $c2s->cid("<ep xmlns='http://ms.net/1'>...</ep>");
 $spf = $c2s->convert();

  non-OO alternative:

 require LMAP::CID2SPF qw(cid2spf);
 $spf = cid2spf("<ep xmlns='http://ms.net/1'>...</ep>");

=head1 DESCRIPTION

This module can be used to convert between two of the LMAP (Lightweight MTA
Authentication Protocol) formats currently being proposed:

  CID = Microsoft's Caller-ID
  SPF = Sender Policy Framework

It will convert a XML-fragment as proposed by CID to a record that can be
added to DNS as proposed by SPF.

=head1 SEE ALSO

CID: L<http://www.microsoft.com/mscorp/twc/privacy/spam_callerid.mspx>

SPF: L<http://spf.pobox.com/>

=cut

# -------------------------------------------------------------------------

use strict;
use warnings;

use vars qw($VERSION);
$VERSION = "0.9";

use Carp;

# Export the cid2spf routine
use Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw();
our @EXPORT_OK = qw(cid2spf);

# We need this
require XML::Parser;

# -------------------------------------------------------------------------

=head1 PUBLIC INTERFACE

=cut

# -------------------------------------------------------------------------

=head2 OO calls

=over 4  

=cut

# -------------------------------------------------------------------------
                  
=item new [SOURCE]

I<Class method.>
Create a new converter object.

=cut

sub new {
	my $self = shift;
	my $type = ref($self) || $self;
	my $me = bless {}, $type;

	$me->{'cid'} = undef;
	return $me;
}

# -------------------------------------------------------------------------

=item cid [cid-xml]

I<Instance method.>
Sets or gets the CID-XML fragment for this converter object.

=cut

sub cid {
	my $self = shift;
	if (@_) {
		$self->{'cid'} = shift;
	}
	return $self->{'cid'};
}

# -------------------------------------------------------------------------

=item convert

I<Instance method.>
Converts the CID stored with cid() and returns the SPF-string.

=cut

sub convert {
	my $self = shift;

	if (! defined $self->{'cid'}) {
		croak "CID is not set (call cid() first)";
	}
	
	$self->{'spf'} = [];
	$self->{'has_error'} = 0;

	# Parse the beast. Any XML-problem will be reported by XML::Parser.
	LMAP::CID2SPF::XML::parse($self);
	if ($self->{'has_error'}) {
		croak $self->{'error'};
	}
	return $self->{'spf'};
}

# -------------------------------------------------------------------------
# NON-OO call
# -------------------------------------------------------------------------

=back

=head2 NON-OO call

=over 4  

=cut

# -------------------------------------------------------------------------
                  
=item cid2spf <cid-xml>

Converts the given CID returning the corresponding SPF-string.

=cut

sub cid2spf {
	my $cid = shift;
	my $c = LMAP::CID2SPF->new();
	$c->cid($cid);
	return $c->convert();
}

# -------------------------------------------------------------------------
# XML::Parser callback subs:
# -------------------------------------------------------------------------

package LMAP::CID2SPF::XML;

our $me = undef;
our $action;
our $has_servers;
our $xmlp = undef;

# -------------------------------------------------------------------------
# Called with the LMAP::CID2SPF object as a parameter

sub parse {
	my $obj = shift;
	$action = '-all';
	$has_servers = undef;
	$me = $obj;
	$xmlp = new XML::Parser(Style => 'Stream') if ! defined $xmlp;
	$xmlp->parse($obj->{'cid'});
}

# -------------------------------------------------------------------------
sub StartTag {
	my $hash = shift;
	my $tag = shift;
	my %attr = %_;
	if ($tag eq 'm') {
		if (defined $has_servers && ! $has_servers) {
			$me->{'error'} = "Declared <noMailServers\> and later <m>, this CID entry is not valid.\n";
			$me->{'has_error'} = 1;
		}
		$has_servers = 1;
	}
	elsif ($tag eq 'noMailServers') {
		if (defined $has_servers && $has_servers) {
			$me->{'error'} = "Declared <m> and later <noMailServers\>, this CID entry is not valid.\n";
			$me->{'has_error'} = 1;
		}
		$has_servers = 0;
	}
	elsif ($tag eq 'ep') {
		if (defined $attr{'testing'} && $attr{'testing'} eq 'true') {
			# A CID with 'testing' found:
			# From the MS-specs:
			#  "Documents in which such attribute is present with a true
			#  value SHOULD be entirely ignored (one should act as if the
			#  document were absent)"
			# From the SPF-specs:
			#  "Neutral (?): The SPF client MUST proceed as if a domain did
			#  not publish SPF data."
			# So we set SPF action to "neutral":
			$action = '?all';
		}
	}
	elsif ($tag eq 'mx') {
		# The empty MX-tag, same as SPF's MX-mechanism
		push @{ $me->{'spf'} }, 'mx';
	}
}

# -------------------------------------------------------------------------
sub EndTag {
	my $hash = shift;
	my $tag = shift;
}

# -------------------------------------------------------------------------
sub EndDocument {
	my $hash = shift;
	# This is the end... print what we've got out
	my $spf_entry = '';
	$spf_entry .= 'v=spf1';
	if ($has_servers) {
		$spf_entry .= ' ' . join(' ', @{ $me->{'spf'} });
	}
	$spf_entry .= ' ' . $action;
	
	# Store the result here
	$me->{'spf'} = $spf_entry;
}

# -------------------------------------------------------------------------
sub Text {
	my $hash = shift;

	my $text = $hash->{'Text'};
	my @context = @{ $hash->{'Context'} };
	my $tag = $context[$#context];
	# Remove starting and trailing spaces from text:
	$text =~ s/^\s+//g;
	$text =~ s/\s+$//g;

	if ($tag eq 'a' || $tag eq 'r') {
		# The A and R tags from MS-CID are both handled by the 
		# ipv4/6-mechanisms from SPF:
		my $mechanism = 'ip4';
		if ($text =~ /:/) {
			$mechanism = 'ip6';
		}
		push @{ $me->{'spf'} }, $mechanism . ':' . $text;
	}
	if ($tag eq 'indirect') {
		# MS-CID's indirect is "sort of" the include from SPF:
		# Not really true, because the <indirect> tag from MS-CID also 
		# provides a fallback in case the included domain doesn't provide
		# _ep-records: The inbound MX-servers of the included domains
		# are added to the list of allowed outgoing mailservers for the
		# domain that declared the _ep-record with the <indirect> tag.
		# In SPF you would use the 'mx:domain' to handle this, but this
		# wouldn't depend on referred domain having or not SPF-records.
		push @{ $me->{'spf'} }, 'include:' . '_ep.' . $text;
	}
}

1;

=back

=head1 AUTHOR

Copyright (C) 2004 Ernesto Baschny (F<ernst@baschny.de>)

All rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.  

=head1 VERSION

0.9

=cut