tbfrisbee.pl.in 3.6 KB
Newer Older
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 88 89 90 91 92 93 94 95 96 97 98 99 100 101
#!/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");
102
	my $wmbytes = event_notification_get_string($handle, $note, "MBYTES_WRITTEN");
103 104 105 106 107 108 109 110 111 112 113

	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);
114
	    $images{$image}{'mbytes'} = int($usize / 1048576);
115 116 117 118 119 120 121
	}
	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;
	}
122 123
	if ($images{$image}{'mbytes'} > 0) {
	    $wpct = sprintf "%.1f", $wmbytes / $images{$image}{'mbytes'} * 100;
124 125
	}
	print "$node\@$tstamp: image=$image seq=$seq recv=$rchunks ($rpct\%)".
126
	    " decomp=$dchunks ($dpct\%) bwritten=$wmbytes ($wpct\%)\n";
127
}