#!/usr/bin/perl

#BEGIN_VERSION_GENERATION
$FENCE_RELEASE_NAME="2.0.115";
$REDHAT_COPYRIGHT=("Copyright (C) Red Hat, Inc.  2004  All rights reserved.");
$BUILD_DATE="(built Tue Aug 23 13:16:07 EDT 2016)";
#END_VERSION_GENERATION

################################################################################

use File::Basename;
use Term::ANSIColor;
use Getopt::Long;
use XML::LibXML;

################################################################################

my @devices = ();
my %devices_name = ();
my %devices_path = ();
my %options = ();
my %results = ();

################################################################################

sub do_action_on (\@$$)
{
    my @devices = @{(shift)};
    my ($dev, $node_key) = @_;
    my $err = 0;

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self (dev=$dev node_key=$node_key)\n";
    }

    foreach (@devices) {
	if (do_reset ($_) != 0) {
	}
	if (do_register_ignore ($_, $node_key) != 0) {
	    $err++;
	}
    }

    if (scalar (get_keys_reserve ($dev)) == 0) {
	if (do_reserve ($dev, $node_key) != 0) {
	    $err++;
	}
    }

    return ($err);
}

sub do_action_off ($$$)
{
    my ($dev, $node_key, $host_key) = @_;
    my $err = 0;

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self (dev=$dev node_key=$node_key host_key=$host_key)\n";
    }

    if (do_preempt_abort ($dev, $host_key, $node_key) != 0) {
	$err++;
    }

    return ($err);
}

sub do_action_clear ($$)
{
    my ($dev, $rk) = @_;

    return (0) unless get_keys_register ($dev);

    my $cmd = "sg_persist -n -o -C -K $rk -d $dev";
    my @out = qx { $cmd 2> /dev/null };
    my $err = ($?>>8);

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self (dev=$dev rk=$rk)\n";
	print "    cmd=$cmd\n";
	print "    err=$err\n";
    }

    return ($err);
}

sub do_verify_on (\@$$)
{
    my @devices = @{(shift)};
    my ($dev, $node_key) = @_;
    my $err = 0;

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self (dev=$dev node_key=$node_key)\n";
    }

    @keys = grep { /^$node_key$/ } get_keys_register ($dev);

    if (scalar (@keys) == 0) {
	$err++;
    } elsif (defined $options{'s'} && (scalar (@keys) != scalar (@devices))) {
	$err++;
    }

    @keys = get_keys_reserve ($dev);

    if (scalar (@keys) == 0) {
	$err++;
    }

    return ($err);
}

sub do_verify_off ($$$)
{
    my ($dev, $node_key, $host_key) = @_;
    my $err = 0;

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self (dev=$dev node_key=$node_key host_key=$host_key)\n";
    }

    @keys = grep { /^$node_key$/ } get_keys_register ($dev);

    if (scalar (@keys) != 0) {
	$err++;
    }

    @keys = grep { /^$host_key$/ } get_keys_reserve ($dev);

    if (scalar (@keys) == 0) {
	$err++;
    }

    return ($err);
}

sub do_verify_clear ($$)
{
    my ($dev, $host_key) = @_;
    my $err = 0;

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self (dev=$dev host_key=$host_key)\n";
    }

    @keys = get_keys_register ($dev);

    if (scalar (@keys) != 0) {
	$err++;
    }

    return ($err);
}

sub do_key_write ($)
{
    my $key = shift;

    open (\*FILE, ">/tmp/.fence_scsi_test") or die "$!\n";
    print (FILE "$key\n");
    close (FILE);

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self (key=$key)\n";
    }

    return;
}

sub do_key_read ($)
{
    my $key = shift;

    open (\*FILE, "</tmp/.fence_scsi_test") or die "$!\n";
    chomp ($$key = <FILE>);
    close (FILE);

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self (key=$$key)\n";
    }

    return;
}

sub do_register ($$)
{
    my ($dev, $sark) = @_;

    my $cmd = "sg_persist -n -o -G -S $sark -d $dev";
    my @out = qx { $cmd 2> /dev/null };
    my $err = ($?>>8);

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self (dev=$dev sark=$sark)\n";
	print "    cmd=$cmd\n";
	print "    err=$err\n";
    }

    return ($err);
}

sub do_register_ignore ($$)
{
    my ($dev, $sark) = @_;

    my $cmd = "sg_persist -n -o -I -S $sark -d $dev";
    my @out = qx { $cmd 2> /dev/null };
    my $err = ($?>>8);

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self (dev=$dev sark=$sark)\n";
	print "    cmd=$cmd\n";
	print "    err=$err\n";
    }

    return ($err);
}

sub do_reserve ($$)
{
    my ($dev, $rk) = @_;

    my $cmd = "sg_persist -n -o -R -T 5 -K $rk -d $dev";
    my @out = qx { $cmd 2> /dev/null };
    my $err = ($?>>8);

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self (dev=$dev rk=$rk)\n";
	print "    cmd=$cmd\n";
	print "    err=$err\n";
    }

    return ($err);
}

sub do_release ($$)
{
    my ($dev, $rk) = @_;

    my $cmd = "sg_persist -n -o -L -T 5 -K $rk -d $dev";
    my @out = qx { $cmd 2> /dev/null };
    my $err = ($?>>8);

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self (dev=$dev rk=$rk)\n";
	print "    cmd=$cmd\n";
	print "    err=$err\n";
    }

    return ($err);
}

sub do_preempt ($$$)
{
    my ($dev, $rk, $sark) = @_;

    my $cmd = "sg_persist -n -o -P -T 5 -K $rk -S $sark -d $dev";
    my @out = qx { $cmd 2> /dev/null };
    my $err = ($?>>8);

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self (dev=$dev rk=$rk sark=$sark)\n";
	print "    cmd=$cmd\n";
	print "    err=$err\n";
    }

    return ($err);
}

sub do_preempt_abort ($$$)
{
    my ($dev, $rk, $sark) = @_;

    my $cmd = "sg_persist -n -o -A -T 5 -K $rk -S $sark -d $dev";
    my @out = qx { $cmd 2> /dev/null };
    my $err = ($?>>8);

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self (dev=$dev rk=$rk sark=$sark)\n";
	print "    cmd=$cmd\n";
	print "    err=$err\n";
    }

    return ($err);
}

sub do_reset ($)
{
    my ($dev) = @_;

    my $cmd = "sg_turs $dev";
    my @out = qx { $cmd 2> /dev/null };
    my $err = ($?>>8);

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self (dev=$dev)\n";
	print "    cmd=$cmd\n";
	print "    err=$err\n";
    }

    return ($err);
}

sub get_options ()
{
    my @opts = ("d|device=s",
		"h|help",
		"k|key=s",
		"o|action=s",
		"s|strict",
		"t|test=s",
		"v|verbose");

    Getopt::Long::Configure ("no_auto_abbrev") or exit (1);
    Getopt::Long::GetOptions (\%options, @opts) or exit (1);

    return;
}

sub get_devices ()
{
    my @devices = split (/,/, $options{'d'});

    map { s/^\s+// } @devices;
    map { s/\s+$// } @devices;

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self\n";
    }

    return (@devices);
}

sub get_devices_clvm ()
{
    my @devices = ();

    my $cmd = "vgs" .
              " --noheadings" .
              " --sort pv_uuid" .
              " --options pv_name,vg_attr" .
              " --config 'global { locking_type=0 }'";

    my @out = qx { $cmd 2> /dev/null };
    my $err = ($?>>8);

    @devices = map { (split)[0] } grep { /c$/ } @out;

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self\n";
    }

    return (@devices);
}

sub get_devices_scsi ()
{
    my @devices = ();

    open (\*DIR, "/sys/block/") or die "$!\n";
    @devices = grep { /^sd/ } readdir (DIR);
    close (DIR);

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self\n";
    }

    return (@devices);
}

sub get_devices_name ($)
{
    my $dev = shift;
    my $name = basename ($dev);

    if (-l "/dev/mpath/$name") {
	$name = basename (readlink "/dev/mpath/$name");
    }

    $name = "/dev/$name";

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self (dev=$dev)\n";
	print "    name=$name\n";
    }

    return ($name);
}

