test(openbmc): exercise retries through the request handler

Replace extracted function copies with requests through the real plugin.
Check retry timing, exhaustion, recovery, request contents, and per-node
retry budgets at external boundaries. Keep production behavior unchanged.

xCAT-test/unit/openbmc_503_retry.t

@@ -1,183 +1,208 @@
 #!/usr/bin/env perl
-
 use strict;
 use warnings;
-no warnings 'once';
 
 use File::Spec;
+use File::Temp qw(tempdir);
 use FindBin;
+use HTTP::Response;
+use JSON;
 use Test::More;
 
-my @plugin_candidates = (
-    File::Spec->catfile(
-        $FindBin::Bin, '..', '..', 'xCAT-server', 'lib', 'xcat', 'plugins',
-        'openbmc.pm'
-    ),
-);
-push @plugin_candidates,
-  File::Spec->catfile($ENV{XCATROOT}, 'lib', 'perl', 'xCAT_plugin', 'openbmc.pm')
-  if defined $ENV{XCATROOT};
-push @plugin_candidates, '/opt/xcat/lib/perl/xCAT_plugin/openbmc.pm';
-
-my ($plugin_path) = grep { -f } @plugin_candidates;
-BAIL_OUT('Could not locate the OpenBMC plugin') if !defined $plugin_path;
-
-open my $plugin_fh, '<', $plugin_path
-  or BAIL_OUT("Could not open $plugin_path: $!");
-my $plugin_source = do { local $/; <$plugin_fh> };
-close $plugin_fh;
-
-sub extract_subroutine {
-    my ($name) = @_;
-    my ($subroutine) =
-      $plugin_source =~ /(^sub \Q$name\E \{.*?^\}\n)(?=\n#-+)/ms;
-    BAIL_OUT("Could not extract $name from $plugin_path")
-      if !defined $subroutine;
-    return $subroutine;
-}
-
-my $retry_after        = extract_subroutine('retry_after');
-my $deal_with_response = extract_subroutine('deal_with_response');
-
-{
-    package xCAT::SvrUtils;
-
-    our @messages;
-
-    sub sendmsg {
-        push @messages, [@_];
+our ($now, @login_children);
+BEGIN {
+    no warnings 'once';
+    if (@ARGV && $ARGV[0] eq '--fixture') {
+        $now = 0;
+        *CORE::GLOBAL::time = sub () { return $now; };
+        *CORE::GLOBAL::waitpid = sub ($$) {
+            $? = 0;
+            return @login_children ? shift @login_children : -1;
+        };
     }
 }
 
 {
-    package OpenBMC503Response;
+    package RetryTable;
 
-    sub new {
-        return bless {}, shift;
-    }
+    sub getAttribs { return { username => 'test-user', password => 'test-password' }; }
 
-    sub status_line {
-        return '503 Service Unavailable';
+    sub getNodesAttribs {
+        my ($self, $nodes) = @_;
+        return { map { $_ => [{ bmc => "$_.example" }] } @$nodes };
     }
 }
 
-## no critic (BuiltinFunctions::ProhibitStringyEval)
-my $loaded = eval <<"HARNESS";
-package OpenBMC503Harness;
-no strict 'vars';
-use warnings;
-use JSON;
-$retry_after
-$deal_with_response
-1;
-HARNESS
-## use critic
-BAIL_OUT("Could not load the OpenBMC response harness: $@") if !$loaded;
+{
+    package RetryHTTP;
 
-$::RESPONSE_OK                  = '200 OK';
-$::RESPONSE_SERVICE_UNAVAILABLE = '503 Service Unavailable';
-$::UPLOAD_ACTIVATE_STREAM       = 0;
-$::UPLOAD_AND_ACTIVATE          = 0;
+    sub add_with_opts { return $_[0]{send}->($_[1]); }
+    sub wait_for_next_response { return $_[0]{receive}->(); }
+}
 
-my $node     = 'node01';
-my $response = OpenBMC503Response->new();
-my $callback = sub { };
+sub run_fixture {
+    my ($replies) = @_;
+    my (@requests, @messages, @responses, @warnings);
+    local $SIG{__WARN__} = sub { push @warnings, @_; };
+    my $config = tempdir(CLEANUP => 1);
+    $ENV{XCATCFG} = "SQLite:$config";
+    my $source = File::Spec->rel2abs("$FindBin::Bin/../../xCAT-server");
+    my $plugin = "$source/lib/xcat/plugins/openbmc.pm";
+    if (-d "$FindBin::Bin/../../perl-xCAT") {
+        $ENV{XCATROOT} = $source;
+        unshift @INC, "$source/lib/perl", "$source/lib",
+            "$FindBin::Bin/../../perl-xCAT";
+    } else {
+        my $root = $ENV{XCATROOT} || '/opt/xcat';
+        $root = '/opt/xcat' unless -f "$root/lib/perl/xCAT_plugin/openbmc.pm";
+        $ENV{XCATROOT} = $root;
+        unshift @INC, "$root/lib/perl";
+        $plugin = "$root/lib/perl/xCAT_plugin/openbmc.pm";
+    }
 
-$OpenBMC503Harness::callback       = $callback;
-$OpenBMC503Harness::wait_node_num  = 1;
-$OpenBMC503Harness::xcatdebugmode  = 0;
-$OpenBMC503Harness::next_status{LOGIN_RESPONSE} = 'RPOWER_STATUS_REQUEST';
+    $INC{'xCAT_monitoring/monitorctrl.pm'} = __FILE__;
+    require File::Path;
+    {
+        no warnings 'redefine';
+        # Loading the plugin must not create its system log directories.
+        local *File::Path::mkpath = sub { return; };
+        require $plugin;
+    }
 
-for my $attempt (1 .. 3) {
-    subtest "503 retry attempt $attempt is scheduled" => sub {
-        my $handle = "handle-$attempt";
-        $OpenBMC503Harness::handle_id_node{$handle} = $node;
-        $OpenBMC503Harness::node_info{$node}{cur_status} =
-          'RPOWER_STATUS_RESPONSE';
-        delete $OpenBMC503Harness::node_wait{$node};
+    my $handle = 0;
+    my $pid = 1000;
+    $now = 0;
+    no warnings 'redefine';
+    no warnings 'once';
+    local *xCAT::Table::new = sub {
+        my ($class, $name) = @_;
+        die "Unexpected table: $name" unless $name eq 'passwd' || $name eq 'openbmc';
+        return bless {}, 'RetryTable';
+    };
+    local *xCAT::NetworkUtils::getNodeIPaddress = sub { return '192.0.2.1'; };
+    local *xCAT::Utils::xfork = sub {
+        push @login_children, ++$pid;
+        return $pid;
+    };
+    local *LWP::UserAgent::request = sub { die 'Unexpected synchronous HTTP request'; };
+    my $send = sub {
+        my ($request) = @_;
+        my $node = $request->uri->host;
+        $node =~ s/\.example$//;
+        die "Unexpected BMC: $node" unless exists $replies->{$node};
+        my $login = $request->uri->path eq '/login';
+        my $code = $login ? 200 : shift @{$replies->{$node}};
+        die "Unexpected extra request for $node" unless defined $code;
+        push @requests, {
+            node => $node, time => $now, method => $request->method,
+            path => $request->uri->path, content => $request->content,
+            authorization => scalar $request->header('Authorization'),
+        };
+        my $response = HTTP::Response->new($code);
+        $response->content($code == 503 ? 'Service Unavailable' : encode_json({ data => {
+            '/xyz/openbmc_project/state/chassis0' => {
+                CurrentPowerState => 'xyz.openbmc_project.State.Chassis.PowerState.Off',
+                RequestedPowerTransition => 'xyz.openbmc_project.State.Chassis.Transition.Off',
+            },
+            description => 'BMC request failed',
+        } }));
+        push @responses, [$response, ++$handle];
+        return $handle;
+    };
+    my $receive = sub {
+        return @{shift @responses} if @responses;
+        die "Request did not complete" if ++$now > 30;
+        return;
+    };
+    local *HTTP::Async::new = sub {
+        return bless { send => $send, receive => $receive }, 'RetryHTTP';
+    };
+    local $SIG{ALRM} = sub { die "Request timed out\n"; };
+    alarm 10;
+    xCAT_plugin::openbmc::process_request({
+        command => ['rpower'], arg => ['stat'], node => [sort keys %$replies],
+    }, sub { push @messages, $_[0]; });
+    alarm 0;
+    return { requests => \@requests, messages => \@messages, warnings => \@warnings,
+        pending => scalar @responses, remaining => $replies };
+}
 
-        my @warnings;
-        my $before = time();
-        {
-            local $SIG{__WARN__} = sub { push @warnings, @_ };
-            OpenBMC503Harness::deal_with_response($handle, $response);
+if (@ARGV && $ARGV[0] eq '--fixture') {
+    print encode_json(run_fixture(decode_json($ARGV[1])));
+    exit 0;
+}
+
+sub check_request {
+    my ($replies, $expected) = @_;
+    # A fresh interpreter gives each request its own plugin state.
+    open(my $child, '-|', $^X, File::Spec->rel2abs(__FILE__), '--fixture',
+        encode_json($replies)) or die "Cannot start fixture: $!";
+    my $output = do { local $/; <$child> };
+    close $child;
+    is($?, 0, 'request completes without a fixture error');
+    my $result = eval { decode_json($output) };
+    my $decode_error = $@;
+    ok(ref($result) eq 'HASH', 'fixture returns request results') or do {
+        diag($decode_error || $output || 'No fixture output');
+        return;
+    };
+    is_deeply($result->{warnings}, [], 'no runtime warnings');
+    is($result->{pending}, 0, 'all HTTP responses are consumed');
+    is(scalar @{$result->{messages}}, scalar keys %$replies,
+        'only the requested nodes produce results');
+    for my $node (sort keys %$replies) {
+        my @login = grep { $_->{node} eq $node && $_->{path} eq '/login' }
+            @{$result->{requests}};
+        is(scalar @login, 1, "$node logs in once");
+        is($login[0]{method}, 'POST', "$node sends the login request");
+        my @sent = grep { $_->{node} eq $node && $_->{path} ne '/login' }
+            @{$result->{requests}};
+        is_deeply([map { $_->{time} } @sent], $expected->{$node}{times},
+            "$node retries at three-second intervals, then stops");
+        is_deeply([map { [@{$_}{qw(method path content authorization)}] } @sent],
+            [map { ['GET', '/xyz/openbmc_project/state/enumerate', '',
+                'Basic dGVzdC11c2VyOnRlc3QtcGFzc3dvcmQ='] } @{$expected->{$node}{times}}],
+            "$node preserves the request and credentials on each attempt");
+        my $message = { name => [$node] };
+        if (exists $expected->{$node}{error}) {
+            $message->{errorcode} = [1];
+            $message->{error} = [$expected->{$node}{error}];
+        } else {
+            $message->{data} = [{ contents => [$expected->{$node}{result}] }];
         }
-        my $after = time();
+        is_deeply([grep { $_->{node}[0]{name}[0] eq $node } @{$result->{messages}}],
+            [{ node => [$message] }],
+            "$node reports exactly one final result");
+        is_deeply($result->{remaining}{$node}, [], "$node consumes the expected replies");
+    }
+}
 
-        is(
-            $OpenBMC503Harness::node_info{$node}{_503_retries},
-            $attempt,
-            'retry counter is incremented once'
-        );
-        is(
-            $OpenBMC503Harness::node_info{$node}{cur_status},
-            'RPOWER_STATUS_REQUEST',
-            'response state returns to its request state'
-        );
-        cmp_ok(
-            $OpenBMC503Harness::node_wait{$node},
-            '>=',
-            $before + 3,
-            'retry deadline is at least three seconds from entry'
-        );
-        cmp_ok(
-            $OpenBMC503Harness::node_wait{$node},
-            '<=',
-            $after + 3,
-            'retry deadline is no more than three seconds from return'
-        );
-        ok(
-            !exists $OpenBMC503Harness::handle_id_node{$handle},
-            'completed response handle is removed'
-        );
-        is(
-            $OpenBMC503Harness::wait_node_num,
-            1,
-            'node remains active while a retry is pending'
-        );
-        is_deeply(\@xCAT::SvrUtils::messages, [], 'no error is reported');
-        is_deeply(\@warnings, [], 'no warning is emitted');
+for my $failures (0 .. 3) {
+    subtest "success after $failures service-unavailable responses" => sub {
+        check_request({ node01 => [(503) x $failures, 200] }, {
+            node01 => { times => [map { 3 * $_ } 0 .. $failures], result => 'off' },
+        });
     };
 }
 
-subtest 'fourth 503 exhausts retries' => sub {
-    my $handle = 'handle-4';
-    $OpenBMC503Harness::handle_id_node{$handle} = $node;
-    $OpenBMC503Harness::node_info{$node}{cur_status} =
-      'RPOWER_STATUS_RESPONSE';
-    delete $OpenBMC503Harness::node_wait{$node};
+subtest 'the fourth 503 ends the request' => sub {
+    check_request({ node01 => [(503) x 4] }, {
+        node01 => { times => [0, 3, 6, 9], error => '503 Service Unavailable' },
+    });
+};
 
-    my @warnings;
-    {
-        local $SIG{__WARN__} = sub { push @warnings, @_ };
-        OpenBMC503Harness::deal_with_response($handle, $response);
-    }
+subtest 'other errors are not retried' => sub {
+    check_request({ node01 => [502] }, {
+        node01 => { times => [0], error => '[502] BMC request failed' },
+    });
+};
 
-    is(
-        $OpenBMC503Harness::node_info{$node}{_503_retries},
-        4,
-        'retry counter records the exhausted attempt'
-    );
-    is(
-        $OpenBMC503Harness::node_info{$node}{cur_status},
-        'RPOWER_STATUS_RESPONSE',
-        'terminal response state is not rescheduled'
-    );
-    ok(
-        !exists $OpenBMC503Harness::node_wait{$node},
-        'no retry deadline is set'
-    );
-    ok(
-        !exists $OpenBMC503Harness::handle_id_node{$handle},
-        'completed response handle is removed'
-    );
-    is($OpenBMC503Harness::wait_node_num, 0, 'node is completed');
-    is_deeply(
-        \@xCAT::SvrUtils::messages,
-        [[[1, '503 Service Unavailable'], $callback, $node]],
-        'the existing terminal error is reported'
-    );
-    is_deeply(\@warnings, [], 'no warning is emitted');
+subtest 'one exhausted node does not stop or spend another node retry budget' => sub {
+    check_request({ node01 => [(503) x 4], node02 => [503, 503, 503, 200], node03 => [200] }, {
+        node01 => { times => [0, 3, 6, 9], error => '503 Service Unavailable' },
+        node02 => { times => [0, 3, 6, 9], result => 'off' },
+        node03 => { times => [0], result => 'off' },
+    });
 };
 
 done_testing();