# 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);
}