#!/usr/bin/perl
# $Id: cfm,v 1.48 2000/09/04 19:37:02 dmetz Exp $
# $crtd:  by  Derald Metzger  on  200310 $
# $cmnt:  cfm cmd. Does host specific management of cfm database.
#                Copyright (c) 1998 - 2000 Derald Metzger
# This file is part of the cfm pkg (GPL).
# $

use strict;


#  Load perl modules
use Cfm;
use File::Basename;
use File::Spec;
use Getopt::Long;

#  Var declarations
use vars '$opt_Q';       # Cfm-0 compatability \\\remove
use vars '$opt_R';       # Cfm-0 compatability \\\remove
use vars '$opt_q';       # Cfm-0 compatability \\\remove
use vars '@diffopts';    # Diff opts from the cfm main config file
use vars '$opt_decr';    # Decrement the set's rcs version
use vars '$opt_dir';     # Dir arg flag
use vars '$opt_log';     # Just display the rcs log
use vars '$opt_msg';     # Use cmdline msg with upload for rcs log
use vars '$opt_nefile';  # Non-existant file flag
use vars '$opt_neslnk';  # Non-existant symlink flag
use vars '$opt_nosum';   # No summary output flag
use vars '$opt_rcr';     # Recursion flag, recurse thru cfmdb dir levels
use vars '$opt_set';     # Set flag, holds name of single set to check
use vars '$opt_upd';     # Update flag, enable upload/download
use vars '$opt_xtr';     # Extract (download) flag, NOT interactive

#  Id/set cfm vars
my @args;                    # System call args
my $brch; # Selected set tag's branch  (<branch>.<level>)
my $configfn = "$Cfm::cfmroot/CFMROOT/config";  # Cfm main config filename
my $dbf;                     # Cfmdb node name
my $err_cnt = 0;             # Cumulative file/symlink diff errs
my $fn;   # Cannonical form of input file arg, no .cfmsl sfx
my $fil_cnt = 0;             # Cumulative file/symlink count
my $hashpr = "##";           # needed to get # at beginning of format line
my $hfn;  # Host side filename with possible .cfmsl suffix for symlinks
my $hostsetsfn = "$Cfm::cfmroot/CFMROOT/hostsets";  # Hostsets filename
my $hnam = $Cfm::uname[1];   # Executing host's name
my $iarg_flg = 0;            # Input arg seen
my $lvl;  # Selected set tag's level   (1.1.x.<level>)
my $nd;                      # Index for @nodes
my @nodes;                   # Filesystem node args w/info
my $pfx;                     # Cfmdb filename os_dir prefix
my $rc;                      # System call return code
my $set;                     # Selected set name
my @sets;                    # List of sets to check
my $sfx;                     # Cfmdb filename suffix
my @slnks;                   # List of symlink args

#  Dependent vars
eval `grep '^\@diffopts =' "$configfn"`; # Diff opts fm config
$opt_decr = ();                          # Default decrement is null

# Prep for redirection & restore
open(SAVEOUT, ">&STDOUT");
open(SAVEERR, ">&STDERR");

my $usage  = "
$Cfm::cfm_ver_rel
Copyright (C) 1998 - 2000 Derald Metzger
This may be freely redistributed under the terms of the GNU GPL.
usage:
  cfm [-S] [-l] [-m <msg>] [-r] [-s <set> [-d <decr>]] [-u] [-v <level>] [-x]
      [-L <symlink> ...] [-F <reg_file> ...] ][-D <dir> ...]
      [--] {<dir> | <file>} ...]

  -v <level>:  0 err_ret, 1 err_msgs,sum, 2 chk_lst, 3 diffs, 4 debug
";

#  Read in all options and args. Opt values are stored in $opt_<variable>.
# Args are validated and placed in the @nodes array.
Getopt::Long::Configure("bundling","permute");
GetOptions(
           "Q",
           "R",
           "dir|D",
           "q",
           "nefile|F",
           "neslnk|L",
           "decr|d=i",
           "log|l",
           "msg|m=s",
           "nosum|S",
           "rcr|r",
           "set|s=s",
           "upd|u",
           "v=i" => \$Cfm::vb_lvl,
           "xtr|x",
           "<>" => \&get_args,
           )
    || die "### Invalid option! $usage";
