idlestats.in 11.2 KB
Newer Older
1 2
#!/usr/bin/perl -wT
#
3
# Copyright (c) 2016-2017 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 23 24 25 26 27
# 
# {{{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/>.
# 
# }}}
#
use strict;
use English;
use Getopt::Std;
use Date::Parse;
28
use POSIX qw/ceil floor/;
29
use RRDs;
30
use JSON;
31

32
use lib "@prefix@/lib";
33 34 35 36
use libdb;
use libtestbed;
use EmulabConstants;
use Experiment;
37
use Interface;
38 39 40
use Node;
use User;

41 42 43
# Protos
sub get_stats($$$;$);

44
# Constants
45
my $TB = "@prefix@";
46
my $STEP = 3600; # 1 hour (in seconds).  This should be an RRA epoch.
47
my $RAWSTEP = 300; # periodicity of raw samples.
48
my $DEFWINDOW = 86400 * 14; # two weeks (in seconds).
49 50 51
my $MINTIMESPECLEN = 6;
my $MAXTIMESPECLEN = 100;
my $SD_STATSDIR = "$TB/data/slothd_rrd";
52
my $ALLZEROMAC = "000000000000";
53 54

# Globals
55
my $g_step = $STEP;
56
my $g_doboth = 0;
57
my $g_doraw = 0;
58 59
my $g_valtype = "MAX";
my $g_now = time();
60 61
my $g_end;
my $g_start;
62 63
my $g_experiment;
my @g_nodelist = ();
64
my $g_silent = 0;
65 66 67

sub usage() {
    print STDERR
68
	"Return JSON-encoded node activity stastics.\n\n".
69 70
	"Usage: $0 [-d] [-A|-B] [-R] [-S <start_time>] [-E <end_time>] node [node ...]\n" .
	"       $0 [-d] [-A|-B] [-R] [-S <start_time>] [-E <end_time>] -e <pid>,<eid>\n".
71
	"-d:              turn on debugging.\n" .
72
	"-s:              silent mode, no warnings\n" .
73
	"-A:              return averages instead of maximums.\n".
74
	"-B:              return both average and maximum data points.\n".
75
	"-R:              include the latest day's raw 5 minute samples.\n".
76 77 78 79
	"-e <pid>,<eid>:  request data for nodes in an experiment.\n".
	"-S <start_time>: bound the start of the returned data.\n".
	"                 Default is beginning of available data for a list of nodes,\n".
	"                 or the beginning of the specified experiment.\n".
80
	"-E <end_time>:   bound the end of the returned data. Default is 'now'.\n".
81
	"\n".
82 83 84 85 86 87 88
	"Start/end times can be specified as anything recognized by the\n".
	"Date::Parse module. When requesting experiment data, start times\n".
	"prior to the start of the experiment will be truncated to the beginning\n". 
	"of the experiment (with a warning). The start time must be less than\n".
	"the end time. Returned data is reported at a fixed 1 hour granularity.\n".
	"Data series with no data points are indicated as such with stub\n".
	"entries in the output.\n";
89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112
    exit 1;
}

# un-taint path
$ENV{'PATH'} = '/bin:/sbin:/usr/bin:/usr/local/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

# Turn off line buffering on output
$| = 1;

#
# Verify user and get his DB uid and other info for later.
#
my $user;
if ($UID) {
    $user = User->ThisUser();
    if (! defined($user)) {
	die("*** $0:\n".
	    "    You ($UID) do not exist!\n");
    }
}

my %opts = ();

113
if (!getopts("dhABRS:E:e:s", \%opts) || $opts{'h'}) {
114 115 116
    usage();
}

117
if ($opts{'A'}) {
118 119 120
    $g_valtype = "AVERAGE";
}

121 122 123 124
if ($opts{'s'}) {
    $g_silent = 1;
}

125 126
if ($opts{'B'}) {
    $g_doboth = 1;
127 128
}

129 130
if ($opts{'R'}) {
    $g_doraw = 1;
131
    $g_step = $RAWSTEP;
132 133
}

