Page MenuHomeClusterLabs Projects

fence_zvm.pl
No OneTemporary

fence_zvm.pl

#!/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="";
$REDHAT_COPYRIGHT="";
$BUILD_DATE="";
#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 " -o metadata print XML metadata for fence agent\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 print_metadata
{
print '<?xml version="1.0" ?>
<resource-agent name="fence_zvm" shortdesc="I/O Fencing agent for GFS on s390 and zSeries VM clusters" >
<longdesc>
fence_zvm is an I/O Fencing agent used on a GFS virtual machine in a s390 or zSeries VM cluster. It uses the s3270 program to log the specified virtual machine out of VM. For fence_zvm to execute correctly, you must have s3270 in your PATH.
</longdesc>
<vendor-url>http://www.ibm.com</vendor-url>
<parameters>
<parameter name="ipaddr" unique="1" required="1">
<getopt mixed="-a &lt;ip&gt;" />
<content type="string" />
<shortdesc lang="en">IP Address or Hostname</shortdesc>
</parameter>
<parameter name="userid" unique="1" required="1">
<getopt mixed="-u &lt;userid&gt;" />
<content type="string" />
<shortdesc lang="en">Userid of the virtual machine to fence</shortdesc>
</parameter>
<parameter name="passwd" unique="1" required="0">
<getopt mixed="-p &lt;password&gt;" />
<content type="string" />
<shortdesc lang="en">Login password or passphrase</shortdesc>
</parameter>
<parameter name="passwd_script" unique="1" required="0">
<getopt mixed="-S &lt;script&gt;" />
<content type="string" />
<shortdesc lang="en">Script to retrieve password</shortdesc>
</parameter>
<parameter name="help" unique="1" required="0">
<getopt mixed="-h" />
<content type="string" />
<shortdesc lang="en">Display help and exit</shortdesc>
</parameter>
</parameters>
<actions>
<action name="metadata" />
</actions>
</resource-agent>
';
}
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;
}
elsif ($name eq "action")
{
$opt_o = $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:Vo:") || fail_usage;
usage if defined $opt_h;
version if defined $opt_V;
fail_usage "Unkown parameter." if (@ARGV > 0);
if ((defined $opt_o) && ($opt_o =~ /metadata/i)) {
print_metadata();
exit 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();
if ((defined $opt_o) && ($opt_o =~ /metadata/i)) {
print_metadata();
exit 0;
}
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;

File Metadata

Mime Type
text/x-perl
Expires
Tue, Feb 25, 12:26 AM (22 h, 14 m)
Storage Engine
blob
Storage Format
Raw Data
Storage Handle
1462154
Default Alt Text
fence_zvm.pl (9 KB)

Event Timeline