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, 5 months 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_5_msu,
version_2_11_5,
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:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>