power_ilo.pm.in 15.1 KB
Newer Older
1 2 3
#!/usr/bin/perl -wT

#
4
# Copyright (c) 2008-2016 University of Utah and the Flux Group.
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
24 25 26
#

#
27
# Handle iLO[23] remote power control.
28
# Also handle DRAC since its so similar.
29 30 31 32 33 34
#
# Even though not that similar, also handle IPMI so that we
# can have per-node passwords not allowed by power_ipmi.
# "ipmi15" uses the IPMI 1.5 "lan" interface, "ipmi20" uses
# the IPMI 2.0 "lanplus" interface.
#
35
# Node must have an interface such that role='mngmnt' and
36
# interface_type='ilo[23]'.
37 38 39 40 41 42
#
# Supports either pubkey or passwd auth, depending on what's in db.
#

package power_ilo;

43 44 45
use strict;
use warnings;

46
use Exporter;
47
our @ISA = ("Exporter");
48
our @EXPORT = qw( iloctrl ilostatus );
49 50 51

use lib "@prefix@/lib";
use libdb;
52
use emutil;
53
use English;
54 55
use IO::Pty;
use POSIX qw(setsid);
56
use POSIX ":sys_wait_h";
57

Leigh Stoller's avatar
Leigh Stoller committed
58
my $debug = 0;
59 60
# Always parallelize for now cause we are vulnerable to timeouts with 
# unreachable nodes or weird iLO crap.
61
# NOTE: ipmi doesn't appear to be handled if $parallelize isn't set.
62
my $parallelize = 1;
63 64 65 66 67 68

# Turn off line buffering on output
$| = 1;

my %portinfo = ();

69 70 71 72 73 74
sub ilostatus($$@) {
    my ($type,$statusp,@nodes) = @_;

    return iloaction($type, "status", $statusp, @nodes);
}

75 76
#
# usage: iloctrl(type, cmd, nodes)
77
# type = { "ilo" | "ilo2" | "ilo3" | "drac" | "ipmi15" | "ipmi20" }
78
# cmd = { "forcecycle" | "cycle" | "on" | "off" | "status" }
79 80 81 82 83 84
# nodes = list of one or more physical node names
#
# Returns 0 on success. Non-zero on failure.
# 
sub iloctrl($$@) {
    my ($type,$cmd,@nodes) = @_;
85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103

    # XXX it would be useful to propagate the individual node status here too
    my %status = ();
    return iloaction($type, $cmd, \%status, @nodes);
}

