All new accounts created on Gitlab now require administrator approval. If you invite any collaborators, please let Flux staff know so they can approve the accounts.

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