#!/usr/perl5/bin/perl
#
# Copyright (c) 2001 by Sun Microsystems, Inc.
# All rights reserved.
#
#ident	"@(#)SUNW_cluster_storage_rcm.pl	1.2	01/08/15 SMI"
#

#
# This RCM script prevents the removal and suspension of primary paths
# to Sun Cluster managed storage devices.
#

require 5.005;
use strict;
use English;
use POSIX qw(locale_h EEXIST ENOENT);
use Sun::Solaris::Utils qw(textdomain gettext);
use Fcntl ':flock';				# for LOCK_EX and LOCK_UN
use IO::File;

my ($CMD_SCSTAT) = "/usr/cluster/bin/scstat";
my ($CMD_SCDIDADM) = "/usr/cluster/bin/scdidadm";
my ($CMD_DGCONV) = "/usr/cluster/lib/dcs/dgconv";
my ($CMD_METASET) = "/usr/sbin/metaset";
my ($CMD_VXDISK) = "/usr/sbin/vxdisk";
my ($CMD_CLINFO) = "/usr/sbin/clinfo";
my ($cache) = "/tmp/.rcm_cluster_storage.cache";
my ($locale);

#
# Append a new item to a comma-separated list.
#
sub add_list_item (@)
{
	my ($list, $item) = @ARG;

	if ($item ne "") {
		if ($list ne "") {
			$list = "$list,$item";
		} else {
			$list = $item;
		}
	}
	return ($list);
}

#
# 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 a failure to process 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);
}

#
# Returns a table describing raw device group membership.
#
sub get_raw_data
{
	my (@raw_data);

	if (-e $CMD_DGCONV) {
		open(DGCONV, "$CMD_DGCONV -d all |");
		if ($CHILD_ERROR) {
			setlocale(LC_ALL, $locale);
			fail(1, gettext("Internal failure"),
			    "Can't get raw groups");
		}
		@raw_data = <DGCONV>;
		close(DGCONV);
	}
	return (@raw_data);
}

#
# Returns a table describing SVM device group membership.
#
sub get_svm_data
{
	my (@groups, $group, $disklist, @svm_data);

	if (! -e $CMD_METASET) {
		return;
	}

	open(SVMGROUPS, "$CMD_METASET |");
	if ($CHILD_ERROR) {
		setlocale(LC_ALL, $locale);
    	    	fail(1, gettext("Internal failure"), "Can't get SVM groups");
	}
	while (<SVMGROUPS>) {
		if (/Set name = ([^, \t]+)/) {
			push(@groups, $1);
		}
	}
	close (SVMGROUPS);

	foreach $group (@groups) {
		$disklist = "";
		open(SVMDISKS, "$CMD_METASET -s $group -C disksin |");
		if ($CHILD_ERROR) {
			setlocale(LC_ALL, $locale);
			fail(1, gettext("Internal failure"),
			    "Can't get SVM groups");
		}
		while ($ARG = <SVMDISKS>) {
			chop;
			$disklist = add_list_item($disklist, $ARG);
		}
		close(SVMDISKS);

		push(@svm_data, "$group $disklist");
	}

	return (@svm_data);
}

#
# Returns a table describing VxVM device group membership.
#
sub get_vxvm_data
{
	my (@vxvm_data);

	if (-e $CMD_VXDISK) {
		open(VXDISK, "$CMD_VXDISK -o alldgs -q list |");
		if ($CHILD_ERROR) {
			setlocale(LC_ALL, $locale);
			fail(1, gettext("Internal failure"),
			    "Can't get VxVM groups");
		}
		@vxvm_data = <VXDISK>;
		close(VXDISK);
	}

	return (@vxvm_data);
}

