loncom/debugging_tools/testkerberos.pl - view

File: [LON-CAPA] / loncom / debugging_tools / testkerberos.pl
Revision 1.2: download - view: text, annotated - select for diffs
Mon Apr 12 20:07:45 2010 UTC (14 years ago) by raeburn
Branches: MAIN
CVS tags: version_2_9_X, version_2_9_1, version_2_9_0, version_2_8_99_1, version_2_12_X, version_2_11_X, version_2_11_4_uiuc, version_2_11_4_msu, version_2_11_4, version_2_11_3_uiuc, version_2_11_3_msu, version_2_11_3, version_2_11_2_uiuc, version_2_11_2_msu, version_2_11_2_educog, version_2_11_2, version_2_11_1, version_2_11_0_RC3, version_2_11_0_RC2, version_2_11_0_RC1, version_2_11_0, version_2_10_X, version_2_10_1, version_2_10_0_RC2, version_2_10_0_RC1, version_2_10_0, loncapaMITrelate_1, language_hyphenation_merge, language_hyphenation, PRINT_INCOMPLETE_base, PRINT_INCOMPLETE, HEAD, BZ4492-merge, BZ4492-feature_horizontal_radioresponse, BZ4492-feature_Support_horizontal_radioresponse, BZ4492-Support_horizontal_radioresponse

- 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.

