#!/usr/bin/perl
#############################################################################
#  dist2,v 1.5 2003/01/22 04:19:42 garlick Exp
#############################################################################
#  Copyright (C) 2001-2002 The Regents of the University of California.
#  Produced at Lawrence Livermore National Laboratory (cf, DISCLAIMER).
#  Written by Jim Garlick <garlick@llnl.gov>.
#  UCRL-CODE-2003-004.
#  
#  This file is part of Genders, a cluster configuration database and
#  rdist preprocessor.
#  For details, see <http://www.llnl.gov/linux/genders/>.
#  
#  Genders is free software; you can redistribute it and/or modify it under
#  the terms of the GNU General Public License as published by the Free
#  Software Foundation; either version 2 of the License, or (at your option)
#  any later version.
#  
#  Genders is distributed in the hope that it will be useful, but WITHOUT ANY
#  WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
#  FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
#  details.
#  
#  You should have received a copy of the GNU General Public License along
#  with Genders; if not, write to the Free Software Foundation, Inc.,
#  59 Temple Place, Suite 330, Boston, MA  02111-1307  USA.
#############################################################################
#
# Author: Jim Garlick
# Adapted from IBM SP version for linux 4/00.
#
# New wrapper for rdist with the following new features:
# - won't go if /var/dist/VAR_DIST_IS_MOUNTED is not present
# - only generates the minimum set of attribute definitions in Distfile
#   (determined by scanning Distfiles)
# - uses source copy of genders (/var/dist/genders/genders.cluster), minimizing
#   bootstrap problems since genders is rdisted (does depend on clusters file)
# - can emit Distfile to stdout, with or without line numbers, for debugging
#   rdist "error on line nnn" problems
# - intended to factor common code from "dist_local" and "dist_all"
#
# Plus the ones we are used to:
# - can specify -i to get canonical hostnames instead of alternates
#   (reliable_hostname on SP, altname= attribute elsewhere)
# - package.fileset abstraction for /var/dist repository
# - genders attributes expanded to attr_xyz definitions, with multi-cluster
#   support
# - can update all nodes in a cluster or a subset
#

require "/usr/lib/genders/gendlib.pl";

use Getopt::Std;

$path_vardist =		"/var/dist";
$path_genders = 	"/var/dist/genders/genders.%s";
$path_genders_fallback ="/etc/genders";
$path_distfile = 	"/var/dist/Distfile.%s";
$path_testfile =	"/var/dist/VAR_DIST_IS_MOUNTED";
$path_openfile =	"/var/dist/VAR_DIST_OPEN_VERSION";
if ($Genders::havePSSP) {
	# AIX /usr/bin/rdist is the ancient one.
	# AIX rsh is somewhat confused about authentication methods, 
	# so use this simple one.  (Note: "rsh" in Swiss German means "ass")
	$path_rdist =		"/admin/bin/rdist -P/admin/bin/rsh-std"
} else {
	# linux has USC rdist installed in /usr/bin.  Shouldn't everyone?
	$path_rdist = 		"/usr/bin/rdist";
}
$path_postp_closed =	"/usr/local.scf/admin/dist/postp";
$local_clister = 	"";
@limit_nodes =		();
$rdist_passthru_opts = 	"";

$line_no = 		1;

use strict;

my ($attrpair, @attrpairs, @want_labels, @found_labels);
my (@packages, $cmd);

# die if ruid is not root
if ($< != 0) {
        print STDERR ("Run me as root!\n");
        exit(1);
}

# read arguments from command line
if (!getopts("o:c:Fvinlw:g:f:")) { 		
	usage();
}					

# initialize Gendlib with proper genders file (use the one in /var/dist)
if ($main::opt_c) {
	$main::local_cluster = $main::opt_c;
	Genders::init(sprintf($main::path_genders, $main::local_cluster));
} else {
	($main::local_cluster) = Genders::get_clusters();
	Genders::init(sprintf($main::path_genders, $main::local_cluster));
	if (!Genders::getnode("all")) {
		Genders::init($main::path_genders_fallback);
	}
	# Fall back to /etc/genders if /var/dist perhaps isn't mounted
}

# quit if args make no sense
if (defined($main::opt_l) + defined($main::opt_w) + defined($main::opt_g) 
    + defined($main::opt_F) > 1) {
	usage();
}
if ($main::opt_f && @ARGV) {
	usage();
}

# opt -n implies -v
if ($main::opt_n) {
	$main::opt_v = 1;
}

if ($main::opt_o) {
	$main::rdist_passthru_opts = "-o $main::opt_o";
}

# quit if /var/dist isn't mounted
# (relax this requirement if -f option specified) 
if (! -f $main::path_testfile && !defined($main::opt_f)) {
	print STDERR ("Couldn't open $main::path_testfile\n");
	exit(1);
}

# If /var/dist/VAR_DIST_OPEN_VERSION exists, we need to run the SCF post processing
# script.  Run it and remove the file.
if (-f $main::path_openfile && -x $main::path_postp_closed) {
	print STDERR ("Running $main::path_postp_closed on $main::path_vardist\n");
	system($main::path_postp_closed);
	unlink($main::path_openfile);
}

# @main::limit_nodes will contain the list of possible target nodes
@main::limit_nodes = participating_nodes();

if (!@main::limit_nodes) {
	printf STDERR ("No target nodes specified\n");
	exit(0);
}

if ($main::opt_f) {
	#
	# -f Distfile
	#
	if (!findattrs_file($main::opt_f, \@attrpairs)) {
		# couldn't read file (function emits error)
		exit(1);
	}
	if (!dist_file($main::opt_f, \@attrpairs)) {
		# couldn't start rdist
		exit(1);
	}
} else {
	# extract separate list of uniq'ed packages and labels from ARGV which
	# contains dotted pairs
	if (!expand_dotted_list(\@main::ARGV, \@packages, \@want_labels)) {
		# we mixed dotted pairs and plain package names	(function emits error)
		exit(1);
	}

	# if no "packages" specified, we must want to send out all of them
	if (!@packages) {
		get_all_packages(\@packages);
	}

	# read Distfiles for specified packages and retrive attributes and labels
	if (!findattrs_pkg(\@packages, \@found_labels, \@attrpairs)) {
		# a package doesn't have correspoding Distfile (function emits error)
		exit(1);
	}

	# did we ask for nonexistant labels?
	if (!verify_labels(\@want_labels, \@found_labels)) {
		# label not found in Distfile scan (function emits error)
		exit(1);
	}

	# do the real work
	if (!dist_pkg(\@packages, \@attrpairs, \@want_labels)) {
		# couldn't chdir to /var/dist or couldn't start rdist
		exit(1);
	}
}


exit(0);

sub emit_definition
{
	my ($fh, $attr, $cluster) = @_;
	my ($variable, @node_list, $i);

	construct_definition($attr, $cluster, \$variable, \@node_list);

	if ($#node_list + 1 < 6) {
		xprintf($fh, "%20s = (%s)\n", $variable, join(" ", @node_list));
	} else {
		xprintf($fh, "%s = (\n", $variable);
		while (@node_list) {
			xprint($fh, "\t");
			for ($i = 0; $i < 9; $i++) {
				if (@node_list) {
					printf $fh ("%s ", shift(@node_list));
				}
			}
			printf $fh ("\n");
		}
		xprint($fh, ")\n");
	}
}

sub construct_definition
{
	my ($attr, $cluster, $variable, $node_list) = @_;

	my (@node_list);

	# construct LHS
	if ($cluster) {
		${$variable} = sprintf("%s!attr_%s", $cluster, $attr);
	} else {
		${$variable} = sprintf("attr_%s", $attr);
	}

	# construct RHS
	if (!$cluster) {
		@{$node_list} = getnodes($attr);
	} elsif ($cluster eq $main::local_cluster) {
		@{$node_list} = sprintf("\${attr_%s}", $attr);
	} else {
		@{$node_list} = ();
	}
}

sub getnodes
{
	my ($attr) = @_;
	my ($node, @allnodes, @nodes);

	@allnodes = Genders::getnode($attr);
	if (! $main::opt_i) {
		@allnodes = Genders::to_altnames(@allnodes);
	}
	foreach $node (@allnodes) {
		if (grep(/^$node$/, @main::limit_nodes)){
			push(@nodes, $node);
		}
	}

	return @nodes;
}