#
# Internal command to do the work.
#
# usage: iloaction(type, cmd, status, nodes)
# type = { "ilo" | "ilo2" | "ilo3" | "drac" | "ipmi15" | "ipmi20" }
# cmd = { "forcecycle" | "cycle" | "on" | "off" | "status" }
# status = hash ref keyed by node with value of per-node return status
# nodes = list of one or more physical node names
#
# Returns 0 on success. Non-zero on failure.
# 
sub iloaction($$$@) {
    my ($type,$cmd,$statusp,@nodes) = @_;
104
    my $exitval = 0;
105
    my $force = 0;
106 107 108 109 110

    if ($debug) {
	print "iloctrl called with $type,$cmd,(" . join(',',@nodes) . ")\n";
    }

111 112 113
    if ($cmd eq "forcecycle") {
	$force = 1;
	$cmd = "cycle";
114
    } elsif ($cmd !~ /^(cycle|on|off|status)$/) {
115
	warn "invalid power command '$cmd'; \n" . 
116 117 118 119
	    "  valid commands are 'cycle, 'off', 'on', and 'status'.\n";
	foreach my $n (@nodes) {
	    $statusp->{$n} = -1;
	}
120 121 122 123 124 125 126 127
	return scalar(@nodes);
    }

    my %ilo_nodeinfo = ();

    # grab ilo IP and auth info
    foreach my $n (@nodes) {
	my $res = DBQueryFatal("select IP from interfaces" . 
128 129
			       " where node_id='$n' and ".
			       " role='" . TBDB_IFACEROLE_MANAGEMENT() . "'" . 
130 131
			       "   and interface_type='$type'");
	if (!defined($res) || !$res || $res->num_rows() == 0) {
132
	    warn "No $type interface for $n; cannot find $type IP!\n";
133
	    $statusp->{$n} = -1;
134 135 136 137 138
	    ++$exitval;
	    next;
	}
	my ($IP) = $res->fetchrow();

139 140 141
	# FIXED: Handle multiple rows here like power_ipmi.pm does.
	# This is so we can grab a kgkey separately from the user password.
	$res = DBQueryFatal("select key_role,key_uid,mykey,key_privlvl" . 
142 143 144 145
			    " from outlets_remoteauth" . 
			    " where node_id='$n' and key_type='$type'");
	if (!defined($res) || !$res || $res->num_rows() == 0) {
	    warn "No $type remote auth info for $n!\n";
146
	    $statusp->{$n} = -1;
147 148 149
	    ++$exitval;
	    next;
	}
150 151 152
	my ($krole,$kuid,$kkey,$kgkey,$kprivlvl);
	while (my $row = $res->fetchrow_hashref()) {
	    $krole = $row->{'key_role'};
Leigh Stoller's avatar
Leigh Stoller committed
153
	    if ($krole eq "ipmi-passwd" || $krole eq "ssh-key") {
154 155 156 157 158 159 160
		$kuid = $row->{'key_uid'};
		$kkey = $row->{'mykey'};
	        if ($row->{'key_privlvl'}) {
	            $kprivlvl = $row->{'key_privlvl'};
	        }
	    }
	    elsif ($krole eq "ipmi-kgkey") {
161 162 163 164 165 166 167 168
		#
		# XXX looks like we always need a user ID.
		# Not just for the check in ipmiexec, but for ipmitool too.
		# ipmitool seems to want both uid/password in addition to key,
		# otherwise it prompts for a password.
		#
		$kuid = $row->{'key_uid'};

169 170 171
		($kgkey = $row->{'mykey'}) =~ s/^0x//;
	        # NOTE: key_privlvl is currently ignored in case this is the
	        # only authentication mechanism being used.
172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188
	    }
	}

	if ($kgkey && $kkey) {
	    $krole = 'ipmi-kgkey-passwd';
	}
	elsif ($kgkey) {
	    $krole = 'ipmi-kgkey';
	    # restore previous behavior
	    $kkey = $kgkey;
	    $kgkey = undef;
	    $kprivlvl = undef;
	}
	else {
	    # all of the keys were empty which is weird and the last key_role
	    # returned from the db wins
	}
189

190
	$ilo_nodeinfo{$n} = [ $n,$IP,$krole,$kuid,$kkey,$kgkey,$kprivlvl ];
191 192
    }

193
    my $timeout = 30;
194 195
    if ($parallelize) {
	my $coderef = sub {
196
	    my ($n,$IP,$krole,$kuid,$kkey,$kgkey,$kprivlvl) = @{ $_[0] };
197 198 199
	    
	    my $tret;
	    eval {
200
		if ($type =~ /^ipmi/) {
201
		    $tret = ipmiexec($n,$type,$cmd,$IP,$krole,$kuid,$kkey,$kgkey,$kprivlvl,$timeout,$force);
202 203 204
		} else {
		    $tret = iloexec($n,$type,$cmd,$IP,$krole,$kuid,$kkey,$timeout);
		}
205 206 207 208
	    };
	    if ($@) {
		print "$@";
		return -1;
209
	    }
210
	    return $tret;
211 212 213 214 215 216 217
	};
	my @results = ();
	my @ilos    = values(%ilo_nodeinfo);
	
	if (ParRun(undef, \@results, $coderef, @ilos)) {
	    print STDERR "*** power_ilo: Internal error in ParRun()!\n";
	    return -1;
218
	}
219 220
	#
	# Check the exit codes. 
221
	# Is this awkward or what?
222
	#
223 224 225 226 227 228 229 230 231 232 233
	for (my $i = 0; $i < @ilos; $i++) {
	    my $n = $ilos[$i]->[0];
	    my $rv = ($results[$i] >> 8);
	    $statusp->{$n} = $rv;
	    if ($cmd eq "status") {
		$exitval++
		    if ($rv < 0);
	    } else {
		++$exitval
		    if ($rv != 0);
	    }
234
	}
235
    }
236 237
    else {
	for my $key (keys(%ilo_nodeinfo)) {
238
	    my ($n,$IP,$krole,$kuid,$kkey,$kgkey,$kprivlvl) = @{$ilo_nodeinfo{$key}};
239

240 241 242 243 244
	    my $rv;
	    if ($type =~ /^ipmi/) {
		$rv = ipmiexec($n,$type,$cmd,$IP,$krole,$kuid,$kkey,$kgkey,$kprivlvl,$timeout,$force);
	    } else {
		$rv = iloexec($n,$type,$cmd,$IP,$krole,$kuid,$kkey,$timeout);
245
	    }
246 247 248
	    $statusp->{$n} = $rv;
	    ++$exitval
		if ($rv < 0);
249 250 251 252 253 254
	}
    }
    return $exitval;
}