@ARGV && do { get_args(shift @ARGV) }; #  Get possible residue args

#  These flags require args whose processing must have cleared the flag
$opt_nefile|$opt_neslnk && die "### Invalid option args! $usage";

$iarg_flg || die "### Insufficient args! $usage";

#  Backward compatability patch
$opt_Q && ($Cfm::vb_lvl = 1);
$opt_R && $opt_q && ($Cfm::vb_lvl = 1);

#  Sort out the set list pieces. Default sets conditionally added below
if($opt_set) {  # User specified the set
    @sets = $opt_set;
} else {  # 1st part: @sets, 2nd part <rpm>, 3rd part $def_sets
    @sets = split /\s+/,`grep "^$hnam " "$hostsetsfn"`;  # Get host's set list
    shift @sets; shift @sets;   # Dump the hostname and ref set
    $opt_xtr && shift @sets;    # Dump pnp too for -x downloads
    shift @Cfm::def_sets;       # Dump the dummy <rpm>
}
@sets || die "### No sets available. Try `cfmdb -qh .'";

#  Debug. All data is in.
($Cfm::vb_lvl > 3) && &print_opts;
($Cfm::vb_lvl > 3) && &print_nodes;

#  Just do an rlog?
$opt_log && do {
    for $nd (@nodes) {
        @args = ("rlog","$Cfm::cfmroot$$nd[0]$$nd[1]$$nd[2]");
        ($rc = system(@args)) && do {
            print "### Failed rlog for $dbf",
            "\n    system(@args)";
            printf "\n    returned: %#04x\n", $rc;
        };
        next;
    }
    exit;
};

