#!/usr/bin/perl 
$|=1;


use IO::Socket;
use IO::Select;
use IPC::Open3;
use Getopt::Std;

# WARNING!! Do not add code bewteen "#BEGIN_VERSION_GENERATION" and 
# "#END_VERSION_GENERATION"  It is generated by the Makefile

#BEGIN_VERSION_GENERATION
$FENCE_RELEASE_NAME="6.0.2.36";
$SISTINA_COPYRIGHT=("Copyright (C) Red Hat, Inc.  2004  All rights reserved.");
$BUILD_DATE="(built Thu Jan 29 12:30:32 EST 2009)";
#END_VERSION_GENERATION

# Get the program name from $0 and strip directory names
$_=$0;
s/.*\///;
my $pname = $_;


################################################################################
sub usage 
{
    print "Usage:\n";
    print "\n";
    print "$pname [options]\n";
    print "\n";
    print "Options:\n";
    print "  -a <ip>          IP address or hostname of RILOE card\n";
    print "  -h               usage\n";
    print "  -l <name>        Login name\n";
    print "  -n <num>         local port for stunnel (default 8888)\n";
    print "  -o <string>      Action: reboot (default), off, on or status\n";
    print "  -p <string>      Login password\n";
    print "  -q               quiet mode\n";
    print "  -V               version\n";
    print "  -v               verbose\n";
    exit 0;
}


sub diedie
{
    if (defined $stunnel_pid)
    {
       kill 9, $stunnel_pid;
       waitpid $stunnel_pid,0;
    }
    print STDERR "@_";
    exit 1;
}

sub sendsock
{
	my ($sock, $msg, $junk) = @_;

	print $sock $msg;
	if ($verbose)
	{
		chomp $msg;
		print "SEND: $msg\n" 
	}
}


