xref: /onnv-gate/usr/src/lib/libbsm/auditxml.pm (revision 4176:9c92120b1c02)
1*4176Stz204579#
2*4176Stz204579# CDDL HEADER START
3*4176Stz204579#
4*4176Stz204579# The contents of this file are subject to the terms of the
5*4176Stz204579# Common Development and Distribution License (the "License").
6*4176Stz204579# You may not use this file except in compliance with the License.
7*4176Stz204579#
8*4176Stz204579# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
9*4176Stz204579# or http://www.opensolaris.org/os/licensing.
10*4176Stz204579# See the License for the specific language governing permissions
11*4176Stz204579# and limitations under the License.
12*4176Stz204579#
13*4176Stz204579# When distributing Covered Code, include this CDDL HEADER in each
14*4176Stz204579# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
15*4176Stz204579# If applicable, add the following below this CDDL HEADER, with the
16*4176Stz204579# fields enclosed by brackets "[]" replaced with your own identifying
17*4176Stz204579# information: Portions Copyright [yyyy] [name of copyright owner]
18*4176Stz204579#
19*4176Stz204579# CDDL HEADER END
20*4176Stz204579#
21*4176Stz204579#
22*4176Stz204579# Copyright 2007 Sun Microsystems, Inc.  All rights reserved.
23*4176Stz204579# Use is subject to license terms.
24*4176Stz204579#
25*4176Stz204579# ident	"%Z%%M%	%I%	%E% SMI"
26*4176Stz204579#
27*4176Stz204579
28*4176Stz204579use xmlHandlers;
29*4176Stz204579
30*4176Stz204579package externalEvent;
31*4176Stz204579
32*4176Stz2045791;
33*4176Stz204579
34*4176Stz204579sub new {
35*4176Stz204579    my $pkg = shift;
36*4176Stz204579    my $id  = shift;
37*4176Stz204579    my $obj = shift;
38*4176Stz204579
39*4176Stz204579    my @kid = $obj->getKids(); # kids of event are entry or allowed_types
40*4176Stz204579
41*4176Stz204579    # separate kids into classes and create hash of entries and an
42*4176Stz204579    # array of includes
43*4176Stz204579
44*4176Stz204579    my %entry = ();
45*4176Stz204579    my @entry = ();
46*4176Stz204579    my @allowed_types = ();
47*4176Stz204579    my @include = ();
48*4176Stz204579    my $internalName = '';
49*4176Stz204579
50*4176Stz204579    my $kid;
51*4176Stz204579    foreach $kid (@kid) {
52*4176Stz204579	my $class = $kid->getClass();
53*4176Stz204579	my $kidId = $kid->getAttr('id');
54*4176Stz204579
55*4176Stz204579	if ($class eq 'entry') {
56*4176Stz204579	    my $tokenId = 'undefined';
57*4176Stz204579	    my $format = '';
58*4176Stz204579	    my $internal = $kid->getKid('internal');
59*4176Stz204579	    if (defined $internal) {
60*4176Stz204579	      $tokenId = $internal->getAttr('token');
61*4176Stz204579	      $format = $internal->getAttr('format');
62*4176Stz204579	      $format = '' unless defined $format;
63*4176Stz204579	    }
64*4176Stz204579	    my $comment;
65*4176Stz204579	    my $commentKid = $kid->getKid('comment');
66*4176Stz204579	    if (defined $commentKid) {
67*4176Stz204579	    	$comment = $commentKid->getContent;
68*4176Stz204579	    }
69*4176Stz204579	    my $external = $kid->getKid('external');
70*4176Stz204579	    if (defined ($external)) {
71*4176Stz204579		$entry{$kidId} = [$external, $kid, $tokenId, $format, $comment];
72*4176Stz204579		push (@entry, $kidId);
73*4176Stz204579	    }
74*4176Stz204579	    else {
75*4176Stz204579		print STDERR "no external attributes defined for $id/$kidId\n";
76*4176Stz204579	    }
77*4176Stz204579	} # handle event id translation...
78*4176Stz204579	elsif ($class eq 'altname') {
79*4176Stz204579	    $internalName = $kid->getAttr('id');
80*4176Stz204579	    unless (defined $internalName) {
81*4176Stz204579		print STDERR "missing id for internal name of $id\n";
82*4176Stz204579		$internalName = 'error';
83*4176Stz204579	    }
84*4176Stz204579	}
85*4176Stz204579	elsif ($class eq 'allowed_types') {
86*4176Stz204579	    my $content = $kid->getContent();
87*4176Stz204579	    @allowed_types = (@allowed_types, split(/\s*,\s*/, $content));
88*4176Stz204579	}
89*4176Stz204579    }
90*4176Stz204579    my @entryCopy = @entry;
91*4176Stz204579    return bless {'id'			=> $id,
92*4176Stz204579		  'internalName'	=> $internalName,
93*4176Stz204579		  'allowed_types'	=> \@allowed_types,
94*4176Stz204579		  'entry'		=> \%entry,
95*4176Stz204579		  'entryList'		=> \@entry,
96*4176Stz204579		  'entryListCopy'	=> \@entryCopy,
97*4176Stz204579		  'include'		=> \@include,
98*4176Stz204579		  'xmlObj'		=> $obj}, $pkg;
99*4176Stz204579}
100*4176Stz204579
101*4176Stz204579# return id
102*4176Stz204579
103*4176Stz204579sub getExternalName {
104*4176Stz204579  my $pkg = shift;
105*4176Stz204579
106*4176Stz204579  return $pkg->{'id'};
107*4176Stz204579}
108*4176Stz204579
109*4176Stz204579
110*4176Stz204579# return internal name if it exists, else id
111*4176Stz204579
112*4176Stz204579sub getInternalName {
113*4176Stz204579    $pkg = shift;
114*4176Stz204579
115*4176Stz204579    if ($pkg->{'internalName'}) {
116*4176Stz204579	return $pkg->{'internalName'};
117*4176Stz204579    }
118*4176Stz204579    else {
119*4176Stz204579	return $pkg->{'id'};
120*4176Stz204579    }
121*4176Stz204579}
122*4176Stz204579
123*4176Stz204579# getNextEntry reads from 'entryList' destructively
124*4176Stz204579# but resets when the list after the list is emptied
125*4176Stz204579
126*4176Stz204579sub getNextEntry {
127*4176Stz204579    my $pkg = shift;
128*4176Stz204579
129*4176Stz204579    unless (@{$pkg->{'entryList'}}) {
130*4176Stz204579	@{$pkg->{'entryList'}} = @{$pkg->{'entryListCopy'}};
131*4176Stz204579	return undef;
132*4176Stz204579    }
133*4176Stz204579    my $id = shift @{$pkg->{'entryList'}};
134*4176Stz204579
135*4176Stz204579    return ($pkg->getEntry($id));  # getEntry returns an array
136*4176Stz204579}
137*4176Stz204579
138*4176Stz204579# getEntryIds returns list of all ids from entryList
139*4176Stz204579
140*4176Stz204579sub getEntryIds {
141*4176Stz204579    my $pkg = shift;
142*4176Stz204579    return (@{$pkg->{'entryList'}});
143*4176Stz204579}
144*4176Stz204579
145*4176Stz204579# getEntry returns a selected entry for the current event
146*4176Stz204579
147*4176Stz204579sub getEntry {
148*4176Stz204579    my $pkg = shift;
149*4176Stz204579    my $id  = shift;  #entry id
150*4176Stz204579
151*4176Stz204579    my $ref = $pkg->{'entry'};
152*4176Stz204579    my $array = $$ref{$id};
153*4176Stz204579
154*4176Stz204579    return @$array;
155*4176Stz204579}
156*4176Stz204579
157*4176Stz204579# getNextInclude reads from 'include' destructively
158*4176Stz204579
159*4176Stz204579sub getNextInclude {
160*4176Stz204579    my $pkg = shift;
161*4176Stz204579
162*4176Stz204579    return shift @{$pkg->{'include'}};
163*4176Stz204579}
164*4176Stz204579
165*4176Stz204579# getIncludes returns list of 'include'
166*4176Stz204579
167*4176Stz204579sub getIncludes {
168*4176Stz204579    my $pkg = shift;
169*4176Stz204579    return @{$pkg->{'include'}};
170*4176Stz204579}
171*4176Stz204579
172*4176Stz204579# return a reference to the list of event id's allowed for
173*4176Stz204579# this generic event
174*4176Stz204579
175*4176Stz204579sub getAllowedTypes {
176*4176Stz204579    my $pkg = shift;
177*4176Stz204579
178*4176Stz204579    return $pkg->{'allowed_types'};
179*4176Stz204579}
180*4176Stz204579
181*4176Stz204579package internalEvent;
182*4176Stz204579
183*4176Stz2045791;
184*4176Stz204579
185*4176Stz204579sub new {
186*4176Stz204579    my $pkg = shift;
187*4176Stz204579    my $id  = shift;
188*4176Stz204579    my $obj = shift;
189*4176Stz204579
190*4176Stz204579    my @kid = $obj->getKids(); # kids of event are entry
191*4176Stz204579
192*4176Stz204579    my @entry = ();
193*4176Stz204579
194*4176Stz204579    my $reorder = 0;
195*4176Stz204579    if ($reorder = $obj->getAttr('reorder')) {
196*4176Stz204579	$reorder = 1 if $reorder eq 'yes';
197*4176Stz204579    }
198*4176Stz204579    my $kid;
199*4176Stz204579    foreach $kid (@kid) {
200*4176Stz204579      my $class = $kid->getClass();
201*4176Stz204579      my $id = $kid->getAttr('id');
202*4176Stz204579
203*4176Stz204579      if ($class eq 'entry') {
204*4176Stz204579	my $internal = $kid->getKid('internal');
205*4176Stz204579	if (defined ($internal)) {
206*4176Stz204579	  push (@entry, [$internal, $kid]);
207*4176Stz204579	}
208*4176Stz204579	else {
209*4176Stz204579	  print STDERR "no internal attributes defined for $id\n";
210*4176Stz204579	}
211*4176Stz204579      }
212*4176Stz204579    }
213*4176Stz204579    return bless {'id'       => $id,
214*4176Stz204579		  'reorder'  => $reorder,
215*4176Stz204579		  'entry'    => \@entry,
216*4176Stz204579		  'xmlObj'   => $obj}, $pkg;
217*4176Stz204579}
218*4176Stz204579
219*4176Stz204579# getEntries returns a list of all entry references
220*4176Stz204579
221*4176Stz204579sub getEntries {
222*4176Stz204579    my $pkg = shift;
223*4176Stz204579
224*4176Stz204579    return undef unless @{$pkg->{'entry'}};
225*4176Stz204579
226*4176Stz204579    return @{$pkg->{'entry'}};
227*4176Stz204579}
228*4176Stz204579
229*4176Stz204579sub isReorder {
230*4176Stz204579  my $pkg = shift;
231*4176Stz204579
232*4176Stz204579  return $pkg->{'reorder'};
233*4176Stz204579}
234*4176Stz204579
235*4176Stz204579sub getId {
236*4176Stz204579    my $pkg = shift;
237*4176Stz204579
238*4176Stz204579    return $pkg->{'id'};
239*4176Stz204579}
240*4176Stz204579
241*4176Stz204579package eventDef;
242*4176Stz204579
243*4176Stz204579%uniqueId = ();
244*4176Stz204579
245*4176Stz2045791;
246*4176Stz204579
247*4176Stz204579sub new {
248*4176Stz204579    my $pkg = shift;
249*4176Stz204579    my $id  = shift;
250*4176Stz204579    my $obj = shift;
251*4176Stz204579    my $super = shift;
252*4176Stz204579
253*4176Stz204579    my $omit;
254*4176Stz204579    my $type;
255*4176Stz204579    my $header;
256*4176Stz204579    my $idNo;
257*4176Stz204579    my $javaToo;
258*4176Stz204579    my $title = '';
259*4176Stz204579    my @program = ();
260*4176Stz204579    my @see = ();
261*4176Stz204579
262*4176Stz204579    $omit = '' unless $omit = $obj->getAttr('omit');
263*4176Stz204579    $type = '' unless $type = $obj->getAttr('type');
264*4176Stz204579    $header = 0 unless $header = $obj->getAttr('header');
265*4176Stz204579    $idNo = '' unless $idNo = $obj->getAttr('idNo');
266*4176Stz204579
267*4176Stz204579    if ($idNo ne '' && $uniqueId{$idNo}) {
268*4176Stz204579        print STDERR "$uniqueId{$idNo} and $id have the same id ($idNo)\n";
269*4176Stz204579    }
270*4176Stz204579    else {
271*4176Stz204579        $uniqueId{$idNo} = $id;
272*4176Stz204579    }
273*4176Stz204579
274*4176Stz204579    return bless {'id'		=> $id,
275*4176Stz204579		  'header'	=> $header,
276*4176Stz204579		  'idNo'	=> $idNo,
277*4176Stz204579		  'omit'	=> $omit,
278*4176Stz204579		  'super'	=> $super,
279*4176Stz204579		  'type'	=> $type,
280*4176Stz204579		  'title'	=> $title,
281*4176Stz204579		  'program'	=> \@program,
282*4176Stz204579		  'see'		=> \@see,
283*4176Stz204579		  'external'	=> 0,
284*4176Stz204579		  'internal'	=> 0}, $pkg;
285*4176Stz204579}
286*4176Stz204579
287*4176Stz204579# putDef is called at the end of an <event></event> block, so
288*4176Stz204579# it sees a completed object.
289*4176Stz204579
290*4176Stz204579sub putDef {
291*4176Stz204579    my $pkg  = shift;
292*4176Stz204579    my $obj  = shift;  # ref to xmlHandlers event object
293*4176Stz204579    my $context = shift;
294*4176Stz204579
295*4176Stz204579    my $id = $pkg->{'id'};
296*4176Stz204579
297*4176Stz204579    if ($context eq 'internal') {
298*4176Stz204579	$pkg->{$context} = new internalEvent($id, $obj);
299*4176Stz204579	return undef;
300*4176Stz204579    } elsif ($context eq 'external') {
301*4176Stz204579	my $ref = $pkg->{$context} = new externalEvent($id, $obj);
302*4176Stz204579	return $ref->{'internalName'};
303*4176Stz204579    }
304*4176Stz204579}
305*4176Stz204579
306*4176Stz204579sub getId {
307*4176Stz204579    my $pkg = shift;
308*4176Stz204579
309*4176Stz204579    return $pkg->{'id'};
310*4176Stz204579}
311*4176Stz204579
312*4176Stz204579sub getHeader {
313*4176Stz204579    my $pkg = shift;
314*4176Stz204579
315*4176Stz204579    return $pkg->{'header'};
316*4176Stz204579}
317*4176Stz204579
318*4176Stz204579sub getIdNo {
319*4176Stz204579    my $pkg = shift;
320*4176Stz204579
321*4176Stz204579    return $pkg->{'idNo'};
322*4176Stz204579}
323*4176Stz204579
324*4176Stz204579sub getSuperClass {
325*4176Stz204579    my $pkg = shift;
326*4176Stz204579
327*4176Stz204579    return $pkg->{'super'};
328*4176Stz204579}
329*4176Stz204579
330*4176Stz204579sub getOmit {
331*4176Stz204579    my $pkg = shift;
332*4176Stz204579
333*4176Stz204579    return $pkg->{'omit'};
334*4176Stz204579}
335*4176Stz204579
336*4176Stz204579sub getType {
337*4176Stz204579    my $pkg = shift;
338*4176Stz204579
339*4176Stz204579    return $pkg->{'type'};
340*4176Stz204579}
341*4176Stz204579
342*4176Stz204579sub getTitle {
343*4176Stz204579    return shift->{'title'};
344*4176Stz204579}
345*4176Stz204579
346*4176Stz204579sub getProgram {
347*4176Stz204579    return shift->{'program'};
348*4176Stz204579}
349*4176Stz204579
350*4176Stz204579sub getSee {
351*4176Stz204579    return shift->{'see'};
352*4176Stz204579}
353*4176Stz204579
354*4176Stz204579sub getInternal {
355*4176Stz204579    my $pkg = shift;
356*4176Stz204579
357*4176Stz204579    return $pkg->{'internal'};
358*4176Stz204579}
359*4176Stz204579
360*4176Stz204579sub getExternal {
361*4176Stz204579    my $pkg = shift;
362*4176Stz204579
363*4176Stz204579    return $pkg->{'external'};
364*4176Stz204579}
365*4176Stz204579
366*4176Stz204579# this isn't fully implemented; just a skeleton
367*4176Stz204579
368*4176Stz204579package tokenDef;
369*4176Stz204579
370*4176Stz2045791;
371*4176Stz204579
372*4176Stz204579sub new {
373*4176Stz204579    my $pkg = shift;
374*4176Stz204579    my $obj = shift;
375*4176Stz204579    my $id  = shift;
376*4176Stz204579
377*4176Stz204579    $usage	= $obj->getAttr('usage');
378*4176Stz204579    $usage = '' unless defined $usage;
379*4176Stz204579
380*4176Stz204579    return bless {'id'		=> $id,
381*4176Stz204579		  'usage'	=> $usage
382*4176Stz204579		  }, $pkg;
383*4176Stz204579}
384*4176Stz204579
385*4176Stz204579sub getId {
386*4176Stz204579    my $pkg = shift;
387*4176Stz204579
388*4176Stz204579    return $pkg->{'id'};
389*4176Stz204579}
390*4176Stz204579
391*4176Stz204579sub getUsage {
392*4176Stz204579    my $pkg = shift;
393*4176Stz204579
394*4176Stz204579    return $pkg->{'usage'};
395*4176Stz204579}
396*4176Stz204579
397*4176Stz204579package messageList;
398*4176Stz204579
399*4176Stz2045791;
400*4176Stz204579
401*4176Stz204579sub new {
402*4176Stz204579    my $pkg = shift;
403*4176Stz204579    my $obj = shift;
404*4176Stz204579    my $id  = shift;
405*4176Stz204579    my $header = shift;
406*4176Stz204579    my $start = shift;
407*4176Stz204579    my $public = shift;
408*4176Stz204579    my $deprecated = shift;
409*4176Stz204579
410*4176Stz204579    my @msg = ();
411*4176Stz204579
412*4176Stz204579    my @kid = $obj->getKids(); # kids of msg_list are msg
413*4176Stz204579    my $kid;
414*4176Stz204579    foreach $kid (@kid) {
415*4176Stz204579	my $class = $kid->getClass();
416*4176Stz204579	if ($class eq 'msg') {
417*4176Stz204579	    my $text = $kid->getContent();
418*4176Stz204579	    $text = '' unless defined ($text);
419*4176Stz204579	    my $msgId = $kid->getAttr('id');
420*4176Stz204579	    if (defined ($msgId)) {
421*4176Stz204579	        push(@msg, join('::', $msgId, $text));
422*4176Stz204579	    }
423*4176Stz204579	    else {
424*4176Stz204579	        print STDERR "missing id for $class <msg>\n";
425*4176Stz204579	    }
426*4176Stz204579	}
427*4176Stz204579	else {
428*4176Stz204579	    print STDERR "invalid tag in <msg_list> block: $class\n";
429*4176Stz204579	}
430*4176Stz204579    }
431*4176Stz204579
432*4176Stz204579    return bless {'id'		=> $id,
433*4176Stz204579		  'header'	=> $header,
434*4176Stz204579		  'msg'		=> \@msg,
435*4176Stz204579		  'start'	=> $start,
436*4176Stz204579		  'public'	=> $public,
437*4176Stz204579		  'deprecated'	=> $deprecated
438*4176Stz204579		 }, $pkg;
439*4176Stz204579}
440*4176Stz204579
441*4176Stz204579sub getId {
442*4176Stz204579    my $pkg = shift;
443*4176Stz204579
444*4176Stz204579    return $pkg->{'id'};
445*4176Stz204579}
446*4176Stz204579
447*4176Stz204579sub getMsgStart {
448*4176Stz204579    my $pkg = shift;
449*4176Stz204579
450*4176Stz204579    return $pkg->{'start'};
451*4176Stz204579}
452*4176Stz204579
453*4176Stz204579sub getDeprecated {
454*4176Stz204579    my $pkg = shift;
455*4176Stz204579
456*4176Stz204579    return $pkg->{'deprecated'};
457*4176Stz204579}
458*4176Stz204579
459*4176Stz204579sub getMsgPublic {
460*4176Stz204579    my $pkg = shift;
461*4176Stz204579
462*4176Stz204579    return $pkg->{'public'};
463*4176Stz204579}
464*4176Stz204579
465*4176Stz204579sub getHeader {
466*4176Stz204579    my $pkg = shift;
467*4176Stz204579
468*4176Stz204579    return $pkg->{'header'};
469*4176Stz204579}
470*4176Stz204579
471*4176Stz204579# destructive read of @msg...
472*4176Stz204579
473*4176Stz204579sub getNextMsg {
474*4176Stz204579    my $pkg = shift;
475*4176Stz204579
476*4176Stz204579    my @msg = @{$pkg->{'msg'}};
477*4176Stz204579
478*4176Stz204579    return undef unless @msg;
479*4176Stz204579
480*4176Stz204579    my $text = pop(@msg);
481*4176Stz204579    $pkg->{'msg'} = \@msg;
482*4176Stz204579    return $text;
483*4176Stz204579}
484*4176Stz204579
485*4176Stz204579# returns all msgs
486*4176Stz204579sub getMsgs {
487*4176Stz204579    my $pkg = shift;
488*4176Stz204579
489*4176Stz204579    return @{$pkg->{'msg'}};
490*4176Stz204579}
491*4176Stz204579
492*4176Stz204579
493*4176Stz204579package auditxml;
494*4176Stz204579
495*4176Stz204579# These aren't internal state because the callback functions don't
496*4176Stz204579# have the object handle.
497*4176Stz204579
498*4176Stz204579@debug   = ();            # stack for nesting debug state
499*4176Stz204579%event   = ();            # event name => $objRef
500*4176Stz204579@event   = ();            # event id
501*4176Stz204579%token   = ();            # token name => $objRef
502*4176Stz204579@token   = ();            # token id
503*4176Stz204579%msg_list = ();           # messageList string list id to obj
504*4176Stz204579@msg_list = ();           # id list
505*4176Stz204579%service = ();            # valid service names
506*4176Stz204579%externalToInternal = (); # map external event name to internal event name
507*4176Stz204579
508*4176Stz2045791;
509*4176Stz204579
510*4176Stz204579sub new {
511*4176Stz204579    my $pkg  = shift;
512*4176Stz204579    my $file = shift;  # xml file to be parsed
513*4176Stz204579
514*4176Stz204579    register('event',      \&eventStart,  \&eventEnd);
515*4176Stz204579    register('entry',      0,             \&entry);
516*4176Stz204579    register('external',   0,             \&external);
517*4176Stz204579    register('internal',   0,             \&internal);
518*4176Stz204579    register('include',    0,             \&include);
519*4176Stz204579    register('token',      0,             \&token);
520*4176Stz204579    register('service',    0,             \&service);
521*4176Stz204579    register('msg_list',   0,             \&msg_list);
522*4176Stz204579    register('msg',        0,             \&msg);
523*4176Stz204579
524*4176Stz204579    # do not use register() for debug because register generates extra
525*4176Stz204579    # debug information
526*4176Stz204579
527*4176Stz204579    xmlHandlers::registerStartCallback('debug', \&debugStart);
528*4176Stz204579    xmlHandlers::registerEndCallback('debug', \&debugEnd);
529*4176Stz204579
530*4176Stz204579    $xml = new xmlHandlers(0, 'top level', $file);
531*4176Stz204579
532*4176Stz204579    return bless {'xmlObj'     => $xml,
533*4176Stz204579	          'firstToken' => 1,
534*4176Stz204579	          'firstEvent' => 1}, $pkg;
535*4176Stz204579}
536*4176Stz204579
537*4176Stz204579# local function -- register both the auditxml function and the
538*4176Stz204579# xmlHandler callback
539*4176Stz204579
540*4176Stz204579sub register {
541*4176Stz204579    my $localName     = shift;
542*4176Stz204579    my $startFunction = shift;
543*4176Stz204579    my $endFunction = shift;
544*4176Stz204579
545*4176Stz204579    if ($startFunction) {
546*4176Stz204579      xmlHandlers::registerStartCallback($localName, \&completed);
547*4176Stz204579	$startFunction{$localName} = $startFunction;
548*4176Stz204579    }
549*4176Stz204579    if ($endFunction) {
550*4176Stz204579      xmlHandlers::registerEndCallback($localName, \&completed);
551*4176Stz204579	$endFunction{$localName} = $endFunction;
552*4176Stz204579    }
553*4176Stz204579}
554*4176Stz204579
555*4176Stz204579sub completed {
556*4176Stz204579    my $obj = shift;
557*4176Stz204579    my $callbackSource = shift;
558*4176Stz204579
559*4176Stz204579    my $id  = $obj->getAttr('id');
560*4176Stz204579    my $class = $obj->getClass();
561*4176Stz204579
562*4176Stz204579    if ($main::debug) {
563*4176Stz204579	print "*** $callbackSource: $class", (defined ($id)) ? "= $id\n" : "\n";
564*4176Stz204579
565*4176Stz204579	my %attributes = $obj->getAttributes();
566*4176Stz204579	my $attribute;
567*4176Stz204579	foreach $attribute (keys %attributes) {
568*4176Stz204579	    print "*** $attribute = $attributes{$attribute}\n";
569*4176Stz204579	}
570*4176Stz204579	my $content = $obj->getContent();
571*4176Stz204579	print "*** content = $content\n" if defined $content;
572*4176Stz204579    }
573*4176Stz204579    if ($callbackSource eq 'start') {
574*4176Stz204579	&{$startFunction{$class}}($obj);
575*4176Stz204579    }
576*4176Stz204579    elsif ($callbackSource eq 'end') {
577*4176Stz204579	&{$endFunction{$class}}($obj);
578*4176Stz204579    }
579*4176Stz204579    else {
580*4176Stz204579	print STDERR "no auditxml function defined for $class\n";
581*4176Stz204579    }
582*4176Stz204579}
583*4176Stz204579
584*4176Stz204579# getNextEvent reads from @event destructively.  'firstEvent' could
585*4176Stz204579# be used to make a copy from which to read.
586*4176Stz204579
587*4176Stz204579sub getNextEvent {
588*4176Stz204579    my $pkg = shift;
589*4176Stz204579
590*4176Stz204579    return undef unless (@event);
591*4176Stz204579    if ($pkg->{'firstEvent'}) {
592*4176Stz204579	@token = sort @token;
593*4176Stz204579	$pkg->{'firstEvent'} = 1;
594*4176Stz204579    }
595*4176Stz204579
596*4176Stz204579    my $id = shift @event;
597*4176Stz204579
598*4176Stz204579    return $event{$id};
599*4176Stz204579}
600*4176Stz204579
601*4176Stz204579# returns all event ids
602*4176Stz204579sub getEventIds {
603*4176Stz204579   my $pkg = shift;
604*4176Stz204579
605*4176Stz204579   return @event;
606*4176Stz204579}
607*4176Stz204579
608*4176Stz204579# returns event for id
609*4176Stz204579sub getEvent {
610*4176Stz204579    my $pkg = shift;
611*4176Stz204579    my $id = shift;
612*4176Stz204579
613*4176Stz204579    return $event{$id};
614*4176Stz204579}
615*4176Stz204579
616*4176Stz204579sub getToken {
617*4176Stz204579    my $pkg = shift;
618*4176Stz204579    my $id = shift;
619*4176Stz204579
620*4176Stz204579    return $token{$id};
621*4176Stz204579}
622*4176Stz204579
623*4176Stz204579# getNextToken reads from @token destructively.  'firstToken' could
624*4176Stz204579# be used to make a copy from which to read.
625*4176Stz204579
626*4176Stz204579sub getNextToken {
627*4176Stz204579    my $pkg = shift;
628*4176Stz204579
629*4176Stz204579    return undef unless (@token);
630*4176Stz204579
631*4176Stz204579    if ($pkg->{'firstToken'}) {
632*4176Stz204579	@token = sort @token;
633*4176Stz204579	$pkg->{'firstToken'} = 1;
634*4176Stz204579    }
635*4176Stz204579    my $id = shift @token;
636*4176Stz204579
637*4176Stz204579    return $token{$id};
638*4176Stz204579}
639*4176Stz204579
640*4176Stz204579# return token Ids
641*4176Stz204579
642*4176Stz204579sub getTokenIds {
643*4176Stz204579    my $pkg = shift;
644*4176Stz204579
645*4176Stz204579    return @token;
646*4176Stz204579}
647*4176Stz204579
648*4176Stz204579# getNextMsgId reads from @msg_list destructively.
649*4176Stz204579
650*4176Stz204579sub getNextMsgId {
651*4176Stz204579    my $pkg = shift;
652*4176Stz204579
653*4176Stz204579    return undef unless (@msg_list);
654*4176Stz204579
655*4176Stz204579    my $id = shift @msg_list;
656*4176Stz204579
657*4176Stz204579    return ($id, $msg_list{$id});
658*4176Stz204579}
659*4176Stz204579
660*4176Stz204579sub getMsgIds {
661*4176Stz204579    my $pkg = shift;
662*4176Stz204579
663*4176Stz204579    return @msg_list;
664*4176Stz204579}
665*4176Stz204579
666*4176Stz204579sub getMsg {
667*4176Stz204579    my $pkg = shift;
668*4176Stz204579    my $id = shift;
669*4176Stz204579
670*4176Stz204579    return $msg_list{$id};
671*4176Stz204579}
672*4176Stz204579
673*4176Stz204579sub external {
674*4176Stz204579}
675*4176Stz204579
676*4176Stz204579sub internal {
677*4176Stz204579
678*4176Stz204579}
679*4176Stz204579
680*4176Stz204579sub eventStart {
681*4176Stz204579    my $obj  = shift;
682*4176Stz204579
683*4176Stz204579    my $id = $obj->getAttr('id');
684*4176Stz204579
685*4176Stz204579    unless ($id) {
686*4176Stz204579	print STDERR "eventStart can't get a valid id\n";
687*4176Stz204579	return;
688*4176Stz204579    }
689*4176Stz204579    unless (defined $event{$id}) {
690*4176Stz204579        my $super;
691*4176Stz204579	if ($super = $obj->getAttr('instance_of')) {
692*4176Stz204579	    $super = $event{$super};
693*4176Stz204579	} else {
694*4176Stz204579	    $super = 0;
695*4176Stz204579	}
696*4176Stz204579	$event{$id} = new eventDef($id, $obj, $super);
697*4176Stz204579        push (@event, $id);
698*4176Stz204579    } else {
699*4176Stz204579	print STDERR "duplicate event id: $id\n";
700*4176Stz204579    }
701*4176Stz204579}
702*4176Stz204579
703*4176Stz204579sub eventEnd {
704*4176Stz204579    my $obj  = shift;
705*4176Stz204579
706*4176Stz204579    my $id    = $obj->getAttr('id');
707*4176Stz204579    unless (defined $id) {
708*4176Stz204579	print STDERR "event element is missing required id attribute\n";
709*4176Stz204579	return;
710*4176Stz204579    }
711*4176Stz204579    print "event = $id\n" if $main::debug;
712*4176Stz204579
713*4176Stz204579    foreach my $kid ($obj->getKids) {
714*4176Stz204579    	my $class = $kid->getClass;
715*4176Stz204579    	next unless ($class =~ /title|program|see/);
716*4176Stz204579	my $content = $kid->getContent;
717*4176Stz204579	if ($class eq 'title') {
718*4176Stz204579	    $event{$id}->{$class} = $content;
719*4176Stz204579	} else {
720*4176Stz204579	    push @{$event{$id}->{$class}}, $content;
721*4176Stz204579	}
722*4176Stz204579    }
723*4176Stz204579    $event{$id}->putDef($obj, 'internal');
724*4176Stz204579
725*4176Stz204579    my $internalName = $event{$id}->putDef($obj, 'external');
726*4176Stz204579
727*4176Stz204579    $externalToInternal{$id} = $internalName if $internalName;
728*4176Stz204579}
729*4176Stz204579
730*4176Stz204579# class method
731*4176Stz204579
732*4176Stz204579#sub getInternalName {
733*4176Stz204579#    my $name = shift;
734*4176Stz204579#
735*4176Stz204579#    return $externalToInternal{$name};
736*4176Stz204579#}
737*4176Stz204579
738*4176Stz204579sub entry {
739*4176Stz204579}
740*4176Stz204579
741*4176Stz204579#sub include {
742*4176Stz204579#    my $obj  = shift;
743*4176Stz204579#
744*4176Stz204579#    my $id = $obj->getAttr('id');
745*4176Stz204579#
746*4176Stz204579#    if (defined $id) {
747*4176Stz204579#	print "include = $id\n" if $main::debug;
748*4176Stz204579#    }
749*4176Stz204579#    else {
750*4176Stz204579#	print STDERR "include element is missing required id attribute\n";
751*4176Stz204579#    }
752*4176Stz204579#}
753*4176Stz204579
754*4176Stz204579sub token {
755*4176Stz204579    my $obj  = shift;
756*4176Stz204579
757*4176Stz204579    my $id = $obj->getAttr('id');
758*4176Stz204579
759*4176Stz204579    if (defined $id) {
760*4176Stz204579	print "token = $id\n" if $main::debug;
761*4176Stz204579	$token{$id} = new tokenDef($obj, $id);
762*4176Stz204579	push (@token, $id);
763*4176Stz204579    }
764*4176Stz204579    else {
765*4176Stz204579	print STDERR "token element is missing required id attribute\n";
766*4176Stz204579    }
767*4176Stz204579}
768*4176Stz204579
769*4176Stz204579sub msg_list {
770*4176Stz204579    my $obj = shift;
771*4176Stz204579
772*4176Stz204579    my $id = $obj->getAttr('id');
773*4176Stz204579    my $header = $obj->getAttr('header');
774*4176Stz204579    my $start = $obj->getAttr('start');
775*4176Stz204579    my $public = $obj->getAttr('public');
776*4176Stz204579    my $deprecated = $obj->getAttr('deprecated');
777*4176Stz204579
778*4176Stz204579    $header = 0 unless $header;
779*4176Stz204579    $start = 0 unless $start;
780*4176Stz204579    $public = ($public) ? 1 : 0;
781*4176Stz204579    $deprecated = ($deprecated) ? 1 : 0;
782*4176Stz204579
783*4176Stz204579    if (defined $id) {
784*4176Stz204579	print "msg_list = $id\n" if $main::debug;
785*4176Stz204579	$msg_list{$id} = new messageList($obj, $id, $header, $start,
786*4176Stz204579	    $public, $deprecated);
787*4176Stz204579	push (@msg_list, $id);
788*4176Stz204579    }
789*4176Stz204579    else {
790*4176Stz204579	print STDERR
791*4176Stz204579	    "msg_list element is missing required id attribute\n";
792*4176Stz204579    }
793*4176Stz204579}
794*4176Stz204579
795*4176Stz204579sub msg {
796*4176Stz204579#    my $obj = shift;
797*4176Stz204579}
798*4176Stz204579
799*4176Stz204579# Service name was dropped during PSARC review
800*4176Stz204579
801*4176Stz204579sub service {
802*4176Stz204579    my $obj = shift;
803*4176Stz204579
804*4176Stz204579    my $name = $obj->getAttr('name');
805*4176Stz204579    my $id   = $obj->getAttr('id');
806*4176Stz204579
807*4176Stz204579    if ((defined $id) && (defined $name)) {
808*4176Stz204579	print "service $name = $id\n" if $main::debug;
809*4176Stz204579	$service{$name} = $id;
810*4176Stz204579    }
811*4176Stz204579    elsif (defined $name) {
812*4176Stz204579	print STDERR "service $name is missing an id number\n";
813*4176Stz204579    }
814*4176Stz204579    elsif (defined $id) {
815*4176Stz204579	print STDERR "service name missing for id = $id\n";
816*4176Stz204579    }
817*4176Stz204579    else {
818*4176Stz204579	print STDERR "missing both name and id for a service entry\n";
819*4176Stz204579    }
820*4176Stz204579}
821*4176Stz204579
822*4176Stz204579#sub getServices {
823*4176Stz204579#
824*4176Stz204579#    return %service;
825*4176Stz204579#}
826*4176Stz204579
827*4176Stz204579# <debug set="on"> or <debug set="off"> or <debug>
828*4176Stz204579# if the set attribute is omitted, debug state is toggled
829*4176Stz204579
830*4176Stz204579# debugStart / debugEnd are used to insure debug state is
831*4176Stz204579# scoped to the block between <debug> and </debug>
832*4176Stz204579
833*4176Stz204579sub debugStart {
834*4176Stz204579    my $obj = shift;
835*4176Stz204579
836*4176Stz204579    push (@debug, $main::debug);
837*4176Stz204579    my $debug = $main::debug;
838*4176Stz204579
839*4176Stz204579    my $state = $obj->getAttr('set');
840*4176Stz204579
841*4176Stz204579    if (defined $state) {
842*4176Stz204579	$main::debug = ($state eq 'on') ? 1 : 0;
843*4176Stz204579    }
844*4176Stz204579    else {
845*4176Stz204579	$main::debug = !$debug;
846*4176Stz204579    }
847*4176Stz204579    if ($debug != $main::debug) {
848*4176Stz204579	print 'debug is ', $main::debug ? 'on' : 'off', "\n";
849*4176Stz204579    }
850*4176Stz204579}
851*4176Stz204579
852*4176Stz204579sub debugEnd {
853*4176Stz204579    my $obj = shift;
854*4176Stz204579
855*4176Stz204579    my $debug = $main::debug;
856*4176Stz204579    $main::debug = pop (@debug);
857*4176Stz204579
858*4176Stz204579    if ($debug != $main::debug) {
859*4176Stz204579	print 'debug is ', $main::debug ? 'on' : 'off', "\n";
860*4176Stz204579    }
861*4176Stz204579}
862