#!/usr/bin/perl -w
##
## Do ad-hoc test for Winbind + Active Directory environment
## Copyright (c) 2007 SATOH Fumiyasu @ OSS Technology Co., Japan
##                    <http://www.osstech.co.jp/>
##

use strict;
#use warnings;
use English;
use IO::File;
use POSIX;
use File::stat;

use Net::LDAP;
use Net::LDAP::Control::Paged;
use Net::LDAP::Constant qw(LDAP_CONTROL_PAGED);

use constant USERACCOUNTCONTROL_ACCOUNT_DISABLE =>	0x00000002;
use constant SAMACCOUNTTYPE_SECURITY_GLOBAL_GROUP =>	0x10000000;

my $cmd_name = $0;
$cmd_name =~ s#^.*/##;
my $cmd_usage = "Usage: $cmd_name CONFIG\n";

$ENV{'LC_ALL'} = 'C';
$ENV{'PATH'} = join(':', qw(
  /opt/osstech/bin
  /opt/osstech/sbin
  /bin
  /usr/bin
  /sbin
  /usr/sbin
));

$SIG{'ALRM'} = sub { die "timedout\n" };
$SIG{'__DIE__'} = sub {
  STDERR->print("$cmd_name: ERROR: @_\n");
  exit(1);
};
$SIG{'__WARN__'} = sub {
  STDERR->print("$cmd_name: WARNING: @_\n");
};

STDOUT->autoflush(1);
STDERR->autoflush(1);

my $page_size = 100;

if (@ARGV != 1) {
  print $cmd_usage;
  exit(0);
}
my $conf_file = shift(@ARGV);

eval {
  package c;
  $c::ad_server = undef;
  $c::ad_domain = undef;
  $c::ad_admin = undef;
  $c::ad_password = undef;
  $c::scope = 'sub';
  $c::user_random_pickup_factor = 20;
  $c::group_random_pickup_factor = 20;
  require $conf_file;
};
if ($EVAL_ERROR) {
  die("cannot load configuration file: $conf_file: $@");
}

if (!defined($c::base)) {
  $c::base = "dc=$c::ad_domain";
  $c::base =~ s/\./,dc=/g;
}
if (!defined($c::bind_dn)) {
  $c::bind_dn = "cn=$c::ad_admin,cn=Users,$c::base";
}
if (!defined($c::bind_pass)) {
  $c::bind_pass = $c::ad_password;
}

## ======================================================================

print "Connecting to LDAP server on DC ...\n";
my $ldap = Net::LDAP->new($c::ad_server) || die "$@";
$ldap->bind($c::bind_dn, 'password' => $c::bind_pass);

my $page = Net::LDAP::Control::Paged->new(size => $page_size);
my %args = (
  'base' =>	$c::base,
  'scope' =>	$c::scope,
  'control' =>	[$page],
);

my $search = sub {
  my ($filter, @attrs) = @_;

  $args{'filter'} = $filter;
  if (@attrs) {
    $args{'attrs'} = \@attrs;
  }
  else {
    delete($args{'attrs'});
  }

  ## FIXME: Supported ranged attributes. e.g.:
  ## dn: CN=student,CN=Users,DC=example,DC=jp
  ## objectClass: top
  ## objectClass: group
  ## cn: student
  ## member;range=0-1499: CN=user1,OU=Users,DC=example,DC=jp
  ## member;range=0-1499: CN=user2,OU=Users,DC=example,DC=jp
  ## ...
  ## member;range=0-1499: CN=user1500,OU=Users,DC=example,DC=jp
  ## distinguishedName: CN=student,CN=Users,DC=example,DC=jp
  ## ...

  my @entry = ();
  my $cookie;
  while (1) {
    my $mesg = $ldap->search(%args);
    $mesg->code && die $mesg->error;

    push(@entry, $mesg->entries);

    my ($resp) = $mesg->control(LDAP_CONTROL_PAGED) or last;
    $cookie = $resp->cookie or last;
    $page->cookie($cookie);
    print '.';
  }

  if ($cookie) {
    $page->cookie($cookie);
    $page->size(0);
    my $mesg = $ldap->search(%args);
    $mesg->code && die $mesg->error;

    push(@entry, $mesg->entries);
  }

  print '... ', scalar(@entry), " entries\n";

  return @entry;
};

## ======================================================================

sub sid_bin2text
{
  my ($sid_bin) = @_;

  my ($sid_rev, $sid_num_auths, @sid_id_auth) = unpack('C8', $sid_bin);
  my @sid_sub_auths =
    (unpack('C8' . ('V' x $sid_num_auths), $sid_bin))[-$sid_num_auths..-1];
  my $sid =
    sprintf('S-%u-%u' . '-%u' x $sid_num_auths, $sid_rev, $sid_num_auths, @sid_sub_auths);
  my $rid = $sid_sub_auths[-1];

  return wantarray ? ($sid, $rid) : $sid;
}

sub pwent2string
{
  my ($name, $hash, $uid, $gid, $quota, $comment, $gecos, $home, $shell) = @_;

  return defined($name) ? "$name:$hash:$uid:$gid:$gecos:$home:$shell" : 'NO ENTRY';
}

sub grent2string
{
  my ($name, $hash, $gid, $members) = @_;

  $members = join(',', sort(split(/ /, $members))) if (defined($members));
  return defined($name) ? "$name:$hash:$gid:$members" : 'NO ENTRY';
}

sub random_pickup_items
{
  my $factor = shift(@_);
  my $num = int(@_ * ($factor / 100.0)) || 1;
  my @picked = ();
  for (my $i=0; $i<$num; $i++) {
    push(@picked, splice(@_, int(rand(@_)), 1));
  }

  return sort @picked;
}

sub mktemp
{
  my $template = "/tmp/$cmd_name.tmp.";
  my @seed = ('0'..'9', 'a'..'z', 'A'..'Z');
  my $seed_n = 10;
  my $try_max = $seed_n * 10;

  for (my $try = 0; $try <= $try_max; $try++) {
    my $temp = $template;
    for (my $n = 0; $n < $seed_n; $n++) {
      $temp .= $seed[int(rand(@seed))];
    }

    my $fh = IO::File->new($temp, O_RDWR|O_CREAT|O_EXCL, 0600);
    if (defined($fh)) {
      return $temp;
    }
    elsif ($! != POSIX::EEXIST || $try == $try_max) {
      die "cannot create temporary file $temp: $!\n";
    }
  }
}

my $test_count = 0;
my $test_ok = 0;
my $test_ng = 0;

sub test_true
{
  my ($name, $v, $err) = @_;

  $test_count++;

  print "$name: ";
  if ($v) {
    $test_ok++;
    print "OK\n";
  }
  else {
    $test_ng++;
    print "NG\n";
    if (defined($err) && $err ne '') {
      $err =~ s/^(.{512}).*$/$1 .../mg;
      $err =~ s/\n+$//;
      $err =~ s/\n([^\n])/\n\t$1/g;
      print "\t$err\n";
    }
  }
}

sub test_eq
{
  my ($name, $v, $e, $err) = @_;

  $err = "expected value: <$e>\nactual value: <$v>\n" if (!defined($err));
  test_true($name, $v eq $e, $err);
}

sub test_empty
{
  my ($name, $v, $err) = @_;

  $err = "value is not empty: <$v>" if (!defined($err));
  test_true($name, $v eq '', $err);
}

## ======================================================================

print "Retrievng group info from DC through LDAP ...\n";

