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