#
# ------------------------------------------------------------------
# | Copyright Unpublished, Atria Software, Inc.  All Rights        |
# | Reserved.  This software contains proprietary and confidential |
# | information of Atria and its suppliers.  Use, disclosure or    |
# | reproduction is prohibited without the prior express written   |
# | consent of Atria.                                              |
# ------------------------------------------------------------------

#
# ck_ver_cltxt_len.pl [-blatest] [-verbose] [elem_pname] ... 
#
# With no args, all of the elements in the current directory's
# VOB are checked.
# If elem_pname's are specified
# only those elements are checked... you still must be cd'd
# to those elements VOB! (due to implementation limitations of
# this script).
#
# With "-blatest", check only the LATEST version of every branch
# in the element, otherwise check every version in the element.
# For each selected version, forceable construct the cleartext
# and verify that its length matches what the VOB says it should be.
#
# With "-verbose" each version checked is identified.  Otherwise
# only a progress indicator (".") is printed for each version
# checked.
#
# The cleartext is constructed in a *single* temporary file,
# so the cleartext pool isn't filled up.  It is safe to run
# multiple instances on the same host simultaneously (each instance
# uses its own tmp file).
#
# *** need to be in a view (any view will do) ***
# *** need to be cd'd to the VOB to check ***
#
# E.g.,
# % setview <any view>
# % cd <vob root dir>
# % ct lock -vob .  (OPTIONAL keep reading)
# % ck_ver_cltxt_len.pl | tee ck_ver_cltxt_len.out
# ... sit back ...
# % ct unlock -vob .
#
# Alternatively you can run it as follows...
#    set view
#    $ cd <vob root dir>
#    $ ct find -all -type f -print | xargs -n50 ck_ver_ver_cltxt_len.pl
#
# Note: actually, you need only lock the source pools, not the
# entire VOB.  That way folks can still do everything except
# make branches, checkin and checkout (if doing so involves making a branch).
#
# Warning: this script will take a long time for a large VOB.
# Sorry, I can't give you a size / time factor.
#
# It isn't necessary to lock the VOB being checked, however,
# not locking it may result in "false" errors (in the unlikely
# event that an element is changing -e.g., checkin, mkbranch-
# while it is being checked).
#

$ct='cleartool';

if ($ENV{OS} =~ /^Windows/) {
    chop($cwd = `cd`);
    $dev_null='NUL';
    $all_query="created_since(03-Jan-1970)";
    $copy_src_dst="copy ";
    $tmp_cltxt_cntr_pname = "C:\\temp\\junk_cleartext_container.$$";
    $pname_sep = '\\';
	chomp (my @reg = `reg query HKLM\\Software\\Atria\\ClearCase\\CurrentVersion /v ProductHome`);
	($ProductHome)  = grep(s/\s+ProductHome\s+REG_SZ\s+//,@reg);
    $invoke_mgr_pn = "$ProductHome\\etc\\utils\\invoke_mgr.exe";
    if (!-f $invoke_mgr_pn) {
        # must be a v2.x system
        die ("need \"$invoke_mgr_pn\" (a V3.x util) for NT.\n");
    }
} else {
    chop($cwd = `pwd`);
    $dev_null='/dev/null';
    $all_query="'created_since(03-Jan-1970)'";
    $copy_src_dst="/bin/cp ";
    $tmp_cltxt_cntr_pname = "/tmp/junk_cleartext_container.$$";
    $pname_sep = '/';
	$invoke_mgr_pn = '/opt/rational/clearcase/etc/utils/invoke_mgr';
}

# From /opt/rational/clearcase/lib/mgrs/mgr_info.h
#
$MGR_CONSTRUCT_USE_SRC_CONTAINER =      101 << 8;
$MGR_CONSTRUCT_USE_NEW_FILE =           102 << 8;

# force non-buffered output (so we see progress even when redirecting
# output to a file).
$| = 1;


# cleartool command
# maintains global file handles CT_WRITE and CT_READ
#
sub cleartool {
    local($cmd) = @_;
    local($_);
    local($cmd_terminator) = ("ThisIsABadCommand");
    local(@response);

    # Spawn a cleartool process if we haven't yet done so
    if (! $spawned_ct) {
	pipe(CT_READ, CT_P_WRITE) || die("can't create pipe\n");
	local($oldfh) = select(CT_P_WRITE); $| = 1; select($oldfh);

	# redirect STDOUT to CT_P_WRITE, ditto for STDERR
	open(SAVED_STDOUT, ">&STDOUT") || die("can't dup stdout\n");
	close(STDOUT);
	open(STDOUT, ">&CT_P_WRITE") || die("can't redirect STDOUT\n");

	open(SAVED_STDERR, ">&STDERR") || die("can't dup stderr\n");
	close(STDERR);
	open(STDERR, ">&CT_P_WRITE") || die("can't redirect STDERR\n");

	# spawn the cleatool and get a WRITE fh for its input.
	# Its output / errout is inherited from our (redirected) STD{OUT,ERR}
	open(CT_WRITE, "| $ct") || die("can't spawn $ct\n");
        $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);
	open(STDOUT, ">&SAVED_STDOUT");
	close(SAVED_STDOUT);

	close(STDERR);
	open(STDERR, ">&SAVED_STDERR");
	close(SAVED_STDERR);

        $spawned_ct = "yes";
    }

    # Send the command.
    print CT_WRITE  $cmd, "\n";

    # Send a special piece of swill so we can recognize the end of the response
    print CT_WRITE  "$cmd_terminator", "\n";

    # Get the response
    while (<CT_READ>) {
	chop;
	last if (/$cmd_terminator/);
	push(@response, $_);
    }
    @response;
}

# cache for cleartool_dump()
#
$dump_data_cache_tag = "";
@dump_data_cache = ();

# cleartool_dump_flush
#
sub cleartool_dump_flush {
    $dump_data_cache_tag = "";
}

# cleartool_dump <dump_args>
#
sub cleartool_dump {
    local($args) = @_;

    # if we have the info for the object in our cache, just return it.
    if ($dump_data_cache_tag ne $args) {
	# print "loading dump data for $args\n";
	@dump_data_cache = &cleartool("dump $args");
	$dump_data_cache_tag = $args;
    }
    @dump_data_cache;
}

# obj_get_oid <obj_sel>
#
sub obj_get_oid {
    local($obj_sel) = @_;
    local($_, $oid);

    ($oid) = grep(/^oid=/, &cleartool_dump($obj_sel));
    $oid || die("no oid for pname '$obj_sel'\n");
    $oid =~ /^oid=([^\s]+)/;
    $oid = $1;
    $oid || die("no oid for pname '$obj_sel'\n");
    $oid;
}

# ver_get_cntr <ver_xpn>
#
sub ver_get_cntr {
    local($ver_xpn) = @_;
    local($_, $cntr);

    ($cntr) = grep(/^source cont=/, &cleartool_dump($ver_xpn));
    return 0 if (!$cntr);    # return nil for ndata versions
    $cntr =~ /^source cont="(.*)"/;
    $cntr = $1;
}

# ver_get_len <ver_xpn>
# Get the VOB's idea of the version's length.
# Assume this is only called for non-ndata versions
#
sub ver_get_len {
    local($ver_xpn) = @_;
    local($_, $ver_len, $junk);

    # Note: explicitly do not get this info from asking the mvfs
    # (i.e., by stat-ing the ver_xpn).  Sometimes the mvfs returns
    # the VOB recorded info, sometimes, the actual size of the cleartext
    # container.

    ($ver_len, $junk) = grep(/^nlink:/, &cleartool_dump($ver_xpn));
    return -1 if (!$ver_len);    # error
    $ver_len =~ /^.*; size: (\d+)/;
    $ver_len = $1;
}

# ver_construct_cleartext <ver_xpn> <typemgr> <src_cntr> <sugg_cltxt_cntr_pname>
# returns actual cleartext container pname or NULL if error.
#
sub ver_construct_cleartext {
    local($ver_xpn, $typemgr, $src_cntr, $sugg_cltxt_cntr_pname) = @_;
    local($_, $ver_oid, $cmd, $act_cntr_pname);

    if ($typemgr =~ /^whole_copy/) {
	$act_cntr_pname = $src_cntr;
    } else {
        # Create / truncate the cltxt container (at least the z_whole_copy
        # type manager fails if the cltxt container doesn't already
        # exist).
        open(FH, ">$sugg_cltxt_cntr_pname");
        close(FH);
	($ver_oid) = &obj_get_oid($ver_xpn);

	# NYI: use invoke_mgr @ V3
	# The following invocation mechanism isn't valid on NT
        if (-f $invoke_mgr_pn) {
            $cmd = "\"$invoke_mgr_pn\" $typemgr construct_version $src_cntr $sugg_cltxt_cntr_pname $ver_oid";
        } else {
            # must be a v2.x system
            if (-d 'C:/') {
                # NT v2.x
                die ("need \"$invoke_mgr_pn\" (a V3.x util) for NT.\n");
            } else {
                # UNIX v2.x
                $cmd = "/opt/rational/clearcase/lib/mgrs/$typemgr/construct_version $src_cntr $sugg_cltxt_cntr_pname $ver_oid";
            }
        }
	# print ("$cmd\n");

	system($cmd);

	if ($? == $MGR_CONSTRUCT_USE_NEW_FILE) {
	    $act_cntr_pname = $sugg_cltxt_cntr_pname;
	    $? = 0; # success
	} elsif ($? == $MGR_CONSTRUCT_USE_SRC_CONTAINER) {
	    $act_cntr_pname = $src_cntr;
	    $? = 0; # success
	}
	if ($? != 0) { 
	    print("##### ERROR: unable to construct cleartext\n"); 
	    $act_cntr_pname = "";
	}
    }

    $act_cntr_pname;
}

# elem_get_mgr <elem_xpn>
#
sub elem_get_mgr {
    local($elem_xpn) = @_;
    local($_, $eltype, $typemgr);

    ($eltype) = grep(/element type:/, &cleartool("desc \"$elem_xpn\""));
    $eltype =~ /element type:\s+([^\s]+)/;
    $eltype = $1;

    $typemgr = $eltype_mgrs{$eltype};
    if (! $typemgr) {
	($typemgr) = grep (/type manager:/, &cleartool("desc -type $eltype"));
	$typemgr =~ /type manager:\s+([^\s]+)/;
	$typemgr = $1;
	$eltype_mgrs{$eltype} = $typemgr;
    }
    $typemgr || die("no typemgr for pname '\"$elem_xpn\"'\n");
    $typemgr;
}

# get_this_vob <pn_in_vob>
# Extract just the VOB tag from the pn.  Die if not a VOB.
#
sub get_this_vob {
    local($pn_in_vob) = @_;
    local($_, $vob);

    ($vob) = grep(/^[\\\/]/, &cleartool("desc -s vob:$pn_in_vob"));
    $vob || die("Not in VOB '$pn_in_vob'\n");
    $vob;
}

###########
# main
###########

# NOTE: even when processing arglist elements
# you still must be in the element's VOB
# due to some implementation limitations of
# this script (e.g., it does some 'ct dump'
# (get oid) and 'ct desc' (get type) operations 
# don't specify the VOB
$vob = &get_this_vob($cwd);

print "
##### checking element's versions for VOB at '$vob' ...


***** IF THIS VOB ISN'T LOCKED, YOU CAN GET FALSE ERROR DETECTIONS *****

";

$nelems = 0;
$ncntrs = 0;

while ($ARGV[0] =~ /^-/) {
    if ($ARGV[0] eq "-blatest") {
	$blatest = 1;
	shift;
    } elsif ($ARGV[0] eq "-verbose") {
	$verbose = 1;
	shift;
    }
}

if ($blatest) {
    print "Checking only the LATEST version on each branch.\n";
} else {
    print "Checking EVERY version.\n";
}
print "\n";

if (@ARGV) {
    # process each element in the arglist
    #
    foreach (@ARGV) {
	next unless $_;
	$ver_errors += &ck_elem_ver_len($_);
    }
} 
else {
    # process each element in the current VOB
    #
    open(FINDALL, "$ct find -all -type f -print |") || 
	die("can't do find -add\n");
    while (<FINDALL>) {
        chop;
	next unless $_;
	$ver_errors += &ck_elem_ver_len($_);
    }
    close(FINDALL);
}
unlink($tmp_cltxt_cntr_pname);

print "\n##### checked $nelems elements\n\n";
if ($ver_errors != 0) {
    print "***************************\n";
    print "***** $ver_errors ERRORS DETECTED\n";
    print "***************************\n";
} else {
    print "******************\n";
    print "***** ALL OK *****\n";
    print "******************\n";
}
exit $exit_status;


# ck_elem_ver_len <elem_xpn>
#
sub ck_elem_ver_len {
    local($elem_xpn) = @_;
    local($_, @stat_info, $ver_len, $cltxt_size);
    local($typemgr, $eltype, $cntr, $ver_xpn, $ver_errors);
    local($find_vers_pipe);

    $ver_errors = 0;
    $nelems++;

    # determine the element's type mgr
    #
    $typemgr = &elem_get_mgr($elem_xpn);
    if ($typemgr =~ /^directory/) {
	print "##### Ignoring directory element: $elem_xpn\n";
	return 0;
    }

    # for each version, check the version's cleartext length
    #
    print "##### checking versions of '$elem_xpn' (manager '$typemgr')...\n";

    if ($blatest) {
	$find_vers_pipe = "$ct find \"$elem_xpn\" -bra $all_query -print |";
    } else {
	$find_vers_pipe = "$ct find \"$elem_xpn\" -ver $all_query -print |";
    }
    open(VERH, $find_vers_pipe) || die("can't find versions\n.");
    while (<VERH>) {
        chop;
	if ($blatest) {
	    $ver_xpn = $_ . ${pname_sep} . "LATEST";
	} else {
	    $ver_xpn = $_;
	}

	# skip checked out versions and branch-version-0 versions
	#
	next if ($ver_xpn =~ /CHECKEDOUT/);
	next if ($ver_xpn =~ m|.*/0$|);

	# get the version's container
	#
	$cntr = &ver_get_cntr($ver_xpn);

	# ignore ndata versions
	#
	next if (!$cntr);

	# get the ver id string
	#
	$ver_xpn =~ /.*\@\@(.*)/;
	$ver_id_str = $1;

	# construct the version's cleartext
	#
	if (!($act_cntr_pname = &ver_construct_cleartext($ver_xpn, $typemgr, 
				     $cntr, $tmp_cltxt_cntr_pname))) {
	    $ver_errors++;
	    next unless ($typemgr =~ /delta/);

	    # don't bother checking anything else for this element
	    print("##### Skipping rest of element\n");
	    last;
	}

	# get the size of the constructed cleartext
	#
	@stat_info = stat($act_cntr_pname);
	$cltxt_size = $stat_info[7];

	# get the VOB's idea of what the len should be
	#
	$ver_len = &ver_get_len($ver_xpn);

	if ($cltxt_size != $ver_len) {
	    print "\n" if (!$verbose);
	    print "##### ver *** ERROR ***: $ver_id_str\n";
	    print "----- cleartext size is $cltxt_size; should be $ver_len\n";
	    $ver_errors++;
	} else {
	    if ($verbose) {
		print "##### ver OK: $ver_id_str\n";
	    } else {
		print ".";
	    }
	}
    }
    close(VERH);
    print "\n" if (!$verbose);

    if ($ver_errors != 0) {
	print "##### elem *** ERROR ***: \"$elem_xpn\"\n";
    } else {
	print "##### elem OK: \"$elem_xpn\"\n";
    }

    $ver_errors;
}
