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