1# Before `make install' is performed this script should be runnable with 2# `make test'. After `make install' it should work as `perl test.pl' 3# 4# $Id: test.pl,v 1.1 2004/10/27 07:42:07 pelov Exp pelov $ 5 6######################### We start with some black magic to print on failure. 7 8BEGIN { $| = 1; $^W = 1; print "1..10\n"; } 9END { print "not ok 1\n" unless $loaded; } 10 11use strict; 12use vars qw($loaded $fd_status); 13use POSIX qw(ttyname); 14use Authen::PAM; # qw(:functions :constants); 15 16$loaded = 1; 17print "ok 1\n"; 18 19######################### End of black magic. 20 21my $failures = 0; 22 23sub ok { 24 my ($no, $ok) = @_; 25 if ($ok) { 26 print "ok $no\n"; 27 } else 28 { 29 print "not ok $no\n"; $failures++; 30 } 31} 32 33sub pam_ok { 34 my ($no, $pamh, $pam_ret_val, $other_test) = @_ ; 35 if ($pam_ret_val != PAM_SUCCESS()) { 36 print "not ok $no ($pam_ret_val - ", 37 pam_strerror($pamh, $pam_ret_val),")\n"; 38 $failures++; 39 } 40 elsif (defined($other_test) && !$other_test) { 41 print "not ok $no\n"; 42 $failures++; 43 } 44 else { 45 print "ok $no\n"; 46 } 47} 48 49sub skip { 50 my ($no, $msg) = @_ ; 51 print "skipped $no: $msg\n"; 52} 53 54sub my_fail_delay { 55 $fd_status = shift; 56 my $delay = shift; 57 58# print "Status: $fd_status, Delay: $delay\n"; 59} 60 61{ 62 my ($pamh, $item); 63 my $res = -1; 64 65 my $pam_service = "login"; 66 my $login_name = getpwuid($<); 67 my $tty_name = ttyname(fileno(STDIN)) or 68 die "Can't obtain the tty name!\n"; 69 70# $res = pam_start($pam_service, $login_name, \&Authen::PAM::pam_default_conv, $pamh); 71 if ($login_name) { 72 print 73 "---- The remaining tests will be run for service '$pam_service', ", 74 "user '$login_name' and\n---- device '$tty_name'.\n"; 75 76 $res = pam_start($pam_service, $login_name, $pamh); 77 } else { # If we cannot get the username then ask for it 78 print 79 "---- The remaining tests will be run for service '$pam_service' and\n", 80 "---- device '$tty_name'.\n"; 81 82 $res = pam_start($pam_service, $pamh); 83 } 84 pam_ok(2, $pamh, $res); 85 86 $res = pam_get_item($pamh, PAM_SERVICE(), $item); 87 pam_ok(3, $pamh, $res, $item eq $pam_service); 88 89# $res = pam_get_item($pamh, PAM_USER(), $item); 90# pam_ok(4, $pamh, $res, $item eq $login_name); 91 92# $res = pam_set_item($pamh, PAM_CONV(), \&Authen::PAM::pam_default_conv); 93# pam_ok(4.99, $pamh, $res); 94 95 $res = pam_get_item($pamh, PAM_CONV(), $item); 96 pam_ok(4, $pamh, $res, $item == \&Authen::PAM::pam_default_conv); 97 98 $res = pam_set_item($pamh, PAM_TTY(), $tty_name); 99 pam_ok(5, $pamh, $res); 100 101 $res = pam_get_item($pamh, PAM_TTY(), $item); 102 pam_ok(6, $pamh, $res, $item eq $tty_name); 103 104 if (HAVE_PAM_ENV_FUNCTIONS()) { 105 $res = pam_putenv($pamh, "_ALPHA=alpha"); 106 pam_ok(7, $pamh, $res); 107 108 my %en = pam_getenvlist($pamh); 109 ok(8, $en{"_ALPHA"} eq "alpha"); 110 } 111 else { 112 skip(7, 'environment functions are not supported by your PAM library'); 113 skip(8, 'environment functions are not supported by your PAM library'); 114 } 115 116# if (HAVE_PAM_FAIL_DELAY()) { 117# $res = pam_set_item($pamh, PAM_FAIL_DELAY(), \&my_fail_delay); 118# pam_ok(10, $pamh, $res); 119# } else { 120# skip(10, 'custom fail delay function is not supported by your PAM library'); 121# } 122 123 if ($login_name) { 124 print 125 "---- Now, you may be prompted to enter the password of '$login_name'.\n"; 126 } else{ 127 print 128 "---- Now, you may be prompted to enter a user name and a password.\n"; 129 } 130 131 $res = pam_authenticate($pamh, 0); 132# $res = pam_chauthtok($pamh); 133 { 134 my $old_failures = $failures; 135 pam_ok(9, $pamh, $res); 136 print 137 "---- The failure of test 9 could be due to your PAM configuration\n", 138 "---- or typing an incorrect password.\n" 139 if ($res != PAM_SUCCESS()); 140 $failures = $old_failures; # Authentication failures don't count 141 } 142 143# if (HAVE_PAM_FAIL_DELAY()) { 144# ok(12, $res == $fd_status); 145# } else { 146# skip(12, 'custom fail delay function is not supported by your PAM library'); 147# } 148 149 $res = pam_end($pamh, 0); 150 ok(10, $res == PAM_SUCCESS()); 151 152 # Checking the OO interface 153 $pamh = new Authen::PAM($pam_service, $login_name); 154 ok(11, ref($pamh)); 155# 156# $res = $pamh->pam_authenticate; 157# $res = $pamh->pam_chauthtok; 158# pam_ok(111, $pamh, $res); 159# 160 $pamh = 0; # this will destroy the object (and call pam_end) 161 162 print "\n"; 163 164 exit($failures); 165} 166