summaryrefslogtreecommitdiffstats
path: root/3rdparty/openpgm-svn-r1135/pgm/test/ambient_spm.pl
blob: 90de632a60a85fef34fa9a0a771c42d40e9e5c25 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
#!/usr/bin/perl
# ambient_spm.pl
# 5.1.4. Ambient SPMs

use strict;
use PGM::Test;
use IO::Handle;

BEGIN { require "test.conf.pl"; }

$| = 1;

my $mon = PGM::Test->new(tag => 'mon', host => $config{mon}{host}, cmd => $config{mon}{cmd});
my $app = PGM::Test->new(tag => 'app', host => $config{app}{host}, cmd => $config{app}{cmd});

pipe(FROM_PARENT, TO_CHILD) or die "pipe: $!";
FROM_PARENT->autoflush(1);

$mon->connect;
$app->connect;

sub close_ssh {
	close FROM_PARENT; close TO_CHILD;
	$mon = $app = undef;
	print "finished.\n";
}

$SIG{'INT'} = sub { print "interrupt caught.\n"; close_ssh(); };

$mon->say ("filter $config{app}{ip}");
print "mon: ready.\n";

$app->say ("create ao");
$app->say ("bind ao");
$app->say ("connect ao");
$app->say ("listen ao");

if (my $pid = fork) {
# parent 
	close FROM_PARENT;

	print "mon: wait for odata ...\n";
	$mon->wait_for_odata;
	print "mon: odata received.\n";
	print "mon: wait for spm ...\n";
	$mon->wait_for_spm ({ 'timeout' => 45 });
	print "mon: received spm.\n";

	print TO_CHILD "die\n";

	close TO_CHILD;
	waitpid($pid,0);
} else {
# child
	die "cannot fork: $!" unless defined $pid;
	close TO_CHILD;
	print "app: loop sending data.\n";
	vec(my $rin, fileno(FROM_PARENT), 1) = 1;
	my $rout = undef;

# hide stdout
	open(OLDOUT, ">&STDOUT");
	open(STDOUT, ">/dev/null") or die "Can't redirect stdout: $!";

# send every ~50ms
	while (! select($rout = $rin, undef, undef, 0.05))
	{
		$app->say ("send ao ringo");
	}

# restore stdout
	close(STDOUT) or die "Can't close STDOUT: $!";
	open(STDOUT, ">&OLDOUT") or die "Can't restore stdout: $!";
	close(OLDOUT) or die "Can't close OLDOUT: $!";

	print "app: loop finished.\n";
	close FROM_PARENT;
	exit;
}

print "test completed successfully.\n";

$mon->disconnect (1);
$app->disconnect;
close_ssh;

# eof