# Gather the names of attributes from distfiles 
#    $file (IN)		filename to scan
#    \@attributes (OUT)	list of attributes in package Distfiles
#    RETURN		0 if failed to read a Distfile (error reported)
sub findattrs_file
{
	my ($file, $attributes) = @_;
	my ($retval, %attrs, %labels);

	$retval = 1;

	if (!find_attrs_in_file($file, \%labels, \%attrs)) {
		printf STDERR ("Can't open file: %s\n", $file);
		$retval = 0;
	}

	@{$attributes} = post_process_attrs(\%attrs);

	return $retval;
}

# Gather the names of attributes from distfiles 
#    \@packages (IN)	list of packages to scan 
#    \@labels (OUT)	list of labels in package Distfiles
#    \@attributes (OUT)	list of attributes in package Distfiles
#    RETURN		0 if failed to read a Distfile (error reported)
sub findattrs_pkg
{
	my ($packages, $labels, $attributes) = @_;
	my (%labels, %attrs, $file, $attrpair, $package, $retval);

	$retval = 1;

	# Scan each file specified, collecting attribute/cluster pairs
	foreach $package (@{$packages}) {
		$file = sprintf($main::path_distfile, $package);
		if (!find_attrs_in_file($file, \%labels, \%attrs)) {
			printf STDERR ("Unknown package: %s\n", $package);
			$retval = 0;
		}
	}

	@{$attributes} = post_process_attrs(\%attrs);
	@{$labels} = sort(keys %labels);

	return $retval;
}

sub post_process_attrs
{
	my ($attrs) = @_;

	# For every local_cluster!attr_attr, add an attr_attr.
	# The next step will be to expand only attr_attr, and define
	# this_cluster!attr_attr in terms of attr_attr.
	foreach $attrpair (keys %{$attrs}) {
		if ($attrpair =~ /^(\w+):$main::local_cluster$/) {
			${$attrs}{$1}++;
		}
	}
	
	return sort(keys %{$attrs});
}

#     $file  (IN)
#     \%labels (IN/OUT)
#     \%attrs (IN/OUT)
sub find_attrs_in_file
{
	my ($file, $labels, $attrs) = @_;
	my ($retval);

	if (open(FILE, "< $file")) {
		while (<FILE>) {
			chomp;
			s/\#.*//;  		# delete comments
			next if (/^\s*$/);	# skip blank lines
			if (/^\s*(\w+):/) {	# label
				${$labels}{$1}++;
			}
			while (s/\$\{(\w+)!attr_(\w+)\}//) { #c!attr_xyz
				${$attrs}{"$2:$1"}++;
			}
			while (s/\$\{attr_(\w+)\}//) {       # attr_xyz
				${$attrs}{$1}++;
			}
		}
		close(FILE);
		$retval = 1;
	} else {
		$retval = 0;
	}

	return $retval;
}

sub xprint
{
	my ($fh) = shift(@_);
	if ($main::opt_n) {
		printf $fh ("%-3.3d:", $main::line_no++);
	}
	print $fh (@_);
}

sub xprintf
{
	my ($fh) = shift(@_);
	if ($main::opt_n) {
		printf $fh ("%-3.3d:", $main::line_no++);
	}
	printf $fh (@_);
}

# send Distfiles corresponding to @packages to HANDLE
#    \*HANDLE	(IN)
#    @packages (IN)
sub cat_packages
{
	my ($fh, $file, $package);
	$fh = shift(@_);

	foreach $package (@_) {
		$file = sprintf($main::path_distfile, $package);
		cat_file($fh, $file);
	}
}

sub cat_file
{
	my ($fh, $file) = @_;

	if (open(FILE, "< $file")) {
		xprintf($fh, "# begin %s\n", $file);
		while (<FILE>) {
			xprint($fh, $_);
		}
		xprintf($fh, "# end %s\n", $file);
		close(FILE);
	}
}

sub usage
{
	print STDERR ("Usage: dist2 [-o rdist_opts] [-c cluster] [-v [-n]] [-i] [-F | -l | -w host,host,host | -g attr] [pkg.[fs]] ...\n");
	exit(1);
}

