#!/usr/perl5/bin/perl
#
# Copyright 2005 Sun Microsystems, Inc.  All rights reserved.
# Use is subject to license terms.
#
#ident	"@(#)SUNW_cluster_quorum_rcm.pl	1.3	05/05/06 SMI"
#

#
# This RCM script prevents the removal and suspension of Sun Cluster
# quorum devices.
#

require 5.005;
use strict;
use English;
use locale;
use POSIX qw(locale_h);
use Sun::Solaris::Utils qw(textdomain gettext);

my ($CMD_SCSTAT) = "/usr/cluster/bin/scstat";
my ($CMD_SCDIDADM) = "/usr/cluster/bin/scdidadm";
my ($CMD_CLINFO) = "/usr/sbin/clinfo";
my ($locale);
my ($LIB_SMF) = "/lib/svc/share/smf_include.sh";

#
# Log a detailed error message, report a more general failure, and exit
# with the return value specified.
#
# The return value should be 3 for a properly processed request refusal,
# or 1 if there was an error processing the operation.
#
sub fail (@)
{
	my ($retval, $reason, $log_msg) = @ARG;

	if ($log_msg ne "") {
		print "rcm_log_err=", $log_msg, "\n";
	}

	if ($reason ne "") {
		print "rcm_failure_reason=", $reason, "\n";
	}

	exit ($retval);
}

#
# Given a disk device path, returns usage and reason strings specifying
# if and how the disk is in use.
#
sub analyze_disk (@)
{
	my (@disk_data, @quorum_data);
	my ($usage, $reason, $path, $fullname, $quorum, $managed_disk);
	my ($disk) = @ARG;

	# Sanity check
	#
	if ($disk eq "") {
		fail(1, gettext("Protocol error"),
		    "Invalid or missing disk argument");
	}

	# Determine what DID corresponds to this disk
	#
	@disk_data = get_disk_data();
	foreach $managed_disk (@disk_data) {
		($path, $fullname) = split('[ \t]+', $managed_disk);
		$path = $path . "s2";
		if ($disk eq $path) {
			last;
		} else {
			$fullname = "";
		}
	}
	if ($fullname eq "") {
		fail(1, gettext("Protocol error"),
		    "Cannot determine DID for disk argument");
	}

	# Determine if the DID is used as a quorum device, and fill in $usage
	# and $reason appropriately.
	#
	$usage = "";
	$reason = "";
	@quorum_data = get_quorum_data();
	foreach $quorum (@quorum_data) {
		if ($quorum eq $fullname) {
			$usage = sprintf(
			    gettext("Sun Cluster Quorum Disk (DevID=\"%s\")"),
			        $fullname);
			$reason = gettext("Configured quorum device.");
			last;
		}
	}

	return ($usage, $reason);
}

#
# Returns a list of configured quorum devices.
#
sub get_quorum_data ()
{
	my (@quorums, $quorum);

	# Temporarily change to the C locale before analyzing subcommands.
	#
	setlocale(LC_ALL, "C");

	open(SCSTAT, "$CMD_SCSTAT -q |");
	if ($CHILD_ERROR) {
		setlocale(LC_ALL, $locale);
		fail(1, gettext("Internal failure"),
		    "Unable to obtain quorum devices");
	}
	while (<SCSTAT>) {
		if (/Device votes:[ \t]+([^ \t]+)/) {
			$quorum = $1;
			$quorum =~ s/s[0-9]+$//;
			push(@quorums, $quorum);
		}
	}
	close(SCSTAT);

	# Return to the user specified locale when done.
	#
	setlocale(LC_ALL, $locale);

	return (@quorums);
}

