package Spline::Srs;

use strict;
use warnings;

use Mail::SRS;

use base 'Exporter';
our @EXPORT = qw( );
our @EXPORT_OK = qw(
    check_exclude
);

sub new {
    my $class = shift;
    my $opts  = shift;

    my $active_secret;
    if (ref $opts->{secret} eq 'ARRAY') {
        $active_secret = $opts->{secret}->[0];
    }
    else {
        $active_secret = $opts->{secret};
    }

    if (length($active_secret // '') < 20) {
        die 'You need to configure a suitable secret';
    }

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

    my $self = {
        alias => $opts->{alias} // '',
        excludes => $opts->{excludes} // [],
        srsalt_fallback => $opts->{srsalt_fallback} // 0,
        srs => new Mail::SRS(
            Secret          => $opts->{secret} // '',
            MaxAge          => $opts->{max_age} // 49,
            HashLength      => $opts->{hash_length} // 5,
            HashMin         => $opts->{hash_min} // 5,
            IgnoreTimestamp => $opts->{ignore_time} // 0,
        ),
    };
    bless $self, $class;

    return $self;
}

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 forward($) {
    my $self = shift;
    my $addr = shift;

    return $addr if check_exclude($addr, $self->{excludes});
    return $self->{srs}->forward($addr, $self->{alias});
}

sub reverse($) {
    my $self = shift;
    my $addr = shift;

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

        my $err = $@;
        if ($err) {
            die $err unless $err =~ m/Invalid hash/;
            $addr = replace_srsalt_chars($addr);
        }
        else {
            return $result;
        }
    }

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

sub handle($$) {
    my $self = shift;
    my ($map, $key) = @_;
    my $result;

    if ($map eq 'forward') {
        $result = $self->forward($key);
    }
    elsif ($map eq 'reverse') {
        $result = $self->reverse($key);
    }
    elsif ($map eq 'check') {
        eval {
            $self->reverse($key);
        };

        my $err = $@;
        if ($err) {
            if ($err =~ m/(Invalid hash|Invalid timestamp)/) {
                return 'REJECT Invalid SRS';
            }

            return 'DUNNO';
        }
        else {
            return 'OK';
        }
    }
    else {
        die 'Invalid request';
    }

    return $result;
}

1;

# vim: set et ts=4: