The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
#
# $Id: test.pl,v 1.1 2004/10/27 07:42:07 pelov Exp pelov $

######################### We start with some black magic to print on failure.

BEGIN { $| = 1; $^W = 1; print "1..10\n"; }
END { print "not ok 1\n" unless $loaded; }

use strict;
use vars qw($loaded $fd_status);
use POSIX qw(ttyname);
use Authen::PAM; # qw(:functions :constants);

$loaded = 1;
print "ok 1\n";

######################### End of black magic.

my $failures = 0;

sub ok {
    my ($no, $ok) = @_;
    if ($ok) {
      print "ok $no\n";
    } else
    {
      print "not ok $no\n"; $failures++;
    }
}

sub pam_ok {
    my ($no, $pamh, $pam_ret_val, $other_test) = @_ ;
    if ($pam_ret_val != PAM_SUCCESS()) {
        print "not ok $no ($pam_ret_val - ",
	  pam_strerror($pamh, $pam_ret_val),")\n";
	$failures++;
    }
    elsif (defined($other_test) && !$other_test) {
        print "not ok $no\n";
	$failures++;
    }
    else {
        print "ok $no\n";
    }
}

sub skip {
  my ($no, $msg) = @_ ;
  print "skipped $no: $msg\n";
}

sub my_fail_delay {
  $fd_status = shift;
  my $delay = shift;

#  print "Status: $fd_status, Delay: $delay\n";
}

{
  my ($pamh, $item);
  my $res = -1;

  my $pam_service = "login";
  my $login_name = getpwuid($<);
  my $tty_name = ttyname(fileno(STDIN)) or
    die "Can't obtain the tty name!\n";

#  $res = pam_start($pam_service, $login_name, \&Authen::PAM::pam_default_conv, $pamh);
  if ($login_name) {
    print
      "---- The remaining tests will be run for service '$pam_service', ",
      "user '$login_name' and\n---- device '$tty_name'.\n";

    $res = pam_start($pam_service, $login_name, $pamh);
  } else { # If we cannot get the username then ask for it
    print
      "---- The remaining tests will be run for service '$pam_service' and\n",
      "---- device '$tty_name'.\n";

    $res = pam_start($pam_service, $pamh);
  }
  pam_ok(2, $pamh, $res);

  $res = pam_get_item($pamh, PAM_SERVICE(), $item);
  pam_ok(3, $pamh, $res, $item eq $pam_service);

#  $res = pam_get_item($pamh, PAM_USER(), $item);
#  pam_ok(4, $pamh, $res, $item eq $login_name);

#  $res = pam_set_item($pamh, PAM_CONV(), \&Authen::PAM::pam_default_conv);
#  pam_ok(4.99, $pamh, $res);

  $res = pam_get_item($pamh, PAM_CONV(), $item);
  pam_ok(4, $pamh, $res, $item == \&Authen::PAM::pam_default_conv);

  $res = pam_set_item($pamh, PAM_TTY(), $tty_name);
  pam_ok(5, $pamh, $res);

  $res = pam_get_item($pamh, PAM_TTY(), $item);
  pam_ok(6, $pamh, $res, $item eq $tty_name);

  if (HAVE_PAM_ENV_FUNCTIONS()) {
    $res = pam_putenv($pamh, "_ALPHA=alpha");
    pam_ok(7, $pamh, $res);

    my %en = pam_getenvlist($pamh);
    ok(8, $en{"_ALPHA"} eq "alpha");
  }
  else {
    skip(7, 'environment functions are not supported by your PAM library');
    skip(8, 'environment functions are not supported by your PAM library');
  }

#  if (HAVE_PAM_FAIL_DELAY()) {
#    $res = pam_set_item($pamh, PAM_FAIL_DELAY(), \&my_fail_delay);
#    pam_ok(10, $pamh, $res);
#  } else {
#    skip(10, 'custom fail delay function is not supported by your PAM library');
#  }

   if ($login_name) {
     print
       "---- Now, you may be prompted to enter the password of '$login_name'.\n";
   } else{
     print
       "---- Now, you may be prompted to enter a user name and a password.\n";
   }

  $res = pam_authenticate($pamh, 0);
#  $res = pam_chauthtok($pamh);
  {
    my $old_failures = $failures;
    pam_ok(9, $pamh, $res);
    print 
      "---- The failure of test 9 could be due to your PAM configuration\n",
	"---- or typing an incorrect password.\n"
      if ($res != PAM_SUCCESS());
    $failures = $old_failures; # Authentication failures don't count
  }

#  if (HAVE_PAM_FAIL_DELAY()) {
#    ok(12, $res == $fd_status);
#  } else {
#    skip(12, 'custom fail delay function is not supported by your PAM library');
#  }

  $res = pam_end($pamh, 0);
  ok(10, $res == PAM_SUCCESS());

  # Checking the OO interface
  $pamh = new Authen::PAM($pam_service, $login_name);
  ok(11, ref($pamh));
#
#  $res = $pamh->pam_authenticate;
#  $res = $pamh->pam_chauthtok;
#  pam_ok(111, $pamh, $res);
#
  $pamh = 0;  # this will destroy the object (and call pam_end)

  print "\n";

  exit($failures);
}