sub participating_nodes
{
	my (@nodes, $myframe);

	Genders::init_hname();

	if (defined($main::opt_l)) {			
		@nodes = ($Genders::hname);
	} elsif (defined($main::opt_w)) {
		@nodes = split(/,/, $main::opt_w);
	} elsif (defined($main::opt_g)) {
		@nodes = Genders::getnode($main::opt_g);
	} elsif (defined($main::opt_F)) {
		$myframe = Genders::getattrval("frame");
		# If no frame attr (i.e. CWS) just act like -l 
		if (!$myframe) {
			@nodes = ($Genders::hname);
		} else {
			@nodes = Genders::getnode("frame=$myframe");
		}
	} else {
		@nodes = Genders::getnode("all");
	}
	if (! $main::opt_i) {
		@nodes = Genders::to_altnames(@nodes);
	}
	return @nodes;
}

sub expand_dotted_list
{
	my ($dot_list, $packages, $labels) = @_;
	my (%pkgs, %labs, $pkg, $lab, $dotted, $using_labels, $retval);

	$using_labels = 0;
	$retval = 1;
	# Convert list of package.label's to %pkgs and %want_labels
	foreach $dotted (@{$dot_list}) {
		($pkg, $lab) = split(/\./, $dotted);
		$pkgs{$pkg}++;
		if ($lab) {
			$labs{$lab}++;
			$using_labels = 1;
		} elsif ($using_labels) {	# "dist foo.bar baz" will not
			$retval = 0;		# do the intended thing
			print STDERR ("All or no packages must have .fileset\n");
			last;
		}
	}
	@{$packages} = (sort keys %pkgs);
	@{$labels} = (sort keys %labs);

	return $retval;
}

sub verify_labels
{
	my ($want_labels, $found_labels) = @_;
	my ($lab, $retval);

	$retval = 1;
	foreach $lab (@{$want_labels}) {
		if (!grep(/^$lab$/, @{$found_labels})) {
			print STDERR ("Unknown label: $lab\n");
			$retval = 0;
		}
	}

	return $retval;
}

sub emit_distfile_defs
{
	my ($fh, $attrpairs) = @_;	
	my ($attrpair);

	xprint($fh, "# these definitions were auto-generated by $0\n");
	foreach $attrpair (@{$attrpairs}) {
		emit_definition($fh, split(/:/, $attrpair));
	}
	xprint($fh, "# end auto-generated definitions\n");

}

sub get_all_packages
{
	my ($pkg_list) = @_;
        my ($file);
 
        if (opendir(DIR, $main::path_vardist)) {
                foreach $file (readdir(DIR)) {
			if ($file =~ /^Distfile.(.*)$/) {
				push(@{$pkg_list}, $1);
			}
		}
                closedir(DIR);
	}
}

# Start rdist for the specified file
#    \@packages (IN)	list of package names
#    \@attrpairs (IN)
sub dist_file
{
	my ($file, $attrpairs) = @_;
	my ($cmd);

	if (!$main::opt_v) {
		$cmd = sprintf("%s %s -f-", $main::path_rdist, 
				$main::rdist_passthru_opts);
		if (!open(PIPE, "|$cmd")) {
			print STDERR ("Couldn't fork rdist\n");
			return 0;
		}
	}
	emit_distfile_defs($main::opt_v ? \*STDOUT : \*PIPE, $attrpairs);
	cat_file($main::opt_v ? \*STDOUT : \*PIPE, $file);

	if (!$main::opt_v) {
		close(PIPE);
	}
	return 1;
}

# Start rdist for the specified /var/dist packages
#    \@packages (IN)	list of package names
#    \@attrpairs (IN)
#    \@labels (IN)
sub dist_pkg
{
	my ($packages, $attrpairs, $labels) = @_;
	my ($cmd);

	if (!$main::opt_v) {
		if (!chdir($main::path_vardist)) {
			printf STDERR ("Couldn't chdir to %s\n",
			    $main::path_vardist);
			return 0;
		}
		$cmd = sprintf("%s %s -f- %s", 
				$main::path_rdist, $main::rdist_passthru_opts,
				join(" ", @{$labels}));
		if (!open(PIPE, "|$cmd")) {
			print STDERR ("Couldn't fork rdist\n");
			return 0;
		}
	}

	emit_distfile_defs($main::opt_v ? \*STDOUT : \*PIPE, $attrpairs);
	cat_packages($main::opt_v ? \*STDOUT : \*PIPE, @{$packages});

	if (!$main::opt_v) {
		close(PIPE);
	}

	return 1;
}
