#!/usr/bin/perl
#
#
use strict;

my $r_data = '';
read(STDIN, $r_data, $ENV{'CONTENT_LENGTH'});

use Getopt::Std;
use MIME::Base64;
use CGI::Simple;
use YAML::Tiny;


our(%opts);
getopts('hjc:', \%opts);

my $configfile  = $opts{'c'} || '/etc/benno-import-rest/auth-storage.yml';
my $config;
eval {
    $config= YAML::Tiny->read($configfile)->[0]->{auth};
};
if ($@) {
    print STDERR "[0:RESTIMPORT] $@\n";
    exit 2;
}
my $DEBUG = $config->{debug} || $ENV{DEBUG};
$config->{DEBUG}    = $DEBUG;
$CGI::Simple::DEBUG = $DEBUG;
$CGI::Simple::POST_MAX = -1;     # infinity
$CGI::Simple::DISABLE_UPLOADS = 0;

my $q = CGI::Simple->new;
$q->charset('UTF-8');
my $r_method = $q->request_method;

my $authstring = (split /\s/, $q->http('Authorization'))[1];
my ($r_user,$r_pass) = split /:/, MIME::Base64::decode($authstring),2;


if ($DEBUG >= 3) {
    print STDERR "[4:RESTIMPORT] input_data: $r_data\n";
}

# JResponse multival attributes
$config->{multival} = ['STORAGEURL','CONTAINER'];
$config->{r_type}   = 'storageurl';
$config->{r_user}   = $r_user;
$config->{r_pass}   = $r_pass;

my $BennoAuth = BennoAuth->new($config);
$BennoAuth->call_modules;

my $JR = JResponse->new();
$JR->set_status($BennoAuth->statusinfo);
$JR->add_param('STORAGEURLS', $BennoAuth->get_storageurl);

# Check request
my $http_code = ($r_method ne 'GET')            ? '405 Method not allowed'
              : $BennoAuth->authok == 0         ? '401 Unauthorized'
              : '200 OK'
              ;


if ($http_code =~ /^401 Unauthorized$/) {
    print "WWW-Authenticate: Basic realm=\"Password Required\"\r\n";
    print $q->header('text/html',$http_code);
    exit;
}
elsif ($http_code !~ /^200 OK$/) {
    print $q->header('text/html',$http_code);
    exit;
}
else {
    print $q->header('text/html',$http_code);
    print STDERR '[3:RESTIMPORT] JSON return: '.$JR->response."\n" if ($DEBUG >= 3);
    print $JR->response;
}

### SUBs ###
### EOP ###
1;

package JResponse;
use JSON;

sub new {
    my $class = shift;
    my ($conf) = @_;

    my $self = {
        status   => 'fail',
        multival => $conf->{multival},
    };
    $self->{param}->{info} = 'LOGIN NOT ALLOWED';
    bless $self, $class;

    return $self;
}


sub response
{
    my $self = shift;
    my $response = {
        status => $self->{status},
    };

    my $r_data = {};
    foreach my $param (keys %{$self->{param}}) {
        my $value = $self->{param}->{$param};
        next if $value eq 'NOTE';
        next if $value eq 'AUTHPARAM';
        $r_data->{$param} = $self->{param}->{$param};
    }
 
    $response->{data}  = $r_data;

    return JSON->new->allow_nonref->encode($response);
}


# add multiple value and uniquize
sub add_param
{
    my ($self,$param,$value) = @_;

    return unless $value;

    $param = lc($param);
    # multivalue but single occurance
    if (grep(/^$param$/i, @{$self->{multival}})) {
        if (ref $value) {
            push @{$self->{param}->{$param}}, @{$value};
        }
        else {
            push @{$self->{param}->{$param}}, $value;
        }
        my $uniques = $self->_unique($self->{param}->{$param});
        $self->{param}->{$param} = $uniques;
    }
    else {
        $self->{param}->{$param} = $value;
    }
}


sub set_status
{
    my ($self,$status,$info) = @_;
    if ($status) {
        $self->{status} = $status;
    }
    $self->{param}->{info} = $info if $info;
}


sub _unique
{
    my ($self,$listref) = @_;

    my @return = do { my %seen; grep { !$seen{$_}++ } @${listref}};
    @return = grep $_, @return;
    return \@return;
}


### EOP ###
1;


package BennoAuth;
use IPC::Open3;

sub new {
    my $class = shift;
    my ($conf) = @_;

    my $self = {
        module_dir          => $conf->{moduleDir}    || '/etc/benno-web/auth.d',
        module_config       => $conf->{module_config},
        r_type              => $conf->{r_type},
        r_user              => $conf->{r_user},
        r_pass              => $conf->{r_pass},
        param               => {},
        status              => '',               # success || fail || error
        info                => '',               # status info
        multival            => $conf->{multival},
        DEBUG               => $conf->{DEBUG},
        
    };
    bless $self, $class;

    return $self;
}


sub environment
{
    my ($self) = @_;

    $ENV{module_dir}   = $self->{module_dir};
    $ENV{AUTHLINES}    = '';
    $ENV{AUTHOK}       = '';
    $ENV{REQUEST_TYPE} = $self->{r_type};

    my $role_set = 0;

    foreach my $configvar (keys %{$self->{module_config}}) {
        $ENV{$configvar} = $self->{module_config}->{$configvar};
    }

}


