File:
[LON-CAPA] /
loncom /
debugging_tools /
testkerberos.pl
Revision
1.1:
download - view:
text,
annotated -
select for diffs
Mon Feb 11 17:21:34 2008 UTC (16 years, 6 months ago) by
raeburn
Branches:
MAIN
CVS tags:
version_2_9_99_0,
version_2_8_X,
version_2_8_99_0,
version_2_8_2,
version_2_8_1,
version_2_8_0,
version_2_7_X,
version_2_7_99_1,
version_2_7_99_0,
version_2_7_1,
version_2_7_0,
version_2_6_99_1,
version_2_6_99_0,
bz6209-base,
bz6209,
bz5969,
bz2851,
HEAD,
GCI_3,
GCI_2,
GCI_1,
BZ5971-printing-apage,
BZ5434-fox
- 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.
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.1 2008/02/11 17:21:34 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: use Authen::Krb4;
34:
35: print STDOUT "Enter your LON-CAPA domain, (e.g., msu): ";
36: my $domain = <STDIN>;
37: chomp($domain);
38: print STDOUT "Enter the Kerberos version (4 or 5): ";
39: my $version = <STDIN>;
40: chomp($version);
41: print STDOUT "Enter the Kerberos realm, (e.g., MSU.EDU): ";
42: my $realm = <STDIN>;
43: chomp($realm);
44: print STDOUT "Enter a username which uses Kerberos authentication: ";
45: my $username = <STDIN>;
46: chomp($username);
47: print STDOUT "Enter the password for this user: ";
48: system ("stty -echo");
49: my $password= <STDIN>;
50: system ("stty echo");
51: chomp ($password);
52: print STDOUT "\n";
53:
54: my $response;
55: if ($username eq '' || $password eq '') {
56: $response = "Kerberos check failed - either the username or the password was blank";
57: } else {
58: my $domaintab = '/home/httpd/lonTabs/domain.tab';
59: if ($domain eq '') {
60: print STDOUT "Warning: Domain is blank. It will not be possible to retrieve default authentication information for the domain.\n";
61: } else {
62: if (-e "$domaintab") {
63: my ($howpwd,$contentpwd);
64: if (open(my $fh,"<$domaintab")) {
65: my @lines = <$fh>;
66: close($fh);
67: chomp(@lines);
68: foreach my $line (@lines) {
69: next if ($line =~ /^#/);
70: my ($dom,$desc,$auth,$autharg,$lang,$loc,$long,$lat,$primary) = split(/:/,$line);
71: if ($dom eq $domain) {
72: $howpwd = $auth;
73: $contentpwd = $autharg;
74: last;
75: }
76: }
77: } else {
78: print STDOUT "Warning: could not open $domaintab to retrieve default authentication information for the domain: $domain.\n";
79: }
80: if ($howpwd eq '' || $contentpwd eq '') {
81: print STDOUT "Warning: could not determine default authentication and/or argument from $domaintab for domain: $domain\n";
82: } else {
83: if ($howpwd =~ /^krb(4|5)$/) {
84: if ($1 ne $version) {
85: 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";
86: }
87: } else {
88: print STDOUT "Warning: the default authentication - $howpwd - in $domaintab for this domain ($domain) is not for Kerberos authentication\n";
89: }
90: if ($contentpwd ne $realm) {
91: 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";
92: }
93: }
94: } else {
95: print STDOUT "Warning: could not access $domaintab to retrieve default authentication information for the domain.\n";
96: }
97: }
98: if ($realm ne '') {
99: if ($version != 4 && $version != 5) {
100: $response = "Kerberos check failed - unexpected kerberos version - $version (this should be 4 or 5)";
101: } else {
102: my $krbreturn;
103: if ($version == 5) {
104: &Authen::Krb5::init_context();
105: my $krbclient = &Authen::Krb5::parse_name($username.'@'.$realm);
106: my $krbservice = "krbtgt/".$realm."\@".$realm;
107: my $krbserver = &Authen::Krb5::parse_name($krbservice);
108: my $credentials= &Authen::Krb5::cc_default();
109: $credentials->initialize(&Authen::Krb5::parse_name($username.'@'.$realm));
110: if (exists(&Authen::Krb5::get_init_creds_password)) {
111: $krbreturn = &Authen::Krb5::get_init_creds_password(&Authen::Krb5::parse_name($username.'@'.$realm),$password,$krbservice);
112: if (ref($krbreturn) eq 'Authen::Krb5::Creds') {
113: $response = "Kerberos check passed. Kerberos $version. User: $username - response from Authen::Krb5 was Creds object\n";
114: } else {
115: $response = "Kerberos check failed. Kerberos $version. User: $username - response was $krbreturn";
116: }
117: } else {
118: $krbreturn = &Authen::Krb5::get_in_tkt_with_password($krbclient,$krbserver,
119: $password,$credentials);
120: if ($krbreturn == 1) {
121: $response = "Kerberos check passed. Kerberos $version. User: $username - response was $krbreturn";
122: } else {
123: $response = "Kerberos check failed. Kerberos $version. User: $username - response was $krbreturn";
124: }
125: }
126: } elsif ($version == 4) {
127: $krbreturn =
128: &Authen::Krb4::get_pw_in_tkt($username,'',$realm,'krbtgt',$realm,1,$password);
129: if ($krbreturn == 0) {
130: $response = "Kerberos check passed. Kerberos $version. User: $username - response was $krbreturn";
131: } else {
132: $response = "Kerberos check failed. Kerberos $version. User: $username - response was $krbreturn";
133: }
134: }
135: }
136: } else {
137: $response = "Kerberos check failed - Kerberos realm is blank";
138: }
139: }
140: print STDOUT "$response\n";
141:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>