grabron.in 7.38 KB
Newer Older
Robert Ricci's avatar
Robert Ricci committed
1
#!/usr/bin/perl -w
Leigh Stoller's avatar
Leigh Stoller committed
2 3

#
4
# Copyright (c) 2000-2003 University of Utah and the Flux Group.
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
# 
# {{{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/>.
# 
# }}}
Leigh Stoller's avatar
Leigh Stoller committed
24
#
Robert Ricci's avatar
Robert Ricci committed
25 26 27 28 29 30 31 32 33 34 35 36 37 38
#
# grabron - Grab data from Dave Andersen's DBSYNC program, and upload it into
# the testbed database
#

use strict;

use IO::Socket;
use Net::hostent;

use lib '@prefix@/lib';
use libdb;
use libtestbed;

39 40 41 42 43
sub get_ipmap();
sub get_bandwidths();
sub upload_times($$$);
sub get_times($);

Robert Ricci's avatar
Robert Ricci committed
44 45
my $TB = '@prefix@';

Robert Ricci's avatar
Robert Ricci committed
46 47 48 49 50 51 52 53
#
# This is the magic node which is equivalent to the TBDB_WIDEAREA_LOCALNODE .
# This could be moved to a configure variable, but I'm not going to do so
# until there's a need to go to that trouble. It's hacky, no matter where
# you put it.
#
my $MAGICNODE = "ron2";

Robert Ricci's avatar
Robert Ricci committed
54 55
my $logfile = "$TB/log/grabron";

56 57
my $debug = 0;

58 59
if (@ARGV != 1) {
    die "Usage: $0 <url>\n";
Robert Ricci's avatar
Robert Ricci committed
60
}
61
my ($url) = @ARGV;
62
if (! ($url =~ /^http:\/\/([\w.-]+)\/(.*)$/) ) {
63 64 65 66
    die "URL must be in the form http://host/path\n";
}
my ($host,$path) = ($1,$2);
print "Host is $host, path is $path\n";
Robert Ricci's avatar
Robert Ricci committed
67 68 69 70 71 72

$| = 1;

#
# Time in beteen polls
#
73
my $interval = 25 * 60 *60; # 24 hours
Robert Ricci's avatar
Robert Ricci committed
74

Robert Ricci's avatar
Robert Ricci committed
75 76 77 78 79 80 81 82 83
#
# Find out the interface to use for the TBDB_WIDEAREA_LOCALNODE, since I don't
# want to hardcode it anywhere.
# XXX: What if it has more than one interface?
#
my $result = DBQueryFatal("select iface from interfaces where node_id='" .
	TBDB_WIDEAREA_LOCALNODE . "'");
if ($result->num_rows() != 1){
    die "Unable to determine iface for " . TBDB_WIDEAREA_LOCALNODE . "\n";
Robert Ricci's avatar
Robert Ricci committed
84
}
Robert Ricci's avatar
Robert Ricci committed
85 86
my ($localIface) = ($result->fetchrow());

87 88 89 90
if (!$debug) {
    if (TBBackGround($logfile)) {
	exit(0);
    }
91
}
Robert Ricci's avatar
Robert Ricci committed
92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110

#
# Start out with the the last $interval seconds
#
my $last_time = time - $interval;

while (1) {
    my @times = get_times($last_time);
    $last_time = time;
    if (@times) {
    	my %ipmap = get_ipmap();
    	my %bandwidths = get_bandwidths();
    	upload_times(\@times,\%ipmap,\%bandwidths);
    }

    sleep($interval);
}

sub get_ipmap() {
111
    my $result = DBQueryFatal("select node_id,iface, IP from interfaces");
Robert Ricci's avatar
Robert Ricci committed
112 113 114 115 116 117 118 119
    my %map = ();
    while (my ($node_id,$iface,$IP) = $result->fetchrow()) {
	$map{$IP} = [$node_id, $iface];
    }
    return %map;
}

sub get_bandwidths() {
120 121
    my $result = DBQueryFatal("select node_id1,iface1,node_id2,iface2, ".
	    "bandwidth from widearea_delays");
Robert Ricci's avatar
Robert Ricci committed
122
    my %map = ();
123 124
    while (my ($node1,$if1,$node2,$if2,$bandwidth) = $result->fetchrow()) {
	$map{"$node1:$if1 $node2:$if2"} = $bandwidth;
Robert Ricci's avatar
Robert Ricci committed
125 126 127 128 129 130 131 132 133 134 135 136
    }
    return %map;
}

sub upload_times($$$) {
    my ($rTimes,$rIPmap,$rBandwidths) = @_;
    my @times = @$rTimes;
    my %ipmap = %$rIPmap;
    my %bandwidths = %$rBandwidths;
    my $suceeded = 0;
    my $failed = 0;
    foreach my $time (@times) {
137
	my ($src,$dst,$latency,$stddev,$lossrate) = @$time;
Robert Ricci's avatar
Robert Ricci committed
138 139 140 141 142 143 144 145 146 147 148 149
	if (!$ipmap{$src}) {
	    warn "Got an IP ($src) that's not in the interfaces table\n";
	    $failed++;
	    next;
	}
	my ($node_id1, $iface1) = @{$ipmap{$src}};
	if (!$ipmap{$dst}) {
	    warn "Got an IP ($dst) that's not in the interfaces table\n";
	    $failed++;
	    next;
	}
	my ($node_id2, $iface2) = @{$ipmap{$dst}};
150 151
	my $bandwidth = $bandwidths{"$node_id1:$iface1 $node_id2:$iface2"};
	if (!defined $bandwidth) {
152 153
	    warn "Got a pair ($node_id1:$iface1 $node_id2:$iface2) that has ".
		    "no bandwidth\n";
154
	    $bandwidth = -1;
Robert Ricci's avatar
Robert Ricci committed
155 156 157 158 159 160 161 162 163 164
	}
	if (!defined($latency)) {
	    #
	    # If no latency, that means we can't get there from here, so
	    # we provide -1s in bandwidth and latency, to specify that
	    #
	    $latency = -1;
	    $bandwidth = -1;
	}
	$suceeded++;
Robert Ricci's avatar
Robert Ricci committed
165 166 167
	DBQueryFatal("replace into widearea_recent set time=$latency, " .
		"node_id1='$node_id1', iface1='$iface1', ".
		"node_id2='$node_id2', iface2='$iface2', " .
168
		" bandwidth=$bandwidth, time_stddev='$stddev', " .
169 170
		" lossrate='$lossrate', start_time=$::last_time, " .
		" end_time=$::end_time");
Robert Ricci's avatar
Robert Ricci committed
171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190
	#
	# If either (or both) endpoints are the magic node, we update
	# the database again, with the WIDEAREA_LOCALNODE instead.
	#
	if (($node_id1 eq $MAGICNODE) || ($node_id2 eq $MAGICNODE)) {
	    if ($node_id1 eq $MAGICNODE) {
		$node_id1 = TBDB_WIDEAREA_LOCALNODE;
		$iface1 = $localIface;
	    }
	    if ($node_id2 eq $MAGICNODE) {
		$node_id2 = TBDB_WIDEAREA_LOCALNODE;
		$iface2 = $localIface;
	    }
	    DBQueryFatal("replace into widearea_recent set time=$latency, ".
		" node_id1='$node_id1', iface1='$iface1', ".
		" node_id2='$node_id2', iface2='$iface2', " .
		" bandwidth=$bandwidth, time_stddev='$stddev', " .
		" lossrate='$lossrate', start_time=$::last_time, " .
		" end_time=$::end_time");
	}
Robert Ricci's avatar
Robert Ricci committed
191 192 193 194 195 196 197 198

    }

    print "Database upload done: $suceeded suceeded, $failed failed\n";
}

