Authen::Krb5::KDB::V4 - objects for Kerberos V5 database V4 principals and policies

    use Authen::Krb5::KDB::V4;

    $p = Authen::Krb5::KDB::V4->new( data => "..." );

    if ($p->type eq 'princ') {
	print $p->name, ": ", $p->fail_auth_count"\n";
    } elsif ($p->type eq 'policy') {
	print $p->name, ": ", $p->policy_refcnt, "\n";
    }

package Authen::Krb5::KDB::V4;

# $Id: V4.pm,v 1.10 2002/10/09 20:41:32 steiner Exp $

use Carp;
use Authen::Krb5::KDB::V3;
use strict;
use vars qw($VERSION @ISA);

@ISA = ( "Authen::Krb5::KDB::V3" );

$VERSION = do{my@r=q$Revision: 1.10 $=~/\d+/g;sprintf '%d.'.'%02d'x$#r,@r};

my %Policy_Fields = (
    'type'           => 0,
    'name'           => 1,
    'pw_min_life'    => 1,
    'pw_max_life'    => 1,
    'pw_min_length'  => 1,
    'pw_min_classes' => 1,
    'pw_history_num' => 1,
    'policy_refcnt'  => 1,
 );

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my %args = @_;
        # checks => level
        # lineno => N
        # data => "string"
    my ($entry_type, $p);

    if ($args{'data'} =~ /^(\w+)\t(.*)$/) {
	$entry_type = $1;
	$args{'raw_data'} = $args{'data'};
	$args{'data'} = $2;
    }

    if ($entry_type eq 'princ') {
	$p = $class->new_princ ( %args );
    } elsif ($entry_type eq 'policy') {
	$p = $class->new_policy ( %args );
    } else {
	carp "Unknown entry type '$entry_type' at line $args{'lineno'}";
	return undef;
    }
    return $p;
}

sub new_policy {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my %args = @_;
        # checks => level
        # lineno => N
        # data => "string"
        # raw_data => "string"
    my $self = {};
    my @data;

    if (defined($args{'data'})) {
	@data = split(/\t/, $args{'data'});
	$self->{'raw_data'} = defined($args{'raw_data'}) ? $args{'raw_data'} : $args{'data'};
    } else {
	croak "data for new policy not defined at line $args{'lineno'}";
    }

    if (scalar @data != scalar(keys %Policy_Fields) - 1) {
	carp "wrong number of data fields for policy at line $args{'lineno'}";
    }

    $self->{'type'} = 'policy';

    $self->{'name'} = shift @data;
    $self->{'pw_min_life'} = shift @data;
    $self->{'pw_max_life'} = shift @data;
    $self->{'pw_min_length'} = shift @data;
    $self->{'pw_min_classes'} = shift @data;
    $self->{'pw_history_num'} = shift @data;
    $self->{'policy_refcnt'} = shift @data;

    if (@data) {
	carp "still data left from policy '$self->{'name'}' at line $args{'lineno'}: '@data'";
    }

    if ($args{'checks'} == 2) {
	_check_level2($self, $args{'lineno'});
    }

    bless($self, $class);
    return $self;
}

sub print_policy {
    my $self = shift;

    if ($self->type() ne 'policy') {
	croak "data is not a policy record but a '" . $self->type . "'";
    }
    print "Policy: ", $self->name(), "\n";
    print "Maximum password life: ", $self->pw_max_life(), "\n";
    print "Minimum password life: ", $self->pw_min_life(), "\n";
    print "Minimum password length: ", $self->pw_min_length(), "\n";
    print "Minimum number of password character classes: ",
            $self->pw_min_classes(), "\n";
    print "Number of old keys kept: ", $self->pw_history_num(), "\n";
    print "Reference count: ", $self->policy_refcnt(), "\n";
    print "\n";
}

sub _check_level2 ($$) {
    my $self = shift;
    my $lineno = shift;

    if ($self->{'name'} !~ /^[!-~]+$/) { # any ASCII printable char
	carp "name is not valid at line $lineno: $self->{'name'}";
    }
    if ($self->{'pw_min_life'} !~ /^\d+$/) {
	carp "pw_min_life is not valid at line $lineno: $self->{'pw_min_life'}";
    }
    if ($self->{'pw_max_life'} !~ /^\d+$/) {
	carp "pw_max_life is not valid at line $lineno: $self->{'pw_max_life'}";
    }
    if ($self->{'pw_min_length'} !~ /^\d+$/) {
	carp "pw_min_length is not valid at line $lineno: $self->{'pw_min_length'}";
    }
    if ($self->{'pw_min_classes'} !~ /^\d+$/) {
	carp "pw_min_classes is not valid at line $lineno: $self->{'pw_min_classes'}";
    }
    if ($self->{'pw_history_num'} !~ /^\d+$/) {
	carp "pw_history_num is not valid at line $lineno: $self->{'pw_history_num'}";
    }
    if ($self->{'policy_refcnt'} !~ /^\d+$/) {
	carp "policy_refcnt is not valid at line $lineno: $self->{'policy_refcnt'}";
    }
}

foreach my $field (keys %Policy_Fields) {
    no strict "refs";
    if ($Policy_Fields{$field}) {
	*$field = sub {
	    my $self = shift;
	    $self->{$field} = shift  if @_;
	    return $self->{$field};
	};
    } else {
	*$field = sub {
	    my $self = shift;
	    carp "Can't change value via $field method"  if @_;
	    return $self->{$field};
	};
    }
}

1;
__END__