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