Checkpoint my graphing code. This initial commit produces just two

kinds of graphs for a template instantiation.

tbsetup/GNUmakefile.in

@@ -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 \

tbsetup/Template.pm.in

@@ -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;

tbsetup/template_linkgraph.in

+#!/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);
+}
+

tbsetup/webtemplate_linkgraph.in

+#!/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: $!");

utils/opsdb_control.in

@@ -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;
 }
 

utils/opsdb_control.proxy.in

@@ -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];

www/linkgraph_image.php

+<?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");
+}
+
+#
+# No Footer!
+#