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