| Perl Script #
# This perl script is intended to be given to costumers by Rational
# support. It gets general information that we need for all multisite
# support calls.The user must give a string identifying the site. He/she
# may choose any string he/she wishes but all references to this site in
# the escalation data base must use this string. The script expects to
# be run in a view in the vob tag for the replica at the site given as
# an argument. It will print a banner containing the site string
followed
# by output from the following commands. The script handles differences
# in syntax between 2.x and 3.x versions of ClearCase.
#
# 1. cleartool lsvob <vob_tag>
# 2. cleartool -VerAll
# 3. multitool -VerAll
# 4. cleartool lsreplica -long
# 5. multitool lsepoch
# 6. for each replica found in step 4
# 6a. cleartool desc replica:$replica
# 6b. cleartool dump replica:$replica
# 7. uname on unix, ver on NT
#
#
# Try to determine whether we are unix or NT. Assume the following
# will fail on any unix.
#
if(system("cmd.exe /c ver")) {
$UnixVersion = 1;
$NT_Version = 0;
} else {
$UnixVersion = 0;
$NT_Version = 1;
}
if($NT_Version) {
$RMFILE = "cmd /c del";
$SEP = '\\';
$UNAME = "cmd /c ver";
if(exists($ENV{'TMP'})) {
$TMPDIR = $ENV{'TMP'};
} elsif (-d $ENV{'SystemDrive'}.'\tmp') {
$TMPDIR = $ENV{'SystemDrive'}.'\tmp';
} elsif (-d $ENV{'SystemDrive'}.'\temp') {
$TMPDIR = $ENV{'SystemDrive'}.'\temp';
} else {
unless(mkdir($ENV{'SystemDrive'}.'\temp', 0777)) {
printf "Could not find TMP ev or open \\temp on $ENV{'SystemDrive'}\n";
exit 0;
}
$TMPDIR = $ENV{'SystemDrive'}.'\temp';
}
$Program = "MultitoolInfo.nt";
$CurrentHost = `hostname`;
} else {
$RMFILE = "rm -f";
$SEP = '/';
$TMPDIR = "/usr/tmp";
$UNAME = "uname -a";
$Program = "MultitoolInfo.nt";
$CurrentHost = `uname -n`;
}
sub GetSystemInfo {
my($tmpfile) = MultisiteInfoTemp();
return undefined if(DoCommand($LocalCmd,1,qq($UNAME > "$tmpfile")));
WriteTmpFile($tmpfile);
DoCommand($LocalCmd,0,qq($RMFILE "$tmpfile"));
}
#
# Actually returns a function reference. The base string passed
# in will be used as a file prefix for all subsequent calls to the
# referenced function. A sequence number is attached to the end
# of the tmpfile name on each call to the referenced fuction.
sub TempFile {
my($base) = shift;
my($path) = $TMPDIR.$SEP.$base;
return sub { $Sequence++; return "$path.$Sequence"; };
}
# Our tempfiles will have a file prefix of "MultisiteInfoTemp.pid".
*MultisiteInfoTemp = TempFile("MultisiteInfoTemp.".$$);
#
# A general error message function. Its passed one of these error
# types, the function where the error occurred, and the message.
$InternalError = "Internal Error";
$FatalError = "Fatal Error";
$WarningError = "Warning";
sub Error {
my($type,$f,$msg) = @_;
print STDOUT "$Program: $type Encountered in $f:\n $msg\n";
return undefined;
}
#
# A specialized error message function to print cleartool errors.
# The ClearTool function below sets $LastClearToolCommand command
# each time its called. That function also always leaves all cleartool
# output in @ClearToolOutput
sub ReportClearToolError {
if(@ClearToolOutput) {
print STDERR "Cleartool Error encountered\n";
print STDERR "Cleartool Command: $LastClearToolCommand\n";
print STDERR "Cleartool Error Massage:\n";
print STDOUT @ClearToolOutput, "\n";
return undefined;
}
return 0;
}
#
# A specialized error message function to print multitool errors.
# The MultiTool function below sets $LastMultiToolCommand command
# each time its called. That function also always leaves all multitool
# output in @MultiToolOutput
sub ReportMultiToolError {
if(@MultiToolOutput) {
print STDERR "Multitool Error encountered in $f:\n";
print STDERR "Multitool Command: $LastMultiToolCommand\n";
print STDERR "Multitool Error Massage:\n";
print STDOUT @MultiToolOutput, "\n";
return undefined;
}
return 0;
}
#
# Open a pipe to cleartool during the initial call and leave it open for
# the duration of this process. All write the passed command to the
# pipe followed by a command that cleartool is sure not to recognize.
All
# cleartool out up to and not including the "command not recognized" is
# read and placed in ClearToolOutput for use by the caller or
# ReportClearToolError.
$CommandTerminator = "Snarf";
$SpawnedCleartool = 0;
sub ClearTool {
my($command) = @_;
@ClearToolOutput = ();
$LastClearToolCommand = $command;
# Spawn a cleartool process if we haven't yet done so
if (!$SpawnedClearTool) {
unless(pipe(CT_READ, CT_P_WRITE)) {
Error($InternalError,'ClearTool',"Pipe failed: $!\n");
return undefined;
}
my($oldfh) = select(CT_P_WRITE); $| = 1; select($oldfh);
# redirect STDOUT to CT_P_WRITE, ditto for STDERR
unless(open(SAVED_STDOUT, ">&STDOUT")) {
Error($InternalError,'ClearTool',"Can\'t dup STDOUT: $!\n");
return undefined;
}
close(STDOUT);
unless(open(STDOUT, ">&CT_P_WRITE")) {
Error($InternalError,'ClearTool',"Can\'t redirect STDOUT: $!\n");
return undefined;
}
unless(open(SAVED_STDERR, ">&STDERR")) {
Error($InternalError,'ClearTool',"Can\'t dup STDERR: $!\n");
return undefined;
}
close(STDERR);
unless(open(STDERR, ">&CT_P_WRITE")) {
Error($InternalError,'ClearTool',"Can\'t redirect STDERR: $!\n");
return undefined;
}
# spawn the cleatool and get a WRITE fh for its input.
# Its output / errout is inherited from our (redirected) STD{OUT,ERR}
unless(open(CT_WRITE, "| cleartool")) {
Error($InternalError,'ClearTool',"Can\'t spawn cleartool: $!\n");
return undefined;
}
$oldfh = select(CT_WRITE); $| = 1; select($oldfh);
close(CT_P_WRITE); # this isn't our side of the pipe
# redirect STD{OUT,ERR} back to their original state
close(STDOUT);
unless(open(STDOUT, ">&SAVED_STDOUT")) {
Error($InternalError,'ClearTool',"Can\'t put STDOUT back: $!\n");
return undefined;
}
close(SAVED_STDOUT);
close(STDERR);
unless(open(STDERR, ">&SAVED_STDERR")) {
Error($InternalError,'ClearTool',"Can\'t put STDERR back: $!\n");
return undefined;
}
close(SAVED_STDERR);
$SpawnedClearTool++;
}
# Send the command.
print CT_WRITE $command, "\n";
# Send
print CT_WRITE $CommandTerminator, "\n";
# Get the response
while (<CT_READ>) {
# print "Ct Out: $_";
last if (m(Unrecognized command: "$CommandTerminator"));
push(@ClearToolOutput, $_);
}
@ClearToolOutput;
}
#
# Open a pipe to multitool during the initial call and leave it open for
# the duration of this process. All write the passed command to the
# pipe followed by a command that multitool is sure not to recognize.
All
# multitool out up to and not including the "command not recognized" is
# read and placed in MultiToolOutput for use by the caller or
# ReportMultiToolError.
$SpawnedMultiTool = 0;
sub MultiTool {
my($command) = @_;
@MultiToolOutput = ();
$LastMultiToolCommand = $command;
# Spawn a multitool process if we haven't yet done so
if (!$SpawnedMultiTool) {
unless(pipe(MT_READ, MT_P_WRITE)) {
Error($InternalError,'MultiTool',"Pipe failed: $!\n");
return undefined;
}
my($oldfh) = select(MT_P_WRITE); $| = 1; select($oldfh);
# redirect STDOUT to MT_P_WRITE, ditto for STDERR
unless(open(SAVED_STDOUT, ">&STDOUT")) {
Error($InternalError,'MultiTool',"Can\'t dup STDOUT: $!\n");
return undefined;
}
close(STDOUT);
unless(open(STDOUT, ">&MT_P_WRITE")) {
Error($InternalError,'MultiTool',"Can\'t redirect STDOUT: $!\n");
return undefined;
}
unless(open(SAVED_STDERR, ">&STDERR")) {
Error($InternalError,'MultiTool',"Can\'t dup STDERR: $!\n");
return undefined;
}
close(STDERR);
unless(open(STDERR, ">&MT_P_WRITE")) {
Error($InternalError,'MultiTool',"Can\'t redirect STDERR: $!\n");
return undefined;
}
# spawn the cleatool and get a WRITE fh for its input.
# Its output / errout is inherited from our (redirected) STD{OUT,ERR}
unless(open(MT_WRITE, "| multitool")) {
Error($InternalError,'MultiTool',"Can\'t spawn multitool: $!\n");
return undefined;
}
$oldfh = select(MT_WRITE); $| = 1; select($oldfh);
close(MT_P_WRITE); # this isn't our side of the pipe
# redirect STD{OUT,ERR} back to their original state
close(STDOUT);
unless(open(STDOUT, ">&SAVED_STDOUT")) {
Error($InternalError,'MultiTool',"Can\'t put STDOUT back: $!\n");
return undefined;
}
close(SAVED_STDOUT);
close(STDERR);
unless(open(STDERR, ">&SAVED_STDERR")) {
Error($InternalError,'MultiTool',"Can\'t put STDERR back: $!\n");
return undefined;
}
close(SAVED_STDERR);
$SpawnedMultitool++;
}
# Send the command.
print MT_WRITE $command, "\n";
# Send
print MT_WRITE $CommandTerminator, "\n";
# Get the response
while (<MT_READ>) {
# print "Mt Out: $_";
last if (m(Unrecognized command: "$CommandTerminator"));
push(@MultiToolOutput, $_);
}
@MultiToolOutput;
}
#
# Invoke the perl system mechanism to execute a local command. Try
# to make sence out of errors.
sub System {
my($args) = @_;
my($rc) = 0;
my($st) = 0xffff & system($args);
return $st if($st == 0);
$rc = $st;
print " System Error encountered in $f:\n";
printf " system(%s) returned %#04x: ", "args", $rc;
if($rc == 0xff00) {
print " command failed\n";
}
elsif($rc > 0xff) {
$rc >>= 8;
print " ranwith non-zero exit status $rc\n";
}
else {
print "ran with ";
if($rc & 0x80) {
$rc &= ~0x80;
print " coredump from ";
}
print " signal $rc\n";
}
$st;
}
#
# Front end for the ClearTool, MultiTool, and System functions. Print
# a banner if $display is set. For ClearTool and MultiTool calls either
# call the appropriate specialized error message function or print the
# contents of the Clear/Multi/Output array if $display is set. For
System
# just return. On error undefined is return, 0 otherwise.
$ClearToolCmd = 1;
$MultiToolCmd = 2;
$LocalCmd = 3;
sub DoCommand {
my($type,$display,$command) = @_;
print "\n";
if($type == $ClearToolCmd) {
if($display) {
print qq(######## Output of "cleartool $command"\n);
}
if(grep(/Error/,ClearTool($command)) or !@ClearToolOutput) {
return undefined if(ReportClearToolError());
}
if($display) {
foreach (@ClearToolOutput) {
print;
}
}
} elsif($type == $MultiToolCmd) {
if($display) {
print qq(######## Output of "multitool $command"\n);
}
if(grep(/Error/,MultiTool($command)) or !@MultiToolOutput) {
return undefined if(ReportMultiToolError());
}
if($display) {
foreach (@MultiToolOutput) {
print;
}
}
} elsif($type == $LocalCmd) {
if($display) {
#
# Local commands may redirect the output to a tmp file for parsing.
# Strip off the redirection in the banner.
$pcmd = $1 if($command =~ /(.*)>/);
print qq(######## Output of "$pcmd"\n);
}
if(System($command)) {
return undefined;
}
} else {
print "Internal Error: DoCommand called with unknown type\n";
return undefined;
}
}
#
# Open and write the named tmp file to standard output.
sub WriteTmpFile {
my($f) = @_;
unless(open(TMPDESC,$f)) {
Error($InternalError,'WriteTmpFile',"Open of tmp file $f failed: $!");
return undefined;
}
while(<TMPDESC>) {
print;
}
close(TMPDESC);
}
#
# cleartool doesn't recognoze version request in pipe mode so make
# an explicate cleartool call.
sub ClearToolVersion {
my($tmpfile) = MultisiteInfoTemp();
return undefined if(DoCommand($LocalCmd,1,
qq(cleartool -VerAll > "$tmpfile")));
unless(open(TMPDESC,$tmpfile)) {
Error($InternalError,'ClearToolVersion',
"Open of tmp file $tmpfile failed: $!");
return undefined;
}
while(<TMPDESC>) {
print;
$CC_Version = $1 if(/ClearCase version (.*?) /);
}
close(TMPDESC);
DoCommand($LocalCmd,0,qq($RMFILE "$tmpfile"));
return 0;
}
#
# multitool doesn't recognoze version request in pipe mode so make
# an explicate multitool call.
sub MultiToolVersion {
my($tmpfile) = MultisiteInfoTemp();
return undefined if(DoCommand($LocalCmd,1,
qq(multitool -VerAll > "$tmpfile")));
unless(open(TMPDESC,$tmpfile)) {
Error($InternalError,'MultiToolVersion',
"Open of tmp file $tmpfile failed: $!");
return undefined;
}
while(<TMPDESC>) {
print;
$MS_Version = $1 if(/MultiSite version (.*?) /);
}
close(TMPDESC);
DoCommand($LocalCmd,0,qq($RMFILE "$tmpfile"));
return 0;
}
#
# Main program.
$nargs = scalar @ARGV;
if($nargs != 2) {
print "$Program: Perl MultitoolInfo.pl <site designation> <vob tag>\n";
exit(1);
}
$Site = shift(@ARGV);
$VobTag = shift(@ARGV);
#
# Print a banner.
print "\n";
print
"******************************************************************\n";
print "***** Vob: $VobTag\n";
print "***** Site: $Site\n";
print "***** Host: $CurrentHost\n";
print
"******************************************************************\n";
#
# Can't use the ClearTool or MultiTool function to get version
information
# because the pipe interface doesn't recognize the version commands.
exit(1) if(ClearToolVersion());
exit(1) if(MultiToolVersion());
#
# The above set CC_Version and MS_Version globals. Set a boolean
# for easy version checks.
if($CC_Version =~ /^3/) {
$CC_V3 = 1;
}
#
# The real work
exit(1) if(DoCommand($ClearToolCmd,1,"lsvob -long $VobTag"));
exit(1) if(DoCommand($ClearToolCmd,1,"lsreplica -long"));
DoCommand($MultiToolCmd,1,"lsepoch");
foreach (@MultiToolOutput) {
push(@Replicas,$1) if(m/^Oplog IDs for row "(.*)"/);
}
foreach $replica (@Replicas) {
if($CC_V3) {
DoCommand($ClearToolCmd,1,"desc replica:$replica");
} else {
DoCommand($ClearToolCmd,1,"desc -vreplica $replica");
}
}
foreach $replica (@Replicas) {
if($CC_V3) {
DoCommand($ClearToolCmd,1,"dump replica:$replica");
} else {
DoCommand($ClearToolCmd,1,"dump -vreplica $replica");
}
}
#
# On NT the output of this command is pretty lengthy so it goes on
# the end. On unix its just uname -a.
GetSystemInfo();
|