# This will slurp up all the data on the socket.  If nothing is available after 10 seconds, the
# function will return all the data that has been read so far.  If $mode is defined, the function
# will return immediately following the initial packet terminator "<END_RIBCL/>"  The RILOE has
# a nasty timing issue.  The header packet must be sent, a reply recived and then the command
# packet needs to be sent before the riloe times out the command.  This takes on the order
# of seconds.  If the command times out, the connection through stunnel is broken.
#
# FIXME -- this feels like a kludge.  There has to be a better way to make this work.
#
sub receive_response
{
    my ($sock,$mode) = @_;
    $mode = 0 unless defined $mode;
    my $count=0;

    my $buffer = "";

    my $selector = IO::Select->new();
    $selector->add($sock);

    while (@ready = $selector->can_read(10))
    {
        my $buf;
        my $rd = sysread $sock, $buf, 512;

        diedie "sysread error: $!\n" if (!defined $rd);

    	print "READ:($rd,$mode) $buf\n" if ($verbose); 

        last unless ($rd);

        $buffer="$buffer$buf"; 

        # RIBCL VERSION=1.2
	last if ( $buffer =~ /<END_RIBCL\/>$/mi && $mode==1 );

        # RIBCL VERSION=2.0
	last if ( $buffer =~ /<\/RIBCL>$/mi && $mode==1 );
    }

    ### Determine version of RIBCL if not already defined
    if (!defined $ribcl_vers)
    {
        if ($buffer =~ /<RIBCL VERSION=\"([0-9.]+)\"/m)
        {
            $ribcl_vers=$1;
            print "ribcl_vers=$ribcl_vers\n" if ($verbose);
        }
	else
	{
            diedie "unable to detect RIBCL version\n";
	}
    }
    return $buffer;
}


sub chld_reaper
{
    if (waitpid($stunnel_pid, WNOHANG))
    {
        my $status = $?;
        print "REAPER: status $status on $stunnel_pid\n" if ($verbose);

        if ($status != 0 )
        {
            print STDERR "stunnel error\n" ;
    	    close_stunnel();
            exit 1;
	}
    }
}

sub pipe_reaper
{
    print STDERR "pipe error\n" ;
    kill 9, $stunnel_pid;
    waitpid($stunnel_pid, WNOHANG);
    close_stunnel();
    exit 1;
}

sub open_stunnel()
{
    if ( $stunnel_version == 3 )
    {
        # create an SSL tunnel.  By default, stunnel will background itself.
        # specying -f keeps it in the forground and makes it easy to identify and kill
        # later.  
        $cmd = "stunnel -d localhost:$localport -r $hostname -c -f ";
    }
    elsif ( $stunnel_version == 4 )
    {
        $cmd = "stunnel /dev/stdin";
    }
    else 
    {
        die "unkown stunnel version\n"; 
    }

    
    
    print "cmd: $cmd\n" if ($verbose);

    $stunnel_pid = open3(*CMD_IN, *CMD_OUT, *CMD_ERR, $cmd);

    $SIG{CHLD} = \&chld_reaper;
    $SIG{PIPE} = \&pipe_reaper;
    if ( $stunnel_version == 4 )
    {
        print CMD_IN  "foreground = yes\n";
        print CMD_IN  "client     = yes\n";
        print CMD_IN  "debug      = 7\n";
        print CMD_IN  "[443]\n";
        print CMD_IN  "accept     = $localport\n";
        print CMD_IN  "connect    = $hostname\n";
        close CMD_IN;
    }

    # give stunnel some time to startup.
     sleep 2;

}


sub close_stunnel()
{
    # clean up stunnel
    $SIG{CHLD}= 'DEFAULT';
    kill 9, "$stunnel_pid";

    $selector = IO::Select->new();
    $selector->add(*CMD_ERR, *CMD_OUT);

    while (@ready = $selector->can_read) 
    {
        foreach $fh (@ready) 
        {
            if (fileno($fh) == fileno(CMD_ERR)) 
            {
		# FIXME -- icky blocking read
                my $line = <CMD_ERR>;
                print "stunnel STDERR: $line" if ($verbose && defined $line);
            }
            else 
            {
		# FIXME -- icky blocking read
                my $line = <CMD_OUT>;
                print "stunnel STDOUT: $line" if ($verbose && defined $line);
            }
            $selector->remove($fh) if eof($fh);
        }
    }

    close(CMD_IN);
    close(CMD_OUT);
    close(CMD_ERR);

    waitpid $stunnel_pid,0;
}
sub open_socket()
{
    printf "Creating an ssl stunnel from localhost:$localport to $hostname\n" if $verbose;
    $socket = IO::Socket::INET->new(PeerAddr => 'localhost',
    				    PeerPort => $localport,
    				    Proto    => 'tcp',
				    Type	 => SOCK_STREAM) 
        or diedie "Can't connect to localhost:$localport: $@\n";

    return $socket;
}


sub power_off
{
    my $response = set_power_state ("N");
    my @response = split /\n/,$response;
    my $no_err=0;

    foreach my $line (@response)
    {
        if ($line =~ /MESSAGE='(.*)'/)
        {
            my $msg = $1;
            if ($msg eq "No error") 
            { 
		$no_err++;
                next; 
            }
	    elsif ($msg eq "Host power is already OFF.")
            {
                $agent_status = 0;
                print "warning: $msg\n" unless defined $quiet;
            }
            else
            {
                $agent_status = 1;
                print STDERR "error: $msg\n";
            }
        }
    }

    # There should be about 6 or more response packets on a successful
    # power off command.  
    if ($agent_status<0)
    {
        $agent_status= ($no_err<5) ? 1 : 0;
    } 

    return $agent_status;
}


sub power_on
{
    my $response = set_power_state ("Y");
    my @response = split /\n/,$response;
    my $no_err=0;

    foreach my $line (@response)
    {

        if ($line =~ /MESSAGE='(.*)'/)
        {
            my $msg = $1;
            if ($msg eq "No error") 
            { 
                $no_err++;
                next; 
            }
	    elsif ($msg eq "Host power is already ON.")
            {
                $agent_status = 0;
                print "warning: $msg\n" unless defined $quiet;
            }
            else
            {
                $agent_status = 1;
                print STDERR "error: $msg\n";
            }
        }
    }

    # There should be about 6 or more response packets on a successful
    # power on command.  
    if ($agent_status<0)
    {
        $agent_status= ($no_err<5) ? 1 : 0;
    } 

    return $agent_status;
}

sub power_status
{
    my $response = get_power_state ();
    my @response = split /\n/,$response;

    foreach my $line (@response)
    {
        if ($line =~ /MESSAGE='(.*)'/)
        {
            my $msg = $1;
            if ($msg eq "No error") 
            { 
                next; 
            }
            else
            {
                $agent_status = 1;
                print STDERR "error: $msg\n";
            }
        }
        # RIBCL VERSION=1.2   
        elsif ($line =~ /HOST POWER=\"(.*)\"/)
        {
           $agent_status = 0;
           print "power is $1\n";
        }

        # RIBCL VERSION=2.0   
        elsif ($line =~ /HOST_POWER=\"(.*)\"/)
        {
           $agent_status = 0;
           print "power is $1\n";
        }

    }

    return $agent_status;
}

sub set_power_state
{
    my $state = shift;
    my $response = "";

    if (!defined $state || ( $state ne "Y" && $state ne "N") )
    {
        diedie "illegal state\n";
    }

    ### Setup stunnel from localhost:$localport to $hostname ($hostname can be in hostname:port format)
    open_stunnel;

    $socket = open_socket;

    sendsock $socket, "<?xml version=\"1.0\"?>\r\n";
    $response = receive_response($socket,1);

    print "Sending power-o".(($state eq "Y")?"n":"ff")."\n" if ($verbose);

    if ($ribcl_vers < 2 )
    {
        sendsock $socket, "<RIBCL VERSION=\"1.2\">\n";
    }
    else
    {
        # It seems the firmware can't handle the <LOCFG> tag
        # RIBCL VERSION=2.0
        #> sendsock $socket, "<LOCFG VERSION=\"2.21\">\n";
        sendsock $socket, "<RIBCL VERSION=\"2.0\">\n";
    }
    sendsock $socket, "    <LOGIN USER_LOGIN = \"$username\" PASSWORD = \"$passwd\">\n";
    sendsock $socket, "        <SERVER_INFO MODE = \"write\">\n";
    sendsock $socket, "            <SET_HOST_POWER HOST_POWER = \"$state\"/>\n";
    sendsock $socket, "        </SERVER_INFO>\n";
    sendsock $socket, "    </LOGIN>\n";
    sendsock $socket, "</RIBCL>\n";
    # It seems the firmware can't handle the <LOCFG> tag
    # RIBCL VERSION=2.0
    #> sendsock $socket, "</LOCFG>\n" if ($ribcl_vers >= 2) ;

    $response = receive_response($socket);

    print "Closing connection\n" if ($verbose);
    close($socket);
    close_stunnel();

    return $response;
}

sub get_power_state
{
    my $response = "";

    ### Setup stunnel from localhost:$localport to $hostname ($hostname can be in hostname:port format)
    open_stunnel;

    $socket = open_socket;

    sendsock $socket, "<?xml version=\"1.0\"?>\r\n";
    $response = receive_response($socket,1);

    print "Sending get-status\n" if ($verbose);

    if ($ribcl_vers < 2 )
    {
        sendsock $socket, "<RIBCL VERSION=\"1.2\">\n";
    }
    else
    {
        # It seems the firmware can't handle the <LOCFG> tag
        # RIBCL VERSION=2.0
        #> sendsock $socket, "<LOCFG VERSION=\"2.21\">\n";
        sendsock $socket, "<RIBCL VERSION=\"2.0\">\n";
    }
    sendsock $socket, "    <LOGIN USER_LOGIN = \"$username\" PASSWORD = \"$passwd\">\n";
    sendsock $socket, "        <SERVER_INFO MODE = \"read\">\n";
    sendsock $socket, "            <GET_HOST_POWER_STATUS/>\n";
    sendsock $socket, "        </SERVER_INFO>\n";
    sendsock $socket, "    </LOGIN>\n";
    sendsock $socket, "</RIBCL>\n";
    # It seems the firmware can't handle the <LOCFG> tag
    # RIBCL VERSION=2.0
    #> sendsock $socket, "<\/LOCFG VERSION>\n" if ($ribcl_vers >= 2) ;

    $response = receive_response($socket);

    print "Closing connection\n" if ($verbose);
    close($socket);
    close_stunnel();
    
    return $response;
}

sub fail
{
    ($msg)=@_;
    print $msg unless defined $quiet;
    exit 1;
}


sub get_options_stdin
{
    my $opt;
    my $line = 0;
    while( defined($in = <>) )
    {
        $_ = $in;

        chomp;

        # strip leading and trailing whitespace
        s/^\s*//;
        s/\s*$//;

        # skip comments
        next if /^#/;

        $line+=1;
        $opt=$_;
        next unless $opt;

        ($name,$val)=split /\s*=\s*/, $opt;

        if ( $name eq "" )
        {
           print STDERR "parse error: illegal name in option $line\n";
           exit 2;
        }

        elsif ($name eq "action" )
        {
            $action = $val;
        }

        # DO NOTHING -- this field is used by fenced or stomithd
        elsif ($name eq "agent" ) { }

        # FIXME -- deprecated.  use "hostname" instead.
        elsif ($name eq "fm" )
        {
            (my $dummy,$hostname) = split /\s+/,$val;
            print STDERR "Depricated \"fm\" entry detected.  refer to man page.\n";
        }

        elsif ($name eq "hostname" )
        {
            $hostname = $val;
        }
        elsif ($name eq "localport" )
        {
            $localport = $val;
	}
        elsif ($name eq "login" )
        {
            $username = $val;
        }

	# FIXME -- deprecated residue of old fencing system
        elsif ($name eq "name" ) { }

        elsif ($name eq "passwd" )
        {
            $passwd = $val;
        }
        elsif ($name eq "verbose" )
        {
            $verbose = $val;
        }

        # FIXME should we do more error checking?  
        # Excess name/vals will be eaten for now
        else
        {
           fail "parse error: unknown option \"$opt\"\n";
           #> exit 2;
        }
    }
}

sub fail_usage
{
    ($msg)=@_;
    print STDERR $msg if $msg;
    print STDERR "Please use '-h' for usage.\n";
    exit 1;
}


sub version
{
  print "$pname $FENCE_RELEASE_NAME $BUILD_DATE\n";
  print "$SISTINA_COPYRIGHT\n" if ( $SISTINA_COPYRIGHT );

  exit 0;
}

# get stunnel version.  version 3.x of stunnel uses "-V" to print the version
# where as version 4.x uses "-version".  We must handle both cases to deal with
# stunnel's brokeness.
#open VER,"stunnel -V |" or 
sub get_stunnel_version
{
	$stunnel_pid = open3 (*CMD_IN,*CMD_OUT,*CMD_OUT,"stunnel -V") or
		die "open3 error: $!";

	while (<CMD_OUT>) 
	{
		if ($_ =~ /^stunnel (\d+)\..* on .*/)
		{
			$stunnel_version = $1;
		}
	}
	close CMD_IN;
	close CMD_OUT;
	$status = waitpid ($stunnel_pid,0);

	if ( $status != 0 )
	{
		$stunnel_pid = open3 (*CMD_IN,*CMD_OUT,*CMD_OUT,"stunnel -version") or
			die "open3 error: $!";
		while (<CMD_OUT>) 
		{
			if ($_ =~ /^stunnel (\d+)\..* on .*/)
			{
				$stunnel_version = $1;
			}
		}
		close CMD_IN;
		close CMD_OUT;
		$status = waitpid ($stunnel_pid,0);
	}
}


################################################################################
# MAIN

print STDERR "WARNING!  fence_rib is deprecated.  use fence_ilo instead\n";

# since we might be running tcsh and not a real shell where we can
# divert stderr, we'll just use sh.  hopefully it's really bash.
$_ = system "sh -c 'which stunnel > /dev/null 2>&1'";
diedie "stunnel not found\n" if $_;


$stunnel_version = 0;
get_stunnel_version();

$action = "reboot";

if (@ARGV > 0) {
   getopts("a:hl:n:o:p:qvV") || fail_usage ;

   usage if defined $opt_h;
   version if defined $opt_V;

   fail_usage "Unkown parameter." if (@ARGV > 0);

   fail_usage "No '-a' flag specified." unless defined $opt_a;
   $hostname = $opt_a;

   fail_usage "No '-l' flag specified." unless defined $opt_l;
   $username = $opt_l;

   fail_usage "No '-p' flag specified." unless defined $opt_p;
   $passwd   = $opt_p;

   $action = $opt_o if defined $opt_o;
   fail_usage "Unrecognised action '$action' for '-o' flag"
      unless $action=~ /^(off|on|reboot|status)$/;

   $localport = $opt_n if defined $opt_n;

   $quiet = 1 if defined $opt_q;

   $verbose = 1 if defined $opt_v;

} else {
   get_options_stdin();

   fail "no host\n" unless defined $hostname;
   fail "no login name\n" unless defined $username;
   fail "no password\n" unless defined $passwd;

   fail "unrecognised action: $action\n"
      unless $action=~ /^(off|on|reboot|status)$/;
}

$localport = 8888 unless defined ($localport);
$hostname = "$hostname:443" unless ($hostname =~ /:/);

$ribcl_vers = undef; # undef = autodetect

$agent_status = -1;


$_=$action;

if (/on/)
{
	power_on;
}
elsif (/off/)
{
	power_off;
}
elsif (/reboot/)
{
	power_off;
	diedie "power_off: unexpected error\n" if ($agent_status < 0);

	$agent_status = -1;
	power_on;
	diedie "power_on: unexpected error\n" if ($agent_status < 0);
}
elsif (/status/)
{
	power_status;
}
else
{
	diedie "illegal action: '$_'\n";
}

# $agent_status should have been set at this point.
diedie "unexpected error\n" if ($agent_status < 0);

if ($agent_status == 0)
{
    print "success\n" unless defined $quiet;
    exit 0
}
else
{
    print "failure\n" unless defined $quiet;
    exit 1
}


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