summaryrefslogtreecommitdiffstats
path: root/3rdparty/openpgm-svn-r1085/pgm/test/PGM/Test.pm
diff options
context:
space:
mode:
Diffstat (limited to '3rdparty/openpgm-svn-r1085/pgm/test/PGM/Test.pm')
-rw-r--r--3rdparty/openpgm-svn-r1085/pgm/test/PGM/Test.pm394
1 files changed, 394 insertions, 0 deletions
diff --git a/3rdparty/openpgm-svn-r1085/pgm/test/PGM/Test.pm b/3rdparty/openpgm-svn-r1085/pgm/test/PGM/Test.pm
new file mode 100644
index 0000000..cb2ee6d
--- /dev/null
+++ b/3rdparty/openpgm-svn-r1085/pgm/test/PGM/Test.pm
@@ -0,0 +1,394 @@
+package PGM::Test;
+
+use strict;
+our($VERSION);
+use Carp;
+use IO::File;
+use IPC::Open2;
+use Net::SSH qw(sshopen2);
+use Sys::Hostname;
+use POSIX ":sys_wait_h";
+use JSON;
+
+$VERSION = '1.00';
+
+=head1 NAME
+
+PGM::Test - PGM test module
+
+=head1 SYNOPSIS
+
+ $test = PGM::Test->new();
+
+=cut
+
+my $json = new JSON;
+
+sub new {
+ my $class = shift;
+ my $self = {};
+ my %params = @_;
+
+ $self->{tag} = exists $params{tag} ? $params{tag} : confess "tag parameter is required";
+ $self->{host} = exists $params{host} ? $params{host} : confess "host parameter is required";
+ $self->{cmd} = exists $params{cmd} ? $params{cmd} : confess "cmd parameter is required";
+
+ $self->{in} = IO::File->new();
+ $self->{out} = IO::File->new();
+ $self->{pid} = undef;
+
+ bless $self, $class;
+ return $self;
+}
+
+sub connect {
+ my $self = shift;
+ my $host = hostname;
+
+ if ($self->{host} =~ /^(localhost|127\.1|127\.0\.0\.1|$host)$/)
+ {
+ print "$self->{tag}: opening local connection\n";
+ $self->{pid} = open2 ($self->{in},
+ $self->{out},
+ "uname -a && sudo $self->{cmd}")
+ or croak "open2 failed $!";
+ }
+ else
+ {
+ print "$self->{tag}: opening SSH connection to $self->{host} ...\n";
+ $self->{pid} = sshopen2 ($self->{host},
+ $self->{in},
+ $self->{out},
+ "uname -a && sudo $self->{cmd}")
+ or croak "SSH failed: $!";
+ }
+
+ print "$self->{tag}: connected.\n";
+ $self->wait_for_ready;
+}
+
+sub disconnect {
+ my($self,$quiet) = @_;
+ my $out = $self->{out};
+
+ print "$self->{tag}: sending quit command ...\n";
+ eval {
+ local($SIG{ALRM}) = sub { die "alarm\n"; };
+ alarm 10;
+ print $out "quit\n";
+ while (readline($self->{in})) {
+ chomp;
+ print "$self->{tag} [$_]\n" if (!$quiet);
+ }
+ alarm 0;
+ };
+ if ($@) {
+ print "$self->{tag}: alarm raised on quit command.\n";
+ } else {
+ print "$self->{tag}: eof.\n";
+ }
+
+ print "$self->{tag}: closing SSH connection ...\n";
+ close ($self->{in});
+ close ($self->{out});
+ print "$self->{tag}: closed.\n";
+}
+
+sub DESTROY {
+ my $self = shift;
+
+ if ($self->{pid}) {
+ print "$self->{tag}: waiting child to terminate ...\n";
+ eval {
+ local($SIG{ALRM}) = sub { die "alarm\n"; };
+ alarm 10;
+ waitpid $self->{pid}, 0;
+ alarm 0;
+ };
+ if ($@) {
+ die unless $@ eq "alarm\n";
+ local($SIG{CHLD}) = 'IGNORE';
+ print "$self->{tag}: killing child ...\n";
+ kill 'INT' => $self->{pid};
+ print "$self->{tag}: killed.\n";
+ } else {
+ print "$self->{tag}: terminated.\n";
+ }
+ }
+}
+
+sub wait_for_ready {
+ my $self = shift;
+
+ while (readline($self->{in})) {
+ chomp;
+ print "$self->{tag} [$_]\n";
+ last if /^READY/;
+ }
+}
+
+sub wait_for_block {
+ my $self = shift;
+ my $fh = $self->{in};
+ my $b = '';
+ my $state = 0;
+
+ while (<$fh>) {
+ chomp();
+ my $l = $_;
+ if ($state == 0) {
+ if ($l =~ /^{$/) {
+ $state = 1;
+ } else {
+ print "$self->{tag} [$l]\n";
+ }
+ }
+
+ if ($state == 1) {
+ $b .= $l;
+
+ if ($l =~ /^}$/) {
+ $state = 0;
+ return $b;
+ }
+ }
+ }
+}
+
+sub wait_for_spm {
+ my $self = shift;
+ my $timeout = ref($_[0]) ? $_[0]->{'timeout'} : 10;
+ my $obj = undef;
+
+ eval {
+ local $SIG{ALRM} = sub { die "alarm\n"; };
+ alarm $timeout;
+ for (;;) {
+ my $block = $self->wait_for_block;
+ $obj = $json->jsonToObj($block);
+ last if ($obj->{PGM}->{type} =~ /SPM$/);
+ }
+ alarm 0;
+ };
+ if ($@) {
+ die unless $@ eq "alarm\n";
+ confess "$self->{tag}: alarm raised waiting for spm.\n";
+ }
+
+ return $obj;
+}
+
+sub wait_for_spmr {
+ my $self = shift;
+ my $timeout = ref($_[0]) ? $_[0]->{'timeout'} : 10;
+ my $obj = undef;
+
+ eval {
+ local $SIG{ALRM} = sub { die "alarm\n"; };
+ alarm $timeout;
+ for (;;) {
+ my $block = $self->wait_for_block;
+ $obj = $json->jsonToObj($block);
+ last if ($obj->{PGM}->{type} =~ /SPMR/);
+ }
+ alarm 0;
+ };
+ if ($@) {
+ die unless $@ eq "alarm\n";
+ confess "$self->{tag}: alarm raised waiting for spmr.\n";
+ }
+
+ return $obj;
+}
+
+sub die_on_spmr {
+ my $self = shift;
+ my $timeout = ref($_[0]) ? $_[0]->{'timeout'} : 10;
+ my $obj = undef;
+
+ eval {
+ local $SIG{ALRM} = sub { die "alarm\n"; };
+ alarm $timeout;
+ for (;;) {
+ my $block = $self->wait_for_block;
+ $obj = $json->jsonToObj($block);
+ last if ($obj->{PGM}->{type} =~ /SPMR/);
+ }
+ alarm 0;
+ };
+ if ($@) {
+ die unless $@ eq "alarm\n";
+ return $obj;
+ }
+
+ confess "$self->{tag}: spmr received during blackout.\n";
+}
+
+# data to {app}
+sub wait_for_data {
+ my $self = shift;
+ my $fh = $self->{in};
+ my $timeout = ref($_[0]) ? $_[0]->{'timeout'} : 10;
+ my $data = undef;
+
+ eval {
+ local $SIG{ALRM} = sub { die "alarm\n"; };
+ alarm $timeout;
+ while (<$fh>) {
+ chomp;
+ if (/^DATA: (.+)$/) {
+ $data = $1;
+ last;
+ }
+ print "$self->{tag} [$_]\n";
+ }
+ alarm 0;
+ };
+ if ($@) {
+ die unless $@ eq "alarm\n";
+ confess "$self->{tag}: alarm raised waiting for data.\n";
+ }
+
+ return $data;
+}
+
+sub wait_for_odata {
+ my $self = shift;
+ my $timeout = ref($_[0]) ? $_[0]->{'timeout'} : 10;
+ my $obj = undef;
+
+ eval {
+ local $SIG{ALRM} = sub { die "alarm\n"; };
+ alarm $timeout;
+ for (;;) {
+ my $block = $self->wait_for_block;
+ $obj = $json->jsonToObj($block);
+ last if ($obj->{PGM}->{type} =~ /ODATA/);
+ }
+ alarm 0;
+ };
+ if ($@) {
+ die unless $@ eq "alarm\n";
+ confess "$self->{tag}: alarm raised waiting for odata.\n";
+ }
+
+ return $obj;
+}
+
+sub wait_for_rdata {
+ my $self = shift;
+ my $timeout = ref($_[0]) ? $_[0]->{'timeout'} : 10;
+ my $obj = undef;
+
+ eval {
+ local $SIG{ALRM} = sub { die "alarm\n"; };
+ alarm $timeout;
+ for (;;) {
+ my $block = $self->wait_for_block;
+ $obj = $json->jsonToObj($block);
+ last if ($obj->{PGM}->{type} =~ /RDATA/);
+ }
+ alarm 0;
+ };
+ if ($@) {
+ die unless $@ eq "alarm\n";
+ confess "$self->{tag}: alarm raised waiting for rdata.\n";
+ }
+
+ return $obj;
+}
+
+sub die_on_nak {
+ my $self = shift;
+ my $timeout = ref($_[0]) ? $_[0]->{'timeout'} : 10;
+ my $obj = undef;
+
+ eval {
+ local $SIG{ALRM} = sub { die "alarm\n"; };
+ alarm $timeout;
+ for (;;) {
+ my $block = $self->wait_for_block;
+ $obj = $json->jsonToObj($block);
+ last if ($obj->{PGM}->{type} =~ /NAK/);
+ }
+ alarm 0;
+ };
+ if ($@) {
+ die unless $@ eq "alarm\n";
+ return $obj;
+ }
+
+ confess "$self->{tag}: nak received during blackout.\n";
+}
+
+sub wait_for_nak {
+ my $self = shift;
+ my $timeout = ref($_[0]) ? $_[0]->{'timeout'} : 10;
+ my $obj = undef;
+
+ eval {
+ local $SIG{ALRM} = sub { die "alarm\n"; };
+ alarm $timeout;
+ for (;;) {
+ my $block = $self->wait_for_block;
+ $obj = $json->jsonToObj($block);
+ last if ($obj->{PGM}->{type} =~ /NAK/);
+ }
+ alarm 0;
+ };
+ if ($@) {
+ die unless $@ eq "alarm\n";
+ confess "$self->{tag}: alarm raised waiting for nak.\n";
+ }
+
+ return $obj;
+}
+
+sub wait_for_ncf {
+ my $self = shift;
+ my $timeout = ref($_[0]) ? $_[0]->{'timeout'} : 10;
+ my $obj = undef;
+
+ eval {
+ local $SIG{ALRM} = sub { die "alarm\n"; };
+ alarm $timeout;
+ for (;;) {
+ my $block = $self->wait_for_block;
+ $obj = $json->jsonToObj($block);
+ last if ($obj->{PGM}->{type} =~ /NCF/);
+ }
+ alarm 0;
+ };
+ if ($@) {
+ die unless $@ eq "alarm\n";
+ confess "$self->{tag}: alarm raised waiting for ncf.\n";
+ }
+
+ return $obj;
+}
+
+sub print {
+ my $self = shift;
+ my $timeout = ref($_[0]) ? $_[0]->{'timeout'} : 10;
+ my $out = $self->{out};
+
+ print "$self->{tag}> @_";
+ eval {
+ local($SIG{ALRM}) = sub { die "alarm\n"; };
+ alarm $timeout;
+ print $out "@_";
+ $self->wait_for_ready;
+ alarm 0;
+ };
+ if ($@) {
+ die unless $@ eq "alarm\n";
+ confess "$self->{tag}: alarm raised.\n";
+ }
+}
+
+sub say {
+ my $self = shift;
+ $self->print ("@_\n");
+}
+
+1;
generated by cgit v1.2.3-55-g7522 (git 2.39.0) at 2024-06-06 19:15:27 +0200