Commit af61998a authored by Leigh Stoller's avatar Leigh Stoller

Checkpoint my graphing code. This initial commit produces just two

kinds of graphs for a template instantiation.
parent f115b830
......@@ -25,7 +25,7 @@ BIN_STUFF = power snmpit tbend tbprerun tbreport \
template_swapin template_swapout template_graph \
template_exprun template_delete template_metadata \
template_export template_control template_commit \
template_analyze
template_analyze template_linkgraph
SBIN_STUFF = resetvlans console_setup.proxy sched_reload named_setup \
batch_daemon exports_setup reload_daemon sched_reserve \
......@@ -56,7 +56,8 @@ LIBEXEC_STUFF = rmproj wanlinksolve wanlinkinfo \
webnodeattributes webarchive_control webtemplate_create \
webtemplate_swapin webtemplate_swapout webtemplate_exprun \
webtemplate_graph webtemplate_metadata webtemplate_export \
webtemplate_control webtemplate_commit webtemplate_analyze
webtemplate_control webtemplate_commit webtemplate_analyze \
webtemplate_linkgraph
LIB_STUFF = libtbsetup.pm exitonwarn.pm libtestbed.pm snmpit_intel.pm \
snmpit_cisco.pm snmpit_lib.pm snmpit_apc.pm power_rpc27.pm \
......
......@@ -20,6 +20,7 @@ use lib '@prefix@/lib';
use libdb;
use libtestbed;
use libtblog;
use Experiment;
use English;
use overload ('""' => 'Stringify');
......@@ -1814,7 +1815,21 @@ sub Instantiated($)
if (! $query_result);
return $query_result->numrows;
}
}
#
# Return the underlying experiment object.
#
sub Experiment($)
{
my ($self) = @_;
# Must be a real reference.
return -1
if (! ref($self));
return Experiment->LookupByIndex($self->exptidx());
}
#
# Delete a template instance record.
......@@ -2179,8 +2194,8 @@ sub LogHole($)
#
# Now add the loghole results directly.
#
Template::mysystem("$TEVC -w -t 60 -e $pid/$eid now ns SNAPSHOT ".
" LOGHOLE_ARGS='-l $logdir -P -s'") == 0
Template::mysystem("$TEVC -w -t 180 -e $pid/$eid now ns SNAPSHOT ".
" LOGHOLE_ARGS='-l $logdir -s'") == 0
or return -1;
return 0;
......
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2006 University of Utah and the Flux Group.
# All rights reserved.
#
use English;
use strict;
use Getopt::Std;
use POSIX qw(isatty setsid);
use POSIX qw(strftime);
use Errno qw(EDQUOT);
use Data::Dumper;
#
# Simple graphing functions for link data.
#
# Exit codes are important; they tell the web page what has happened so
# it can say something useful to the user. Fatal errors are mostly done
# with die(), but expected errors use this routine. At some point we will
# use the DB to communicate the actual error.
#
# $status < 0 - Fatal error. Something went wrong we did not expect.
# $status = 0 - Everything okay.
# $status > 0 - Expected error. User not allowed for some reason.
#
sub usage()
{
print(STDERR
"Usage: template_linkgraph [-q] [-s vnode] [-t vnode] ".
"-i <exptidx> -r <runid> <guid/vers> <graphtype>\n".
"switches and arguments:\n".
"-q - be less chatty\n".
"-r <rund> - Experiment run to work on\n".
"-i <exptidx> - Experiment index to work on\n".
"<guid/vers> - GUID and version\n");
exit(-1);
}
my $optlist = "qi:dr:s:t:";
my %options = ();
my $quiet = 0;
my $debug = 0;
my $eid;
my $exptidx;
my $runidx;
my $guid;
my $version;
my $graphtype;
my $srcvnode;
my $dstvnode;
#
# Configure variables
#
my $TB = "@prefix@";
my $EVENTSYS = @EVENTSYS@;
my $TBOPS = "@TBOPSEMAIL@";
my $TBLOGS = "@TBLOGSEMAIL@";
my $TBDOCBASE = "@TBDOCBASE@";
my $TBBASE = "@TBBASE@";
my $CONTROL = "@USERNODE@";
my $checkquota = "$TB/sbin/checkquota";
my $dbcontrol = "$TB/sbin/opsdb_control";
# Locals
my $dbuid;
my $template;
my $instance;
my $archive_tag;
# Protos
sub ParseArgs();
sub fatal($$);
sub cleanup();
#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use libdb;
use libtestbed;
use libtblog;
use Template;
use Experiment;
# In libdb
my $projroot = PROJROOT();
#
# Turn off line buffering on output
#
$| = 1;
#
# Set umask for start/swap. We want other members in the project to be
# able to swap/end experiments, so the log and intermediate files need
# to be 664 since some are opened for append.
#
umask(0002);
#
# Untaint the path
#
# un-taint path
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
#
# Verify user and get his DB uid.
#
if (! UNIX2DBUID($UID, \$dbuid)) {
tbdie("You do not exist in the Emulab Database!");
}
# Now parse arguments.
ParseArgs();
# Temporary
libArchive::setdebug($debug);
#
# Grab template info and do access check.
#
$template = Template->Lookup($guid, $version);
if (!defined($template)) {
tbdie("Experiment template $guid/$version does not exist!");
}
if (! TBProjAccessCheck($dbuid,
$template->pid(), $template->gid(),
TB_PROJECT_READINFO)) {
tberror("You do not have permission to export template $guid/$version");
exit(1);
}
my $pid = $template->pid();
my $gid = $template->gid();
$instance = Template::Instance->LookupByExptidx($exptidx);
if (!defined($instance)) {
fatal(-1, "Could not get instance record for experiment $exptidx!");
}
if ($instance->ArchiveTag(\$archive_tag) < 0) {
fatal(-1, "Could not get current archive tag for instance $exptidx!");
}
if (system("$checkquota $dbuid") != 0) {
tberror("You are over your disk quota on $CONTROL; please cleanup!");
exit(1);
}
# Get the the runs.
my %runlist;
$instance->RunList(\%runlist) == 0
or fatal(-1, "Could not get runlist for $instance");
#
# It is an error to analyze an instance with no runs; it sorta implies
# the the initial run is still active.
#
if (! keys(%runlist)) {
tberror("There are no experiment runs in instance $instance!");
exit(1);
}
if ($instance->Instantiated()) {
my $experiment = Experiment->Lookup($instance->pid(), $instance->eid());
fatal(-1, "Could not get experiment object from $instance!")
if (!defined($experiment));
fatal(-1, "No experiment database in use!")
if (! $experiment->dpdb() || !$experiment->dpdbname());
my $dbname = $experiment->dpdbname();
system("$dbcontrol graphdb $dbname $graphtype") == 0 or
fatal(-1, "Failed to generate requested graph!");
}
exit(0);
#
# Parse command arguments. Once we return from getopts, all that are
# left are the required arguments.
#
sub ParseArgs()
{
if (! getopts($optlist, \%options)) {
usage();
}
if (@ARGV != 2) {
usage();
}
#
# Pick up guid/version first and untaint.
#
my $tmp = shift(@ARGV);
if ($tmp =~ /^([\w]*)\/([\d]*)$/) {
$guid = $1;
$version = $2;
}
else {
tbdie("Bad data in argument: $tmp");
}
#
# Pick up graph type.
#
$tmp = shift(@ARGV);
if ($tmp =~ /^([\w]*)$/) {
$graphtype = $1;
}
else {
tbdie("Bad data in argument: $tmp");
}
if (defined($options{"i"})) {
$exptidx = $options{"i"};
if (! TBcheck_dbslot($exptidx, "default", "int",
TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
tbdie("Improper experiment index!");
}
# real check.
if ($exptidx =~ /^([\w]*)$/) {
$exptidx = $1;
}
else {
tbdie("Bad data in argument: $exptidx");
}
}
else {
tbdie("You must supply the -i option!");
}
if (defined($options{"r"})) {
$runidx = $options{"r"};
if (! TBcheck_dbslot($runidx, "default", "int",
TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
tbdie("Improper run index!");
}
# real check.
if ($runidx =~ /^([\w]*)$/) {
$runidx = $1;
}
else {
tbdie("Bad data in argument: $runidx");
}
}
else {
tbdie("You must supply the -r option!");
}
if (defined($options{"s"})) {
$srcvnode = $options{"s"};
if ($srcvnode =~ /^([-\w]+)$/) {
$srcvnode = $1;
}
else {
tbdie("Bad srcvnode name: $srcvnode!");
}
}
if (defined($options{"t"})) {
$dstvnode = $options{"s"};
if ($dstvnode =~ /^([-\w]+)$/) {
$dstvnode = $1;
}
else {
tbdie("Bad dstvnode name: $dstvnode!");
}
}
if (defined($options{"q"})) {
$quiet = 1;
}
if (defined($options{"d"})) {
$debug = 2;
}
}
#
# Cleanup the mess.
#
sub cleanup()
{
}
sub fatal($$)
{
my ($errorstat, $msg) = @_;
tberror $msg;
tbinfo "Cleaning up and exiting with status $errorstat ...";
exit($errorstat);
}
#!/usr/bin/perl -w
#
# EMULAB-COPYRIGHT
# Copyright (c) 2006 University of Utah and the Flux Group.
# All rights reserved.
#
use English;
#
# This gets invoked from the Web interface. Simply a wrapper ...
#
#
# Configure variables
#
my $TB = "@prefix@";
#
# Run the real thing, and never return.
#
exec "$TB/bin/template_linkgraph", @ARGV;
die("webtemplate_linkgraph: Could not exec template_linkgraph: $!");
......@@ -59,6 +59,7 @@ sub AddTempDB(@);
sub LoadTempDB(@);
sub DelTempDB(@);
sub DumpExpDB(@);
sub GraphDB(@);
sub DoOpsStuff($;$);
sub Initialize();
sub fatal($);
......@@ -70,6 +71,9 @@ use lib "@prefix@/lib";
use libdb;
use libtestbed;
# Locals
my $dbuid;
#
# We don't want to run this script unless its the real version.
#
......@@ -95,6 +99,14 @@ if (! $OPSDBSUPPORT) {
exit(0);
}
#
# Verify user and get his DB uid.
#
if (! UNIX2DBUID($UID, \$dbuid)) {
die("*** $0:\n".
" You do not exist in the Emulab Database!\n");
}
#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
......@@ -150,6 +162,9 @@ elsif ($action eq "loadtempdb") {
elsif ($action eq "dumpexpdb") {
exit(DumpExpDB(@ARGV));
}
elsif ($action eq "graphdb") {
exit(GraphDB(@ARGV));
}
elsif ($action eq "setup") {
exit(Initialize());
}
......@@ -392,6 +407,20 @@ sub SetGroups(@)
push(@glist, $dbname);
}
}
#
# Now get additional temporary DBs.
#
my $databases_result =
DBQueryFatal("select dbname from datapository_databases ".
"where pid='$pid' and gid='$gid'");
while (my ($dbname) = $databases_result->fetchrow_array()) {
if (defined($dbname) && $dbname ne "") {
push(@glist, $dbname);
}
}
}
$input .= "$uid @glist\n";
}
......@@ -639,9 +668,20 @@ sub AddTempDB(@)
die("Bad data in dbname: $dbname");
}
#
# Add DB record for it.
#
if (! DBQueryWarn("insert into datapository_databases set ".
" pid='$pid', gid='$gid', uid='$dbuid', ".
" dbname='$dbname', created=now()")) {
fatal("Failed to add temporary dbname to database");
}
print "Adding temporary DB '$dbname' to mysql database on $CONTROL.\n";
my $retval = DoOpsStuff("adddb $dbname -t");
if ($retval) {
DBQueryWarn("delete from datapository_databases ".
"where dbname='$dbname'");
fatal("$OPSDBPROXY failed on $CONTROL!");
}
......@@ -722,6 +762,55 @@ sub DelTempDB(@)
if ($retval) {
fatal("$OPSDBPROXY failed on $CONTROL!");
}
DBQueryFatal("delete from datapository_databases ".
"where dbname='$dbname'");
return 0;
}
#
# Hack graph support.
#
sub GraphDB(@)
{
my ($dbname, $which, $filename) = @_;
usage()
if (@_ < 2 || @_ > 3);
#
# Untaint args.
#
if ($dbname =~ /^([-\w,\+]+)$/) {
$dbname = $1;
}
else {
die("Bad data in dbname: $dbname");
}
if ($which =~ /^([\w]*)$/) {
$which = $1;
}
else {
die("Bad data in which: $which");
}
# Note different taint check (allow /).
if (defined($filename)) {
if ($filename =~ /^([-\w\.\/]+)$/) {
$filename = $1;
}
else {
tbdie("Bad data in filename: $filename");
}
}
else {
$filename = "";
}
print "Graphing DB '$dbname' from mysql database on $CONTROL.\n"
if ($debug);
my $retval = DoOpsStuff("graphdb $dbname $which $filename");
if ($retval) {
fatal("$OPSDBPROXY failed on $CONTROL!");
}
return 0;
}
......
......@@ -9,6 +9,7 @@ use Getopt::Std;
use Errno;
use File::Basename;
use strict;
use GD::Graph::lines;
#
# A wrapper for messing with the OPS DB from boss.
......@@ -73,6 +74,7 @@ sub DelDB(@);
sub SetDBs(@);
sub DumpDB(@);
sub LoadDB(@);
sub GraphDB(@);
sub fatal($);
#
......@@ -129,6 +131,9 @@ elsif ($action eq "dumpdb") {
elsif ($action eq "loaddb") {
exit(LoadDB(@ARGV));
}
elsif ($action eq "graphdb") {
exit(GraphDB(@ARGV));
}
else {
die("*** $0:\n".
" Do not know what to do with '$action'!\n");
......@@ -521,6 +526,126 @@ sub LoadDB(@)
return 0;
}
#
# Very hacky graphing support. Initially, I'm supporting a couple of
# different kinds of graphs just to get the ball rolling. I have no
# idea where this stuff is going to go.
#
sub SaveGraph($$)
{
my ($gd, $filename) = @_;
# Spew to stdout.
if (!defined($filename)) {
binmode STDOUT;
print STDOUT $gd->gd->gif();
return 0;
}
if (! open(OUT, ">$filename")) {
print "Could not open $filename for writing!\n";
return -1;
}
binmode OUT;
print OUT $gd->gd->gif();
close OUT;
return 0;
}
sub GraphDB(@)
{
my ($dbname, $which, $filename) = @_;
usage()
if (@_ < 2 || @_ > 3);
my $exists = DBExists($dbname);
return -1
if ($exists < 0);
my $isemulab = IsEmulabDB($dbname);
return -1
if ($isemulab < 0);
if (!$exists) {
print "DB '$dbname' does not exist!\n";
return -1;
}
my $gd = new GD::Graph::lines(700,425);
if (!$gd) {
print "Could not create a new graph object!\n";
return -1;
}
# This is called as root, so just switch to the proper DB.
if (TBDBConnect($dbname, $dbuser, $dbpass) < 0) {
fatal("Could not connect to $dbname database!");
}
my $xlabel;
my $ylabel;
my $title;
my @x_data = ();
my @y_data = ();
if ($which eq "pps") {
$xlabel = "Seconds Since Time Start";
$ylabel = "Packets per Second";
$title = "Aggregate Packets per Second";
}
elsif ($which eq "bps") {
$xlabel = "Seconds Since Time Start";
$ylabel = "Bytes per Second";
$title = "Aggregate Bytes per Second";
}
else {
print "Do not know how to graph $which!\n";
return -1;
}
$gd->set(x_label => $xlabel,
y_label => $ylabel,
title => $title,
r_margin => 30,
y_tick_number => 'auto',
x_tick_number => 'auto',
box_axis => 0,
line_width => 3,
transparent => 0,
);
if ($which eq "pps" || $which eq "bps") {
my $query_result;
if ($which eq "pps") {
$query_result =
DBQueryFatal("select UNIX_TIMESTAMP(timestamp),count(*) ".
" from event ".
"group by timestamp order by timestamp");
}
else {
$query_result =
DBQueryFatal("select UNIX_TIMESTAMP(timestamp),sum(ip_len) ".
" from event as e ".
"left join iphdr as i on ".
" i.sid=e.sid and i.cid=e.cid ".
"group by timestamp order by timestamp");
}
my ($tstart,$first) = $query_result->fetchrow_array();
@x_data = (0);
@y_data = ($first);
while (my ($timestamp, $count) = $query_result->fetchrow_array()) {
push(@x_data, $timestamp - $tstart);
push(@y_data, $count);
}
}
my @data = ( \@x_data , \@y_data );
$gd->plot(\@data);
SaveGraph($gd, $filename);
return 0;
}
sub fatal($)
{
my($mesg) = $_[0];
......
<?php
#
# EMULAB-COPYRIGHT
# Copyright (c) 2006 University of Utah and the Flux Group.
# All rights reserved.
#
include("defs.php3");
include_once("template_defs.php");
#
# Only known and logged in users ...
#
$uid = GETLOGIN();
LOGGEDINORDIE($uid);
$isadmin = ISADMIN($uid);
#
# Verify page arguments.
#
if (!isset($exptidx) ||
strcmp($exptidx, "") == 0) {
USERERROR("You must provide an instance ID", 1);
}
if (!TBvalid_integer($exptidx)) {
PAGEARGERROR("Invalid characters in instance ID!");
}
# Only template instances right now.
$instance = TemplateInstance::LookupByExptidx($exptidx);
if (!$instance) {
USERERROR("The instance $exptidx is not a valid instance!", 1);
}
#
# Spit out the image with a content header.
#
$eid = $instance->eid();
$pid = $instance->pid();
$runidx = $instance->runidx();
$guid = $instance->guid();
$vers = $instance->vers();
$which = "pps";
#
# Default to pps if no graphtype.
#
if (isset($graphtype) && $graphtype != "") {
if (! preg_match('/^[\w]*$/', $graphtype)) {
PAGEARGERROR("Invalid characters in graphtype!");
}
$which = $graphtype;
}
if (!TBExptGroup($pid, $eid, $gid)) {
TBERROR("No such experiment $pid/$eid!", 1);
}
TBGroupUnixInfo($pid, $gid, $unix_gid, $unix_name);
if ($fp = popen("$TBSUEXEC_PATH $uid $unix_name webtemplate_linkgraph " .
"-i $exptidx -r $runidx $guid/$vers $which", "r")) {
header("Content-type: image/gif");
fpassthru($fp);
}
else {
# No Data. Spit back a stub image.
header("Content-type: image/gif");
readfile("coming-soon-thumb.gif");
}
#