#
# Copyright 2001-2003 Sun Microsystems, Inc.  All rights reserved.
# Use is subject to license terms.
#
#ident   "@(#)common.pm 1.39     03/05/27 SMI"
#
# common methods

package Cluster::common;
use strict;
use Socket;
use Exporter;
use FileHandle;
use Cluster::Cgi;
use Cluster::RBAC;
use Cluster::Common;
use Sun::Solaris::Utils qw(gettext);
use Net::Domain qw(hostdomain);

use vars qw(@ISA $VERSION @EXPORT $imagedir $in_form $do_page_name
	    $errstatus $in_table %FORM @nodes $errmsg $errpos $result
	    @rg %rsrg %rgstate %rgdesc %rsstate %rsdesc %rgdesc %rsmsg
	    @res @rgrs %rtdesc %rsrt %rtfailover @state %desc @lh
	    @lhrs @lhrg @sa @sars @sarg $cmd_save @cmd $this_url $q
	    $pkg);
$VERSION = '1.00';
@ISA = qw(Exporter);
@EXPORT = qw(&bailout &getargs &do_page &errpage
	&flush &wizard_start &wizard_end &code_start &code_end
	&opencmdIN &runsuid &printable &cmd_info &box_start &box_end
	&input &password &hidden &radio &checkbox &submit &option
	&okmsg &errmsg &getnodes &getscstatrg &getscrgconfig &getlh
	&checktype &cmd_install_type &cmd_register_type &getglobal
	&isglobal &portinuse &cmd_install_type_1 &hosttoip
	&iptohost &domain &validatepassword &validatelh &validateport
	&webtestinfo &freeport &getpath
	&typeselect &reloadmenu %FORM @nodes $errmsg $errpos $result
	$errstatus @rg %rsrg %rgstate %rgdesc %rsstate %rsdesc %rgdesc
	%rsmsg @res @rgrs %rtdesc %rsrt %rtfailover @state %desc @lh
	@lhrs @lhrg @sa @sars @sarg $cmd_save @cmd $this_url
	&hostnameoption &createservice *IN $q
	&action_table_start &action_table_row_start &action_table_supplement
	&action_table_row_end &action_table_end
	&submit_table_start &submit_table_end
	);

# Path to pfexec command
my $PFEXEC = "/usr/bin/pfexec";

# Generate page header, with title $do_page_name, which we internationalize
# here.
sub common_header {
        # Initialize breadcrumbs and page name:
	my $cmd_str = $_[1];
	if (ref($do_page_name) eq "HASH") {
	    $do_page_name = $do_page_name->{$cmd_str};
	}
	if (ref($do_page_name) eq "ARRAY") {
	    for (my $i = 0; $i <= $#{@{$do_page_name}}; $i += 2) {
		$do_page_name->[$i] = gettext($do_page_name->[$i]);
	    }
	} else {
	    $do_page_name = gettext($do_page_name);
	}

	if ($cmd_str =~ /cmd_rs_weights/) {
	    $q->content_header($do_page_name, undef, get_loadbalance_script());
	} else {
           $q->content_header($do_page_name);
	}

	$imagedir = "/images";
}

# Print an error message
# If the second argument is "0", skip the error icon
sub bailout {
	my ($err, $icon) = @_;
	print "<p>\n";
	if ($icon ne "0") {
		print "<img src=\"/images/error_32.gif\" width=32 height=32 alt=".gettext("error").">\n";
	}
	print STDOUT "<font color=\"red\">".gettext("An unexpected error was encountered:")."<p>$err</font>\n";
	if ($in_table) {
	    print "</table>\n";
	}
	if ($in_form) {
		&wizard_end();
	}
	&common_footer();
	exit;
}

