1#!/usr/perl5/bin/perl 2# 3# Copyright (c) 2003, Oracle and/or its affiliates. All rights reserved. 4# 5 6# 7# This script is a stress test for ::Exacct and libexacct. 8# See README for details. 9# 10 11use strict; 12use warnings; 13use blib; 14use POSIX qw(:sys_wait_h); 15 16use Sun::Solaris::Exacct qw(:ALL); 17use Sun::Solaris::Exacct::Catalog qw(:ALL); 18use Sun::Solaris::Exacct::Object qw(:ALL); 19use Sun::Solaris::Exacct::File qw(:ALL); 20use Fcntl; 21 22our $exit = 0; 23our $ono = 1; 24our $maxono = 1000; # max = 16777216 (2^24) 25 26# 27# Dump an object. 28# 29sub dump_object 30{ 31 my ($obj, $fh, $indent) = @_; 32 $fh ||= \*STDOUT; 33 $indent ||= 0; 34 my @cat = $obj->catalog()->value(); 35 my $istr = ' ' x $indent; 36 37 if ($obj->type() == &EO_ITEM) { 38 printf $fh ("%sITEM\n%s Catalog = %s|%s|%d\n", 39 $istr, $istr, @cat); 40 $indent++; 41 my $val = $obj->value(); 42 if (ref($val)) { 43 dump_object($val, $fh, $indent); 44 } else { 45 printf $fh ("%s Value = %s\n", $istr, $val); 46 } 47 } else { 48 printf $fh ("%sGROUP\n%s Catalog = %s|%s|%d\n", 49 $istr, $istr, @cat); 50 $indent++; 51 foreach my $val ($obj->value()) { 52 dump_object($val, $fh, $indent); 53 } 54 printf $fh ("%sENDGROUP\n", $istr); 55 } 56} 57 58# 59# Dump a list of objects. 60# 61sub dump_objects 62{ 63 my ($fh, $objs) = @_; 64 foreach my $o (@$objs) { 65 dump_object($o, $fh); 66 } 67} 68 69# 70# Build up a set of random objects. 71# 72sub gen_objs 73{ 74 my ($nobjs, $embed) = @_; 75 $nobjs += $ono; 76 $embed ||= 0; 77 my @objs; 78 while ($ono < $nobjs) { 79 my $rt = int(rand(9)) + 1; 80 $rt = 15 if ($rt >= 9); # Group. 81 $rt <<= 28; 82 if ($rt == &EXT_UINT8) { 83 push(@objs, ea_new_item($rt | $ono++, 8)); 84 } elsif ($rt == &EXT_UINT16) { 85 push(@objs, ea_new_item($rt | $ono++, 16)); 86 } elsif ($rt == &EXT_UINT32) { 87 push(@objs, ea_new_item($rt | $ono++, 32)); 88 } elsif ($rt == &EXT_UINT64) { 89 push(@objs, ea_new_item($rt | $ono++, 64)); 90 } elsif ($rt == &EXT_DOUBLE) { 91 push(@objs, ea_new_item($rt | $ono++, 92 123456789.123456789)); 93 } elsif ($rt == &EXT_STRING) { 94 push(@objs, ea_new_item($rt | $ono++, "string")); 95 } elsif ($rt == &EXT_EXACCT_OBJECT) { 96 my $o = $ono++; 97 my $i = int(rand($nobjs - $ono)) + 1; 98 push(@objs, ea_new_item($rt | $o, gen_objs($i, 1))); 99 } elsif ($rt == &EXT_RAW) { 100 push(@objs, ea_new_item($rt | $ono++, "RAWrawRAW")); 101 } elsif ($rt == &EXT_GROUP) { 102 my $o = $ono++; 103 my $i = int(rand($nobjs - $ono + 1)); 104 push(@objs, ea_new_group($rt | $o, gen_objs($i))); 105 } 106 107 # If for an embedded object, just return 1 object. 108 last if ($embed); 109 } 110 return(@objs); 111} 112 113# 114# Main routine. 115# 116$| = 1; 117$SIG{INT} = $SIG{TERM} = $SIG{HUP} = sub { $exit = 1; }; 118my $iters = 0; 119while (! $exit) { 120 print("."); 121 122 # Generate and output some random records. 123 my $f = ea_new_file("/tmp/wr.$$", &O_RDWR | &O_CREAT | &O_TRUNC) 124 || die("\ncreate /tmp/wr.$$ failed: ", ea_error_str(), "\n"); 125 my @outobjs = gen_objs($maxono); 126 $f->write(@outobjs); 127 $f = undef; 128 open($f, ">/tmp/wr1.$$") || die("\nopen /tmp/wr1.$$ failed: $!\n"); 129 dump_objects($f, \@outobjs); 130 close($f); 131 @outobjs = (); 132 133 # Scan the file forwards with next. 134 $f = ea_new_file("/tmp/wr.$$", &O_RDONLY) 135 || die("\nopen /tmp/wr.$$ failed: ", ea_error_str(), "\n"); 136 while ($f->next()) { 137 ; 138 } 139 die("\nnext /tmp/wr.$$ failed: ", ea_error_str(), "\n") 140 unless (ea_error() == EXR_EOF); 141 $f = undef; 142 143 # Scan the file backwards with previous. 144 $f = ea_new_file("/tmp/wr.$$", &O_RDONLY, aflags => &EO_TAIL) 145 || die("\nopen /tmp/wr.$$ failed: ", ea_error_str(), "\n"); 146 while ($f->previous()) { 147 ; 148 } 149 die("\nprevious /tmp/wr.$$ failed: ", ea_error_str(), "\n") 150 unless (ea_error() == EXR_EOF); 151 $f = undef; 152 153 # Read the file forwards with get. 154 my @inobjs = (); 155 $f = ea_new_file("/tmp/wr.$$", &O_RDONLY) 156 || die("\nopen /tmp/wr.$$ failed: ", ea_error_str(), "\n"); 157 while (my $obj = $f->get()) { 158 push(@inobjs, $obj); 159 } 160 die("\nget /tmp/wr.$$ failed: ", ea_error_str(), "\n") 161 unless (ea_error() == EXR_EOF); 162 $f = undef; 163 164 # Dump the objects and compare with original. 165 open($f, ">/tmp/wr2.$$") || die("\nopen /tmp/wr2.$$ failed: $!\n"); 166 dump_objects($f, \@inobjs); 167 close($f); 168 if (system("cmp -s /tmp/wr1.$$ /tmp/wr2.$$") != 0) { 169 die("\nget cmp failed /tmp/wr2.$$\n"); 170 } 171 172 # Read the file forwards with next and get. 173 @inobjs = (); 174 $f = ea_new_file("/tmp/wr.$$", &O_RDONLY) 175 || die("\nopen /tmp/wr.$$ failed: ", ea_error_str(), "\n"); 176 while ($f->next()) { 177 my $obj = $f->get(); 178 push(@inobjs, $obj); 179 } 180 die("\nnext/get /tmp/wr.$$ failed: ", ea_error_str(), "\n") 181 unless (ea_error() == EXR_EOF); 182 $f = undef; 183 184 # Dump the objects and compare with original. 185 open($f, ">/tmp/wr2.$$") || die("\nopen /tmp/wr2.$$ failed: $!\n"); 186 dump_objects($f, \@inobjs); 187 close($f); 188 if (system("cmp -s /tmp/wr1.$$ /tmp/wr2.$$") != 0) { 189 die("\nnext/get cmp failed /tmp/wr2.$$\n"); 190 } 191 192 # Read the file backwards with previous and get. 193 @inobjs = (); 194 $f = ea_new_file("/tmp/wr.$$", &O_RDONLY, aflags => &EO_TAIL) 195 || die("\nopen /tmp/wr.$$ failed: ", ea_error_str(), "\n"); 196 while ($f->previous()) { 197 my $obj = $f->get(); 198 $f->previous(); 199 unshift(@inobjs, $obj); 200 } 201 die("\nprevious/get /tmp/wr.$$ failed: ", ea_error_str(), "\n") 202 unless (ea_error() == EXR_EOF); 203 $f = undef; 204 205 # Dump the objects and compare with original. 206 open($f, ">/tmp/wr2.$$") || die("\nopen /tmp/wr2.$$ failed: $!\n"); 207 dump_objects($f, \@inobjs); 208 close($f); 209 if (system("cmp -s /tmp/wr1.$$ /tmp/wr2.$$") != 0) { 210 die("\nprevious/get cmp failed /tmp/wr2.$$\n"); 211 } 212 213 # Run randtest on the file. 214 foreach my $sz (qw(5 10 50 100)) { 215 my $s = system ("./randtest 1000 $sz /tmp/wr.$$") >> 8; 216 if ($s == 2) { 217 $exit = 1; 218 } elsif ($s != 0) { 219 die("randtest 1000 $sz /tmp/wr.$$ failed $s\n"); 220 } 221 } 222 223 $iters++; 224} 225unlink("/tmp/wr.$$", "/tmp/wr1.$$", "/tmp/wr2.$$") || 226 die("\nCan't cleanup: $!\n"); 227print("\n$iters iterations completed\n"); 228