#
# Returns information tuples describing each Sun Cluster managed disk.  For
# each disk, its path and Device ID fullname are both returned.
#
sub get_disk_data ()
{
	my (@disks);

	# Temporarily change to the C locale before analyzing subcommands.
	#
	setlocale(LC_ALL, "C");

	open(SCDISKS, "$CMD_SCDIDADM -l -o path -o fullname |");
	if ($CHILD_ERROR) {
		setlocale(LC_ALL, $locale);
		fail(1, gettext("Internal failure"),
		    "Unable to obtain DID paths");
	}
	@disks = <SCDISKS>;
	close(SCDISKS);

	# Return to the user specified locale when done.
	#
	setlocale(LC_ALL, $locale);

	return (@disks);
}

#
# Main routine of the script.
#

my ($usage, $reason);
my ($cmd, $disk) = @ARGV;

$locale = setlocale(LC_ALL, "");

SWITCH: {

	# The "scriptinfo" command.
	#
	($cmd eq "scriptinfo") && do {
		print "rcm_script_version=1\n";
		print "rcm_script_func_info=",
		    gettext("Sun Cluster Quorum Devices (1.1)"), "\n";
		print "rcm_cmd_timeout=86400\n";
		exit(0);
	};

	# The "register" command.  All physical disks that are used as quorum
	# devices are registered.  To determine which disks are quorum devices,
	# data about what DIDs map to what physical disks are combined with data
	# about which DIDs are quorum devices.
	#
	($cmd eq "register") && do {
		# Do nothing if this system isn't clustered.
		#
		if ((system($CMD_CLINFO)/256) != 0) {
			exit(0);
		}

		# When Solaris boots under SMF, its possible that
		# the rcm_daemon runs before bootcluster completes. 
		# In this case we return success since reregistration 
		# will be performed during the initiation of the DR
		# operation.
		if ( -e $LIB_SMF ) {
			my $svc_state=`svcs -H -o STATE bootcluster`;

			chop $svc_state;

			if ($svc_state ne "online") {
				# Registration is expected to be performed
				# again during the board operations.
				exit(0);
			}
		}

		my (@disk_data, @quorum_data, $path, $fullname, $quorum);
		@disk_data = get_disk_data();
		@quorum_data = get_quorum_data();
		foreach $disk (@disk_data) {
			($path, $fullname) = split('[ \t]+', $disk);
			$path = $path . "s2";
			foreach $quorum (@quorum_data) {
				if ($quorum eq $fullname) {
					print "rcm_resource_name=$path\n";
				}
			}
		}
		exit(0);
	};

	# The "resourceinfo" command.  Analyze the disk and return the usage.
	#
	($cmd eq "resourceinfo") && do {
		($usage, $reason) = analyze_disk($disk);
		if ($usage eq "") {
			$usage = gettext("Sun Cluster Quorum Disk (unused?)");
		}
		print "rcm_resource_usage_info=", $usage, "\n";
		exit(0);
	};

	# The "queryremove", "preremove", "querysuspend", and "presuspend"
	# commands.  These are all processed the same: analyze the disk, and
	# if a failure reason was returned, fail the operation.
	#
	($cmd eq "queryremove" || $cmd eq "preremove" ||
	 $cmd eq "querysuspend" || $cmd eq "presuspend") && do {
		($usage, $reason) = analyze_disk($disk);
		if ($reason ne "") {
			fail(3, $reason, "");
		}
		exit(0);
	};

	# The "postremove", "undoremove", and "cancelsuspend" commands.  These
	# are all processed the same: do nothing.  Just catch them and make
	# sure that a return value of 0 is returned.
	#
	($cmd eq "postremove" || $cmd eq "undoremove" ||
	    $cmd eq "cancelsuspend" || $cmd eq "postresume" ||
		$cmd eq "cancelremove" || $cmd eq "preremove") && do {
		exit(0);
	};

	# An empty command name is a protocol error that should be logged.
	#
	($cmd eq "") && do {
		fail(1, gettext("Protocol error"), "Missing command name");
	};

	# Any commands not caught above, exit with a value of 2 to indicate
	# that this script doesn't recognize the commands.  They are not
	# errors.
	#
	exit(2);
}
