1# Copyright (c) 2004 Anthony D. Urso. All rights reserved. 2# This program is free software; you can redistribute it and/or 3# modify it under the same terms as Perl itself. 4 5package Mail::DomainKeys::Key::Public; 6 7use base "Mail::DomainKeys::Key"; 8 9use strict; 10 11our $VERSION = "0.88"; 12 13sub new { 14 my $type = shift; 15 my %prms = @_; 16 17 my $self = {}; 18 19 $self->{'GRAN'} = $prms{'Granularity'}; 20 $self->{'NOTE'} = $prms{'Note'}; 21 $self->{'TEST'} = $prms{'Testing'}; 22 $self->{'TYPE'} = ($prms{'Type'} or "rsa"); 23 $self->{'DATA'} = $prms{'Data'}; 24 25 bless $self, $type; 26} 27 28sub load { 29 my $type = shift; 30 my %prms = @_; 31 32 my $self = {}; 33 34 35 $self->{'GRAN'} = $prms{'Granularity'}; 36 $self->{'NOTE'} = $prms{'Note'}; 37 $self->{'TEST'} = $prms{'Testing'}; 38 $self->{'TYPE'} = ($prms{'Type'} or "rsa"); 39 40 if ($prms{'File'}) { 41 my @data; 42 open FILE, "<$prms{'File'}" or 43 return; 44 while (<FILE>) { 45 chomp; 46 /^---/ and 47 next; 48 push @data, $_; 49 } 50 $self->{'DATA'} = join '', @data; 51 } else { 52 return; 53 } 54 55 bless $self, $type; 56} 57 58sub fetch { 59 use Net::DNS; 60 61 my $type = shift; 62 my %prms = @_; 63 64 my $strn; 65 66 67 ($prms{'Protocol'} eq "dns") or 68 return; 69 70 my $host = $prms{'Selector'} . "._domainkey." . $prms{'Domain'}; 71 72 my $rslv = new Net::DNS::Resolver or 73 return; 74 75 my $resp = $rslv->query($host, "TXT") or 76 return; 77 78 foreach my $ans ($resp->answer) { 79 next unless $ans->type eq "TXT"; 80 $strn = join "", $ans->char_str_list; 81 } 82 83 $strn or 84 return; 85 86 my $self = &parse_string($strn) or 87 return; 88 89 bless $self, $type; 90} 91 92sub parse { 93 my $type = shift; 94 my %prms = @_; 95 96 97 my $self = &parse_string($prms{'String'}) or 98 return; 99 100 bless $self, $type; 101} 102 103sub as_string { 104 my $self = shift; 105 106 my $text; 107 108 109 $self->granularity and 110 $text .= "g=" . $self->granularity . "; "; 111 112 $self->type and 113 $text .= "k=" . $self->type . "; "; 114 115 $self->note and 116 $text .= "n=" . $self->note . "; "; 117 118 $self->testing and 119 $text .= "t=y; "; 120 121 $text .= "p=" . $self->data; 122 123 length $text and 124 return $text; 125 126 return; 127} 128 129sub convert { 130 use Crypt::OpenSSL::RSA; 131 132 my $self = shift; 133 134 135 $self->data or 136 return; 137 138 # have to PKCS1ify the pubkey because openssl is too finicky... 139 my $cert = "-----BEGIN PUBLIC KEY-----\n"; 140 141 for (my $i = 0; $i < length $self->data; $i += 64) { 142 $cert .= substr $self->data, $i, 64; 143 $cert .= "\n"; 144 } 145 146 $cert .= "-----END PUBLIC KEY-----\n"; 147 148 my $cork; 149 150 eval { 151 $cork = new_public_key Crypt::OpenSSL::RSA($cert); 152 }; 153 154 $@ and 155 $self->errorstr($@), 156 return; 157 158 $cork or 159 return; 160 161 # segfaults on my machine 162# $cork->check_key or 163# return; 164 165 $self->cork($cork); 166 167 return 1; 168} 169 170sub verify { 171 my $self = shift; 172 my %prms = @_; 173 174 175 my $rtrn = eval { 176 $self->cork->verify($prms{'Text'}, $prms{'Signature'}); 177 }; 178 179 $@ and 180 $self->errorstr($@), 181 return; 182 183 return $rtrn; 184} 185 186sub granularity { 187 my $self = shift; 188 189 (@_) and 190 $self->{'GRAN'} = shift; 191 192 $self->{'GRAN'}; 193} 194 195sub note { 196 my $self = shift; 197 198 (@_) and 199 $self->{'NOTE'} = shift; 200 201 $self->{'NOTE'}; 202} 203 204sub revoked { 205 my $self = shift; 206 207 $self->data or 208 return 1; 209 210 return; 211} 212 213sub testing { 214 my $self = shift; 215 216 (@_) and 217 $self->{'TEST'} = shift; 218 219 $self->{'TEST'}; 220} 221 222sub parse_string { 223 my $text = shift; 224 225 my %tags; 226 227 228 foreach my $tag (split /;/, $text) { 229 $tag =~ s/^\s*|\s*$//g; 230 231 foreach ($tag) { 232 /^g=(\S+)$/ and 233 $tags{'GRAN'} = $1; 234 /^k=(rsa)$/i and 235 $tags{'TYPE'} = lc $1; 236 /^n=(.*)$/ and 237 $tags{'NOTE'} = $1; 238 /^p=([A-Za-z0-9\+\/\=]+)$/ and 239 $tags{'DATA'} = $1; 240 /^t=y$/i and 241 $tags{'TEST'} = 1; 242 } 243 } 244 245 return \%tags; 246} 247 2481; 249