Added way to clean things during a fork for kadmin

The MIT kadmin module currently directly runs the MIT kadmin program.  Some
data needs to be cleaned during the forks for this.  This provides a
callback that can be registered and is called during the fork process,
currently just to mark database handles inactive.  It was added to both the
MIT and Heimdal modules, though it's only a stub in the Heimdal module.
Heimdal is not forking kadmin, but the stub is there in order to allow the
caller to not care which module is being used and just always register the
callbacks.

4 files changed, 32 insertions, 9 deletions

diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm
index 9c2805b..b0010a5 100644
--- a/perl/Wallet/Kadmin/Heimdal.pm
+++ b/perl/Wallet/Kadmin/Heimdal.pm
@@ -39,6 +39,11 @@ sub error {
     return $self->{error};
 }
 
+# Set a callback to be called for forked kadmin processes.  This does nothing
+# for Heimdal, as we're not forking anything, but remains for compatibility
+# with the MIT kadmin module.
+sub fork_callback { }
+
 ##############################################################################
 # kadmin Interaction
 ##############################################################################
diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm
index 2e9b0b4..c3ad901 100644
--- a/perl/Wallet/Kadmin/MIT.pm
+++ b/perl/Wallet/Kadmin/MIT.pm
@@ -39,6 +39,12 @@ sub error {
     return $self->{error};
 }
 
+# Set a callback to be called for forked kadmin processes.
+sub fork_callback {
+    my ($self, $callback) = @_;
+    $self->{fork_callback} = $callback;
+}
+
 ##############################################################################
 # kadmin Interaction
 ##############################################################################
@@ -73,11 +79,7 @@ sub kadmin {
         $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
-        # careful about our database handles.  (We still lose if there's some
-        # other database handle open we don't know about.)
-        #$object->{dbh}->{InactiveDestroy} = 1;
+        $self->{fork_callback} ();
         unless (open (STDERR, '>&STDOUT')) {
             warn "wallet: cannot dup stdout: $!\n";
             exit 1;
diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm
index 6733cf0..22598f1 100644
--- a/perl/Wallet/Object/Keytab.pm
+++ b/perl/Wallet/Object/Keytab.pm
@@ -466,6 +466,11 @@ sub new {
     my $kadmin = Wallet::Kadmin->new ();
     $self->{kadmin} = $kadmin;
 
+    # Set a callback for things to do after a fork, specifically for the MIT
+    # kadmin module which forks to kadmin.
+    my $callback = sub { $self->{dbh}->{InactiveDestroy} = 1 };
+    $kadmin->fork_callback ($callback);
+
     $self = $class->SUPER::new ($type, $name, $dbh);
     $self->{kadmin} = $kadmin;
     return $self;
@@ -484,8 +489,14 @@ sub create {
     bless $self, $class;
     my $kadmin = Wallet::Kadmin->new ();
     $self->{kadmin} = $kadmin;
+
+    # Set a callback for things to do after a fork, specifically for the MIT
+    # kadmin module which forks to kadmin.
+    my $callback = sub { $self->{dbh}->{InactiveDestroy} = 1 };
+    $kadmin->fork_callback ($callback);
+
     if (not $kadmin->addprinc ($name)) {
-        die $kadmin->error;
+        die $kadmin->error, "\n";
     }    
     $self = $class->SUPER::create ($type, $name, $dbh, $creator, $host, $time);
     $self->{kadmin} = $kadmin;
diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t
index 7423ed1..8ecc2c1 100755
--- a/perl/t/kadmin.t
+++ b/perl/t/kadmin.t
@@ -8,7 +8,7 @@
 # See LICENSE for licensing terms.
 
 use POSIX qw(strftime);
-use Test::More tests => 15;
+use Test::More tests => 17;
 
 use Wallet::Admin;
 use Wallet::Config;
@@ -34,11 +34,16 @@ for my $good (qw{service service/foo bar foo/bar host/example.org
         "Valid principal name $good");
 }
 
-# Test creating an MIT object.  We don't care about anything but correctly
-# creating it -- testing operations is for the keytab tests.
+# Test creating an MIT object and seeing if the callback works.
 $Wallet::Config::KEYTAB_KRBTYPE = 'MIT';
 my $kadmin = Wallet::Kadmin->new ();
 ok (defined ($kadmin), 'MIT kadmin object created');
+my $callback = sub { return 1 };
+$kadmin->fork_callback ($callback);
+is ($kadmin->{fork_callback} (), 1, ' and callback works.');
+my $callback = sub { return 2 };
+$kadmin->fork_callback ($callback);
+is ($kadmin->{fork_callback} (), 2, ' and changing it works.');
 
 # Test creating a Heimdal object.  For us to test a working Heimdal object,
 # we need a properly configured Heimdal KDC.  So instead, we deliberately