#
255
# Arguments: $node_id,$type,$cmd,$IP,$key_role,$key_uid,$key[,$timeout]
256 257
# on/off/cycle returns: 0 for success, < 0 otherwise
# status returns: 0 for off, 1 for on, -1 for error
258
#
259 260
sub iloexec($$$$$$$;$) {
    my ($node_id,$type,$cmd,$IP,$key_role,$key_uid,$key,$timeout) = @_;
261 262 263 264 265 266 267 268 269 270 271 272 273 274 275

    if ($debug) {
	print "iloexec called with (" . join(',',@_) . ")\n";
    }

    if (!defined($type) || !defined($cmd) || !defined($IP) 
	|| !defined($key_role) || !defined($key_uid) || !defined($key)) {
	warn "Incomplete argument list, skipping node" . 
	    (defined($node_id)?" $node_id":"");

	return -1;
    }

    my $power_cmd;
    if ($cmd eq 'cycle') {
276 277
	$power_cmd = ($type eq "drac" ?
		      'racadm serveraction powercycle' : 'power reset');
278 279
    }
    elsif ($cmd eq 'reset') {
280 281
	$power_cmd = ($type eq "drac" ?
		      'racadm serveraction hardreset' : 'power warm');
282 283
    }
    elsif ($cmd eq 'on') {
284 285
	$power_cmd = ($type eq "drac" ?
		      'racadm serveraction powerup' : 'power on');
286 287
    }
    elsif ($cmd eq 'off') {
288 289
	$power_cmd = ($type eq "drac" ?
		      'racadm serveraction powerdown' : 'power off');
290
    }
291 292 293 294
    elsif ($cmd eq 'status') {
	$power_cmd = ($type eq "drac" ?
		      'racadm serveraction powerstatus' : 'power');
    }
295 296 297 298 299
    else {
	warn "Bad iLO power command $cmd";
	return -11;
    }

300 301
    if ($type ne 'ilo' && $type ne 'ilo2' && $type ne 'ilo3' &&
	$type ne "drac") {
302
	warn "Unsupported iLO/DRAC type $type!";
303 304 305 306
	return -7;
    }

    my @expect_seq;
307
    my $ssh_cmd = "ssh -o StrictHostKeyChecking=no -l '$key_uid'";
308 309 310 311 312

    if ($key_role eq 'ssh-key') {
	if ($key ne '') {
	    $ssh_cmd .= " -i '$key'";
	}
313 314 315 316 317 318 319
	if ($type eq "drac") {
	    @expect_seq = (['\$ ',  $power_cmd],
			   ['\$ ',  'exit']);
	}
	else {
	    @expect_seq = (['hpiLO-> ',$power_cmd],['hpiLO-> ','exit']);
	}
320 321 322 323 324 325 326 327
    }
    elsif ($key_role eq 'ssh-passwd') {
	$ssh_cmd .= " -o PubkeyAuthentication=no";
	$ssh_cmd .= " -o PasswordAuthentication=yes";
	if ($key eq '') {
	    warn "iLO key_role ssh-passwd specified, but no passwd!";
	    return -13;
	}
328 329 330 331 332 333 334 335 336
	if ($type eq "drac") {
	    @expect_seq = (['password: ', $key],
			   ['\$ ',        $power_cmd],
			   ['\$ ',        'exit']);
	}
	else {
	    @expect_seq = (['password: ',$key],['hpiLO-> ',$power_cmd],
			   ['hpiLO-> ','exit']);
	}
337 338 339 340 341 342 343 344
    }
    else {
	warn "Unsupported key_role $key_role!";
	return -14;
    }

    $ssh_cmd .= " $IP";

345 346 347 348 349 350 351 352 353
    my $pid;
    my $sentall = 0;
    # Setup some signal handlers so we can avoid leaving ssh zombies.
    $SIG{'CHLD'} = sub { die "iloexec($node_id) child ssh died unexpectedly!"; };
    $SIG{'PIPE'} = sub { die "iloexec($node_id) ssh died unexpectedly!"; };
    if (defined($timeout)) {
	$SIG{'ALRM'} = sub {
	    $SIG{'PIPE'} = 'IGNORE';
	    $SIG{'CHLD'} = 'IGNORE';
354
	    kill('INT',$pid);
355
	    select(undef,undef,undef,0.1);
356
	    kill('TERM',$pid);
357
	    select(undef,undef,undef,0.1);
358
	    kill('KILL',$pid);
359 360 361 362 363 364
	    die "iloexec($node_id) timed out in ssh!";
	};

	alarm($timeout);
    }

365
    my $pty = IO::Pty->new() || die "can't make pty: $!";
366
    defined ($pid = fork()) || die "fork: $!";
367 368
    if (!$pid) {
	# Flip to UID 0 to ensure we can read whatever private key we need
369
	$UID = $EUID = 0;
370 371
	
	if ($debug) {
372
	    print "Flipped to root: $UID,$EUID\n";
373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390
	}

	# Connect our kid to the tty so the parent can chat through the pty
        POSIX::setsid();

	$pty->make_slave_controlling_terminal();

	my $tty = $pty->slave();
	my $tty_fd = $tty->fileno();
	close($pty);

	open(STDIN,"<&$tty_fd");
	open(STDOUT,">&$tty_fd");
	open(STDERR,">&STDOUT");
	close($tty);

	# Don't want ssh to prompt us via ssh-askpass!
	delete $ENV{DISPLAY};
391 392 393 394

	if ($debug) {
	    print "ssh_cmd($node_id): $ssh_cmd\n";
	}
395 396 397 398 399 400 401 402
	
	exec("$ssh_cmd") || die "exec: $!";
    }

    #
    # Talk to ssh over the pty: wait for expected output and send responses
    #
    my @lines = ();
403
    foreach my $es (@expect_seq) {
404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429
	my ($rval,$sval) = @$es;

	my $found = 0;
	my $line = '';
	while (1) {
	    my $char;
	    if (read($pty,$char,1) != 1) {
		warn "Error in read in iLO pseudo expect loop!\n";
		print "Had read the following lines:\n";
		foreach my $ln (@lines) {
		    print "  $ln\n";
		}
		last;
	    }
	    if ($char eq "\r" || $char eq "\n") {
		push @lines,$line;
		if ($debug) {
		    print "read '$line' while looking for '$rval'\n";
		}
		$line = '';
	    }
	    else {
		$line .= $char;
	    }

	    if ($line =~ /$rval$/) {
430 431
		print $pty $sval;
		print $pty ($type eq "ilo3" ? "\r" : "\r\n");
432 433 434 435 436 437 438 439 440 441 442 443 444 445
		if ($debug) {
		    print "sent '$sval'\n";
		}
		$found = 1;
		last;
	    }
	}

	if (!$found) {
	    # some sort of error; try to kill off ssh
	    kill(15,$pid);
	    return -16;
	}
    }
446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462
    # this is a race, but there's nothing better, because we want the remote 
    # side to see an appropriate exit so it frees its resources, so there is
    # a very miniscule chance that the connection could break and ssh could 
    # exit before we get here... but it seems unlikely.
    $SIG{'CHLD'} = 'IGNORE';

    # make sure the local ssh dies:
    my $i = 5;
    my $dead = 0;
    while (--$i) {
	my $ret = waitpid($pid,WNOHANG);
	if ($ret == -1 || $ret == $pid) {
	    $dead = 1;
	    last;
	}
	sleep(1);
    }
463
    kill('KILL',$pid) if (!$dead);
464

465 466 467 468 469 470 471 472 473 474 475 476 477
    if ($cmd eq "status") {
	foreach my $line (@lines) {
	    if ($line =~ /server power is currently:\s+(\S+)/) {
		return ($1 eq "Off") ? 0 : 1;
	    }
	}
	print "iLO unexpected power status:\n";
	foreach my $line (@lines) {
	    print "'$line'\n";
	}
	return -1;
    }

478 479 480 481
    # if we get here, things probably went ok...
    return 0;
}