sub get_devices_path ($)
{
    my $dev = shift;
    my $name = basename ($dev);
    my @path = ();

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self (dev=$dev)\n";
    }

    if (-d "/sys/block/$name/slaves/") {
	opendir (\*DIR, "/sys/block/$name/slaves/");
	@path = grep { !/^\./ } readdir (DIR);
	closedir (DIR);
    }

    if (scalar (@path) == 0) {
	push (@path, $name);
    }

    if ($path[0] =~ /^dm/) {
	@path = get_devices_path ("/dev/$path[0]");
    } else {
	@path = map { "/dev/$_" } @path;
	if (defined $options{'v'}) {
	    print "    path=[ @path ]\n";
	}
    }

    return (@path);
}

sub get_devices_info ($)
{
    my $dev = shift;
    my $name = basename ($dev);
    my @info = ();

    if (-e "/sys/block/$name/device/vendor") {
	open (\*FILE, "</sys/block/$name/device/vendor");
	chomp ($info[0] = <FILE>);
	close (FILE);
    }

    if (-e "/sys/block/$name/device/model") {
	open (\*FILE, "</sys/block/$name/device/model");
	chomp ($info[1] = <FILE>);
	close (FILE);
    }

    map { s/^\s+// } @info;
    map { s/\s+$// } @info;

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self (dev=$dev)\n";
	print "    info=[ @info ]\n";
    }

    return (@info);
}

sub get_keys_register ($)
{
    my $dev = shift;
    my @keys = ();

    my $cmd = "sg_persist -n -i -k -d $dev";
    my @out = qx { $cmd 2> /dev/null };
    my $err = ($?>>8);

    foreach (@out) {
	chomp;
	push (@keys, $_) if ($_ =~ s/^\s+0x//i);
    }

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self (dev=$dev)\n";
	print "    cmd=$cmd\n";
	print "    err=$err\n";
	print "    keys=[ @keys ]\n";
    }

    return (@keys);
}

sub get_keys_reserve
{
    my $dev = shift;
    my @keys = ();

    my $cmd = "sg_persist -n -i -r -d $dev";
    my @out = qx { $cmd 2> /dev/null };
    my $err = ($?>>8);

    foreach (@out) {
	chomp;
	push (@keys, $_) if ($_ =~ s/^\s+key=0x//i);
    }

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self (dev=$dev)\n";
	print "    cmd=$cmd\n";
	print "    err=$err\n";
	print "    keys=[ @keys ]\n";
    }

    return (@keys);
}

sub test_config_fence ()
{
    my $xml = XML::LibXML->new();
    my $file = "/etc/cluster/cluster.conf";
    my $tree = $xml->parse_file ($file);
    my $root = "//cluster/fencedevices/fencedevice";
    my $err = 0;

    my $xpath_agent = "count(${root}[\@agent='fence_scsi'])";

    if ($tree->findvalue ($xpath_agent) == 0) {
	$err = 1;
    }

    exit ($err);
}

sub test_config_nodes ()
{
    my $xml = XML::LibXML->new();
    my $file = "/etc/cluster/cluster.conf";
    my $tree = $xml->parse_file ($file);
    my $root = "//cluster/clusternodes/clusternode";
    my $err = 0;

    my $xpath_name = "count(${root}/\@name)";
    my $xpath_nodeid = "count(${root}/\@nodeid)";

    if ($tree->findvalue ($xpath_name) != $tree->findvalue ($xpath_nodeid)) {
	$err = 1;
    }

    exit ($err);
}

sub print_devices ()
{
    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self\n";
	foreach (@devices) {
	    print "    $_\n";
	}
    }

    return;
}

sub print_options ()
{
    return;
}

sub print_results ($)
{
    my $dev = shift;
    my @results = @{$results{$dev}};

    if (defined $options{'v'}) {
	$self = (caller(0))[3];
	print "  $self (dev=$dev)\n";
	print "    results=[ action=$results[0] verify=$results[1] ]\n";
    } else {
	printf ("  %-*s", $width, $_);
	if (grep { $_  } @results) {
	    $test = colored (" FAIL ", "red");
	} else {
	    $test = colored ("  OK  ", "green");
	}
	printf ("[%s]\n", $test);
    }

    return;
}

