#!/usr/bin/perl
# vim: set sw=4 ts=4 et : 

use strict;
use warnings;

## MAYBE set 'sane' PATH ??

$ENV{LANG} = 'C';
$ENV{LC_ALL} = 'C';
$ENV{LANGUAGE} = 'C';

#use Data::Dumper;

# globals
my $PROC_DRBD = "/proc/drbd";
my ($HOSTNAME) = (`uname -n` =~ /(\S+)/);
my $stderr_to_dev_null = 1;
my $watch = 0;
my %drbd;
my %minor_of_name;
my $DRBD_VERSION;
my @DRBD_VERSION;

my %xen_info;
my %virsh_info;

# sets $drbd{minor}->{name} (and possibly ->{ll_dev})
sub map_minor_to_resource_names()
{
	my @drbdadm_sh_status = `drbdadm sh-status`;
	my ($ll_res, $ll_dev, $ll_minor, $conf_res, $conf_vnr, $minor, $name, $vnr);

	for (@drbdadm_sh_status) {
		# volumes only present in >= 8.4
		# some things generated by drbdadm

		/^_conf_res_name=(.*)\n/	and $conf_res = $1, $name = $conf_res;
		/^_conf_volume=(\d+)\n/		and $conf_vnr = $1;

		/^_stacked_on=(.*?)\n/		and $ll_res = $1;
		# not always present:
		/^_stacked_on_device=(.*)\n/	and $ll_dev = $1;
		/^_stacked_on_minor=(\d+)\n/	and $ll_minor = $1;

		# rest generated by drbdsetup
		/^_minor=(.*?)\n/		and $minor = $1;
		/^_res_name=(.+?)\n/		and $name = $1;
		/^_volume=(\d+)\n/		and $vnr = $1;

		/^_sh_status_process/	or next;

		$drbd{$minor}{name} = $name;
		if (defined $conf_vnr) {
			# >= 8.4, append /volume to resource name.
			# If both are present, they should be the same.  But
			# just in case, prefer the kernel volume number, if it
			# is present and positive. Else, use the volume number
			# from the config.
			$drbd{$minor}{name} .= defined $vnr ? "/$vnr" : "/$conf_vnr";
		}
		$minor_of_name{$name} = $minor;
		$drbd{$minor}{ll_dev} = defined($ll_dev) ? $ll_minor : $ll_res
			if $ll_res;
	}

	# fix up hack for git versions 8.3.1 > x > 8.3.0:
	# _stacked_on_minor information is missing,
	# _stacked_on is resource name
	# may be defined (and reported) out of order.
	for my $i (keys %drbd) {
		next unless exists $drbd{$i}->{ll_dev};
		my $lower = $drbd{$i}->{ll_dev};
		next if $lower =~ /^\d+$/;
		next unless exists $minor_of_name{$lower};
		$drbd{$i}->{ll_dev} = $minor_of_name{$lower};
	}
	# fix up to be able to report "lower dev of:"
	for my $i (keys %drbd) {
		next unless exists $drbd{$i}->{ll_dev};
		my $lower = $drbd{$i}->{ll_dev};
		$drbd{$lower}->{ll_dev_of} = $i;
	}
}

sub ll_dev_info {
	my $i = shift;
	( "ll-dev of:", $i, $drbd{$i}{name} )
}

