Commit 19af165b authored by Mike Hibler's avatar Mike Hibler

Example perl script to receive and print FRISBEESTATUS events.

parent 9b239951
#
# Copyright (c) 2002-2011 University of Utah and the Flux Group.
# Copyright (c) 2002-2016 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
......@@ -27,7 +27,7 @@ OBJDIR = ../..
SUBDIR = event/example
SYSTEM := $(shell uname -s)
PROGRAMS = tbrecv tbsend tbrecv.py tbsend.py eventdebug.pl
PROGRAMS = tbrecv tbsend tbrecv.py tbsend.py eventdebug.pl tbfrisbee.pl
include $(OBJDIR)/Makeconf
......
#!/usr/bin/perl
#
# Copyright (c) 2002-2017 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
# This file is part of the Emulab network testbed software.
#
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
#
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public
# License for more details.
#
# You should have received a copy of the GNU Affero General Public License
# along with this file. If not, see <http://www.gnu.org/licenses/>.
#
# }}}
#
#
# This is a sample client to run on a testbed node to capture TBEXAMPLE
# events for the node. Perl equivalent of tbrecv.c
#
#
# Configure variables
#
use lib '@prefix@/lib';
use event;
use Getopt::Std;
use strict;
my $server = "boss";
my $port = 16505;
sub usage {
warn "Usage: $0 [-s server] [-p port]\n";
return 1;
}
my %opt = ();
getopt(\%opt,"s:p:h");
if ($opt{h}) { exit &usage; }
if (@ARGV) { exit &usage; }
if ($opt{s}) { $server = $opt{s}; } else { $server = "localhost"; }
if ($opt{p}) { $port = $opt{p}; }
my $URL = "elvin://$server";
if ($port) { $URL .= ":$port"; }
my $handle = event_register($URL,0);
if (!$handle) { die "Unable to register with event system\n"; }
my $tuple = address_tuple_alloc();
if (!$tuple) { die "Could not allocate an address tuple\n"; }
%$tuple = ( objtype => 'FRISBEESTATUS' );
if (!event_subscribe($handle,\&callbackFunc,$tuple)) {
die "Could not subscribe to event\n";
}
#
# Note a difference from tbrecv.c - we don't yet have event_main() functional
# in perl, so we have to poll. (Nothing special about the select, it's just
# a wacky way to get usleep() )
#
while (1) {
event_poll($handle);
select(undef, undef, undef, 0.25);
}
if (event_unregister($handle) == 0) {
die "Unable to unregister with event system\n";
}
exit(0);
my %images = ();
sub callbackFunc($$$) {
my ($handle,$note,$data) = @_;
my @val = ();
my $expt = event_notification_get_expt($handle, $note);
my $host = event_notification_get_host($handle, $note);
my $node = event_notification_get_objname($handle, $note);
my $image = event_notification_get_eventtype($handle, $note);
my $tstamp = event_notification_get_string($handle, $note, "TSTAMP");
my $seq = event_notification_get_string($handle, $note, "SEQUENCE");
my $rchunks = event_notification_get_string($handle, $note, "CHUNKS_RECV");
my $dchunks = event_notification_get_string($handle, $note, "CHUNKS_DECOMP");
my $wbytes = event_notification_get_string($handle, $note, "BYTES_WRITTEN");
if (!exists($images{$image})) {
my $isize = `imageinfo -s $image`;
if ($? || !defined($isize)) {
$isize = 0;
}
my $usize = `imageinfo -u $image`;
if ($? || !defined($usize)) {
$usize = 0;
}
$images{$image}{'chunks'} = int($isize / 1048576);
$images{$image}{'bytes'} = int($usize);
}
my ($rpct,$dpct,$wpct);
$rpct = $dpct = $wpct = "??";
if ($images{$image}{'chunks'} > 0) {
$rpct = sprintf "%.1f", $rchunks / $images{$image}{'chunks'} * 100;
$dpct = sprintf "%.1f", $dchunks / $images{$image}{'chunks'} * 100;
}
if ($images{$image}{'bytes'} > 0) {
$wpct = sprintf "%.1f", $wbytes / $images{$image}{'bytes'} * 100;
}
print "$node\@$tstamp: image=$image seq=$seq recv=$rchunks ($rpct\%)".
" decomp=$dchunks ($dpct\%) bwritten=$wbytes ($wpct\%)\n";
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment