[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";