# IBM_PROLOG_BEGIN_TAG # This is an automatically generated prolog. # # bos720 src/bos/usr/lpp/bosinst/samples/NIM/Util.pm 1.1 # # Licensed Materials - Property of IBM # # COPYRIGHT International Business Machines Corp. 2008,2009 # All Rights Reserved # # US Government Users Restricted Rights - Use, duplication or # disclosure restricted by GSA ADP Schedule Contract with IBM Corp. # # IBM_PROLOG_END_TAG # @(#)63 1.1 src/bos/usr/lpp/bosinst/samples/NIM/Util.pm, bosinst, bos720 3/29/09 15:21:00 package NIM::Util; =head1 NAME NIM::Util =over 2 =item NIM related utilities. =back =head1 VARIABLES =head2 %Settings =over 2 =item * project =item * work_dir =item * log_file_handle =item * log_file_name =item * xml_results =item * verbose =back =head1 FUNCTIONS =cut #------------------------------------------------------------------------------- BEGIN { # print "NIM::Util BEGIN\n"; use Hash::Util; use POSIX qw(ctime mktime time); use Time::HiRes qw(gettimeofday); use File::Path; use FileHandle; use IO::Select; use Cwd; use Carp; use Exporter (); use XML::LibXML; use XML::Simple; use IO::File; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); @ISA = qw(Exporter); @EXPORT = qw(bsearch create_work_dir df_info invoke invoke_ssh xml_result log_print log_printf mutex_lock mutex_lock_nb mutex_unlock $Lang %Cmds); %Settings = ('project' => 'sysp', 'work_dir' => "/var/ibm/systemp/nim", 'log_file_handle' => undef, 'log_file_name' => undef, 'xml_results' => 0, 'verbose' => 0); $Lang = 'LANG=C'; %Cmds = ('df' => '/usr/bin/df', 'rpm' => '/usr/bin/rpm', 'tar' => '/usr/bin/tar', 'lsnim' => '/usr/sbin/lsnim', 'nim' => '/usr/sbin/nim -a verbose=1', 'compress' => '/usr/bin/compress', 'uncompress' => '/usr/bin/uncompress', 'uudecode' => '/usr/bin/uudecode', 'uuencode' => '/usr/bin/uuencode', 'ssh' => '/usr/bin/ssh'); @Warnings = (); %SavedOutput = (); $logger = undef; # Capture all warnings $SIG{'__WARN__'} = sub { if (! $NIM::Util::Settings{'xml_results'}) { warn "sigwarn: $_[0]\n"; } push @Warnings, ($_[0]); if ((defined log_print) && ((defined $Settings{'log_file_handle'}) || $logger)) { # Carp::cluck("sigwarn: $_[0]"); log_warn("sigwarn: $_[0]"); } }; $SIG{'__DIE__'} = sub { if ((defined log_print) && ((defined $Settings{'log_file_handle'}) || $logger)) { log_error("sigdie: $_[0]"); if ($Settings{'xml_results'}) { if (defined xml_result) { my $out = ''; my $warnings = join('', @Warnings); if (defined restore_output) { my $outputs = restore_output(); $out = ${$outputs->[0]} . $out; $warnings = ${$outputs->[1]} . $warnings; } print xml_result($Settings{'log_file_name'}, $out, $_[0], $warnings); close STDERR; } } } }; } #------------------------------------------------------------------------------- INIT { # print "NIM::Util INIT\n"; if (! $Settings{'log_file_handle'}) { my $log_file_name = $Settings{'log_file_name'}; if (! $log_file_name) { $Settings{'work_dir'} = NIM::Util::create_work_dir($Settings{'work_dir'}); if ($Settings{'work_dir'}) { if (-e "$Settings{'work_dir'}/$$") { `rm -r $Settings{'work_dir'}/$$/*`; } else { `mkdir $Settings{'work_dir'}/$$`; } if (! -e "$Settings{'work_dir'}/locks") { `mkdir $Settings{'work_dir'}/locks`; } $log_file_name = "$Settings{'work_dir'}/$$/$Settings{'project'}.log"; $Settings{'log_file_name'} = $log_file_name; } } if ($log_file_name) { # print "log file: \'$log_file_name\'\n"; my $fh = new FileHandle(">$log_file_name"); if (defined $fh) { $Settings{'log_file_handle'} = $fh; my $ts = timestamp(); print $fh $ts . ": Created\n"; } else { warn "Unable to open log file\n"; } } } if ($Settings{'verbose'}) { print_settings($Settings{'log_file_handle'}); } my $pm = which_pm('Log4pAutomation.pm'); if (defined $pm) { require Log4pAutomation; $logger = Log4pAutomation::get_logger('NIM'); } NIM::Util::delete_expired_work_dirs(); } #------------------------------------------------------------------------------- END { # print "NIM::Util END\n"; my $rc = $?; if ($Settings{'log_file_handle'}) { log_print("Exit rc = \'$?\'\n"); # my $log_file_name = "$Settings{'work_dir'}/$$/$Settings{'project'}.log"; # print "Closing file: $log_file_name\n"; my $fh = $Settings{'log_file_handle'}; $fh->close(); $Settings{'log_file_handle'} = undef; } # may need to set exit status since we did some calls here $? = $rc; } #------------------------------------------------------------------------------- sub reset_sigwarn_sigdie_handlers { if (defined $SIG{'__WARN__'}) { delete $SIG{'__WARN__'}; } if (defined $SIG{'__DIE__'}) { delete $SIG{'__DIE__'}; } } #------------------------------------------------------------------------------- sub get_warnings { return \@Warnings; } #------------------------------------------------------------------------------- sub print_warnings { $warnings = join('', @Warnings); print "$warnings"; return \@Warnings; } #------------------------------------------------------------------------------- sub delete_expired_work_dirs { my $s = time(); my @dir_list = `ls -1 $Settings{'work_dir'} | grep [1-9][0-9]*`; foreach my $dir_name (@dir_list) { chomp $dir_name; my @stat_attrs = stat("$Settings{'work_dir'}/$dir_name"); my $mtime = $stat_attrs[9]; # hard coded expiration of one week if ((($s - $mtime) / (60 * 60 * 24)) > 7) { `rm -r $Settings{'work_dir'}/$dir_name`; # my @time_array = localtime($mtime); # printf("Deleting $Settings{'work_dir'}/$dir_name %s\n", ctime(mktime @time_array)); } } } #------------------------------------------------------------------------------- sub create_work_dir { my ($work_dir) = @_; # remove all trailing '/'s $work_dir =~ s/\/+$//g; if ($work_dir eq '') { $work_dir = '.'; } mkpath($work_dir); my $rc = $work_dir; if (! -d $work_dir) { warn "not a dir\n"; $rc = ''; } if (! -w $work_dir) { warn "not writable\n"; $rc = ''; } if (-e $work_dir) { # `rm -r $work_dir/*`; } return $rc; } #------------------------------------------------------------------------------- sub timestamp { my $rc = ''; my ($s, $us) = (0, 0); if (0) { $s = time(); } else { ($s, $usec) = gettimeofday(); } # @array == ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) my @array = localtime($s); $rc = mktime @array; $rc = ctime($rc); chomp $rc; $rc = sprintf("$rc (%06u)", $usec); return $rc; } #------------------------------------------------------------------------------- sub log_msg { my ($msg) = @_; if ($Settings{'log_file_handle'}) { my $fh = $Settings{'log_file_handle'}; my $ts = timestamp(); print $fh $ts . ": $msg"; } } #------------------------------------------------------------------------------- sub log_print { my ($msg) = @_; log_msg($msg); if ($logger && Log4pAutomation::initialized()) { $logger->info($msg); } } #------------------------------------------------------------------------------- sub log_printf { my $format = shift; my (@values) = @_; my $msg = sprintf("$format", @values); log_msg($msg); if ($logger && Log4pAutomation::initialized()) { $logger->info($msg); } } #------------------------------------------------------------------------------- sub log_warn { my ($msg) = @_; log_msg($msg); if ($logger && Log4pAutomation::initialized()) { $logger->warn($msg); } } #------------------------------------------------------------------------------- sub log_error { my ($msg) = @_; log_msg($msg); if ($logger && Log4pAutomation::initialized()) { $logger->error($msg); } } #------------------------------------------------------------------------------- sub print_settings { my ($fh) = @_; if (! $fh) { $fh = STDOUT; } print $fh "NIM::Util::Settings:\n"; while (my ($key, $value) = each(%Settings)) { if ($key ne 'log_file_handle') { print $fh "\t$key = \'$value\'\n"; } } } #------------------------------------------------------------------------------- sub invoke { my ($cmd) = @_; my @rc = (); log_print "invoke(\'$Lang $cmd\')\n"; if ($cmd) { if (1) { log_print "\t$cmd\n"; open(CMD, "$Lang $cmd 2>&1 |") || die "Can't run $cmd: $!"; my $exit_status = $?; if ($exit_status) { my $exit_value = ($exit_status >> 8); log_printf("\t\texit value(0x%x), signal(0x%x), core dump(%d)\n", $exit_value, ($exit_status & 127), ($exit_status & 128) ? 1 : 0); if ($exit_value) { warn "$cmd exited with $exit_value"; } } while () { my $line = $_; log_print "\t$line"; # chomp($line); push @rc, ($line); } close(CMD); } } return \@rc; } #------------------------------------------------------------------------------- sub invoke_ssh { my ($target, $cmd, $workdir, $tarfile) = @_; my @rc = (); log_print "invoke_ssh(\'$target\' \'$Lang $cmd\'"; if ($work_dir) { log_print " \'$workdir\'"; } if ($tarfile) { log_print " \'$tarfile\'"; } log_print ")\n"; if ($cmd) { # my $full_cmd = "$Lang $cmd 3>&1 1>&2 2>&3 3>&- | sed s/^/err:/"; my $full_cmd = "$Lang $cmd 2>&1"; if ($tarfile) { $full_cmd = "cat | tar -xf -; $full_cmd"; } if ($workdir) { $full_cmd = "cd $workdir; $full_cmd"; } $full_cmd = "$Cmds{'ssh'} $target \"$full_cmd\" 2>&1"; if ($tarfile) { if (($tarfile) eq '-') { $full_cmd = "cat | $full_cmd"; } else { $full_cmd = "cat $tarfile | $full_cmd"; } } log_print "\t$full_cmd\n"; open(CMD, "$full_cmd |") || die "Can't run $full_cmd: $!"; my $exit_status = $?; if ($exit_status) { my $exit_value = ($exit_status >> 8); log_printf("\t\texit value(0x%x), signal(0x%x), core dump(%d)\n", $exit_value, ($exit_status & 127), ($exit_status & 128) ? 1 : 0); if ($exit_value) { warn "$full_cmd exited with $exit_value"; } } while () { my $line = $_; log_print "\t$line"; # chomp($line); push @rc, ($line); } close(CMD); } return \@rc; } #------------------------------------------------------------------------------- sub slurp_output { my @fds = (STDOUT, STDERR); foreach my $fh (@fds) { my $variable = ''; # First, save away open("SAVED_${fh}", ">&${fh}") || die "Can't run open cmd: $!"; close $fh; open($fh, ">", \$variable) || die "Can't run open cmd: $!"; $SavedOutput{$fh} = \$variable; } } #------------------------------------------------------------------------------- sub restore_output { my @rc = (); my @fds = (STDOUT, STDERR); foreach my $fh (@fds) { # Now close and restore to original condition. close $fh; open($fh, ">&SAVED_${fh}") || die "Can't run open cmd: $!"; push @rc, ($SavedOutput{$fh}); } return \@rc; } #------------------------------------------------------------------------------- sub enable_xml_results { $Settings{'xml_results'} = 1; slurp_output(); } #------------------------------------------------------------------------------- sub xml_result { my ($log_file, $out, $exception, $warnings) = @_; my $rc = ''; my %elements = (); my $doc = XML::LibXML::Document->new(); $elements{'pauto'} = $doc->createElement('pauto'); $doc->setDocumentElement($elements{'pauto'}); $elements{'result'} = $doc->createElement('result'); $elements{'pauto'}->appendChild($elements{'result'}); if (0) { $elements{'result'}->setAttribute('log', $log_file); $elements{'result'}->setAttribute('output', $out); $elements{'result'}->setAttribute('exception', $exception); $elements{'result'}->setAttribute('warnings', $warnings); } else { $elements{'log'} = $doc->createElement('log'); my $text = XML::LibXML::Text->new($log_file); $elements{'log'}->appendChild($text); $elements{'result'}->appendChild($elements{'log'}); # $elements{'output'} = $doc->createElement('output'); $text = XML::LibXML::Text->new($out); $elements{'output'}->appendChild($text); $elements{'result'}->appendChild($elements{'output'}); # $elements{'exception'} = $doc->createElement('exception'); $text = XML::LibXML::Text->new($exception); $elements{'exception'}->appendChild($text); $elements{'result'}->appendChild($elements{'exception'}); # $elements{'warnings'} = $doc->createElement('warnings'); $text = XML::LibXML::Text->new($warnings); $elements{'warnings'}->appendChild($text); $elements{'result'}->appendChild($elements{'warnings'}); } $rc = $doc->toString(); return $rc; } #------------------------------------------------------------------------------- sub parse_xml_input_file { my ($file) = @_; my $rc = eval { XMLin($file, SuppressEmpty => '', KeyAttr => []); }; if ($@) { die "Can't run XMLin($file): $!"; } use Data::Dumper; log_print Dumper($rc); log_print XMLout($rc, RootName => 'pauto', NoAttr => 1); return $rc; } #------------------------------------------------------------------------------- sub read_stdin { my $s = IO::Select->new(); $s->add(\*STDIN); my $rc = ''; if ($s->can_read(.5)) { while () { $rc = $rc . $_; } } # print "$rc"; return $rc; } #------------------------------------------------------------------------------- # on linux # Filesystem 1K-blocks Used Available Use% Mounted on # /dev/sdb1 10317828 2061988 7731724 22% /home # # on AIX # Filesystem 512-blocks Free %Used Iused %Iused Mounted on # /dev/hd1 65536 62480 5% 306 5% /home #------------------------------------------------------------------------------- sub df_info { my ($fs) = @_; my %rc = (); if (-d $fs) { $results = invoke("$Cmds{'df'} $fs"); @keys = split(' ', @$results[0]); @values = split(' ', @$results[1]); # print "keys = @keys\n"; # print "values = @values\n"; for (my $i = 0; $i <= $#values; $i++) { if ($keys[$i] =~ m/([1-9][0-9]*)([K]*)-blocks/) { $rc{'blocks'} = $values[$i]; $rc{'blocksize'} = $1; if ($2 eq 'K') { $rc{'blocksize'} *= 1024; } # print "blocks = $values[$i]\n"; # print "blocksize = $rc{'blocksize'}\n"; } else { $rc{$keys[$i]} = $values[$i]; # print "$keys[$i] = $values[$i]\n"; } } } return \%rc; } #------------------------------------------------------------------------------- sub which_pm { my ($fn) = @_; if ((-e "$fn") && (-r "$fn")) { my $dir = getcwd(); return "$dir/$fn"; } foreach my $path (@INC) { if ((-e "$path/$fn") && (-r "$path/$fn")) { # remove all trailing '/'s $path =~ s/\/+$//g; return "$path/$fn"; } } return undef; } #------------------------------------------------------------------------------- sub bsearch { my ($ary_ptr, $item, $min, $max) = @_; local *ary = \@$ary_ptr; my $rc = -1; if (! defined $min) { $min = 0; } if (! defined $max) { $max = $#ary; } if (($ary[$min] le $item) && ($item le $ary[$max])) { my $mid = int (($max + $min) / 2); # log_print "\tbsearch min($min) mid($mid) max($max)\n"; if ($item lt $ary[$mid]) { $rc = bsearch($ary_ptr, $item, $min, $mid - 1); } elsif ($item gt $ary[$mid]) { $rc = bsearch($ary_ptr, $item, $mid + 1, $max); } else { $rc = $mid; } } return $rc; } #------------------------------------------------------------------------------- sub mutex_lock { my @names = @_; log_print "mutex_lock(\'@names\')\n"; use Fcntl ':flock'; # import LOCK_* constants my @rc = (); foreach my $name (@names) { my $path_name = "$Settings{'work_dir'}/locks/$name"; my $fh = new IO::File; sysopen($fh, $path_name, O_RDWR|O_CREAT, 0644) or die "Can't open $path_name file: $!"; flock($fh, LOCK_EX) or die "Can't flock $path_name file: $!"; push @rc, ($fh); log_print "\t$name => $fh\n"; } return @rc; } #------------------------------------------------------------------------------- sub mutex_lock_nb { my @names = @_; log_print "mutex_lock(\'@names\')\n"; use Fcntl ':flock'; # import LOCK_* constants my @rc = (); my $locked = 0; foreach my $name (@names) { my $path_name = "$Settings{'work_dir'}/locks/$name"; my $fh = new IO::File; sysopen($fh, $path_name, O_RDWR|O_CREAT, 0644) or die "Can't open $path_name file: $!"; $locked = flock($fh, LOCK_EX | LOCK_NB); if ($locked) { push @rc, ($fh); log_print "\t$name => $fh\n"; } } return @rc; } #------------------------------------------------------------------------------- sub mutex_unlock { my @fhs = @_; log_print "mutex_unlock()\n"; # release in reverse order for (my $fh = pop(@fhs); $fh; $fh = pop(@fhs)) { log_print "\t$fh\n"; close($fh); } } #------------------------------------------------------------------------------- sub test { my @test = ('b', 'a', 'c', 'z', 'y', 'x'); @test = sort @test; log_print "\ttest = @test\n"; my $index = bsearch(\@test, 'y'); log_print "\tindex = $index, max index = $#test\n"; } 1; # __END__ =head1 AUTHOR IBM =head1 BUGS Please report any bugs to the L. =head1 SUPPORT =head1 ACKNOWLEDGEMENTS =head1 SEE ALSO =cut