--- loncom/debugging_tools/testkerberos.pl	2008/02/11 17:21:34	1.1
+++ loncom/debugging_tools/testkerberos.pl	2010/04/12 20:07:45	1.2
@@ -3,7 +3,7 @@
 #
 # testkerberos.pl - Checks if Kerberos authentication is functional in the domain
 #
-# $Id: testkerberos.pl,v 1.1 2008/02/11 17:21:34 raeburn Exp $
+# $Id: testkerberos.pl,v 1.2 2010/04/12 20:07:45 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -30,7 +30,6 @@
 #################################################
 use strict;
 use Authen::Krb5;
-use Authen::Krb4;
 
 print STDOUT "Enter your LON-CAPA domain, (e.g., msu): ";
 my $domain = <STDIN>;
@@ -99,38 +98,10 @@ if ($username eq '' || $password eq '')
         if ($version != 4 && $version != 5) {
             $response = "Kerberos check failed - unexpected kerberos version - $version (this should be 4 or 5)";
         } else {
-            my $krbreturn;
             if ($version == 5) {
-                &Authen::Krb5::init_context();
-                my $krbclient = &Authen::Krb5::parse_name($username.'@'.$realm);
-                my $krbservice = "krbtgt/".$realm."\@".$realm;
-                my $krbserver  = &Authen::Krb5::parse_name($krbservice);
-                my $credentials= &Authen::Krb5::cc_default();
-                $credentials->initialize(&Authen::Krb5::parse_name($username.'@'.$realm));
-                if (exists(&Authen::Krb5::get_init_creds_password)) {
-                    $krbreturn = &Authen::Krb5::get_init_creds_password(&Authen::Krb5::parse_name($username.'@'.$realm),$password,$krbservice);
-                    if (ref($krbreturn) eq 'Authen::Krb5::Creds') {
-                        $response = "Kerberos check passed. Kerberos $version. User: $username - response from Authen::Krb5 was Creds object\n";
-                    } else {
-                        $response = "Kerberos check failed. Kerberos $version. User: $username - response was $krbreturn";
-                    }
-                } else {
-                    $krbreturn  = &Authen::Krb5::get_in_tkt_with_password($krbclient,$krbserver,
-                                                                          $password,$credentials);
-                    if ($krbreturn == 1) {
-                        $response = "Kerberos check passed. Kerberos $version. User: $username - response was $krbreturn";
-                    } else {
-                        $response = "Kerberos check failed. Kerberos $version. User: $username - response was $krbreturn";
-                    }
-                }
+                $response = &check_krb5($username,$realm,$password);
             } elsif ($version == 4) {
-                $krbreturn = 
-                     &Authen::Krb4::get_pw_in_tkt($username,'',$realm,'krbtgt',$realm,1,$password);
-                if ($krbreturn == 0) { 
-                    $response = "Kerberos check passed. Kerberos $version. User: $username - response was $krbreturn";
-                } else {
-                    $response = "Kerberos check failed. Kerberos $version. User: $username - response was $krbreturn";
-                }
+                $response = &check_krb4($username,$realm,$password);
             }
         }
     } else {
@@ -139,3 +110,55 @@ if ($username eq '' || $password eq '')
 }
 print STDOUT "$response\n";
 
+sub check_krb4 {
+    my ($username,$realm,$password) = @_;
+    my ($krbreturn,$response);
+    eval {
+        require Authen::Krb4;
+    };
+    if (!$@) {
+        $krbreturn = &Authen::Krb4::get_pw_in_tkt($username,'',$realm,'krbtgt',$realm,1,$password);
+        if ($krbreturn == 0) {
+            $response = "Kerberos check passed. Kerberos 4. User: $username - response was $krbreturn";
+        } else {
+            $response = "Kerberos check failed. Kerberos 4. User: $username - response was $krbreturn";
+        }
+    } else {
+        $response = 'Kerberos check failed. Kerberos '.$version.
+                    ' requires "perl-Authen-Krb4" which does not appear to be installed.'."\n".
+                    'This may be because you are using revision 1.7 or later of the krb5 package,'.
+                    ' which no longer supports Kerberos 4.'."\n".'Checking with Kerberos 5 instead:'."\n".
+                    &check_krb5($username,$realm,$password);
+    }
+    return $response;
+}
+
+sub check_krb5 {
+    my ($username,$realm,$password) = @_;
+    &Authen::Krb5::init_context();
+    my $krbclient = &Authen::Krb5::parse_name($username.'@'.$realm);
+    my $krbservice = "krbtgt/".$realm."\@".$realm;
+    my $krbserver  = &Authen::Krb5::parse_name($krbservice);
+    my $credentials= &Authen::Krb5::cc_default();
+    $credentials->initialize(&Authen::Krb5::parse_name($username.'@'.$realm));
+    my ($krbreturn,$response);
+    if (exists(&Authen::Krb5::get_init_creds_password)) {
+        $krbreturn = &Authen::Krb5::get_init_creds_password(&Authen::Krb5::parse_name($username.'@'.$realm),
+                                                                                      $password,$krbservice);
+        if (ref($krbreturn) eq 'Authen::Krb5::Creds') {
+            $response = "Kerberos check passed. Kerberos 5. User: $username - response from Authen::Krb 5 was Creds object\n";
+        } else {
+            $response = "Kerberos check failed. Kerberos 5. User: $username - response was $krbreturn";
+        }
+    } else {
+        $krbreturn  = &Authen::Krb5::get_in_tkt_with_password($krbclient,$krbserver,
+                                                              $password,$credentials);
+        if ($krbreturn == 1) {
+            $response = "Kerberos check passed. Kerberos 5. User: $username - response was $krbreturn";
+        } else {
+            $response = "Kerberos check failed. Kerberos 5. User: $username - response was $krbreturn";
+        }
+    }
+    return $response;
+}
+