# ------------------------------------------------------------------
# | 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_all_cntrs.pl (the VOB is implicitly the current directory's VOB)
#
# check all of the elements in the the current VOB
# and detect missing (and corrupt text_file_delta) 
# source containers.
# *** need to be in a view (any view will do) ***
# *** need to be cd'd to the VOB to check ***
#
# % setview <any view>
# % cd <vob root dir>
# % ct lock -vob .
# % /usr/atria/bin/Perl ck_all_cntrs.pl | tee ck_all_cntrs.out
# ... sit back ...
# % ct unlock -vob .
#
# 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. FYI, the
# check consists of a "find -all" and *for each element found*,
# a "ct desc" and a "ct dump".  If a non-delta element is found,
# there is a "lsvtree" and a "ct dump" for each version of the element.
# 
# 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).
# 
# Oh, while the name of the script is misleading, only source
# containers are checked.
#
# Find each element in the VOB and check it:
# For delta managed elements check for the single container.
# For non-delta managed elements, check for a container for each version.
#   maintain a table of visited containers so that we only check
#   them once.
#
# If a missing container is found and it's a delta managed element,
# check for / report other containers that are for that element.
# (actually, this is NYI).
#
# If the container is a text_file_delta container, check to see that no NULLs
# are present in the file (if this has been enabled; see below).
# NYI: do likewise if the container is a z_text_file_delta container.

$ct='cleartool';

if (-d 'C:/') {
    # NT
    chop($cwd = `cd`);
    $dev_null='NUL';
    $created_since='created_since(03-Jan-1970)';
} else {
    # UNIX
    chop($cwd = `pwd`);
    $dev_null='/dev/null';
    $created_since="'created_since(03-Jan-1970)'";
}

# check_for_nulls
#
# comment this out to DISABLE checking for nulls in delta containers
$check_for_nulls=1;

# 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 STDERR\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;
}

# 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;
}

# 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;
}

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

print "
##### checking all source containers for VOB at '$cwd' ...


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

";
print "Checking delta containers for nulls is ";
$check_for_nulls ? print "ENABLED.\n" : print "DISABLED.\n";
print "\n";

$nelems = 0;
$ncntrs = 0;
$elem_errors = 0;

# find each element in the VOB and check it
#
open(FINDH, "$ct find -all -type f -print |") || die("can't spawn 'ct find'\n");
foreach (<FINDH>) {
    chop;
    next unless $_;
    $elem_errors += &ck_elem($_);
}
close(FINDH);

print "\n##### checked $nelems elements with $ncntrs (unique) containers checked\n\n";
if ($elem_errors != 0) {
    print "***************************\n";
    print "***** ERRORS DETECTED *****\n";
    print "***************************\n";
} else {
    print "******************\n";
    print "***** ALL OK *****\n";
    print "******************\n";
}
exit $elem_errors;


# ck_elem <$elem_xpn>
#
sub ck_elem 
{
    local($elem_xpn) = @_;
    local($_, $typemgr, $eltype, $cntr, $ver_xpn, $elem_error);

    $elem_error = 0;
    $nelems++;

    # determine the element's type mgr
    #
    $typemgr = &elem_get_mgr($elem_xpn);

    # if it's a delta manager, 
    #    only need to access one of the elements versions
    #    if missing, see if there are candidate containers
    # otherwise
    #    need to access each of the element's versions
    #
    if ($typemgr =~ /text_file_delta/) {
	$ncntrs++;
        $cntr = &ver_get_cntr("$elem_xpn/main/0");
        if (! -f $cntr) {
            $elem_error=1;
            print "##### elem *** ERROR ***: $elem_xpn\n";
            print "----- missing container: $cntr\n";
            # NYI: check for candidate containers
        } else {
            # It's there. Check for nulls.
	    $has_nulls = 0;
	    if ($check_for_nulls && $typemgr =~ /^text_file_delta/) {
		$has_nulls = 1 if (&tfd_has_nulls($cntr, $cntr) != 0);
	    } else {
		# NYI: gunzip and then check for nulls
	    }

	    if ($has_nulls) {
		$elem_error=1;
		print "##### *** ERROR ***: $elem_xpn\n";
		# Note: tfd_has_nulls() prints informational msgs
	    } else {
		print "##### elem OK: $elem_xpn\n";
	    }
        }
    } else {
        # really need to check all versions
        #
        print "##### checking each non-ndata version of '$elem_xpn' (manager '$typemgr')...\n";
        foreach (`$ct find $elem_xpn -ver $created_since -print`) {
	    chop;
            $ver_xpn = $_;
            next if ($ver_xpn =~ /CHECKEDOUT/);
            $cntr = &ver_get_cntr($ver_xpn);
	    next if $visited_cntrs{$cntr};  # skip cntrs we've already checked
	    $visited_cntrs{$cntr} = 1;      # add it to the table
	    $ver_xpn =~ /.*\@\@(.*)/;
	    $ver_id_str = $1;
            if ($cntr) { # ignore ndata versions
		$ncntrs++;
                if (! -f $cntr) {
                    print "##### ver *** ERROR ***: $ver_id_str\n";
                    print "----- missing container: $cntr\n";
                    $elem_error=1;
                } else {
                    print "##### ver OK: $ver_id_str\n";
                }
            }
        }
        if ($elem_error != 0) {
            print "##### elem *** ERROR ***: $elem_xpn\n";
            print "----- missing container: $cntr\n";
        } else {
            print "##### elem OK: $elem_xpn\n";
        }
    }
    $elem_error;
}

