arif/xcat-core
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
xcat-core/xCAT-server/lib/perl/xCAT/IPMI.pm
jbjohnso 9f8c5f7998 It was discovered that the strategy to jump software ids, while effective, had the side effect of invalidating reservations 
This means that initial SDR download would usually fail on implementations that consider reservations in such a manner.
Back out the incrementing software id behavior and instead bump retry interval back up to mitigate risk of wraparound
on retries.

git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/branches/2.7@14127 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd
2012-10-25 19:26:46 +00:00

964 lines
39 KiB
Perl
Raw Blame History

#!/usr/bin/perl
# IBM(c) 2107 EPL license http://www.eclipse.org/legal/epl-v10.html
#(C)IBM Corp
#modified by jbjohnso@us.ibm.com
#This module abstracts the session management aspects of IPMI
package xCAT::IPMI;
use Carp qw/confess cluck/;
BEGIN
{
$::XCATROOT = $ENV{'XCATROOT'} ? $ENV{'XCATROOT'} : '/opt/xcat';
}
use lib "$::XCATROOT/lib/perl";
use strict;
use warnings "all";
use Time::HiRes qw/time/;
use IO::Socket::INET qw/!AF_INET6 !PF_INET6/;
my $initialtimeout=0.809;
use constant STATE_OPENSESSION=>1;
use constant STATE_EXPECTINGRAKP2=>2;
use constant STATE_EXPECTINGRAKP4=>3;
use constant STATE_ESTABLISHED=>4;
#my $ipmidbg;
#open($ipmidbg,">","/tmp/ipmidbg");
#sub dprint {
# return;
# my $self = shift;
# foreach (@_) {
# foreach (split /\n/,$_) {
# print $ipmidbg $self->{bmc}.": ".$_."\n";
# }
# }
#}
my $doipv6=eval {
require Socket6;
require IO::Socket::INET6;
IO::Socket::INET6->import();
1;
};
use IO::Select;
#use Data::Dumper;
use Digest::MD5 qw/md5/;
my $pendingpackets=0;
my $maxpending; #determined dynamically based on rcvbuf detection
my $ipmi2support = eval {
require Digest::SHA1;
Digest::SHA1->import(qw/sha1/);
require Digest::HMAC_SHA1;
Digest::HMAC_SHA1->import(qw/hmac_sha1/);
1;
};
my $aessupport;
if ($ipmi2support) {
$aessupport = eval {
require Crypt::Rijndael;
require Crypt::CBC;
1;
};
}
sub hexdump {
foreach (@_) {
printf "%02X ",$_;
}
print "\n";
}
my %payload_types = ( #help readability in certain areas of code by specifying payload by name rather than number
'ipmi' => 0,
'sol' => 1,
'rmcpplusopenreq' => 0x10,
'rmcpplusopenresponse' => 0x11,
'rakp1' => 0x12,
'rakp2' => 0x13,
'rakp3' => 0x14,
'rakp4' => 0x15,
);
my $socket; #global socket for all sessions to share. Fun fun
my $select = IO::Select->new();
my %bmc_handlers; #hash from bmc address to a live session management object.
#only one allowed at a time per bmc
my %sessions_waiting; #track session objects that may want to retry a packet, value is timestamp to 'wake' object for retransmit
sub new {
my $proto = shift;
my $class = ref $proto || $proto;
my $self = {};
bless $self,$class;
my %args = @_;
unless ($ipmi2support) {
$self->{ipmi15only} = 1;
}
unless ($args{'bmc'} and defined $args{'userid'} and defined $args{'password'}) {
$self->{error}="bmc, userid, and password must be specified";
return $self;
}
foreach (keys %args) { #store all passed parameters
$self->{$_} = $args{$_};
}
unless ($args{'port'}) { #default to port 623 unless specified
$self->{'port'} = 623;
}
unless ($socket) {
if ($doipv6) {
$socket = IO::Socket::INET6->new(Proto => 'udp');
} else {
$socket = IO::Socket::INET->new(Proto => 'udp');
}
if (-r "/proc/sys/net/core/rmem_max") { # we can detect the maximum allowed socket, read it.
my $sysctl;
open ($sysctl,"<","/proc/sys/net/core/rmem_max");
my $maxrcvbuf=<$sysctl>;
my $rcvbuf = $socket->sockopt(SO_RCVBUF);
if ($maxrcvbuf > $rcvbuf) {
$socket->sockopt(SO_RCVBUF,$maxrcvbuf/2);
}
$maxpending=$maxrcvbuf/1500; #probably could have maxpending go higher, but just go with typical MTU as a guess
} else { #We do not have a way to determine how high we could set RCVBUF, so read the current value and run with it
my $rcvbuf = $socket->sockopt(SO_RCVBUF);
$maxpending=$rcvbuf/1500; #probably could have maxpending go higher, but just go with typical MTU as a guess
}
$select->add($socket);
}
my $bmc_n;
my ($family, $socktype, $protocol, $saddr, $name, $ip, $service);
if ($doipv6) {
($family, $socktype, $protocol, $saddr, $name) = Socket6::getaddrinfo($self->{bmc},623,AF_UNSPEC,SOCK_DGRAM,0);
($ip,$service) = Socket6::getnameinfo($saddr,Socket6::NI_NUMERICHOST());
}
unless ($saddr or $bmc_n = inet_aton($self->{bmc})) {
$self->{error} = "Could not resolve ".$self->{bmc}." to an address";
return $self;
}
if ($ip and $ip =~ /::ffff:\d+\.\d+\.+\d+\.\d+/) {
$ip =~ s/::ffff://;
} elsif (not $ip and $bmc_n) {
$ip = inet_ntoa($bmc_n);
}
$bmc_handlers{$ip}=$self;
if ($saddr) {
$self->{peeraddr} = $saddr;
} else {
$self->{peeraddr} = sockaddr_in($self->{port},$bmc_n);
}
$self->init();
return $self;
}
sub login {
my $self = shift;
my %args = @_;
if ($self->{logged}) {
$args{callback}->("SUCCESS",$args{callback_args});
return;
}
$self->{onlogon} = $args{callback};
$self->{onlogon_args} = $args{callback_args};
$self->{logontries}=5;
$self->get_channel_auth_cap();
}
sub logout {
my $self = shift;
my %args = @_;
$self->{onlogout} = $args{callback};
$self->{onlogout_args} = $args{callback_args};
unless ($self->{logged}) {
if ( $self->{onlogout}) { $self->{onlogout}->("SUCCESS",$self->{onlogout_args}); }
return;
}
$self->{noretry}=1;
$self->subcmd(netfn=>0x6,command=>0x3c,data=>$self->{sessionid},callback=>\&logged_out,callback_args=>$self);
$self->{logged}=0; #seeing as how we are going to take it on faith the logout happened, do the callback now
if ( $self->{onlogout}) {
$self->{onlogout}->("SUCCESS",$self->{onlogout_args});
}
}
sub logged_out {
return;
my $rsp = shift;
my $self = shift;
if (defined $rsp->{code} and $rsp->{code} == 0) {
$self->{logged}=0;
if ( $self->{onlogout}) {
$self->{onlogout}->("SUCCESS",$self->{onlogout_args});
}
} else {
if ( $self->{onlogout}) {
$self->{onlogout}->("ERROR:",$self->{onlogout_args});
}
}
}
sub get_channel_auth_cap { #implement special case for session management command
my $self = shift;
if (defined $self->{ipmi15only}) {
$self->subcmd(netfn=>0x6,command=>0x38,data=>[0x0e,0x04],callback=>\&got_channel_auth_cap,callback_args=>$self);
} else {
$self->subcmd(netfn=>0x6,command=>0x38,data=>[0x8e,0x04],callback=>\&got_channel_auth_cap,callback_args=>$self);
}
#0x8e, set bit to signify recognition of IPMI 2.0 and request channel 'e', current.
#0x04, request administrator privilege
}
sub get_session_challenge {
my $self = shift;
my @user;
if ($self->{userbytes}) {
@user = @{$self->{userbytes}};
} else {
@user = unpack("C*",$self->{userid});
for (my $i=scalar @user;$i<16;$i++) {
$user[$i]=0;
}
$self->{userbytes} = \@user;
}
$self->subcmd(netfn=>0x6,command=>0x39,data=>[2,@user],callback=>\&got_session_challenge,callback_args=>$self); #we only support MD5, we would have errored out if not supported
}
sub got_session_challenge {
my $rsp = shift;
my $self = shift;
my @data = @{$rsp->{data}};
my %localcodes = ( 0x81 => "Invalid user name", 0x82 => "null user disabled" );
my $code = $rsp->{code}; #just to save me some typing
if ($code) {
my $errtxt = sprintf("ERROR: Get challenge failed with %02xh",$code);
if ($localcodes{$code}) {
$errtxt .= " ($localcodes{$code})";
} #TODO: generic codes
$self->{onlogon}->($errtxt, $self->{onlogon_args});
return;
}
$self->{sessionid} = [splice @data,0,4];
$self->{authtype}=2; #switch to auth mode
$self->activate_session(@data);
}
sub activate_session {
my $self = shift;
my @challenge = @_;
my @data = (2,4,@challenge,1,0,0,0);
$self->subcmd(netfn=>0x6,command=>0x3a,data=>\@data,callback=>\&session_activated,callback_args=>$self);
}
sub session_activated {
my $rsp = shift;
my $self = shift;
my $code = $rsp->{code}; #just to save me some typing
my %localcodes = (
0x81 => "No available login slots",
0x82 => "No available login slots for ".$self->{userid},
0x83 => "No slot available as administrator",
0x84 => "Session sequence number out of range",
0x85 => "Invalid session ID",
0x86 => $self->{userid}. " is not allowed to be Administrator or Administrator not allowed over network",
);
if ($code) {
my $errtxt = sprintf("ERROR: Unable to log in to BMC due to code %02xh",$code);
if ($localcodes{$code}) {
$errtxt .= " ($localcodes{$code})";
}
$self->{onlogon}->($errtxt, $self->{onlogon_args});
return;
}
if ($rsp->{error}) {
$self->{onlogon}->($rsp->{error}, $self->{onlogon_args});
return;
}
my @data = @{$rsp->{data}};
$self->{sessionid} = [splice @data,1,4];
$self->{sequencenumber}=$data[1]+($data[2]<<8)+($data[3]<<16)+($data[4]<<24);
$self->{sequencenumberbytes} = [splice @data,1,4];
$self->set_admin_level();
}
sub set_admin_level {
my $self= shift;
$self->subcmd(netfn=>0x6,command=>0x3b,data=>[4],callback=>\&admin_level_set,callback_args=>$self);
}
sub admin_level_set {
my $rsp = shift;
my $self = shift;
my %localcodes = (
0x80 => $self->{userid}." is not allowed administrator access",
0x81 => "This user or channel is not allowed administrator access",
0x82 => "Cannot disable User Level authentication",
);
my $code = $rsp->{code};
if ($code) {
my $errtxt = sprintf("ERROR: Failed requesting administrator privilege %02xh",$code);
if ($localcodes{$code}) {
$errtxt .= " (".$localcodes{$code}.")";
}
$self->{onlogon}->($errtxt,$self->{onlogon_args});
} else {
$self->{logged}=1;
$self->{onlogon}->("SUCCESS",$self->{onlogon_args});
}
}
sub got_channel_auth_cap {
my $rsp = shift;
my $self = shift;
if ($rsp->{error}) {
$self->{onlogon}->("ERROR: ".$rsp->{error}, $self->{onlogon_args});
return;
}
my $code = $rsp->{code}; #just to save me some typing
if ($code == 0xcc and not defined $self->{ipmi15only}) { #ok, most likely a stupid ipmi 1.5 bmc
$self->{ipmi15only}=1;
return $self->get_channel_auth_cap();
}
if ($code != 0) {
$self->{onlogon}->("ERROR: Get channel capabilities failed with $code", $self->{onlogon_args});
return;
}
my @data = @{$rsp->{data}};
$self->{currentchannel} = $data[0];
if (($data[1] & 0b10000000) and ($data[3] & 0b10)) {
$self->{ipmiversion} = '2.0';
}
if ($self->{ipmiversion} eq '1.5') {
unless ($data[1] & 0b100) {
$self->{onlogon}->("ERROR: MD5 is required but not enabeld or available on target BMC",$self->{onlogon_args});
}
$self->get_session_challenge();
} elsif ($self->{ipmiversion} eq '2.0') { #do rmcp+
$self->open_rmcpplus_request();
}
}
sub open_rmcpplus_request {
my $self = shift;
$self->{'authtype'}=6;
unless ($self->{localsid}) { $self->{localsid}=358098297; } #this is an arbitrary number of no significance
$self->{localsid}+=1; #new session ID if we are relogging
my @sidbytes = unpack("C4",pack("N",$self->{localsid}));
$self->{sidm} = \@sidbytes;
unless ($self->{rmcptag}) { $self->{rmcptag} = 1; }
$self->{rmcptag}+=1;
my @payload = ($self->{rmcptag},#message tag,
0, #requested privilege role, 0 is highest allowed
0,0, #reserved
@sidbytes,
0,0,0,8,1,0,0,0, #table 13-17, request sha
1,0,0,8,1,0,0,0); #sha integrity
if ($aessupport) {
push @payload,(2,0,0,8,1,0,0,0);
} else {
push @payload,(2,0,0,8,0,0,0,0);
}
$self->{sessionestablishmentcontext} = STATE_OPENSESSION;
$self->sendpayload(payload=>\@payload,type=>$payload_types{'rmcpplusopenreq'});
}
sub checksum {
my $self = shift;
my $sum = 0;
foreach(@_) {
$sum += $_;
}
$sum = ~$sum + 1;
return($sum&0xff);
}
sub subcmd {
my $self = shift;
my %args = @_;
my $rsaddr=0x20; #figrue 13-4, rssa by old code
my @rnl = ($rsaddr,$args{netfn}<<2);
my @rest = ($self->{rqaddr},$self->{seqlun},$args{command},@{$args{data}});
my @payload=(@rnl,$self->checksum(@rnl),@rest,$self->checksum(@rest));
$self->{ipmicallback} = $args{callback};
$self->{ipmicallback_args} = $args{callback_args};
my $type = $payload_types{'ipmi'};
if ($self->{integrityalgo}) {
$type = $type | 0b01000000; #add integrity
}
if ($self->{confalgo}) {
$type = $type | 0b10000000; #add secrecy
}
$self->sendpayload(payload=>\@payload,type=>$type,delayxmit=>$args{delayxmit});
}
sub waitforrsp {
my $self=shift;
my %args=@_;
my $data;
my $peerport;
my $peerhost;
my $timeout; #TODO: code to scan pending objects to find soonest retry deadline
my $curtime=time();
if (defined $args{timeout}) { $timeout = $args{timeout}; }
foreach (keys %sessions_waiting) {
if (defined $timeout and $timeout == 0) { last; } #once we get to zero, then there is no lower and anything else is a waste
if ($sessions_waiting{$_}->{timeout} <= $curtime) {
$timeout=0; #this waitforrsp must go as quickly to retry as possible, but give it a chance this iteration to clear without timedout being called
#if something defferred entry into waitforrsp so long that there was no chance to check for response, this grants at least one shot at getting data
}
if (defined $timeout) {
if ($timeout < $sessions_waiting{$_}->{timeout}-$curtime) {
next;
}
}
$timeout = $sessions_waiting{$_}->{timeout}-$curtime;
}
unless (defined $timeout) {
return scalar (keys %sessions_waiting);
}
if ($select->can_read($timeout)) {
while ($select->can_read(0)) {
my @ipmiq=();
while ($select->can_read(0)) {
$peerport = $socket->recv($data,1500,0);
push @ipmiq,[$peerport,$data];
}
while (@ipmiq) {
my $datagram = shift @ipmiq;
($peerport,$data) = @$datagram;
route_ipmiresponse($peerport,unpack("C*",$data));
while ($select->can_read(0)) {
$peerport = $socket->recv($data,1500,0);
push @ipmiq,[$peerport,$data];
}
}
}
}
foreach (keys %sessions_waiting) { #now that we have given all incoming packets a chance, if some sessions were past due when we entered
#take timeout response action now
if ($sessions_waiting{$_}->{timeout} <= $curtime) {
my $session = $sessions_waiting{$_}->{ipmisession};
delete $sessions_waiting{$_};
$pendingpackets-=1;
$session->timedout();
next;
}
}
return scalar (keys %sessions_waiting);
}
sub timedout {
my $self = shift;
unless (ref $self->{pendingargs}) {
return;
}
$self->{nowait}=1;
$self->{timeout} = $self->{timeout}*1.5;
if ($self->{noretry}) { return; }
if ($self->{timeout} > 7) { #giveup, really
$self->{timeout}=$initialtimeout;
my $rsp={};
$rsp->{error} = "timeout";
$self->{ipmicallback}->($rsp,$self->{ipmicallback_args});
$self->{nowait}=0;
return;
}
if ($self->{sessionestablishmentcontext} == STATE_OPENSESSION) { #in this particular case, we want to craft a new rmcp session request with a new client side session id, to aid in distinguishing retry from new
$self->open_rmcpplus_request();
#experimintation has showed rakp1 and 3 are best done with a straightforward retry, not something fancy...
#stale rakp3 in a ipmi2 implementation that can't handle it will be detected through rmcp status code rather than assuming we must start over.
} elsif ($self->{sessionestablishmentcontext} == STATE_EXPECTINGRAKP2) { #in this particular case, we want to craft a new rmcp session request with a new client side session id, to aid in distinguishing retry from new
$self->relog();
} elsif ($self->{sessionestablishmentcontext} == STATE_EXPECTINGRAKP4) { #in this particular case, we want to craft a new rmcp session request with a new client side session id, to aid in distinguishing retry from new
$self->relog();
} else {
$self->sendpayload(%{$self->{pendingargs}},nowait=>1); #do not induce the xmit to wait for packets, just spit it out. timedout is in a wait-for-packets loop already, so it's fine
}
$self->{nowait}=0;
}
sub route_ipmiresponse {
my $sockaddr=shift;
my @rsp = @_;
unless (
$rsp[0] == 0x6 and
$rsp[2] == 0xff and
$rsp[3] == 0x07) {
return; #ignore non-ipmi packets
}
my $host;
my $port;
#($port,$host) = sockaddr_in6($sockaddr);
#$host = inet_ntoa($host);
if ($doipv6) {
($host,$port) = Socket6::getnameinfo($sockaddr,Socket6::NI_NUMERICHOST());
} else {
($port,$host) = sockaddr_in($sockaddr);
$host = inet_ntoa($host);
}
if ($host =~ /::ffff:\d+\.\d+\.+\d+\.\d+/) {
$host =~ s/::ffff://;
}
if ($bmc_handlers{$host}) {
$pendingpackets-=1;
$bmc_handlers{$host}->handle_ipmi_packet(@rsp);
}
}
sub handle_ipmi_packet {
#return zero if we like the response
my $self = shift;
my @rsp = @_;
if ($rsp[4] == 0 or $rsp[4] == 2) { #IPMI 1.5 (check 0 assumption...)
my $remsequencenumber=$rsp[5]+$rsp[6]>>8+$rsp[7]>>16+$rsp[8]>>24;
if ($self->{remotesequencenumber} and $remsequencenumber < $self->{remotesequencenumber} ) {
return 5; #ignore malformed sequence number
}
$self->{remotesequencenumber}=$remsequencenumber;
$self->{remotesequencebytes} = [@rsp[5..8]];
if ($rsp[4] != $self->{authtype}) {
return 2; # not thinking about packets that do not match our preferred auth type
}
unless ($rsp[9] == $self->{sessionid}->[0] and
$rsp[10] == $self->{sessionid}->[1] and
$rsp[11] == $self->{sessionid}->[2] and
$rsp[12] == $self->{sessionid}->[3]) {
return 1; #this response does not match our current session id, ignore it
}
my @authcode=();
if ($rsp[4] == 2) {
@authcode = splice @rsp,13,16;
}
my @payload = splice (@rsp,14,$rsp[13]);
if (@authcode) { #authcode is longer than 0, check it
$self->{checkremotecode}=1;
my @expectedauthcode = $self->ipmi15authcode(@payload);
$self->{checkremotecode}=0;
foreach (0..15) {
if ($expectedauthcode[$_] != $authcode[$_]) {
return 3; #invalid authcode
}
}
}
return $self->parse_ipmi_payload(@payload);
} elsif ($rsp[4] == 6) { #IPMI 2.0
if (($rsp[5]& 0b00111111) == 0x11) {
return $self->got_rmcp_response(splice @rsp,16); #the function always leaves ourselves waiting, no need to deregister
} elsif (($rsp[5]& 0b00111111) == 0x13) {
return $self->got_rakp2(splice @rsp,16); #same as above
} elsif (($rsp[5]& 0b00111111) == 0x15) {
return $self->got_rakp4(splice @rsp,16); #same as above
} elsif (($rsp[5]& 0b00111111) == 0x0) { #ipmi payload, sophisticated logic to follow
my $encrypted;
if ($rsp[5]&0b10000000) {
$encrypted=1;
}
unless ($rsp[5]&0b01000000) {
return 3; #we refuse to examine unauthenticated packets in this context
}
splice (@rsp,0,4); #ditch the rmcp header
my @authcode = splice(@rsp,-12);#strip away authcode and remember it
my @expectedcode = unpack("C*",hmac_sha1(pack("C*",@rsp),$self->{k1}));
splice (@expectedcode,12);
foreach (@expectedcode) {
unless ($_ == shift @authcode) {
return 3; #authcode bad, pretend it never existed
}
}
my $thissid = unpack("N",pack("C*",$rsp[2],$rsp[3],$rsp[4],$rsp[5]));
unless ($thissid==$self->{localsid}) {
return 1; #this response does not match our current session id, ignore it
}
my $remsequencenumber=$rsp[6]+$rsp[7]>>8+$rsp[8]>>16+$rsp[9]>>24;
if ($self->{remotesequencenumber} and $remsequencenumber < $self->{remotesequencenumber} ) {
return 5; #ignore malformed sequence number
}
$self->{remotesequencenumber}=$remsequencenumber;
my $psize = $rsp[10]+($rsp[11]<<8);
my @payload = splice(@rsp,12,$psize);
if ($encrypted) {
my $iv = pack("C*",splice @payload,0,16);
my $cipher = Crypt::CBC->new(-literal_key => 1,-key=>$self->{aeskey},-cipher=>"Crypt::Rijndael",-header=>"none",-iv=>$iv,-keysize=>16,-blocksize=>16,-padding=>\&cbc_pad);
my $crypted = pack("C*",@payload);
@payload = unpack("C*",$cipher->decrypt($crypted));
}
return $self->parse_ipmi_payload(@payload);
} else {
return 6; #unsupported payload
}
} else {
return 7; #unsupported ASF traffic
}
}
sub cbc_pad {
my $block = shift;
my $size = shift;
my $mode = shift;
if ($mode eq 'e') {
my $neededpad=$size-length($block)%$size;
$neededpad -= 1;
my @pad=unpack("C*",$block);
foreach (1..$neededpad) {
push @pad,$_;
}
push @pad,$neededpad;
return pack("C*",@pad);
} elsif ($mode eq 'd') {
my @block = unpack("C*",$block);
my $count = pop @block;
unless ($count) {
return pack("C*",@block);
}
splice @block,0-$count;
return pack("C*",@block);
}
}
sub got_rmcp_response {
my $self = shift;
my @data = @_;
my $byte = shift @data;
unless ($self->{sessionestablishmentcontext} and $self->{sessionestablishmentcontext} != STATE_ESTABLISHED) {
#we would ignore an RMCP+ open session response if we are not in an IPMI2 negotiation, so we have to have *some* state that isn't established for this to be kosher
return 9; #now's not the time for this response, ignore it
}
unless ($byte == $self->{rmcptag}) { #make sure this rmcp response is specifically the last one we sent.... we don't want to happily proceed with the risk a retry request blew up our temp session id without letting us know
return 9;
}
$byte = shift @data;
unless ($byte == 0x00) {
$self->{onlogon}->("ERROR: $byte code on opening RMCP+ session",$self->{onlogon_args}); #TODO: errors
return 9;
}
$byte = shift @data;
unless ($byte >= 4) {
$self->{onlogon}->("ERROR: Cannot acquire sufficient privilege",$self->{onlogon_args});
return 9;
}
splice @data,0,5;
$self->{pendingsessionid} = [splice @data,0,4];
#TODO: if we retried, and the first answer comes back but the second answer is dropped, log in will fail as we do not know our correct session id
#basically, we would have to retry open session requested until RAKP2 *confirmed* good
$self->send_rakp1();
return 0;
}
sub send_rakp3 {
#TODO: this is the point where OPEN RMCP SESSION REQUEST should have retry stopped, not send_rakp1
my $self = shift;
$self->{rmcptag}+=1;
my @payload = ($self->{rmcptag},0,0,0,@{$self->{pendingsessionid}});
my @user = unpack("C*",$self->{userid});
push @payload,unpack("C*",hmac_sha1(pack("C*",@{$self->{remoterandomnumber}},@{$self->{sidm}},4,scalar @user,@user),$self->{password}));
$self->sendpayload(payload=>\@payload,type=>$payload_types{'rakp3'});
}
sub send_rakp1 {
my $self = shift;
$self->{rmcptag}+=1;
my @payload = ($self->{rmcptag},0,0,0,@{$self->{pendingsessionid}});
$self->{randomnumber}=[];
foreach (1..16) {
my $randomnumber = int(rand(255));
push @{$self->{randomnumber}},$randomnumber;
}
push @payload, @{$self->{randomnumber}};
push @payload,(4,0,0); # request admin
my @user = unpack("C*",$self->{userid});
push @payload,scalar @user;
push @payload,@user;
$self->{sessionestablishmentcontext} = STATE_EXPECTINGRAKP2;
$self->sendpayload(payload=>\@payload,type=>$payload_types{'rakp1'});
}
sub init {
my $self = shift;
$self->{sessionestablishmentcontext} = 0;
$self->{'sequencenumber'} = 0; #init sequence number
$self->{'sequencenumberbytes'} = [0,0,0,0]; #init sequence number
$self->{'sessionid'} = [0,0,0,0]; # init session id
$self->{'authtype'}=0; # first messages will have auth type of 0
$self->{'ipmiversion'}='1.5'; # send first packet as 1.5
$self->{'timeout'}=$initialtimeout; #start at a quick timeout, increase on retry
$self->{'seqlun'}=0; #the IPMB seqlun combo, increment by 4s
$self->{rqaddr}=0x81; #Per table '5-4' system sofware ids in the ipmi spec, we are allowed 0x81-0x8d software ids
#A problem with ipmi is that chatty commands (rinv) can mistake stale data for new if sequence number overflows
#for example, if 'get firmware information' command is retried, and happens to have sequence number 4,
#64 transactions later a reply to the retry comes up, the data is passed into the callback function because of ambiguity introduced by the
#overflowed sequence number
#to mitigate this, we will iterate rqaddr every time the seqlun counter overflows
#of course, this still means that rqaddr will, itself, overflow, but it mitigates things because:
#448 instead of 64 transactions are now required before ambiguity is possible
#A stale reply has to come in after the conversation has advanced at least 448 transactions, meaning longer delay on extraneous reply before this is a problem
#even if a stale reply comes in at *about* the right time, it has to match an exact multiple of 448 instead of 64, which is significantly less likely.
$self->{'logged'}=0;
}
sub relog {
my $self=shift;
$self->init();
$self->{logontries} -= 1;
$self->get_channel_auth_cap();
}
sub got_rakp4 {
my $self = shift;
my @data = @_;
my $byte = shift @data;
unless ($self->{sessionestablishmentcontext} == STATE_EXPECTINGRAKP4) { #ignore rakp4 unless we are explicitly expecting RAKP4
return 9; #now's not the time for this response, ignore it
}
unless ($byte == $self->{rmcptag}) { #make sure this rmcp response is specifically the last one we sent.... we don't want to happily proceed with the risk a retry request blew up our temp session id without letting us know
return 9;
}
$byte = shift @data;
unless ($byte == 0x00) {
if (($byte == 0x02) and $self->{logontries}) {
#ok, turns out an IPMI2 device may optimistically assume that since it has transmitted RAKP4, it's done with this whole RAKP exchange, thus
#code 2 can happen.... To workaround this, code 2 is taken as a cue to start over if we haven't got an rakp2 yet
$self->relog();
}
if (($byte == 0x02 or $byte == 15) and $self->{logontries}) { # most likely scenario is that a retry earlier in the process invalided the flow this packet came in on, ignore it and hope the retries all sort out
#UPDATE: turns out open rmcp session request shenanigans were to blame, rakp2 straight retransmits seems safe
#the biggest risk: that we did not receive the correct rakp2, so the prudent thing to be doing in this time interval would be retrying RAKP1...
#ipmi2 session negotiation is a bit weird in how retries can corrupt state and we effectively should be rewinding a bit...
#TODO: think about retry logic hard to decide how many packets we can retry
#thought: can we match a failed RAKP2 to the last RAKP1 we transmitted? If we can, and we see the last RAKP1 was in fact the one this response is for, that
#would definitely mean we should rewinnd to open session rquest..
#ditto for rakp4, if we can confirm rakp is for the last transmitted rakp3, then we need to rewind to send_rakp1...
#$self->relog();
return;
}
$self->{onlogon}->("ERROR: $byte code on opening RMCP+ session",$self->{onlogon_args}); #TODO: errors
return 9;
}
splice @data,0,6; #discard reserved bytes and session id
my @expectauthcode = unpack("C*",hmac_sha1(pack("C*",@{$self->{randomnumber}},@{$self->{pendingsessionid}},@{$self->{remoteguid}}),$self->{sik}));
foreach (@expectauthcode[0..11]) {
unless ($_ == (shift @data)) {
#we'll just ignore this transgression...... *this time*
#$self->{onlogon}->("ERROR: failure in final rakp exchange message",$self->{onlogon_args});
return 9;
}
}
$self->{sessionid} = $self->{pendingsessionid};
$self->{integrityalgo}='sha1';
if ($aessupport) {
$self->{confalgo} = 'aes';
}
$self->{sequencenumber}=1;
$self->{sequencenumberbytes}=[1,0,0,0];
$self->{sessionestablishmentcontext} = STATE_ESTABLISHED; #will move on to relying upon session sequence number
$self->set_admin_level();
return 0;
}
sub got_rakp2 {
my $self=shift;
my @data = @_;
my $byte = shift @data;
unless ($self->{sessionestablishmentcontext} >= STATE_EXPECTINGRAKP2 and $self->{sessionestablishmentcontext} != STATE_ESTABLISHED) {
#we will bail out unless the state is either EXPECTINGRAKP2 or EXPECTINGRAKP4.
#the reason being that if an old rakp1 retry actually made it and we were just too aggressive, then a previous rakp2 is invalidated and invalid session id or the integrity check value is bad
return 9; #now's not the time for this response, ignore it
}
unless ($byte == $self->{rmcptag}) { #make sure this rmcp response is specifically the last one we sent.... we don't want to happily proceed with the risk a retry request blew up our temp session id without letting us know
return 9;
}
$byte = shift @data;
unless ($byte == 0x00) {
if ($byte == 0x02) { #invalid session id is almost certainly because a retry on rmcp+ open session response rendered our session id invalid, ignore this in the hope that we'll get an answer for our retry that invalidated us..
#$self->relog();
#TODO: probably should disable RAKP1 retry here... high likelihood that we'll just spew a bad RAKP1 and Open Session Request retry would be more appropriate to try to discern a valid session id
return;
}
$self->{onlogon}->("ERROR: $byte code on opening RMCP+ session",$self->{onlogon_args}); #TODO: errors
return 9;
}
splice @data,0,6; # throw away reserved bytes, and session id, might need to check
$self->{remoterandomnumber} = [];
foreach (1..16) {
push @{$self->{remoterandomnumber}},(shift @data);
}
$self->{remoteguid} = [];
foreach (1..16) {
push @{$self->{remoteguid}},(shift @data);
}
#Data now represents authcode.. sha1 only..
my @user = unpack("C*",$self->{userid});
my $ulength = scalar @user;
my $hmacdata = pack("C*",(@{$self->{sidm}},@{$self->{pendingsessionid}},@{$self->{randomnumber}},@{$self->{remoterandomnumber}},@{$self->{remoteguid}},4,$ulength,@user));
my @expectedhash = (unpack("C*",hmac_sha1($hmacdata,$self->{password})));
foreach (0..(scalar(@expectedhash)-1)) {
if ($expectedhash[$_] != $data[$_]) {
$self->{onlogon}->("ERROR: Incorrect password provided",$self->{onlogon_args});
return 9;
}
}
$self->{sik} = hmac_sha1(pack("C*",@{$self->{randomnumber}},@{$self->{remoterandomnumber}},4,$ulength,@user),$self->{password});
$self->{k1} = hmac_sha1(pack("C*",1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),$self->{sik});
if ($aessupport) {
$self->{k2} = hmac_sha1(pack("C*",2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2),$self->{sik});
my @aeskey = unpack("C*",$self->{k2});
$self->{aeskey} = pack("C*",(splice @aeskey,0,16));
}
$self->{sessionestablishmentcontext} = STATE_EXPECTINGRAKP4;
$self->send_rakp3();
return 0;
}
sub parse_ipmi_payload {
my $self=shift;
my @payload = @_;
#for now, just trash the headers, this has been validated to death anyway
#except seqlun, that one is important
if ($payload[4] != $self->{seqlun} or $payload[0] != $self->{rqaddr}) {
#both sequence number and arqaddr must match, because we are using rqaddr to extend the sequence number
#print "Successfully didn't get confused by stale response ".$payload[4]." and ".($self->{seqlun}-4)."\n";
#hexdump(@payload);
return 1; #response mismatch
}
$self->{seqlun} += 4; #increment by 1<<2
if ($self->{seqlun} > 0xff) { #overflow case
#Problem with rqaddr iteration strategy to get more sequence numbers, changing swid invalidates reservation ids for some BMCs...
# if ($self->{rqaddr} == 0x8d) { #rqaddr itself is forced to overflow
# $self->{rqaddr}=0x81;
# } else {
# $self->{rqaddr}+=2; #table 5-4 demands rqaddr be odd for software ids, so we must increment by 2
#}
$self->{seqlun} &= 0xff; #keep it one byte
}
delete $sessions_waiting{$self}; #deregister self as satisfied, callback will reregister if appropriate
delete $self->{pendingargs};
splice @payload,0,5; #remove rsaddr/netfs/lun/checksum/rq/seq/lun
pop @payload; #remove checksum
my $rsp;
$rsp->{cmd} = shift @payload;
$rsp->{code} = shift @payload;
$rsp->{data} = \@payload;
$self->{timeout}=$initialtimeout;
$self->{ipmicallback}->($rsp,$self->{ipmicallback_args});
return 0;
}
sub ipmi15authcode {
my $self = shift;
#per table 22-22 'authcode algorithms'
my @data = @_;
my @password;
my @code;
if ($self->{passbytes}) {
@password = @{$self->{passbytes}};
} else {
@password = unpack("C*",$self->{password});
for (my $i=scalar @password;$i<16;$i++) {
$password[$i]=0;
}
$self->{passbytes} = \@password;
}
my @sequencebytes = @{$self->{sequencenumberbytes}};
if ($self->{checkremotecode}) {
@sequencebytes = @{$self->{remotesequencebytes}};
}
if ($self->{authtype} == 0) {
return ();
} elsif ($self->{authtype} == 2) {
return unpack("C*",md5(pack("C*",@password,@{$self->{sessionid}},@data,@sequencebytes,@password))); #ignoring single-session channels
}
#Not supporting plaintext passwords, that would be asinine
}
#this function accepts a generic ipmi command and applies current session data and handles the 1.5<->2.0 differences
sub sendpayload {
#implementation used section 13.6, examle ipmi over lan packet
my $self = shift;
my %args = @_;
my @msg = (0x6,0x0,0xff,0x07); #RMCP header is constant in IPMI
my $type = $args{type} & 0b00111111;
my @payload = @{$args{payload}};
$self->{pendingargs} = \%args;
push @msg,$self->{'authtype'}; # add authtype byte (will support 0 only for session establishment, 2 for ipmi 1.5, 6 for ipmi2
if ($self->{'ipmiversion'} eq '2.0') { #TODO: revisit this to see if assembly makes sense
push @msg, $args{type};
if ($type == 2) {
push @msg,@{$self->{'iana'}},0;
push @msg,@{$self->{'oem_payload_id'}};
}
push @msg,@{$self->{sessionid}};
}
push @msg,@{$self->{sequencenumberbytes}};
if ($self->{'ipmiversion'} eq '1.5') { #ipmi 2.0 for some reason swapped session id and seq number location
push @msg,@{$self->{sessionid}};
unless ($self->{authtype} == 0) {
push @msg,$self->ipmi15authcode(@payload);
}
push @msg,scalar(@payload);
push @msg,@payload;
#TODO: sweat a pad or not? spec isn't crystal clear on the 'legacy pad' and it sounds like it is just for some old crappy nics that have no business in a good server
} elsif ($self->{'ipmiversion'} eq '2.0') {
#TODO:
my $size = scalar(@payload);
if ($self->{confalgo}) {
my $pad = ($size+1)%16;
if ($pad) { $pad = 16-$pad; }
my $newsize =$size+$pad+17;
push @msg,($newsize&0xff,$newsize>>8);
my @iv;
foreach (1..16) { #generate a new iv for outbound packet
my $num = int(rand(255));
push @msg,$num;
push @iv, $num;
}
my $cipher = Crypt::CBC->new(-literal_key => 1,-key=>$self->{aeskey},-cipher=>"Rijndael",-header=>"none",-iv=>pack("C*",@iv),-keysize=>16,-padding=>\&cbc_pad);
push @msg,(unpack("C*",$cipher->encrypt(pack("C*",@payload))));
} else {
push @msg,($size&0xff,$size>>8);
push @msg,@payload;
}
if ($self->{integrityalgo}) {
my @integdata = @msg[4..(scalar @msg)-1];
my $neededpad=((scalar @integdata)+2)%4;
if ($neededpad) { $neededpad = 4-$neededpad; }
for (my $i=0;$i<$neededpad;$i++) {
push @integdata,0xff;
push @msg,0xff;
}
push @msg,$neededpad;
push @integdata,$neededpad;
push @msg,7;
push @integdata,7;
my $intdata = pack("C*",@integdata);
my @acode = unpack("C*",hmac_sha1($intdata,$self->{k1}));
push @msg,splice @acode,0,12;
#push integrity pad
#push @msg,0x7; #reserved byte in 2.0
#push integrity data
}
}
unless ($args{nowait} or $self->{nowait}) { #if nowait indicated, the packet will be sent regardless of maxpending
#primary use case would be retries that should represent no delta to pending sessions in aggregate and therefore couldn't exceed maxpending anywy
#if we did do this on timedout, waitforrsp may recurse, which is a complicated issue. Theoretically, if waitforrsp protected itself, it
#would act the same, but best be explicit about nowait if practice does not match theory
#another scenario is if we have urgent payload for a BMC (PET acknowledge, negotiating login if temp session id is very short lived
$self->waitforrsp(timeout=>0); #the intent here is to interrupt outgoing activity to give a chance to respond to incoming data
#until we send, the ball is in our court so things are less time critical
while ($pendingpackets > $maxpending) { #if we hit our ceiling, wait until a slot frees up, which can't happen until either a packet is received or someone gives up
$self->waitforrsp();
}
}
$socket->send(pack("C*",@msg),0,$self->{peeraddr});
$sessions_waiting{$self}={};
$sessions_waiting{$self}->{ipmisession}=$self;
if ($args{delayxmit}) {
$sessions_waiting{$self}->{timeout}=time()+$args{delayxmit};
$self->{timeout}=$initialtimeout/1.5; #since we are burning one of the retry attempts, start the backoff algorithm faster to make it come out even
undef $args{delayxmit};
return; #don't actually transmit packet, use retry timer to start us off
} else {
$sessions_waiting{$self}->{timeout}=time()+$self->{timeout};
}
$pendingpackets+=1;
if ($self->{sequencenumber}) { #if using non-zero, increment, otherwise..
$self->{sequencenumber} += 1;
$self->{sequencenumberbytes} = [$self->{sequencenumber}&0xff,($self->{sequencenumber}>>8)&0xff,($self->{sequencenumber}>>16)&0xff,($self->{sequencenumber}>>24)&0xff];
}
}
1;
Reference in New Issue View Git Blame Copy Permalink