#
# Given some information about a managed storage device along with tables of
# information about SVM and VxVM groups, this function returns a comma
# separated list of which groups the managed storage device belongs to.
#
sub get_group_list
{
	my ($grouplist, $group, $dataline);
	my ($path, $fullname, $name, $svm_ref, $vxvm_ref, $raw_ref) = @ARG;
	
	# Tape devices *ONLY* have an easily computed raw device group.
	#
	if ($path =~ /^\/dev\/rmt/) {
		$group = $fullname;
		$group =~ s/\/dev\/did\///;
		return ($group);
	}


	# Add to the list the disks's raw device group.
	#
	foreach $dataline (@$raw_ref) {
		my ($disk, $group) = split('[ \t]+', $dataline);
		if ($fullname =~ /$disk$/) {
			chop $group;
			$grouplist = add_list_item($grouplist, $group);
		}
	}

	# Add to the list the disk's SVM device groups.
	#
	foreach $dataline (@$svm_ref) {
		my ($disk, $disklist);
		($group, $disklist) = split(' ', $dataline);
		foreach $disk (split(',', $disklist)) {
			if ($disk eq $fullname) {
				$grouplist = add_list_item($grouplist, $group);
			}
		}
	}

	# Add to the list the disk's VxVM device groups.
	#
	foreach $dataline (@$vxvm_ref) {
		my ($ctdname);
		my ($device, $type, $disk, $group, $status) =
		    split('[ \t]+', $dataline);
		if ($group =~ /\(([^\)]*)\)/) {
			$group = $1;
		}
		next if ($group eq "rootdg");
		next if ($group eq "-");
		($ctdname = $path) =~ s/\/dev\/rdsk\///;
		if ($device =~ /$ctdname/ || $disk =~ /$ctdname/) {
			$grouplist = add_list_item($grouplist, $group);
		}
	}

	return ($grouplist);
}

#
# Refreshes the contents of a private cache file in /tmp.  The cache
# contains information necessary to speed up all of the callbacks that
# query the information about managed disks.  The cache should just be
# refreshed during the register callback for this purpose.
#
# The cached information includes the node's hostname and a table of
# mappings from disk paths to Device IDs, as well as all of the device
# group membership information for each disk.
#
# Refreshing the cache depends upon processing the results from various
# subcommands.  So switch the locale to the POSIX C locale for the duration
# of the cache refresh.
#
sub refresh_cache (@)
{
	my ($node, @sc_data, $device, $group, @svm_data, @vxvm_data, @raw_data);

	# Ensure that the cachefile exists as a regular file owned and
	# operated by root.  (Destroy all imposters.)
	#
	if (-e $cache) {
		my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime,
		    $mtime, $ctime, $blksize, $blocks) = stat(_);
		$mode = $mode & 0777;
		if (! ((-f _) && ($uid == 0) && ($mode == 0600))) {
			unlink($cache);
		} else {
			# Don't rebuild the cache if it's fairly new (i.e. it
			# was created only ~5 seconds ago).
			#
			if (time() - $mtime <= 5) {
				return;
			}
		}
	}
	if (! -e $cache) {
		while (!(IO::File->new($cache, O_RDWR|O_CREAT|O_EXCL, 0600)) &&
		    ($OS_ERROR == EEXIST)) {
			if (!unlink($cache) && $OS_ERROR == ENOENT) {
				fail(1, gettext("Internal failure"),
				    "Can't create cache file");
			}
		}
	}

	# Switch to the POSIX C locale so that subcommands can be used properly.
	#
	setlocale(LC_ALL, "C");

	# Open the cache, lock it, and flush out any old entries.
	#
	open(CACHE, ">$cache");
	if ($CHILD_ERROR) {
		setlocale(LC_ALL, $locale);
	    	fail(1, gettext("Internal failure"), "Can't open cache file");
	}
	flock(CACHE, LOCK_EX);
	truncate(CACHE, 0);

	# Add this cluster node's hostname to the cache.
	#
	($node) = split('[ \t\n]', `/usr/bin/hostname`);
	if ($CHILD_ERROR || $node eq "") {
		setlocale(LC_ALL, $locale);
		fail(1, gettext("Internal failure"), "Can't get nodename");
	}
	print CACHE "HOSTNAME $node\n";

	# Gather all of the device group membership data.
	#
	@svm_data = get_svm_data();
	@vxvm_data = get_vxvm_data();
	@raw_data = get_raw_data();

	# Gather all of the managed device data.
	#
	open(SCDIDADM, "$CMD_SCDIDADM -l -o path -o fullname -o name |");
	if ($CHILD_ERROR) {
		setlocale(LC_ALL, $locale);
		fail(1, gettext("Internal failure"), "Can't get DID data.");
	}
	@sc_data = <SCDIDADM>;
	close(SCDIDADM);

	# Now for each managed device, combine all of its management data with
	# its device group membership data and write the results out to the
	# cache.
	#
	foreach $device (@sc_data) {
		my ($path, $fullname, $name) = split('[ \t]+', $device);
		my ($grouplist) = get_group_list($path, $fullname, $name,
		    \@svm_data, \@vxvm_data, \@raw_data);
		if ($path !~ /^\/dev\/rmt/) {
			$path = $path . "s2";
		} else {
			$path = $path . "\t";
		}
		print CACHE "$path \t $fullname \t $grouplist\n";
	}

	flock(CACHE, LOCK_UN);
	close(CACHE);

	# Return to the preferred user locale once the cache is refreshed.
	#
	setlocale(LC_ALL, $locale);

	return;
}