# tfd_has_nulls (pname, leafname)
# check (and report) if the leafname file has any nulls in it.
# Also report problems if container is empty or doesn't look like tfd container.
# return TRUE if container has any problems.
#
sub tfd_has_nulls 
{
    local($pname, $cntr) = @_;
    local($buf, $bcnt, $problems, $fh, @stat);

    # Report a problem if the container is empty.
    @stat = stat($cntr);
    if ($stat[7] <= 0) {
	print "\nERROR: tfd container has 0 size: $pname\n";
	return 1;
    }

    $fh = TFD_HAS_NULLS_FH;
    open($fh, $cntr) || (print "\nERROR: Can't open $pname\n" && return 1);

    # Report if 1st line doesn't have TFD 'control record'
    if ($bcnt = read ($fh, $buf, 25)) {
	if ($buf !~ /^\^S db1 /) {
	    print "\nERROR: missing tfd control record at byte 0 in $pname\n";
	    $problems++;
	}
    }

    # Report any blocks of NULLs
    $problems += &fh_file_has_nulls ($fh, $pname, $cntr);

    close($fh);
    $problems > 0;  # return TRUE if any problems.
}

# fh_file_has_nulls (fh, pname, leafname)
# check (and report) if the file associated with filehandle 'fh'
# has any nulls in it.
# return TRUE if container has any problems.
#
sub fh_file_has_nulls 
{
    local($fh, $pname, $file) = @_;
    local($buf, $bcnt, $bufsize, $bufbaseindx);
    local($num_null_blocks, $problems);
    local($pos, $first_null_indx, $last_null_indx);

    # reset things 
    seek($fh, 0, 0);
    binmode($fh);

    $bufsize=16384;

    $bufbaseindx=0;
    $last_null_indx = -2;  # must be < -1 to ensure 1st NULL (at loc 0)
			   # looks like a new block

    # Track / report blocks of NULLs (deal with blocks spanning buffers)
    while ($bcnt = read ($fh, $buf, $bufsize)) {
	$pos = $[;
	while (($pos = index($buf, "\000", $pos)) >= $[) {
	    # Found a NULL.
	    if ($pos - 1 + $bufbaseindx == $last_null_indx) {
		# Consecutive, just keep going.
		$last_null_indx++;
	    } else {
		# Begin new block (report end of previous block if any)
		print $last_null_indx - $first_null_indx + 1,
		      " consecutive NULL bytes\n" if ($last_null_indx >= 0);

		# begin new block
		$first_null_indx = $pos + $bufbaseindx;
		$last_null_indx = $first_null_indx;
		print "\nERROR: found NULL at byte $first_null_indx in $pname\n";
		$problems++;
		$num_null_blocks++;
	    }
	    $pos++;
	}
	$bufbaseindx += $bcnt;
    }
    # Report the end of the last NULL block (if any)
    if ($last_null_indx >= 0) {
        if ($first_null_indx == 0 && $last_null_indx + 1 == $bufbaseindx) {
            print $last_null_indx - $first_null_indx + 1,
                " consecutive NULL bytes - FILE IS ALL NULLS\n";
        } else {
            print $last_null_indx - $first_null_indx + 1,
                " consecutive NULL bytes\n";
        }
    }

    $problems > 0;  # return TRUE if any problems.
}