1: #!/usr/bin/perl 2: # The LearningOnline Network 3: # 4: # testkerberos.pl - Checks if Kerberos authentication is functional in the domain 5: # 6: # $Id: testkerberos.pl,v 1.2 2010/04/12 20:07:45 raeburn Exp $ 7: # 8: # Copyright Michigan State University Board of Trustees 9: # 10: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 11: # 12: # LON-CAPA is free software; you can redistribute it and/or modify 13: # it under the terms of the GNU General Public License as published by 14: # the Free Software Foundation; either version 2 of the License, or 15: # (at your option) any later version. 16: # 17: # LON-CAPA is distributed in the hope that it will be useful, 18: # but WITHOUT ANY WARRANTY; without even the implied warranty of 19: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20: # GNU General Public License for more details. 21: # 22: # You should have received a copy of the GNU General Public License 23: # along with LON-CAPA; if not, write to the Free Software 24: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 25: # 26: # /home/httpd/html/adm/gpl.txt 27: # 28: # http://www.lon-capa.org/ 29: # 30: ################################################# 31: use strict; 32: use Authen::Krb5; 33: 34: print STDOUT "Enter your LON-CAPA domain, (e.g., msu): "; 35: my $domain = <STDIN>; 36: chomp($domain); 37: print STDOUT "Enter the Kerberos version (4 or 5): "; 38: my $version = <STDIN>; 39: chomp($version); 40: print STDOUT "Enter the Kerberos realm, (e.g., MSU.EDU): "; 41: my $realm = <STDIN>; 42: chomp($realm); 43: print STDOUT "Enter a username which uses Kerberos authentication: "; 44: my $username = <STDIN>; 45: chomp($username); 46: print STDOUT "Enter the password for this user: "; 47: system ("stty -echo"); 48: my $password= <STDIN>; 49: system ("stty echo"); 50: chomp ($password); 51: print STDOUT "\n"; 52: 53: my $response; 54: if ($username eq '' || $password eq '') { 55: $response = "Kerberos check failed - either the username or the password was blank"; 56: } else { 57: my $domaintab = '/home/httpd/lonTabs/domain.tab'; 58: if ($domain eq '') { 59: print STDOUT "Warning: Domain is blank. It will not be possible to retrieve default authentication information for the domain.\n"; 60: } else { 61: if (-e "$domaintab") { 62: my ($howpwd,$contentpwd); 63: if (open(my $fh,"<$domaintab")) { 64: my @lines = <$fh>; 65: close($fh); 66: chomp(@lines); 67: foreach my $line (@lines) { 68: next if ($line =~ /^#/); 69: my ($dom,$desc,$auth,$autharg,$lang,$loc,$long,$lat,$primary) = split(/:/,$line); 70: if ($dom eq $domain) { 71: $howpwd = $auth; 72: $contentpwd = $autharg; 73: last; 74: } 75: } 76: } else { 77: print STDOUT "Warning: could not open $domaintab to retrieve default authentication information for the domain: $domain.\n"; 78: } 79: if ($howpwd eq '' || $contentpwd eq '') { 80: print STDOUT "Warning: could not determine default authentication and/or argument from $domaintab for domain: $domain\n"; 81: } else { 82: if ($howpwd =~ /^krb(4|5)$/) { 83: if ($1 ne $version) { 84: 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"; 85: } 86: } else { 87: print STDOUT "Warning: the default authentication - $howpwd - in $domaintab for this domain ($domain) is not for Kerberos authentication\n"; 88: } 89: if ($contentpwd ne $realm) { 90: 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"; 91: } 92: } 93: } else { 94: print STDOUT "Warning: could not access $domaintab to retrieve default authentication information for the domain.\n"; 95: } 96: } 97: if ($realm ne '') { 98: if ($version != 4 && $version != 5) { 99: $response = "Kerberos check failed - unexpected kerberos version - $version (this should be 4 or 5)"; 100: } else { 101: if ($version == 5) { 102: $response = &check_krb5($username,$realm,$password); 103: } elsif ($version == 4) { 104: $response = &check_krb4($username,$realm,$password); 105: } 106: } 107: } else { 108: $response = "Kerberos check failed - Kerberos realm is blank"; 109: } 110: } 111: print STDOUT "$response\n"; 112: 113: sub check_krb4 { 114: my ($username,$realm,$password) = @_; 115: my ($krbreturn,$response); 116: eval { 117: require Authen::Krb4; 118: }; 119: if (!$@) { 120: $krbreturn = &Authen::Krb4::get_pw_in_tkt($username,'',$realm,'krbtgt',$realm,1,$password); 121: if ($krbreturn == 0) { 122: $response = "Kerberos check passed. Kerberos 4. User: $username - response was $krbreturn"; 123: } else { 124: $response = "Kerberos check failed. Kerberos 4. User: $username - response was $krbreturn"; 125: } 126: } else { 127: $response = 'Kerberos check failed. Kerberos '.$version. 128: ' requires "perl-Authen-Krb4" which does not appear to be installed.'."\n". 129: 'This may be because you are using revision 1.7 or later of the krb5 package,'. 130: ' which no longer supports Kerberos 4.'."\n".'Checking with Kerberos 5 instead:'."\n". 131: &check_krb5($username,$realm,$password); 132: } 133: return $response; 134: } 135: 136: sub check_krb5 { 137: my ($username,$realm,$password) = @_; 138: &Authen::Krb5::init_context(); 139: my $krbclient = &Authen::Krb5::parse_name($username.'@'.$realm); 140: my $krbservice = "krbtgt/".$realm."\@".$realm; 141: my $krbserver = &Authen::Krb5::parse_name($krbservice); 142: my $credentials= &Authen::Krb5::cc_default(); 143: $credentials->initialize(&Authen::Krb5::parse_name($username.'@'.$realm)); 144: my ($krbreturn,$response); 145: if (exists(&Authen::Krb5::get_init_creds_password)) { 146: $krbreturn = &Authen::Krb5::get_init_creds_password(&Authen::Krb5::parse_name($username.'@'.$realm), 147: $password,$krbservice); 148: if (ref($krbreturn) eq 'Authen::Krb5::Creds') { 149: $response = "Kerberos check passed. Kerberos 5. User: $username - response from Authen::Krb 5 was Creds object\n"; 150: } else { 151: $response = "Kerberos check failed. Kerberos 5. User: $username - response was $krbreturn"; 152: } 153: } else { 154: $krbreturn = &Authen::Krb5::get_in_tkt_with_password($krbclient,$krbserver, 155: $password,$credentials); 156: if ($krbreturn == 1) { 157: $response = "Kerberos check passed. Kerberos 5. User: $username - response was $krbreturn"; 158: } else { 159: $response = "Kerberos check failed. Kerberos 5. User: $username - response was $krbreturn"; 160: } 161: } 162: return $response; 163: } 164: