auditxml.pm revision c0c79a3f09914f35651895ffc111883455b7f62d
#
# CDDL HEADER START
#
# The contents of this file are subject to the terms of the
# Common Development and Distribution License (the "License").
# You may not use this file except in compliance with the License.
#
# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
# or http://www.opensolaris.org/os/licensing.
# See the License for the specific language governing permissions
# and limitations under the License.
#
# When distributing Covered Code, include this CDDL HEADER in each
# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
# If applicable, add the following below this CDDL HEADER, with the
# fields enclosed by brackets "[]" replaced with your own identifying
# information: Portions Copyright [yyyy] [name of copyright owner]
#
# CDDL HEADER END
#
#
# Copyright 2007 Sun Microsystems, Inc. All rights reserved.
# Use is subject to license terms.
#
# ident "%Z%%M% %I% %E% SMI"
#
use xmlHandlers;
package externalEvent;
1;
sub new {
my $pkg = shift;
my $id = shift;
my $obj = shift;
my @kid = $obj->getKids(); # kids of event are entry or allowed_types
# separate kids into classes and create hash of entries and an
# array of includes
my %entry = ();
my @entry = ();
my @allowed_types = ();
my @include = ();
my $internalName = '';
my $kid;
foreach $kid (@kid) {
my $class = $kid->getClass();
my $kidId = $kid->getAttr('id');
if ($class eq 'entry') {
my $tokenId = 'undefined';
my $format = '';
my $internal = $kid->getKid('internal');
if (defined $internal) {
$tokenId = $internal->getAttr('token');
$format = $internal->getAttr('format');
$format = '' unless defined $format;
}
my $comment;
my $commentKid = $kid->getKid('comment');
if (defined $commentKid) {
$comment = $commentKid->getContent;
}
my $external = $kid->getKid('external');
if (defined ($external)) {
$entry{$kidId} = [$external, $kid, $tokenId, $format, $comment];
push (@entry, $kidId);
}
else {
print STDERR "no external attributes defined for $id/$kidId\n";
}
} # handle event id translation...
elsif ($class eq 'altname') {
$internalName = $kid->getAttr('id');
unless (defined $internalName) {
print STDERR "missing id for internal name of $id\n";
$internalName = 'error';
}
}
elsif ($class eq 'allowed_types') {
my $content = $kid->getContent();
@allowed_types = (@allowed_types, split(/\s*,\s*/, $content));
}
}
my @entryCopy = @entry;
return bless {'id' => $id,
'internalName' => $internalName,
'allowed_types' => \@allowed_types,
'entry' => \%entry,
'entryList' => \@entry,
'entryListCopy' => \@entryCopy,
'include' => \@include,
'xmlObj' => $obj}, $pkg;
}
# return id
sub getExternalName {
my $pkg = shift;
return $pkg->{'id'};
}
# return internal name if it exists, else id
sub getInternalName {
$pkg = shift;
if ($pkg->{'internalName'}) {
return $pkg->{'internalName'};
}
else {
return $pkg->{'id'};
}
}
# getNextEntry reads from 'entryList' destructively
# but resets when the list after the list is emptied
sub getNextEntry {
my $pkg = shift;
unless (@{$pkg->{'entryList'}}) {
@{$pkg->{'entryList'}} = @{$pkg->{'entryListCopy'}};
return undef;
}
my $id = shift @{$pkg->{'entryList'}};
return ($pkg->getEntry($id)); # getEntry returns an array
}
# getEntryIds returns list of all ids from entryList
sub getEntryIds {
my $pkg = shift;
return (@{$pkg->{'entryList'}});
}
# getEntry returns a selected entry for the current event
sub getEntry {
my $pkg = shift;
my $id = shift; #entry id
my $ref = $pkg->{'entry'};
my $array = $$ref{$id};
return @$array;
}
# getNextInclude reads from 'include' destructively
sub getNextInclude {
my $pkg = shift;
return shift @{$pkg->{'include'}};
}
# getIncludes returns list of 'include'
sub getIncludes {
my $pkg = shift;
return @{$pkg->{'include'}};
}
# return a reference to the list of event id's allowed for
# this generic event
sub getAllowedTypes {
my $pkg = shift;
return $pkg->{'allowed_types'};
}
package internalEvent;
1;
sub new {
my $pkg = shift;
my $id = shift;
my $obj = shift;
my @kid = $obj->getKids(); # kids of event are entry
my @entry = ();
my $reorder = 0;
if ($reorder = $obj->getAttr('reorder')) {
$reorder = 1 if $reorder eq 'yes';
}
my $kid;
foreach $kid (@kid) {
my $class = $kid->getClass();
my $id = $kid->getAttr('id');
if ($class eq 'entry') {
my $internal = $kid->getKid('internal');
if (defined ($internal)) {
push (@entry, [$internal, $kid]);
}
else {
print STDERR "no internal attributes defined for $id\n";
}
}
}
return bless {'id' => $id,
'reorder' => $reorder,
'entry' => \@entry,
'xmlObj' => $obj}, $pkg;
}
# getEntries returns a list of all entry references
sub getEntries {
my $pkg = shift;
return undef unless @{$pkg->{'entry'}};
return @{$pkg->{'entry'}};
}
sub isReorder {
my $pkg = shift;
return $pkg->{'reorder'};
}
sub getId {
my $pkg = shift;
return $pkg->{'id'};
}
package eventDef;
%uniqueId = ();
1;
sub new {
my $pkg = shift;
my $id = shift;
my $obj = shift;
my $super = shift;
my $omit;
my $type;
my $header;
my $idNo;
my $javaToo;
my $title = '';
my @program = ();
my @see = ();
$omit = '' unless $omit = $obj->getAttr('omit');
$type = '' unless $type = $obj->getAttr('type');
$header = 0 unless $header = $obj->getAttr('header');
$idNo = '' unless $idNo = $obj->getAttr('idNo');
if ($idNo ne '' && $uniqueId{$idNo}) {
print STDERR "$uniqueId{$idNo} and $id have the same id ($idNo)\n";
}
else {
$uniqueId{$idNo} = $id;
}
return bless {'id' => $id,
'header' => $header,
'idNo' => $idNo,
'omit' => $omit,
'super' => $super,
'type' => $type,
'title' => $title,
'program' => \@program,
'see' => \@see,
'external' => 0,
'internal' => 0}, $pkg;
}
# putDef is called at the end of an <event></event> block, so
# it sees a completed object.
sub putDef {
my $pkg = shift;
my $obj = shift; # ref to xmlHandlers event object
my $context = shift;
my $id = $pkg->{'id'};
if ($context eq 'internal') {
$pkg->{$context} = new internalEvent($id, $obj);
return undef;
} elsif ($context eq 'external') {
my $ref = $pkg->{$context} = new externalEvent($id, $obj);
return $ref->{'internalName'};
}
}
sub getId {
my $pkg = shift;
return $pkg->{'id'};
}
sub getHeader {
my $pkg = shift;
return $pkg->{'header'};
}
sub getIdNo {
my $pkg = shift;
return $pkg->{'idNo'};
}
sub getSuperClass {
my $pkg = shift;
return $pkg->{'super'};
}
sub getOmit {
my $pkg = shift;
return $pkg->{'omit'};
}
sub getType {
my $pkg = shift;
return $pkg->{'type'};
}
sub getTitle {
return shift->{'title'};
}
sub getProgram {
return shift->{'program'};
}
sub getSee {
return shift->{'see'};
}
sub getInternal {
my $pkg = shift;
return $pkg->{'internal'};
}
sub getExternal {
my $pkg = shift;
return $pkg->{'external'};
}
# this isn't fully implemented; just a skeleton
package tokenDef;
1;
sub new {
my $pkg = shift;
my $obj = shift;
my $id = shift;
$usage = $obj->getAttr('usage');
$usage = '' unless defined $usage;
return bless {'id' => $id,
'usage' => $usage
}, $pkg;
}
sub getId {
my $pkg = shift;
return $pkg->{'id'};
}
sub getUsage {
my $pkg = shift;
return $pkg->{'usage'};
}
package messageList;
1;
sub new {
my $pkg = shift;
my $obj = shift;
my $id = shift;
my $header = shift;
my $start = shift;
my $public = shift;
my $deprecated = shift;
my @msg = ();
my @kid = $obj->getKids(); # kids of msg_list are msg
my $kid;
foreach $kid (@kid) {
my $class = $kid->getClass();
if ($class eq 'msg') {
my $text = $kid->getContent();
$text = '' unless defined ($text);
my $msgId = $kid->getAttr('id');
if (defined ($msgId)) {
push(@msg, join('::', $msgId, $text));
}
else {
print STDERR "missing id for $class <msg>\n";
}
}
else {
print STDERR "invalid tag in <msg_list> block: $class\n";
}
}
return bless {'id' => $id,
'header' => $header,
'msg' => \@msg,
'start' => $start,
'public' => $public,
'deprecated' => $deprecated
}, $pkg;
}
sub getId {
my $pkg = shift;
return $pkg->{'id'};
}
sub getMsgStart {
my $pkg = shift;
return $pkg->{'start'};
}
sub getDeprecated {
my $pkg = shift;
return $pkg->{'deprecated'};
}
sub getMsgPublic {
my $pkg = shift;
return $pkg->{'public'};
}
sub getHeader {
my $pkg = shift;
return $pkg->{'header'};
}
# destructive read of @msg...
sub getNextMsg {
my $pkg = shift;
my @msg = @{$pkg->{'msg'}};
return undef unless @msg;
my $text = pop(@msg);
$pkg->{'msg'} = \@msg;
return $text;
}
# returns all msgs
sub getMsgs {
my $pkg = shift;
return @{$pkg->{'msg'}};
}
package auditxml;
# These aren't internal state because the callback functions don't
# have the object handle.
@debug = (); # stack for nesting debug state
%event = (); # event name => $objRef
@event = (); # event id
%token = (); # token name => $objRef
@token = (); # token id
%msg_list = (); # messageList string list id to obj
@msg_list = (); # id list
%service = (); # valid service names
%externalToInternal = (); # map external event name to internal event name
1;
sub new {
my $pkg = shift;
my $file = shift; # xml file to be parsed
register('event', \&eventStart, \&eventEnd);
register('entry', 0, \&entry);
register('external', 0, \&external);
register('internal', 0, \&internal);
register('include', 0, \&include);
register('token', 0, \&token);
register('service', 0, \&service);
register('msg_list', 0, \&msg_list);
register('msg', 0, \&msg);
# do not use register() for debug because register generates extra
# debug information
xmlHandlers::registerStartCallback('debug', \&debugStart);
xmlHandlers::registerEndCallback('debug', \&debugEnd);
$xml = new xmlHandlers(0, 'top level', $file);
return bless {'xmlObj' => $xml,
'firstToken' => 1,
'firstEvent' => 1}, $pkg;
}
# local function -- register both the auditxml function and the
# xmlHandler callback
sub register {
my $localName = shift;
my $startFunction = shift;
my $endFunction = shift;
if ($startFunction) {
xmlHandlers::registerStartCallback($localName, \&completed);
$startFunction{$localName} = $startFunction;
}
if ($endFunction) {
xmlHandlers::registerEndCallback($localName, \&completed);
$endFunction{$localName} = $endFunction;
}
}
sub completed {
my $obj = shift;
my $callbackSource = shift;
my $id = $obj->getAttr('id');
my $class = $obj->getClass();
if ($main::debug) {
print "*** $callbackSource: $class", (defined ($id)) ? "= $id\n" : "\n";
my %attributes = $obj->getAttributes();
my $attribute;
foreach $attribute (keys %attributes) {
print "*** $attribute = $attributes{$attribute}\n";
}
my $content = $obj->getContent();
print "*** content = $content\n" if defined $content;
}
if ($callbackSource eq 'start') {
&{$startFunction{$class}}($obj);
}
elsif ($callbackSource eq 'end') {
&{$endFunction{$class}}($obj);
}
else {
print STDERR "no auditxml function defined for $class\n";
}
}
# getNextEvent reads from @event destructively. 'firstEvent' could
# be used to make a copy from which to read.
sub getNextEvent {
my $pkg = shift;
return undef unless (@event);
if ($pkg->{'firstEvent'}) {
@token = sort @token;
$pkg->{'firstEvent'} = 1;
}
my $id = shift @event;
return $event{$id};
}
# returns all event ids
sub getEventIds {
my $pkg = shift;
return @event;
}
# returns event for id
sub getEvent {
my $pkg = shift;
my $id = shift;
return $event{$id};
}
sub getToken {
my $pkg = shift;
my $id = shift;
return $token{$id};
}
# getNextToken reads from @token destructively. 'firstToken' could
# be used to make a copy from which to read.
sub getNextToken {
my $pkg = shift;
return undef unless (@token);
if ($pkg->{'firstToken'}) {
@token = sort @token;
$pkg->{'firstToken'} = 1;
}
my $id = shift @token;
return $token{$id};
}
# return token Ids
sub getTokenIds {
my $pkg = shift;
return @token;
}
# getNextMsgId reads from @msg_list destructively.
sub getNextMsgId {
my $pkg = shift;
return undef unless (@msg_list);
my $id = shift @msg_list;
return ($id, $msg_list{$id});
}
sub getMsgIds {
my $pkg = shift;
return @msg_list;
}
sub getMsg {
my $pkg = shift;
my $id = shift;
return $msg_list{$id};
}
sub external {
}
sub internal {
}
sub eventStart {
my $obj = shift;
my $id = $obj->getAttr('id');
unless ($id) {
print STDERR "eventStart can't get a valid id\n";
return;
}
unless (defined $event{$id}) {
my $super;
if ($super = $obj->getAttr('instance_of')) {
$super = $event{$super};
} else {
$super = 0;
}
$event{$id} = new eventDef($id, $obj, $super);
push (@event, $id);
} else {
print STDERR "duplicate event id: $id\n";
}
}
sub eventEnd {
my $obj = shift;
my $id = $obj->getAttr('id');
unless (defined $id) {
print STDERR "event element is missing required id attribute\n";
return;
}
print "event = $id\n" if $main::debug;
foreach my $kid ($obj->getKids) {
my $class = $kid->getClass;
next unless ($class =~ /title|program|see/);
my $content = $kid->getContent;
if ($class eq 'title') {
$event{$id}->{$class} = $content;
} else {
push @{$event{$id}->{$class}}, $content;
}
}
$event{$id}->putDef($obj, 'internal');
my $internalName = $event{$id}->putDef($obj, 'external');
$externalToInternal{$id} = $internalName if $internalName;
}
# class method
#sub getInternalName {
# my $name = shift;
#
# return $externalToInternal{$name};
#}
sub entry {
}
#sub include {
# my $obj = shift;
#
# my $id = $obj->getAttr('id');
#
# if (defined $id) {
# print "include = $id\n" if $main::debug;
# }
# else {
# print STDERR "include element is missing required id attribute\n";
# }
#}
sub token {
my $obj = shift;
my $id = $obj->getAttr('id');
if (defined $id) {
print "token = $id\n" if $main::debug;
$token{$id} = new tokenDef($obj, $id);
push (@token, $id);
}
else {
print STDERR "token element is missing required id attribute\n";
}
}
sub msg_list {
my $obj = shift;
my $id = $obj->getAttr('id');
my $header = $obj->getAttr('header');
my $start = $obj->getAttr('start');
my $public = $obj->getAttr('public');
my $deprecated = $obj->getAttr('deprecated');
$header = 0 unless $header;
$start = 0 unless $start;
$public = ($public) ? 1 : 0;
$deprecated = ($deprecated) ? 1 : 0;
if (defined $id) {
print "msg_list = $id\n" if $main::debug;
$msg_list{$id} = new messageList($obj, $id, $header, $start,
$public, $deprecated);
push (@msg_list, $id);
}
else {
print STDERR
"msg_list element is missing required id attribute\n";
}
}
sub msg {
# my $obj = shift;
}
# Service name was dropped during PSARC review
sub service {
my $obj = shift;
my $name = $obj->getAttr('name');
my $id = $obj->getAttr('id');
if ((defined $id) && (defined $name)) {
print "service $name = $id\n" if $main::debug;
$service{$name} = $id;
}
elsif (defined $name) {
print STDERR "service $name is missing an id number\n";
}
elsif (defined $id) {
print STDERR "service name missing for id = $id\n";
}
else {
print STDERR "missing both name and id for a service entry\n";
}
}
#sub getServices {
#
# return %service;
#}
# <debug set="on"> or <debug set="off"> or <debug>
# if the set attribute is omitted, debug state is toggled
# debugStart / debugEnd are used to insure debug state is
# scoped to the block between <debug> and </debug>
sub debugStart {
my $obj = shift;
push (@debug, $main::debug);
my $debug = $main::debug;
my $state = $obj->getAttr('set');
if (defined $state) {
$main::debug = ($state eq 'on') ? 1 : 0;
}
else {
$main::debug = !$debug;
}
if ($debug != $main::debug) {
print 'debug is ', $main::debug ? 'on' : 'off', "\n";
}
}
sub debugEnd {
my $obj = shift;
my $debug = $main::debug;
$main::debug = pop (@debug);
if ($debug != $main::debug) {
print 'debug is ', $main::debug ? 'on' : 'off', "\n";
}
}