# 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::Message;
use strict;
our $VERSION = "0.88";
sub load {
use Mail::Address;
use Mail::DomainKeys::Header;
use Mail::DomainKeys::Signature;
my $type = shift;
my %prms = @_;
my $self = {};
my $file;
if ($prms{'File'}) {
if (ref $prms{'File'} and (ref $prms{'File'} eq "GLOB" or
$prms{'File'}->isa("IO::Handle"))) {
$file = $prms{'File'};
} else {
return;
}
} else {
$file = \*STDIN;
}
my $lnum = 0;
my @head;
if ($prms{'HeadString'}) {
foreach (split /\n/, $prms{'HeadString'}) {
s/\r$//;
last if /^$/;
if (/^\s/ and $head[$lnum-1]) {
#$head[$lnum-1]->append($_);
$head[$lnum-1]->append("\n" . $_);
next;
}
$head[$lnum] =
parse Mail::DomainKeys::Header(String => $_);
$lnum++;
}
} else {
while (<$file>) {
chomp;
s/\r$//;
last if /^$/;
if (/^\s/ and $head[$lnum-1]) {
#$head[$lnum-1]->append($_);
$head[$lnum-1]->append("\n" . $_);
next;
}
$head[$lnum] =
parse Mail::DomainKeys::Header(String => $_);
$lnum++;
}
}
$self->{'HEAD'} = \@head;
my %seen = (FROM => 0, SIGN => 0, SNDR => 0);
foreach my $hdr (@head) {
$hdr->signed($seen{'SIGN'});
$hdr->key or
return;
if ($hdr->key =~ /^From$/i and !$seen{'FROM'}) {
my @list = parse Mail::Address($hdr->vunfolded);
$self->{'FROM'} = $list[0];
$seen{'FROM'} = 1;
} elsif ($hdr->key =~ /^Sender$/i and !$seen{'SNDR'}) {
my @list = parse Mail::Address($hdr->vunfolded);
$self->{'SNDR'} = $list[0];
$seen{'SNDR'} = 1;
} elsif ($hdr->key =~ /^DomainKey-Signature$/i and
not $seen{'SIGN'}) {
$self->{'SIGN'} = parse Mail::DomainKeys::Signature(
String => $hdr->vunfolded);
$seen{'SIGN'} = 1;
}
}
if ($prms{'BodyReference'}) {
$self->{'BODY'} = $prms{'BodyReference'};
} else {
my @body;
while (<$file>) {
chomp;
s/\r$//;
push @body, $_;
}
$self->{'BODY'} = \@body;
}
bless $self, $type;
}
sub canonify {
my $self = shift;
$self->signature->method or
return;
$self->signature->method eq "nofws" and
return $self->nofws;
$self->signature->method eq "simple" and
return $self->simple;
return;
}
sub gethline {
my $self = shift;
my $hdrs = shift or
return;
my %hmap = map { lc($_) => 1 } (split(/:/, $hdrs));
my @found = ();
foreach my $hdr (@{$self->head}) {
if ($hmap{lc($hdr->key)}) {
push(@found, $hdr->key);
delete $hmap{$hdr->key};
}
}
my $res = join(':', @found);
return $res;
}
sub nofws {
my $self = shift;
my $text;
my @headers_used;
foreach my $hdr (@{$self->head}) {
$hdr->signed or $self->signature->signing or
next;
$self->signature->wantheader($hdr->key) or
next;
push @headers_used, lc $hdr->key;
my $line = $hdr->unfolded;
#$line =~ s/[\s\r\n]//g;
$line =~ s/[ \t\r\n]//g;
$text .= $line . "\r\n";
}
if ($self->signature->signheaderlist) {
$self->signature->headerlist(join(":", @headers_used));
}
# delete trailing blank lines
foreach (reverse @{$self->{'BODY'}}) {
/[^\s\r\n]/ and # last non-blank line
last;
/^[\s\r\n]*$/ and
pop @{$self->{'BODY'}};
}
# make sure there is a body before adding a seperator line
(scalar @{$self->{'BODY'}}) and
$text .= "\r\n";
foreach my $lin (@{$self->{'BODY'}}) {
my $str = $lin;
$str =~ s/[\s\r\n]//g;
$text .= $str . "\r\n";
}
return $text;
}
sub simple {
my $self = shift;
my $text;
my @headers_used;
foreach my $hdr (@{$self->head}) {
$hdr->signed or $self->signature->signing or
next;
$self->signature->wantheader($hdr->key) or
next;
push @headers_used, lc $hdr->key;
#$text .= $hdr->line . "\r\n";
my $lin = $hdr->line . "\n";
$lin =~ s/\n/\r\n/gs;
$text .= $lin;
}
if ($self->signature->signheaderlist) {
$self->signature->headerlist(join(":", @headers_used));
}
# delete trailing blank lines
foreach (reverse @{$self->{'BODY'}}) {
/[^\r\n]/ and # last non-blank line
last;
/^[\r\n]*$/ and
pop @{$self->{'BODY'}};
}
# make sure there is a body before adding a seperator line
(scalar @{$self->{'BODY'}}) and
$text .= "\r\n";
foreach my $lin (@{$self->{'BODY'}}) {
my $str = $lin;
$str =~ s/\r?\n\z//;
$text .= $str . "\r\n";
}
return $text;
}
sub sign {
my $self = shift;
my %prms = @_;
my $sign = new Mail::DomainKeys::Signature(
Method => $prms{'Method'},
Domain => $self->senderdomain,
Selector => $prms{'Selector'},
SignHeaders => $prms{'SignHeaders'},
Signing => 1);
$self->signature($sign);
$sign->sign(Text => $self->canonify, Private => $prms{'Private'},
Sender => ($self->sender or $self->from));
return $sign;
}
sub verify {
my $self = shift;
$self->signed or
return;
return $self->signature->verify(Text => $self->canonify,
Sender => ($self->sender or $self->from),
SenderHdr => $self->sender, FromHdr => $self->from);
}
sub body {
my $self = shift;
(@_) and
$self->{'BODY'} = shift;
$self->{'BODY'};
}
sub from {
my $self = shift;
(@_) and
$self->{'FROM'} = shift;
$self->{'FROM'};
}
sub head {
my $self = shift;
(@_) and
$self->{'HEAD'} = shift;
$self->{'HEAD'}
}
sub sender {
my $self = shift;
(@_) and
$self->{'SNDR'} = shift;
$self->{'SNDR'};
}
sub senderdomain {
my $self = shift;
$self->sender and
return $self->sender->host;
$self->from and
return $self->from->host;
return;
}
sub signature {
my $self = shift;
(@_) and
$self->{'SIGN'} = shift;
$self->{'SIGN'};
}
sub signed {
my $self = shift;
$self->signature and
return 1;
return;
}
sub testing {
my $self = shift;
$self->signed and $self->signature->testing and
return 1;
return;
}
1;