sub print_usage
{
    print "\n";
    print "Usage: fence_scsi_test -o <action> [options]\n";
    print "\n";
    print "Actions:\n";
    print "\n";
    print "  on                    Register <key> with the devices.\n";
    print "  off                   Remove <key> from the devices.\n";
    print "  clear                 Remove all registrations from the devices.\n";
    print "\n";
    print "Options:\n";
    print "\n";
    print "  -k, --key=VALUE       Key to use with current action.\n";
    print "  -d, --devices=LIST    Devices used for the current action.\n";
    print "  -s, --strict          Perform strict verification.\n";
    print "  -h, --help            Display this help and exit.\n";
    print "  -v, --verbose         Verbose mode.\n";
    print "\n";

    defined $options{'h'} ? exit (0) : exit (1);
}

################################################################################

get_options ();

if (scalar (keys %options) == 0) {
    print_usage ();
}

if (defined $options{'v'}) {
    print_options ();
}

if (defined $options{'h'}) {
    print_usage ();
}

if (defined $options{'t'}) {
    for ($options{'t'}) {
	($_ =~ /^fence$/i) && do {
	    test_config_fence ();
	    last;
	};
	($_ =~ /^nodes$/i) && do {
	    test_config_nodes ();
	    last;
	};
	exit (1);
    }
}

if ($options{'o'} !~ /^clear$/i) {
    if ($options{'k'} =~ /^[[:xdigit:]]+$/) {
	$node_key = lc ($options{'k'});
    } else {
	print_usage ();
    }
}

for ($options{'o'}) {
    ($_ =~ /^on$/i) && do {
	do_key_write ($node_key);
	last;
    };
    ($_ =~ /^off$/i) && do {
	do_key_read (\$host_key);
	last;
    };
    ($_ =~ /^clear/i) && do {
	do_key_read (\$host_key);
	last;
    };
    print_usage ();
}

if (defined $options{'d'}) {
    @devices = get_devices ();
} else {
    @devices = get_devices_clvm ();
}

if (scalar (@devices) == 0) {
    die "error: no devices found\n";
} else {
    $count = scalar (@devices);
    $width = (reverse sort { $a <=> $b } map { (length) + 8 } @devices)[0];
}

if (defined $options{'v'}) {
    print_devices ();
}

foreach (@devices) {
    if (! -e $_) {
	die "error: $_ does not exist\n";
    }
    if (! -b $_) {
	die "error: $_ is not a block device\n";
    }

    $devices_name{$_} = get_devices_name ($_);
    $devices_path{$_} = [ get_devices_path ($devices_name{$_}) ];
}

for ($options{'o'}) {
    ($_ =~ /^on$/i) && do {
	print "\n" if (!defined $options{'v'});
	foreach (@devices) {
	    $results{$_}[0] = do_action_on (@{$devices_path{$_}}, $_, $node_key);
	    $results{$_}[1] = do_verify_on (@{$devices_path{$_}}, $_, $node_key);
	    print_results ($_);
	}
	print "\n" if (!defined $options{'v'});
	last;
    };
    ($_ =~ /^off$/i) && do {
	print "\n" if (!defined $options{'v'});
	foreach (@devices) {
	    $results{$_}[0] = do_action_off ($devices_name{$_}, $node_key, $host_key);
	    $results{$_}[1] = do_verify_off ($devices_name{$_}, $node_key, $host_key);
	    print_results ($_);
	}
	print "\n" if (!defined $options{'v'});
	last;
    };
    ($_ =~ /^clear$/i) && do {
	print "\n" if (!defined $options{'v'});
	foreach (@devices) {
	    $results{$_}[0] = do_action_clear ($devices_name{$_}, $host_key);
	    $results{$_}[1] = do_verify_clear ($devices_name{$_}, $host_key);
	    print_results ($_);
	}
	print "\n" if (!defined $options{'v'});
	last;
    };
    print_usage ();
}