my @groups = ();
my @group_names_wo_sfu = ();
my %group_by_dn = ();
my %group_by_name = ();
my %group_by_gid = ();
my %group_by_sid = ();
my %group_by_rid = ();
for my $entry ($search->('(objectClass=group)')) {
  next if ($entry->get_value('sAMAccountType') != SAMACCOUNTTYPE_SECURITY_GLOBAL_GROUP);
  my $name = lc($entry->get_value('sAMAccountName'));
  my $gid = $entry->get_value('msSFU30GidNumber');

  if (!defined($gid)) {
    push(@group_names_wo_sfu, $name);
    next;
  }

  my ($sid, $rid) = sid_bin2text($entry->get_value('objectSid'));

  my $group = {
    'dn' =>	$entry->dn,
    'name' =>	$name,
    'hash' =>	'*',
    'gid' =>	$gid,
    'members' =>[],
    'members_dn' => [$entry->get_value('member')],
    'sid' =>	$sid,
    'rid' =>	$rid,
  };

  push(@groups, $group);
  $group_by_dn{$entry->dn} =
  $group_by_name{$name} =
  $group_by_sid{$sid} =
  $group_by_rid{$rid} =
      $group;

  if (!exists($group_by_gid{$gid})) {
    $group_by_gid{$gid} = $group;
  }
  else {
    warn "GID <$gid> of group <$name> conflicts with group <$group_by_gid{$gid}->{'name'}>: ignored\n";
  }
}

## ======================================================================

print "Retrievng user info from DC through LDAP ...\n";

my @users = ();
my @user_names_wo_sfu = ();
my %user_by_dn = ();
my %user_by_name = ();
my %user_by_uid = ();
my %user_by_sid = ();
my %user_by_rid = ();
for my $entry ($search->('(objectClass=user)')) {
  next if (grep(/^computer$/i, $entry->get_value('objectclass')));
  next if ($entry->get_value('userAccountControl') & USERACCOUNTCONTROL_ACCOUNT_DISABLE);
  my $name = lc($entry->get_value('sAMAccountName'));
  my $uid = $entry->get_value('msSFU30UidNumber');
  my $group = $group_by_rid{$entry->get_value('primaryGroupID')};

  unless (defined($uid) && defined($group)) {
    push(@user_names_wo_sfu, $name);
    next;
  }

  my ($sid, $rid) = sid_bin2text($entry->get_value('objectSid'));

  my $gid = $group->{'gid'};
  my @gids = ($gid);
  for my $memberof ($entry->get_value('memberOf')) {
    my $group = $group_by_dn{$memberof};
    next if (!defined($group));

    push(@gids, $group->{'gid'});
    push(@{$group->{'members'}}, $name);
  }

  my $gecos = $entry->get_value('msSFU30Gecos');
  $gecos = $entry->get_value('name') if (!defined($gecos));

  my $user = {
    'dn' =>	$entry->dn,
    'name' =>	$name,
    'hash' =>	'*',
    'uid' =>	$uid,
    'gid' =>	$gid,
    'gids' =>	[sort {$a<=>$b} @gids],
    'gecos' =>	$gecos,
    'home' =>	$entry->get_value('msSFU30HomeDirectory'),
    'shell' =>	$entry->get_value('msSFU30LoginShell'),
    'sid' =>	$sid,
    'rid' =>	$rid,
  };

  push(@users, $user);
  $user_by_dn{$entry->dn} =
  $user_by_name{$name} =
  $user_by_sid{$sid} =
  $user_by_rid{$rid} =
    $user;

  if (!exists($user_by_uid{$uid})) {
    $user_by_uid{$uid} = $user;
  }
  else {
    warn "UID <$uid> of user <$name> conflicts with user <$user_by_uid{$uid}->{'name'}>: ignored\n";
  }
}

## ======================================================================

print "Construct expected user and group info for tests ...\n";

## Collect user names for user name tests
my @user_names_all = sort keys %user_by_name;
my @user_names = ();
if (@c::test_ad_users) {
  @user_names = sort @c::test_ad_users;
}
else {
  @user_names = random_pickup_items($c::user_random_pickup_factor, @user_names_all);
}
print 'Test users: ', scalar(@user_names), "\n";

## Collect user names that has passwordfor for authentication tests
my @user_names_w_password = sort keys %c::test_ad_users_w_password;
print 'Test users with password: ', scalar(@user_names_w_password), "\n";
if (@user_names_w_password == 0) {
  warn "no user with password specified: all authentication tests are skipped"
}

## Collect UIDs for UID tests
my @user_uids = ();
if (@c::test_uids) {
  @user_uids = sort {$a<=>$b} @c::test_uids;
}
else {
  for my $name (@user_names) {
    my $user = $user_by_name{$name};
    if (!defined($user)) {
      warn "user <$name> not found or has no UID in AD: ignored on UID tests\n";
      next;
    }
    push(@user_uids, $user->{'uid'});
  }
}
print 'Test UIDs: ', scalar(@user_uids), "\n";

## Collect user names for user name tests
my @group_names_all = sort keys %group_by_name;
my @group_names = ();
if (@c::test_ad_groups) {
  @group_names = sort @c::test_ad_groups;
}
else {
  @group_names = random_pickup_items($c::group_random_pickup_factor, @group_names_all);
}
print 'Test groups: ', scalar(@group_names), "\n";

## Collect GIDs for GID tests
my @group_gids = ();
if (@c::test_gids) {
  @group_gids = sort {$a<=>$b} @c::test_gids;
}
else {
  for my $name (@group_names) {
    my $group = $group_by_name{$name};
    if (!defined($group)) {
      warn "group <$name> not found or has no GID in AD: ignored on GID tests\n";
      next;
    }
    push(@group_gids, $group->{'gid'});
  }
}
print 'Test GIDs: ', scalar(@group_gids), "\n";

## Construct NSS information for test users
for my $name (@user_names_all) {
  my $user = $user_by_name{$name};
  $user->{'nssinfo'} =
    join(':', @{%$user}{qw(name hash uid gid gecos home shell)});
}

## Construct NSS information for test groups
for my $name (@group_names_all) {
  my $group = $group_by_name{$name};
  for my $member_dn (@{$group->{'members_dn'}}) {
    my $user = $user_by_dn{$member_dn} || next;
    push(@{$group->{'members'}}, $user->{'name'});
  }
  my $prev = '';
  $group->{'members'} = [grep $_ ne $prev && ($prev = $_), sort @{$group->{'members'}}];
  $group->{'nssinfo'} =
    join(':', @{%$group}{qw(name hash gid)}, join(',', @{$group->{'members'}}));
}

print "Starting tests ...\n\n";

## Test: wbinfo
## ======================================================================

## Test: wbinfo user
## ----------------------------------------------------------------------

my $wbinfo_u_e = join("\n", sort @user_names_wo_sfu, @user_names_all);
chomp(my $wbinfo_u_v = `wbinfo --domain-users |sort`);
test_eq('wbinfo --domain-users', $wbinfo_u_v, $wbinfo_u_e, '');

for my $name (@user_names) {
  my $user = $user_by_name{$name};
  my $e = $user->{'nssinfo'};
  chomp(my $v = `wbinfo --user-info \Q$name\E`);
  test_eq("wbinfo --user-info USER: $name", $v, $e);
}

for my $name (@user_names) {
  my $user = $user_by_name{$name};
  my $e = $user->{'sid'} . ' User (1)';
  chomp(my $v = `wbinfo --name-to-sid \Q$name\E`);
  test_eq("wbinfo --name-to-sid USER: $name", $v, $e);
}

for my $uid (@user_uids) {
  my $user = $user_by_uid{$uid};
  my $e = $user->{'sid'};
  chomp(my $v = `wbinfo --uid-to-sid \Q$uid\E`);
  test_eq("wbinfo --uid-to-sid UID: $uid ($user->{'name'})", $v, $e);
}

for my $name (@user_names) {
  my $user = $user_by_name{$name};
  my $e = join(' ', @{$user->{'gids'}});
  my $v = join(' ', sort {$a<=>$b} split(/\s+/, `wbinfo --user-groups \Q$name\E |sort -n`));
  test_eq("wbinfo --user-groups GROUP: $name", $v, $e);
}

## Test: wbinfo group
## ----------------------------------------------------------------------

my $wbinfo_g_e = join(' ', sort @group_names_wo_sfu, @group_names_all);
chomp(my $wbinfo_g_v = `wbinfo --domain-groups |sort`);
$wbinfo_g_v =~ s/\n/ /g;
test_eq('wbinfo --domain-groups', $wbinfo_g_e, $wbinfo_g_v, '');

for my $name (@group_names) {
  my $group = $group_by_name{$name};
  my $e = $group->{'nssinfo'};
  $e =~ s/:[^:]*$//; ## `wbinfo --group-info GROUP` has no members information
  chomp(my $v = `wbinfo --group-info \Q$name\E`);
  test_eq("wbinfo --group-info GROUP: $name", $v, $e);
}

for my $name (@group_names) {
  my $group = $group_by_name{$name};
  my $e = $group->{'sid'} . ' Domain Group (2)';
  chomp(my $v = `wbinfo --name-to-sid \Q$name\E`);
  test_eq("wbinfo --name-to-sid GROUP: $name", $v, $e);
}

for my $gid (@group_gids) {
  my $group = $group_by_gid{$gid};
  my $e = $group->{'sid'};
  chomp(my $v = `wbinfo --gid-to-sid \Q$gid\E`);
  test_eq("wbinfo --gid-to-sid GID: $gid ($group->{'name'})", $v, $e);
}

## Test: getent
## ======================================================================

## Test: getent passwd
## ----------------------------------------------------------------------

my $etc_passwd_num = int(`wc -l </etc/passwd`);
my $etc_passwd_diff = `getent passwd |head -n $etc_passwd_num |diff /etc/passwd -`;
test_empty(
  'getent passwd: local user entries (/etc/passwd)',
  $etc_passwd_diff, $etc_passwd_diff
);

my $ad_passwd = join("\n", sort map {$user_by_name{$_}->{'nssinfo'}} @user_names_all);
my $ad_passwd_temp = mktemp;
my $ad_passwd_fh = IO::File->new($ad_passwd_temp, 'w');
$ad_passwd_fh->print($ad_passwd, "\n");
$ad_passwd_fh->close;
my $ad_passwd_diff = `getent passwd |sed 1,${etc_passwd_num}d |sort |diff $ad_passwd_temp -`;
unlink($ad_passwd_temp);
test_empty(
  'getent passwd: AD user entries (winbind)',
  $ad_passwd_diff, $ad_passwd_diff
);

for my $name (@user_names) {
  my $e = $user_by_name{$name}->{'nssinfo'};
  my $v = pwent2string(getpwnam($name));
  test_eq("getent passwd USER: $name", $v, $e);
}

for my $uid (@user_uids) {
  my $user = $user_by_uid{$uid};
  my $e = $user->{'nssinfo'};
  my $v = pwent2string(getpwuid($uid));
  test_eq("getent passwd UID: $uid ($user->{'name'})", $v, $e);
}

## Test: getent group
## ----------------------------------------------------------------------

my $etc_group_num = int(`wc -l </etc/group`);
my $etc_group_diff = `getent group |head -n $etc_group_num |diff /etc/group -`;
test_empty(
  'getent group: local group entries (/etc/group)',
  $etc_group_diff, $etc_group_diff
);

my $ad_group = join("\n", sort map {$group_by_name{$_}->{'nssinfo'}} @group_names_all);
my $ad_group_temp = mktemp;
my $ad_group_fh = IO::File->new($ad_group_temp, 'w');
$ad_group_fh->print($ad_group, "\n");
$ad_group_fh->close;

my $ent_group_temp = mktemp;
my $ent_group_fh = IO::File->new($ent_group_temp, 'w');
my $ent_group_fh2 = IO::File->new("getent group |sed 1,${etc_group_num}d |sort |");
while (defined(my $line = $ent_group_fh2->getline)) {
  chomp($line);
  $line =~ s/([^:]*)$//;
  $line .= join(',', sort split(/,/, $1));
  $ent_group_fh->print($line, "\n");
}
$ent_group_fh->close;
my $ad_group_diff = `diff $ad_group_temp $ent_group_temp`;
unlink($ad_group_temp, $ent_group_temp);
test_empty(
  "getent group: AD group entries (winbind)",
  $ad_group_diff, $ad_group_diff
);

for my $name (@group_names) {
  my $e = $group_by_name{$name}->{'nssinfo'};
  my $v = grent2string(getgrnam($name));
  test_eq("getent group GROUP: $name", $v, $e);
}

for my $gid (@group_gids) {
  my $group = $group_by_gid{$gid};
  my $e = $group->{'nssinfo'};
  my $v = grent2string(getgrgid($gid));
  test_eq("getent group GID: $gid ($group->{'name'})", $v, $e);
}

## Test: user and password auth
## ======================================================================

for my $name (@user_names_w_password) {
  my $pass = $c::test_ad_users_w_password{$name};
  my $wbinfo_a = `wbinfo --authenticate \Q$name\E%\Q$pass\E 2>&1`;
  test_true("wbinfo --authenticate USER\%PASSWORD: $name", $? == 0, $wbinfo_a);
}

## Test: UID, GID and permissions on home directory
## ======================================================================

for my $name (@user_names) {
  my $user = $user_by_name{$name};
  my ($name2, $hash, $uid, $gid, $quota, $comment, $gecos, $home, $shell) =
    getpwnam($name);

  unless (-d $home) {
    warn "home <$home> for user <$name> not found: home directory tests are skipped\n";
    warn "home <$home> for user <$name> not found: \`su - USER\` tests are skipped\n";
    next;
  }
  my $stat = stat($home);
  if (!$stat) {
    warn "stat(2) failed: home <$home> for user <$name>: $OS_ERROR\n";
    next;
  }
  test_eq("home owner: $home: $name ($uid)", $stat->uid, $user->{'uid'});
  test_eq("home mode: $home: 0755", ($stat->mode & 0777), 0755);

  unless (-f $shell && -x $shell && $shell =~ /sh$/) {
    warn "user <$name> has no valid shell <$shell>: \`su - USER\` tests are skipped\n";
    next;
  }

  my ($su_out, $su_status) = eval {
    alarm(5);
    my $out = `su - \Q$name\E -c "exec /bin/sh -c 'echo;/bin/id -a;/bin/pwd;/bin/ls -ld . >/dev/null && /bin/touch test-winbind-sfu.$$.tmp && /bin/rm test-winbind-sfu.$$.tmp && echo OK || echo NG'" 2>/dev/null`;
    my $status = $?;
    alarm(0);
    return ($out, $status);
  };
  if ($EVAL_ERROR) {
    warn "su - <$name> failed: timed out: broken shell environment?\n";
    next;
  }

  test_true("su - USER: $name", $su_status == 0);

  chomp($su_out);
  my ($id_out, $pwd_out, $ok_out) = (split(/\n/, $su_out))[-3,-2,-1];

  ($uid, $gid, my $gids) = $id_out=~ /^uid=(\d+)\(.*?\)\s+gid=(\d+).*=(.*)$/m;
  if (!defined($gids)) {
    ($uid, $gid, $gids) = '`su - USER` failed';
  }
  $gids =~ s/\([^)]+\)//g;
  $gids = join(',', sort {$a<=>$b} split(/,/, $gids));
  test_eq("user effective uid: $name: $uid", $uid, $user->{'uid'});
  test_eq("user effective gid: $name: $gid", $gid, $user->{'gid'});
  test_eq("user effective gids: $name: $gids", $gids, join(',', @{$user->{'gids'}}));
  test_true("user permission for home: $name: $home", $ok_out eq 'OK');
}

## Test: finger
## ======================================================================

for my $name (@user_names) {
  my $user = $user_by_name{$name};
  my $real = $user->{'gecos'};
  $real =~ s/,.*$//;
  my $e = qr/^
    [\w\s]+:\s*\Q$name\E\s+
    [\w\s]+:\s*\Q$real\E\n
    [\w\s]+:\s*\Q$user->{'home'}\E\s+
    [\w\s]+:\s*\Q$user->{'shell'}\E\n
  /x;
 my $v = `finger \Q$name\E`;
  test_true("finger USER: $name", $v =~ $e);
}

## ======================================================================

print "\nDone.\n\n";
print "OK: $test_ok\n";
print "NG: $test_ng\n";
print "Total: $test_count\n";

exit($test_ng == 0 ? 0 : 1);