#---------------------------------------------------------------------------+
# Licensed Materials - Property of IBM
# Rational ClearQuest and ClearCase
# Copyright IBM Corp. 1998, 2005 All Rights Reserved
# US Government Users Restricted Rights -
# Use, duplication or disclosure restricted by GSA ADP Schedule Contract
# with IBM Corp.
#---------------------------------------------------------------------------+

use strict;
use Getopt::Long;

#
# Command Line Options
my ($site,$vob_tag,$show_deleted,$showsyncmgmt,$help,$force_OS,$version);
my $bound_options = GetOptions ("site=s" => \$site, 
                                "vobtag=s" => \$vob_tag, 
                                "showdeleted!" => \$show_deleted,
                                "help!" => \$help,
                                "force_os=s" => \$force_OS,
								"version!" => \$version );


my $usage= <<ENDUSAGE;
USAGE:
 perl multisiteinfo.pl -site=<site designation> -vobtag=<vob tag> 
                      [-showdeleted] [-help] [-force_os={win32,unix}]
ENDUSAGE

my $help_message = <<ENDHELP;
 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.

  1. cleartool -VerAll 
  2. multitool -VerAll
  3. cleartool lsvob <vob_tag>
  4. cleartool describe <vob_tag>
  5. cleartool dump <vob_tag>
  6. cleartool lsreplica -long
  7. multitool lsepoch
  8. for each replica found in step 6
     8a. cleartool desc -long replica:<replica_name>
     8b. cleartool dump -long replica:<replica_name>
  9. Sync Manager Information
 10. uname on UNIX, ver on NT

ENDHELP

my $version_info= <<ENDVER;
msinfo.pl version 3.29.06
ENDVER

my (@replicas,$replica);
my ($NT_version,$Unix_version);

# 
# Try to determine whether we are unix or NT.
if ($force_OS ne '') {
    if ($force_OS ne 'win32' && $force_OS ne 'unix') {
		print "Invalid option to -force_os!\n";
		exit 0;
    }
}

if ($force_OS eq 'win32' )  {
    $NT_version = 1;
    $Unix_version = 0;
    print "OS=MSWin32 (forced)\n";
} 
elsif ($force_OS eq 'unix' ) {
    $NT_version = 0;
    $Unix_version = 1;
    print "OS=Generic Unix (forced)\n";
} 
elsif ($^O) {
    my $arch = $^O;
    $NT_version = (($arch =~ /^MSWin32/) || ($arch eq 'i386-win32')) ? 1 : 0;
    $Unix_version = ! $NT_version;
    #print "OS=$arch\n";
}
else  {    
    print "Unable to determine OS!\n";
    exit 0;
}

my $program;
my $current_host;
my $RMFILE;
my $SEP;  
my $UNAME;  
my $TMPDIR; 

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";
    $current_host = `hostname`;
} else {
    $RMFILE = "rm -f";
    $SEP = '/';
    $TMPDIR = "/usr/tmp";
    $UNAME = "uname -a";
    $program = "MultitoolInfo.nt";
    $current_host = `uname -n`;
}

my $cleartool_cmd = 1;
my $multitool_cmd = 2;
my $local_command = 3;

sub GetSystemInfo {
    my($tmpfile) = MultisiteInfoTemp();
    return 1 if(DoCommand($local_command,1,qq($UNAME > "$tmpfile")));
    WriteTmpFile($tmpfile);
    DoCommand($local_command,0,qq($RMFILE "$tmpfile"));   
}

my $file_sequence_no;

#
# 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 function.
sub TempFile {
    my($base) = shift;
    my($path) = $TMPDIR.$SEP.$base;
    return sub { $file_sequence_no++; return "$path.$file_sequence_no"; };
}

#
# Our tempfiles will have a file prefix of "MultisiteInfoTemp.pid".
*MultisiteInfoTemp = TempFile("MultisiteInfoTemp.".$$);


my ($internal_error,$fatal_error,$warning_error);
my $f;

#
# A general error message function. Its passed one of these error
# types, the function where the error occurred, and the message.
$internal_error = "Internal Error";
$fatal_error = "Fatal Error";
$warning_error = "Warning";
sub Error {
    my($type,$f,$msg) = @_;
    print STDOUT "$program: $type Encountered in $f:\n $msg\n";
    return 1;
}

my (@cleartool_output,@multitool_output);
my ($lastcleartoolcommand,$lastmultitoolcommand);

#
# 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 @cleartool_output
sub ReportClearToolError {
    print STDERR "Cleartool Error encountered\n";
	print STDERR "Cleartool Command: $lastcleartoolcommand\n";
	print STDERR "Error Message:\n";
	print STDERR  @cleartool_output, "\n"; 
}

#
# 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 @multitool_output
sub ReportMultiToolError {
	print STDERR "Multitool Error encountered in $f:\n";
	print STDERR "Multitool Command: $lastmultitoolcommand\n";
	print STDERR "Error Message:\n";
	print STDERR  @multitool_output, "\n"; 
}
	
#
# 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 cleartool_output for use by the caller or 
# ReportClearToolError.
my $cmd_terminator= "NONVALIDCOMMAND";
my ($spawned_cleartool,$SpawnedMultiTool) = (0,0);

sub ClearTool {
    my($command) = @_;
    @cleartool_output = ();
    $lastcleartoolcommand = $command;
    
    # Spawn a cleartool process if we haven't yet done so
    if (!$spawned_cleartool) {
        unless(pipe(CT_READ, CT_P_WRITE)) { 
	      Error($internal_error,'ClearTool',"Pipe failed: $!\n");
	      return 1;
	    }
        my($oldfh) = select(CT_P_WRITE); $| = 1; select($oldfh);
        # redirect STDOUT to CT_P_WRITE, ditto for STDERR
        unless(open(SAVED_STDOUT, ">&STDOUT")) {
	      Error($internal_error,'ClearTool',"Can\'t dup STDOUT: $!\n");
	      return 1;
	    }
	    close(STDOUT);
        unless(open(STDOUT, ">&CT_P_WRITE")) {
	      Error($internal_error,'ClearTool',"Can\'t redirect STDOUT: $!\n");
	      return 1;
	    }
	    unless(open(SAVED_STDERR, ">&STDERR")) {
			Error($internal_error,'ClearTool',"Can\'t dup STDERR: $!\n");
			return 1;
	    }
        close(STDERR);
        unless(open(STDERR, ">&CT_P_WRITE")) {
			Error($internal_error,'ClearTool',"Can\'t redirect STDERR: $!\n");
			return 1;
	    }
 
        # 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($internal_error,'ClearTool',"Can\'t spawn cleartool: $!\n");
			return 1;
	    }
        $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($internal_error,'ClearTool',"Can\'t put STDOUT back: $!\n");
			return 1;
	    }
        close(SAVED_STDOUT);
 
		close(STDERR);
        unless(open(STDERR, ">&SAVED_STDERR")) {
			Error($internal_error,'ClearTool',"Can\'t put STDERR back: $!\n");
			return 1;
	    }
        close(SAVED_STDERR);
 
        $spawned_cleartool++;
    }
    # Send the command.
    print CT_WRITE  $command, "\n";
    # Send 
    print CT_WRITE  $cmd_terminator, "\n";
    # Get the response
    while (<CT_READ>) {
    # print "Ct Out: $_"; 
        last if (m(Unrecognized command: "$cmd_terminator"));
        push(@cleartool_output, $_);
    }
    @cleartool_output;

}

#
# 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 multitool_output for use by the caller or 
# ReportMultiToolError.
sub MultiTool {
    my($command) = @_;
    @multitool_output = ();
    $lastmultitoolcommand = $command;

    # Spawn a multitool process if we haven't yet done so
    if (!$SpawnedMultiTool) {
        unless(pipe(MT_READ, MT_P_WRITE)) { 
			Error($internal_error,'MultiTool',"Pipe failed: $!\n");
			return 1;
	    }
        my($oldfh) = select(MT_P_WRITE); $| = 1; select($oldfh);
 
        # redirect STDOUT to MT_P_WRITE, ditto for STDERR
        unless(open(SAVED_STDOUT, ">&STDOUT")) {
			Error($internal_error,'MultiTool',"Can\'t dup STDOUT: $!\n");
			return 1;
	    }
	    close(STDOUT);
        unless(open(STDOUT, ">&MT_P_WRITE")) {
			Error($internal_error,'MultiTool',"Can\'t redirect STDOUT: $!\n");
			return 1;
	    }
	    unless(open(SAVED_STDERR, ">&STDERR")) {
			Error($internal_error,'MultiTool',"Can\'t dup STDERR: $!\n");
			return 1;
	    }
        close(STDERR);
        unless(open(STDERR, ">&MT_P_WRITE")) {
			Error($internal_error,'MultiTool',"Can\'t redirect STDERR: $!\n");
			return 1;
	    }
 
        # 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($internal_error,'MultiTool',"Can\'t spawn multitool: $!\n");
			return 1;
	    }
        $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($internal_error,'MultiTool',"Can\'t put STDOUT back: $!\n");
			return 1;
	    }
        close(SAVED_STDOUT);
        close(STDERR);
        unless(open(STDERR, ">&SAVED_STDERR")) {
			Error($internal_error,'MultiTool',"Can\'t put STDERR back: $!\n");
			return 1;
	    }
        close(SAVED_STDERR);
         $SpawnedMultiTool++;
    }
    # Send the command.
    print MT_WRITE  $command, "\n";
    # Send 
    print MT_WRITE  $cmd_terminator, "\n";
    # Get the response
    while (<MT_READ>) {
        last if (m(Unrecognized command: "$cmd_terminator"));
        push(@multitool_output, $_);
    }
    @multitool_output;
}

#
# Invoke the perl system mechanism to execute a local command. 
# PERL system return codes are in the high-order bytes, so divide
# by 256 to extract the real value. 
# Status 0 indicates success.
# If the called process exits with a signal, then this is reported
# in the low-order bytes.
sub DoSystem {
    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; #what does this do..
		print "\n  Command completed with non-zero exit status $rc.\n";
    }
    else {
		print "command completed 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.
sub DoCommand {
    my($type,$display,$command) = @_;
    print "\n";
    if($type == $cleartool_cmd) {
		if($display) {
			print qq(######## Output of "cleartool $command"\n);
		}
		if(grep(/Error/,ClearTool($command)) or !@cleartool_output) {
			if(@cleartool_output) {
				ReportClearToolError();
			}
			return 1;
		}

		if($display) {
			foreach (@cleartool_output) {
				print;
			}
		}
    } elsif($type == $multitool_cmd) {
		if($display) {
			print qq(######## Output of "multitool $command"\n);
		}
		if(grep(/Error/,MultiTool($command)) or !@multitool_output) {
			if(@multitool_output) {
				ReportMultiToolError();
			}
			return 1;
		}
		if($display) {
			foreach (@multitool_output) {
			print;
			}
		}
    } elsif($type == $local_command) {
		if($display) {
			# Local commands may redirect the output to a tmp file for parsing.
			# Strip off the redirection in the banner.
			my $cmd_to_parse = $1 if($command =~ /(.*)>/);
			print qq(######## Output of "$cmd_to_parse"\n);
		}
		if(DoSystem($command)) {
			return 1;
		}
    } else {
		print "Internal Error: DoCommand called with unknown type\n";
		return 1;
    }
}

#
# Open and write the named tmp file to standard output.
sub WriteTmpFile {
    my($f) = @_;
    unless(open(TMPDESC,$f)) {
		Error($internal_error,'WriteTmpFile',"Open of tmp file $f failed: $!");
		return 1;
    }
    while(<TMPDESC>) {
		print;
    }
    close(TMPDESC);
}

#
# cleartool doesn't recognize version request in pipe mode so make
# an explicit cleartool call.
sub ClearToolVersion {
    my($tmpfile) = MultisiteInfoTemp();
    my $clearcase_version;
    return 1 if(DoCommand($local_command,1,
				  qq(cleartool -VerAll > "$tmpfile")));
    unless(open(TMPDESC,$tmpfile)) {
		Error($internal_error,'ClearToolVersion',
	      "Open of tmp file $tmpfile failed: $!");
	return 1;
    }
    while(<TMPDESC>) {
		print;
		$clearcase_version = $1 if(/ClearCase version (.*?) /);
    }
    close(TMPDESC);
    DoCommand($local_command,0,qq($RMFILE "$tmpfile"));
    return 0;
}

#
# multitool doesn't recognize version request in pipe mode so make
# an explicit multitool call.
sub MultiToolVersion {
    my($tmpfile) = MultisiteInfoTemp();
    my $multitool_version;
    return 1 if(DoCommand($local_command,1,
				  qq(multitool -VerAll > "$tmpfile")));

    unless(open(TMPDESC,$tmpfile)) {
	Error($internal_error,'MultiToolVersion',
	      "Open of tmp file $tmpfile failed: $!");
	return 1;
    }
    while(<TMPDESC>) {
		print;
		$multitool_version = $1 if(/MultiSite version (.*?) /);
    }
    close(TMPDESC);
    DoCommand($local_command,0,qq($RMFILE "$tmpfile"));
    return 0;
}

#
# Syncmgr doesn't recognize version request in pipe mode so make
# an explicit syncmgr call.
sub SyncMgrVersion {
    my($tmpfile) = MultisiteInfoTemp();
    my $syncmgr_version;
    return 1 if(DoCommand($local_command,1,
				  qq(syncmgr_server -VerAll > "$tmpfile")));

    unless(open(TMPDESC,$tmpfile)) {
		Error($internal_error,'SyncMgrVersion',
	      "Open of tmp file $tmpfile failed: $!");
	return 1;
    }
    while(<TMPDESC>) {
		print;
		$syncmgr_version = $1 if(/syncmgr_server (.*?) /);
    }
    close(TMPDESC);
    DoCommand($local_command,0,qq($RMFILE "$tmpfile"));
    return 0;
}



#
# Syncmgr 
sub SyncMgrExists {
    my($tmpfile) = MultisiteInfoTemp();
    my $exists = 0;

    DoCommand($local_command,0,qq(multitool -VerAll > "$tmpfile"));

    unless(open(TMPDESC,$tmpfile)) {
		Error($internal_error,'SyncMgrExistence',
	      "Open of tmp file $tmpfile failed: $!");
		return 1;
    }
    while(<TMPDESC>) {
		if(/libatriasyncmgr/) {$exists = 1;}
    }
    close(TMPDESC);
    DoCommand($local_command,0,qq($RMFILE "$tmpfile"));
    return $exists;
}

#
# Main program.
#
# Something necessary wasn't supplied -- show usage.
if (($site eq '' || $vob_tag eq '') && $help == 0 && $version == 0){
	print "$usage";
	exit 1;
}

# Help was requested -- display it.
if ($help == 1) {
     print "\n";
     print "$usage";
     print "\n";
     print "$help_message";
     print "\n";
     print "$version_info";
     exit 1;
}

# Version was reqested -- display it.
if ($version == 1) {
     print "\n";
     print "$version_info";
	 print "\n";
     exit 1;
}

#
# Print a banner.
print "\n";
print "$version_info";
print "******************************************************************\n";
print "***** Vob:  $vob_tag\n";
print "***** Site: $site\n";
print "***** Host: $current_host\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 real work
exit 1 if(DoCommand($cleartool_cmd,1,"lsvob -long $vob_tag"));
exit 1 if(DoCommand($cleartool_cmd,1,"desc  vob:$vob_tag"));
exit 1 if(DoCommand($cleartool_cmd,1,"dump  vob:$vob_tag"));
exit 1 if(DoCommand($cleartool_cmd,1,"lsreplica -long -invob $vob_tag"));
DoCommand($multitool_cmd,1,"lsepoch -invob $vob_tag ");

#
# If we have requested info for .deleted replicas, then add them to our list.
# We get replica names by reading out the replica entries in one epoch matrix row.
my $begin_first_epoch_row = 0;
foreach (@multitool_output)
{
    if(m/^Oplog IDs for row "(.*)"/){
		if ($begin_first_epoch_row == 0){
			$begin_first_epoch_row = 1; # We have found the first row.
		}else{
			last;  # We must be at the second row.
                 # All replica names have been seen. Done.
		}
    }
    else{
    	if (m/^ oid.*\((.*\.deleted(\.\d*)?)\)/){ # Match the X.deleted[.Y] entries.
			if ($show_deleted){ 
				push(@replicas,$1); 
			}
		}elsif (m/^ oid.*\((.*)\)/){ # Match the normal replica names.
   	 		push(@replicas,$1);
		}
    } 
}

#
# For each replica get the desc and dump
foreach $replica (@replicas) {
    	DoCommand($cleartool_cmd,1,"desc -long replica:$replica\@$vob_tag");
}

my $the_local_replica;

foreach $replica (@replicas) {
	DoCommand($cleartool_cmd,1,"dump -long replica:$replica\@$vob_tag");
	foreach (@cleartool_output) {
		if(m/^flags:(.*)predefined(.*)/) {
			$the_local_replica = $replica;
		}
	}
}

#
# Gather info for sync management if the current install includes it
if (SyncMgrExists())
{
	print "\n\n######## Sync Management Information ########";

	SyncMgrVersion();
	DoCommand($multitool_cmd,1,"syncserver -inquire -vob $vob_tag");
	DoCommand($multitool_cmd,1,"lssetting -replica $the_local_replica\@$vob_tag -inquire");
	DoCommand($multitool_cmd,1,"lssetting -site -long");
	DoCommand($multitool_cmd,1,"syncinfo -replica $the_local_replica\@$vob_tag");
}

#
# On NT the output of this command is pretty lengthy so it goes on
# the end. On unix its just uname -a.
GetSystemInfo();
