#!/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-auth/clients/bennoweb.yml';
my $conf;
eval {
    $conf= YAML::Tiny->read($configfile)->[0]->{rest};
};
if ($@) {
    print STDERR "[0:OAUTH2/userinfo] $@\n";
    exit 2;
}
my $DEBUG = $conf->{debug} || $ENV{DEBUG};
$conf->{DEBUG}    = $DEBUG;
$CGI::Simple::DEBUG = $DEBUG;
$CGI::Simple::POST_MAX = 1_048_576;     # 1 MB
$CGI::Simple::DISABLE_UPLOADS = 0;

my $multival_config = $conf->{multival_params} || 'ARCHIVE,FILTER,MAIL,NOTE,ROLE'; 
my @multival_params = $multival_config =~ /[^\s,]+/g;
$conf->{multival} = \@multival_params;

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

my  $c_bearer  = $conf->{'bearer-token'};
my ($r_bearer) = (split /\s+/, $q->http('Authorization'),2)[1]
                        or print STDERR "[0:OAUTH2/userinfo] ERROR Bearer token not set!\n";


# Check request
my $http_code = ($q->request_method ne 'POST')     ? '405 Method not allowed'
              : ($c_bearer          ne $r_bearer)  ? '403 Forbidden'
              : '200 OK'
              ;

if ($http_code !~ /^200 OK$/) {
    print $q->header('text/html',$http_code);
    exit;
}

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

my $JR = JResponse->new($conf);

my $OData;
eval {
    $OData = OAuth2Data->new($r_data);
};
if ($@) {
    print STDERR '[0:OAUTH2/userinfo] ERROR: '.$@."\n";
    print $q->header('text/html',$http_code);
    $JR->set_status('error',$@);
    print $JR->response;
    exit;
}

# last parameter overwrites
$JR->add_param('ROLE'       ,'USER');

$JR->add_param('DISPLAYNAME',$OData->get_displayname);
$JR->add_param('MAIL',       $OData->get_mail);
$JR->add_param('USERID',     $OData->get_userid);

my $Mapping = new Mapping($conf);

# set container
eval {
    foreach my $cnt ($Mapping->get_retlines($conf->{tenantMap},$OData->get_tenantid)) {
        print STDERR '[4:OAUTH2/userinfo] Read tenant mapping: '.$conf->{tenantMap}."\n" if $DEBUG >= 4;
        $JR->add_param('ARCHIVE',$cnt);
    }
};
if ($@) {
    print STDERR '[0:OAUTH2/userinfo] ERROR: '.$@."\n";
    print $q->header('text/html',$http_code);
    $JR->set_status('error',$@);
    print $JR->response;
    exit;
}

# add additional data for user
eval {
    my $userid = $OData->get_userid;
    foreach my $mapline ($Mapping->get_retlines($conf->{userExtend},$userid)) {
        print STDERR "[4:OAUTH2/userinfo] Read additional data for $userid\n" if $DEBUG >= 4;
        my ($param,$value) = split /\s/, $mapline;
        print STDERR "[4:OAUTH2/userinfo]   >> \"$param $value\"\n" if $DEBUG >= 4;
        $JR->add_param($param,$value);
    }
};

$JR->set_status('success');

print $q->header('text/html',$http_code);
print STDERR '[3:OAUTH2/userinfo] JSON return: '.$JR->response."\n" if ($DEBUG >= 3);
print $JR->response;

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


# call external script for mappings
package Mapping;
use IPC::Open3;

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

    my $self = {
        debug  => $conf->{debug},
    };
    bless $self, $class;

    return $self;
}


sub get_retlines
{
    my ($self,$mapfile,$pname) = @_;

    print STDERR '[1:OAUTH2/userinfo] Read mappings for: '.$pname."\n" if ($DEBUG >= 1);
    my($wtr, $rdr, $err);
    use Symbol 'gensym'; $err = gensym;
    my $pid = open3($wtr, $rdr, $err, $mapfile);
    print $wtr $pname;
    close $wtr;
    waitpid( $pid, 0 );
    my $child_exit_status = $? >> 8;

    my @err = <$err>;
    foreach my $line (@err) {
        chomp $line;
        print STDERR "ERROR tenantMap: $line\n";
    }

    my @retlines = <$rdr>;
    chomp @retlines;

    return @retlines;
}


### EOP ###
1;



package JResponse;
use JSON;

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

    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 OAuth2Data;
use JSON;
use MIME::Base64;

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

    my $self = {};
    bless $self, $class;

    my $JSON = JSON->new->allow_nonref;
    my $djson = $JSON->decode($data);
    $self->{user}       = $djson->{user};
    $self->{password}   = $djson->{password};
    $self->{type}       = $djson->{type};
    $self->{additional_user_infos} = $djson->{additional_user_infos};

    $self->{id}  = {};
    if ($self->{type} eq 'metadata') {      # Azure data with id token
        my $jtoken = decode_base64($djson->{external_oidc_token});
        my ($jheader,$jpayload,$signature) = split /\}/, $jtoken;
        $jheader  .= '}';
        $jpayload .= '}';

        my $JSON = JSON->new->allow_nonref;

        my ($header,$payload);
        eval {
            $header = $JSON->decode($jheader);
        };
        if ($@) {
            print STDERR "[0:OAUTH2/userinfo] ERROR Cannot decode external_oidc_token header: $jheader\n";
            die "Cannot decode external_oidc_token header\n"
        }
        eval {
            $self->{external_oidc_token} = $JSON->decode($jpayload);
        };
        if ($@) {
            print STDERR "[0:OAUTH2/userinfo] ERROR Cannot decode external_oidc_token payload: $jpayload\n";
            die "Cannot decode external_oidc_token payload\n"
        }
    }

    return $self;
}


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

    return $self->{external_oidc_token}->{tid};
}


sub get_displayname
{
    my ($self) = @_;
    $self->{additional_user_infos}->{displayName} && return $self->{additional_user_infos}->{displayName};
    $self->{external_oidc_token}->{name}          && return $self->{external_oidc_token}->{name};
    return $self->{user};
}


sub get_mail
{
    my ($self) = @_;
    my @addresses;
    foreach my $addr(@{$self->{additional_user_infos}->{proxyAddresses}}) {
        # "SMTP:prefix@domain
        # strip MS Exchange smtp: prefix
        $addr =~ s/^smtp:\s*//i or next;
        push @addresses, lc($addr);
    }
    foreach my $addr(@{$self->{additional_user_infos}->{otherMails}}) {
        # "SMTP:prefix@domain
        # strip MS Exchange smtp: prefix
        $addr =~ s/^smtp:\s*//i;
        $addr =~ s/\w//g;   # remove whitespaces
        push @addresses, lc($addr);
    }

    push @addresses, lc($self->{external_oidc_token}->{mail});
    push @addresses, lc($self->{user});

    return \@addresses;
}


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

    $self->{additional_user_infos}->{userPrincipalName} && return $self->{additional_user_infos}->{userPrincipalName};
    $self->{additional_user_infos}->{user}              && return $self->{additional_user_infos}->{user};
    $self->{external_oidc_token}->{preferred_username}  && return $self->{external_oidc_token}->{preferred_username};
    return $self->{user};
}


### EOP ###
1;

