Annotation of loncom/debugging_tools/testkerberos.pl, revision 1.2
1.1 raeburn 1: #!/usr/bin/perl
2: # The LearningOnline Network
3: #
4: # testkerberos.pl - Checks if Kerberos authentication is functional in the domain
5: #
1.2 ! raeburn 6: # $Id: testkerberos.pl,v 1.1 2008/02/11 17:21:34 raeburn Exp $
1.1 raeburn 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) {
1.2 ! raeburn 102: $response = &check_krb5($username,$realm,$password);
1.1 raeburn 103: } elsif ($version == 4) {
1.2 ! raeburn 104: $response = &check_krb4($username,$realm,$password);
1.1 raeburn 105: }
106: }
107: } else {
108: $response = "Kerberos check failed - Kerberos realm is blank";
109: }
110: }
111: print STDOUT "$response\n";
112:
1.2 ! raeburn 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:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to testkerberos.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / debugging_tools