package Spline::Srs;

use strict;
use warnings;

use Mail::SRS;

use base 'Exporter';
our @EXPORT = qw( );
our @EXPORT_OK = qw(
    config_set
    config_get
    check_exclude
    srs_forward
    srs_reverse
);

my $config = {
    alias => '',
    excludes => [],
    secret => '',
    max_age => 49,
    hash_length => 5,
    hash_min => 5,
    ignore_time => 0,
    srsalt_fallback => 0,
};

my $srs = undef;

sub config_set($$) {
    my ($key, $value) = @_;
    return unless defined $config->{$key};

    $config->{$key} = $value;
    $srs = undef;
}

sub config_get($) {
    my $key = shift;
    return $config->{$key};
}

sub check_exclude($@) {
    my ($addr, $excludes) = @_;
    return 0 unless ref($excludes) eq 'ARRAY';

    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 replace_srsalt_chars($) {
    my $addr = shift;
    if ($addr =~ m/^(SRS[01][=+-])([^=]+)(=.*)$/) {
        my ($srs, $hash, $rest) = ($1, $2, $3);
        $hash =~ s#_#+#g;
        $hash =~ s#\.#/#g;
        return "$srs$hash$rest";
    }

    return $addr;
}

sub srs_forward($) {
    my $addr = shift;

    return $addr if check_exclude($addr, $config->{excludes});

    check_configured();
    return $srs->forward($addr, $config->{alias});
}

sub srs_reverse($) {
    my $addr = shift;

    check_configured();

    if ($config->{srsalt_fallback}) {
        my $result;
        eval {
            $result = $srs->reverse($addr);
        };

        my $err = $@;
        if ($err) {
            if ($err =~ m/Invalid hash/) {
                my $fallback = replace_srsalt_chars($addr);
                return $srs->reverse($fallback);
            }

            die $err;
        }

        return $result;
    }

    return $srs->reverse($addr);
}

sub check_configured() {
    return if defined $srs;

    if (length($config->{secret}) < 20) {
        die 'You need to configure a suitable secret';
    }

    if (!$config->{alias}) {
        die 'You need to configure an alias domain';
    }

    $srs = new Mail::SRS(
        Secret          => $config->{secret},
        MaxAge          => $config->{max_age},
        HashLength      => $config->{hash_length},
        HashMin         => $config->{hash_min},
        IgnoreTimestamp => $config->{ignore_time},
    );
}

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: