#!/usr/bin/perl
# Module for TWiki Collaboration Platform, http://TWiki.org/
#
# Copyright (C) 2014 Terje Andersen for CERN and
# Copyright (C) 2014-2021 Peter Thoeny & TWiki Contributors
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 3
# of the License, or (at your option) any later version. For
# more details read LICENSE in the root of this distribution.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See
# GNU General Public License for more details, published at
# http://www.gnu.org/copyleft/gpl.html

BEGIN {
    unshift @INC, '.';
    require 'setlib.cfg';
}

use strict;
use warnings;

use TWiki;
use TWiki::Func;
use TWiki::Contrib::LdapContrib;

our @EXPORT_OK = qw(runTests);
our ($ldap, %keysLookedAt);
our $verbose = 1;

my $twiki = new TWiki('admin');
my $session = $TWiki::Plugins::SESSION;
$ldap = TWiki::Contrib::LdapContrib::getLdapContrib($session);

#
# Running tests
# Usage:
# cd /../bin
# perl ../tools/ldapdbtests
#
#

print "Test 1: Checking that each WikiUser maps to only one LoginName:\n" if $verbose;
exit 1 unless &duplicatesCheck('WikiUser','LoginName','U2W');

print "Test 2: Checking that each LoginName maps to only one WikiUser:\n" if $verbose;
exit 1 unless &duplicatesCheck('LoginName','WikiUser','W2U');

print "Test 3: Given U2W::\$loginName = \$wikiName, and W2U::\$wikiName = \$reverseLoginName, check that \$loginName eq \$reverseLoginName:\n" if $verbose;
exit 1 unless &pointerCheck('U2W','W2U');

print "Test 4: Given U2DN::\$loginName = \$dn, and DN2U::\$dn = \$reverseLoginName, check that \$loginName eq \$reverseLoginName:\n" if $verbose;
exit 1 unless &pointerCheck('U2DN','DN2U');

print "Test 5: Checking that each LoginName in LOGINNAMES has an U2W entry, and vice versa\n" if $verbose;
exit 1 unless &consistencyCheck("LoginName","LOGINNAMES","U2W");

print "Test 6: Checking that each WikiName in WIKINAMES has an W2U entry, and vice versa\n" if $verbose;
exit 1 unless &consistencyCheck("WikiName","WIKINAMES","W2U");

print "Test 7: Checking that each group in GROUPS has an GROUP entry, and vice versa\n" if $verbose;
exit 1 unless &consistencyCheck("group","GROUPS","GROUPS");

print "Test 8: If we find a \$loginName in U2CREATED, U2UPDATED or U2EMAILS, control that the \$loginName is present in U2W and in LOGINNAMES:\n" if $verbose;
exit 1 unless &userCheck();

print "Test 9: Test that each \$timestamp found in U2CREATED::\$user = \$timestamp and U2UPDATE::\$user = \$timestamp is valid:\n" if $verbose;
exit 1 unless &timestampCheck();

print "Test 10: Testing for unknown keys in cache:\n" if $verbose;
exit 1 unless &validKeysCheck();

#
# Tests finished
#

sub userCheck {
  my $u2createdCounter = 0;
  my $u2updatedCounter = 0;
  my $u2emailCounter = 0;

  my $status = 1;
  $ldap->getCacheTie('read');
  my $data = $ldap->{data};

  my %loginNames = map { $_ => 1 } split (/\s*,\s*/, $data->{LOGINNAMES});
  for my $key (keys %$data) {
    if ($key =~ m/U2(CREATED|UPDATED|EMAIL)::(.+)/) {
      $keysLookedAt{$key} = 1;

      $u2createdCounter++ if $1 eq 'CREATED';
      $u2updatedCounter++ if $1 eq 'UPDATED';
      $u2emailCounter++ if $1 eq 'EMAIL';

      my $loginName = $2;

      unless (defined $loginNames{$loginName}) {
        printf "  ERROR: LoginName $loginName from key $key does not exist in LOGINNAMES\n";
        $status = 0;
        last;
      }

      unless (defined $data->{"U2W::$loginName"}) {
        printf "  ERROR: LoginName $loginName from key $key does not exist in U2W::$loginName\n";
        $status = 0;
        last;
      }
    }
  }
  $ldap->untieCache();

  printf "  login names found in %d U2CREATED, %d U2UPDATED and %d U2EMAIL entries. Every login name was found in U2W and Loginnames. No errors found.\n\n",
    $u2createdCounter, $u2updatedCounter, $u2emailCounter if $verbose && $status;

  return $status unless $status;
}

sub timestampCheck {
  my $u2createdCounter = 0;
  my $u2updatedCounter = 0;
  my $status = 1;

  $ldap->getCacheTie('read');
  my $data = $ldap->{data};
  while (my ($key, $val) = each %$data) {
    if ($key =~ m/U2(CREATED|UPDATED)::(.+)/) {
      $keysLookedAt{$key} = 1;
      $u2createdCounter++ if $1 eq 'CREATED';
      $u2updatedCounter++ if $1 eq 'UPDATED';
      my $loginName = $2;
      my $timestamp = 2;

      unless ($timestamp =~ m/\A\d+\z/) {
        printf "  ERROR: Timestamp $timestamp found from $key is not a number";
        $status = 0;
        last;
      }
    }
  }
  $ldap->untieCache();
  printf "  %d U2CREATED and %d U2UPDATED entries tested , No errors found.\n\n", $u2createdCounter, $u2updatedCounter if $verbose && $status;
  return $status unless $status;
}

sub validKeysCheck {
  my @validKeys = ('WIKINAMES','LOGINNAMES','GROUPS','UNKWNUSERS','UNKWNGROUPS','GROUPS','GROUP2UNCACHEDMEMBERSDN','EMAIL2U','U2EMAIL','U2W','W2U','DN2U','U2DN','U2CREATED','U2UPDATED','LASTUPDATED');
  printf "  Valid keys (%d): @validKeys\n", scalar(@validKeys) if $verbose;
  my $countedKeys = 0;
  my $status = 1;

  $ldap->getCacheTie('read');
  my $data = $ldap->{data};
  while (my ($key, $val) = each %$data) {
    $countedKeys++;
    my $hit = 0;
    for my $validKey (@validKeys) {
      $hit = 1 if $key =~ m/\A$validKey/;
    }

    unless ($hit) {
      print  "  ERROR: key $key is not in the \@validKeys list!\n";
      $status = 0;
      last;
    }
  }
  $ldap->untieCache();
  print "  $countedKeys keys tested, No errors found.\n\n" if $verbose && $status;
  return $status unless $status;
}

sub pointerCheck {
  my ($key1, $key2) = @_;
  for my $arg ($key1, $key2) {
    exit 1 unless $arg;
  }

  my $key1Counter = 0;
  $ldap->getCacheTie('read');
  my $data = $ldap->{data};
  my $status = 1;
  while (my ($key, $val) = each %$data) {
    if ($key =~ m/${key1}::(.+)/) {
      $keysLookedAt{$key} = 1;
      $key1Counter++;
      my $key1Attr = $1;
      my $key1Val = $val;

      unless (defined $key1Val) {
        print "  ERROR: ${key1}::$key1Attr maps to an undefined value!\n";
        $status = 0;
        last;
      }

      my $reverseValue = $data->{"${key2}::$key1Val"};

      unless (defined $reverseValue) {
        print "  ERROR: ${key1}::$key1Attr = $key1Val, but ${key2}::$key1Val does not exist!\n";
        $status = 0;
        last;
      }

      if ($key1Attr ne $reverseValue) {
        print "  ERROR: ${key1}::$key1Attr maps to $key1Val, but ${key2}::$key1Val maps to $reverseValue!\n"; 
        $status = 0;
        last;
      }
    }
  }

  my $key2Counter = 0;
  while (my ($key, $val) = each %$data) {

    if ($key =~ m/${key2}::(.+)/) {
      $keysLookedAt{$key} = 1;
      $key2Counter++;
      my $key2Attr = $1;
      my $key2Val = $val;

      unless (defined $key2Val) {
        print "  ERROR: ${key2}::$key2Attr maps to an undefined value!\n";
        $status = 0;
        last;
      }

      my $reverseValue = $data->{"${key1}::$key2Val"};

      unless (defined $reverseValue) {
        print "  ERROR: ${key2}::$key2Attr = $key2Val, but ${key1}::$key2Val does not exist!\n";
        $status = 0;
        last;
      }

      if ($key2Attr ne $reverseValue) {
        print "  ERROR: ${key2}::$key2Attr maps to $key2Val, but ${key1}::$key2Val maps to $reverseValue!\n";
        $status = 0;
        last;
      }
    }

  }
  $ldap->untieCache();

  printf "  %d $key1 and %d $key2 entries tested , No errors found.\n\n", $key1Counter, $key2Counter if $verbose && $status;
  return $status;
}

sub consistencyCheck {
  my ($identifier, $listKey, $uniqueKey) = @_;
  for ($identifier, $listKey, $uniqueKey) {
    exit 1 unless defined;
  }

  my %list;
  $ldap->getCacheTie('read');
  my $data = $ldap->{data};
  if (defined $data->{$listKey}) {
    %list = map { $_ => 1 } split (',', $data->{$listKey});
  }
  my %entry;
  for my $key (keys %$data) {
    if ($key =~ m/\A(?:$uniqueKey)::(.*)\z/) {
      $keysLookedAt{$key} = 1;
      $entry{$1} = 1 ;
    }
  }
  $ldap->untieCache();

  printf "  %d ${identifier}s counted from $listKey, %d ${identifier}s counted from ${uniqueKey}::\$$identifier\n", scalar(keys(%list)), scalar(keys(%entry)) if $verbose;
  
  for my $identifier (keys(%list)) {
    print "  ERROR: $identifier exists in $listKey, but not in ${uniqueKey}::$identifier\n" and exit 1 unless defined $entry{$identifier};
  }

  for my $identifier (keys(%entry)) {
    print "  ERROR: $identifier exists in ${uniqueKey}::${identifier}, but not in $listKey\n" and exit 1 unless defined $list{$identifier};
  }

  print "  No errors found.\n\n" if $verbose;

  return 1;
}

sub duplicatesCheck {
  my ($identifier, $resolvesTo, $cacheKey) = @_;
  for ($identifier, $resolvesTo, $cacheKey) {
    exit 1 unless defined;
  }

  my %counter;
  $ldap->getCacheTie('read');
  my $data = $ldap->{data};
  while (my ($key, $val) = each %$data) {
    if ($key =~ m/\A$cacheKey/) {
      $keysLookedAt{$key} = 1;
      $counter{$val}++ 
    }
  }
  $ldap->untieCache();
  
  printf "  %d ${identifier}s counted ...\n", scalar(keys(%counter)) if $verbose;
  my @duplicates = grep { $counter{$_} > 1 } keys %counter;
  if (@duplicates) {
    for my $name (@duplicates) {
      print "  ERROR: $identifier $name is in use by $counter{$name} ${resolvesTo}s!\n" and exit 1 if $counter{$name} > 1;
    }
  } else {
    print "  No duplicates found.\n" if $verbose;
  }
  print "\n" if $verbose;
  
  return 1;
}
