#!/usr/bin/perl -w

#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2004 University of Utah and the Flux Group.
# All rights reserved.
#

use English;
use Getopt::Std;
use XML::Parser;
#use RPC::XML;
#use RPC::XML::Parser;

#
# Convert between XML and DB representation of a virtual experiment.
# Very simple, no DTDs, DOMs, XSLs, etc. Just the facts ...
#
# XXX We do not regex the data carefully enough before inserting it into
# the DB. We run quotemeta() over it, but we should be more careful about
# per-slot checks.
#
sub usage()
{
    print STDOUT "Usage: xmlconvert [-x <xmlfile> [-n] [-p]] [-d] pid eid\n";
 
    exit(-1);
}
my $optlist  = "x:ndsp";
my $fromxml  = 0;
my $fromparser = 0;
my $impotent = 0;
my $debug    = 0;
# Results of parsing nse specifications. Therefore different treatment.
# In particular, we don't expect updates to the experiments table
my $simparse = 0;

#
# Configure variables
#
my $TB       = "@prefix@";
my $TBOPS    = "@TBOPSEMAIL@";

# Locals
my $xmlfile;
my $pid;
my $eid;

# This goes at the beginning of the output.
my $XMLHEADER = "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>";

#
# These are the virtual tables that make up an experiment.  Each one
# could have multiple rows, each of which will be a hash table.
#
my %virtual_tables = 
    ("experiments"		=> { rows  => undef, 
				     tag   => "settings",
				     # Indicates a single row.
				     row   => undef,
				     attrs => [ ] },
     "virt_nodes"		=> { rows  => undef, 
				     tag   => "nodes",
				     row   => "node",
				     attrs => [ "vname" ]},
     "virt_lans"		=> { rows  => undef, 
				     tag   => "lans",
				     row   => "lan",
				     attrs => [ "vname" ]},
     "virt_lan_settings"	=> { rows  => undef, 
				     tag   => "lan_settings",
				     row   => "lan_setting",
				     attrs => [ "vname", "capkey" ]},
     "virt_lan_member_settings" => { rows  => undef, 
				     tag   => "lan_member_settings",
				     row   => "lan_member_setting",
				     attrs => [ "vname", "member", "capkey" ]},
     "virt_trafgens"		=> { rows  => undef, 
				     tag   => "trafgens",
				     row   => "trafgen",
				     attrs => [ "vname", "vnode" ]},
     "virt_agents"		=> { rows  => undef, 
				     tag   => "agents",
				     row   => "agent",
				     attrs => [ "vname", "vnode" ]},
     "virt_node_desires"	=> { rows  => undef, 
				     tag   => "node_desires",
				     row   => "node_desire",
				     attrs => [ "vname", "desire" ]},
     "virt_routes"		=> { rows  => undef, 
				     tag   => "routes",
				     row   => "route",
				     attrs => [ "vname", "src", "dst" ]},
     "virt_vtypes"		=> { rows  => undef, 
				     tag   => "vtypes",
				     row   => "vtype",
				     attrs => [ "name" ]},
     "virt_programs"		=> { rows  => undef, 
				     tag   => "programs",
				     row   => "program",
				     attrs => [ "vname", "vnode" ]},
     "nseconfigs"		=> { rows  => undef, 
				     tag   => "nseconfigs",
				     row   => "nseconfig",
				     attrs => [ "vname" ]},
     "eventlist"		=> { rows  => undef, 
				     tag   => "events",
				     row   => "event",
				     attrs => [ "vname" ]},
     "event_groups"		=> { rows  => undef, 
				     tag   => "event_groups",
				     row   => "event_group",
				     attrs => [ "group_name", "agent-name" ]});

