mirror of
https://github.com/xcat2/xcat-core.git
synced 2025-05-22 03:32:04 +00:00
bd0ad1ba43
The maximum socket receive buffer size (SO_RCVBUF) is set from the value in /proc/sys/net/core/rmem_max. When this value is close to INT_MAX, the select() system call used by IO::Select->can_read() never returns true. This causes packets to never be read. Therefore, reduce the maximum socket receive buffer size to a value which works.
1170 lines
50 KiB
Perl
1170 lines
50 KiB
Perl
#!/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 xCAT::SvrUtils;
|
|
|
|
use IO::Socket::INET qw/!AF_INET6 !PF_INET6/;
|
|
my $initialtimeout = 0.5;
|
|
use constant STATE_OPENSESSION => 1;
|
|
use constant STATE_EXPECTINGRAKP2 => 2;
|
|
use constant STATE_EXPECTINGRAKP4 => 3;
|
|
use constant STATE_ESTABLISHED => 4;
|
|
use constant STATE_FAILED => 5;
|
|
|
|
#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 %tabooseq; #TODO: this is a global which means one taboo in the whole set causes unrelated session objects to consider it taboo unnecessarily
|
|
my $maxpending; #determined dynamically based on rcvbuf detection
|
|
|
|
my $ipmi2support;
|
|
if (-f "/etc/debian_release" or -f "/etc/debian_version") {
|
|
$ipmi2support = eval {
|
|
require Digest::SHA;
|
|
Digest::SHA->import(qw/sha1/);
|
|
require Digest::HMAC_SHA1;
|
|
Digest::HMAC_SHA1->import(qw/hmac_sha1/);
|
|
1;
|
|
};
|
|
}
|
|
else {
|
|
$ipmi2support = eval {
|
|
require Digest::SHA1;
|
|
Digest::SHA1->import(qw/sha1/);
|
|
require Digest::HMAC_SHA1;
|
|
Digest::HMAC_SHA1->import(qw/hmac_sha1/);
|
|
1;
|
|
};
|
|
}
|
|
use Crypt::Rijndael;
|
|
use Crypt::CBC;
|
|
|
|
sub hexdump {
|
|
foreach (@_) {
|
|
printf "%02X ", $_;
|
|
}
|
|
print "\n";
|
|
}
|
|
|
|
my %command_info = (
|
|
6 => {
|
|
56 => "Get Channel Authentication Capabilities",
|
|
59 => "Set session privilege level",
|
|
60 => "Close Session",
|
|
58 => "activate session",
|
|
57 => "Get Session Challenge",
|
|
1 => "Get Device ID",
|
|
2 => "Cold Reset",
|
|
55 => "Get System GUID",
|
|
64 => "Set Channel Access",
|
|
76 => "Set User Payload Access",
|
|
10 => "Get Command Support",
|
|
},
|
|
4 => {
|
|
18 => "Set PEF Configuration Parameters",
|
|
19 => "Get PEF Configuration Parameters",
|
|
45 => "Get Sensor Reading",
|
|
},
|
|
0 => {
|
|
8 => "Set System Boot Options",
|
|
9 => "Get System Boot Options",
|
|
4 => "Chassis Identify(beacon)",
|
|
2 => "Chassis Control",
|
|
1 => "Get Chassis Status",
|
|
},
|
|
12 => {
|
|
1 => "Set LAN Configuration Parameters",
|
|
2 => "Get LAN Configuration Parameters",
|
|
33 => "Set SOL Configuration Parameters",
|
|
34 => "Get SOL Configuration Parameters",
|
|
},
|
|
10 => {
|
|
35 => "Get SDR",
|
|
34 => "Reserve SDR Repository",
|
|
71 => "Clear SEL",
|
|
67 => "Get SEL Entry",
|
|
66 => "Reserve SEL",
|
|
72 => "Get SEL Time",
|
|
64 => "Get SEL Info",
|
|
17 => "Read FRU Data",
|
|
16 => "Get FRU Inventory Area Info",
|
|
32 => "Get SDR Repository Info",
|
|
},
|
|
);
|
|
|
|
my %netfn_types = (
|
|
0 => "Chassis",
|
|
2 => "Bridge",
|
|
4 => "Sensor/Event",
|
|
6 => "App",
|
|
8 => "Firmware",
|
|
10 => "Storage",
|
|
12 => "Transport",
|
|
# do we need to define anymore then these?
|
|
);
|
|
|
|
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 %rmcp_codes = ( #human friendly translations of rmcp+ code numbers
|
|
1 => "Insufficient resources to create new session (wait for existing sessions to timeout)",
|
|
2 => "Invalid Session ID", #this shouldn't occur...
|
|
3 => "Invalid payload type", #shouldn't occur..
|
|
4 => "Invalid authentication algorithm", #if this happens, we need to enhance our mechanism for detecting supported auth algorithms
|
|
5 => "Invalid integrity algorithm", #same as above
|
|
6 => "No matching authentication payload",
|
|
7 => "No matching integrity payload",
|
|
8 => "Inactive Session ID", #this suggests the session was timed out while trying to negotiate, shouldn't happen
|
|
9 => "Invalid role",
|
|
0xa => "Unauthorised role or privilege level requested",
|
|
0xb => "Insufficient resources to create a session at the requested role",
|
|
0xc => "Invalid username length",
|
|
0xd => "Unauthorized name",
|
|
0xe => "Unauthorized GUID",
|
|
0xf => "Invalid integrity check value",
|
|
0x10 => "Invalid confidentiality algorithm",
|
|
0x11 => "No cipher suite match with proposed security algorithms",
|
|
0x12 => "Illegal or unrecognized parameter", #have never observed this, would most likely mean a bug in xCAT or IPMI device
|
|
);
|
|
my $socket; #global socket for all sessions to share. Fun fun
|
|
my $select = IO::Select->new();
|
|
|
|
our %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 = @_;
|
|
$self->init();
|
|
unless ($ipmi2support) {
|
|
$self->{ipmi15only} = 1;
|
|
}
|
|
$self->{privlevel} = 4;
|
|
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{'node'}) { #default to port 623 unless specified
|
|
$self->{'node'} = $args{'bmc'};
|
|
}
|
|
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>;
|
|
# select() on a socket will never succeed if the buffer is too large (i.e. near INT_MAX)
|
|
my $cap_maxrcvbuf = 2047*1024*1024;
|
|
if ($maxrcvbuf > $cap_maxrcvbuf) {
|
|
$maxrcvbuf = $cap_maxrcvbuf;
|
|
}
|
|
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);
|
|
}
|
|
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 => [ $self->{privlevel} ], 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 == 0x80 or $code == 0x81) and $self->{privlevel} == 4) {
|
|
$self->{privlevel} = 3;
|
|
$self->subcmd(netfn => 0x6, command => 0x3b, data => [ $self->{privlevel} ], callback => \&admin_level_set, callback_args => $self);
|
|
return;
|
|
}
|
|
|
|
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
|
|
push @payload, (2, 0, 0, 8, 1, 0, 0, 0); # aes
|
|
$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 = @_;
|
|
while ($self->{incommand}) {
|
|
$self->waitforrsp(timeout=>1);
|
|
}
|
|
$self->{incommand} = 1;
|
|
|
|
$self->{expectedcmd} = $args{command};
|
|
$self->{expectednetfn} = $args{netfn} + 1;
|
|
if ($self->{onlogon_args}->{xcatdebugmode}) {
|
|
my $command_string = $command_info{$args{netfn}}->{$args{command}};
|
|
my $data_values = join ", ", @{$args{data}};
|
|
my $msg = sprintf ("[ipmi_debug] $self->{onlogon_args}->{command}:$self->{onlogon_args}->{subcommand}(@{$self->{onlogon_args}->{extraargs}}), raw_cmd: netfn(0x%02x=>%s), cmd(0x%02x=>%s), data=[%s]", $args{netfn}, $netfn_types{$args{netfn}}, $args{command}, $command_string, $data_values);
|
|
xCAT::SvrUtils::sendmsg([0, $msg], $self->{onlogon_args}->{outfunc}, $self->{node});
|
|
}
|
|
my $seqincrement = 7;
|
|
while ($tabooseq{ $self->{expectednetfn} }->{ $self->{expectedcmd} }->{ $self->{seqlun} } and $seqincrement) { #avoid using a seqlun formerly marked 'taboo', but don't advance by more than 7, just in case
|
|
$tabooseq{ $self->{expectednetfn} }->{ $self->{expectedcmd} }->{ $self->{seqlun} }--; #forgive a taboo lun over time...
|
|
$self->{seqlun} += 4; #increment by 1<<2
|
|
$self->{seqlun} &= 0xff; #make sure we don't get too large a seqlun
|
|
$seqincrement--; #assure seq number doesn't go beyond 7 even if it means going taboo, one enhancement would be to pick the *least* taboo instead of just giving up
|
|
}
|
|
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} += 1; #$self->{timeout}*2;
|
|
if ($self->{noretry}) { return; }
|
|
if ($self->{timeout} > 5) { #giveup, really
|
|
$self->{timeout} = $initialtimeout + (0.5 * rand());
|
|
my $rsp = {};
|
|
$rsp->{error} = "timeout";
|
|
$self->{incommand} = 0;
|
|
$self->{ipmicallback}->($rsp, $self->{ipmicallback_args});
|
|
$self->{nowait} = 0;
|
|
return;
|
|
} elsif ($self->{sessionestablishmentcontext} == STATE_FAILED) {
|
|
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->{hasretried} = 1; #remember that we have retried at the moment
|
|
$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;
|
|
}
|
|
|
|
#------------------------modified to support openbmc ipmi command----------------
|
|
unless ($rsp[5] & 0b01000000) {
|
|
if ($self->{max_privilege} != 0) {
|
|
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) {
|
|
if ($rmcp_codes{$byte}) {
|
|
$self->{onlogon}->("ERROR: " . $rmcp_codes{$byte}, $self->{onlogon_args}); #TODO: errors
|
|
} else {
|
|
$self->{onlogon}->("ERROR: $byte code on opening RMCP+ session", $self->{onlogon_args}); #TODO: errors
|
|
}
|
|
return 9;
|
|
}
|
|
$byte = shift @data;
|
|
|
|
# add $byte == 0 to support openbmc ipmi command
|
|
unless ($byte >= 4 or $byte == 0) {
|
|
$self->{onlogon}->("ERROR: Cannot acquire sufficient privilege", $self->{onlogon_args});
|
|
return 9;
|
|
}
|
|
$self->{max_privilege} = $byte if ($byte == 0);
|
|
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} }, $self->{privlevel}, 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, ($self->{privlevel}, 0, 0); # request priv
|
|
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->{confalgo} = undef;
|
|
$self->{integrityalgo} = undef;
|
|
$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 + (0.5 * rand()); #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.
|
|
#I abandoned this strategy, but leaving it documented for posterity. The issue is that some operations don't like the client changing software id
|
|
#midstream (notably SDR reservations).
|
|
#ipmi spec does contain some guidance in the BT section of the spec 'Using the Seq Field'. There is guidance elsewhere about sequence numbers higher than 8 beyond current
|
|
#but I'm not sure if thet means 'session sequence number' or 'seq', which are very very different.
|
|
#one tangible recommendation is for the combination of command+seq+netfn to be unique, which can certainly help, so we should track netfn and command to make sure response
|
|
#matches at least the expected command and netfn.
|
|
#additionally, it looks like we could implement a sort of 'taboo' sequence number scheme. When we ascertain that we are retrying, we flag the current sequence number to be
|
|
#'taboo' in the future. When the time comes to increment sequence number, we mark the current combination of command+netfn+seq as 'taboo'
|
|
#should circumstances suggest that we are about to transmit a packet with a taboo combination, we bump sequence number until no longer taboo, no more than 8 bumps.
|
|
#if we should incur 7 bumps, clear the taboo list and continue on, hoping for best (pessimistically assuming the spec means seq number or that someone could at least interpret it that way)
|
|
#I'll implement this later...
|
|
$self->{'logged'} = 0;
|
|
$self->{'incommand'} = 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;
|
|
}
|
|
if ($rmcp_codes{$byte}) {
|
|
$self->{onlogon}->("ERROR: " . $rmcp_codes{$byte}, $self->{onlogon_args}); #TODO: errors
|
|
} else {
|
|
$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';
|
|
$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 == 0x9 or $byte == 0xd) and $self->{privlevel} == 4) {
|
|
|
|
# this is probably an environment that wants to give us only operator
|
|
# try to connect again at 3.
|
|
$self->{privlevel} = 3;
|
|
$self->relog();
|
|
return;
|
|
}
|
|
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;
|
|
}
|
|
if ($rmcp_codes{$byte}) {
|
|
$self->{sessionestablishmentcontext} = STATE_FAILED;
|
|
$self->{onlogon}->("ERROR: " . $rmcp_codes{$byte}, $self->{onlogon_args}); #TODO: errors
|
|
} else {
|
|
$self->{sessionestablishmentcontext} = STATE_FAILED;
|
|
$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} }, $self->{privlevel}, $ulength, @user));
|
|
my @expectedhash = (unpack("C*", hmac_sha1($hmacdata, $self->{password})));
|
|
foreach (0 .. (scalar(@expectedhash) - 1)) {
|
|
if ($expectedhash[$_] != $data[$_]) {
|
|
$self->{sessionestablishmentcontext} = STATE_FAILED;
|
|
$self->{onlogon}->("ERROR: Incorrect password provided", $self->{onlogon_args});
|
|
return 9;
|
|
}
|
|
}
|
|
$self->{sik} = hmac_sha1(pack("C*", @{ $self->{randomnumber} }, @{ $self->{remoterandomnumber} }, $self->{privlevel}, $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});
|
|
$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
|
|
unless ($payload[4] == $self->{seqlun} and $payload[1] >> 2 == $self->{expectednetfn} and $payload[5] == $self->{expectedcmd}) {
|
|
|
|
#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
|
|
}
|
|
if ($self->{hasretried}) { #if we sent this out multiple times, mark the sequence as taboo
|
|
$self->{hasretried} = 0;
|
|
$tabooseq{ $self->{expectednetfn} }->{ $self->{expectedcmd} }->{ $self->{seqlun} } = 16; #consider a lun taboo for 16 overflow cycles
|
|
}
|
|
|
|
#set to impossible values to reflect the fact we expect *no* command/nnetfn at the moment
|
|
$self->{expectednetfn} = 0x1ff;
|
|
$self->{expectedcmd} = 0x1ff;
|
|
$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 + (0.5 * rand());
|
|
$self->{incommand} = 0;
|
|
$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 + (0.5 * rand())) / 2; #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;
|