summaryrefslogtreecommitdiff
path: root/perl
diff options
context:
space:
mode:
Diffstat (limited to 'perl')
-rw-r--r--perl/Wallet/Kadmin/Heimdal.pm123
-rw-r--r--perl/Wallet/Kadmin/MIT.pm78
-rw-r--r--perl/Wallet/Object/Keytab.pm15
3 files changed, 154 insertions, 62 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;
}
diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm
index 092e973..6733cf0 100644
--- a/perl/Wallet/Object/Keytab.pm
+++ b/perl/Wallet/Object/Keytab.pm
@@ -484,7 +484,9 @@ sub create {
bless $self, $class;
my $kadmin = Wallet::Kadmin->new ();
$self->{kadmin} = $kadmin;
- $kadmin->addprinc ($name);
+ if (not $kadmin->addprinc ($name)) {
+ die $kadmin->error;
+ }
$self = $class->SUPER::create ($type, $name, $dbh, $creator, $host, $time);
$self->{kadmin} = $kadmin;
return $self;
@@ -517,7 +519,10 @@ sub destroy {
return;
}
my $kadmin = $self->{kadmin};
- return if not $kadmin->delprinc ($self->{name});
+ if (not $kadmin->delprinc ($self->{name})) {
+ $self->error ($kadmin->error);
+ return;
+ }
return $self->SUPER::destroy ($user, $host, $time);
}
@@ -546,12 +551,10 @@ sub get {
unlink $file;
my @enctypes = $self->attr ('enctypes');
my $kadmin = $self->{kadmin};
- my $retval = eval { $kadmin->ktadd ($self->{name}, $file, @enctypes) };
- if ($@) {
- $self->error ($@);
+ if (not $kadmin->ktadd ($self->{name}, $file, @enctypes)) {
+ $self->error ($kadmin->error);
return;
}
- return unless $retval;
local *KEYTAB;
unless (open (KEYTAB, '<', $file)) {
my $princ = $self->{name};
generated by cgit v1.2.3 (git 2.39.1) at 2025-10-31 03:02:02 +0000