#
# Analyze a device and determine which device groups it's in.  Also detect
# if any of those device groups are active on this node, and set a failure
# reason if any of them are.
#
sub analyze_device (@)
{
	my ($path, $get_reason) = @ARG;
	my ($fullname, $grouplist, $activelist, $group, $node, $usage, $reason);

	# Retrieve information from the cache file.
	#
	if (!open(CACHE, $cache)) {
		fail(1, gettext("Internal failure"), "Can't open cache file");
	}
	flock(CACHE, LOCK_EX);
	while (<CACHE>) {
		if (/^HOSTNAME ([^\n]+)/) {
			$node = $1;
			next;
		}
		chop;
		if (/^$path/) {
			($path, $fullname, $grouplist) = split('[ \t]+', $ARG);
			last;
		}
	}
	flock(CACHE, LOCK_UN);
	close(CACHE);

	# Fail if the disk is unrecognized
	#
	if ($fullname eq "") {
		fail(1, gettext("Unrecognized device"),
		    "No device usage found");
	}

	# Construct the usage string.
	#
	if ($grouplist ne "") {
		if ($path =~ /^\/dev\/rmt/) {
			$usage = sprintf(
			    gettext("Sun Cluster Tape (DID=%$1s, DGs=%$2s)"),
			    $fullname, $grouplist);
		} else {
			$usage = sprintf(
			    gettext("Sun Cluster Disk (DID=%$1s, DGs=%$2s)"),
			    $fullname, $grouplist);
		}
	} else {
		if ($path =~ /^\/dev\/rmt/) {
			$usage = sprintf(
			    gettext("Sun Cluster Tape (DID=%$1s)"), $fullname);
		} else {
			$usage = sprintf(
			    gettext("Sun Cluster Disk (DID=%$1s)"), $fullname);
		}
	}

	# Construct the reason string (if requested).
	#
	$reason = "";
	if ($get_reason) {

		# To determine if any of this disk's groups are active, first
		# find out which groups are active on this node and then test
		# whether this disk belongs to any of those groups.
		#
		# Temporarily switch to the C locale while running 'scstat'.
		#
		my ($server, $thisgroup);

		$activelist = "";
		setlocale(LC_ALL, "C");
		open(SCSTAT, "$CMD_SCSTAT -Dvv |");
		if ($CHILD_ERROR) {
			setlocale(LC_ALL, $locale);
		    	fail(1, gettext("Internal failure"),
			    "Can't query device groups");
		}
		while (<SCSTAT>) {
			if (/Device group servers:[ \t]+([^ ]+)[ \t]+([^ ]+)/) {
				$server = $2;
				$thisgroup = $1;
				if ($server eq $node) {
					foreach $group (split(',',$grouplist)) {
						if ($group eq $thisgroup) {
							$activelist =
							    add_list_item(
							        $activelist,
						                $group);
						}
					}
				}
			}
		}
		close (SCSTAT);
		setlocale(LC_ALL, $locale);

		# Generate a failure reason if any groups were active.
		#
		if ($activelist ne "") {
			$reason = sprintf(gettext("Active DGs: %s"),
			    $activelist);
		}
	}

	return ($usage, $reason);
}

#
# Main routine of the script.
#

my (@disks, $usage, $reason);
my ($cmd, $device) = @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 Storage Devices (1.1)"), "\n";
		print "rcm_cmd_timeout=86400\n";
		exit (0);
	};

	# The "register" command.  This registeres interest in every Sun
	# Cluster managed storage device.
	#
	($cmd eq "register") && do {
		# Do nothing if this system isn't clustered.
		#
		if ((system($CMD_CLINFO)/256) != 0) {
			exit(0);
		}

		# Otherwise refresh the cache and register for resources.
		#
		refresh_cache();
		if (!open(CACHE, $cache)) {
			fail(1, gettext("Internal failure"),
			    "Can't open cache file");
		}
		flock(CACHE, LOCK_EX);
		while (<CACHE>) {
			if (/^HOSTNAME ([^\n]+)/) {
				next;
			}
			($device) = split('[ \t]+', $ARG);
			print "rcm_resource_name=$device\n";
		}
		flock(CACHE, LOCK_UN);
		close(CACHE);
		exit(0);
	};

	# The "resourceinfo" command.  Analyze the disk and return the usage.
	#
	($cmd eq "resourceinfo") && do {
		($usage, $reason) = analyze_device($device, 0);
		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_device($device, 1);
		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") && do {
		exit(0);
	};

	# An empty command 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.
	#
	exit(2);
}
