From fe71a855fc8b8d7a809c2087e3b12971ab74b0e2 Mon Sep 17 00:00:00 2001 From: Alexander Sulfrian Date: Fri, 17 Jun 2016 18:07:46 +0200 Subject: First version --- Makefile | 5 +++ Spline/Netstring.pm | 42 ++++++++++++++++++++++++++ Spline/Socketmap.pm | 65 +++++++++++++++++++++++++++++++++++++++ Spline/Srs.pm | 87 +++++++++++++++++++++++++++++++++++++++++++++++++++++ srs | 15 +++++++++ t/srs.t | 32 ++++++++++++++++++++ 6 files changed, 246 insertions(+) create mode 100644 Makefile create mode 100644 Spline/Netstring.pm create mode 100644 Spline/Socketmap.pm create mode 100644 Spline/Srs.pm create mode 100755 srs create mode 100644 t/srs.t diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..d1bea80 --- /dev/null +++ b/Makefile @@ -0,0 +1,5 @@ +all: + @echo "Supported targets: test" + +test: + prove -I. t/*.t diff --git a/Spline/Netstring.pm b/Spline/Netstring.pm new file mode 100644 index 0000000..e7e649f --- /dev/null +++ b/Spline/Netstring.pm @@ -0,0 +1,42 @@ +package Spline::Netstring; + +use strict; +use warnings; + +our @EXPORT = qw( + netstring_read + netstring_write +); + +sub read_length($) { + my $fd = shift; + my $length; + + local $/ = ':'; + $length = <$fd>; + die "Cannot read netstring length" unless defined($length); + chomp $length; + + return $length; +} + +sub netstring_read($) { + my $fd = shift; + my ($length, $data); + + $length = read_length($fd); + if (read($fd, $data, $length) == $length) { + (getc() eq ',') or die "Closing , missing"; + } + else { + die 'Received only ' . length($data) . " of $length bytes"; + } + + return $data; +} + +sub netstring_write($$) { + my ($fd, $data) = @_; + + print $fd length($data).':'.$data.','; +} diff --git a/Spline/Socketmap.pm b/Spline/Socketmap.pm new file mode 100644 index 0000000..df1a6a9 --- /dev/null +++ b/Spline/Socketmap.pm @@ -0,0 +1,65 @@ +package Spline::Socketmap; + +use strict; +use warnings; +use base qw(Net::Server::PreFork); + +use Spline::Netstring; +use Spline::Srs qw( srs_forward srs_reverse ); + +use base 'Exporter'; +our @EXPORT = qw( ); +our @EXPORT_OK = qw( ); + +our $timeout = 10; +our $handler = undef; + +sub call_handler(@) { + return unless ref($handler) eq 'CODE'; + return \&$handler(@_); +} + +sub handle_request($) { + my $data = shift; + + my ($map, $key) = split(/ /, $data, 2); + my $result = call_handler($map, $key); + if (defined $result) { + reply($result); + } + else { + reply('TEMP Protocol error'); + } +} + +sub process_request { + my $self = shift; + + eval { + local $SIG{'ALRM'} = sub { die "Timed Out!\n" }; + alarm($timeout); + + handle_request(netstring_read(*STDIN)); + alarm(0); + }; + my $err = $@; + alarm(0); + + + if ($err) { + if ($err =~ /timed out/i) { + reply('TEMP Timeout'); + } + else { + reply('TEMP Unknown error'); + } + } +} + +sub reply($) { + netstring_write(*STDOUT, @_); +} + +1; + +# vim: set et ts=4: diff --git a/Spline/Srs.pm b/Spline/Srs.pm new file mode 100644 index 0000000..d7fc795 --- /dev/null +++ b/Spline/Srs.pm @@ -0,0 +1,87 @@ +package Spline::Srs; + +use strict; +use warnings; + +use Mail::SRS; +use Spline::Netstring; + +use base 'Exporter'; +our @EXPORT = qw( ); +our @EXPORT_OK = qw( + check_exclude + srs_forward + srs_reverse +); + +our $alias = 'spline.inf.fu-berlin.de'; +our @excludes = ( + 'spline.inf.fu-berlin.de', + '.spline.inf.fu-berlin.de', + 'spline.de', + '.spline.de', +); + +my $srs = new Mail::SRS( + Secret => "", + MaxAge => 49, + HashLength => 5, + HashMin => 4, +); + +sub check_exclude($@) { + my $addr = shift; + my @excludes = @_; + + my @parts = split(/@/, $addr); + my $domain = $parts[-1]; + + for my $exclude (@excludes) { + if ($exclude =~ m/^\./) { + return 1 if $domain =~ m/\Q$exclude\E$/; + } + else { + return 1 if $domain eq $exclude; + } + } + + return 0; +} + +sub srs_forward($) { + my $addr = shift; + + return if check_exclude($addr, @excludes); + return $srs->forward($addr, $alias); +} + +sub srs_reverse($) { + my $addr = shift; + return $srs->reverse($addr); +} + +sub handle($$) { + my ($map, $key) = @_; + my $result; + + if ($map eq 'forward') { + $result = srs_forward($key); + } + elsif ($map eq 'reverse') { + $result = srs_reverse($key); + } + else { + return "PERM Invalid request"; + } + + if (!defined($result)) { + return 'NOTFOUND '; + } + else { + return 'OK ' . $result; + } +} + +1; + +# vim: set et ts=4: diff --git a/srs b/srs new file mode 100755 index 0000000..eea1711 --- /dev/null +++ b/srs @@ -0,0 +1,15 @@ +#!/usr/bin/perl -w +use strict; +use warnings; + +use FindBin; +use lib $FindBin::Bin; +use Spline::Socketmap; +use Spline::Srs; + +$Spline::Socketmap::timeout = 10; + +$Spline::Socketmap::handler = sub { + Spline::Srs->handle(@_); +}; +Spline::Socketmap->run(); diff --git a/t/srs.t b/t/srs.t new file mode 100644 index 0000000..824d8e9 --- /dev/null +++ b/t/srs.t @@ -0,0 +1,32 @@ +use strict; +use warnings; + +use Test::More;# tests => 8; + +BEGIN { + use_ok 'Spline::Srs', qw( + check_exclude + srs_forward + srs_reverse + ) or BAIL_OUT; +} + +# Testing ignores +is(check_exclude('test@example.com', 'example.com'), 1, 'Ignore matching domain'); +is(check_exclude('test@example.de', 'example.com'), 0, 'Do not ignore non-matching domain'); +is(check_exclude('test@test.example.com', 'example.com'), 0, 'Do not ignore sub-domain'); +is(check_exclude('test@test.example.com', '.example.com'), 1, 'Ignore sub-domain if requested'); + +# SRS Forward +my $result = srs_forward('alex@example.com'); +isnt($result, undef, 'Not undef'); +like($result, qr/^SRS0[+=-]/, 'SRS0 Prefix'); +like($result, qr/\@spline\.inf\.fu-berlin\.de$/, 'Rewrite to spline-Domain'); + +# SRS Reverse +is(Spline::Srs::srs_forward('alex@domain.invalid'), 'SRS0=7tXNg=SJ=domain.invalid=alex@spline.inf.fu-berlin.de', 'Forward'); +is(Spline::Srs::srs_reverse('SRS0=7tXNg=SJ=domain.invalid=alex@spline.inf.fu-berlin.de'), 'alex@domain.invalid', 'Reverse'); + +done_testing; + +# vim: set et ts=4: -- cgit v1.2.3-1-g7c22