libmail-dkim-perl 0.44-1 / usr / share / perl5 / Mail / DKIM / Algorithm / Base.pm

#!/usr/bin/perl

# Copyright 2005-2007 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::Canonicalization::nowsp;
use Mail::DKIM::Canonicalization::relaxed;
use Mail::DKIM::Canonicalization::simple;
use Mail::DKIM::Canonicalization::seal;

package Mail::DKIM::Algorithm::Base;
use Carp;
use MIME::Base64;

sub new
{
	my $class = shift;
	my %args = @_;
	my $self = bless \%args, $class;
	$self->init;
	return $self;
}

sub init
{
	my $self = shift;

	croak "no signature" unless $self->{Signature};

	$self->{mode} = $self->{Signature}->signature ? "verify" : "sign";

	# allows subclasses to set the header_digest and body_digest
	# properties
	$self->init_digests;

	my ($header_method, $body_method)
		= $self->{Signature}->canonicalization;

	my $header_class = $self->get_canonicalization_class($header_method);
	my $body_class = $self->get_canonicalization_class($body_method);
	$self->{canon} = $header_class->new(
			output_digest => $self->{header_digest},
			Signature => $self->{Signature},
			Debug_Canonicalization => $self->{Debug_Canonicalization});
	$self->{body_canon} = $body_class->new(
			output_digest => $self->{body_digest},
			Signature => $self->{Signature},
			Debug_Canonicalization => $self->{Debug_Canonicalization});
}

# override this method, please...
# this method should set the "header_digest" and "body_digest" properties
sub init_digests
{
	die "not implemented";
}

# private method - DKIM-specific
sub get_canonicalization_class
{
	my $self = shift;
	croak "wrong number of arguments" unless (@_ == 1);
	my ($method) = @_;

	my $class = $method eq "nowsp" ? "Mail::DKIM::Canonicalization::nowsp" :
			$method eq "relaxed" ? "Mail::DKIM::Canonicalization::relaxed" :
			$method eq "simple" ? "Mail::DKIM::Canonicalization::simple" :
			$method eq "seal" ? "Mail::DKIM::Canonicalization::seal" :
		die "unknown method $method\n";
	return $class;
}

=head1 NAME

Mail::DKIM::Algorithm::Base - base class for DKIM "algorithms"

=head1 SYNOPSIS

  my $algorithm = new Mail::DKIM::Algorithm::rsa_sha1(
                      Signature => $dkim_signature
                  );

  # add headers
  $algorithm->add_header("Subject: this is the subject\015\012");
  $algorithm->finish_header;

  # add body
  $algorithm->add_body("This is the body.\015\012");
  $algorithm->add_body("Another line of the body.\015\012");
  $algorithm->finish_body;

  # now sign or verify...
  # TODO...

=head1 CONSTRUCTOR

You should not create an object of this class directly. Instead, use one
of the DKIM algorithm implementation classes, such as rsa_sha1:

  my $algorithm = new Mail::DKIM::Algorithm::rsa_sha1(
                      Signature => $dkim_signature
                  );

=head1 METHODS

=head2 add_body() - feeds part of the body into the algorithm/canonicalization

  $algorithm->add_body("This is the body.\015\012");
  $algorithm->add_body("Another line of the body.\015\012");

The body should be fed one "line" at a time.

=cut

sub add_body
{
	my $self = shift;
	my $canon = $self->{body_canon} || $self->{canon};
	$canon->add_body(@_);
}

=head2 add_header() - feeds a header field into the algorithm/canonicalization

  $algorithm->add_header("Subject: this is the subject\015\012");

The header must start with the header field name and continue through any
folded lines (including the embedded <CRLF> sequences). It terminates with
the <CRLF> at the end of the header field.

=cut

sub add_header
{
	my $self = shift;
	$self->{canon}->add_header(@_);
}

=head2 finish_body() - signals the end of the message body

  $algorithm->finish_body

Call this method when all lines from the body have been submitted.
After calling this method, use sign() or verify() to get the results
from the algorithm.

=cut

sub finish_body
{
	my $self = shift;
	my $body_canon = $self->{body_canon} || $self->{canon};
	$body_canon->finish_body;
	$self->finish_message;
}

=head2 finish_header() - signals the end of the header field block

  $algorithm->finish_header;

Call this method when all the headers have been submitted.

=cut

sub finish_header
{
	my $self = shift;
	$self->{canon}->finish_header(@_);
}

# checks the bh= tag of the signature to see if it has the same body
# hash as computed by canonicalizing/digesting the actual message body.
# If it doesn't match, a false value is returned, and the
# verification_details property is set to "body has been altered"
sub check_body_hash
{
	my $self = shift;

	# The body_hash value is set in finish_message(), if we're operating
	# from a version of the DKIM spec that uses the bh= tag. Otherwise,
	# the signature shouldn't have a bh= tag to check.

        my $sighash = $self->{Signature}->body_hash();
	if ($self->{body_hash} and $sighash)
	{
		my $body_hash = $self->{body_hash};
		my $expected = decode_base64($sighash);
		if ($body_hash ne $expected)
		{
			$self->{verification_details} = "body has been altered";
	#		print STDERR "I calculated  "
	#			. encode_base64($body_hash, "") . "\n";
	#		print STDERR "signature has "
	#			. encode_base64($expected, "") . "\n";
			return;
		}
	}
	return 1;
}

sub finish_message
{
	my $self = shift;

	# DKIM requires the signature itself to be committed into the digest.
	# But first, we need to set the bh= tag on the signature, then
	# "prettify" it.

	$self->{body_hash} = $self->{body_digest}->digest;
	if ($self->{mode} eq "sign")
	{
		$self->{Signature}->body_hash(
				encode_base64($self->{body_hash}, ""));
	}

	if ($self->{mode} eq "sign")
	{
		$self->{Signature}->prettify;
	}

	my $sig_line = $self->{Signature}->as_string_without_data;
	my $canonicalized = $self->{canon}->canonicalize_header($sig_line);

	$self->{canon}->output($canonicalized);
}

=head2 sign() - generates a signature using a private key

  $base64 = $algorithm->sign($private_key);

=cut

# override this method, please...
sub sign
{
	die "Not implemented";
}

=head2 signature() - get/set the signature worked on by this algorithm

  my $old_signature = $algorithm->signature;
  $algorithm->signature($new_signature);

=cut

sub signature
{
	my $self = shift;
	@_ and
		$self->{Signature} = shift;
	return $self->{Signature};
}

=head2 verify() - verifies a signature

  $result = $algorithm->verify();

Must be called after finish_body().

The result is a true/false value: true indicates the signature data
is valid, false indicates it is invalid.

For an invalid signature, details may be obtained from
$algorithm->{verification_details} or $@.

=cut

# override this method, please...
sub verify
{
	die "Not implemented";
}

1;

__END__

=head1 SEE ALSO

L<Mail::DKIM>

=head1 AUTHOR

Jason Long, E<lt>jlong@messiah.eduE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2005-2007 by Messiah College

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.6 or,
at your option, any later version of Perl 5 you may have available.

=cut