#
# Copyright 2002-2003 Sun Microsystems, Inc.  All rights reserved.
# Use is subject to license terms.
#
#ident	"@(#)Common.pm 1.82     03/04/28 SMI"
#
# Common class for the SunPlex Manager GUI
#

package Cluster::Common;
use strict;
use Exporter;
use FileHandle;
use IO::Socket;
use POSIX;
use MIME::Base64;
use Cluster::Cgi;
use Cluster::RBAC;
use Sys::Hostname;
use Cluster::common;
use Cluster::RunCommand;
use Net::Domain qw(hostdomain);
use Sun::Solaris::Utils qw(gettext);
use Net::SSLeay qw(get_https post_https make_headers make_form);
use vars qw(@ISA $VERSION @EXPORT_OK $TRUE $FALSE);
$VERSION = '1.00';
@ISA = qw(Exporter);
@EXPORT_OK = qw($TRUE $FALSE);

##############################################################################
#
# Class constructor
#
##############################################################################

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self  = {};
	bless ($self, $class);
	return $self;
}

##############################################################################
#
# Class Variables
#
##############################################################################

# Paths to external configuration/log files
my $LOGFILE		   = "/var/cluster/spm/messages";
my $SERVICEFILEDIR         = "/usr/cluster/lib/rgm/rtsupport";
my $RTPREFIX               = "SUNW";

# Globally exported variables
$Cluster::Common::TRUE     = 0;
$Cluster::Common::FALSE    = 1;

# Global constants
use constant TRUE          => 0;
use constant FALSE         => 1;

# Global variables for command output caching
my $INF_CHECKSUM           = "";
my @SCCONFPOUT             = ();
my @SCSTATDOUT		   = ();

# Global configuration variables to be set upon startup
my $LOGDIR		   = "";
my $UNCOMPRESSPATCHDIR	   = "";
my $HOSTNAME               = "";
my @NODELIST               = ();
my $PLATFORM		   = "";
my $HTTP_PORT		   = "";
my $HOSTDOMAIN             = "";
my $CLUSTERNAME            = "";
my $CLUSTERSIZE		   = 0;

# Set the max and min cluster sizes
my $MIN_CLUSTER_SIZE       = 2;
my $MAX_CLUSTER_SIZE       = 8;

# Solaris OS versions
my $SOLARIS_VERSION_8       = "5.8";
my $SOLARIS_VERSION_9       = "5.9";

# Helper classes to instantiate
my $rbac = new Cluster::RBAC;
my $cmd = new Cluster::RunCommand;

##############################################################################
#
# Clustermode Initialization -- these fuctions are only called once,
# when this class is loaded while in cluster mode.
#
##############################################################################

if (is_clustermode() == TRUE) {
	set_clustername();
}

##############################################################################
#
# Package Methods
#
##############################################################################

#
# Common page footer
#

sub footer {
	my ($self, $q) = @_;
	print $q->end_html;
}

#
# Return the character set
#

sub get_charset {
	;# /* TRANSLATION_NOTE The localized value of "charset" is sent to the browser in the Content-Type field to control the charset used to display the page.  This value must be defined appropriately in the message catalog.  For example, in the ja locale the localized value of "charset" should be "EUC-JP", and in the zh locale it should be "gb2312".  The default value is "iso-8859-1". */
	my $charset = gettext("charset");
	if ($charset eq "charset") {
		$charset = "iso-8859-1"; # Default charset
	}
	return $charset;
}

#
# Return the name of the cluster
#

sub get_clustername {
	return $CLUSTERNAME;
}

#
# Return the port the server is running off of
#

sub get_http_port {
	return $HTTP_PORT;
}

#
# Set the port the server is running off of from Apache's httpd.conf
# file.
#

sub set_http_port {
	my ($portline) = $cmd->grep('^Port', 
				    '/opt/SUNWscvw/conf/httpd.conf');
	my @parts = split / /, $portline;
	$HTTP_PORT = $parts[1];

	if (!defined $HTTP_PORT || 
	    $HTTP_PORT eq "" ||
	    $HTTP_PORT < 0 || 
	    $HTTP_PORT > 65535) {
		$HTTP_PORT = 3000;
	}
}

