1package Mail::SRS::DB;
2
3use strict;
4use warnings;
5use vars qw(@ISA);
6use Carp;
7use MLDBM qw(DB_File Storable);
8use Fcntl;
9use Mail::SRS qw(:all);
10
11@ISA = qw(Mail::SRS);
12
13=head1 NAME
14
15Mail::SRS::DB - A MLDBM based Sender Rewriting Scheme
16
17=head1 SYNOPSIS
18
19	use Mail::SRS::DB;
20	my $srs = new Mail::SRS::DB(
21		Database => '/var/run/srs.db',
22		...
23			);
24
25=head1 DESCRIPTION
26
27See Mail::SRS for details of the standard SRS subclass interface.
28This module provides the methods compile() and parse().
29
30This module requires one extra parameter to the constructor, a filename
31for a Berkeley DB_File database.
32
33=head1 BUGS
34
35This code relies on not getting collisions in the cryptographic
36hash. This can and should be fixed.
37
38The database is not garbage collected.
39
40=head1 SEE ALSO
41
42L<Mail::SRS>
43
44=cut
45
46sub new {
47	my $class = shift;
48	my $self = $class->SUPER::new(@_);
49	die "No database specified for Mail::SRS::DB"
50					unless $self->{Database};
51	my %data;
52	my $dbm = tie %data, 'MLDBM',
53			$self->{Database}, O_CREAT|O_RDWR, 0640
54					or die "Cannot open $self->{Database}: $!";
55	$self->{Data} = \%data;
56	return $self;
57}
58
59sub compile {
60	my ($self, $sendhost, $senduser) = @_;
61
62	my $time = time();
63
64	my $data = {
65		Time		=> $time,
66		SendHost	=> $sendhost,
67		SendUser	=> $senduser,
68			};
69
70	# We rely on not getting collisions in this hash.
71	my $hash = $self->hash_create($sendhost, $senduser);
72
73	$self->{Data}->{$hash} = $data;
74
75	# Note that there are 4 fields here and that sendhost may
76	# not contain a + sign. Therefore, we do not need to escape
77	# + signs anywhere in order to reverse this transformation.
78	return $SRS0TAG . $self->separator . $hash;
79}
80
81sub parse {
82	my ($self, $user) = @_;
83
84	unless ($user =~ s/$SRS0RE//oi) {
85		die "Reverse address does not match $SRS0RE.";
86	}
87
88	my $hash = $user;
89	my $data;
90
91	unless ($data = $self->{Data}->{$hash}) {
92		die "No data found";
93	}
94
95	my $sendhost = $data->{SendHost};
96	my $senduser = $data->{SendUser};
97
98	unless ($self->hash_verify($hash, $sendhost, $senduser)) {
99		die "Invalid hash";
100	}
101
102	unless ($self->time_check($data->{Time})) {
103		die "Invalid timestamp";
104	}
105
106	return ($sendhost, $senduser);
107}
108
1091;
110