#!/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::Address;
package Mail::DKIM::Common;
use base 'Mail::DKIM::MessageParser';
use Carp;
our $VERSION = 0.52;
sub new {
my $class = shift;
return $class->new_object(@_);
}
sub add_header {
my $self = shift;
my ($line) = @_;
foreach my $algorithm ( @{ $self->{algorithms} } ) {
$algorithm->add_header($line);
}
if ( $line =~ /^([^:]+?)\s*:(.*)/s ) {
my $field_name = lc $1;
my $contents = $2;
$self->handle_header( $field_name, $contents, $line );
}
push @{ $self->{headers} }, $line;
}
sub add_body {
my $self = shift;
if ( $self->{algorithm} ) {
$self->{algorithm}->add_body(@_);
}
foreach my $algorithm ( @{ $self->{algorithms} } ) {
$algorithm->add_body(@_);
}
}
sub handle_header {
my $self = shift;
my ( $field_name, $contents, $line ) = @_;
push @{ $self->{header_field_names} }, $field_name;
# TODO - detect multiple occurrences of From: or Sender:
# header and reject them
$self->{headers_by_name}->{$field_name} = $contents;
}
sub init {
my $self = shift;
$self->SUPER::init(@_);
#initialize variables
$self->{headers} = [];
$self->{headers_by_name} = {};
$self->{header_field_names} = [];
}
sub load {
my $self = shift;
my ($fh) = @_;
while (<$fh>) {
$self->PRINT($_);
}
$self->CLOSE;
}
sub message_attributes {
my $self = shift;
my @attributes;
if ( my $message_id = $self->message_id ) {
push @attributes, "message-id=<$message_id>";
}
if ( my $sig = $self->signature ) {
push @attributes, 'signer=<' . $sig->identity . '>';
}
if ( $self->{headers_by_name}->{sender} ) {
my @list = Mail::Address->parse( $self->{headers_by_name}->{sender} );
if ( $list[0] ) {
push @attributes, 'sender=<' . $list[0]->address . '>';
}
}
elsif ( $self->{headers_by_name}->{from} ) {
my @list = Mail::Address->parse( $self->{headers_by_name}->{from} );
if ( $list[0] ) {
push @attributes, 'from=<' . $list[0]->address . '>';
}
}
return @attributes;
}
sub message_id {
my $self = shift;
croak 'wrong number of arguments' unless ( @_ == 0 );
if ( my $message_id = $self->{headers_by_name}->{'message-id'} ) {
if ( $message_id =~ /^\s*<(.*)>\s*$/ ) {
return $1;
}
}
return undef;
}
sub message_originator {
my $self = shift;
croak 'wrong number of arguments' unless ( @_ == 0 );
if ( $self->{headers_by_name}->{from} ) {
my @list = Mail::Address->parse( $self->{headers_by_name}->{from} );
return $list[0] if @list;
}
return Mail::Address->new;
}
sub message_sender {
my $self = shift;
croak 'wrong number of arguments' unless ( @_ == 0 );
if ( $self->{headers_by_name}->{sender} ) {
my @list = Mail::Address->parse( $self->{headers_by_name}->{sender} );
return $list[0] if @list;
}
if ( $self->{headers_by_name}->{from} ) {
my @list = Mail::Address->parse( $self->{headers_by_name}->{from} );
return $list[0] if @list;
}
return Mail::Address->new;
}
sub result {
my $self = shift;
croak 'wrong number of arguments' unless ( @_ == 0 );
return $self->{result};
}
sub result_detail {
my $self = shift;
croak 'wrong number of arguments' unless ( @_ == 0 );
if ( $self->{details} ) {
return $self->{result} . ' (' . $self->{details} . ')';
}
return $self->{result};
}
sub signature {
my $self = shift;
croak 'wrong number of arguments' unless ( @_ == 0 );
return $self->{signature};
}
1;