Return to testkerberos.pl CVS log

Up to [LON-CAPA] / loncom / debugging_tools

- bug 6170
  - Kerberos 4 libraries are not included with revision 1.7 of krb5 package.
    Hence, perl-Authen-Krb4 is unavailable for distros using 1.7 (or later)
  - authentication checking for krb4 or krb5 auth types moved to subroutines.
    krb5 check used if Authen::Krb4 unavailable and version = 4 specified.
    User is notified.

#!/usr/bin/perl
# The LearningOnline Network
#
# testkerberos.pl - Checks if Kerberos authentication is functional in the domain
#
# $Id: testkerberos.pl,v 1.2 2010/04/12 20:07:45 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;

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 {
            if ($version == 5) {
                $response = &check_krb5($username,$realm,$password);
            } elsif ($version == 4) {
                $response = &check_krb4($username,$realm,$password);
            }
        }
    } else {
        $response = "Kerberos check failed - Kerberos realm is blank";
    }
}
print STDOUT "$response\n";

sub check_krb4 {
    my ($username,$realm,$password) = @_;
    my ($krbreturn,$response);
    eval {
        require Authen::Krb4;
    };
    if (!$@) {
        $krbreturn = &Authen::Krb4::get_pw_in_tkt($username,'',$realm,'krbtgt',$realm,1,$password);
        if ($krbreturn == 0) {
            $response = "Kerberos check passed. Kerberos 4. User: $username - response was $krbreturn";
        } else {
            $response = "Kerberos check failed. Kerberos 4. User: $username - response was $krbreturn";
        }
    } else {
        $response = 'Kerberos check failed. Kerberos '.$version.
                    ' requires "perl-Authen-Krb4" which does not appear to be installed.'."\n".
                    'This may be because you are using revision 1.7 or later of the krb5 package,'.
                    ' which no longer supports Kerberos 4.'."\n".'Checking with Kerberos 5 instead:'."\n".
                    &check_krb5($username,$realm,$password);
    }
    return $response;
}

sub check_krb5 {
    my ($username,$realm,$password) = @_;
    &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));
    my ($krbreturn,$response);
    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 5. User: $username - response from Authen::Krb 5 was Creds object\n";
        } else {
            $response = "Kerberos check failed. Kerberos 5. 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 5. User: $username - response was $krbreturn";
        } else {
            $response = "Kerberos check failed. Kerberos 5. User: $username - response was $krbreturn";
        }
    }
    return $response;
}