# Args are in $q->param(); process and move to %FORM
sub getargs {
	my ($name, $value);
	foreach $name ($q->param()) {
	    $value = $q->param($name);

	    # Remove bad characters
	    $value =~ s/[\000-037]"'\\//g;
	    # Remove leading spaces
	    $value =~ s/^\s+//;
	    # Remove trailing spaces
	    $value =~ s/\s+$//;
	    # Allow more characters in str_ fields
	    if ($name !~ /^str_/) {
		$value =~ s/;`\$*"&'<>\[\]//g;
	    }
	    # Remove mouse position info
	    $name =~ s/\.[xy]$//;
	    $FORM{$name} = $value;
	}
}

# Run the cmd specified in %FORM
# &do_page("Header name");
# Note: "Header name" should not be internationalized in the caller
# because do_page initializes the gettext framework, so gettext must
# not be called before do_page.  The caller should have a commented
# gettext("Header name"), though, so it will go into the message catalog
# The header name may also be an array ref of a set of breadcrumbs.
# The header name may also be a hash of header names on commands.
sub do_page {
    $do_page_name = $_[0];
    $q = new Cluster::Cgi;

    # Clean up old state
    undef %FORM;
    undef @nodes;
    undef $errmsg;
    undef $errpos;
    undef $result;
    undef $errstatus;
    undef @rg;
    undef %rsrg;
    undef %rgstate;
    undef %rgdesc;
    undef %rsstate;
    undef %rsdesc;
    undef %rgdesc;
    undef %rsmsg;
    undef @res;
    undef @rgrs;
    undef %rtdesc;
    undef %rsrt;
    undef %rtfailover;
    undef @state;
    undef %desc;
    undef @lh;
    undef @lhrs;
    undef @lhrg;
    undef @sa;
    undef @sars;
    undef @sarg;
    undef $cmd_save;
    undef @cmd;
    undef $this_url;

    my ($cmd, $i);
    ($this_url = $0 ) =~ s#.*[/\\]##;

    &getargs();

    $cmd = "cmd_mainpage";
    foreach $i (keys %FORM) {
	    if ($i =~ /^cmd_/) {
		    $cmd = $i;
		    last;
	    }
    }

    # Check for either rg, rs, or ds installation authorizations
    (new Cluster::RBAC)->check_ds_auth($do_page_name, $cmd);

    # Print out header
    &common_header($do_page_name, $cmd);

    ($pkg) = caller;
    eval ( "&".$pkg."::".$cmd);
    if ($@) {
	    if ($@ =~ /^ at /) {
		    # Exited
	    } elsif ($@ =~ /Undefined subroutine/) {
		    &errmsg(gettext("That command has not been implemented yet"));
		    print "$@\n";
	    } else {
		    &bailout(gettext("Problem encountered:")." $@\n");
	    }
    }


    &common_footer();
}

# We have an error, so set the error variables, jump to that page,
# print the footer, and exit.
sub errpage {
    my ($errmsg_in, $errpos_in, $dst) = @_;
    $errmsg = $errmsg_in;
    $errpos = $errpos_in;
    my $str = $pkg."::".$dst;
    #print "*** errpage called $errmsg_in $errpos_in $dst >$str<\n";
    no strict 'refs';
    &$str;
    #eval $str;
    #print "*** errpage done\n";
    &common_footer();
    exit;
}

sub common_footer {
	if ($errpos) {
	    &errmsg($errmsg);
	}

	# Put parameters in comment for debugging
	print "<!- ".gettext("Parameters passed in\n");
	my $i;
	foreach $i (keys %FORM) {
		my $line = $i." = ".$FORM{$i}."\n";
		$line =~ s/</&lt;/g;
		$line =~ s/>/&gt;/g;
		print gettext($line);
	}
	print "->\n";

	if ($in_table) {
	    print "</table>\n";
	}
	if ($in_form) {
		&wizard_end();
	}

	print "</body></html>\n";
}

# Set the flush mode on the file handle
sub flush {
    my ($handle, $mode) = @_;
    if ($mode eq "") {
	$mode = 1;
    }
    select((select($handle), $|=$mode)[$[]);
}

# Start a wizard box
# &wizard_start("Title");
sub wizard_start {
	if ($in_form) {
		return;
	}
	my ($title) = @_;
	if ($title eq "") {
	    $title = $do_page_name;
	}
	$in_form = 1;
	print "<p>\n";
	print "<form action=\"$this_url\" method=\"post\">\n";
	&flush("STDOUT", 1);
	(defined $errpos) || ($errpos = 0);
}

# End a wizard box
sub wizard_end {
	if (0) {
	print "</td></tr>\n";
	print "<tr bgcolor=#aaaaaa><td>&nbsp;</td></tr>\n";
	print "</table></form></center>\n";
	} else {
	print "</form>\n";
	}
	$in_form = "";
	if ($cmd_save) {
		&cmd_info();
	}
}

# Start a code box
sub code_start {
	print "<table border=\"0\" cellspacing=\"0\" cellpadding=\"5\" " .
	    "align=\"center\" width=\"97%\" class=\"message-table\">\n";
	print "<tr><td width=\"95%\">\n";
}

# End a code box
sub code_end {
	print "</td></tr></table>\n";
}

# Run a command and open IN as the result
# Caller must close IN

sub opencmdIN {
    my ($cmd) = @_;
    open(IN, "$PFEXEC /usr/cluster/bin/$cmd 2>&1 |") || &bailout(sprintf(gettext("Couldn't run %s"), $cmd));
}

# Run a command from /usr/cluster/bin
# Return status (0 for success).  Set global $result to the command output.
# Store cmd in $cmd_save
# Results will be printed at wizard_end
# If $quiet is set, don't print as many HTML flags
sub runsuid {
	my ($cmd_in, $quiet) = @_;
	if ($cmd_save) {
	    $cmd_save = join("\n", $cmd_save, $cmd_in);
	} else {
	    $cmd_save = $cmd_in;
	}
	$result = "";
	$errstatus = "";

	if (!defined($quiet)) {
	    print "<p>".gettext("Running")." <p class=\"message-command-text\">/usr/cluster/bin/".&printable($cmd_in)."</p><br>\n";
	}
	if (!open(RUNIN, "$PFEXEC /usr/cluster/bin/$cmd_in 2>&1 |")) {
		#print "Open failed\n";
		$errstatus = $?;
		return $?;
	}
	while (<RUNIN>) {
		$result .= $_;
	}
	if ($result =~ /Usage error/) {
		$result = gettext("Usage error (internal).");
	}
	if (!close(RUNIN)) {
		#print "Close failed\n";
		$errstatus = $?;
		return $?;
	}
	return 0;
}

# Make printable by html
sub printable {
    my ($txt) = @_;
    $txt =~ s/</&lt;/g;
    $txt =~ s/>/&gt;/g;
    return $txt;
}

# Print the command info box
sub cmd_info
{
	&code_start();
	$cmd_save or $cmd_save = "";
	$cmd_save = &printable($cmd_save);
	$result = &printable($result);
	@cmd = split(/\n/, $cmd_save);
	print "<p class=\"message-description-text\">";
	if ($#cmd > 0) {
	    print gettext("Note: the following commands were executed:")."<br>\n";
	} else {
	    print gettext("Note: the following command was executed:")."<br>\n";
	}
	print "<p class=\"message-command-text\">\n";
	my $i;
	for ($i = 0; $i <= $#cmd; $i++) {
		print $cmd[$i]."\n";
		print "<br>\n";
	}
	print "</p>\n";
	if ($errstatus) {
		print "<p class=\"message-command-text\">\n";
		print "<br><font color=\"red\">\n";
		print "<pre>\n";
		print "$result";
		print "</pre></font>\n";
		print "</p>\n";
	}
	&code_end();
}

# Put a box around stuff
sub box_start {
	print "<center><table borderwidth=0 cellspacing=1 cellpadding=1 bgcolor=\"#000000\" width=\"80%\"><tr><td>\n";
	print "  <table borderwidth=0 cellspacing=0 cellpadding=5 bgcolor=\"#ffffff\" width=\"100%\"><tr><td>\n";
}

sub box_end {
	print "  </td></tr></table>\n";
	print "</td></tr></table></center>\n";
}

#input("name") - creates input line
# Fill in from $FORM{"name"}
sub input {
	my ($name, $width) = @_;
	(defined $width) || ($width = "");
	if ($width) {
	    $width = " size=\"$width\"";
	}
	#print "<input name=\"$name\" type=\"text\" value=\"$FORM{$name}\"$width>\n";
	print "<input name=\"$name\" type=\"text\" value=\"$FORM{$name}\">\n";
}

#password("name") - creates password input line
# Fill in from $FORM{"name"}
sub password {
	my ($name) = @_;
	print "<input name=\"$name\" type=\"password\" value=\"$FORM{$name}\">\n";
}

#hidden("name") - put $FORM{"name"} as hidden
sub hidden {
	my ($name, $val) = @_;
	if ($val) {
	    $FORM{$name} = $val;
	}
	print "<input name=\"$name\" type=\"hidden\" value=\"".$FORM{"$name"}."\">\n";
}

#radio("name", "value", "text")
sub radio {
    my ($name, $value, $text) = @_;
    my $checked;
    if ($FORM{$name} eq $value) {
	$checked = " checked";
    }
    if ($checked ne "") {
	$checked = " ".$checked;
    }
    print "<input name=\"$name\" value=\"$value\" type=\"radio\"$checked>$text\n";
}

#checkbox("name", "value", $text, ["checked"])
sub checkbox {
    my ($name, $value, $text, $checked) = @_;
    if ($FORM{$name} eq $value) {
	$checked = " checked";
    }
    if ($checked ne "") {
	$checked = " ".$checked;
    }
    print "<input name=\"$name\" value=\"$value\" type=\"checkbox\"$checked>$text\n";
}

#submit ("cmd", "text")
sub submit {
    my ($name, $text) = @_;
    print "<input name=\"$name\" type=\"submit\" value=\"$text\">\n";
}

#option("name", "value", "text") - creates option line
sub option {
	my ($name, $value, $text) = @_;
	if ($text eq "") {
		$text = $value;
	}
	if ($FORM{$name} eq $value) {
		print "<option value=\"$value\" selected>$text</option>\n";
	} else {
		print "<option value=\"$value\">$text</option>\n";
	}
}

# Print the ok icon
sub okmsg {
	my ($msg) = @_;
	print "<p><img src=\"/images/info_32.gif\" width=32 height=32 alt=".gettext("OK").">\n";
	print "$msg\n<br>\n";
}

# Print text in red
# If pre is 0, do not print the error icon.
# If pre is nonzero, print using <pre>
sub errmsg {
	my ($msg, $pre) = @_;
	if ($msg eq "") {
	    $msg = $errmsg;
	}
	(defined $pre) || ($pre = "");
	$msg =~ s/</&lt;/g;
	$msg =~ s/>/&gt;/g;
	if ($in_table) {
	    print "<tr><td colspan=2>\n";
	} else {
	    print "<p>\n";
	}
	if ($pre ne "0") {
		print "<img src=\"/images/error_32.gif\" width=32 height=32 alt=".gettext("error").">\n";
	}

	print "<font color=\"red\">$msg</font><br>\n";
	if ($pre ne "0" && $pre ne "1" && $pre ne "") {
	    print "<font color=\"red\"><pre>$pre</pre></font><br>\n";

	}
	$errpos = 0;
	if ($in_table) {
	    print "</td></tr>\n";
	}
}

# Get the nodelist in the array @nodes, and states in @state
sub getnodes {

	my $mode = 0;
	my $nodes = 0;
	undef @nodes;
	undef @state;

	&opencmdIN("scstat");
	while (<IN>) {
		chop;
		if (/not a cluster node/) {
		    &bailout(gettext("The system is not booted as a cluster"));
		} elsif (/^Node/) {
			$mode = 1;
		} elsif (/^Path/) {
			$mode = 0;
		}
		s/\s+$//;
		if (/Cluster node:\s+(\S+)\s+(\S+)/) {
			$nodes[$nodes] = $1;
			$state[$nodes++] = $2;
		} elsif ($mode == 1 && /Node name:\s+(\S+)/i) {
			# Backwards compatibility
			$nodes[$nodes] = $1;
			$nodes++;
		}
	}
	close(IN) || &bailout(sprintf(gettext("Error return from scstat %s"), $?)."\n");
}

# Get the scstat resource info
# set @nodes, @state with node info
# set @rg with groups
# set %rsrg with $rsrg{rs} = rg
# set %rgstate{$rg,$node} = state
# set %rsstate{$rs,$node} = state
# set %rsmsg{$rs,$node} = state message
sub getscstatrg {
	my $scstat = "scstat";

	undef @nodes;
	undef @state;
	undef @rg;
	undef %rsrg;
	undef %rgstate;
	undef %rsstate;
	undef %rsmsg;

	my $group;
	my $res;
	my $node;
	my $state;

	# gettext info for potential states
	# This could potentially come from libscstat's message file later
	;# gettext("Unmanaged")
	;# gettext("Offline")
	;# gettext("Online")
	;# gettext("Pending online")
	;# gettext("Pending offline")
	;# gettext("Error--stop failed")
	;# gettext("Unknown")

	&opencmdIN("$scstat");
	while (<IN>) {
	    chop;
	    s/\s+$//;
	    if (/not a cluster node/) {
		&bailout(gettext("The system is not booted as a cluster"));
	    } elsif (/Resources:\s+(\S+)\s+(.*)/) {
		# Resource groups and resources
		($group, $res) = ($1, $2);
		if ($res eq "-") {
		    # No resources
		} else {
		    # Resource list separated by spaces
		    @res = split(/ /, $res);
		    my $i;
		    for ($i = 0; $i <= $#res; $i++) {
			$rsrg{$res[$i]} = $group;
		    }
		}
		$rgrs[1+$#rg] = $res;
		$rg[1+$#rg] = $group;
	    } elsif (/^\s+Group:\s+(\S+)\s+(\S+)\s+(.*)/) {
		# Resource groups
		($group, $node, $state) = ($1, $2, $3);
		$rgstate{$group,$node} = $state;
	    } elsif (/^\s+Resource:\s+(\S+)\s+(\S+)\s+(Stop failed)\s+(.*)/ ||
		    /^\s+Resource:\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*)/) {
		# Resources
		my $msg;
		($res, $node, $state, $msg) = ($1, $2, $3, $4);
		$rsstate{$res,$node} = $state;
		$rsmsg{$res,$node} = $msg;
	    } elsif (/Cluster node:\s+(\S+)\s+(\S+)/) {
		$state[$#nodes+1] = $2;
		$nodes[$#nodes+1] = $1;
	    }
	}
	close(IN);
}

# Get config from scrgadm -p
# For type, fills in %rtdesc, %rtfailover
# For group, fills in %rgdesc
# For resource, fills in %rsdesc, %rsrt, %rsrg

sub getscrgconfig {
	my ($opt) = "-p";
	my $cur_t;
	my $cur_g;
	my $cur_r;
	&opencmdIN("scrgadm $opt");
	while (<IN>) {
		chop;
		$_ =~ s/\s+$//;
		if (/^Res Type name:\s*(.*)/i ||
		    /^RT name:\s*(.*)/i) {
			$cur_t = $1;
			$cur_t =~ s/:.*//; # Truncate version
			$rtdesc{$cur_t} = "";
		} elsif (/\s*Res Type description:\s*(.*)/i ||
		    /\s*RT description:\s*(.*)/i) {
			$rtdesc{$cur_t} = $1;
		} elsif (/\s*Res Type failover:\s*(.*)/i ||
		    /\s*RT description:\s*(.*)/i) {
			$rtfailover{$cur_t} = $1;
		} elsif (/^\s*Res Group name:\s*(.*)/i ||
		    /^\s*RG name:\s*(.*)/i) {
			$cur_g = $1;
			$rgdesc{$1} = "";
		} elsif (/\s*Res Group RG_description:\s*(.*)/i ||
		    /\s*RG Description:\s*(.*)/i) {
			$rgdesc{$cur_g} = $1;
		} elsif (/^\s*Res name:\s*(.*)/i ||
		    /^\s*RS Name:\s*(.*)/i) {
			$cur_r = $1;
			$rsdesc{$1} = "";
		} elsif (/\s*Res R_description:\s*(.*)/i ||
		    /\s*RS Description:\s*(.*)/i) {
			$rsdesc{$cur_r} = $1;
		} elsif (/\s*Res resource type:\s*(.*)/i ||
		    /\s*RS Type:\s*(.*)/i) {
			$rsrt{$cur_r} = $1;
		} elsif (/\s*Res resource group name:\s*(.*)/i ||
		    /\s*RS Resource Group:\s*(.*)/i) {
			$rsrg{$cur_r} = $1;
		} elsif (/^$/) {
			$cur_t = "";
			$cur_r = "";
			$cur_g = "";
		} else {
			#print "<br>Couldn't parse $_\n";
		}
	}
	if (defined $desc{""}) {
		print "Bad parse on desc ".$desc{""}."\n";

	}
	close(IN);
}


# Get a list of logical hosts and shared addresses to select
# return @lh @lhrg @lhrs; hostnames, resource group, resource name
# return @sa @sarg @sars
# Input argument: saok - nonzero if a shared address is okay
# Return 1 if we succeed, or 0 if we fail (i.e. no lh if saok "",
# or no lh or sa if saok set).
sub getlh {
    my ($saok) = @_;
    my ($type);
    undef @lh;
    undef @lhrg;
    undef @lhrs;
    undef @sa;
    undef @sarg;
    undef @sars;
    opencmdIN("scrgadm -pvv");

    while (<IN>) {
	if (/^$/) {
	    $type = "";
	} elsif (/resource type:\s*(\S+)/) {
	    $type = $1;
	} elsif (/\((.+):([^:)]+):([^:)]+)\) Res property value:\s*(.*)/) {
	    my ($rg,$rs,$prop,$val) = ($1,$2,$3,$4);
	    if ($type eq "SUNW.LogicalHostname" && $prop eq "HostnameList") {
		$lhrg[$#lh+1] = $rg;
		$lhrs[$#lh+1] = $rs;
		($lh[$#lh+1] = $val) =~ s/ .*//;
	    } elsif ($type eq "SUNW.SharedAddress" && $prop eq "HostnameList") {
		$sarg[$#sa+1] = $rg;
		$sars[$#sa+1] = $rs;
		($sa[$#sa+1] = $val) =~ s/ .*//;
	    }
	}
    }
    close(IN);
    if (defined($saok) && $saok eq "anything") {
	# Don't check
    } elsif (defined($saok)) {
	if ($#lh < 0 && $#sa < 0) {
	    &errmsg(gettext("There are no logical hostnames or shared addresses set up on this cluster."));
	    print "<p>\n";
	    print gettext("You must <a href=\"/cgi-bin/rg/rs_add.pl\"> set one up</a> to install this service.\n");
	    return 0;
	}
    } else {
	if ($#lh < 0) {
	    &errmsg(gettext("There are no logical hostnames set up on this cluster."));
	    print "<p>\n";
	    print gettext("You must <a href=\"/cgi-bin/rg/rs_add.pl\"> set one up</a> to install this service.\n");
	    return 0;
	}
    }
    return 1;
}

# Make sure the type is installed
# getscrgconfig must have been run before calling
# Return 1 for ok, 0 for error
sub checktype {
    my ($rt) = @_;

    if (! defined($rtdesc{"$rt"})) {
	if (-e "/usr/cluster/lib/rgm/rtreg/$rt") {
		&errmsg(sprintf(gettext(
		    "The %s resource type is not registered on your cluster."),
		    $rt));

		print gettext("Click to register:")."\n";
		&hidden("rt", "$rt");
		&submit("cmd_register_type", gettext("Register"));
		return 0;
	} else {
		&errmsg(sprintf(gettext("The %s resource type is not installed on your cluster."), $rt));
		print "<p>",gettext("It must be installed from the Sun Cluster Agents CD using scinstall on each node.\n");
		$FORM{"rt"} = $rt;
		&cmd_install_type();
		return 0;
	}
    }
    return 1;
}


# Install the type specified in rt
sub cmd_install_type {
    &wizard_start();
    my ($rt, $cmd, $status, $dir, $serv);
    $rt = $FORM{"rt"};
    if ($rt eq "") {
	&errmsg(gettext("No type specified!\n"));
	return;
    } elsif ($rt eq "SUNW.nshttp") {
	$serv = "iws";
    } elsif ($rt eq "SUNW.oracle_listener") {
	$serv = "oracle";
    } elsif ($rt eq "SUNW.oracle_server") {
	$serv = "oracle";
    } elsif ($rt =~ /SUNW.(.*)/) {
	$serv = $1;
    } else {
	&errmsg(sprintf(gettext("Don't know name for type %s"), $rt));
	return;
    }

    if ($errpos == 1) {
	&errmsg();
    }

    &action_table_start();

    &action_table_row_start(gettext("Path to the Sun Cluster Agents CD:"));
    &input("dir", 55);
    &action_table_row_end();

    &action_table_end();

    &submit_table_start();
    &hidden("rt");
    $FORM{"serv"} = $serv;
    &hidden("serv");
    $FORM{"cmd_install_type_1"} = 1;
    &hidden("cmd_install_type_1");
    &submit("submit", gettext("Continue"));
    &submit_table_end();
    return;
}

# Next part of installing type
sub cmd_install_type_1 {
    my $dir = $FORM{"dir"};
    my $rt = $FORM{"rt"};
    &wizard_start;
    if (! -e $dir) {
	&errpage(gettext("Directory does not exist"), 1, "cmd_install_type");
    }

    if (! -e "$dir/.cdtoc") {
	&errpage(gettext("File .cdtoc not found"), 1, "cmd_install_type");
    }

    print "<h2>".sprintf(gettext("Installing %s resource type"), $FORM{"serv"})."</h2>\n";

    my $cmd = "/cgi-bin/ds/scinstall-script.pl";
    my (%args) = (serv => $FORM{"serv"}, cdrom_path => $dir);
    &getnodes();
    my $err;
    $cmd_save = "scinstall -ik -d $dir -s ".$FORM{"serv"};

    my $cluster;
    $cluster = new Cluster::Common;
    $err = $cluster->run_parallel($cmd, 1, \%args);
    if ($err =~ /already/) {
	&errmsg(gettext("Type already installed"), 0);
    } elsif ($err) {
	&errmsg(gettext("Install failed"));
	return;
    }

    &getscrgconfig(); # fill in rtdesc info
    if (! $rtdesc{$rt}) {
	&cmd_register_type;
    } else {
    	print "<p>\n";
	&hidden("rt", "$rt");
    	&submit("cmd_mainpage", gettext("Continue"));
    }
}

# Register the type specified in rt
sub cmd_register_type {
    &wizard_start();
    my ($rt, $cmd, $status);
    $rt = $FORM{"rt"};
    if ($rt eq "") {
	&errmsg(gettext("No type specified!\n"));
	return;
    }
    print "<h2>".sprintf(gettext("Registering %s"), $rt)."</h2>\n";
    $cmd = "scrgadm -a -t $rt";
    $status = &runsuid($cmd);
    if ($status == 0) {
	&okmsg(gettext("Type added successfully."));
	print gettext("You may now continue with your configuration\n");
    } else {
	if ($result =~ /already exists/) {
	    &errmsg(gettext("That type already exists in the cluster"));
	} else {
	    &errmsg(gettext("Failure"));
	}
    }
    print "<p>\n";
    &hidden("rt", "$rt");
    &submit("cmd_mainpage", gettext("Continue"));
}

# Find a globally-mounted file system
sub getglobal {
    my ($name) = "";
    open(IN, "</etc/mnttab") || return "";
    while (<IN>) {
	if (/#/) {
	} else {
	    my ($spec, $mp, $fs, $opt, $t) = split;
	    if ($mp =~ /\.devices/) {
		next;
	    }
	    if ($opt =~ /\bglobal/) {
		$name = $mp;
		last;
	    }
	}
    }
    close(IN);
    return $name;
}

# Test if the directory named is global
# Return 1 for global, 0 for non-global, -1 for error
sub isglobal {
    my ($dir) = @_;
    if ($dir eq "") {
	&errmsg(gettext("NULL directory"));
	return -1;
    }
    # Go up until we find something that exists.
    while (! -d $dir) {
	if ($dir =~ /^\/[^\/]*$/) {
	    return 0; # Hit root
	} elsif ($dir =~ /^(.*)\/[^\/]+/) {
	    $dir = $1;
	} else {
	    &errmsg(gettext("Directory does not exist"));
	    return -1;
	}
    }
    open(IN, "/usr/sbin/df -k $dir|") || return(-1);
    $_ = <IN>;
    $_ = <IN>;
    my ($fs) = split;
    close(IN);
    open(IN, "</etc/mnttab") || return(-1);
    while (<IN>) {
	my ($special, $mount_point, $fstype, $options, $time) = split;
	if ($special eq $fs) {
	    close(IN);
	    if ($options =~ /\bglobal/) {
		return 1;
	    } else {
		return 0;
	    }
	}
    }
    close(IN);
    &errmsg(sprintf(gettext("Couldn't find %s in /etc/mnttab\n"), $fs));
    return -1;
}

# See if we can connect to the port
# Return 1 if we can
sub portinuse {
    my ($port, $host) = @_;
    if ($host eq "" || $host eq "localhost") {
	$host = &Cluster::Common::get_hostname();
    }
    my ($proto) = getprotobyname('tcp');
    if (! socket(TSOCK, PF_INET, SOCK_STREAM, $proto)) {
	return 0;
    }
    my ($iaddr) = inet_aton($host);
    my ($paddr);
    $paddr = sockaddr_in($port, $iaddr);
    alarm 5; # Don't try forever
    if (connect(TSOCK, $paddr)) {
	close TSOCK;
	alarm 0;
	return 1;
    } else {
	close TSOCK;
	alarm 0;
	return 0;
    }
}

# Create select option for logical hostname or shared address
# Call &hostnameoption() if just a lh is okay, or
# &hostnameoption("sa") for la and sa
# returned option will be hostname:rg:rs:"lh" or "sa"

sub hostnameoption {
    my ($sa) = @_;
    my $i;
    print "<select name=\"lh\">\n";
    for ($i = 0; $i <= $#lh; $i++) {
	&option("lh", join(":", $lh[$i], $lhrg[$i], $lhrs[$i], "lh"),
	    $lhrs[$i].gettext(" (lh)"));
    }
    if ($sa) {
	for ($i = 0; $i <= $#sa; $i++) {
	    &option("lh", join(":", $sa[$i], $sarg[$i], $sars[$i], "sa"),
		$sars[$i].gettext(" (sa)"));
	}
    }
    print "</select>\n";
}

# Set up and run the resource / resource group for a service
# Or just set up and don't run
# &createservice($args);
# Gets lh/sa from $FORM{"lh"}
# Gets resource from $FORM{"rs"}
# Gets resource group from $FORM{"rg"}
sub createservice {
    my ($args, $dontstart) = @_;
    &getscrgconfig();

    my ($lh, $lhrg, $lhrs, $lhmode) = split(/:/, $FORM{"lh"});
    my ($mp, $dp, $cmd, $conf, $status);

    my $rg = new Cluster::Rg;
    my @rg_node_list = $rg->get_rg_nodelist($FORM{"rg"});

    if ($lhmode eq "sa" || $lhmode eq "sanocreate") {
	if ($lhmode eq "sa") {
	    # Create resource group

	    &getnodes();
	    $mp = $#nodes+1;
	    $dp = $mp;
	    $cmd = "scrgadm -a -g ".$FORM{"rg"}." -y maximum_primaries=$mp -y desired_primaries=$dp -y RG_dependencies=$lhrg";
	    $status = &runsuid($cmd);
	    if ($status != 0) {
		if ($result =~ /resource group exists/) {
		    &errmsg($result, 0);
		} else {
		    &errmsg(gettext("Failure"), $result);
		    return $status;
		}
	    }
	  } # $lhmode eq "sa"

	$cmd = "scrgadm -a -j ".$FORM{"rs"}." -g ".$FORM{"rg"}." $args ".
	    " -y Scalable=true";

	$status = &runsuid($cmd);
	if ($status != 0) {
	  if ($result =~ /VALIDATE/) {
	    &errmsg(gettext("Validate failed: check syslog for details"));
	    print "<br>\n";
	    for (my $zz = 0; $zz <= $#rg_node_list; $zz++) {
	      print "<a class=\"syslog-link\" ";
	      print "href=\"/cgi-bin/log/log.pl?node=" . $rg_node_list[$zz] . "\">";
	      print gettext("Click here to check syslog on ") . $rg_node_list[$zz];
	      print "</a>\n";
	    }
	  } else {
	    &errmsg(gettext("Failure"), $result);
	  }
	    return $status;
	}

	if ($dontstart) {
	    return $status;
	}

	$cmd = "scswitch -Z -g $lhrg";

	$status = &runsuid($cmd);
	if ($status != 0) {
	    &errmsg(gettext("Failure"), $result);
	    return $status;
	}

	$cmd = "scswitch -Z -g ".$FORM{"rg"};

	$status = &runsuid($cmd);
	if ($status != 0) {
	    &errmsg(gettext("Failure"), $result);
	    return $status;
	}
    } else { # $lhmode ! sa*
	$cmd = "scrgadm -a -j ".$FORM{"rs"}." -g $lhrg $args ";

	$status = &runsuid($cmd);
	if ($status != 0) {
	  if ($result =~ /VALIDATE/) {
	    &errmsg(gettext("Validate failed: check syslog for details"));
	    print "<br>\n";
	    for (my $zz = 0; $zz <= $#rg_node_list; $zz++) {
	      print "<a class=\"syslog-link\" ";
	      print "href=\"/cgi-bin/log/log.pl?node=" . $rg_node_list[$zz] . "\">";
	      print gettext("Click here to view syslog on ") . $rg_node_list[$zz];
	      print "</a>";
	    }
	  } else {
	    &errmsg(gettext("Failure"), $result);
	  }
	  return $status;
	}

	if ($dontstart) {
	    return $status;
	}

	$cmd = "scswitch -Z -g $lhrg";

	$status = &runsuid($cmd);
	if ($status != 0) {
	    &errmsg(gettext("Failure"), $result);
	    return $status;
	}
    }

    &okmsg(gettext("Service started"));
    return 0;
}

# Convert a host name to dotted IP
sub hosttoip {
    my ($host) = @_;
    my ($addr) = inet_aton($host);
    if (! defined $addr) {
	return "";
    }
    return inet_ntoa($addr);
}

# Convert a dotted IP to hostname
sub iptohost {
    my ($ip) = @_;
    my ($rawip, $name, $aliases, $addrtype, $length, @addrs);
    $rawip = inet_aton($ip);
    ($name, $aliases, $addrtype, $length, @addrs) = gethostbyaddr($rawip, AF_INET);
    return $name;
}

# Get the domain name
sub domain {
    return hostdomain();
}

# Make sure password field is specified and is long enough
# Return errpage if error.  Default errpos is 100
sub validatepassword {
    my ($page, $minlen, $name, $errno) = @_;
    (defined $minlen) || ($minlen = "");
    (defined $name) || ($name = "password");
    (defined $errno) || ($errno = "100");
    if ($FORM{$name} eq "") {
	&errpage(gettext("Password must be specified"), $errno, $page);
    } elsif (length($FORM{$name}) < $minlen) {
	&errpage(sprintf(gettext("Password must be at least %s characters"), $minlen), $errno, $page);
    }
}

# Make sure the lh is okay
# Return errpage 101 if error with lh
# Return errpage 102 if error with rs
# Return errpage 103 if error with rg
sub validatelh {
    my ($page, $lhonly) = @_;
    my ($lh, $lhrg, $lhrs, $lhmode) = split(/:/, $FORM{"lh"});
    if ($FORM{"rs"} eq "") {
	&errpage(gettext("Resource must be specified"), 102, $page);
    }
    if (defined $rsdesc{$FORM{"rs"}}) {
	&errpage(sprintf(gettext("Resource %s in use"), $FORM{"rs"}), 102, $page);
    }
    if ($lhmode eq "sa") {
	if ($lhonly) {
	    &errpage(gettext("Logical Hostname must be used"), 101, $page);
	}
	if ($FORM{"rg"} eq "") {
	    $FORM{"rg"} = "rg-$lh";
	    &errpage(gettext("Resource group must be specified for Shared Address"),
		103, $page);
	}
	if (defined $rgdesc{$FORM{"rg"}}) {
		&errpage(sprintf(gettext("Resource group %s in use"), $FORM{"rg"}), 103, $page);
	}
    } elsif ($lhmode eq "lh") {
    } else {
	&errpage(sprintf(gettext("Problem encountered with lh, unexpected mode %s") ,$lhmode), 101, $page);
    }
}

# Validate port
# Make sure port is specified, and not in use on lh
# return default 104 if error
sub validateport {
    my ($page, $name, $errno, $host) = @_;
    if ($errno == 0) {
	$errno = 104;
    }
    if ($FORM{$name} == 0) {
	&errpage(gettext("Port must be specified"), $errno, $page);
    }
    if ($host eq "") {
	my ($lh, $lhrg, $lhrs, $lhmode) = split(/:/, $FORM{"lh"});
	$host = $lh;
    }
    if (&portinuse($FORM{$name}, $host)) {
	&errpage($q->sprintfn(gettext("Port %1 already in use on %2"),
	    $FORM{$name}, $host), $errno, $page);
    }
}

# Print info for testing the web server
# Gets lh, wport, and dots from FORM
sub webtestinfo {
    my ($port, $path);
    if ($FORM{"wport"} == 80) {
	$port = "";
    } else {
	$port = ":".$FORM{"wport"};
    }
    my ($lh, $lhrg, $lhrs, $lhmode) = split(/:/, $FORM{"lh"});
    $path = join("", "http://", $lh, ".", &domain(), $port);
    print "<p>".gettext("Test the web server: ")."<a target=\"webtest\" href=\"$path\">$path</a>\n";
    if ($FORM{"dots"}) {
	$path = $path."/dots.html";
	print "<br>".gettext("Test the dots demo: ")."<a target=\"dots\" href=\"$path\">$path</a>\n";
    }
}

# Find a port that is free, starting at the specified port
sub freeport {
    my ($port, $host) = @_;
    my $tryport;
    for ($tryport = $port; $tryport <= $port+10; $tryport++) {
	if (! &portinuse($tryport, $host)) {
	    last;
	}
    }
    return $tryport;
}

# Get path to item
# Print error if appropriate, print query
sub getpath {
    my ($label, $pathvar, $error, $itemptr, $text) = @_;
    if ($error) {
	&errmsg();
    } elsif ($FORM{$pathvar} eq "") {
	$FORM{$pathvar} = ""; # Can extend this function later
    }
    if (1 || $FORM{$pathvar} eq "" || $error) {
	print "<p>$$itemptr. $text<br>\n";
	$$itemptr++;
	&input($pathvar, 35);
    } else {
	&hidden($pathvar);
    }
}

# Print <select> to pick a resource type
sub typeselect {
    print "<select name=\"rt\">\n";

    my $rtdir = "/usr/cluster/lib/rgm/rtreg";
    my @services = Cluster::Common::get_services();
    my %installed_services;
    opendir(RTDIR, $rtdir) || &bailout(sprintf(gettext("Couldn't open %s"), $rtdir));
    my $dir;
    while ($dir = readdir(RTDIR)) {
	if ($dir eq "." || $dir eq "..") {
	    next;
	}
	my $desc = "";
	if (open(IN, "<$rtdir/$dir")) {
	    while (<IN>) {
		if (/^RT_DESCRIPTION\s*=\s*"(.*)"/) {
		    $desc = gettext($1); # I18N listed in scrgcommon::proptable
		    last;
		}
	    }
	    close(IN);
	}
	if ($desc eq "") {
	    $desc = $dir;
	} else {
	    $desc .= " ($dir)";
	}
	$rtdesc{$dir} = $desc;
	$installed_services{$dir} = 1;
    }
    close(RTDIR);
    foreach $dir (sort bydesc keys %rtdesc) {
	&option("rt", $dir, $rtdesc{$dir});
    }
    foreach $dir (@services) {
	if (! defined $installed_services{$dir}) {
	    &option("rt", $dir, $dir.gettext(" (uninstalled)"));
	}
    }
    &option("rt", "OTHER", gettext("-- Other uninstalled type --"));
    print "</select>\n";
}

# Sort list by descriptions
sub bydesc {
    $rtdesc{$a} cmp $rtdesc{$b};
}

# Cause the menu to be reloaded
sub reloadmenu {
	my ($q_in) = @_;
	if (defined $q_in) {
	    $q = $q_in;
	}
	print $q->start_script();
	print "top.menu.location.reload(true)";
	print $q->end_script();
}

# Usage:
# action_table_start
# action_table_row_start(text), action, [table_supplement(text)],
#	action_table_row_end
# action_table_end
sub action_table_start {
    $in_table = 1;
    print $q->start_table({ CLASS	=> "action-table",
			    WIDTH       => "100%",
			    BORDER      => 0,
			    CELLSPACING => 0,
			    CELLPADDING => 5
			    });
}

sub action_table_row_start {
    my ($text) = @_;
    print "<tr><td><div class =\"action-window-label-text\">";
    print "$text</div></td>\n";
    print "<td width=\"90%\">\n";
}

sub action_table_supplement {
    my ($text) = @_;
    #print "</td></tr>\n";
    #print "<tr><td>&nbsp;</td><td>\n";
    print "<span class=\"action-window-supplemental-text\">";
    print $text;
    print "</span>\n";
}

sub action_table_row_end {
    print "</td></tr>\n";
}

sub action_table_end {
    $in_table = 0;
    print "</table>\n";
}

sub submit_table_start {
    $in_table = 1;
    print "<hr>\n";
    print $q->start_table({ CLASS	=> "action-window",
			    WIDTH       => "96%",
			    BORDER      => 0,
			    CELLSPACING => 0,
			    CELLPADDING => 0,
			    ALIGN	=> "center"
			    });
    print "<tr><td align=\"right\">\n";
}

sub submit_table_end {
    $in_table = 0;
    print "</td></tr></table>\n";
}


# get_loadbalance_script
#
# Outputs the javascript which calculates helpful percentages on
# the "Adjust Resource Weights" SPM page.
# Needs to be in common.pm to be included in page header
sub get_loadbalance_script {
  getnodes();
  my $num_nodes = $#nodes + 1;
  my $lb_script = "";
  if (! ($num_nodes > 0)) {
    return "";
  }
  my $script1 =
<<ENDOFSCRIPT1;
  function calcLoadPercent() {
    if ((document.forms.length > 0) &&
        (document.forms[0].weight1 != null)) {
      var sum = 0;
      var w = 0;
ENDOFSCRIPT1
  $lb_script = $lb_script . $script1;
  my $i = 1;
  for ($i = 1; $i <= $num_nodes; $i++){

    my $script2 =
<<ENDOFSCRIPT2;
       w = document.forms[0].weight$i.value;
       if (isNaN(w) || (w < 0)) {
          w = 0;
          document.forms[0].weight$i.value = 0;
       }
       sum = Number(sum) + Number(w);
ENDOFSCRIPT2
    $lb_script = $lb_script . $script2;
   }
   for ($i = 1; $i <= $num_nodes; $i++){
     my $script3 =
<<ENDOFSCRIPT3; 
       var p = Math.round(1000 * document.forms[0].weight$i.value / sum) / 10;
       if (isNaN(p) || (p < 0)) {
          document.forms[0].percent$i.value = "";
       }
       else {
          document.forms[0].percent$i.value = p + "%";
       }
ENDOFSCRIPT3

     $lb_script = $lb_script . $script3;
   }
   $lb_script = $lb_script . "     }\n}";
   return $lb_script;
}  # get_loadbalance_script()

# Module load return value
1;