134 135 136 137
# Set default start and end times now that we know the step size.
$g_end = floor($g_now/$g_step)*$g_step;
$g_start = $g_end - $DEFWINDOW;

138 139
if ($opts{'e'}) {
    # Lookup will untaint the argument.
140 141
    $g_experiment = Experiment->Lookup($opts{'e'});
    if (!$g_experiment) {
142 143 144 145
	warn "No such experiment: $opts{'e'}\n";
	exit 1;
    }
    if ($UID &&
146 147
	!$g_experiment->AccessCheck($user, TB_EXPT_READINFO)) {
	warn "You ($user) do not have access to experiment $g_experiment\n";
148 149
	exit 1;
    }
150 151
    if ($g_experiment->state() ne EXPTSTATE_ACTIVE &&
	$g_experiment->state() ne EXPTSTATE_PANICED) {
152
	warn "Experiment $g_experiment is not active!\n";
153 154
	exit 1;
    }
155
    @g_nodelist = $g_experiment->NodeList(0,1);
156 157 158
    # Bump start time to the beginning of this experiment.  Note that the
    # first data point may include data from prior to the start of the
    # experiment!
159
    $g_start = floor($g_experiment->swapin_time()/$g_step)*$g_step;
160 161 162
}

if (@ARGV) {
163
    if ($g_experiment) {
164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179
	warn "You may request stats for an experiment, or a list of nodes, but not both!\n";
	exit 1;
    }

    foreach my $node_id (@ARGV) {
	# Lookup will untaint arguments
	my $node = Node->Lookup($node_id);
	if (!$node) {
	    warn "Unknown node: $node_id\n";
	    exit 1;
	}
	if ($UID &&
	    !$node->AccessCheck($user, TB_NODEACCESS_READINFO)) {
	    warn "You ($user) do not have access to $node\n";
	    exit 1;
	}
180
	push @g_nodelist, $node;
181 182 183
    }
}

184
if (!@g_nodelist) {
185 186 187 188
    warn "No nodes to operate on (no nodes in experiment, or no nodes listed on command line)!\n";
    exit 1;
}

189 190 191 192 193 194 195 196 197 198
if ($opts{'S'}) {
    if ($opts{'S'} !~ /^([-.:\/,\w\s]{$MINTIMESPECLEN,$MAXTIMESPECLEN})$/) {
	warn "Illegal start time spec!\n";
	exit 1;
    }
    my $stime = str2time($1);
    if (!defined($stime)) {
	warn "Start time could not be parsed!\n";
	exit 1;
    }
199
    $stime = floor($stime/$g_step)*$g_step;
200
    if ($g_experiment && $stime < $g_start) {
201
	warn "Specified start time is prior to start of experiment!\n".
202 203
	     "Truncating to: $g_start\n"
	     if (!$g_silent);
204
    } else {
205
	$g_start = $stime;
206 207 208
    }
}

209 210 211 212 213 214 215 216 217 218
if ($opts{'E'}) {
    if ($opts{'E'} !~ /^([-.:\/,\w\s]{$MINTIMESPECLEN,$MAXTIMESPECLEN})$/) {
	warn "Illegal end time spec!\n";
	exit 1;
    }
    my $etime = str2time($1);
    if (!defined($etime)) {
	warn "End time could not be parsed!\n";
	exit 1;
    }
219 220 221
    $etime = floor($etime/$g_step)*$g_step;
    if ($etime > $g_end) {
	warn "End time is in the future! Truncated to: $g_end\n"
222
	    if (!$g_silent);
223
    }
224
    else {
225
	$g_end = $etime;
226 227 228
    }
}

229
if ($g_start > $g_end) {
230 231 232 233
    warn "Start time must be less than or equal to end time!\n";
    exit 1;
}

