fence-agents 3.1.5-2ubuntu2 / usr / sbin / fence_zvm

#!/usr/bin/perl

use Getopt::Std;
use IPC::Open2;

my $ME = $0;

END {
  defined fileno STDOUT or return;
  close STDOUT and return;
  warn "$ME: failed to close standard output: $!\n";
  $? ||= 1;
}

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

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

#BEGIN_VERSION_GENERATION
$RELEASE_VERSION="3.1.5";
$BUILD_DATE="(built Mon Feb 6 23:36:23 UTC 2012)";
$REDHAT_COPYRIGHT="Copyright (C) Red Hat, Inc. 2004-2010 All rights reserved.";
#END_VERSION_GENERATION


$comm_program = s3270;
$debug = 0;
$max_loops = 10;

sub usage
{
    print "Usage:\n";  
    print "\n";
    print "$pname [options]\n";
    print "\n";
    print "Options:\n";
    print "  -a <ip>          IP address or hostname of the physical s390\n";
    print "  -h               usage\n";
    print "  -u <string>      userid of the virtual machine to fence\n";
    print "  -p <string>      Password\n";
    print "  -S <path>        Script to run to retrieve login password\n";
    print "  -q               quiet mode\n";
    print "  -r <devnum>      ipl device <devnum>\n";
    print "  -V               Version\n";

    exit 0;
}

sub fail
{
  ($msg)=@_;
  print "failed: " . $msg . "\n" unless defined $opt_q;
  exit 1;
}

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

sub version
{
  print "$pname $RELEASE_VERSION $BUILD_DATE\n";
  print "$REDHAT_COPYRIGHT\n" if ( $REDHAT_COPYRIGHT );

  exit 0;
}


sub do_read
{
    my($line);

    $line = <READ_H>;

    if ($debug)
    {
	my($l) = ($line);
	$l =~ s/\n//;
	print "read:  $l\n";
    }
    
    return $line;
}

sub do_write
{
    my($line) = @_;

    if ($debug)
    {
	my($l) = ($line);
	$l =~ s/\n//;
	print "write:  $l\n";	
    }

    print WRITE_H $line;
}


sub look_for
{
    my ($text, $found);
    $found = 0;
    ($text) = @_;
    &do_write("ascii\n");
    while(1){
	$_ = &do_read;
	last unless (/^data:/);
	$found = 1 if (/$text/);
    } 
    $_ = &do_read; 
    fail "error while looking for string '$text'." unless (/ok/);
    return $found;
}

sub in_cp_read_state
{
    my ($prev);
    $_ = "";
    &do_write("ascii\n");
    while (1){
	$prev = $_;
	$_ = &do_read;
	last unless (/^data:/);
    }
    $_ = &do_read;
    fail "error while looking for machine state." unless (/ok/);
    return 1 if ($prev =~ /CP READ/i);
    return 0;
}

sub send_wait
{ 
    &do_write("wait\n");
    $_ = &do_read;
    $_ = &do_read;
    if (/ok/){
	return 1;
    }
    return 0;
}

sub send_string
{
    my ($cmd);
    ($cmd) = @_;
    &do_write('string "' . $cmd . '\n"' . "\n");
    $_ = &do_read;
    $_ = &do_read;
    if (/ok/){
	return send_wait;
    }
    return 0;
}

sub send_cmd
{
    my ($cmd);
    ($cmd) = @_;
    &do_write($cmd . "\n");
    $_ = &do_read;
    $_ = &do_read;
    if (/ok/){
	return send_wait;
    }
    return 0;
}

sub wait_for_response
{
    my ($pass, $failure, $msg, $found, $loops);
    $loops = 0;
    $found = 0;
    ($pass, $failure, $msg) = @_;
    while (1){
      $loops = $loops + 1;
      fail "timed out waiting for '$pass'" if ($loops > $max_loops);
      &do_write("ascii\n");
      while(1){
        $_ = &do_read;
        chomp;
        last unless (/^data:/);
        $found = 1 if (/$pass/);
        if ($failure){
          fail("$msg '$_'") if (/$failure/);
        }
      }
      $_ = &do_read;
      fail "wait for response failed '$_'" unless (/ok/);
      last if $found;
      sleep 1;
    }
    return 0;
}

sub check_response
{
    ($action) = @_;
    $_ = &do_read;
    $_ = &do_read;
    fail "$action failed." unless (/ok/);
}

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;
        }

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

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

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

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

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

	      elsif ($name eq "passwd" )
        {
            $opt_p = $val;
        }
		elsif ($name eq "passwd_script" )
		{
			$opt_S = $val;
		}
	      elsif ($name eq "userid" )
        {
            $opt_u = $val;
        }

	else
        {
           print stderr "parse error: unknown option \"$opt\"\n";
           #> exit 2;
        }
    }
}

if (@ARGV > 0){
    getopts("a:hp:S:qr:u:V") || 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;

    if (defined $opt_S) {
        $pwd_script_out = `$opt_S`;
        chomp($pwd_script_out);
        if ($pwd_script_out) {
            $opt_p = $pwd_script_out;
        }
    }

    fail_usage "No '-p' or '-S' flag specified." unless defined $opt_p;
    fail_usage "No '-u' flag specified." unless defined $opt_u;

} else {
    get_options_stdin();

    fail "no IP address" unless defined $opt_a;
    fail "no userid" unless defined $opt_u;

    if (defined $opt_S) {
        $pwd_script_out = `$opt_S`;
        chomp($pwd_script_out);
        if ($pwd_script_out) {
            $opt_p = $pwd_script_out;
        }
    }

    fail "no password" unless defined $opt_p;
}

$pid = open2(READ_H, WRITE_H, "$comm_program 2>&1");
&do_write("connect $opt_a\n");
$_ = &do_read;
unless (/^U U U/){
    chomp;
    fail "communication program failed with '$_'.";
}
$_ = &do_read;
fail "couldn't connect to $opt_a." unless(/ok/);
send_wait or fail "couldn't start 3270 session on $opt_a.";
send_cmd "enter" or fail "couldn't reach logon prompt.";
look_for "Enter one of the following commands:" or fail "doesn't look like a login prompt\n";
send_string "logon $opt_u $opt_p norun here" or fail "couldn't login";
send_cmd "clear" or fail "couldn't send the clear command.";
send_string "#cp query userid";
wait_for_response(uc($opt_u),"Enter one of the following commands:", "logon failed");
fail "machine not in CP READ state" unless in_cp_read_state;
if (defined $opt_r){
    send_string "ipl $opt_r" or fail "couldn't send reboot command";
} else {
    send_string "stop" or fail "couldn't send stop command\n";
}
fail "command failed" if look_for "Unknown CP command";
if (defined $opt_r && !in_cp_read_state){
    send_string "#cp disc";
} else {
    &do_write("disconnect\n");
}
&do_write("quit\n");

print "success: booted userid $opt_u\n" unless defined $opt_q;

exit 0;