

#
# 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 Message:\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 Message:\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 =~ /^[34]/) || ($CC_Version =~ /^2002/)) {
    $CC_V3V4V5 = 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_V3V4V5) {
	DoCommand($ClearToolCmd,1,"desc replica:$replica");
    } else {
	DoCommand($ClearToolCmd,1,"desc -vreplica $replica");
    }
}

foreach $replica (@Replicas) {
    if($CC_V3V4V5) {
	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();