#  Diff/ci/co/xtr
while($nd = shift @nodes) {
    $pfx = $$nd[0];    # prefix
    $fn = $$nd[1];     # host side filename
    my @fsets = @sets; # init sets list
    $sfx = $$nd[2];    # suffix
    $dbf = "$Cfm::cfmroot$pfx$fn$sfx";  # Cfmdb file or dir name
    $fil_cnt++;  # Incr for each arg
    $err_cnt++;  # Assume err. More bad exits than good

    # Reject NFS mounts
    system("df \"$fn\" 2>/dev/null | grep : >/dev/null") || do {
        print "### No NFS mounts: ", `df -k $fn | grep : 2>&1`;
        next;
    };
    # Expand dir args
    $sfx || do { expdir($pfx, $fn) || next; };

    # Its a reg file or a symlink from here out. No more dirs.

    #  Local host validation
    chdir dirname($fn) || do {  # Verify local dir access
        warn "### Failed: cd `dirname $fn`\n";
        next;
    };
    # Finish the set list ar, id the version in the dbf
    ($opt_set eq "<rpm>") &&  # Let user abstractly specify owning rpm
		(@fsets = `rpm -qf "$fn" 2>/dev/null` =~ /(.*)-[^-]+-[^-]+\n.*/);
    $opt_set || push @fsets,
	    `rpm -qf "$fn" 2>/dev/null` =~ /(.*)-[^-]+-[^-]+\n.*/, @Cfm::def_sets;
    $lvl = Cfm::chk_rev($dbf, \$set, \$brch, @fsets) || do { # Set not found
        $brch && warn "### No set! s:*,h:$hnam r:$dbf\n";
        next;
    };
    my $rdlvl = $lvl - $opt_decr;  # rcsdiff level

    # Make $hfn for symlinks
    my $sl_flg = $sfx =~ /^(.cfmsl),v/;  # Symlink flag
    my $hfn = "$fn$1";  # Host side filename to rcsdiff
    $sl_flg && do {     # Make text file for symlink
        open(CFMSL,">$hfn") || die "\### Failed: open >$hfn";
        print CFMSL "$fn -> ", readlink "$fn", "\n";
        close CFMSL;
    };

    if(-e $fn) {  # File exists on host
        # Do the rcsdiff
        @args = ("rcsdiff", "-r$brch.$rdlvl" ,@diffopts, "$dbf");
        ($Cfm::vb_lvl > 1) && do {  # Output checklist
            print "## s:$set($opt_decr),h:$hnam, r:$dbf\n";
        };
        ($Cfm::vb_lvl > 2) && do {  # With diff output
            ($rc = 0xffff & system(@args));
        };
        ($Cfm::vb_lvl < 3) && do {  # Quiet. Use return code only
            open(STDOUT, ">/dev/null"); open(STDERR, ">/dev/null");
            ($rc = 0xffff & system(@args));
            open(STDOUT, ">&SAVEOUT"); open(STDERR, ">&SAVEERR");
        };
        $rc || do {  
            $sl_flg && unlink "$hfn";
            $err_cnt--; next;
        };
        ($rc != 0x0100) && do {  # rcsdiff failed, not just a difference
            $Cfm::vb_lvl && warn "### Failed: rcsdiff $dbf";
            ($Cfm::vb_lvl >3)
                && printf "### system(@args) returned: %#04x\n", $rc;
            next;
        };
    } else {
        ($Cfm::vb_lvl > 1) && warn "## Missing: $fn\n";
    }

        # Files are different
        $Cfm::vb_lvl && print "### s:$set($opt_decr),h:$hnam, r:$dbf\n";
        $opt_upd && !$opt_xtr && do {  # Update and not no-prompt extract
            print "--- ci\|co to\/from $dbf [ci\|co\|n](n) ?: ";
            $_ = <STDIN>;
        };
        /^ci$/ && do {  # Checkin
            $opt_decr && do { warn "### No upload to old version"; next; };
            my $msg = ();
            if($opt_msg) {  # We have a msg
                $msg = "-m\"$opt_msg\"";
                @args=("ci","-q","-u","-f","$msg","-r$brch","-N$set","$dbf");
            } else {  # Use interactive msg
                @args=("ci", "-q", "-u", "-f","-r$brch","-N$set","$dbf");
            }
            ($rc = 0xffff & system(@args)) && do {
                warn "### Failed: ci $dbf";
                ($Cfm::vb_lvl > 3) &&
                    printf "\n    system(@args) returned: %#04x\n", $rc;
                $sl_flg && unlink "$hfn";
                next;
            };
            $err_cnt--;
        };
    ($opt_xtr || /^co$/) && do {
        unlink "$hfn" || warn "### Failed pre-co: rm $hfn";
        @args=("co", "-q", "-u", "-f","-r$brch.$rdlvl","$dbf");
        ($rc = 0xffff & system(@args)) && do {
            warn "### Failed: co $dbf";
            ($Cfm::vb_lvl > 3) &&
                printf "\n    system(@args) returned: %#04x\n", $rc;
        };
        $sl_flg && do {  # Make the new symlink
            open(CFMSL, "<$hfn");
            my ($slloc,$sltoken,$sltgt) = split / /, <CFMSL>;
            close CFMSL;
            chop $sltgt;
            unlink "$fn" || warn "### Failed sl post-co: rm $fn";
            symlink "$sltgt", "$fn";
        };
        $err_cnt--;
    };
    $sl_flg && unlink "$hfn";
}

($opt_nosum || !$Cfm::vb_lvl) && exit;

#  Output summary report
print '=' x 72, "\n";
write;

exit $err_cnt;

#####################  subroutines and formats  #####################

#----------
#  This routine pushes the arg passed and any following args in the
# @ARGV array onto an appropriate target array until the next option
# is encountered. The target array choice is based on which flag is
# set. The flag is then cleared.