# sets $drbd{minor}->{state} and (and possibly ->{sync})
sub slurp_proc_drbd_or_exit() {
	unless (open(PD,$PROC_DRBD)) {
		print "drbd not loaded\n";
		exit 0;
	}

	$_=<PD>;
	my ($DRBD_VERSION) = /version: ([\d\.]+)/;
	@DRBD_VERSION = split(/\./, $DRBD_VERSION);
	my $minor;
	while (defined($_ = <PD>)) {
		chomp;
		/^ *(\d+):/ and do {
# skip unconfigured devices
			$minor = $1;
			if (/^ *(\d+): cs:Unconfigured/) {
				next
					unless exists $drbd{$minor}
				and exists $drbd{$minor}{name};
			}
			my $uc = /Unconfigured/ ? "." : undef;
			($drbd{$minor}{conn})   =  $uc || m{\bcs:(\w+)\b};
			($drbd{$minor}{role})   =  $uc || m{\bro:(\w+/\w+)\b};
			($drbd{$minor}{dstate}) =  $uc || m{\bds:(\w+/\w+)\b};
		};
		/^\t\[.*sync.ed:/ and do {
			$drbd{$minor}{sync} = $_;
		};
		/^\t[0-9 %]+oos:/ and do {
			$drbd{$minor}{sync} = $_;
		};
	}
	close PD;
	for (values %drbd) {
		$_->{conn} ||= "Unconfigured";
		$_->{role} ||= ".";
		$_->{dstate} ||= ".";
	}
}

sub abbreviate {
	my($w, $max) = @_;

	$max ||= 15;

# keep UPPERCase and a few lowercase characters.
	1 while length($w) > $max && $w =~ s/([a-z]+)[a-z]/$1/g;

	return substr($w, 0, $max);
}

# taking a sorted list of keys and a hash, produce a short output.
# eg. Connected(*)/WFConnection(alice)
sub shorten_list {
	my ($keys, $hash, $max) = @_;
	my %vals;
	my %vl;

	for my $k (@$keys) {
		$vals{ $hash->{$k} }{ $k }++;
		$vl{ $hash->{$k} }++;
	}


# only a single value? Fine!
#	return abbreviate($hash->{$keys->[0]}, 6) . "(*)"
	return $hash->{$keys->[0]} . "(" . (values %vl)[0] . "*)"
		if 1 == (keys %vals);

# only 1 or 2 keys, ie. 2 values? Fine, done.
	return join("/", map { abbreviate($hash->{$_}, 6); } @$keys)
		if (@$keys <= 2);

# get sorted counts.
	my @v = sort { $b <=> $a; } values %vl;

#print "=========", Dumper(\@v);
# use a wildcard if one element is 3 or more times used, and more often than every other.
	my ($wc_data) =
		(($v[0] >= 3) && ($v[0] != $v[1])) ?
		grep($vl{$_} == $v[0], keys %vl) : ();

	my @stg;
	my %done;
	push(@stg, abbreviate($wc_data, 4) . "(" . $v[0] . "*)"),
		$done{$wc_data}++
			if ($wc_data);

	for my $k2 (@$keys) {
		my $v = $hash->{$k2};
		next if $done{$v}++;

		push @stg, abbreviate($v, 4) .
			"(" . join(",", keys %{$vals{$v}} ) . ")";
	}
	return join("/", @stg);
}

sub slurp_drbdsetup() {
	unless (open(DS,"drbdsetup events2 --now --statistics |")) {
		print "drbdsetup not started\n";
		exit 0;
	}

    my(%later, $my_role);
    while (<DS>) {
        chomp;
        next unless s/^exists //;
        last if /^-$/; # EOD
        s/^([\w.-]+) name:([\w.-]+) //;
        my $what = $1;
        my $res = $2;
        my %f = map { split(/:/, $_, 2); } split(/ +/, $_);

        if ($what eq "resource" &&
                ($my_role = $f{'role'})) {
            $later{$res}{peers}{states}{$HOSTNAME} = $my_role;
            # local node is always connected
            $later{$res}{peers}{conns}{$HOSTNAME} = "Connected";
        } elsif ($what eq "connection") {
            my $p = $f{'conn-name'};
            my $cs= $f{'connection'};
            my $r = $f{'role'};
# Increase difference between "Connecting" and "Connected"
            $cs =~ s/^Connecting/'ing/;
            $later{$res}{peers}{states}{$p} = $r;
            $later{$res}{peers}{conns}{$p}  = $cs;
            $later{$res}{hosts}{$p}++;
        } elsif ($what eq "device") {
            my $minor = $f{minor};
            my $vol = $f{volume};
            $later{$res}{vol_minor}{$vol} = $minor;
            $later{$res}{peers}{dstates}{$HOSTNAME}  = $f{disk};
        } elsif ($what eq "peer-device") {
            my $n = $f{"conn-name"};
            $later{$res}{peers}{dstates}{$n} = $f{"peer-disk"};
        } else {
            warn("unknown key $what\n");
        }
    }


    for my $res2 (keys %later) {
        my @h = sort keys %{$later{$res2}{hosts}};
        my @h_incl = ($HOSTNAME, @h);
        my $vol_minor = $later{$res2}{vol_minor};
        my $peers = $later{$res2}{peers};

        for my $vol2 (keys %$vol_minor) {
            my $minor2 = $vol_minor->{$vol2};

            my $name = length($vol2) ? "$res2/$vol2" : $res2;
# create hash
            $drbd{$minor2}{name} = $name;
            my $v = $drbd{$minor2};


# role with local=first
            $v->{role} = join("/", $my_role,
                    shorten_list(\@h, $peers->{states}));
# role with all mixed together
            $v->{role} = shorten_list(\@h_incl, $peers->{states});

            $v->{dstate} = shorten_list(\@h_incl, $peers->{dstates});
            $v->{conn} = shorten_list(\@h_incl, $peers->{conns});
        }
    }

	close DS;
}


# sets $drbd{minor}->{pv_info}
sub get_pv_info()
{
	for (`pvs --noheadings --units g -o pv_name,vg_name,pv_size,pv_used`) {
		m{^\s*/dev/drbd(\d+)\s+(\S+)\s+(\S+)\s+(\S+)\s*$} or next;
		#  PV  VG  PSize  Used
		$drbd{$1}{pv_info} = { vg => $2, size => $3, used => $4 };
	}
}

sub pv_info
{
	my $t = shift;
	"lvm-pv:", @{$t}{qw(vg size used)};
}

# sets $drbd{minor}->{df_info}
sub get_df_info()
{
	for (`df -TPhl -x tmpfs`) {
		#  Filesystem  Type  Size  Used  Avail  Use%  Mounted  on
		m{^/dev/drbd(\d+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)} or next;
		$drbd{$1}{df_info} = { type => $2, size => $3, used => $4,
			avail => $5, use_percent => $6, mountpoint => $7 };
	}
}

sub df_info
{
	my $t = shift;
	@{$t}{qw(mountpoint type size used avail use_percent)};
}

# sets $drbd{minor}->{xen_info}
sub get_xen_info()
{
	my $dom;
	my $running = 0;
	my %i;
	for (`xm list --long`) {
		/^\s+\(name ([^)\n]+)\)/ and $dom = $1;
		/drbd:([^)\n]+)/ and $i{$minor_of_name{$1}}++;
		m{phy:/dev/drbd(\d+)} and $i{$1}++;
		/^\s+\(state r/ and $ hile failed peer, and should now adjust our
		# network settings during pre-notification of start of the other node.
		#
		# We usually get /post/ notification for ourself and the peer.
		# In both cases adjust should be a no-op.
		drbd_set_status_variables
		figure_out_drbd_peer_uname
		do_drbdadm $DRBD_TO_PEER -v adjust $DRBD_RESOURCE
		;;
	post/*)
		# After something has been done is a good time to
		# recheck our status:
		drbd_set_status_variables
		drbd_update_master_score

		: == DEBUG == ${DRBD_DSTATE_REMOTE[*]} ==
		case ${DRBD_DSTATE_REMOTE[*]} in
		*DUnknown*)
			# Still not communicating.
			# Maybe someone else is primary (too)?
			maybe_outdate_self
		esac
	esac

	return $OCF_SUCCESS
}

# "macro" to be able to give useful error messages
# on clone resource configuration error.
meta_expect()
{
	local what=$1 whatvar=OCF_RESKEY_CRM_meta_${1//-/_} op=$2 expect=$3
	local val=${!whatvar}
	if [[ -n $val ]]; then
		# [, not [[, or it won't work ;)
		[ $val $op $expect ] && return
	fi
	ocf_log err "meta parameter misconfigured, expected $what $op $expect, but found ${val:-unset}."
	exit $OCF_ERR_CONFIGURED
}

ls_stat_is_block_maj_147() {
	set -- $(command ls -L -l "$1" 2>/dev/null)
	[[ $1 = b* ]] && [[ $5 == 147,* ]]
}

check_crm_feature_set()
{
	set -- ${OCF_RESKEY_crm_feature_set//[!0-9]/ }
	local a=${1:-0} b=${2:-0} c=${3:-0}
	
	(( a > 3 )) ||
	(( a == 3 && b > 0 )) ||
	(( a == 3 && b == 0 && c > 0 )) ||
	ocf_log warn "You may be disappointed: This RA is intended for pacemaker 1.0 or better!"
}

drbd_validate_all () {
	DRBDADM="drbdadm"
	DRBDSETUP="drbdsetup"
	DRBD_HAS_MULTI_VOLUME=false

	# these will _exit_ if they don't find the binaries
	check_binary $DRBDADM
	check_binary $DRBDSETUP
	# XXX I really take cibadmin, sed, grep, etc. for granted.

	local VERSION DRBDADM_VERSION_CODE=0
	if VERSION="$($DRBDADM --version 2>/dev/null)"; then
		eval $VERSION
	fi
	if (( $DRBDADM_VERSION_CODE >= 0x080400 )); then
		DRBD_HAS_MULTI_VOLUME=true
	fi
	check_crm_feature_set

	# Check clone and M/S options.
	meta_expect clone-max -le 2
	meta_expect clone-node-max = 1
	meta_expect master-node-max = 1
	meta_expect master-max -le 2

	# Rather than returning $OCF_ERR_CONFIGURED, we sometimes return
	# $OCF_ERR_INSTALLED here: the local config may be broken, but some
	# other node may have a valid config.

	# check drbdconf plausibility
	case "$OCF_RESKEY_drbdconf" in
	"")
		# this is actually ok. drbdadm has its own builtin defaults.
		# but as long as we assign an explicit default above,
		# this cannot happen anyways.
		: ;;
	*[!-%+./0-9:=@A-Z_a-z]*)
		# no, I do not trust the configurable cib parameters.
		ocf_log err "drbdconf name must only contain [-%+./0-9:=@A-Z_a-z]"
		return $OCF_ERR_CONFIGURED
		;;
	*)
		# Check if we can read the configuration file.
		if [ ! -r "${OCF_RESKEY_drbdconf}" ]; then
			ocf_log err "Configuration file ${OCF_RESKEY_drbdconf} does not exist or is not readable!"
			return $OCF_ERR_INSTALLED
		fi
		DRBDADM="$DRBDADM -c $OCF_RESKEY_drbdconf"
	esac

	# check drbd_resource plausibility
	case "$OCF_RESKEY_drbd_resource" in
	"")
		ocf_log err "No resource name specified!"
		return $OCF_ERR_CONFIGURED
		