libmail-srs-perl-0.31.orig/0000755000175000017500000000000010135233631015435 5ustar ericeric00000000000000libmail-srs-perl-0.31.orig/t/0000755000175000017500000000000010135233631015700 5ustar ericeric00000000000000libmail-srs-perl-0.31.orig/t/08_caseless.t0000644000175000017500000000267610066375747020233 0ustar ericeric00000000000000use strict; use warnings; use blib; use Test::More tests => 34; BEGIN { use_ok('Mail::SRS'); } BEGIN { use_ok('Mail::SRS::Guarded'); } BEGIN { use_ok('Mail::SRS::Reversible'); } BEGIN { use_ok('Mail::SRS::Shortcut'); } local $SIG{__WARN__} = sub { }; # We can't test for the presence of the warnings, since it is # mildly nondeterministic whether one will ever be emitted. foreach my $subclass (qw(Guarded Reversible Shortcut)) { my $class = "Mail::SRS::$subclass"; my $srs = $class->new( Secret => "foo", Separator => "+", ); # These all have an uppercase char so that smashing case does # at least something. my @tests = qw( User@domain-with-dash.com User-with-dash@domain.com User+with+plus@domain.com User=with=equals@domain.com User%with!everything&everything=@domain.somewhere ); my $alias0 = 'alias@host.com'; my $alias1 = 'name@forwarder.com'; my $alias2 = 'user@postal.com'; # We smashed case in here, so we must test case insens. foreach (@tests) { my $srs0addr = $srs->forward($_, $alias0); $srs0addr = lc $srs0addr; my $srs0rev = $srs->reverse($srs0addr); is(lc $srs0rev, lc $_, 'Idempotent on ' . $_); my $srs1addr = $srs->forward($srs0addr, $alias1); $srs1addr = lc $srs1addr; my $srs1rev = $srs->reverse($srs1addr); if ($subclass eq 'Shortcut') { is(lc $srs1rev, lc $_, 'Shortcut S2 idempotent on ' . $_); } else { is(lc $srs1rev, lc $srs0addr, 'S2 idempotent on ' . $srs0addr); } } } libmail-srs-perl-0.31.orig/t/01_basic.t0000644000175000017500000000356110066375747017475 0ustar ericeric00000000000000use strict; use warnings; use blib; use Test::More tests => 22; BEGIN { use_ok('Mail::SRS'); } my $srs = new Mail::SRS( Secret => "foo", ); ok(defined $srs, 'Created an object'); isa_ok($srs, 'Mail::SRS'); my @secret = $srs->get_secret; is($secret[0], 'foo', 'Secret was stored OK'); $srs->set_secret('bar', @secret); @secret = $srs->get_secret; is($secret[0], 'bar', 'Secret was updated OK'); is($secret[1], 'foo', 'Old secret was preserved'); my $h = $srs->hash_create("foo"); ok(defined $h, 'Hashing seems to work'); ok($srs->hash_verify($h, "foo"), 'Hashes verify OK'); ok(! $srs->hash_verify("random", "foo"), 'Bad hashes fail hash verify'); ok(! $srs->hash_verify($h, "bar"), 'Wrong data fails hash verify'); my $t = $srs->timestamp_create(); ok(defined $t, 'Created a timestamp'); ok(length $t == 2, 'Timestamp is 2 characters'); ok($srs->timestamp_check($t), 'Timestamp verifies'); my $notlong = 60 * 60 * 24 * 3; my $ages = 60 * 60 * 24 * 50; ok($srs->timestamp_check($srs->timestamp_create(time() - $notlong)), 'Past timestamp is OK'); ok(! $srs->timestamp_check($srs->timestamp_create(time() - $ages)), 'Antique timestamp fails'); ok(! $srs->timestamp_check($srs->timestamp_create(time() + $notlong)), 'Future timestamp fails'); ok(! $srs->timestamp_check($srs->timestamp_create(time() + $ages)), 'Future timestamp fails'); $srs = new Mail::SRS( Secret => "foo", IgnoreTimestamp => 1, ); ok($srs->timestamp_check($srs->timestamp_create()), 'Timestamp verifies'); ok($srs->timestamp_check($srs->timestamp_create(time() - $notlong)), 'Past timestamp is OK'); ok($srs->timestamp_check($srs->timestamp_create(time() - $ages)), 'Antique timestamp ignored'); ok($srs->timestamp_check($srs->timestamp_create(time() + $notlong)), 'Future timestamp ignored'); ok($srs->timestamp_check($srs->timestamp_create(time() + $ages)), 'Future timestamp ignored'); libmail-srs-perl-0.31.orig/t/21_daemon.t0000644000175000017500000000036110066375747017654 0ustar ericeric00000000000000use strict; use warnings; use blib; use Test::More tests => 3; BEGIN { use_ok('Mail::SRS::Daemon'); } my $srs = new Mail::SRS::Daemon( Secret => "foo", ); ok(defined $srs, 'Created an object'); isa_ok($srs, 'Mail::SRS::Daemon'); libmail-srs-perl-0.31.orig/t/05_shortcut.t0000644000175000017500000000253610066375747020274 0ustar ericeric00000000000000use strict; use warnings; use blib; use Test::More tests => 17; BEGIN { use_ok('Mail::SRS::Shortcut'); } my $srs = new Mail::SRS::Shortcut( Secret => "foo", ); ok(defined $srs, 'Created an object'); isa_ok($srs, 'Mail::SRS'); isa_ok($srs, 'Mail::SRS::Shortcut'); my @secret = $srs->get_secret; is($secret[0], 'foo', 'Can still call methods on new object'); my $source = "user\@host.tld"; my @alias = map { "alias$_\@host$_\.tld$_" } (0..5); my $new0 = $srs->forward($source, $alias[0]); ok(length $new0, 'Made a new address'); like($new0, qr/^SRS/, 'It is an SRS address'); my $old0 = $srs->reverse($new0); ok(length $old0, 'Reversed the address'); is($old0, $source, 'The reversal was idempotent'); my $new1 = $srs->forward( $new0, $alias[1]); # print STDERR "Composed is $new1\n"; ok(length $new1, 'Made another new address with the SRS address'); like($new1, qr/^SRS/, 'It is an SRS address'); my $old1 = $srs->reverse($new1); ok(length $old1, 'Reversed the address again'); is($old1, $source, 'Got back the original sender'); my @tests = qw( user@domain-with-dash.com user-with-dash@domain.com user+with+plus@domain.com user%with!everything&everything=@domain.somewhere ); my $alias = "alias\@host.com"; foreach (@tests) { my $srsaddr = $srs->forward($_, $alias); my $oldaddr = $srs->reverse($srsaddr); is($oldaddr, $_, 'Idempotent on ' . $_); } libmail-srs-perl-0.31.orig/t/11_pod_coverage.t0000644000175000017500000000066610066375747021055 0ustar ericeric00000000000000use Test::More; eval "use Test::Pod::Coverage 0.02"; plan skip_all => "Test::Pod::Coverage 0.02 required for testing POD coverage" if $@; plan tests => 5; my $params = { trustme => [qr/^(?:new|parse|compile)$/] }; pod_coverage_ok('Mail::SRS'); pod_coverage_ok('Mail::SRS::Guarded', $params); pod_coverage_ok('Mail::SRS::DB', $params); pod_coverage_ok('Mail::SRS::Reversible', $params); pod_coverage_ok('Mail::SRS::Shortcut', $params); libmail-srs-perl-0.31.orig/t/06_separator.t0000644000175000017500000000341310066375747020415 0ustar ericeric00000000000000use strict; use warnings; use blib; use Test::More tests => 65; BEGIN { use_ok('Mail::SRS'); } foreach (qw(- + =)) { my $srs = new Mail::SRS( Secret => "foo", Separator => $_, ); ok(defined $srs, 'Created an object'); my $sep = $srs->separator; is($sep, $_, 'Got the expected separator'); my $source = 'user@host.tld'; my @alias = map { "alias$_\@host$_\.tld$_" } (0..5); my $srs0 = $srs->forward($source, $alias[0]); like($srs0, qr/^SRS0$_/, 'It uses the right initial separator'); my $old0 = $srs->reverse($srs0); ok(length $old0, 'Reversed the address'); is($old0, $source, 'The reversal was idempotent'); my $srs1 = $srs->forward($srs0, $alias[1]); # print STDERR "Composed is $srs1\n"; ok(length $srs1, 'Made another new address with the SRS address'); like($srs1, qr/^SRS1$_/, 'It uses the right initial separator too'); my $old1 = $srs->reverse($srs1); ok(length $old1, 'Reversed the address again'); like($old1, qr/^SRS0$_/, 'Got an SRS0 address'); is($old1, $srs0, 'It is the original SRS0 address'); my $orig = $srs->reverse($old1); is($orig, $source, 'Got back the original sender'); my @tests = qw( user@domain-with-dash.com user-with-dash@domain.com user+with+plus@domain.com user=with=equals@domain.com user%with!everything&everything=@domain.somewhere ); foreach (@tests) { my $srs0addr = $srs->forward($_, $alias[0]); my $oldaddr = $srs->reverse($srs0addr); is($oldaddr, $_, 'Idempotent on ' . $_); my $srs1addr = $srs->forward($srs0addr, $alias[1]); my $srs0rev = $srs->reverse($srs1addr); is($srs0rev, $srs0addr, 'Idempotent on ' . $srs0addr); } } eval { my $srs = new Mail::SRS( Secret => "foo", Separator => '!', ); }; like($@, qr/separator/, 'Failed to create object with bad separator'); libmail-srs-perl-0.31.orig/t/07_varysep.t0000644000175000017500000000303710066375747020111 0ustar ericeric00000000000000use strict; use warnings; use blib; use Test::More tests => 44; BEGIN { use_ok('Mail::SRS'); } BEGIN { use_ok('Mail::SRS::Guarded'); } BEGIN { use_ok('Mail::SRS::Reversible'); } BEGIN { use_ok('Mail::SRS::Shortcut'); } foreach my $subclass (qw(Guarded Reversible Shortcut)) { my $class = "Mail::SRS::$subclass"; my $srs0 = $class->new( Secret => "foo", Separator => "+", ); my $srs1 = $class->new( Secret => "foo", Separator => "-", ); my $srs2 = $class->new( Secret => "foo", Separator => "=", ); my @tests = qw( user@domain-with-dash.com user-with-dash@domain.com user+with+plus@domain.com user=with=equals@domain.com user%with!everything&everything=@domain.somewhere ); my $alias0 = 'alias@host.com'; my $alias1 = 'name@forwarder.com'; my $alias2 = 'user@postal.com'; foreach (@tests) { my $srs0addr = $srs0->forward($_, $alias0); my $srs0rev = $srs0->reverse($srs0addr); is($srs0rev, $_, 'Idempotent on ' . $_); my $srs1addr = $srs1->forward($srs0addr, $alias1); my $srs1rev = $srs1->reverse($srs1addr); if ($subclass eq 'Shortcut') { is($srs1rev, $_, 'Shortcut S2 idempotent on ' . $_); } else { is($srs1rev, $srs0addr, 'S2 idempotent on ' . $srs0addr); } my $srs2addr = $srs2->forward($srs1addr, $alias2); my $srs2rev = $srs2->reverse($srs2addr); if ($subclass eq 'Guarded') { is($srs2rev, $srs0addr, 'Guarded S3 idempotent on ' . $srs1addr); } elsif ($subclass eq 'Reversible') { is($srs2rev, $srs1addr, 'Reversible S3 idempotent on ' . $srs1addr); } } } libmail-srs-perl-0.31.orig/t/20_cmdline.t0000644000175000017500000000020110066375747020014 0ustar ericeric00000000000000use strict; use warnings; use blib; use Test::More tests => 1; { local $^C = 1; do "script/srs"; } ok(1, 'Parsed script!'); libmail-srs-perl-0.31.orig/t/02_guarded.t0000644000175000017500000000467110066375747020033 0ustar ericeric00000000000000use strict; use warnings; use blib; use Test::More tests => 35; BEGIN { use_ok('Mail::SRS'); } BEGIN { import Mail::SRS qw(:all); } my $srs = new Mail::SRS( Secret => "foo", ); ok(defined $srs, 'Created an object'); isa_ok($srs, 'Mail::SRS'); isa_ok($srs, 'Mail::SRS::Shortcut'); isa_ok($srs, 'Mail::SRS::Guarded'); my @secret = $srs->get_secret; is($secret[0], 'foo', 'Can still call methods on new object'); my $source = 'user@host.tld'; my @alias = map { "alias$_\@host$_\.tld$_" } (0..5); my $srs0 = $srs->forward($source, $alias[0]); ok(length $srs0, 'Made a new address'); like($srs0, qr/^SRS0/, 'It is an SRS0 address'); my $old0 = $srs->reverse($srs0); ok(length $old0, 'Reversed the address'); is($old0, $source, 'The reversal was idempotent'); my $srs1 = $srs->forward( $srs0, $alias[1]); # print STDERR "Composed is $srs1\n"; ok(length $srs1, 'Made another new address with the SRS address'); like($srs1, qr/^SRS1/, 'It is an SRS1 address'); unlike($srs1, qr/SRS0/, 'It is not an SRS0 address'); my $old1 = $srs->reverse($srs1); ok(length $old1, 'Reversed the address again'); like($old1, qr/^SRS0/, 'It is the original SRS0 address'); my $orig = $srs->reverse($old1); is($orig, $source, 'Got back the original sender'); eval { $srs->reverse("garbage"); }; ok(defined $@, 'Error detected reversing garbage'); my $hack = $srs1; # Remove the hash from the address. $hack =~ s/$SRS1RE[^$SRSSEP]+$SRSSEP/$SRS1TAG$SRSSEP/; eval { $srs->reverse($hack); }; like($@, qr/Hashless/, 'Trapped a hashless SRS1 address!'); my $hsrs = new Mail::SRS( Secret => "foo", AllowUnsafeSrs => 1, ); my $hsrs0 = $hsrs->reverse($hack); is($hsrs0, $old1, 'Reversed a hashless SRS1 address'); my @tests = qw( user@domain-with-dash.com user-with-dash@domain.com user+with+plus@domain.com user%with!everything&everything=@domain.somewhere ); my $asrs = new Mail::SRS( Secret => "foo", AlwaysRewrite => 1, ); foreach (@tests) { my $srs0addr = $srs->forward($_, $alias[0]); my $oldaddr = $srs->reverse($srs0addr); is($oldaddr, $_, 'Idempotent on ' . $_); my $srs1addr = $srs->forward($srs0addr, $alias[1]); my $srs0rev = $srs->reverse($srs1addr); is($srs0rev, $srs0addr, 'Idempotent on ' . $srs0addr); my $idemaddr = $srs->forward($srs0addr, $alias[0]); is($srs0addr, $idemaddr, 'Idempotent from same domain'); my $nonidemaddr = $asrs->forward($srs0addr, $alias[0]); isnt($srs0addr, $nonidemaddr, 'AlwaysRewrite works from same domain'); } libmail-srs-perl-0.31.orig/t/03_reversible.t0000644000175000017500000000177310066375747020563 0ustar ericeric00000000000000use strict; use warnings; use blib; use Test::More tests => 13; BEGIN { use_ok('Mail::SRS::Reversible'); } my $srs = new Mail::SRS::Reversible( Secret => "foo", ); ok(defined $srs, 'Created an object'); isa_ok($srs, 'Mail::SRS'); isa_ok($srs, 'Mail::SRS::Reversible'); my @secret = $srs->get_secret; is($secret[0], 'foo', 'Can still call methods on new object'); my @addr = map { "user$_\@host$_\.tld$_" } (0..5); my $new0 = $srs->forward($addr[0], $addr[1]); ok(length $new0, 'Made a new address'); like($new0, qr/^SRS/, 'It is an SRS address'); my $old0 = $srs->reverse($new0); ok(length $old0, 'Reversed the address'); is($old0, $addr[0], 'The reversal was idempotent'); my $new1 = $srs->forward($new0, $addr[2]); # print STDERR "Composed is $new1\n"; ok(length $new1, 'Made another new address with the SRS address'); like($new1, qr/^SRS/, 'It is an SRS address'); my $old1 = $srs->reverse($new1); ok(length $old1, 'Reversed the address again'); is($old1, $new0, 'The reversal was idempotent again'); libmail-srs-perl-0.31.orig/t/04_dbm.t0000644000175000017500000000237710066375747017165 0ustar ericeric00000000000000use strict; use warnings; use blib; use Test::More tests => 14; BEGIN { use_ok('Mail::SRS::DB'); } my $srs = new Mail::SRS::DB( Secret => "foo", Database => 'test.db', ); ok(defined $srs, 'Created an object'); isa_ok($srs, 'Mail::SRS'); isa_ok($srs, 'Mail::SRS::DB'); my @secret = $srs->get_secret; is($secret[0], 'foo', 'Can still call methods on new object'); my @addr = map { "user$_\@host$_\.tld$_" } (0..5); my $new0 = $srs->forward($addr[0], $addr[1]); ok(length $new0, 'Made a new address'); like($new0, qr/^SRS/, 'It is an SRS address'); # print STDERR "New is $new0\n"; my $old0 = $srs->reverse($new0); ok(length $old0, 'Reversed the address'); is($old0, $addr[0], 'The reversal was idempotent'); my $new1 = $srs->forward($new0, $addr[2]); # print STDERR "Composed is $new1\n"; ok(length $new1, 'Made another new address with the SRS address'); like($new1, qr/^SRS/, 'It is an SRS address'); my $old1 = $srs->reverse($new1); ok(length $old1, 'Reversed the address again'); is($old1, $new0, 'The reversal was idempotent again'); $srs = undef; # garb! Restart the process. $srs = new Mail::SRS::DB( Secret => "foo", Database => 'test.db', ); my $oldt = $srs->reverse($new0); is($old0, $addr[0], 'The reversal was idempotent over store'); libmail-srs-perl-0.31.orig/t/10_pod.t0000644000175000017500000000020110066375747017162 0ustar ericeric00000000000000use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); libmail-srs-perl-0.31.orig/eg/0000755000175000017500000000000010135233631016030 5ustar ericeric00000000000000libmail-srs-perl-0.31.orig/eg/exim/0000755000175000017500000000000010135233631016772 5ustar ericeric00000000000000libmail-srs-perl-0.31.orig/eg/exim/srs.conf0000644000175000017500000000333310066375747020474 0ustar ericeric00000000000000.ifdef SRS # This exim config fragment is currently untested, but it lays # out approximately how one might go about setting up SRS in exim. # A redirect router which catches all SRS bounces. It requests an # address translation from the SRS daemon. The exim rule does NOT # have caseful_local_part because we want the local_part_prefix to # match caselessly. Exim will preserve case when passing requests # to the daemon. srs_bounce: driver = redirect allow_fail local_part_prefix = srs0+ : srs0- : srs0= : srs1+ : srs1- : srs1= address_data = ${readsocket{/tmp/srsd}\ {REVERSE $local_part@$domain\n}\ {5s}{\n}{:fail: SRS daemon failure}} data = ${quote_local_part:${local_part:$address_data}}@${domain:$address_data} no_verify # Ideally, we want this only to match forwarded mail. Currently, it # matches only mail sourced nonlocally. srs_forward: senders = ! : ! *@+local_domains : ! *@+virtual_domains address_data = ${readsocket{/tmp/srsd}\ {FORWARD $sender_address_local_part@$sender_address_domain $primary_hostname\n}\ {5s}{\n}{:fail: SRS daemon failure}} errors_to = ${quote_local_part:${local_part:$address_data}}@${domain:$address_data} headers_add = "X-SRS-Rewrite: Sender address rewritten from <$sender_address> by $primary_hostname." driver = redirect data = ${quote_local_part:$local_part}@$domain # Alternatively, we may simply be able to use the following # rewriting rules: # #^(?i:srs0[-+=]) ${readsocket{/tmp/srsd}{REVERSE $0\n}{5s}{\n}\ # {:fail: SRS daemon failure}} T #^(?i:srs1[-+=]) ${readsocket{/tmp/srsd}{REVERSE $0\n}{5s}{\n}\ # {:fail: SRS daemon failure}} T #* ${readsocket{/tmp/srsd}{FORWARD $0 SRSDOMAIN}{5s}{\n}\ # {:fail: SRS daemon failure}} F .endif // SRS libmail-srs-perl-0.31.orig/eg/teach.pl0000644000175000017500000001305610066375747017500 0ustar ericeric00000000000000use strict; use Mail::SRS; my $srs = new Mail::SRS( Secret => "foo", # Please, PLEASE change this! ); # A mail from a@source.com goes to b@forwarder.com and gets forwarded # to c@target.com. my $source = "a\@source.com"; my $alias = "b\@forward.com"; my $target = "c\@target.com"; my $final = "d\@final.com"; my $srsdb = "/tmp/srs-eg.db"; sub presskey { print "\nPress ==================================\n"; <>; print "\n" x 6; } print << "EOM"; Imagine a mail: $source --> $alias The return path of the mail is originally $source. Imagine a redirector: $alias REDIRECTS TO $target If $alias resends the mail with return path $source, SPF at $target will reject it, so we must rewrite the return path so that it comes from the domain of $alias. EOM my $newsource = $srs->forward($source, $alias); print << "EOM"; So when $alias forwards the mail, it rewrites the return path according to SRS, to get: $newsource This is what the \$srs->forward() method does. EOM presskey; print << "EOM"; If the mail bounces, the mail goes back to the forwarder, which applies the reverse transformation to get: EOM my $oldsource = $srs->reverse($newsource); print << "EOM"; $oldsource This is what the \$srs->reverse() method does. The extra fields in the funny-looking address encode the timestamp when the forwards transformation was performed and a cryptographic hash. The timestamp ensures that we don't forward bounces back ad infinitum, but only for (say) one month. The cryptographic hash ensures that SRS addresses for a particular host cannot be forged. When $alias gets a returned mail, it can check the hash with its secret data to make sure this is a real SRS address. EOM presskey; my $srs1source = $srs->forward($newsource, $target); print << "EOM"; If $target is in fact a forwarder, sending to $final, then $target must rewrite the sender again. Bounces must be cryptographically checked before they are sent to a real person, therefore the first SRS link in the chain is maintained, and the address becomes $srs1source This new sender does not contain any new cryptographic information. It contains only the original cryptographic hash from $alias and it assumes that $alias will check its own hash before returning the mail to $source. EOM presskey; my $srs1source1 = $srs->forward($srs1source, $final); my $srs0source = $srs->reverse($srs1source); my $reverse = $srs->reverse($srs0source); print << "EOM"; Now, when either $final or $target performs the reverse transformation, it will get the original SRS address for bounces: $srs0source And then the first forwarder in the chain may perform a final reversal, checking the cryptographic information before returning the mail to $reverse If the mail was to be forwarded a third time, hops can be dropped on the return path, and the new SRS1 address would be $srs1source1 For more information on the peculiarities of this `second layer', see the web page at http://www.anarres.org/projects/srs/ EOM presskey; use Mail::SRS::Shortcut; $srs = new Mail::SRS::Shortcut( Secret => "foo", ); my $srs0a = $srs->forward($source, $alias); my $srs0b = $srs->forward($srs0a, $target); my $orig = $srs->reverse($srs0b); print << "EOM"; This code provides for three other possible types of transformation. The first is a simplistic SRS scheme which implements only a part of the SRS scheme. It shortcuts even the first forwarder after the source address, so the rewriting sequence would proceed as follows: $source via a forwarder becomes $srs0a which if forwarded again, becomes simply $srs0b which when reversed, returns to $orig WARNING: IF YOU USE THIS SIMPLE SYSTEM, YOU MAY BECOME AN OPEN RELAY EOM presskey; use Mail::SRS::Reversible; $srs = new Mail::SRS::Reversible( Secret => "foo", ); my $revsource = $srs->forward($newsource, $final); print << "EOM"; The second is the fully reversable transformation, and is provided by a subclass of Mail::SRS called Mail::SRS::Reversible. This subclass rewrites $newsource to $revsource This is excessively long and breaks the 64 character limit required by RFC821 and RFC2821. This package is provided for randomness and completeness, and its use is NOT RECOMMENDED. The next test will write to a file called $srsdb Abort now if this file is not writable, or you do not want this script to write to that file. EOM presskey; use Mail::SRS::DB; $srs = new Mail::SRS::DB( Secret => "foo", Database => $srsdb, ); my $dbsource = $srs->forward($source, $final); my $dbrev = $srs->reverse($dbsource); $srs = undef; # garb! unlink($srsdb); print << "EOM"; The last mechanism provided by this code is a database driven system. This is designed to be useful to people requiring more functionality from a custom sender rewriting scheme. In this case, the address $source is rewritten to $dbsource and any bounces will be looked up in the database to retrieve $dbrev The new address $dbsource is also cryptographic, and is used as a database key to find the original address and any timeout or reuse information. The source of Mail::SRS::DB provides a good example for people wanting to build more complex rewriting schemes. IMPORTANT: While the database mechanism provides the same functionality as SRS, the new return path is NOT an SRS address, and therefore does NOT start with "SRS+". This is so that database rewriting schemes and `true' SRS schemes can operate seamlessly on the `same' internet. EOM presskey; print << "EOM"; Now go and read the web page at http://www.anarres.org/projects/srs/ If your questions are not answered there, then please mail the maintainers. EOM libmail-srs-perl-0.31.orig/eg/gentoo/0000755000175000017500000000000010135233631017323 5ustar ericeric00000000000000libmail-srs-perl-0.31.orig/eg/gentoo/srsd0000755000175000017500000000070510066375747020250 0ustar ericeric00000000000000#!/sbin/runscript # Copyright 1999-2003 Shevek # Distributed under the terms of the GNU General Public License, v2 or later # NB: Config is in /etc/conf.d/spfd.conf depend() { need net } start() { ebegin "Starting srsd" start-stop-daemon --start --background \ --exec /usr/bin/srsd -- ${SRSD_OPTS} eend $? "Failed to start srsd" } stop() { ebegin "Stopping srsd" start-stop-daemon --stop --quiet --name srsd eend $? "Failed to stop srsd" } libmail-srs-perl-0.31.orig/eg/Limit.pm0000644000175000017500000000421410066375747017467 0ustar ericeric00000000000000package Mail::SRS::Limit; use strict; use warnings; use base 'Mail::SRS'; use Carp; use MLDBM qw(DB_File Storable); use Fcntl; =head1 NAME Mail::SRS::Limit - A Sender Rewriting Scheme which limits bounces =head1 SYNOPSIS use Mail::SRS::Limit; my $srs = new Mail::SRS::Limit( Database => '/var/run/srs.db', Limit => 10, ... ); =head1 DESCRIPTION See Mail::SRS for details of the standard SRS subclass interface. This module requires two extra parameters to the constructor: a filename for a Berkeley DB_File database, and the maximum number of bounces to allow for any mail. =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 =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, Limit => $self->{Limit}, 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 $hash; } sub parse { my ($self, $user) = @_; 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"; } unless ($data->{Limit} > 0) { die "Limit expired"; } $data->{Limit}--; $self->{Data}->{$hash} = $data; # Trigger rewrite in MLDBM return ($sendhost, $senduser); } 1; libmail-srs-perl-0.31.orig/lib/0000755000175000017500000000000010135233631016203 5ustar ericeric00000000000000libmail-srs-perl-0.31.orig/lib/Mail/0000755000175000017500000000000010135233631017065 5ustar ericeric00000000000000libmail-srs-perl-0.31.orig/lib/Mail/SRS/0000755000175000017500000000000010135233631017534 5ustar ericeric00000000000000libmail-srs-perl-0.31.orig/lib/Mail/SRS/Reversable.pm0000644000175000017500000000020210066375746022177 0ustar ericeric00000000000000package Mail::SRS::Reversable; use Carp qw(croak); croak "Please use Mail::SRS::Reversible instead of Mail::SRS::Reversable"; 1; libmail-srs-perl-0.31.orig/lib/Mail/SRS/DB.pm0000644000175000017500000000414010066375746020377 0ustar ericeric00000000000000package 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 =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; libmail-srs-perl-0.31.orig/lib/Mail/SRS/Reversible.pm0000644000175000017500000000211210066375746022211 0ustar ericeric00000000000000package Mail::SRS::Reversible; use strict; use warnings; use vars qw(@ISA); use Carp; use Mail::SRS qw(:all); use Mail::SRS::Shortcut; @ISA = qw(Mail::SRS::Shortcut); =head1 NAME Mail::SRS::Reversible - A fully reversible Sender Rewriting Scheme =head1 SYNOPSIS use Mail::SRS::Reversible; my $srs = new Mail::SRS::Reversible(...); =head1 DESCRIPTION See Mail::SRS for details of the standard SRS subclass interface. This module provides the methods compile() and parse(). It operates without store. =head1 SEE ALSO L =cut sub compile { my ($self, $sendhost, $senduser) = @_; my $timestamp = $self->timestamp_create(); # This has to be done in compile, because we might need access # to it for storing in a database. my $hash = $self->hash_create($timestamp, $sendhost, $senduser); # 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 . join($SRSSEP, $hash, $timestamp, $sendhost, $senduser); } 1; libmail-srs-perl-0.31.orig/lib/Mail/SRS/Shortcut.pm0000644000175000017500000000522410066375746021731 0ustar ericeric00000000000000package Mail::SRS::Shortcut; use strict; use warnings; use vars qw(@ISA); use Carp; use Mail::SRS qw(:all); @ISA = qw(Mail::SRS); =head1 NAME Mail::SRS::Shortcut - A shortcutting Sender Rewriting Scheme =head1 SYNOPSIS use Mail::SRS::Shortcut; my $srs = new Mail::SRS::Shortcut(...); =head1 DESCRIPTION WARNING: Using the simple Shortcut strategy is a very bad idea. Use the Guarded strategy instead. The weakness in the Shortcut strategy is documented at http://www.anarres.org/projects/srs/ See Mail::SRS for details of the standard SRS subclass interface. This module provides the methods compile() and parse(). It operates without store, and shortcuts around all middleman resenders. =head1 SEE ALSO L =cut sub compile { my ($self, $sendhost, $senduser) = @_; if ($senduser =~ s/^$SRS0RE//io) { # This duplicates effort in Guarded.pm but makes this file work # standalone. # We just do the split because this was hashed with someone # else's secret key and we can't check it. # hash, timestamp, host, user (undef, undef, $sendhost, $senduser) = split(qr/\Q$SRSSEP\E/, $senduser, 4); # We should do a sanity check. After all, it might NOT be # an SRS address, unlikely though that is. We are in the # presence of malicious agents. However, this code is # never reached if the Guarded subclass is used. } elsif ($senduser =~ s/$SRS1RE//io) { # This should never be hit in practice. It would be bad. # Introduce compatibility with the guarded format? # SRSHOST, hash, timestamp, host, user (undef, undef, undef, $sendhost, $senduser) = split(qr/\Q$SRSSEP\E/, $senduser, 6); } my $timestamp = $self->timestamp_create(); my $hash = $self->hash_create($timestamp, $sendhost, $senduser); # Note that there are 5 fields here and that sendhost may # not contain a valid separator. Therefore, we do not need to # escape separators anywhere in order to reverse this # transformation. return $SRS0TAG . $self->separator . join($SRSSEP, $hash, $timestamp, $sendhost, $senduser); } sub parse { my ($self, $user) = @_; unless ($user =~ s/$SRS0RE//oi) { # We should deal with SRS1 addresses here, just in case? die "Reverse address does not match $SRS0RE."; } # The 4 here matches the number of fields we encoded above. If # there are more separators, then they belong in senduser anyway. my ($hash, $timestamp, $sendhost, $senduser) = split(qr/\Q$SRSSEP\E/, $user, 4); # Again, this must match as above. unless ($self->hash_verify($hash,$timestamp,$sendhost,$senduser)) { die "Invalid hash"; } unless ($self->timestamp_check($timestamp)) { die "Invalid timestamp"; } return ($sendhost, $senduser); } 1; libmail-srs-perl-0.31.orig/lib/Mail/SRS/Guarded.pm0000644000175000017500000000570610066375746021476 0ustar ericeric00000000000000package Mail::SRS::Guarded; use strict; use warnings; use vars qw(@ISA); use Carp; use Mail::SRS qw(:all); use Mail::SRS::Shortcut; @ISA = qw(Mail::SRS::Shortcut); =head1 NAME Mail::SRS::Guarded - A guarded Sender Rewriting Scheme (recommended) =head1 SYNOPSIS use Mail::SRS::Guarded; my $srs = new Mail::SRS::Guarded(...); =head1 DESCRIPTION This is the default subclass of Mail::SRS. An instance of this subclass is actually constructed when "new Mail::SRS" is called. Note that allowing variable separators after the SRS\d token means that we must preserve this separator in the address for a possible reversal. SRS1 does not need to understand the SRS0 address, just preserve it, on the assumption that it is valid and that the host doing the final reversal will perform cryptographic tests. It may therefore strip just the string SRS0 and not the separator. This explains the appearance of a double separator in SRS1=. See Mail::SRS for details of the standard SRS subclass interface. This module provides the methods compile() and parse(). It operates without store, and guards against gaming the shortcut system. =head1 SEE ALSO L =cut sub compile { my ($self, $sendhost, $senduser) = @_; if ($senduser =~ s/$SRS1RE//io) { # We could do a sanity check. After all, it might NOT be # an SRS address, unlikely though that is. We are in the # presence of malicious agents. However, since we don't need # to interpret it, it doesn't matter if it isn't an SRS # address. Our malicious SRS0 party gets back the garbage # he spat out. # Actually, it turns out that we can simplify this # function considerably, although it should be borne in mind # that this address is not opaque to us, even though we didn't # actually process or generate it. # hash, srshost, srsuser my (undef, $srshost, $srsuser) = split(qr/\Q$SRSSEP\E/, $senduser, 3); my $hash = $self->hash_create($srshost, $srsuser); return $SRS1TAG . $self->separator . join($SRSSEP, $hash, $srshost, $srsuser); } elsif ($senduser =~ s/$SRS0RE/$1/io) { my $hash = $self->hash_create($sendhost, $senduser); return $SRS1TAG . $self->separator . join($SRSSEP, $hash, $sendhost, $senduser); } return $self->SUPER::compile($sendhost, $senduser); } sub parse { my ($self, $user) = @_; if ($user =~ s/$SRS1RE//oi) { my ($hash, $srshost, $srsuser) = split(qr/\Q$SRSSEP\E/, $user, 3); if ($hash =~ /\Q.\E/) { die "Hashless SRS1 address received when " . "AllowUnsafeSrs is not set" unless $self->{AllowUnsafeSrs}; # Reconstruct the parameters as they were in the old format. $srsuser = $srshost . $SRSSEP . $srsuser; $srshost = $hash; } else { unless ($self->hash_verify($hash, $srshost, $srsuser)) { die "Invalid hash"; } } unless (defined $srshost and defined $srsuser) { die "Invalid SRS1 address"; } return ($srshost, $SRS0TAG . $srsuser); } return $self->SUPER::parse($user); } 1; libmail-srs-perl-0.31.orig/lib/Mail/SRS/Daemon.pm0000755000175000017500000001400010066375746021314 0ustar ericeric00000000000000package Mail::SRS::Daemon; use strict; use warnings; use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS $SRSSOCKET); use Exporter; use IO::Socket; use IO::Select; use Getopt::Long; use Mail::SRS qw(:all); @ISA = qw(Exporter); @EXPORT_OK = qw($SRSSOCKET); %EXPORT_TAGS = ( all => \@EXPORT_OK, ); $SRSSOCKET = '/tmp/srsd'; sub new { my $class = shift; my $args = ($#_ == 0) ? %{ (shift) } : { @_ }; my @secrets = ref($args->{Secret}) eq 'ARRAY' ? @{ $args->{Secret} } : [ $args->{Secret} ]; if (exists $args->{SecretFile} && defined $args->{SecretFile}) { my $secretfile = $args->{SecretFile}; die "Secret file $secretfile not readable" unless -r $secretfile; local *FH; open(FH, "<$secretfile") or die "Cannot open $secretfile: $!"; while () { next unless /\S/; next if /^#/; push(@secrets, $_); } close(FH); } die "No secret or secretfile given. Use --secret or --secretfile, ". "and ensure the secret file is not empty." unless @secrets; # Preserve the pertinent original arguments, mostly for fun. my $self = { Secret => $args->{Secret}, SecretFile => $args->{SecretFile}, }; $self->{Socket} = delete $args->{Socket} if exists $args->{Socket}; # An alternative pattern would be to inherit this, rather than # delegate to it. $args->{Secret} = \@secrets; # All other args are passed on verbatim. my $srs = new Mail::SRS($args); $self->{Instance} = $srs; return bless $self, $class; } sub run { my ($self) = @_; my $srs = $self->{Instance}; print STDERR "Starting SRS daemon in PID $$\n"; # Until we decide that forward() and reverse() can die, this will # allow us to trap the error messages from those subroutines. local $SIG{__WARN__} = sub { die @_; }; my $listen = $self->{Socket}; unless ($listen) { unlink($SRSSOCKET) if -e $SRSSOCKET; $listen ||= new IO::Socket::UNIX( Type => SOCK_STREAM, Local => $SRSSOCKET, Listen => 1, ); die "Unable to create listen socket: $!" unless $listen; } my $select = new IO::Select(); $select->add($listen); while (my @socks = $select->can_read) { foreach my $sock (@socks) { if ($sock == $listen) { # print "Accept on $sock\n"; $select->add($listen->accept()); } else { my $line = <$sock>; if (defined($line)) { chomp($line); # print "Read '$line' on $sock\n"; my @args = split(/\s+/, $line); my $cmd = uc shift @args; eval { if ($cmd eq 'FORWARD') { $sock->print($srs->forward(@args), "\n"); } elsif ($cmd eq 'REVERSE') { $sock->print($srs->reverse(@args), "\n"); } else { die "Invalid command $cmd"; } }; if ($@) { $sock->print("ERROR: $@"); $select->remove($sock); $sock->close(); } } # Exim requires that we unconditionally close the socket # print "Close on $sock\n"; $select->remove($sock); $sock->flush(); $sock->close(); undef $sock; } } my @exc = $select->has_exception(0); foreach my $sock (@exc) { # print "Exception on $sock\n"; $select->remove($sock); $sock->close(); } } } __END__ =head1 NAME Mail::SRS::Daemon - modular daemon for Mail::SRS =head1 SYNOPSIS my $daemon = new Mail::SRS::Daemon( SecretFile => $secretfile, Separator => $separator, ); $daemon->run(); =head1 DESCRIPTION The SRS daemon listens on a socket for SRS address transformation requests. It transforms the addresses and returns the new addresses on the socket. It may be invoked from exim using ${readsocket ...}, and probably from other MTAs as well. See http://www.anarres.org/projects/srs/ for examples. =head1 METHODS =head2 $daemon = new Mail::SRS::Daemon(...) Construct a new Mail::SRS object and return it. All parameters which are valid for Mail::SRS are also valid for Mail::SRS::Daemon and will be passed to the constructor of Mail::SRS verbatim. The exception to this rule is the Secret parameter, which will be promoted to a list and will have all secrets from SecretFile included. New parameters are documented here. See L for the rest. =over 4 =item SecretFile => $string A file to read for secrets. Secrets are specified once per line. The first specified secret is used for encoding. Secrets are written one per line. Blank lines and lines starting with a # are ignored. If Secret is not given, then the secret file must be nonempty. Secret will specify a primary secret and override SecretFile if both are specified. However, secrets read from SecretFile still be used for decoding if both are specified. =item Socket => $socket An instance of IO::Socket, presumed to be a listening socket. This may be provided in order to use a preexisting socket, rather than have Mail::SRS::Daemon construct a new socket. =back =head2 $daemon->run() Run the daemon. This method will never return. Errors and exceptions are caught, and error messages are returned down the socket. =head1 EXPORTS Given :all, this module exports the following variables. =over 4 =item $SRSSOCKET The filename of the default socket created by Mail::SRS::Daemon. =back =head1 PROTOCOL The daemon waits for a single line of text from the client, and will respond with a single line. The lines are all of the form "COMMAND args...". Currently, two commands are supported: forward and reverse. A forward request looks like: FORWARD sender@source.com alias@forwarder.com A reverse request looks like: REVERSE srs0+HHH=TT=domain=local-part@forwarder.com In either case, the daemon will respond with either a translated address, or a line starting "ERROR ", followed by a message. =head1 TODO Add more daemon-related options, such as path to socket, or inet socket address. =head1 SEE ALSO L, L, http://www.anarres.org/projects/srs/ =head1 AUTHOR Shevek CPAN ID: SHEVEK cpan@anarres.org http://www.anarres.org/projects/ =head1 COPYRIGHT Copyright (c) 2004 Shevek. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; __END__ libmail-srs-perl-0.31.orig/lib/Mail/SRS.pm0000644000175000017500000005404310135233577020111 0ustar ericeric00000000000000package Mail::SRS; use strict; use warnings; use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS $SRS0TAG $SRS1TAG $SRS0RE $SRS1RE $SRSSEP $SRSTAG $SRSWRAP $SRSHASHLENGTH $SRSMAXAGE ); use Exporter; use Carp; use Digest::HMAC_SHA1; $VERSION = "0.31"; @ISA = qw(Exporter); $SRS0TAG = "SRS0"; $SRS1TAG = "SRS1"; $SRS0RE = qr/^$SRS0TAG([-+=])/io; $SRS1RE = qr/^$SRS1TAG([-+=])/io; $SRSSEP = "="; # These are deprecated. $SRSTAG = $SRS0TAG; $SRSWRAP = $SRS1TAG; $SRSHASHLENGTH = 4; $SRSMAXAGE = 21; @EXPORT_OK = qw($SRS0TAG $SRS1TAG $SRS0RE $SRS1RE $SRSSEP $SRSTAG $SRSWRAP $SRSHASHLENGTH $SRSMAXAGE ); %EXPORT_TAGS = ( all => \@EXPORT_OK, ); =head1 NAME Mail::SRS - Interface to Sender Rewriting Scheme =head1 SYNOPSIS use Mail::SRS; my $srs = new Mail::SRS( Secret => [ .... ], # scalar or array MaxAge => 49, # days HashLength => 4, # base64 characters: 4 x 6bits HashMin => 4, # base64 characters ); my $srsaddress = $srs->forward($sender, $alias); my $sender = $srs->reverse($srsaddress); =head1 DESCRIPTION The Sender Rewriting Scheme preserves .forward functionality in an SPF-compliant world. SPF requires the SMTP client IP to match the envelope sender (return-path). When a message is forwarded through an intermediate server, that intermediate server may need to rewrite the return-path to remain SPF compliant. If the message bounces, that intermediate server needs to validate the bounce and forward the bounce to the original sender. SRS provides a convention for return-path rewriting which allows multiple forwarding servers to compact the return-path. SRS also provides an authentication mechanism to ensure that purported bounces are not arbitrarily forwarded. SRS is documented at http://spf.pobox.com/srs.html and many points about the scheme are discussed at http://www.anarres.org/projects/srs/ For a better understanding of this code and how it functions, please read this document and run the interactive walkthrough in eg/simple.pl in this distribution. To run this from the build directory, type "make teach". =head1 METHODS =head2 $srs = new Mail::SRS(...) Construct a new Mail::SRS object and return it. Available parameters are: =over 4 =item Secret => $string A key for the cryptographic algorithms. This may be an array or a single string. A string is promoted into an array of one element. =item MaxAge The maximum number of days for which a timestamp is considered valid. After this time, the timestamp is invalid. =item HashLength => $integer The number of bytes of base64 encoded data to use for the cryptographic hash. More is better, but makes for longer addresses which might exceed the 64 character length suggested by RFC2821. This defaults to 4, which gives 4 x 6 = 24 bits of cryptographic information, which means that a spammer will have to make 2^24 attempts to guarantee forging an SRS address. =item HashMin => $integer The shortest hash which we will allow to pass authentication. Since we allow any valid prefix of the full SHA1 HMAC to pass authentication, a spammer might just suggest a hash of length 0. We require at least HashMin characters, which must all be correct. Naturally, this must be no greater than HashLength and will default to HashLength unless otherwise specified. =item Separator => $character Specify the initial separator to use immediately after the SRS tag. SRS uses the = separator throughout EXCEPT for the initial separator, which may be any of + - or =. Some MTAs already have a feature by which text after a + or - is ignored for the purpose of identifying a local recipient. If the initial separator is set to + or -, then an administrator may process all SRS mails by creating users SRS0 and SRS1, and using Mail::SRS in the default delivery rule for these users. Some notes on the use and preservation of these separators are found in the perldoc for L. =item AlwaysRewrite => $boolean SRS rewriting is not performed by default if the alias host matches the sender host, since it would be unnecessary to do so, and it interacts badly with ezmlm if we do. Set this to true if you want always to rewrite when requested to do so. =item IgnoreTimestamp => $boolean Consider all timestamps to be valid. Defaults to false. It is STRONGLY recommended that this remain false. This parameter is provided so that timestamps may be ignored temporarily after a change in the timestamp format or encoding, until all timestamps in the old encoding would have become invalid. Note that timestamps still form a part of the cryptographic data when this is enabled. =item AllowUnsafeSrs This is a backwards compatibility option for an older version of the protocol where SRS1 was not hash-protected. The 'reverse' method will detect such addresses, and handle them properly. Deployments upgrading from version <=0.27 to any version >=0.28 should enable this for MaxAge+1 days. When this option is enabled, all new addresses will be generated with cryptographic protection. =back Some subclasses require other parameters. See their documentation for details. =cut sub new { my $class = shift; if ($class eq 'Mail::SRS') { require Mail::SRS::Guarded; return new Mail::SRS::Guarded(@_); } my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; $self->{Secret} = [ $self->{Secret} ] unless ref($self->{Secret}) eq 'ARRAY'; $self->{MaxAge} = $SRSMAXAGE unless $self->{MaxAge}; $self->{HashLength} = $SRSHASHLENGTH unless $self->{HashLength}; $self->{HashMin} = $self->{HashLength} unless $self->{HashMin}; $self->{Separator} = '=' unless exists $self->{Separator}; unless ($self->{Separator} =~ m/^[-+=]$/) { die "Initial separator must be = - or +, " . "not $self->{Separator}"; } return bless $self, $class; } =head2 $srsaddress = $srs->forward($sender, $alias) Map a sender address into a new sender and a cryptographic cookie. Returns an SRS address to use as the new sender. There are alternative subclasses, some of which will return SRS compliant addresses, some will simply return non-SRS but valid RFC821 addresses. See the interactive walkthrough for more information on this ("make teach"). =cut sub forward { my ($self, $sender, $alias) = @_; $sender =~ m/^(.*)\@([^\@]+)$/ or die "Sender '$sender' contains no \@"; my ($senduser, $sendhost) = ($1, $2); $senduser =~ m/\@/ and die 'Sender username may not contain an @'; # We don't require alias to be a full address, just a domain will do if ($alias =~ m/^(.*)\@([^@]+)$/) { $alias = $2; } my $aliashost = $alias; if (lc $aliashost eq lc $sendhost) { return "$senduser\@$sendhost" unless $self->{AlwaysRewrite}; } # Subclasses may override the compile() method. my $srsdata = $self->compile($sendhost, $senduser); return "$srsdata\@$aliashost"; } =head2 $sender = $srs->reverse($srsaddress) Reverse the mapping to get back the original address. Validates all cryptographic and timestamp information. Returns the original sender address. This method will die if the address cannot be reversed. =cut sub reverse { my ($self, $address) = @_; $address =~ m/^(.*)\@([^@])+$/ or croak 'Address contains no @'; my ($user, $host) = ($1, $2); my ($sendhost, $senduser) = eval { $self->parse($user); }; die "Parse error in `$user': $@" if $@; return "$senduser\@$sendhost"; } =head2 $srs->compile($sendhost, $senduser) This method, designed to be overridden by subclasses, takes as parameters the original host and user and must compile a new username for the SRS transformed address. It is expected that this new username will be joined on $SRSSEP, and will contain a hash generated from $self->hash_create(...), and possibly a timestamp generated by $self->timestamp_create(). =cut sub compile { croak "How did Mail::SRS::compile get called? " . "All subclasses override it"; } =head2 $srs->parse($srsuser) This method, designed to be overridden by subclasses, takes an SRS-transformed username as an argument, and must reverse the transformation produced by compile(). It is required to verify any hash and timestamp in the parsed data, using $self->hash_verify($hash, ...) and $self->timestamp_check($timestamp). =cut sub parse { croak "How did Mail::SRS::parse get called? " . "All subclasses override it"; } =head2 $srs->timestamp_create([$time]) Return a two character timestamp representing 'today', or $time if given. $time is a Unix timestamp (seconds since the aeon). This Perl function has been designed to be agnostic as to base, and in practice, base32 is used since it can be reversed even if a remote MTA smashes case (in violation of RFC2821 section 2.4). The agnosticism means that the Perl uses division instead of rightshift, but in Perl that doesn't matter. C implementors should implement this operation as a right shift by 5. =cut # We have two options. We can either encode an send date or an expiry # date. If we encode a send date, we have the option of changing # the expiry date later. If we encode an expiry date, we can send # different expiry dates for different sources/targets, and we don't # have to store them. # Do NOT use BASE64 since the timestamp_check routine now explicit # smashes case in the timestamp just in case there was a problem. # my @BASE64 = ('A'..'Z', 'a'..'z', '0'..'9', '+', '/'); my @BASE32 = ('A'..'Z', '2'..'7'); my @BASE = @BASE32; my %BASE = map { $BASE[$_] => $_ } (0..$#BASE); # This checks for more than one bit set in the size. # i.e. is the size a power of 2? die "Invalid base array of size " . scalar(@BASE) if scalar(@BASE) & (scalar(@BASE) - 1); my $PRECISION = 60 * 60 * 24; # One day my $TICKSLOTS = scalar(@BASE) * scalar(@BASE); # Two chars sub timestamp_create { my ($self, $time) = @_; $time = time() unless defined $time; # Since we only mask in the bottom few bits anyway, we # don't need to take this modulo anything (e.g. @BASE^2). $time = int($time / $PRECISION); #% $TICKSLOTS; # print "Time is $time\n"; my $out = $BASE[$time & $#BASE]; # $#BASE is 2^n -1 $time = int($time / scalar(@BASE)); # Use right shift. return $BASE[$time & $#BASE] . $out; } =head2 $srs->timestamp_check($timestamp) Return 1 if a timestamp is valid, undef otherwise. There are 4096 possible timestamps, used in a cycle. At any time, $srs->{MaxAge} timestamps in this cycle are valid, the last one being today. A timestamp from the future is not valid, neither is a timestamp from too far into the past. Of course if you go far enough into the future, the cycle wraps around, and there are valid timestamps again, but the likelihood of a random timestamp being valid is 4096/$srs->{MaxAge}, which is usually quite small: 1 in 132 by default. =cut sub timestamp_check { my ($self, $timestamp) = @_; return 1 if $self->{IgnoreTimestamp}; $timestamp = uc $timestamp; # LOOK OUT - USE BASE32 my $time = 0; foreach (split(//, $timestamp)) { $time = $time * scalar(@BASE) + $BASE{$_}; } my $now = int(time() / $PRECISION) % $TICKSLOTS; # print "Time is $time, Now is $now\n"; $now += $TICKSLOTS while $now < $time; return 1 if $now <= ($time + $self->{MaxAge}); return undef; } =head2 $srs->time_check($time) Similar to $srs->timestamp_check($timestamp), but takes a Unix time, and checks that an alias created at that Unix time is still valid. This is designed for use by subclasses with storage backends. =cut sub time_check { my ($self, $time) = @_; return 1 if time() <= ($time + ($self->{MaxAge} * $PRECISION)); return undef; } =head2 $srs->hash_create(@data) Returns a cryptographic hash of all data in @data. Any piece of data encoded into an address which must remain inviolate should be hashed, so that when the address is reversed, we can check that this data has not been tampered with. You must provide at least one piece of data to this method (otherwise this system is both cryptographically weak and there may be collision problems with sender addresses). =cut sub hash_create { my ($self, @args) = @_; my @secret = $self->get_secret; croak "Cannot create a cryptographic MAC without a secret" unless @secret; my $hmac = new Digest::HMAC_SHA1($secret[0]); foreach (@args) { $hmac->add(lc $_); } my $hash = $hmac->b64digest; return substr($hash, 0, $self->{HashLength}); } =head2 $srs->hash_verify($hash, @data) Verify that @data has not been tampered with, given the cryptographic hash previously output by $srs->hash_create(); Returns 1 or undef. All known secrets are tried in order to see if the hash was created with an old secret. =cut sub hash_verify { my ($self, $hash, @args) = @_; return undef unless length $hash >= $self->{HashMin}; my @secret = $self->get_secret; croak "Cannot verify a cryptographic MAC without a secret" unless @secret; my @valid = (); foreach my $secret (@secret) { my $hmac = new Digest::HMAC_SHA1($secret); foreach (@args) { $hmac->add(lc $_); } my $valid = substr($hmac->b64digest, 0, length($hash)); # We test all case sensitive matches before case insensitive # matches. While the risk of a case insensitive collision is # quite low, we might as well be careful. return 1 if $valid eq $hash; push(@valid, $valid); # Lowercase it later. } $hash = lc($hash); foreach (@valid) { if ($hash eq lc($_)) { warn "SRS: Case insensitive hash match detected. " . "Someone smashed case in the local-part."; return 1; } } return undef; } =head2 $srs->set_secret($new, @old) Add a new secret to the rewriter. When an address is returned, all secrets are tried to see if the hash can be validated. Don't use "foo", "secret", "password", "10downing", "god" or "wednesday" as your secret. =cut sub set_secret { my $self = shift; $self->{Secret} = [ @_ ]; } =head2 $srs->get_secret() Return the list of secrets. These are secret. Don't publish them. =cut sub get_secret { return @{$_[0]->{Secret}}; } =head2 $srs->separator() Return the initial separator, which follows the SRS tag. This is only used as the initial separator, for the convenience of administrators who wish to make srs0 and srs1 users on their mail servers and require to use + or - as the user delimiter. All other separators in the SRS address must be C<=>. =cut sub separator { return $_[0]->{Separator}; } =head1 EXPORTS Given :all, this module exports the following variables. =over 4 =item $SRSSEP The SRS separator. The choice of C<=> as internal separator was fairly arbitrary. It cannot be any of the following: =over 4 =item / + Used in Base64. =item - Used in domains. =item ! % Used in bang paths and source routing. =item : Cannot be used in a Windows NT or Apple filename. =item ; | * Shell or regular expression metacharacters are probably to be avoided. =back =item $SRS0TAG The SRS0 tag. =item $SRS1TAG The SRS1 tag. =item $SRSTAG Deprecated, equal to $SRS0TAG. =item $SRSWRAP Deprecated, equal to $SRS1TAG. =item $SRSHASHLENGTH The default hash length for the SRS HMAC. =item $SRSMAXAGE The default expiry time for timestamps. =back =head1 EXAMPLES OF USAGE For people wanting boilerplate and those less familiar with using Perl modules in larger applications. =head2 Forward Rewriting my $srs = new Mail::SRS(...); my $address = ... my $domain = ... my $srsaddress = eval { $srs->forward($srsaddress, $domain); }; if ($@) { # The rewrite failed } else { # The rewrite succeeded } =head2 Reverse Rewriting my $srs = new Mail::SRS(...); my $srsaddress = ... my $address = eval { $srs->reverse($srsaddress); }; if ($@) { # The rewrite failed } else { # The rewrite succeeded } =head1 NOTES ON SRS =head2 Case Sensitivity RFC2821 states in section 2.4: "The local-part of a mailbox MUST BE treated as case sensitive. Therefore, SMTP implementations MUST take care to preserve the case of mailbox local-parts. [...] In particular, for some hosts the user "smith" is different from the user "Smith". However, exploiting the case sensitivity of mailbox local-parts impedes interoperability and is discouraged." SRS does not rely on case sensitivity in the local part. It uses base64 for encoding the hash, but allows a case insensitive match, making this approximately equivalent to base36 at worst. It will issue a warning if it detects that a remote MTA has smashed case. The timestamp is encoded in base32. =head2 The 64 Billion Character Question RFC2821 section 4.5.3.1: Size limits and minimums: There are several objects that have required minimum/maximum sizes. Every implementation MUST be able to receive objects of at least these sizes. Objects larger than these sizes SHOULD be avoided when possible. However, some Internet mail constructs such as encoded X.400 addresses [16] will often require larger objects: clients MAY attempt to transmit these, but MUST be prepared for a server to reject them if they cannot be handled by it. To the maximum extent possible, implementation techniques which impose no limits on the length of these objects should be used. local-part The maximum total length of a user name or other local-part is 64 characters. Clearly, by including 2 domain names and a local-part in the rewritten address, there is no way in which SRS can guarantee to stay under this limit. However, very few systems are known to actively enforce this limit, and those which become known to the developers will be listed here. =over 4 =item Cisco: PIX MailGuard (firewall gimmick) =item WebShield [something] (firewall gimmick) =back =head2 Invalid SRS Addresses DO NOT MALFORMAT ADDRESSES. This is designed to be an interoperable format. Certain things are allowed, such as changing the semantics of the hash or the timestamp. However, both of these fields must be present and separated by the SRS separator character C<=>. The purpose of this section is to illustrate that if a malicious party were to malformat an address, he would gain nothing by doing so, nor would the network suffer. The SRS protocol is predicated on the fact that the first forwarder provides a cryptographic wrapper on the forward chain for sending mail to the original sender. So what happens if an SRS address is invalid, or faked by a spammer? The minimum parsing of existing SRS addresses is done at each hop. If an SRS0 address is not valid or badly formatted, it will not affect the operation of the system: the mail will go out along the forwarder chain, and return to the invalid or badly formatted address. If the spammer is not pretending to be the first hop, then he must somehow construct an SRS0 address to embed within his SRS1 address. The cryptographic checks on this SRS0 address will fail at the first forwarder and the mail will be dropped. If the spammer is pretending to be the first hop, then SPF should require that any bounces coming back return to his mail server, thus he wins nothing. =head2 Cryptographic Systems The hash in the address is designed to prevent the forging of reverse addresses by a spammer, who might then use the SRS host as a forwarder. It may only be constructed or validated by a party who knows the secret key. The cryptographic system in the default implementation is not mandated. Since nobody else ever needs to interpret the hash, it is reasonable to put any binary data into this field (subject to the possible constraint of case insensitive encoding). The SRS maintainers have attempted to provide a good system. It satisfies a simple set of basic requirements: to provide unforgeability of SRS addresses given that every MTA for a domain shares a secret key. We prefer SHA1 over MD5 for political, rather than practical reasons. (Anyone disputing this statement must include an example of a practical weakness in their mail. We would love to see it.) If you find a weakness in our system, or you think you know of a better system, please tell us. If your requirements are different, you may override hash_create() and hash_verify() to implement a different system without adversely impacting the network, as long as your addresses still behave as SRS addresses. =head2 Extending Mail::SRS Write a subclass. You will probably want to override compile() and parse(). If you are more familiar with the internals of SRS, you might want to override hash_create(), hash_verify(), timestamp_create() or timestamp_check(). =head1 CHANGELOG =head2 MINOR CHANGES since v0.29 =over 4 =item timestamp_check now explicitly smashes case when verifying. This means that the base used must be base32, NOT base64. =item hash_create and hash_verify now explicitly smash case when creating and verifying hashes. This does not have a significant cryptographic impact. =back =head2 MAJOR CHANGES since v0.27 =over 4 =item The SRS1 address format has changed to include cryptographic information. Existing deployments should consider setting AllowUnsafeSrs for MaxAge+1 days. =back =head2 MINOR CHANGES since v0.26 =over 4 =item parse() and compile() are explicitly specified to die() on error. =back =head2 MINOR CHANGES since v0.23 =over 4 =item Update BASE32 according to RFC3548. =back =head2 MINOR CHANGES since v0.21 =over 4 =item Dates are now encoded in base32. =item Case insensitive MAC validation is now allowed, but will issue a warning. =back =head2 MINOR CHANGES since v0.18 =over 4 =item $SRSTAG and $SRSWRAP are deprecated. =item Mail::SRS::Reversable is now Mail::SRS::Reversible This should not be a problem since people should not be using it! =back You must use $SRS0RE and $SRS1RE to detect SRS addresses. =head2 MAJOR CHANGES since v0.15 =over 4 =item The separator character is now C<=>. =item The cryptographic scheme is now HMAC with SHA1. =item Only a prefix of the MAC is used. =back This API is still a release candidate and should remain relatively stable. =head1 BUGS Email address parsing for quoted addresses is not yet done properly. Case insensitive MAC validation should become an option. =head1 TODO Write a testsuite for testing user-defined SRS implementations. =head1 SEE ALSO L, L, L, "make teach", eg/*, http://www.anarres.org/projects/srs/ =head1 AUTHOR Shevek CPAN ID: SHEVEK cpan@anarres.org http://www.anarres.org/projects/ =head1 COPYRIGHT Copyright (c) 2004 Shevek. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; libmail-srs-perl-0.31.orig/srs0000755000175000017500000001160310066375747016215 0ustar ericeric00000000000000#!/usr/bin/perl use strict; use warnings; use Getopt::Long; use Mail::SRS qw(:all); my ($secretfile, $alias, $forward, $reverse, $help); my $separator = $SRSSEP; my $hashlength = 4; my @addresses; my @secrets; my $result = GetOptions ( "separator=s" => \$separator, "address=s" => \@addresses, "secret=s" => \@secrets, "secretfile=s" => \$secretfile, "forward" => \$forward, "reverse" => \$reverse, "alias=s" => \$alias, "hashlength=i" => \$hashlength, "help" => \$help, ); if (!$result || $help) { print << "EOH"; Usage: srs [flags] [address ...] --separator=s Specify the initial separator to be - + or = --address=s Specify an address to transform --secret=s Specify an SRS cryptographic secret --secretfile=s Specify a file from which to read the secret --forward Perform forward transformation --reverse Perform reverse transformation --hashlength=i Specify number of characters to use in the hash --help Display this help =s denotes a string argument. =i denotes an integer argument Multiple addresses are permitted. Multiple secrets are permitted. EOH exit(1); } die "Separator character must be a single + - or =, not $separator" unless $separator =~ /^[=+-]$/; die "Hash length _should_ be nonzero" unless $hashlength; push(@addresses, @ARGV); die "No address given!" unless @addresses; if (defined $secretfile) { die "Secret file $secretfile not readable" unless -r $secretfile; local *FH; open(FH, "<$secretfile") or die "Cannot open $secretfile: $!"; while () { next unless /\S/; next if /^#/; push(@secrets, $_); } close(FH); } die "No secret or secretfile given. Use --secret or --secretfile, " . "and ensure the secret file is not empty." unless @secrets; my $srs = new Mail::SRS( Secret => \@secrets, Separator => $separator, HashLength => $hashlength, ); my $newaddress; if ($reverse) { print $srs->reverse($_), "\n" for @addresses; } else { die "I need an alias address or domain to do forwards transform. " . "Use --alias" unless defined $alias; print $srs->forward($_, $alias), "\n" for @addresses; } __END__ =head1 NAME srs - command line interface to Mail::SRS =head1 SYNOPSIS srs --alias=alias@forwarder.com --secretfile=/etc/srs_secret \ sender@source.com =head1 DESCRIPTION The srs commandline interface will create an instance of L with parameters derived from the commandline arguments and perform forward or reverse transformations for all addresses given. It is usually invoked from a sendmail envelope address transformation rule, a qmail alias, or similar. See http://www.anarres.org/projects/srs/ for examples. Arguments take the form --name or --name=value. =head1 ARGUMENTS =head2 --separator String, specified at most once. Defaults to $SRSSEP (C<=>). Specify the initial separator for the SRS address. See L for details. =head2 --address String, may be specified multiple times, must be specified at least once. Specify a sender address to transform. =head2 --secret String, may be specified multiple times, at least one of --secret or --secretfile must be specified. Specify an SRS secret. The first specified secret is used for encoding. All secrets are used for decoding. =head2 --secretfile String, specified at most once, at least one of --secret or --secretfile must be specified. A file to read for secrets. Secrets are specified once per line. The first specified secret is used for encoding. Secrets are written one per line. Blank lines and lines starting with a # are ignored. If --secret is not given, then the secret file must be nonempty. --secret will specify a primary secret and override --secretfile if both are specified. However, secrets read from --secretfile will still be used for decoding if both are specified. =head2 --forward No argument. Specifies a forwards transformation. This is the default. --reverse must not also be given. =head2 --reverse No argument. Specifies a reverse transformation. --forward must not also be given. =head2 --alias String, must be specified exactly once if doing forwards transformation. Provides the alias address to which the mail was sent. The domain-part of this address is used in the generated SRS address. The local-part and @ are optional and may be omitted. =head2 --hashlength Integer, may be specified at most once, defaults to 4. Specify the number of base64 characters to use for the cryptographic authentication code. =head2 --help Print some basic help. =head1 SEE ALSO L, http://www.anarres.org/projects/srs/ =head1 AUTHOR Shevek CPAN ID: SHEVEK cpan@anarres.org http://www.anarres.org/projects/ =head1 COPYRIGHT Copyright (c) 2004 Shevek. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut libmail-srs-perl-0.31.orig/TODO0000644000175000017500000000057710066375747016160 0ustar ericeric00000000000000Consider using the year as a salt in the hash secret. Find out about case sensitivity in various MTAs. Find out about the 64 character limit in various MTAs. Database cleaning of old addresses. Clean up s/// and m// tests in Guarded.pm and Shortcut.pm - modify strings at sensible times. Update documentation. Twat check to make sure that secret isn't a hashref or something. libmail-srs-perl-0.31.orig/srsc0000755000175000017500000000172710135233577016355 0ustar ericeric00000000000000#!/usr/bin/perl use strict; use warnings; use IO::Socket; use Mail::SRS::Daemon qw(:all); my $sock = new IO::Socket::UNIX( Type => SOCK_STREAM, Peer => $SRSSOCKET, ); $sock->autoflush(1); while (<>) { $sock->print($_); my $line = <$sock>; print $line; last if $sock->eof; } =head1 NAME srsc - a trivial commandline interface to srsd. =head1 SYNOPSIS srsc =head1 DESCRIPTION What you type into srsc is sent over the socket to srsd. What it returns is printed. This client is provided for debugging purposes only and is not intended to be a part of the official toolset. =head1 SEE ALSO L, L, L, http://www.anarres.org/projects/srs/ =head1 AUTHOR Shevek CPAN ID: SHEVEK cpan@anarres.org http://www.anarres.org/projects/ =head1 COPYRIGHT Copyright (c) 2004 Shevek. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut libmail-srs-perl-0.31.orig/srsd0000755000175000017500000000700310066375747016360 0ustar ericeric00000000000000#!/usr/bin/perl use strict; use warnings; use vars qw($PATH); use IO::Socket; use IO::Select; use Getopt::Long; use Mail::SRS qw(:all); use Mail::SRS::Daemon qw(:all); $PATH = '/tmp/srsd'; my ($secretfile, $help); my $separator = $SRSSEP; my $hashlength = $SRSHASHLENGTH; my @secrets; my $result = GetOptions ( "separator=s" => \$separator, "secret=s" => \@secrets, "secretfile=s" => \$secretfile, "hashlength=i" => \$hashlength, "help" => \$help, ); if (!$result || $help) { print << "EOH"; Usage: srs [flags] [address ...] --separator=s Specify the initial separator to be - + or = --secret=s Specify an SRS cryptographic secret --secretfile=s Specify a file from which to read the secret --hashlength=i Specify number of characters to use in the hash --help Display this help =s denotes a string argument. =i denotes an integer argument Multiple addresses are permitted. Multiple secrets are permitted. EOH exit(1); } my $daemon = new Mail::SRS::Daemon( Secret => \@secrets, SecretFile => $secretfile, HashLength => $hashlength, Separator => $separator, ); $daemon->run(); __END__ =head1 NAME srsd - daemon interface to Mail::SRS =head1 SYNOPSIS srsd --secretfile=/etc/srs_secret =head1 DESCRIPTION The srsd daemon listens on a socket for SRS address transformation requests. It transforms the addresses and returns the new addresses on the socket. It may be used from exim using ${readsocket ...}, from sendmail via a TCP socket in a rule, and probably from other MTAs as well. See http://www.anarres.org/projects/srs/ for examples. Arguments take the form --name or --name=value. =head1 ARGUMENTS =head2 --separator String, specified at most once. Defaults to $SRSSEP (C<=>). Specify the initial separator for the SRS address. See L for details. =head2 --secret String, may be specified multiple times, at least one of --secret or --secretfile must be specified. Specify an SRS secret. The first specified secret is used for encoding. All secrets are used for decoding. =head2 --secretfile String, specified at most once, at least one of --secret or --secretfile must be specified. A file to read for secrets. Secrets are specified once per line. The first specified secret is used for encoding. Secrets are written one per line. Blank lines and lines starting with a # are ignored. If --secret is not given, then the secret file must be nonempty. --secret will specify a primary secret and override --secretfile if both are specified. However, secrets read from --secretfile will still be used for decoding if both are specified. =head2 --hashlength Integer, may be specified at most once, defaults to 4. Specify the number of base64 characters to use for the cryptographic authentication code. =head2 --help Print some basic help. =head1 PROTOCOL A forward request: FORWARD sender@source.com alias@forwarder.com A reverse request: REVERSE srs0+HHH=TT=domain=local-part@forwarder.com A client called srsc has been included in this distribution for testing purposes. =head1 TODO Add more daemon-related options. Path to socket. Document protocol. =head1 SEE ALSO L, L, L, http://www.anarres.org/projects/srs/ =head1 AUTHOR Shevek CPAN ID: SHEVEK cpan@anarres.org http://www.anarres.org/projects/ =head1 COPYRIGHT Copyright (c) 2004 Shevek. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut libmail-srs-perl-0.31.orig/README0000644000175000017500000004133710066375747016347 0ustar ericeric00000000000000NAME Mail::SRS - Interface to Sender Rewriting Scheme SYNOPSIS use Mail::SRS; my $srs = new Mail::SRS( Secret => [ .... ], # scalar or array MaxAge => 49, # days HashLength => 4, # base64 characters: 4 x 6bits HashMin => 4, # base64 characters ); my $srsaddress = $srs->forward($sender, $alias); my $sender = $srs->reverse($srsaddress); DESCRIPTION The Sender Rewriting Scheme preserves .forward functionality in an SPF-compliant world. SPF requires the SMTP client IP to match the envelope sender (return-path). When a message is forwarded through an intermediate server, that intermediate server may need to rewrite the return-path to remain SPF compliant. If the message bounces, that intermediate server needs to validate the bounce and forward the bounce to the original sender. SRS provides a convention for return-path rewriting which allows multiple forwarding servers to compact the return-path. SRS also provides an authentication mechanism to ensure that purported bounces are not arbitrarily forwarded. SRS is documented at http://spf.pobox.com/srs.html and many points about the scheme are discussed at http://www.anarres.org/projects/srs/ For a better understanding of this code and how it functions, please read this document and run the interactive walkthrough in eg/simple.pl in this distribution. To run this from the build directory, type "make teach". METHODS $srs = new Mail::SRS(...) Construct a new Mail::SRS object and return it. Available parameters are: Secret => $string A key for the cryptographic algorithms. This may be an array or a single string. A string is promoted into an array of one element. MaxAge The maximum number of days for which a timestamp is considered valid. After this time, the timestamp is invalid. HashLength => $integer The number of bytes of base64 encoded data to use for the cryptographic hash. More is better, but makes for longer addresses which might exceed the 64 character length suggested by RFC2821. This defaults to 4, which gives 4 x 6 = 24 bits of cryptographic information, which means that a spammer will have to make 2^24 attempts to guarantee forging an SRS address. HashMin => $integer The shortest hash which we will allow to pass authentication. Since we allow any valid prefix of the full SHA1 HMAC to pass authentication, a spammer might just suggest a hash of length 0. We require at least HashMin characters, which must all be correct. Naturally, this must be no greater than HashLength and will default to HashLength unless otherwise specified. Separator => $character Specify the initial separator to use immediately after the SRS tag. SRS uses the = separator throughout EXCEPT for the initial separator, which may be any of + - or =. Some MTAs already have a feature by which text after a + or - is ignored for the purpose of identifying a local recipient. If the initial separator is set to + or -, then an administrator may process all SRS mails by creating users SRS0 and SRS1, and using Mail::SRS in the default delivery rule for these users. Some notes on the use and preservation of these separators are found in the perldoc for Mail::SRS::Guarded. AlwaysRewrite => $boolean SRS rewriting is not performed by default if the alias host matches the sender host, since it would be unnecessary to do so, and it interacts badly with ezmlm if we do. Set this to true if you want always to rewrite when requested to do so. IgnoreTimestamp => $boolean Consider all timestamps to be valid. Defaults to false. It is STRONGLY recommended that this remain false. This parameter is provided so that timestamps may be ignored temporarily after a change in the timestamp format or encoding, until all timestamps in the old encoding would have become invalid. Note that timestamps still form a part of the cryptographic data when this is enabled. AllowUnsafeSrs This is a backwards compatibility option for an older version of the protocol where SRS1 was not hash-protected. The 'reverse' method will detect such addresses, and handle them properly. Deployments upgrading from version <=0.27 to any version >=0.28 should enable this for MaxAge+1 days. When this option is enabled, all new addresses will be generated with cryptographic protection. Some subclasses require other parameters. See their documentation for details. $srsaddress = $srs->forward($sender, $alias) Map a sender address into a new sender and a cryptographic cookie. Returns an SRS address to use as the new sender. There are alternative subclasses, some of which will return SRS compliant addresses, some will simply return non-SRS but valid RFC821 addresses. See the interactive walkthrough for more information on this ("make teach"). $sender = $srs->reverse($srsaddress) Reverse the mapping to get back the original address. Validates all cryptographic and timestamp information. Returns the original sender address. This method will die if the address cannot be reversed. $srs->compile($sendhost, $senduser) This method, designed to be overridden by subclasses, takes as parameters the original host and user and must compile a new username for the SRS transformed address. It is expected that this new username will be joined on $SRSSEP, and will contain a hash generated from $self->hash_create(...), and possibly a timestamp generated by $self->timestamp_create(). $srs->parse($srsuser) This method, designed to be overridden by subclasses, takes an SRS-transformed username as an argument, and must reverse the transformation produced by compile(). It is required to verify any hash and timestamp in the parsed data, using $self->hash_verify($hash, ...) and $self->timestamp_check($timestamp). $srs->timestamp_create([$time]) Return a two character timestamp representing 'today', or $time if given. $time is a Unix timestamp (seconds since the aeon). This Perl function has been designed to be agnostic as to base, and in practice, base32 is used since it can be reversed even if a remote MTA smashes case (in violation of RFC2821 section 2.4). The agnosticism means that the Perl uses division instead of rightshift, but in Perl that doesn't matter. C implementors should implement this operation as a right shift by 5. $srs->timestamp_check($timestamp) Return 1 if a timestamp is valid, undef otherwise. There are 4096 possible timestamps, used in a cycle. At any time, $srs->{MaxAge} timestamps in this cycle are valid, the last one being today. A timestamp from the future is not valid, neither is a timestamp from too far into the past. Of course if you go far enough into the future, the cycle wraps around, and there are valid timestamps again, but the likelihood of a random timestamp being valid is 4096/$srs->{MaxAge}, which is usually quite small: 1 in 132 by default. $srs->time_check($time) Similar to $srs->timestamp_check($timestamp), but takes a Unix time, and checks that an alias created at that Unix time is still valid. This is designed for use by subclasses with storage backends. $srs->hash_create(@data) Returns a cryptographic hash of all data in @data. Any piece of data encoded into an address which must remain inviolate should be hashed, so that when the address is reversed, we can check that this data has not been tampered with. You must provide at least one piece of data to this method (otherwise this system is both cryptographically weak and there may be collision problems with sender addresses). $srs->hash_verify($hash, @data) Verify that @data has not been tampered with, given the cryptographic hash previously output by $srs->hash_create(); Returns 1 or undef. All known secrets are tried in order to see if the hash was created with an old secret. $srs->set_secret($new, @old) Add a new secret to the rewriter. When an address is returned, all secrets are tried to see if the hash can be validated. Don't use "foo", "secret", "password", "10downing", "god" or "wednesday" as your secret. $srs->get_secret() Return the list of secrets. These are secret. Don't publish them. $srs->separator() Return the initial separator, which follows the SRS tag. This is only used as the initial separator, for the convenience of administrators who wish to make srs0 and srs1 users on their mail servers and require to use + or - as the user delimiter. All other separators in the SRS address must be "=". EXPORTS Given :all, this module exports the following variables. $SRSSEP The SRS separator. The choice of "=" as internal separator was fairly arbitrary. It cannot be any of the following: / + Used in Base64. - Used in domains. ! % Used in bang paths and source routing. : Cannot be used in a Windows NT or Apple filename. ; | * Shell or regular expression metacharacters are probably to be avoided. $SRS0TAG The SRS0 tag. $SRS1TAG The SRS1 tag. $SRSTAG Deprecated, equal to $SRS0TAG. $SRSWRAP Deprecated, equal to $SRS1TAG. $SRSHASHLENGTH The default hash length for the SRS HMAC. $SRSMAXAGE The default expiry time for timestamps. NOTES ON SRS Case Sensitivity RFC2821 states in section 2.4: "The local-part of a mailbox MUST BE treated as case sensitive. Therefore, SMTP implementations MUST take care to preserve the case of mailbox local-parts. [...] In particular, for some hosts the user "smith" is different from the user "Smith". However, exploiting the case sensitivity of mailbox local-parts impedes interoperability and is discouraged." SRS does not rely on case sensitivity in the local part. It uses base64 for encoding the hash, but allows a case insensitive match, making this approximately equivalent to base36 at worst. It will issue a warning if it detects that a remote MTA has smashed case. The timestamp is encoded in base32. The 64 Billion Character Question RFC2821 section 4.5.3.1: Size limits and minimums: There are several objects that have required minimum/maximum sizes. Every implementation MUST be able to receive objects of at least these sizes. Objects larger than these sizes SHOULD be avoided when possible. However, some Internet mail constructs such as encoded X.400 addresses [16] will often require larger objects: clients MAY attempt to transmit these, but MUST be prepared for a server to reject them if they cannot be handled by it. To the maximum extent possible, implementation techniques which impose no limits on the length of these objects should be used. local-part The maximum total length of a user name or other local-part is 64 characters. Clearly, by including 2 domain names and a local-part in the rewritten address, there is no way in which SRS can guarantee to stay under this limit. However, very few systems are known to actively enforce this limit, and those which become known to the developers will be listed here. Cisco: PIX MailGuard (firewall gimmick) WebShield [something] (firewall gimmick) Invalid SRS Addresses DO NOT MALFORMAT ADDRESSES. This is designed to be an interoperable format. Certain things are allowed, such as changing the semantics of the hash or the timestamp. However, both of these fields must be present and separated by the SRS separator character "=". The purpose of this section is to illustrate that if a malicious party were to malformat an address, he would gain nothing by doing so, nor would the network suffer. The SRS protocol is predicated on the fact that the first forwarder provides a cryptographic wrapper on the forward chain for sending mail to the original sender. So what happens if an SRS address is invalid, or faked by a spammer? The minimum parsing of existing SRS addresses is done at each hop. If an SRS0 address is not valid or badly formatted, it will not affect the operation of the system: the mail will go out along the forwarder chain, and return to the invalid or badly formatted address. If the spammer is not pretending to be the first hop, then he must somehow construct an SRS0 address to embed within his SRS1 address. The cryptographic checks on this SRS0 address will fail at the first forwarder and the mail will be dropped. If the spammer is pretending to be the first hop, then SPF should require that any bounces coming back return to his mail server, thus he wins nothing. Cryptographic Systems The hash in the address is designed to prevent the forging of reverse addresses by a spammer, who might then use the SRS host as a forwarder. It may only be constructed or validated by a party who knows the secret key. The cryptographic system in the default implementation is not mandated. Since nobody else ever needs to interpret the hash, it is reasonable to put any binary data into this field (subject to the possible constraint of case insensitive encoding). The SRS maintainers have attempted to provide a good system. It satisfies a simple set of basic requirements: to provide unforgeability of SRS addresses given that every MTA for a domain shares a secret key. We prefer SHA1 over MD5 for political, rather than practical reasons. (Anyone disputing this statement must include an example of a practical weakness in their mail. We would love to see it.) If you find a weakness in our system, or you think you know of a better system, please tell us. If your requirements are different, you may override hash_create() and hash_verify() to implement a different system without adversely impacting the network, as long as your addresses still behave as SRS addresses. Extending Mail::SRS Write a subclass. You will probably want to override compile() and parse(). If you are more familiar with the internals of SRS, you might want to override hash_create(), hash_verify(), timestamp_create() or timestamp_check(). CHANGELOG MINOR CHANGES since v0.29 timestamp_check now explicitly smashes case when verifying. This means that the base used must be base32, NOT base64. hash_create and hash_verify now explicitly smash case when creating and verifying hashes. This does not have a significant cryptographic impact. MAJOR CHANGES since v0.27 The SRS1 address format has changed to include cryptographic information. Existing deployments should consider setting AllowUnsafeSrs for MaxAge+1 days. MINOR CHANGES since v0.26 parse() and compile() are explicitly specified to die() on error. MINOR CHANGES since v0.23 Update BASE32 according to RFC3548. MINOR CHANGES since v0.21 Dates are now encoded in base32. Case insensitive MAC validation is now allowed, but will issue a warning. MINOR CHANGES since v0.18 $SRSTAG and $SRSWRAP are deprecated. Mail::SRS::Reversable is now Mail::SRS::Reversible This should not be a problem since people should not be using it! You must use $SRS0RE and $SRS1RE to detect SRS addresses. MAJOR CHANGES since v0.15 The separator character is now "=". The cryptographic scheme is now HMAC with SHA1. Only a prefix of the MAC is used. This API is still a release candidate and should remain relatively stable. BUGS Email address parsing for quoted addresses is not yet done properly. Case insensitive MAC validation should become an option. TODO Write a testsuite for testing user-defined SRS implementations. SEE ALSO Mail::SRS::Guarded, Mail::SRS::DB, Mail::SRS::Reversable, "make teach", eg/*, http://www.anarres.org/projects/srs/ AUTHOR Shevek CPAN ID: SHEVEK cpan@anarres.org http://www.anarres.org/projects/ COPYRIGHT Copyright (c) 2004 Shevek. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. libmail-srs-perl-0.31.orig/MANIFEST.SKIP0000644000175000017500000000031710066375747017356 0ustar ericeric00000000000000^blib/ Makefile$ Makefile\.[a-z]+$ ^pm_to_blib$ CVS/.* .svn/ ,v$ ^tmp/ \.old$ \.bak$ ~$ ^# \.shar$ \.tar$ \.tgz$ \.tar\.gz$ \.zip$ _uu$ \.swp$ /old/ ^local/ test\.pl$ temp\.pl$ .cvsignore$ removed-t/ old/ libmail-srs-perl-0.31.orig/Makefile.PL0000644000175000017500000000235010066375747017431 0ustar ericeric00000000000000use 5.006; use ExtUtils::MakeMaker; # Thanks to YAML my @programs = (); for (split "\n", <<'QUERIES') { srs|y|SRS command line interface srsd|y|SRS address translation daemon srsc|y|SRS daemon commandline client QUERIES my ($program, $default, $description) = split /\|/, $_; if (prompt("Do you want to install '$program', the $description?", $default) =~ /^y/) { push(@programs, $program); } } WriteMakefile( 'NAME' => 'Mail::SRS', 'VERSION_FROM' => 'lib/Mail/SRS.pm', # finds $VERSION 'PREREQ_PM' => { 'Digest::HMAC_SHA1' => 1.01, 'Test::More' => 0.40, 'MLDBM' => 2.01, 'Storable' => 2.04, 'DB_File' => 1.806, 'Fcntl' => 0, 'Carp' => 0, 'Exporter' => 0, 'Getopt::Long' => 2.30, }, # e.g., Module::Name => 1.1 ABSTRACT_FROM => 'lib/Mail/SRS.pm', # retrieve abstract from module AUTHOR => 'Shevek ', EXE_FILES => \@programs, clean => { FILES => 'test.db' }, ); sub MY::postamble { my $self = shift; my $old = $self->MM::postamble(@_); chomp($old); my $new = <<'EON'; .PHONY : teach aux readme teach : all $(PERL) -Mblib eg/teach.pl aux : readme readme : lib/Mail/SRS.pm perldoc -t lib/Mail/SRS.pm > README EON return $old . $new; } libmail-srs-perl-0.31.orig/README.pobox0000644000175000017500000000170710066375746017471 0ustar ericeric00000000000000This original documentation for Mail::SRS version 0.10 is no longer relevant to newer versions of this module, but it is preserved here for posterity just in case of questions. See also OLD-DOCS. -- begin -- Mail/SRS version 0.10 ===================== Sender Rewriting Scheme helps email forwarding (think .forward or /etc/aliases) continue to work in an SPF-compliant world. Please see http://spf.pobox.com/srs.html You should install this module through CPAN. It is meant to cooperate with Mail::SPF::Query. This entire module is PIPING HOT and VERY ALPHA. It is brand new and needs a fair amount of TLC from developers. I expect a lot of people will look at this as a prototype and write their own C versions for their MTAs. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install COPYRIGHT AND LICENCE Opensource license. Copyright (C) 2004 IC Group, Inc. home of pobox.com and listbox.com libmail-srs-perl-0.31.orig/OLD-DOCS0000644000175000017500000000234710066375747016554 0ustar ericeric00000000000000This original documentation for Mail::SRS version 0.10 is no longer relevant to newer versions of this module, but it is preserved here for posterity just in case of questions. See also README.pobox. -- begin -- The Sender Rewriting Scheme preserves .forward functionality in an SPF-compliant world. This module should be considered alpha at this time. Documentation is incomplete. Pobox.com decided to publish Mail::SRS to CPAN anyway because there seems to be a fair amount of interest out there in implementing SRS. SPF requires the SMTP client IP to match the envelope sender (return-path). When a message is forwarded through an intermediate server, that intermediate server may need to rewrite the return-path to remain SPF compliant. If the message bounces, that intermediate server needs to validate the bounce and forward the bounce to the original sender. SRS provides a convention for return-path rewriting which allows multiple forwarding servers to compact the return-path. SRS also provides an authentication mechanism to ensure that purported bounces are not arbitrarily forwarded. SRS is documented at http://spf.pobox.com/srs.html A given SRS address is valid for one month by default. Cookies are relatively unique. -- end -- libmail-srs-perl-0.31.orig/MANIFEST0000644000175000017500000000074110066375746016611 0ustar ericeric00000000000000MANIFEST MANIFEST.SKIP Makefile.PL OLD-DOCS README README.pobox TODO eg/Limit.pm eg/exim/srs.conf eg/gentoo/srsd eg/teach.pl lib/Mail/SRS.pm lib/Mail/SRS/DB.pm lib/Mail/SRS/Daemon.pm lib/Mail/SRS/Guarded.pm lib/Mail/SRS/Reversable.pm lib/Mail/SRS/Reversible.pm lib/Mail/SRS/Shortcut.pm srs srsc srsd t/01_basic.t t/02_guarded.t t/03_reversible.t t/04_dbm.t t/05_shortcut.t t/06_separator.t t/07_varysep.t t/08_caseless.t t/10_pod.t t/11_pod_coverage.t t/20_cmdline.t t/21_daemon.t