sub call_modules
{
    my ($self) = @_;

    $self->environment();
    my $m_count    = 0;
    my $module_dir = $self->{module_dir};
    my (@retlines,@errlines);

    my $password = $self->{r_pass};


    opendir my $dh, $module_dir or die "[0:RESTIMPORT] Cannot read $module_dir/: $!";
    print STDERR "[2:RESTIMPORT] Call modules in $module_dir\n" if $self->{DEBUG} >= 2;


    foreach my $filename (sort readdir($dh)) {
        next if $filename =~ /^\./;
        next if $filename =~ /\.dpkg/;

        my $module = $module_dir.'/'.$filename;
        next if not -f $module;

        my ($authstring,$modulename);
        next unless -x $module;
        $m_count++;
        print STDERR "[3:RESTIMPORT] Execute $filename\n" if $self->{DEBUG} >= 3;
        $authstring = $self->{r_user}."\n".$password;

        my($wtr, $rdr, $err);
        use Symbol 'gensym'; $err = gensym;
        my $pid = open3($wtr, $rdr, $err, $module);
        print $wtr $authstring;
        close $wtr;
        waitpid( $pid, 0 );
        my $child_exit_status = $? >> 8;

        my @err = <$err>;
        foreach my $line (@err) {
            chomp $line; chomp $line;
            push @errlines, "$filename: $line";
        }

        my @retlines = <$rdr>;
        $self->module_return($filename,@retlines);
    }
    if (!$m_count) {
        die "[2:RESTIMPORT] No auth module enabled\n";
    }

    foreach my $errline (@errlines) {
        next if $errline =~ /ERR_NOUSER/;
        print STDERR "[1:RESTIMPORT] AUTH ERROR: $errline\n";
    }

}


sub module_return
{
    my ($self,$filename,@lines) = @_;
    my $authlines;

    foreach my $line (@lines) {
        $line =~ s/\R$//;
        print STDERR "[4:RESTIMPORT] >> $line\n" if $self->{DEBUG} >= 4;

        if ($line =~ /^ERR/) {
            if ($line =~ /^ERROR ERR_AUTH/) {   # user exists in auth backend(s)
                $self->{info} = "AUTH EXISTS from $filename";
            }
            next;               # no logging of auth error 
        }
        if ($line =~ /^AUTH\sALLOW/) {
            $self->{status} = 'success';
            $self->{info}   = "AUTH ALLOW from $filename";
            next;
        }
        if ($line =~ /^AUTH\sBREAK/) {
            my $msg = "AUTH BREAK from $filename\n";
            $self->{status} = 'fail';
            $self->{info}   = $msg;
            print STDERR "[1:RESTIMPORT] WARN $msg\n" if $self->{DEBUG} >= 1;
            last;
        }
        if ($line =~ /^AUTH\s+OK/) {
            $ENV{AUTHOK}    = 1;
            $self->{status} = 'success';
            $self->{info}   = "AUTH OK from $filename";
            next;
        }

        if ($line =~ /^ARCHIVE\s+(\S.*)$/) {
            $self->add_param('CONTAINER',$1);
        }

        my ($p,$v) = split /\s+/,$line,2;
        $self->add_param($p,$v);
        $ENV{AUTHLINES} .= $line."\n";
    }
}


sub add_param
{
    my ($self,$param,$value) = @_; 
    $param = lc($param);

    if (grep( /^$param$/i, @{$self->{multival}})) {
        push @{$self->{param}->{$param}}, $value;
    }
    else {
        $self->{param}->{$param} = $value;
    }
}


sub statusinfo {
    return ($_[0]->{status},$_[0]->{info});
}


sub authok {
    if ($_[0]->{status} eq 'success') {
        return 1;
    }
    return 0;
}


sub get_storageurl
{
    my ($self) = @_;
    my $storageurls     = {};
    my $containerset    = {};   # lookup table: containers in container-storage.list
    my $containerurlset = {};   # lookup table: storageurls . containers set

    foreach my $entry (@{$self->{param}->{storageurl}}) {
        my ($container,$url) = $entry =~ /^(.+?)\s+((file|https?).+)$/i;
        unless ($containerurlset->{$container.$url}) {
            push @{$storageurls->{$url}}, $container;
            $containerurlset->{$container.$url} = 1;
        }
        $containerset->{$container} = 1;
    }

    # set default for containers not in container-storage.list
    my $defaulturl = 'file:///srv/benno/inbox';
    foreach my $container (@{$self->{param}->{container}}) {
        unless ($containerset->{$container}) {
            push @{$storageurls->{$defaulturl}}, $container;
        }
    }

    return $storageurls;
}


our $AUTOLOAD;
sub AUTOLOAD {
    my ($self) = @_;

    # Remove qualifier from original method name...
    my $called = $AUTOLOAD =~ s/.*:://r;

    # getter methods
    my ($param) = $called   =~ /^get_(\S+)/;
    $param = lc($param);

    return $self->{param}->{$param};
}


#
# vim: set filetype=perl:
#
