Improved error handling for Kadmin sub-modules

Improved error handling by adding an error function to the Kadmin sub-modules
which will copy errors down to the Wallet::Object::Keytab error function
rather than relying on too many dies and evals.  There still needs to be more
cleanup here, but that will rely on work on Heimdal::Kadm5 as well, to clean
up its own error handling to not spam warnings when called without RaiseError.
Also caught a few more un-evaled error cases where Heimdal::Kadm5 was called,
and fixed an error where RaiseErrors was being set rather than RaiseError due
to an error in Heimdal::Kadm5 docs.

2 files changed, 145 insertions, 56 deletions

diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm
index a05362e..9c2805b 100644
--- a/perl/Wallet/Kadmin/Heimdal.pm
+++ b/perl/Wallet/Kadmin/Heimdal.pm
@@ -21,7 +21,23 @@ use Wallet::Config ();
 # This version should be increased on any code change to this module.  Always
 # use two digits for the minor version with a leading zero if necessary so
 # that it will sort properly.
-$VERSION = '0.02';
+$VERSION = '0.03';
+
+##############################################################################
+# Utility functions
+##############################################################################
+
+# Set or return the error stashed in the object.
+sub error {
+    my ($self, @error) = @_;
+    if (@error) {
+        my $error = join ('', @error);
+        chomp $error;
+        1 while ($error =~ s/ at \S+ line \d+\.?\z//);
+        $self->{error} = $error;
+    }
+    return $self->{error};
+}
 
 ##############################################################################
 # kadmin Interaction
@@ -30,17 +46,18 @@ $VERSION = '0.02';
 # Create a Heimdal::Kadm5 client object and return it.  It should load
 # configuration from Wallet::Config.
 sub kadmin_client {
+    my ($self) = @_;
     unless (defined ($Wallet::Config::KEYTAB_PRINCIPAL)
             and defined ($Wallet::Config::KEYTAB_FILE)
             and defined ($Wallet::Config::KEYTAB_REALM)) {
         die "keytab object implementation not configured\n";
     }
     my $server = $Wallet::Config::KEYTAB_HOST || 'localhost';
-    my @options = (RaiseErrors => 1,
-                   Server      => $server,
-                   Principal   => $Wallet::Config::KEYTAB_PRINCIPAL,
-                   Realm       => $Wallet::Config::KEYTAB_REALM,
-                   Keytab      => $Wallet::Config::KEYTAB_FILE);
+    my @options = (RaiseError => 1,
+                   Server     => $server,
+                   Principal  => $Wallet::Config::KEYTAB_PRINCIPAL,
+                   Realm      => $Wallet::Config::KEYTAB_REALM,
+                   Keytab     => $Wallet::Config::KEYTAB_FILE);
     my $client = Heimdal::Kadm5::Client->new (@options);
     return $client;
 }
@@ -50,28 +67,34 @@ sub kadmin_client {
 ##############################################################################
 
 # Check whether a given principal already exists in Kerberos.  Returns true if
-# so, false otherwise.  Throws an exception if an error.
+# so, false otherwise.
 sub exists {
     my ($self, $principal) = @_;
     if ($Wallet::Config::KEYTAB_REALM) {
         $principal .= '@' . $Wallet::Config::KEYTAB_REALM;
     }
     my $kadmin = $self->{client};
-    my $princdata = $kadmin->getPrincipal ($principal);
+    my $princdata = eval { $kadmin->getPrincipal ($principal) };
+    if ($@) {
+        $self->error ("error getting principal: $@");
+        return;
+    }
     return $princdata ? 1 : 0;
 }
 
-# Create a principal in Kerberos.  Since this is only called by create, it
-# throws an exception on failure rather than setting the error and returning
-# undef.
+# Create a principal in Kerberos.  If there is an error, return undef and set
+# the error.  Return 1 on success or the principal already existing.
 sub addprinc {
     my ($self, $principal) = @_;
 
-    my $exists = eval { $self->exists ($principal) };
     if ($Wallet::Config::KEYTAB_REALM) {
         $principal .= '@' . $Wallet::Config::KEYTAB_REALM;
     }
-    die "error adding principal $principal: $@\n" if $@;
+    my $exists = eval { $self->exists ($principal) };
+    if ($@) {
+        $self->error ("error adding principal $principal: $@");
+        return undef;
+    }
     return 1 if $exists;
 
     # The way Heimdal::Kadm5 works, we create a principal object, create the
@@ -80,21 +103,34 @@ sub addprinc {
     #        on creation even if it is inactive until after randomized by
     #        module.
     my $kadmin = $self->{client};
-    my $princdata = $kadmin->makePrincipal ($principal);
+    my $princdata = eval { $kadmin->makePrincipal ($principal) };
+    if ($@) {
+        $self->error ("error adding principal $principal: $@");
+        return;
+    }
 
     # Disable the principal before creating, until we've randomized the
     # password.
-    my $attrs = $princdata->getAttributes;
+    my $attrs = eval { $princdata->getAttributes };
+    if ($@) {
+        $self->error ("error adding principal $principal: $@");
+        return;
+    }
     $attrs |= KRB5_KDB_DISALLOW_ALL_TIX;
-    $princdata->setAttributes ($attrs);
+    eval { $princdata->setAttributes ($attrs) };
+    if ($@) {
+        $self->error ("error adding principal $principal: $@");
+        return;
+    }
 
     my $password = 'inactive';
-    eval {
-        $kadmin->createPrincipal ($princdata, $password, 0);
-        $kadmin->randKeyPrincipal ($principal);
-        $kadmin->enablePrincipal ($principal);
-    };
-    die "error adding principal $principal: $@" if $@;
+    my $test = eval { $kadmin->createPrincipal ($princdata, $password, 0) };
+    eval { $kadmin->randKeyPrincipal ($principal) } unless $@;
+    eval { $kadmin->enablePrincipal ($principal) } unless $@;
+    if ($@) {
+        $self->error ("error adding principal $principal: $@");
+        return;
+    }
     return 1;
 }
 
@@ -114,13 +150,19 @@ sub ktadd {
     # to those we have been asked for this time.
     my $kadmin = $self->{client};
     eval { $kadmin->randKeyPrincipal ($principal) };
-    die "error creating keytab for $principal: could not reinit enctypes: $@\n"
-        if $@;
+    if ($@) {
+        $self->error ("error creating keytab for $principal: could not "
+                      ."reinit enctypes: $@");
+        return;
+    }
     my $princdata = eval { $kadmin->getPrincipal ($principal) };
     if ($@) {
-        die "error creating keytab for $principal: $@\n";
+        $self->error ("error creating keytab for $principal: $@");
+        return;
     } elsif (!$princdata) {
-        die "error creating keytab for $principal: principal does not exist\n";
+        $self->error ("error creating keytab for $principal: principal does "
+                      ."not exist");
+        return;
     }
 
     # Now actually remove any non-requested enctypes, if we requested any.
@@ -132,13 +174,24 @@ sub ktadd {
             my $keytype = ${$key}[0];
             next if exists $wanted{$keytype};
             eval { $princdata->delKeytypes ($keytype) };
-            die "error removing keytype $keytype from the keytab: $@\n" if $@;
+            if ($@) {
+                $self->error ("error removing keytype $keytype from the ".
+                              "keytab: $@");
+                return;
+            }
         }
         eval { $kadmin->modifyPrincipal ($princdata) };
+        if ($@) {
+            $self->error ("error saving principal modifications: $@");
+            return;
+        }
     }
 
     eval { $kadmin->extractKeytab ($princdata, $file) };
-    die "error creating keytab for principal: $@\n" if $@;
+    if ($@) {
+        $self->error ("error creating keytab for principal: $@");
+        return;
+    }
 
     return 1;
 }
@@ -149,8 +202,10 @@ sub ktadd {
 sub delprinc {
     my ($self, $principal) = @_;
     my $exists = eval { $self->exists ($principal) };
-    die $@ if $@;
-    if (not $exists) {
+    if ($@) {
+        $self->error ("error checking principal existance: $@");
+        return;
+    } elsif (not $exists) {
         return 1;
     }
     if ($Wallet::Config::KEYTAB_REALM) {
@@ -159,7 +214,10 @@ sub delprinc {
 
     my $kadmin = $self->{client};
     my $retval = eval { $kadmin->deletePrincipal ($principal) };
-    die "error deleting $principal: $@\n" if $@;
+    if ($@) {
+        $self->error ("error deleting $principal: $@");
+        return;
+    }
     return 1;
 }
 
@@ -173,9 +231,10 @@ sub delprinc {
 sub new {
     my ($class) = @_;
     my $self = {
-        client => kadmin_client (),
+        client => undef,
     };
     bless ($self, $class);
+    $self->{client} = kadmin_client ();
     return $self;
 }
 
diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm
index 7bbb248..2e9b0b4 100644
--- a/perl/Wallet/Kadmin/MIT.pm
+++ b/perl/Wallet/Kadmin/MIT.pm
@@ -21,7 +21,23 @@ use Wallet::Config ();
 # This version should be increased on any code change to this module.  Always
 # use two digits for the minor version with a leading zero if necessary so
 # that it will sort properly.
-$VERSION = '0.01';
+$VERSION = '0.02';
+
+##############################################################################
+# Utility functions
+##############################################################################
+
+# Set or return the error stashed in the object.
+sub error {
+    my ($self, @error) = @_;
+    if (@error) {
+        my $error = join ('', @error);
+        chomp $error;
+        1 while ($error =~ s/ at \S+ line \d+\.?\z//);
+        $self->{error} = $error;
+    }
+    return $self->{error};
+}
 
 ##############################################################################
 # kadmin Interaction
@@ -54,7 +70,8 @@ sub kadmin {
         if $Wallet::Config::KEYTAB_REALM;
     my $pid = open (KADMIN, '-|');
     if (not defined $pid) {
-        die "cannot fork: $!\n";
+        $self->error ("cannot fork: $!");
+        return;
     } elsif ($pid == 0) {
         # TODO - How should I handle the db handle?
         # Don't use die here; it will get trapped as an exception.  Also be
@@ -75,7 +92,8 @@ sub kadmin {
     while (<KADMIN>) {
         if (/^wallet: cannot /) {
             s/^wallet: //;
-            die $_;
+            $self->error ($_);
+            return;
         }
         push (@output, $_) unless /Authenticating as principal/;
     }
@@ -88,7 +106,8 @@ sub kadmin {
 ##############################################################################
 
 # Check whether a given principal already exists in Kerberos.  Returns true if
-# so, false otherwise.  Throws an exception if kadmin fails.
+# so, false otherwise.  Returns undef if kadmin fails, with the error already
+# set by kadmin.
 sub exists {
     my ($self, $principal) = @_;
     return unless $self->valid_principal ($principal);
@@ -96,20 +115,22 @@ sub exists {
         $principal .= '@' . $Wallet::Config::KEYTAB_REALM;
     }
     my $output = $self->kadmin ("getprinc $principal");
-    if ($output =~ /^get_principal: /) {
+    if (!defined $output) {
         return;
+    } elsif ($output =~ /^get_principal: /) {
+        return 0;
     } else {
         return 1;
     }
 }
 
-# Create a principal in Kerberos.  Since this is only called by create, it
-# throws an exception on failure rather than setting the error and returning
-# undef.
+# Create a principal in Kerberos.  Sets the error and returns undef on failure,
+# and returns 1 on either success or the principal already existing.
 sub addprinc {
     my ($self, $principal) = @_;
     unless ($self->valid_principal ($principal)) {
-        die "invalid principal name $principal\n";
+        $self->error ("invalid principal name $principal");
+        return;
     }
     return 1 if $self->exists ($principal);
     if ($Wallet::Config::KEYTAB_REALM) {
@@ -117,8 +138,11 @@ sub addprinc {
     }
     my $flags = $Wallet::Config::KEYTAB_FLAGS || '';
     my $output = $self->kadmin ("addprinc -randkey $flags $principal");
-    if ($output =~ /^add_principal: (.*)/m) {
-        die "error adding principal $principal: $1\n";
+    if (!defined $output) {
+        return;
+    } elsif ($output =~ /^add_principal: (.*)/m) {
+        $self->error ("error adding principal $principal: $1");
+        return;
     }
     return 1;
 }
@@ -130,7 +154,8 @@ sub addprinc {
 sub ktadd {
     my ($self, $principal, $file, @enctypes) = @_;
     unless ($self->valid_principal ($principal)) {
-        die "invalid principal name: $principal\n";
+        $self->error ("invalid principal name: $principal");
+        return;
     }
     if ($Wallet::Config::KEYTAB_REALM) {
         $principal .= '@' . $Wallet::Config::KEYTAB_REALM;
@@ -140,10 +165,12 @@ sub ktadd {
         @enctypes = map { /:/ ? $_ : "$_:normal" } @enctypes;
         $command .= ' -e "' . join (' ', @enctypes) . '"';
     }
-    my $output = eval { $self->kadmin ("$command $principal") };
-    die ($@) if ($@);
-    if ($output =~ /^(?:kadmin|ktadd): (.*)/m) {
-        die "error creating keytab for $principal: $1\n";
+    my $output = $self->kadmin ("$command $principal");
+    if (!defined $output) {
+        return;
+    } elsif ($output =~ /^(?:kadmin|ktadd): (.*)/m) {
+        $self->error ("error creating keytab for $principal: $1");
+        return;
     }
     return 1;
 }
@@ -154,20 +181,23 @@ sub ktadd {
 sub delprinc {
     my ($self, $principal) = @_;
     unless ($self->valid_principal ($principal)) {
-        die "invalid principal name: $principal\n";
+        $self->error ("invalid principal name: $principal");
     }
-    my $exists = eval { $self->exists ($principal) };
-    die $@ if $@;
-    if (not $exists) {
+    my $exists = $self->exists ($principal);
+    if (!defined $exists) {
+        return;
+    } elsif (not $exists) {
         return 1;
     }
     if ($Wallet::Config::KEYTAB_REALM) {
         $principal .= '@' . $Wallet::Config::KEYTAB_REALM;
     }
-    my $output = eval { $self->kadmin ("delprinc -force $principal") };
-    die $@ if $@;
-    if ($output =~ /^delete_principal: (.*)/m) {
-        die "error deleting $principal: $1\n";
+    my $output = $self->kadmin ("delprinc -force $principal");
+    if (!defined $output) {
+        return;
+    } elsif ($output =~ /^delete_principal: (.*)/m) {
+        $self->error ("error deleting $principal: $1");
+        return;
     }
     return 1;
 }