#!/usr/bin/perl
#
# AUTHPROTOCOL: STDIN
#
use strict;
use Getopt::Std;

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

my $noauth = 0;
if ($ENV{REQUEST_TYPE} eq 'metadata') {
    $noauth = 1;
}

if ($ENV{AUTHOK} &! $noauth) {
    print STDERR "Already authenticated, skip $0\n" if $ENV{DEBUG};
    exit 0;
}

print STDERR "Give <username> <password>:\n" if ! -p STDIN;

my $firstline  = <STDIN>;
my $secondline = <STDIN>;
chomp $firstline;
chomp $secondline;

my ($uid,$pass);
if (!$secondline) {
    # AUTHPROTO: STDIN
    ($uid,$pass) = split /\s+/,$firstline,2;
}
else {
    # AUTHPROTO: STDIN2
    $uid = $firstline;
    $pass = $secondline;
}

$opts{'h'} && help_exit();
my $configfile  = $ENV{CONFIG}  || $opts{'c'} || '/etc/benno-web/ldapauth.conf';
my $verbose     = $ENV{VERBOSE} || $opts{'v'};
my $DEBUG       = $ENV{DEBUG};  # LDAP DEBUG LEVEL

if (!$pass &! $noauth) {
    print "ERROR ERR_NOPASS\n";
    print STDERR "Aufruf: $0 <username> <passwort>\n";
    exit 1;
}

print STDERR "Read config: $configfile\n" if $verbose;
my $config = read_config($configfile);
if (!$config->{host}) { # early exit
    print "NOTE LDAP host not configured. Exit.\n";
    exit 0;
}

# attributes to fetch from ldap
$config->{attributes} = [ 'cn', 'whenCreated', 'memberOf',
                           get_list($config->{email}), get_list($config->{alias}),
                           $config->{role}, $config->{container},
                        ];

if ($config->{remove_domainsuffix} eq 'true') {
    $uid =~ s/\@.+$//;
}

my $LDAP;
if ($config->{usersuffix} and not $config->{userfilter}) {
    # search not necessary, thus overwrite settings with current user data
    $config->{binddn}   = "$config->{userattr}=$uid,$config->{usersuffix}";
    $config->{password} = $pass;
}
if (!$config->{binddn}) {
    print STDERR "Try anonymous bind to LDAP server.\n" if $verbose;
}
else {
    print STDERR "Connect to $config->{host} with: $config->{binddn}\n" if $verbose;
}
$LDAP = LWs::LDAP->new($config);

my $ret;
my $UserEntry = $LDAP->get_user($uid,$config->{userfilter});
if ($UserEntry) {
    if ($noauth) {
        $ret = 'OK REQUEST_TYPE='.$ENV{REQUEST_TYPE};
    }
    else {
        my $dn = $UserEntry->dn();
        print STDERR "Bind LDAP as: $dn\n" if $verbose;
        $ret = $LDAP->user_auth($dn,$pass);
    }
}
else {
    print "ERROR ERR_NOUSER\n";
    exit;
}

if ($ret !~ /^OK/) {
    print "ERROR ERR_AUTH\n";
    exit;
}
my @addresses;
foreach my $mailattr (get_list($config->{email})) {
    foreach my $addr ($UserEntry->get_value($mailattr)) {
        push @addresses, get_list($addr);
    }
}
foreach my $aliasattr (get_list($config->{alias})) {
    foreach my $addr ($UserEntry->get_value($aliasattr)) {
        push @addresses, get_list($addr);
    }
}
push @addresses, get_list($config->{addemail});

@addresses = format_addresslist(@addresses);

my $filter = get_before_created($config,$UserEntry);

my $role = uc $UserEntry->get_value($config->{role}) || 'USER';

# overwrite role of admin user
foreach my $groupdn ($UserEntry->get_value('memberOf')) {
    if (lc($groupdn) eq lc($config->{admingroupdn})) {
        $role = 'ADMIN';
    }
}

# overwrite role of admin user
foreach my $adminid (get_list($config->{adminuser})) {
    if (lc($uid) eq lc($adminid)) {
        $role = 'ADMIN';
    }
}

if ($role eq 'ADMIN') {
    my @adminaddresses = get_list($config->{adminaddress});
    if (@adminaddresses) {
        foreach my $adminfilter (@adminaddresses) {
            next unless $adminfilter;
            push @addresses, $adminfilter;
        }
    }
    else {
        push @addresses, '*@*';
    }
    undef $filter;
}

# overwrite role of revisor user
foreach my $revisorid (get_list($config->{revisoruser})) {
    if (lc($uid) eq lc($revisorid)) {
        $role = 'REVISOR';
    }
}

if ($role eq 'REVISOR') {
    push @addresses, '*@*';
    undef $filter;
}

my @containers;
unless(@containers = $UserEntry->get_value($config->{container})) {
    @containers = get_list($config->{default_container}) or 'BennoContainer';
}

print "ROLE $role\n";
print 'DISPLAYNAME '.$UserEntry->get_value('cn')."\n";

foreach my $address (@addresses) {
    print "MAIL $address\n";
}
foreach my $container (@containers) {
    print "ARCHIVE $container\n";
}
print "FILTER $filter\n" if $filter;
print "AUTH OK\n";


### SUBS #######################################################################
sub help_exit
{
    print "Usage: $0 [-h] [-v] [-c <configfile>]\n";
    print "\n";
    print "  -c <configfile>    Configfile (default /etc/benno-web/ldapauth.conf)\n";
    print "  -v                 Verbose output\n";
    print "  -h                 This help\n";

    exit;
}


# read_config
sub read_config
{
  my $configfile = shift;
  my $config = {
      userattr              => 'uid',
      objectclass           => 'posixAccount',
      tls                   => 'false',
      email                 => 'mail',
      alias                 => 'emailAlias',
      addemail              => 'bennoEmailAddress',
      role                  => 'bennoRole',
      container             => 'bennoContainer',
      default_container     => 'BennoContainer',
      adminuser             => 'benno',
      remove_domainsuffix   => 'false',
      user_create_filter    => 'false',
    };
  # _very_ simple config file parser
  #
  # Config format:   var = val
  #
  open CONF, "$configfile" or die "Cannot open config file $configfile. $!\n";
  foreach my $line (<CONF>) {
      next if $line =~ /^$/;
      next if $line =~ /^#/;
      chomp $line;
      my ($var,$val) = split(/=/, $line,2);
      # strip ws
      $var =~ s/\s//g;
      $val =~ s/^\s+//g;
      $val =~ s/\s+$//g;

      if ($val =~ /^\</) {  # read file content
        $val = _file_value($val);
      }

      $config->{$var} = $val;
  }
  close CONF;
  return $config;
}


# read config value from file
sub _file_value
{
    my ($configval) = @_;
    my $retval;

    (my $file = $configval) =~ s/^\<//;
    eval {
        local $/;
        open(my $fh, '<', $file) or die "Cannot read $file: $!\n";
        $retval = <$fh>;
        close($fh);
    };
    if ($@) {
        print "NOTE $@";
        return $configval;
    }
    chomp $retval;
    return $retval;
}

# get_list
sub get_list
{
    my ($entry) = @_;

    #return split /,(\s+)?/,$entry;
    return $entry =~ /[^,\s]+/g;
}


# format_addresslist
sub format_addresslist
{
    my @addresslist = @_;

    my $address;
    my %return_addresses;

    foreach my $token (@addresslist) {
        # strip MS Exchange smtp: prefix
        $token =~ s/^smtp:\s*//i;
        $token =~ s/\s//g;  # FS#1004
        # extract plain address
        #                        (emailprefix|<empty>)@domain
        ($address) = $token =~ /(([a-zA-Z0-9_\*\.+-]+|)\@[a-zA-Z0-9-\*\.]+)/;
        next if $address eq '';

        # delete duplicates
        $return_addresses{$address} = 1;
    }
    # delete duplicates
    return (sort keys %return_addresses);
}


sub get_before_created
{
    my ($config,$UserEntry) = @_;
    return undef if ($config->{filter_before_created} ne 'true');

    my $filter = 'NOT SortableDate:[197001010000 TO ###ENTRYDATE###]';
    my $created = $UserEntry->get_value('whenCreated');
    my ($entrytime) = $created =~ /^(\d{8})/;
    $filter =~ s/###ENTRYDATE###/${entrytime}000000/;

    return 'StartDate:'.$entrytime.' '.$filter 
}


### EOP ###
1;
################################################################################
package LWs::LDAP;

use Net::LDAP;
use Carp;


=head1 NAME

LDAP

=head1 SYNOPSIS

    use C<LWS::LDAP>;

=head1 DESCRIPTION

=head1 METHODS

=head2 new($config)

Create new LWs::LDAP object and bind to ldap directory.

Throws exception if failed.

=cut
sub new
{
    my $this = shift;
    my $class = ref($this) || $this;
    my ($config) = shift;

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

    $self->{host}     = $config->{host}     || 'localhost';
    $self->{basedn}   = $config->{basedn}   || 'dc=site';
    $self->{binddn}   = $config->{binddn};
    $self->{password} = $config->{password};
    $self->{userattr} = $config->{userattr} || 'uid';
    $self->{objectclass} = $config->{objectclass} || 'posixAccount';
    $self->{attributes} = $config->{attributes};

    $self->_connect_ldap($config);

    return $self;
}


# connect_ldap
sub _connect_ldap
{
    my $self = shift;
    my ($config) = shift;

    my @hosts = $self->_get_hostlist();

    my $LDAP;
    foreach my $ldapstr (@hosts) {
        next unless $ldapstr;
        $DEBUG && print "Try to connect $ldapstr\n";
        my ($ldaphost,$ldapport) = split /:/, $ldapstr;
        eval {
            if ($config->{tls} eq 'ldaps') {
                $ldapport = 636 unless $ldapport;
                $LDAP = Net::LDAP->new('ldaps://'.$ldaphost, port => $ldapport,
                                       verify => 'none') or die "$@\n";
            }
            else {
                $ldapport = 389 unless $ldapport;
                $LDAP = Net::LDAP->new($ldaphost,
                                       port => $ldapport) or die "$@\n";
            }
        };
        last if $LDAP;
    }
    if ($@) {
        die "ERROR connect LDAP host: $@";
    }

    $DEBUG && $LDAP->debug($DEBUG);

    my $mesg;
    if ($config->{tls} eq 'true') {
        $mesg = $LDAP->start_tls(verify => 'none');
        $mesg->code and exit 1;
    }

    if ($self->{binddn}) {
        $mesg = $LDAP->bind($self->{binddn},'password' => $self->{password});
    }
    else {
        $mesg = $LDAP->bind();      # anonymous bind
    }
    $mesg->code and die $mesg->error;
    $self->{_LDAP} = $LDAP;
}

# _get_hostlist
sub _get_hostlist
{
    return split /,(\s+)?/,$_[0]->{host};
}



# get_user($userid)
#
# returns a Net::LDAP::Entry object of the user
sub get_user
{
    my $self = shift;
    my $userid = shift;
    my $userfilter = shift;

    my $filter;
    if ($userfilter) {
        $filter = $userfilter;
    }
    else {
        $filter = "(&(objectClass=$self->{objectclass})($self->{userattr}=%s))";
    }

    my ($localpart,$domainpart) = $userid =~ /^(.+)\@(.+)$/;
    $filter =~ s/%u/$localpart/g;
    $filter =~ s/%d/$domainpart/g;
    $filter =~ s/%s/$userid/g;
    print "LDAP Search: \"$filter\"\n" if $verbose;
    my $mesg = $self->{_LDAP}->search( base   => $self->{basedn},
                                       attrs  => $self->{attributes},
                                       filter => $filter
                                     );
    if ($mesg->code) {
        print STDERR "Error search \"$filter\": ",$mesg->error,".\n" if $DEBUG;
    }

    if ($mesg->count < 1) {
        print STDERR "No match for \"$filter\" in directory.\n" if $DEBUG;
    }

    if ($mesg->count > 1) {
        die "Userid not unique at ldap directory.\n" if $DEBUG;
    }
    return $mesg->entry(0);
}

# user_auth($userdn,$userpass)
#
#
sub user_auth
{
    my $self = shift;
    my ($userdn,$userpass) = @_;
    my $mesg = $self->{_LDAP}->bind($userdn,'password' => $userpass);
    if ($mesg->code) {
        return 'ERROR AUTHENTICATION ERROR';
    }

    return 'OK';
}

### EOP ###
1;
