Return to testkerberos.pl CVS log

Up to [LON-CAPA] / loncom / debugging_tools

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