sub get_args($arg) {
    my ($arg) = @_;
    my $ref;
    
    $iarg_flg = 1;  # Input arg seen
    unshift @ARGV, $arg;  # Put back 1st arg
    $opt_nefile && do {
        Cfm::vt_nodes(\@ARGV, ",v", \$err_cnt, \@nodes);
        $opt_nefile = 0;
        return;
    };
    $opt_neslnk && do {
        Cfm::vt_nodes(\@ARGV, ".cfmsl,v", \$err_cnt, \@nodes);
        $opt_neslnk = 0;
        return;
    };
    $opt_dir && do {
        Cfm::vt_nodes(\@ARGV, "d", \$err_cnt, \@nodes);
        $opt_dir = 0;
        return;
    };
    Cfm::vt_nodes(\@ARGV, "", \$err_cnt, \@nodes);
}

#----------
# This routine accepts a dir arg assumed to have been shifted off the
# global array @nodes and expands it into the files that the dir
# contains provided the files are either present on this host or an
# applicable set in the cfmdb indicates they that they should exist.
# It unshifts these files back onto @nodes. If recursion is enabled by
# global flag $opt_rcr additional dirs encountered in the expansion
# are unshifted back onto @nodes for subsequent recursive expansion as
# well. Note cwd must be the dir containing $fn.
#GLOBAL ARGS:
#  @nodes   = File nodes not yet processed: node = [ $pfx, $fn, $sfx ]
#  $opt_rcr = Recursion flag
#  $dbf     = Cfmdb dir. Note $sfx is null
#  @sets    = This hosts cfm option adjusted hostset list
#INPUT:
#  The $pfx and $fn of a dir which has already been shifted out of @nodes.
#OUTPUT:
#  File entries unshifted back onto @nodes. Dir entries as well if recursion
#  is enabled.
#
sub expdir( $ $ ) { 
    my ($pfx, $fpn) = @_;
    my ($set, $br);  # Args for chk_rev
	my @fsets = @sets;

    opendir(DBDIR, $dbf) || do { warn "### Failed: opendir <$dbf"; return 0; };
    $fil_cnt--; $err_cnt--;  # Fix counts. Dir, not a file/sl
    for my $n (File::Spec->no_upwards(readdir DBDIR)) {
        if($n =~ m;(.+?)(\.cfmsl,v|,v);o) {  # Get basename, suffix of rcsfile
            -e "$fn/$1" || do {  # Non-existant dir expansion file, chk for set
				$#fsets && push @fsets,
				    `rpm -qf "$fn/$1" 2>/dev/null` =~ /(.*)-[^-]+-[^-]+/,#<rpm>
				     @Cfm::def_sets;
			    Cfm::chk_rev("$dbf/$n", \$set, \$br, @fsets) || next;
			};
            unshift @nodes, [ $pfx, "$fn" eq "/" ? "/$1" : "$fn/$1", "$2" ];
        } else {  # Not an rcsfile
            (!$opt_rcr || !-d "$fn/$n") && next;  # Just ignore it
            # Recursion is on, the dir exists on this host
            unshift @nodes, [ $pfx, "$fn" eq "/" ? "/$n" : "$fn/$n", () ];
        }
    }
    close DBDIR;
}

#----------
sub print_opts() {  # Print for debug 
    print "####  Dump of opts\n",
    "  F= $opt_nefile  S= $opt_neslnk  D= $opt_dir  \@ARGV= ", join(' ', @ARGV), "\n",
    "  \$set= $opt_set  \@sets= ", join(' ', @sets), "  \@def_sets= ", join(' ',@Cfm::def_sets), "\n",
    "  Flags:  log= $opt_log  nosum= $opt_nosum  rcr= $opt_rcr  xtr= $opt_xtr  vb= $Cfm::vb_lvl\n";

    "  msg= $opt_msg\n",
    "  set= $opt_set  decr= $opt_decr   upd= $opt_upd  xtr= $opt_xtr\n";
}

#----------
sub print_nodes() {  # Print digested input args
    print "####  Dump of nodes\n";
    for (@nodes) { print "  ", join ' : ', @$_, "\n"; }
}

#----------
format =
@< @<<<<< @<<<<<<<<< Summary Report:  chkd @>>>>>> files,  found @>>>>> errs
$hashpr $Cfm::sdate  $hnam                         $fil_cnt         $err_cnt
.