#
# Get the current date string

sub get_date {
	return $cmd->date();
}

#
# Return the minimum supported size of a cluster
#

sub get_min_cluster_size() {
	return $MIN_CLUSTER_SIZE;
}

#
# Return the maxiumum supported size of a cluster
#

sub get_max_cluster_size() {
	return $MAX_CLUSTER_SIZE;
}

#
# Return cluster state and nodelist
#

sub get_cluster_state($) {
	my ($self) = @_;
	my ($node, @nodelist, $clusterstate, $clustererror,
	    @online_nodelist, $online_nodelist_string,
	    @offline_nodelist);

	# Get node states
	@nodelist = $self->get_nodelist();

	foreach $node (@nodelist) {
		my ($nodestate);
		$nodestate = $self->get_nodestate($node);
		chomp $nodestate;

		if ($self->get_hostdomain()) {
		    $node .= "." .  $self->get_hostdomain();
		}

		if ($nodestate ne "Online") {
			push @offline_nodelist, $node;
		} else {
			push @online_nodelist, $node;
		}
	}

	if ($#offline_nodelist >= 0) {
	    $clusterstate = sprintf(gettext("Faulted: %s"),
		join(", ", @offline_nodelist));
	} else {
	    $clusterstate = gettext("Up");
	}

	# Create the list of online nodes
	$online_nodelist_string = join ",", @online_nodelist;

	# Return the state and the list of nodes that are online
	return ($clusterstate, $online_nodelist_string);
}

#
# Get this node's hostname
#

sub get_hostname() {
	return $HOSTNAME;
}

#
# Set this node's hostname
#

sub set_hostname() {
	$HOSTNAME = hostname();
}

#
# Get this node's domain
#

sub get_hostdomain() {
	return $HOSTDOMAIN;
}

#
# Set this node's domain
#

sub set_hostdomain() {
	$HOSTDOMAIN = hostdomain();
}

#
# Set the log directory
#

sub set_logdir() {
	$LOGDIR = "/var/cluster/spm";
	system("/bin/pfexec /bin/chown spmadmin $LOGDIR"); # XXX
}

#
# Set the working patch directory
#

sub set_uncompresspatchdir() {
	$UNCOMPRESSPATCHDIR = "$LOGDIR/uncompressed_patches";
}

#
# Start autodiscovery
#

sub start_autodiscover() {
	system("/bin/pfexec /opt/SUNWscvw/lib/perl/Cluster/autodiscover.pl ".
		get_http_port());
}

#
# Get the static cluster nodelist
#

sub get_nodelist {
	@NODELIST = $cmd->scha_cluster_get("-O all_nodenames");
	return @NODELIST;
}

#
# Get the size of the cluster
#

sub get_clustersize {
	$CLUSTERSIZE = $#NODELIST + 1;
	return $CLUSTERSIZE;
}

#
# Get the list of nodes currently online
#

sub get_online_nodelist {
	my ($self) = @_;
	my ($node, @nodelist, @online_nodelist, $nodestate);

	@nodelist = get_nodelist();

	foreach $node (@nodelist) {
		$nodestate = $self->get_nodestate($node);
		push (@online_nodelist, $node) if ($nodestate eq "UP");
	}

	return @online_nodelist;
}

#
# Get the state of the specified node
#

sub get_nodestate {
	my ($self, $node) = @_;
	my ($nodestate) = $cmd->scha_cluster_get("-O nodestate_node $node");
	if (lc($nodestate) eq "up") {
		$nodestate = "Online";
	} else {
		$nodestate = "Offline";
	}
	return ($nodestate);
}

#
# Set this node's hardware platform, e.g. "SUNW,Ultra-4"
#

sub set_platform {
	($PLATFORM) = $cmd->uname("-i");
	chomp $PLATFORM;
}

#
# Get this node's hardware platform
#

sub get_platform {
	return $PLATFORM;
}

#
# Set the name of the cluster
#

sub set_clustername {
	($CLUSTERNAME) = $cmd->scha_cluster_get("-O clustername");
	chomp $CLUSTERNAME;
	$CLUSTERNAME = ucfirst(lc($CLUSTERNAME));
}

#
# Get the log dir
#

sub get_logdir {
	return $LOGDIR;
}

#
# Get the working patch directory.  This directory is used to store the
# patches locally on each node.  If the patches are compressed, then uncompress
# them here.
sub get_uncompresspatchdir {
	return $UNCOMPRESSPATCHDIR; 
}

#
# Check if we're in clustermode
#

sub is_clustermode {
	my ($ret) = $cmd->clinfo("");
	return $ret;
}

#
# Check if this node has clustering installed
#

sub is_installed_cluster {
	if (-d "/usr/cluster" && -e "/etc/cluster/nodeid") {
		return TRUE;
	} else {
		return FALSE;
	}
}

#
# Print an error if we're not in cluster mode
#

sub print_nonclustermode_error {
	my ($self, $q) = @_;
	#
	# The current node is not in cluster mode
	# Print warning. The caller needs to exit
	# upon receiving non-zero return value.
	#
	my $nodename = $self->get_hostname();
	print $q->header();
	print $q->start_html(-title   => gettext("Not a cluster node"),
		 -BGCOLOR => 'white',
		 -text	  => 'black',
		 -link	  => 'blue',
		 -vlink   => 'blue',
		 -style   => {'src'=>'/css/clustmgr-style.css'},
		 );

	print $q->center();
	print $q->font({ color => 'red',
			size => '+10' });
	print $q->b();
	print gettext("Warning: Can't display cluster info!");
	print $q->br();
	print sprintf(gettext("Current host %s is not a Cluster node!"), $nodename);
	print $q->br();
	print gettext("Make sure it is booted in cluster mode and try again.");
	print $q->end_b();
	print $q->end_font();
	print $q->end_center();
	print $q->end_html;
}

#
# Print an error
#

sub print_error() {
	my ($self, $q, $content) = @_;
	print $q->center();
	print $q->font({ color => 'red' });
	print $content;
	print $q->br();
	print $q->end_font();
	print $q->end_center();
	return;
}

#
# Send a mail message
#

sub send_mail {
	my ($self, $to, $from, $subject, $message) = @_;
}

#
# Do a https get or post
#

sub get_http {
	my ($self, $address, $port, $location, $postdata, $noerrs) = @_;
	my ($reply, $result, @output);

	# Turn off complaining
	$Net::SSLeay::trace = 0;
	
	my ($accept_language) = $ENV{"HTTP_ACCEPT_LANGUAGE"};
	if ((! (defined $accept_language)) || ! $accept_language) {
		$accept_language = "en";
	}

	# Try accessing the Apache module
	my $auth = "";
	if (exists $ENV{"MOD_PERL"}) {
		my ($r, $user, $basic, $pass);
		
		$r = Apache->request();
		my $auth_type = $r->auth_type;
		my (@credentials);
		if ($auth_type eq "Cluster::AuthCookieHandler") {
			my (@entry) = &Cluster::CookieStorage::get_cookie(
			    $ENV{"AuthCookie"});
			    push @credentials, $entry[0], $entry[1];
			    if ($entry[2] ne "") {
				# Role information
				push @credentials, $entry[2], $entry[3];
			    }
		}
		
		# Base64 encode each credential and separate with colon
		# This handles passwords containing colons
		$auth = 'Base64 ' . join(":",
		    map {MIME::Base64::encode($_, "")} @credentials);
	}

	# SSLeay autoloader bombs out if run in a non-C locale
	# because it checks for the string "Invalid".
	# Temporarily switch to C locale for make_headers, get_https, etc.
	my $LC_MESSAGES = 5; # From /usr/include/iso/locale_iso.h
	my $locale = setlocale($LC_MESSAGES); # Get current locale
	setlocale($LC_MESSAGES, "C");

	# Generate the http header
	my ($headers) = "\r\n";
	if ($auth) {
		 $headers = make_headers( 'Authorization'   => $auth,
					  'Accept-Language' => $accept_language);
	} else {
		 $headers = make_headers( 'Accept-Language' => $accept_language);
	}

	# Add the host domain to the address
	if ($self->get_hostdomain()) {
	    $address .= "." . $self->get_hostdomain();
	}

	# Do a get or a post
	if (defined $postdata) {
		($reply, $result) = post_https($address, $port,
					       $location, $headers,
					       make_form(%$postdata));
	} else {
		($reply, $result) = get_https($address, $port, 
					      $location, $headers);
	}

	# Restore locale
	setlocale($LC_MESSAGES, $locale);

	# Store the result
	$self->{'http_result'} = $result;
	if ($result !~ /200/) {
		if (!defined($noerrs)) {
		    print STDERR "get_http: $address:$port$location $result\n";
		    &errmsg(sprintf(gettext("Communication problem with %s"),
			"$address:$port"));
		    print "<br>".gettext("See /var/cluster/spm/error_log ".
			"for details")."<br>\n";
		}
		return undef;
	}

	# Return the output in an array
	if (defined $reply) {
		@output = split /\n/, $reply;
		return @output;
	}

	# Return undef if there's no output
	return undef;
}

#
# Log messages
#

sub syslog {
	my ($self, $message) = @_;
	chomp $message;
	open(LOG, "| /usr/bin/pfexec /usr/bin/tee -a $LOGFILE > /dev/null");
	my $datestring = localtime;
	my @date = split / /, $datestring;
	print LOG "$date[1] $date[3] $date[4] $message\n";
	close(LOG);
}

#
# Run command via http on multiple nodes in parallel
# Input variables:
#	$CMD - the command that is run
#	$verbose - produce verbose output
#	$args - hash ref of arguments to pass to client
#	uses global Cluster::common::nodes
# Get the results from each child into @buf.
# Get the status from each child into @status
# Return error message
#

sub run_parallel {
    my ($self, $CMD, $verbose, $args) = @_;

    my (@status);

    my (@pid); # Pid for each remote process
    my (@offset); # File offset for each results file
    my ($delay) = 1; # Delay between checks of each job
    my $running_jobs = 0; # Number of running jobs

    if ($#Cluster::common::nodes < 0) {
	&Cluster::common::errmsg(gettext("Empty nodelist."), 0);
	return gettext("No nodes specified");
    }

    print "<!- Command run on\n";
    print join(", ", @Cluster::common::nodes)."\n";
    print "$CMD\n->\n";

    # Non-buffered
    select((select(STDOUT), $|=1)[$[]);

    my $open_connections = 0;
    my $i;
    for ($i = 0; $i <= $#Cluster::common::nodes; $i++) {
	# Send requests to each node
	($pid[$i]) = $self->get_http($Cluster::common::nodes[$i],
		$self->get_http_port(), $CMD, $args);
	if (! (defined $pid[$i]) || $pid[$i] == 0) {
	    $status[$i] = gettext("Remote process couldn't start");
	    print "<br>$Cluster::common::nodes[$i]: ".$status[$i]."\n";
	} else {
	    $running_jobs ++;
	    $offset[$i] = 0;
	}
    }

    # SSL bug can cause "last" to bail out of above loop
    # This is a debugging check
    if ($i <= $#Cluster::common::nodes) {
	    $status[$i] = gettext("Job couldn't start: SSL problem\n");
	    print "<br>$Cluster::common::nodes[$i]: ".$status[$i]."\n";
    }

    while ($running_jobs > 0) {
	my ($got_data) = 0;
	for ($i = 0; $i <= $#Cluster::common::nodes; $i++) {
	    if ($pid[$i] <= 0) {
		next;
	    }
	    # Get data from node
	    my (@data) = $self->get_http($Cluster::common::nodes[$i],
		$self->get_http_port(), "/cgi-bin/ds/get-results.pl?pid=" .
		$pid[$i] . "&offset=".$offset[$i]);
	    my ($status) = shift @data;
	    if (!(defined $status) || $status eq "") {
		$status[$i] = gettext("Remote process couldn't be contacted");
		print "<br>$Cluster::common::nodes[$i]: ".$status[$i]."\n";
		$running_jobs--;
		$pid[$i] = 0;
		next;
	    } elsif ($status =~ /^ERROR/) {
		$status[$i] = gettext("Remote process couldn't be contacted");
		$status[$i] .= $status; # XXX Debugging
		print "<br>$Cluster::common::nodes[$i]: ".$status[$i]."\n";
		$running_jobs--;
		$pid[$i] = 0;
		next;
	    }
	    if ($status =~ /EXITED/) {
		if ($#data < 0) {
		    $running_jobs--;
		    $pid[$i] = 0;
		}
	    } elsif ($status =~ /RUNNING/) {
	    } else {
		$status[$i] = sprintf(
		    gettext("Remote script returned bad value %s"), $status);
		print "<br>$Cluster::common::nodes[$i]: ".$status[$i]."\n";
		$running_jobs--;
		$pid[$i] = 0;
		next;
	    }
	    while ($#data >= 0) {
		my ($line) = shift @data;
		$offset[$i] += length($line)+1;

		$got_data = 1;

		# Fix up HTML symbols (but we use <tt>)
		$line =~ s/</&lt;/g;
		$line =~ s/>/&gt;/g;
		$line =~ s|&lt;(/?tt)&gt;|<$1>|g;

		if ($line =~ /ERROR: (.*)/) {
		    # Error from command
		    $status[$i] = $1;
		    if ($verbose) {
			print "<br>$Cluster::common::nodes[$i]: ",
			    "$status[$i]\n";
		    }
		} elsif ($line =~ /EXITSTATUS: (\d+)/) {
		    # Error from other side
		    $status[$i] = $1;
		    if ($verbose) {
			print "<br>$Cluster::common::nodes[$i]: ",
			    "$status[$i]\n";
		    }
		} else {
		    if ($verbose)  {
			# Body line; echo if verbose
			print "<br>$Cluster::common::nodes[$i]: ",
			    "$line\n";
		    }
		}
	    }
	}
	if ($got_data) {
	    $delay = 0;
	} else {
	    # Double the delay
	    $delay = ($delay == 0) ? 1 : ($delay*2);
	    sleep $delay;
	}
    }

    # Return the combined status of all the nodes
    my $errmsg = "";
    for ($i = 0; $i <= $#Cluster::common::nodes; $i++) {
	if ($status[$i]) {
	    $errmsg .= "<br>".$Cluster::common::nodes[$i].": ".$status[$i]."\n";
	}

    }
    return $errmsg;
}

# Generate page header.  Just calls Cgi::content_header
sub header {
	my ($self, $q, $title, $key, $script) = @_;
	$q->content_header($title, $key, $script);
}

# Fork off a process to run the script remotely.  The pid of the running
# process is returned via HTTP.  The file result.pid is opened to
# hold output of the process.
# The code here is complicated by the need to avoid zombie processes when
# the process completes.
# A reference to the subroutine is passed in, and is called as sub($q, $handle)
sub run_script {
	my ($self, $script) = @_;

	# Check for app install authorization
	$rbac->check_ds_auth(gettext("Data Service Installation"),
			     "cmd_install");

	my ($q) = new Cluster::Cgi;
	print $q->header();
	select((select(STDOUT), $|=1)[$[]);
	# Pipe is used to get pid from grandchild
	pipe(PIPEREAD, PIPEWRITE) || die ("Pipe failed $!");
	my ($pid) = fork;
	defined $pid or die "Cannot fork: $!\n";
	if ($pid) {
		# Parent
		close PIPEWRITE;
		my ($in);
		$in  = <PIPEREAD>;
		print "$in\n"; # Return value to caller
		waitpid $pid, 0; # Clean up child
		return;
	} else {
		# Child
		close PIPEREAD;
		my ($pid2);
		defined ($pid2 = fork) or die "Cannot fork: $!\n";

		if ($pid2) {
			# Original child
			close PIPEWRITE;
			CORE::exit(0); # Terminate the process
		}
		# Grandchild - fall through

		if (! open(OUT, ">/var/cluster/spm/result.$$")) {
			print STDERR "run_script: Couldn't open output\n";
			CORE::exit(0); # Terminate the process
		}

		print PIPEWRITE "$$\n"; # Send our pid to parent
		close PIPEWRITE;

		# Close all file descriptors execept OUT
		for (my $i = 0; $i < 255; $i++) {
		    if ($i != fileno(OUT)) {
			    POSIX::close($i);
		    }
		}

		# Set up fds 0, 1, 2 so processes won't hit SIGPIPE
		open(IN, "</dev/null"); # fd 0
		open(STDOUT, ">/dev/null"); # fd 1
		open(ERR, ">/dev/null"); # fd 2

		# Run the script, catching any errors
		eval ('&$script($q, \*OUT)');
		if ($@) {
			$@ =~ s/ at .*//;
			print OUT "ERROR: $@\n"
		}
		CORE::exit(0); # Terminate the process
	}
}

#
# Get rid of the spaces around the given string
#

sub trim($) {
	my ($self, $str) = @_;

	my @parts = split /(\S+)/, $str;
	my $newstr = "";
	for (my $i = 0; $i <= $#parts; $i++) {
		if (($i == 0 || $i == $#parts) && ($parts[$i] =~ " ")) {
			next;
		}
		$newstr = "$newstr$parts[$i]";
	}

	return $newstr;
}

sub find_item_by_name
{
        my ($self, $item_list_ref, $item_name) = @_;
        my @item_list = @$item_list_ref;
        for (my $i = 0; $i < $#item_list + 1; $i++) {
                if ($item_list[$i]{'name'} eq $item_name) {
                        return $i;
                }
        }
        return (-1); # not found
}

# Take a hostname and return an array of the corresponding IP addresses
# in dotted decimal form.
# Return empty array if IP address could not be looked up.
sub get_ip_addresses {
	my ($self, $name) = @_;
	my ($junk, @addrs);
	($junk, $junk, $junk, $junk, @addrs) = gethostbyname($name);
	return map { join(".", unpack('C4', $_)) } @addrs;
}

# Get the version of the os
sub get_osversion() {
	my ($sysname, $nodename, $release, $version, $machine) = 
	      POSIX::uname();
	return $release;
}

# Find out if we're on Solaris 8
sub is_solaris8() {
	my ($self) = @_;
	if ($self->get_osversion() eq $SOLARIS_VERSION_8) {
		return TRUE;
	}
	return FALSE;
}

# Find out if we're on Solaris 9
sub is_solaris9() {
	my ($self) = @_;
	if ($self->get_osversion() eq $SOLARIS_VERSION_9) {
		return TRUE;
	}
	return FALSE;
}

# Get the supported resource types on the cluster
sub get_services() {
	my @services = ();
	my $osversion = get_osversion();
	my $servicefile = "$SERVICEFILEDIR/$osversion";

	if (-e $servicefile) {
		open(FILE, $servicefile);
		while (my $line = <FILE>) {
			chomp $line;
			my ($token) = split /#/, $line;
			$token =~ s/\s+//g;

			if ($token ne "") {
				push @services, "$RTPREFIX.$token";
			}
		}
		close(FILE);
	}
	
	return @services;
}

# Convert each character in a string to hex
sub string_to_hex {
	my ($self, $string) = @_;
	return unpack("H*", $string);
}

##############################################################################
#
# General SunPlex Manager Initialization -- these fuctions are only
# called twice, when this class is loaded.
#
##############################################################################

set_hostname();
set_hostdomain();
set_platform();
set_http_port();
set_logdir();
set_uncompresspatchdir();
start_autodiscover();

# Return true
1;