# XXX
# The experiment table is special. Only certain fields are allowed to
# be updated. Not sure what the right approach for this is.
# Note that I regex the data before inserting it below.
#
my %experiment_fields = ("multiplex_factor"		=> 1,
			 "forcelinkdelays"		=> 1,
			 "uselinkdelays"		=> 1,
			 "usewatunnels"			=> 1,
			 "uselatestwadata"		=> 1,
			 "wa_delay_solverweight"	=> 1,
			 "wa_bw_solverweight"		=> 1,
			 "wa_plr_solverweight"		=> 1,
			 "cpu_usage"			=> 1,
			 "mem_usage"			=> 1,
			 "allowfixnode"			=> 1,
			 "veth_encapsulate"		=> 1,
			 "jail_osname"			=> 1,
			 "delay_osname"			=> 1,
			 "sync_server"			=> 1,
		         "use_ipassign"			=> 1,
		         "ipassign_args"		=> 1,
		         "usemodelnet"			=> 1,
		         "modelnet_cores"		=> 1,
		         "modelnet_edges"		=> 1);

# New parsing code state machine control.
my $PARSING_NOTYET	= 0;
my $PARSING_EXPERIMENT	= 1;
my $PARSING_TABLE	= 2;
my $PARSING_ROW		= 3;
my $PARSING_SLOT	= 4;
my $parserstate		= $PARSING_NOTYET;

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

#
# Untaint the path
# 
$ENV{'PATH'} = "/bin:/usr/bin:/sbin:/usr/sbin";
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use libdb;
use libtestbed;

#
# Parse command arguments. Once we return from getopts, all that should
# left are the required arguments.
#
%options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (defined($options{"d"})) {
    $debug = 1;
}
if (defined($options{"p"})) {
    $fromparser = 1;
}
if (defined($options{"s"})) {
    $simparse = 1;
}
if (defined($options{"x"})) {
    $fromxml = 1;
    $xmlfile = $options{"x"};

    if ($xmlfile =~ /^([-\w\/\.]+)$/) {
	$xmlfile = $1;
    }
    else {
	fatal("Bad data in argument: $xmlfile.");
    }
    if (defined($options{"n"})) {
	$impotent = 1;
    }    
}
if (@ARGV != 2) {
    usage();
}
$pid   = $ARGV[0];
$eid   = $ARGV[1];

# Taint Check.
if ($pid =~ /^([-\w]+)$/) {
    $pid = $1;
}
else {
    fatal("Bad data in argument: $pid.");
}
if ($eid =~ /^([-\w]+)$/) {
    $eid = $1;
}
else {
    fatal("Bad data in argument: $eid.");
}

my %event_objtypes;
my $query_result = DBQueryFatal("select idx,type from event_objecttypes");
while (my ($idx,$type) = $query_result->fetchrow_array()) {
    $event_objtypes{$type} = $idx;
}

# Do it
if ($fromxml) {
    readXML($pid, $eid, $xmlfile, $fromparser);
}
else {
    writeXML_XML($pid, $eid);
}
exit(0);

#
# Read in XML and convert to DB representation, doing lots of checks!
# This code is silly. Overly stylized (one tag per line!). Should
# use the XML::Parser package instead. But this was easy and fun for a
# first cut. 
#
# State variables for parsing code below.
my $current_expt;
my $current_table;
my $current_row;
my $current_slot;
my $current_data;