234 235 236 237
sub get_stats($$$;$) {
    my ($rrdfile, $dtype, $header, $filter) = @_;
    my ($start, $end, $step) = ($g_start, $g_end, $STEP);
    my $rawvals;
238

239
    if ($dtype eq "RAW") {
240
	$step = $RAWSTEP;
241 242 243 244 245 246 247
	$start = $end - 86400; # a day's worth of samples, but...
	# Snap to the start time if it is less than a day prior to now.
	# It should already be aligned to five minutes.
	if ($g_start > $start) {
	    $start = $g_start;
	}
	$dtype = "AVERAGE";
248
    }
249 250
    elsif ($g_doraw) {
	$rawvals = get_stats($rrdfile, "RAW", $header, $filter);
251
	my $rawstart = floor($g_now/$STEP)*$STEP - 86400;
252 253 254 255 256
	if ($start <= $rawstart) {
	    $end = $rawstart;
	} else {
	    return $rawvals;
	}
257 258 259
    }

    my ($rrd_stamp,$rrd_step,$rrd_names,$rrd_data) = 
260 261
	RRDs::fetch($rrdfile, $dtype, "--start=$start", "--end=$end", 
		    "--resolution=$step");
262
    if (RRDs::error) {
Kirk Webb's avatar
Kirk Webb committed
263
	warn "Could not get data from $rrdfile: ". RRDs::error ."\n"
264
	    if (!$g_silent);
Kirk Webb's avatar
Kirk Webb committed
265
	return [];
266
    }
267 268
    my $hasvalues = 0; # track whether or not any data exists.
    my @tmpvals = ($header,);
269
    foreach my $rrd_line (@$rrd_data) {
270
	$filter->($rrd_stamp, $rrd_line)
271 272 273 274 275 276
	    if $filter;
	foreach my $val (@$rrd_line) {
	    $hasvalues = 1
		if (defined($val));
	}
	push @tmpvals, [$rrd_stamp, @$rrd_line];
277 278 279
	$rrd_stamp += $rrd_step;
    }
    if ($hasvalues) {
280 281 282 283 284 285
	# Tack on raw values if they were requested and retrieved.
	if ($rawvals && @$rawvals) {
	    shift @$rawvals;  # Get rid of header.
	    return [@tmpvals, @$rawvals];
	}
	return \@tmpvals;
286 287 288 289
    }
    return [];
}

