Mail::DKIM::DkSignature - represents a DomainKeys-Signature header

  my $signature = Mail::DKIM::DkSignature->new(
                      [ Algorithm => "rsa-sha1", ]
                      [ Signature => $base64, ]
                      [ Method => "simple", ]
                      [ Domain => "example.org", ]
                      [ Headers => "from:subject:date:message-id", ]
                      [ Query => "dns", ]
                      [ Selector => "alpha", ]
                      [ Key => $private_key, ]
                  );

  my $sig = Mail::DKIM::DkSignature->parse(
                  "DomainKey-Signature: a=rsa-sha1; b=yluiJ7+0=; c=nofws"
            );

  print $signature->as_string . "\n";

  DomainKey-Signature: a=rsa-sha1; b=yluiJ7+0=; c=nofws

  $signature->canonicalization("nofws");
  $signature->canonicalization("simple");

  $method = $signature->canonicalization;

  my $d = $signature->domain;          # gets the domain value
  $signature->domain("example.org");   # sets the domain value

  $signature->headerlist("a:b:c");

  my $headerlist = $signature->headerlist;

  my @headers = $signature->headerlist;

  my $i = $signature->identity;

  my $source = $signature->identity_source;

#!/usr/bin/perl

# Copyright 2005-2006 Messiah College. All rights reserved.
# Jason Long <jlong@messiah.edu>

# 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.

use strict;
use warnings;

use Mail::DKIM::PublicKey;
use Mail::DKIM::Algorithm::dk_rsa_sha1;

package Mail::DKIM::DkSignature;
use base "Mail::DKIM::Signature";
use Carp;

sub new {
	my $type = shift;
	my %prms = @_;
	my $self = {};
	bless $self, $type;

	$self->algorithm($prms{'Algorithm'} || "rsa-sha1");
	$self->signature($prms{'Signature'});
	$self->canonicalization($prms{'Method'} || "simple");
	$self->domain($prms{'Domain'});
	$self->headerlist($prms{'Headers'});
	$self->protocol($prms{'Query'} || "dns");
	$self->selector($prms{'Selector'});
	$self->key($prms{'Key'}) if defined $prms{'Key'};

	return $self;
}

sub parse
{
	my $class = shift;
	croak "wrong number of arguments" unless (@_ == 1);
	my ($string) = @_;

	# remove line terminator, if present
	$string =~ s/\015\012\z//;

	# remove field name, if present
	my $prefix;
	if ($string =~ /^(domainkey-signature:)(.*)/si)
	{
		# save the field name (capitalization), so that it can be
		# restored later
		$prefix = $1;
		$string = $2;
	}

	my $self = $class->Mail::DKIM::KeyValueList::parse($string);
	$self->{prefix} = $prefix;

	return $self;
}

sub as_string_without_data
{
	croak "as_string_without_data not implemented";
}

sub body_count
{
	croak "body_count not implemented";
}

sub body_hash
{
	croak "body_hash not implemented";
}

sub algorithm
{
	my $self = shift;

	if (@_)
	{
		$self->set_tag("a", shift);
	}

	my $a = $self->get_tag("a");
	return defined $a && $a ne '' ? lc $a : 'rsa-sha1';
}	

sub canonicalization
{
	my $self = shift;
	croak "too many arguments" if (@_ > 1);

	if (@_)
	{
		$self->set_tag("c", shift);
	}

	return lc($self->get_tag("c")) || "simple";
}	

sub DEFAULT_PREFIX
{
	return "DomainKey-Signature:";
}

sub domain
{
	my $self = shift;

	if (@_)
	{
		$self->set_tag("d", shift);
	}

	my $d = $self->get_tag("d");
	return defined $d ? lc $d : undef;
}	

sub expiration
{
	my $self = shift;
	croak "cannot change expiration on " . ref($self) if @_;
	return undef;
}

use MIME::Base64;

sub check_canonicalization
{
	my $self = shift;

	my $c = $self->canonicalization;

	my @known = ("nofws", "simple");
	return unless (grep { $_ eq $c } @known);
	return 1;
}

# checks whether the protocol found on this subject is valid for
# fetching the public key
# returns a true value if protocol is "dns", false otherwise
#
sub check_protocol
{
	my $self = shift;

	my $protocol = $self->protocol;
	return unless $protocol;
	return ($protocol eq "dns");
}

sub check_version
{
	#DomainKeys doesn't have a v= tag
	return 1;
}

sub get_algorithm_class
{
	my $self = shift;
	croak "wrong number of arguments" unless (@_ == 1);
	my ($algorithm) = @_;

	my $class =
		$algorithm eq "rsa-sha1" ? "Mail::DKIM::Algorithm::dk_rsa_sha1" :
		undef;
	return $class;
}

# get_public_key - same as parent class

sub hash_algorithm
{
	my $self = shift;
	my $algorithm = $self->algorithm;

	return $algorithm eq "rsa-sha1" ? "sha1" : undef;
}

#sub headerlist
# is in Signature.pm

sub identity
{
	my $self = shift;
	croak "cannot change identity on " . ref($self) if @_;
	return $self->{dk_identity};
}

sub identity_source
{
	my $self = shift;
	croak "unexpected argument" if @_;
	return $self->{dk_identity_source};
}

# init_identity() - initialize the DomainKeys concept of identity
#
# The signing identity of a DomainKeys signature is the sender
# of the message itself, i.e. the address in the Sender/From header.
# The sender may not be known when the signature object is
# constructed (since the signature usually precedes the From/Sender
# header), so use this method when you have the From/Sender value.
# See also finish_header() in Mail::DKIM::Verifier.
#
sub init_identity
{
	my $self = shift;
	$self->{dk_identity} = shift;
	$self->{dk_identity_source} = shift;
}

sub method
{
	croak "method not implemented (use canonicalization instead)";
}	

sub protocol {
	my $self = shift;

	(@_) and
		$self->set_tag("q", shift);

	# although draft-delany-domainkeys-base-06 does mandate presence of a
	# q=dns tag, it is quote common that q tag is missing - be merciful
	return !defined($self->get_tag("q")) ? 'dns' : $self->get_tag("q");
}	

# same as parent class

# same as parent class

sub timestamp
{
	croak "timestamp not implemented";
}

sub version
{
	croak "version not implemented";
}

1;