# $Id: Key.pm,v 1.3 2002/10/09 20:42:42 steiner Exp $
use Carp;
use strict;
use vars qw($VERSION);
$VERSION = do{my@r=q$Revision: 1.3 $=~/\d+/g;sprintf '%d.'.'%02d'x$#r,@r};
# If value is 1, the value is read/write and we build the accessor function;
# if 0, the value is read-only and an accessor function is built.
# if -1, the accessor function is written by hand
my %Key_Fields = (
'version' => 1, # XXX writable?
'kvno' => 1, # XXX writable?
'type' => -1,
'length' => -1,
'contents' => -1,
);
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my %args = @_;
# checks => level
# lineno => N
# version => N
# kvno => N
# data => array of type,len,contents tuples
my $self = {};
$self->{'_data_cntr'} = -1;
# check arguments
if (not defined($args{'version'})) {
croak "version for Key data not defined at line $args{'lineno'}";
}
if (not defined($args{'kvno'})) {
croak "kvno for Key data not defined at line $args{'lineno'}";
}
if (not defined($args{'data'}) or @{$args{'data'}} < 1) {
croak "data for Key data not defined at line $args{'lineno'}";
}
$self->{'version'} = $args{'version'};
$self->{'kvno'} = $args{'kvno'};
$self->{'data'} = [];
foreach my $tuple (@{$args{'data'}}) {
my $p = {};
$p->{'type'} = $tuple->[0];
$p->{'length'} = $tuple->[1];
$p->{'contents'} = $tuple->[2];
# probably already checked but let's make sure
if ($args{'checks'}) {
if (check_length($p->{'length'}*2, $p->{'contents'})) {
carp "key contents length field not ok at line $args{'lineno'}";
}
}
push @{$self->{'data'}}, $p;
}
if ($args{'checks'} == 2) {
_check_level2($self, $args{'lineno'});
}
bless($self, $class);
return $self;
}
sub _check_level2 ($$) {
my $self = shift;
my $lineno = shift;
if ($self->{'version'} !~ /^\d+$/) {
carp "key version is not valid at line $lineno: $self->{'version'}";
}
if ($self->{'kvno'} !~ /^\d+$/) {
carp "key kvno is not valid at line $lineno: $self->{'kvno'}";
}
foreach my $data (@{$self->{'data'}}) {
if ($data->{'type'} !~ /^\d+$/) {
carp "key type is not valid at line $lineno: $data->{'type'}";
}
if ($data->{'length'} !~ /^\d+$/) {
carp "key length is not valid at line $lineno: $data->{'length'}";
}
if ($data->{'contents'} ne '-1' and
$data->{'contents'} !~ /^[\da-f]+$/) {
carp "key contents is not valid at line $lineno: $data->{'contents'}";
}
}
}
#XXX what is format???
sub parse_contents {
my $self = shift;
my $byte = 8;
my $template = "A2" x $self->length();
my @modname;
my $modname = '';
my $octet = 0;
@modname = map hex, unpack($template, $self->contents());
$modname = join '', map chr, @modname;
return $modname;
}
sub next_data {
my $self = shift;
if (defined($self->{'data'}[$self->{'_data_cntr'}+1])) {
$self->{'_data_cntr'}++;
return 1;
} else {
$self->{'_data_cntr'} = -1;
return 0;
}
}
sub type {
my $self = shift;
carp "Can't change value via type method" if @_;
carp "Need to call the next_data method before calling type method"
if ($self->{'_data_cntr'} == -1);
return $self->{'data'}[$self->{'_data_cntr'}]->{'type'};
}
sub length {
my $self = shift;
carp "Can't change value via length method" if @_;
carp "Need to call the next_data method before calling length method"
if ($self->{'_data_cntr'} == -1);
return $self->{'data'}[$self->{'_data_cntr'}]->{'length'};
}
sub contents {
my $self = shift;
carp "Need to call the next_data method before calling contents method"
if ($self->{'_data_cntr'} == -1);
if (@_) {
$self->{'data'}[$self->{'_data_cntr'}]->{'contents'} = shift;
# length is the number of hex pairs
$self->{'data'}[$self->{'_data_cntr'}]->{'length'} =
CORE::length($self->{'data'}[$self->{'_data_cntr'}]->{'contents'})/2;
}
return $self->{'data'}[$self->{'_data_cntr'}]->{'contents'};
}
# generate rest of accessor methods
foreach my $field (keys %Key_Fields) {
no strict "refs";
if ($Key_Fields{$field} == 1) {
*$field = sub {
my $self = shift;
$self->{$field} = shift if @_;
return $self->{$field};
};
} elsif (not $Key_Fields{$field}) {
*$field = sub {
my $self = shift;
carp "Can't change value via $field method" if @_;
return $self->{$field};
};
}
}
1;
__END__
=head1 NAME
Authen::Krb5::KDB::Key - objects for Kerberos V5 database Key data
=head1 SYNOPSIS
use Authen::Krb5::KDB::Key;
Authen::Krb5::KDB::Key->new ( checks => N,
lineno => N,
version => $version,
kvno => $kvno,
data => $data );
foreach my $key (@{$principal->key_data()}) {
print " Ver: ", $key->version(), "\n";
print "Kvno: ", $key->kvno(), "\n";
while ($key->next_data()) {
print " Type: ", $key->type(), "\n";
print " Length: ", $key->length(), "\n";
print " Contents: ", $key->contents(), "\n";
}
}
=head1 DESCRIPTION
Generally this functions are only used internally within other KDB modules.
=over 4
=item new()
=item version
=item kvno
=item next_data()
=item type (I<read only>)
=item length (I<read only>)
=item contents
=item parse_contents
Parse hexadecimal contents and return as a string.
=back
=head1 AUTHOR
Dave Steiner, E<lt>steiner@bakerst.rutgers.eduE<gt>
=head1 COPYRIGHT
Copyright (c) 2002 David K. Steiner. All rights reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 SEE ALSO
perl(1), kerberos(1), Authen::Krb5::KDB, Authen::Krb5::KDB_H,
Authen::Krb5::KDB::V5, Authen::Krb5::KDB::V4, Authen::Krb5::KDB::V3.
=cut