290
# Do all the things!
291
my @results = ();
292
foreach my $node (@g_nodelist) {
293
    my $node_id = $node->node_id();
294 295
    my $nobj = {};
    $nobj->{'node_id'} = $node_id;
296

Kirk Webb's avatar
Kirk Webb committed
297
    #
298
    # Process top-level node stats.
Kirk Webb's avatar
Kirk Webb committed
299 300 301 302
    #
    # Track whether or not there are data points in the time query range.
    # If not, return an empty array instead of a list of undefined values.
    #
303
    my $mainrrd = "$SD_STATSDIR/${node_id}.rrd";
304
    my $mheader = ["timestamp","load_1min","load_5min","load_15min"];
305 306

    # anonymous func to process entries returned by rrd.
307 308 309
    my $f_main = sub {
	my ($tstamp, $vals) = @_;
	shift @$vals; # remove the 'last_tty' timestamp.
310
	@$vals = map { defined($_) ? sprintf("%.2f", $_)/1 : undef } @$vals;
311 312
    };

313
    if (!-f $mainrrd) {
314 315
	warn "Could not find main rrd file ($mainrrd) for $node_id\n"
	    if (!$g_silent);
316
	$nobj->{'main'} = []; # Indicate no data found.
317 318
    }
    else {
319
	if ($g_doboth) {
320 321 322 323 324 325 326 327
	    my $avg = get_stats($mainrrd, "AVERAGE", $mheader, $f_main);
	    my $max = get_stats($mainrrd, "MAX", $mheader, $f_main);
	    if (@$avg || @$max) {
		$nobj->{'main'}->{'AVG'} = $avg;
		$nobj->{'main'}->{'MAX'} = $max;
	    } else {
		$nobj->{'main'} = [];
	    }
Kirk Webb's avatar
Kirk Webb committed
328
	} else {
329
	    $nobj->{'main'}->{($g_valtype eq "MAX" ? "MAX" : "AVG")} = 
330
		get_stats($mainrrd, $g_valtype, $mheader, $f_main);
Kirk Webb's avatar
Kirk Webb committed
331
	}
332
    }
333

Kirk Webb's avatar
Kirk Webb committed
334
    #
335
    # Process interface statistics.
Kirk Webb's avatar
Kirk Webb committed
336 337 338 339 340 341 342
    #
    # Get the set of known interfaces for this node.  We only consider
    # control and experimental interfaces.  We elide oddball interfaces
    # with an all-zero MAC address.  Track whether or not we find statistics
    # for each interface.  We will mark interfaces with no stats by returning
    # an empty array for them.
    #
343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358
    my @interfaces = ();
    my %ifmap = ();
    my $ctrlmac = "*unknown*";
    Interface->LookupAll($node, \@interfaces);
    foreach my $intf (@interfaces) {
	next if ($intf->mac() eq $ALLZEROMAC);
	if ($intf->IsControl()) {
	    $ctrlmac = uc($intf->mac());
	    $ifmap{$ctrlmac} = $intf;
	    $intf->{'SEEN'} = 0;
	}
	elsif ($intf->IsExperimental()) {
	    $ifmap{uc($intf->mac())} = $intf;
	    $intf->{'SEEN'} = 0;
	}
    }
Kirk Webb's avatar
Kirk Webb committed
359
    $nobj->{'interfaces'}->{'ctrl_iface'} = $ctrlmac; # communicate ctrl iface.
360 361 362 363

    # anonymous func to process entries returned by rrd.
    my $f_intf = sub {
	my ($tstamp, $vals) = @_;
364
	@$vals = map { defined($_) ? sprintf("%.2f", $_)/1 : undef } @$vals;
365
    };
Kirk Webb's avatar
Kirk Webb committed
366
    my @intfrrds = glob "$SD_STATSDIR/${node_id}-*.rrd"; # iface stats files.
367
    my $iheader = ["timestamp","ipkt_rate","opkt_rate"];
368
    foreach my $intfrrd (@intfrrds) {
369
	$intfrrd =~ /${node_id}-([0-9a-f]{12}).rrd$/i;	
Kirk Webb's avatar
Kirk Webb committed
370
	next if (!$1); # skip if mac addr in filename is malformed.
371
	my $mac = uc($1);
Kirk Webb's avatar
Kirk Webb committed
372 373
	next if (!exists($ifmap{$mac})); # skip if iface is not in DB.
	$ifmap{$mac}->{'SEEN'} = 1; # mark.
374
	if ($g_doboth) {
375 376
	     my $avg = get_stats($intfrrd, "AVERAGE", $iheader, $f_intf);
	     my $max = get_stats($intfrrd, "MAX", $iheader, $f_intf);
377 378 379 380 381 382
	     if (@$avg || @$max) {
		 $nobj->{'interfaces'}->{$mac}->{"AVG"} = $avg;
		 $nobj->{'interfaces'}->{$mac}->{"MAX"} = $max;
	     } else {
		 $nobj->{'interfaces'}->{$mac} = [];
	     }
383
	} else {
384 385
	    $nobj->{'interfaces'}->{$mac}->{($g_valtype eq
					     "MAX" ? "MAX" : "AVG")} =
386
		get_stats($intfrrd, $g_valtype, $iheader, $f_intf);
387 388
	}
    }
Kirk Webb's avatar
Kirk Webb committed
389 390
    # Indicate no data found for interfaces where there is no
    # RRD stats file.
391 392
    foreach my $mac (keys %ifmap) {
	if (!$ifmap{$mac}->{'SEEN'}) {
393
	    $nobj->{'interfaces'}->{$mac} = [];
394
	}
395
    }
Kirk Webb's avatar
Kirk Webb committed
396 397

    # Add node data structure to results set.
398 399 400
    push @results, $nobj;
}

401
print to_json(\@results);
402
exit 0;