482
#
483
# Arguments: $node_id,$type,$cmd,$IP,$key_role,$key_uid,$key[,$kgkey,$privlvl,$timeout]
484 485
# on/off/cycle returns: 0 for success, <0 on error
# status returns: 0 for off, 1 for on, <0 for error
486
#
487 488
sub ipmiexec($$$$$$$;$$$$) {
    my ($node_id,$type,$cmd,$IP,$key_role,$key_uid,$key,$kgkey,$privlvl,$timeout,$force) = @_;
489 490 491 492 493 494 495 496 497 498 499 500 501

    if ($debug) {
	print "ipmiexec called with (" . join(',',@_) . ")\n";
    }

    if (!defined($type) || !defined($cmd) || !defined($IP) 
	|| !defined($key_role) || !defined($key_uid) || !defined($key)) {
	warn "Incomplete argument list, skipping node" . 
	    (defined($node_id)?" $node_id":"");

	return -1;
    }

502
    if ($cmd =~ /^(cycle|reset|on|off|status)$/) {
503 504 505 506 507 508 509
	$cmd = $1;
    }
    else {
	warn "Bad IPMI power command $cmd";
	return -11;
    }

510
    my ($iface,$pwdmax,$usekey);
511 512
    if ($type eq 'ipmi15') {
	$iface = "lan";
513
	$pwdmax = 15;
514 515
    } elsif ($type eq 'ipmi20') {
	$iface = "lanplus";
516
	$pwdmax = 20;
517 518 519 520 521
    } else {
	warn "Unsupported IPMI type $type!";
	return -7;
    }

522 523
    if ($key_role eq 'ipmi-passwd') {
	$usekey = 0;
524 525
    } elsif ($key_role eq 'ipmi-kgkey-passwd') {
        $usekey = 1;
526 527 528 529 530 531
    } elsif ($key_role eq 'ipmi-kgkey') {
	if ($type eq 'ipmi15') {
	    warn "Cannot use key_role 'kgkey' for IPMI 1.5!";
	    return -21;
	}
	$usekey = 1;
532
	$kgkey = $key;
533
    } else {
534 535 536 537 538 539 540
	warn "Unsupported IPMI key_role $key_role!";
	return -14;
    }

    # XXX IPMI takes about 40 seconds to timeout and doesn't
    # have an option to control?!

541
again:
542
    my $privlvl_args = ($privlvl) ? " -L $privlvl" : '';
543
    my $ipmicmd = "ipmitool -I $iface -H $IP -U $key_uid $privlvl_args -E -K power $cmd";
544 545 546 547 548
    print "*** Executing '$ipmicmd', output:\n"
	if ($debug > 1);

    # Set the password and key environment variables
    $ENV{'IPMI_PASSWORD'} = substr($key, 0, $pwdmax);
549
    $ENV{'IPMI_KGKEY'} = $kgkey
550 551
	if ($usekey);

552
    my $output = `$ipmicmd 2>&1`;
553
    my $stat = ($? >> 8);
554 555 556 557 558

    # And clear them again
    delete $ENV{'IPMI_PASSWORD'};
    delete $ENV{'IPMI_KGKEY'};

559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575
    #
    # XXX check for failured due to power cycle of a node that is turned off
    # and turn it on if desired.
    #
    if ($stat && $cmd eq "cycle" &&
	$output =~ /Command not supported in present state/) {
	if ($force) {
	    print "*** Cycle failed, trying power on instead.\n"
		if ($debug > 1);
	    $cmd = "on";
	    $force = 0;
	    goto again;
	}
	# XXX we should maybe do a POWEROFF state transition here?
	$output = "Node is powered off, use 'power on' instead.\n";
    }

576
    if ($stat || $debug > 1) {
577 578
	print "*** '$ipmicmd' failed (stat=$stat):\n"
	    if ($stat);
579 580 581
	print $output;
    }

582 583 584 585 586 587 588 589 590 591
    if (!$stat && $cmd eq "status") {
	if ($output =~ /power is (off|on)/i) {
	    return ($1 eq "off") ? 0 : 1;
	}
	print "IPMI unexpected power status:\n";
	print $output;
	return -1;
    }

    return ($stat ? -1 : 0);
592 593
}

594
1;
595 596 597 598

# vim: set ft=perl et sw=4 ts=8:
# Not sure what the (no)et sw=? ts=? rules should be in this file - they're kind of mixed.
# Seems like a leading tab in some places and then 4 expanded spaces.  Maybe et sw=4 ts=8.