Mail::SRS::DB - A MLDBM based Sender Rewriting Scheme

Mail-SRS documentation Contained in the Mail-SRS distribution.

Index

Code Index:

NAME

Top

Mail::SRS::DB - A MLDBM based Sender Rewriting Scheme

SYNOPSIS

Top

	use Mail::SRS::DB;
	my $srs = new Mail::SRS::DB(
		Database => '/var/run/srs.db',
		...
			);

DESCRIPTION

Top

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.

BUGS

Top

This code relies on not getting collisions in the cryptographic hash. This can and should be fixed.

The database is not garbage collected.

SEE ALSO

Top

Mail::SRS

Mail-SRS documentation Contained in the Mail-SRS distribution. 
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);


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;