sub get_times($) {
    my ($last_time) = (@_);
199 200 201
    my $end_time = time();
    
    print "Connecting to $host\n";
Robert Ricci's avatar
Robert Ricci committed
202 203 204

    my $remote = IO::Socket::INET->new ( Proto => "tcp",
    					 PeerAddr => $host,
205
					 PeerPort => 80 );
Robert Ricci's avatar
Robert Ricci committed
206
    if (!$remote) {
207
	warn "Unable to connect to to $host\n";
Robert Ricci's avatar
Robert Ricci committed
208 209 210 211
	return ();
    }

    $remote->autoflush(1); # Equivalent of $| = 1
212 213
	
    print "Giving times $last_time $end_time\n";
Robert Ricci's avatar
Robert Ricci committed
214

215 216 217 218
    my $args = "start=$last_time&end=$end_time&format=avgTxt";
    print $remote "GET http://$host/$path?$args HTTP/1.0\n";
    print $remote "User-Agent: grabron\n";
    print $remote "\n";
Robert Ricci's avatar
Robert Ricci committed
219

220 221 222 223 224
    #
    # Set some gloabls, so that other functions see these times
    #
    $::last_time = $last_time;
    $::end_time = $end_time;
Robert Ricci's avatar
Robert Ricci committed
225

226 227 228 229 230
    $/ = "\r\n"; # Use CRLF instead of just LF to delimit lines
    my @data = <$remote>;
    chomp @data;
    if (!@data) {
	warn "No data returned\n";
Robert Ricci's avatar
Robert Ricci committed
231 232 233 234 235
	undef $remote;
	return ();
    }

    #
236
    # Check HTTP header, make sure we got back a 200
Robert Ricci's avatar
Robert Ricci committed
237
    #
238 239 240
    my $firstline = shift @data;
    if (! ($firstline =~ /^HTTP\/\d\.\d (\d+) (.*)$/)) {
	warn "Unexpected header: $firstline\n";
Robert Ricci's avatar
Robert Ricci committed
241 242 243
	undef $remote;
	return ();
    }
244 245 246
    my ($status,$stext) = ($1,$2);
    if ($status != 200) {
	warn "Unexpected status: $status $stext\n";
Robert Ricci's avatar
Robert Ricci committed
247 248 249 250
	undef $remote;
	return ();
    }

251
    #
252
    # Eat the rest of the headers
253
    #
254
    while (shift @data) { }
Robert Ricci's avatar
Robert Ricci committed
255 256

    #
257 258
    # XXX - hack to work around oddity in fetchAll's output - it uses CRLF for
    # headers (the standard), but newlines for the body
Robert Ricci's avatar
Robert Ricci committed
259
    #
260 261 262
    if (@data == 1) {
	@data = split /\n/,$data[0];
    }
Robert Ricci's avatar
Robert Ricci committed
263 264 265 266

    my @return;
    foreach my $line (@data) {
	chomp $line;
267 268 269
	if ($debug) {
	    print "got line $line\n";
	}
270
	if (! ($line =~ /(\d+\.\d+.\d+\.\d+)\s+(\d+\.\d+.\d+\.\d+)\s+(\d+\.\d+)\s+(\d+\.\d+)\s+(\d+)\s+(\d+)/) ) {
Robert Ricci's avatar
Robert Ricci committed
271 272 273 274
	    warn "Bad data line: $line\n";
	    next;
	}

275 276
	my ($src,$dst,$avg,$stddev,$successful,$unsuccessful)
	    = ($1,$2,$3,$4,$5,$6);
Robert Ricci's avatar
Robert Ricci committed
277
	if ($successful > 0) {
278 279
	    my $lossrate = ($unsuccessful*1.0)/($successful + $unsuccessful);
	    push @return, [$src,$dst,$avg,$stddev,$lossrate];
Robert Ricci's avatar
Robert Ricci committed
280
	} elsif ($unsuccessful > 0) {
281
	    push @return, [$src,$dst,undef,$stddev,1];
Robert Ricci's avatar
Robert Ricci committed
282 283 284 285 286 287 288 289 290 291
	}
    }

    print "Got " . scalar(@return) . " lines of new data\n";

    undef $remote;

    return @return;

}