eventdebug.pl.in 2.96 KB
Newer Older
1
#!/usr/bin/perl
Mike Hibler's avatar
Mike Hibler committed
2
#
3
# Copyright (c) 2002-2016 University of Utah and the Flux Group.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
# 
# {{{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/>.
# 
# }}}
Mike Hibler's avatar
Mike Hibler committed
23 24
#

25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
#
# Debug the event system by subscribing to and printing all events - event
# system analog of tcpdump. An trivial modification of tbrecv.pl
#

#
# Configure variables
#

use lib '@prefix@/lib';

use event;
use Getopt::Std;
use strict;

sub usage {
41
	warn "Usage: $0 [-b] [-s server] [-p port] [pid/eid]\n";
42 43 44 45
	return 1;
}

my %opt = ();
46
my $expt = "";
47
getopt("s:p:hb", \%opt);
48 49

if ($opt{h}) { exit &usage; }
50 51 52 53 54 55 56 57
if (@ARGV) {
    $expt = shift @ARGV;
}
if (@ARGV) {
    usage();
    exit 1;
}

58 59

my ($server,$port);
60 61
if ($opt{s}) { $server = $opt{s}; } else { $server = "localhost"; }
if ($opt{b}) { $port = @BOSSEVENTPORT@ ; }
62 63 64 65 66 67 68 69 70 71 72
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"; }

73 74 75 76
if ($expt) {
    %$tuple = ( expt => $expt );
}

77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
my $gotone;

sub callbackFunc($$$) {
	my ($handle,$notification,$data) = @_;

	my $time      = time();
	my $site      = event_notification_get_site($handle, $notification);
	my $expt      = event_notification_get_expt($handle, $notification);
	my $group     = event_notification_get_group($handle, $notification);
	my $host      = event_notification_get_host($handle, $notification);
	my $objtype   = event_notification_get_objtype($handle, $notification);
	my $objname   = event_notification_get_objname($handle, $notification);
	my $eventtype = event_notification_get_eventtype($handle,
		$notification);
	print "Event: $time $site $expt $group $host $objtype $objname " .
		"$eventtype\n";

	$gotone++;
}

97 98 99 100 101 102 103 104 105 106
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) {
107 108 109
    $gotone = 1;
    while ($gotone) {
	$gotone = 0;
110
	event_poll($handle);
111 112
    }
    event_poll_blocking($handle, 5000);
113 114 115 116 117 118 119 120
}

if (event_unregister($handle) == 0) {
	die "Unable to unregister with event system\n";
}

exit(0);