[LON-CAPA-cvs] cvs: loncom /debugging_tools testkerberos.pl
raeburn
lon-capa-cvs-allow@mail.lon-capa.org
Mon, 11 Feb 2008 17:21:35 -0000
raeburn Mon Feb 11 12:21:35 2008 EDT
Added files:
/loncom/debugging_tools testkerberos.pl
Log:
- Script to test if Kerberos authentication is functional, and also compare values entered for Kerberos version and realm with defaults in domain.tab file for domain.
Index: loncom/debugging_tools/testkerberos.pl
+++ loncom/debugging_tools/testkerberos.pl
#!/usr/bin/perl
# The LearningOnline Network
#
# testkerberos.pl - Checks if Kerberos authentication is functional in the domain
#
# $Id: testkerberos.pl,v 1.1 2008/02/11 17:21:34 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
#################################################
use strict;
use Authen::Krb5;
use Authen::Krb4;
print STDOUT "Enter your LON-CAPA domain, (e.g., msu): ";
my $domain = <STDIN>;
chomp($domain);
print STDOUT "Enter the Kerberos version (4 or 5): ";
my $version = <STDIN>;
chomp($version);
print STDOUT "Enter the Kerberos realm, (e.g., MSU.EDU): ";
my $realm = <STDIN>;
chomp($realm);
print STDOUT "Enter a username which uses Kerberos authentication: ";
my $username = <STDIN>;
chomp($username);
print STDOUT "Enter the password for this user: ";
system ("stty -echo");
my $password= <STDIN>;
system ("stty echo");
chomp ($password);
print STDOUT "\n";
my $response;
if ($username eq '' || $password eq '') {
$response = "Kerberos check failed - either the username or the password was blank";
} else {
my $domaintab = '/home/httpd/lonTabs/domain.tab';
if ($domain eq '') {
print STDOUT "Warning: Domain is blank. It will not be possible to retrieve default authentication information for the domain.\n";
} else {
if (-e "$domaintab") {
my ($howpwd,$contentpwd);
if (open(my $fh,"<$domaintab")) {
my @lines = <$fh>;
close($fh);
chomp(@lines);
foreach my $line (@lines) {
next if ($line =~ /^#/);
my ($dom,$desc,$auth,$autharg,$lang,$loc,$long,$lat,$primary) = split(/:/,$line);
if ($dom eq $domain) {
$howpwd = $auth;
$contentpwd = $autharg;
last;
}
}
} else {
print STDOUT "Warning: could not open $domaintab to retrieve default authentication information for the domain: $domain.\n";
}
if ($howpwd eq '' || $contentpwd eq '') {
print STDOUT "Warning: could not determine default authentication and/or argument from $domaintab for domain: $domain\n";
} else {
if ($howpwd =~ /^krb(4|5)$/) {
if ($1 ne $version) {
print STDOUT "Warning: the default Kerberos authentication in $domaintab for domain: $domain is $1 which is different to the version - $version - which you are currently checking.\n";
}
} else {
print STDOUT "Warning: the default authentication - $howpwd - in $domaintab for this domain ($domain) is not for Kerberos authentication\n";
}
if ($contentpwd ne $realm) {
print STDOUT "Warning: the default Kerberos realm from $domaintab for domain: $domain is $contentpwd which is different to the realm - $realm - you are currently checking\n";
}
}
} else {
print STDOUT "Warning: could not access $domaintab to retrieve default authentication information for the domain.\n";
}
}
if ($realm ne '') {
if ($version != 4 && $version != 5) {
$response = "Kerberos check failed - unexpected kerberos version - $version (this should be 4 or 5)";
} else {
my $krbreturn;
if ($version == 5) {
&Authen::Krb5::init_context();
my $krbclient = &Authen::Krb5::parse_name($username.'@'.$realm);
my $krbservice = "krbtgt/".$realm."\@".$realm;
my $krbserver = &Authen::Krb5::parse_name($krbservice);
my $credentials= &Authen::Krb5::cc_default();
$credentials->initialize(&Authen::Krb5::parse_name($username.'@'.$realm));
if (exists(&Authen::Krb5::get_init_creds_password)) {
$krbreturn = &Authen::Krb5::get_init_creds_password(&Authen::Krb5::parse_name($username.'@'.$realm),$password,$krbservice);
if (ref($krbreturn) eq 'Authen::Krb5::Creds') {
$response = "Kerberos check passed. Kerberos $version. User: $username - response from Authen::Krb5 was Creds object\n";
} else {
$response = "Kerberos check failed. Kerberos $version. User: $username - response was $krbreturn";
}
} else {
$krbreturn = &Authen::Krb5::get_in_tkt_with_password($krbclient,$krbserver,
$password,$credentials);
if ($krbreturn == 1) {
$response = "Kerberos check passed. Kerberos $version. User: $username - response was $krbreturn";
} else {
$response = "Kerberos check failed. Kerberos $version. User: $username - response was $krbreturn";
}
}
} elsif ($version == 4) {
$krbreturn =
&Authen::Krb4::get_pw_in_tkt($username,'',$realm,'krbtgt',$realm,1,$password);
if ($krbreturn == 0) {
$response = "Kerberos check passed. Kerberos $version. User: $username - response was $krbreturn";
} else {
$response = "Kerberos check failed. Kerberos $version. User: $username - response was $krbreturn";
}
}
}
} else {
$response = "Kerberos check failed - Kerberos realm is blank";
}
}
print STDOUT "$response\n";