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