view release on metacpan or  search on metacpan

test.pl  view on Meta::CPAN

######################### 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{