sub readXML($$$$) {
    my ($pid, $eid, $xmlfile, $fromparser) = @_;
    my %experiment;

    if ($xmlfile ne "-") {
	open(STDIN, "< $xmlfile")
	    or fatal("opening $xmlfile for STDIN: $!");
    }

    if ($fromparser) {
	#
	# Create a parser.
	#
	my $parser = new XML::Parser(Style => 'Tree');
	$parser->setHandlers('Start'   => \&StartElement_FromParser,
			     'End'     => \&EndElement_FromParser,
			     'Char'    => \&ProcessElement);

	fatal($@)
	    if (eval { $parser->parse(*STDIN); return 1; } != 1);
    }
    else {
	#
	# Create a parser.
	#
	my $parser = new XML::Parser(Style => 'Tree');
	$parser->setHandlers('Start'   => \&StartElement,
			     'End'     => \&EndElement,
			     'Char'    => \&ProcessElement);

	fatal($@)
	    if (eval { $parser->parse(*STDIN); return 1; } != 1);
    }

    # If these are the results of parsing the nse specifications,
    # we don't expect updates to the experiments table
    my %experiments_table;
    if ( ! $simparse ) {

	#
	# Verify. 
	#
	# Must be exactly one experiments table row, and we prune out lots
	# of stuff that is not allowed. Note that we never insert a
	# experiment, but only allow updates of certain values. 
	#
	if (scalar(@{ $virtual_tables{"experiments"}->{"rows"} }) != 1) {
	    fatal("Must be exactly one experiments table row!");
	}
	%experiments_table = %{@{$virtual_tables{"experiments"}->{"rows"}}[0]};
	foreach my $key (keys(%experiments_table)) {
	    delete($experiments_table{$key})
		if (!exists($experiment_fields{$key}));
	}
    }

    #
    # Okay, a hokey DoS check. Do not allow more than 10000 total rows!
    # Why so many? Well, Rob likes to generate lots of events!
    #
    my $count = 0;
    foreach my $table (keys(%virtual_tables)) {
	$count += scalar(@{$virtual_tables{$table}->{"rows"}})
	    if (defined($virtual_tables{$table}->{"rows"}));
    }
    if ($count > 100000) {
	fatal("Too many rows of data!");
    }

    #
    # Okay, thats all the checking we do! There is not much that can
    # screw up the DB just by inserting rows into the allowed set of
    # virtual experiment tables, since we ignore the pid/eid in the xml. 
    #
    # First the experiments table, which gets an update statement, if there
    # is anything to update.
    #
    if ( (! $simparse) && scalar(keys(%experiments_table))) {
	my @setlist  = ();

	my $describe_result =
	    DBQueryFatal("describe experiments");

	#
	# Need to find the default values for slots that are not sent to
	# us in the xml so that we can set them properly.
	#
	while (my $rowref = $describe_result->fetchrow_hashref()) {
	    my $slot  = $rowref->{"Field"};
	    my $value = $rowref->{"Default"};

	    if (exists($experiment_fields{$slot}) &&
		! exists($experiments_table{$slot})) {
		$experiments_table{$slot} =
		    (defined($value) ? $value : "NULL");
	    }
	}

	foreach my $key (keys(%experiments_table)) {
	    my $val = $experiments_table{$key};

	    if (!defined($val) || $val eq "NULL" || $val eq "") {
		push(@setlist, "$key=NULL");
	    }
	    else {
		# Sanity check the fields.
		if (TBcheck_dbslot($val, "experiments", $key,
			TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
		    push(@setlist, "$key='$val'");
		}
		else {
		    fatal("Illegal characters in table data: ".
			  "experiments:$key - $val");
		}
	    }	    
	}
	my $query = "update experiments ".
	            "set " . join(",", @setlist) . " " .
		    "where eid='$eid' and pid='$pid'";

	print "$query\n"
	    if ($debug);
	DBQueryFatal($query)
	    if (!$impotent);
    }

    #
    # Now all the other tables, which get inserts. Need to delete all the
    # old info too.
    #
    foreach my $table (keys(%virtual_tables)) {
	# Don't want to muck with this table! Done above. 
	next
	    if ($table eq "experiments");

	# Delete only during the initial parsing and not
	# during parsing of nse specifications
	if ( ! $simparse ) {
	    DBQueryFatal("delete from $table ".
			 "where eid='$eid' and pid='$pid'")
		if (!$impotent);
	} else {
	    # The nseconfigs table is special. During a
	    # simparse, we need delete all rows for the
	    # experiment except the one with the vname
	    # 'fullsim'. This row is essentially virtual
	    # info and does not change across swapins
	    # where as the other rows depend on the
	    # mapping
	    if ( !$impotent && ($table eq "nseconfigs") ) {
		DBQueryFatal("delete from $table ". 
		             "where eid='$eid' and pid='$pid' and ".
			     "vname!='fullsim'")
	    } elsif ( !$impotent && (($table eq "eventlist") ||
				       ($table eq "virt_agents")) ) {
	        # Both eventlist and virt_agents need to be cleared
		# for NSE event objecttype since entries in this
		# table depend on the particular mapping
		my $nse_objtype = $event_objtypes{"NSE"};
		DBQueryFatal("delete from $table ". 
		             "where pid='$pid' and eid='$eid' and ".
			     "objecttype='$nse_objtype'");
	    } 
	}
	next
	    if (!defined($virtual_tables{$table}->{"rows"}));

	foreach my $rowref (@{$virtual_tables{$table}->{"rows"}}) {
	    my %rowhash = %{ $rowref };
	    my @fields  = ("pid", "eid");
	    my @values  = ("'$pid'", "'$eid'");

	    # If no actual rows, then skip. Might happen.
	    last
		if (! scalar(keys(%rowhash)));

	    foreach my $key (keys(%rowhash)) {
		my $val = $rowhash{$key};

		if (!defined($val) || $val eq "NULL") {
		    push(@values, "NULL");
		}
		elsif ($val eq "") {
		    push(@values, "''");
		}
		else {
		    # Sanity check the fields.
		    if (TBcheck_dbslot($val, $table, $key,
				 TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
			push(@values, DBQuoteSpecial($val));
		    }
		    else {
			fatal("Illegal characters in table data: ".
			      "$table:$key - $val");
		    }
		}
		push(@fields, $key);
	    }
	    # If we are called after an nseparse, we need to
	    # use replace coz some of the tables such as 
	    # virt_agents and eventlist are not truly
	    # virtual tables. That is coz they contain the
	    # vnode field which is the same as the vname
	    # field in the reserved table. For simulated
	    # nodes, the mapping may change across swapins
	    # and the event may have to be delivered to a
	    # different simhost
	    if ( $simparse ) {
		$query = "replace into $table (" . join(",", @fields) . ") ".
		"values (" . join(",", @values) . ") ";
	    } else {
		$query = "insert into $table (" . join(",", @fields) . ") ".
		"values (" . join(",", @values) . ") ";
	    }

	    print "$query\n"
		if ($debug);
	    DBQueryFatal($query)
		if (!$impotent);
	}
    }
    return 0;
}

#
# XML::Parser routines.
#
#
# Start an element.
# 
sub StartElement_FromParser ($$$)
{
    my ($expat, $element, %attrs) = @_;

    if ($element eq "virtual_experiment") {
	fatal("Out of sync at experiment start: $element")
	    if (defined($current_expt) ||
		defined($current_table) ||
		defined($current_row) ||
		defined($current_slot));
	$current_expt = "$pid/$eid";
	
	#
	# Sanity check pid/eid.
	#
	if ((exists($attrs{'pid'}) && $attrs{'pid'} ne $pid) ||
	    (exists($attrs{'eid'}) && $attrs{'eid'} ne $eid)) {
	    fatal("pid/eid mismatch!");
	}
    }
    elsif (exists($virtual_tables{$element})) {
	#
	# A new table start.
	#
	fatal("Out of sync at element start: $element")
	    if (!defined($current_expt) ||
		defined($current_table) ||
		defined($current_row) ||
		defined($current_slot));
	$current_table = $element;

	if (! defined($virtual_tables{$element}->{"rows"})) {
	    $virtual_tables{$element}->{"rows"} = [];
	}
	print "Starting new table: $element\n"
	    if ($debug);
    }
    elsif ($element eq "row") {
	fatal("Out of sync at row start: $element")
	    if (!defined($current_expt) ||
		!defined($current_table) ||
		defined($current_row) ||
		defined($current_slot));
	$current_row = {};
    }
    else {
	fatal("Out of sync at slot start: $element")
	    if (!defined($current_expt) ||
		!defined($current_table) ||
		!defined($current_row) ||
		defined($current_slot));
	$current_slot = $element;
	$current_data = "";
    }
}

#
# End an element.
# 
sub EndElement_FromParser ($$)
{
    my ($expat, $element) = @_;

    if ($element eq "virtual_experiment") {
	fatal("Out of sync at experiment start: $element")
	    if (!defined($current_expt) ||
		defined($current_table) ||
		defined($current_row) ||
		defined($current_slot));
	undef($current_expt);
    }
    elsif (exists($virtual_tables{$element})) {
	#
	# A table termination.
	#
	fatal("Out of sync at element end: $element")
	    if (!defined($current_expt) ||
		!defined($current_table) ||
		defined($current_row) ||
		defined($current_slot));
	undef($current_table);
    }
    elsif ($element eq "row") {
	fatal("Out of sync at row end: $element")
	    if (!defined($current_expt) ||
		!defined($current_table) ||
		!defined($current_row) ||
		defined($current_slot));

	print "Adding new row to table $current_table\n"
	    if ($debug);
	
	push(@{ $virtual_tables{$current_table}->{"rows"} }, $current_row);
	undef($current_row);
    }
    else {
	fatal("Out of sync at slot end: $element")
	    if (!defined($current_expt) ||
		!defined($current_table) ||
		!defined($current_row) ||
		!defined($current_slot));
    
	#
	# Always ignore pid/eid.
	#
	if ($current_slot ne "pid" && $current_slot ne "eid") {
	    print "    Entering new slot: $current_slot: $current_data\n"
		if ($debug);
	    $current_row->{$current_slot} = $current_data;
	}
	undef($current_slot);
	undef($current_data);
    }
}

#
# Process stuff inside a slot.
# 
sub ProcessElement ($$)
{
    my ($expat, $string) = @_;

    if (defined($current_slot)) {
	$current_data .= xmldecode($string);
    }
}

#
# Start an element.
#
sub StartElement ($$$)
{
    my ($expat, $element, %attrs) = @_;

    #
    # First element must be the experiment tag; It starts the process.
    #
    if ($parserstate == $PARSING_NOTYET) {
	fatal("Must start with an experiment tag!")
	    if ($element ne "experiment");

	fatal("Out of sync at experiment start: $element")
	    if (defined($current_expt) ||
		defined($current_table) ||
		defined($current_row) ||
		defined($current_slot));
	$current_expt = "$pid/$eid";
	
	#
	# Sanity check pid/eid.
	#
	if ((exists($attrs{'pid'}) && $attrs{'pid'} ne $pid) ||
	    (exists($attrs{'eid'}) && $attrs{'eid'} ne $eid)) {
	    fatal("pid/eid mismatch!");
	}
	print "Starting new experiment $pid/$eid\n"
	    if ($debug);
	
	$parserstate = $PARSING_EXPERIMENT;
    }
    elsif ($parserstate == $PARSING_EXPERIMENT) {
	#
	# Need to find the right table.
	#
	my $table;
	
	foreach my $key (keys(%virtual_tables)) {
	    if ($virtual_tables{$key}->{"tag"} eq $element) {
		$table = $key;
		last;
	    }
	}
	fatal("Unknown table: $element")
	    if (!defined($table));

	fatal("Out of sync at table start: $element")
	    if (!defined($current_expt) ||
		defined($current_table) ||
		defined($current_row) ||
		defined($current_slot));
	
	if (! defined($virtual_tables{$table}->{"rows"})) {
	    $virtual_tables{$table}->{"rows"} = [];
	}
	$current_table = $table;
	$parserstate   = $PARSING_TABLE;

	print "Starting new table: $table\n"
	    if ($debug);

	# Skip to parsing a row.
	if (!defined($virtual_tables{$current_table}->{"row"})) {
	    $current_row = {};
	    $parserstate = $PARSING_ROW;
	}
    }
    elsif ($parserstate == $PARSING_TABLE) {
	#
	# A row in a table. row tag must match table tag.
	#
	fatal("Out of sync at row start: $element")
	    if ((!defined($current_expt) ||
		 !defined($current_table) ||
		 defined($current_row) ||
		 defined($current_slot)) ||
		$virtual_tables{$current_table}->{"row"} ne $element);

	print "Starting new row at $element in table: $current_table\n"
	    if ($debug);
	
	$current_row = {};
	$parserstate = $PARSING_ROW;
    }
    elsif ($parserstate == $PARSING_ROW) {
	#
	# A slot in a row.
	# 
	fatal("Out of sync at slot start: $element")
	    if (!defined($current_expt) ||
		!defined($current_table) ||
		!defined($current_row) ||
		defined($current_slot));

	print "Starting new slot $element in table: $current_table\n"
	    if ($debug);
	
	$parserstate  = $PARSING_SLOT;
	$current_slot = $element;
	$current_data = "";
    }
    else {
	fatal("Out of sync at element: $element");
    }
}

#
# End an element.
# 
sub EndElement ($$)
{
    my ($expat, $element) = @_;

    if ($parserstate == $PARSING_EXPERIMENT) {
	fatal("Out of sync at experiment start: $element")
	    if ($element ne "experiment" ||
		(!defined($current_expt) ||
		 defined($current_table) ||
		 defined($current_row) ||
		 defined($current_slot)));
	undef($current_expt);
	$parserstate = $PARSING_NOTYET;
    }
    elsif ($parserstate == $PARSING_TABLE) {
	#
	# A table termination.
	#
	fatal("Out of sync at element end: $element")
	    if ((!defined($current_expt) ||
		 !defined($current_table) ||
		 defined($current_row) ||
		 defined($current_slot)) ||
		$element ne $virtual_tables{$current_table}->{"tag"});
	undef($current_table);
	$parserstate = $PARSING_EXPERIMENT;
    }
    elsif ($parserstate == $PARSING_ROW) {
	#
	# A row termination.
	# 
	fatal("Out of sync at row end: $element")
	    if ((!defined($current_expt) ||
		 !defined($current_table) ||
		 !defined($current_row) ||
		 defined($current_slot)) ||
		(defined($virtual_tables{$current_table}->{"row"}) &&
		 $element ne $virtual_tables{$current_table}->{"row"}));
		
	print "Adding new row $element to table $current_table\n"
	    if ($debug);
	
	push(@{ $virtual_tables{$current_table}->{"rows"} }, $current_row);
	undef($current_row);
	$parserstate = $PARSING_TABLE;

	# Skip to parsing an experiment
	if (!defined($virtual_tables{$current_table}->{"row"})) {
	    undef($current_table);
	    $parserstate = $PARSING_EXPERIMENT;
	}
    }
    elsif ($parserstate == $PARSING_SLOT) {
	#
	# A slot termination.
	# 
	fatal("Out of sync at slot end: $element")
	    if (!defined($current_expt) ||
		!defined($current_table) ||
		!defined($current_row) ||
		!defined($current_slot));
    
	#
	# Always ignore pid/eid.
	#
	if ($current_slot ne "pid" && $current_slot ne "eid") {
	    print "    Entering new slot: $current_slot: $current_data\n"
		if ($debug);
	    $current_row->{$current_slot} =
		($current_data ne "__NULL__" ? $current_data : undef);
	}
	undef($current_slot);
	undef($current_data);
	$parserstate = $PARSING_ROW;
    }
}

#
# Convert a virtual experiment representation into XML and spit it out.
# The DB holds the data of course.
#
sub writeXML_XML($$) {
    my ($pid, $eid) = @_;

    my $query_result =
	DBQueryFatal("select * from experiments ".
		     "where eid='$eid' and pid='$pid'");

    if (! $query_result->numrows) {
	fatal("No such experiment $pid/$eid exists!");
    }

    spitxml_header();
    spitxml_opentag("experiment pid='$pid' eid='$eid'", 0);
    spitxml_opentag("settings", 1);
    spitxml_spaces(2);
    
    my $settings = $query_result->fetchrow_hashref();

    foreach my $key (keys(%{ $settings })) {
	my $data = $settings->{$key};
	
	spitxml_entity($key, $data, 0);
    }
    spitxml_closetag("settings", 1);

    #
    # Read in a set of tables that live at top level.
    # 
    foreach my $table (keys(%virtual_tables)) {
	next
	    if ($table eq "experiments");
	
	my $tabletag = $virtual_tables{$table}->{"tag"};
	my $rowtag   = $virtual_tables{$table}->{"row"};

	$query_result =
	    DBQueryFatal("select * from $table ".
			 "where eid='$eid' and pid='$pid'");

	next
	    if (! $query_result->numrows);

	spitxml_opentag($tabletag, 1);
	
	while (my $rowref = $query_result->fetchrow_hashref()) {
	    spitxml_opentag($rowtag, 2);
	    spitxml_spaces(3);

	    foreach my $key (keys(%{ $rowref })) {
		my $data = $rowref->{$key};

		next
		    if ($key eq "pid" || $key eq "eid");

		spitxml_entity($key, $data, 0);
	    }
	    print "\n";
	    spitxml_closetag($rowtag, 2);
	}
	spitxml_closetag($tabletag, 1);
    }

    spitxml_closetag("experiment", 0);
    return 0;
}

#
# This is the old version; I will eventually remove it. 
#
sub writeXML_RPC($$) {
    my ($pid, $eid) = @_;

    my $query_result =
	DBQueryFatal("select * from experiments ".
		     "where eid='$eid' and pid='$pid'");

    if (! $query_result->numrows) {
	fatal("No such experiment $pid/$eid exists!");
    }
    my $exp = {};
    $exp->{"experiment"}->{"settings"} = $query_result->fetchrow_hashref();

    foreach my $key (keys(%{ $exp->{"experiment"}->{"settings"} })) {
	$exp->{"experiment"}->{"settings"}->{$key} = ""
	    if (!defined($exp->{"experiment"}->{"settings"}->{$key}));
    }

    #
    # Read in a set of tables that live at top level.
    # 
    foreach my $table (keys(%virtual_tables)) {
	next
	    if ($table eq "experiments");
	
	my $tag = $virtual_tables{$table}{"tag"};

	if (!exists($exp->{"experiment"}->{$tag})) {
	    $exp->{"experiment"}->{$tag} = [];
	}
	$query_result =
	    DBQueryFatal("select * from $table ".
			 "where eid='$eid' and pid='$pid'");

	while (my $rowref = $query_result->fetchrow_hashref()) {
	    foreach my $key (keys(%{ $rowref })) {
		$rowref->{$key} = ""
		    if (!defined($rowref->{$key}));
	    }
	    push(@{ $exp->{"experiment"}->{$tag} }, $rowref);
	}
    }

    my $foo = new RPC::XML::response($exp);
    print $foo->as_string();
    
    return 0;
}

#
# Utility functions to pretty print XML output, with specified indentation.
#
sub spitxml_spaces($)
{
    my ($level) = @_;

    my $spaces = $level * 1;

    printf("%${spaces}s", "");
}
    
sub spitxml_opentag($$)
{
    my ($tag, $level) = @_;

    spitxml_spaces($level);
    print "<${tag}>\n";
}

sub spitxml_closetag($$)
{
    my ($tag, $level) = @_;

    spitxml_spaces($level);
    print "</${tag}>\n";
}

sub spitxml_header()
{
    print "$XMLHEADER\n";
}

sub spitxml_entity($$$)
{
    my ($tag, $data, $level) = @_;

    $data = "__NULL__"
	if (!defined($data));

    spitxml_spaces($level)
	if ($level);

    if ($data eq "") {
	print "<${tag}/>";
    }
    else {
	print "<${tag}>" . xmlencode($data) . "</${tag}>";
    }
}

#
# Convert from/to XML special chars. Not many of them ...
# 
sub xmlencode($)
{
    my ($string) = @_;

    my %specialchars = ('&' => '&amp;',
			'<' => '&lt;',
			'>' => '&gt;',
			"'" => '&#39;',
			"]" => '&#93;',
			'"' => '&#34;');

    $string =~ s/([&<>"'])/$specialchars{$1}/ge;
    return $string;
}

sub xmldecode($)
{
    my ($string) = @_;

    my %specialchars = ('&amp;'  => '&',
			'&lt;'   => '<',
			'&gt;'   => '>',
			'&#39;'  => "'",
			'&#93;'  => ']',
			'&#34;'  => '"');

    $string =~ s/(&\w+;)/$specialchars{$1}/ge;
    return $string;
}

# Die
sub fatal($)
{
    my ($msg) = @_;

    die("*** $0:\n".
	"    $msg\n");
}