startvm

#!/usr/bin/perl

use strict;
use warnings;
use DBI;
use Time::Local qw( timelocal_posix timegm_posix );

$|=1;

our @nodes = ();
our $node = "node";

sub parsenodes
{
    my $topofile=shift;
    my $fh = new IO::File($topofile);
    while(<$fh>)
    {
        if ($_ !~ /net\.node/)
	{
            next;
        }
	my $state = 0;
        my @items = split /[\,\[\]\'\s]+/, $_;
        for my $i (@items)
	{
	   if ($i eq "for" && $state == 0)
	   {
		$state = 1;
	   }
	   elsif ($i eq "name" && $state == 1)
	   {	   
		$state = 2;
	   }
	   elsif ($i eq "in" && $state == 2)
           {
                $state = 3;
           }
	   elsif($state == 3)
	   {
	       push(@nodes, $i);
	       if ($node eq "node")
	       {
		   $node = $i;
	       }		   
	   }
        }
    }
}

sub randompass()
{
    my @letters = ('a'..'z');
    my @special = ('!','_','-','#','@');
    my @numeric = (0..9);
    my $randpassword = '';

    while ( length($randpassword) < 12 ) {
        $randpassword = $randpassword . join '', $letters[rand @letters];
	$randpassword = $randpassword . join '', uc($letters[rand @letters]);
        $randpassword = $randpassword . join '', $numeric[rand @numeric];
    }
    $randpassword = $randpassword . join '', $special[rand @special];
    return $randpassword;
}

# Take paper ID, type of VM to create
# and a list of IDs that need access
# like startvm 2 small 4 2 1

my $usage="$0 paper-ID vm-type vnc-pass contact-IDs\n";
my %opt = ();


if ($#ARGV < 3)
{
    print $usage;
    print "DONE";
    exit 1;
}

# Read info from conf/options.php
# to get orgName, dbUser, etc.
my $fh = new IO::File("conf/options.php");
while (<$fh>)
{
    if ($_ =~ /\$Opt/ && $_ =~ /\=/)
    {
	my @arr = split /[\[\]\"\=\s+\;]/, $_;	
	if ($#arr > 3)
	{
	    my $intake = 0;
	    for my $a (@arr)
	    {
		if ($a !~ /[\[\]\"\=\s+]/ && $a =~ /[a-zA-Z0-9]/)
		{
		    if ($a =~ /^\$Opt/)
		    {
			$intake = 1;
			next;
		    }
		    if ($intake =~ /^[0-9]$/ && $intake == 1)
		    {
			$opt{$a} = 0;
			$intake = $a;
		    }
		    else
		    {
			$opt{$intake} = $a;
			last;
		    }
		}
	    }
	}
    }
}
close($fh);

my %vms=();
# Read VM descriptions from file
$fh = new IO::File($opt{'clusterVMs'});
while (<$fh>)
{
    my @items= split /\|/, $_;
    $items[1] =~ s/\n//;
    $vms{$items[0]} = $items[1];
}
close($fh);


my $dsn = "DBI:mysql:database=$opt{'dbName'}";
my $dbh = DBI->connect($dsn, $opt{'dbUser'}, $opt{'dbPassword'});
my $sth;
my %tocreate=();
my $paperID = $ARGV[0];
my $vmtype = $ARGV[1];
my $vncpass = $ARGV[2];
my $SSH = "ssh -o StrictHostKeyChecking=no";
my $proj = $opt{'clusterOrg'} . "p" . $paperID;
my $vmid = "$vmtype.$proj";
# Check that we haven't already allocated a VM for this paper
my $query = 'SELECT * FROM VMs WHERE vmid like \'%.' . $proj . '\'';
$sth = $dbh->prepare($query)
    or die "prepare statement failed: $dbh->errstr()";
$sth->execute() or die "execution failed: $dbh->errstr()";
# If already allocated, bail out
if ($sth->rows > 0)
{
    print "You have already allocated a VM for this paper. Please stop it before trying to allocate another one. \n";
    print "DONE\n";
    exit 0;
}
# Set server
my $path=$opt{'webpath'} . "/secret";
$ENV{HOME}=$path;
my $cmd="mrg config set server grpc.sphere-testbed.net";
system($cmd);
my $cmd="sudo -u merge mrg config set server grpc.sphere-testbed.net";
system($cmd);
my $logincmd =  "mrg login " . $opt{'clusterUser'} . " -p \"" . $opt{'clusterPass'} . "\"";
# Log in as conf admin and as www-data user
$cmd = $logincmd;
my $result=system($cmd);
# Log in as conf admin and as merge user
$cmd = "sudo -H -u merge " . $logincmd;
my $result=system($cmd);
# Create a project for paper if it does not exist
$cmd ="mrg show project $proj";
print "Checking if project $proj exists\n";
my $result = system($cmd);
if ($result != 0)
{
    $cmd = "mrg new project $proj \"" . $opt{'clusterOrg'} . " AE for paper " . $paperID . "\" --category Research -o " . $opt{'clusterOrg'};
    print "Creating new project $proj\n";
    $result = system($cmd);
}
# Figure out which cluster accounts we have created before
my $org = $opt{'clusterOrg'};
for (my $i = 3; $i <= $#ARGV; $i++)
{
    my $id = $ARGV[$i];
    my $username = $org . "u" .  $ARGV[$i];
    $sth = $dbh->prepare(
	'SELECT * FROM ClusterUsers WHERE contactID = ?')
	or die "prepare statement failed: $dbh->errstr()";
    $sth->execute($ARGV[$i]) or die "execution failed: $dbh->errstr()";
    # If no account exists according to HotCRP try to create it or re-create it and save
    if ($sth->rows == 0)
    {
	print "Create account for " . $ARGV[$i] . "\n";
	$sth = $dbh->prepare(
	    'SELECT * FROM ContactInfo WHERE contactID = ?')
	    or die "prepare statement failed: $dbh->errstr()";
	$sth->execute($ARGV[$i]) or die "execution failed: $dbh->errstr()";
	while (my $ref = $sth->fetchrow_hashref()) {
	    my $usstate = "";
	    my $firstName = $ref->{'firstName'};
	    my $lastName = $ref->{'lastName'};
	    my $email = $ref->{'email'};
	    my $affiliation = $ref->{'affiliation'};
	    my $country= $ref->{'country'};
	    if ($affiliation eq "")
	    {
		$affiliation = "HotCRP";
	    }
	    if ($country eq "" || $country eq "United States of America")
	    {
		$country = "United States";
	    }
	    if ($country eq "United States")
	    {
		$usstate = "--usstate CA";
	    }
	    my $password = randompass();
	    # Check if the user already exists, and if it does unregister them since we need to generate a new password
	    my $cmd = "mrg show user $username";
	    print "Checking if user $username exists\n";
	    my $result = system($cmd);
	    if ($result == 0)
	    {
		# Assume that this will work
		$cmd = "mrg delete user $username && mrg unregister $username";
		system($cmd);
		print "Existing user $username has been deleted, and new user will be created";
	    }
	    $cmd = "mrg register $username $email \"$firstName $lastName\" \"$affiliation\" Researcher \"$country\" $usstate -p \"$password\"";
	    print "Registering new user\n";
	    # Execute the command in new process
	    $result = system($cmd);
	    if ($result == 0)
	    {
		# Assume requesting membership will work
		$cmd = "mrg sudo --nokeys -u $username -p  \"$password\" -- mrg membership request organization user $org $username";
		$result = system($cmd);
		$cmd =  "mrg membership confirm organization user " . $opt{'clusterOrg'} . " " . $username;
		$result = system($cmd);
		if ($result == 0)
		{
		    print "Successfully registered user $username\n";
		    my $sth1 = $dbh->prepare(
			'INSERT INTO ClusterUsers(contactID, username, password) values (?, ?, ?)')
			or die "prepare statement failed: $dbh->errstr()";
		    $sth1->bind_param(1, $id);
		    $sth1->bind_param(2, $username);
		    $sth1->bind_param(3,$password);
		    $sth1->execute or die "execution failed: $dbh->errstr()";
		    $sth1->finish;
		    # Join user to the project
		    $cmd = "mrg update member project $proj $username";
		    $result = system($cmd);
		    if ($result != 0)
		    {
			print "Membership update for project $proj and user $username failed\n";
		    }
		}
		else
		{
		    exit 0;
		    print "Registration of $username for email $email has worked but we could not activate the user. Please contact testbed ops.\n";
		}
	    }
	    else
	    {
		print "Registration of $username for email $email has failed. Please contact testbed ops.\n";
	    }
	}
	$sth->finish;
    }
    else
    {
	# Join user to the project
	$cmd = "mrg update member project $proj $username";
	$result = system($cmd);
	if ($result != 0)
	{
	    print "Membership update for project $proj and user $username failed\n";
	}
    }
    $sth->finish;
}
# Now create an XDC in that project if needed
# First create a config file
my $config = "$path/config";
my $admin=$opt{'clusterUser'};
open(my $oh, '>', $config) or die $!;
print $oh "
Host *
     IdentityFile $path/.ssh/merge_key
     ServerAliveInterval 30
     User $admin
     StrictHostKeyChecking no
     ProxyCommand ssh -o StrictHostKeyChecking=no -p 2022 -i $path/.ssh/merge_key -W %h:%p $admin\@jump.sphere-testbed.net";
close($oh);
# Create similar config for merge user
my $mconfig = "/tmp/config";
my $oh;
open($oh, '>', $mconfig) or die $!;
print $oh "                                                                                                                                                                                                                           
Host *	
    IdentityFile /home/merge/.ssh/merge_key
    ServerAliveInterval 30
    User $admin
    StrictHostKeyChecking no
    UserKnownHostsFile=/dev/null
    ProxyCommand ssh -o StrictHostKeyChecking=no -p 2022 -i /home/merge/.ssh/merge_key -W %h:%p $admin\@jump.sphere-testbed.net";
close($oh);
$cmd="mrg list xdcs | grep xdc.$proj > /dev/null";
$result=system($cmd);
if ($result != 0)    
{    
    # XDC needs to be created
    print "Creating XDC xdc.$proj this may take a bit\n";
    $cmd="mrg new xdc xdc.$proj";
    $result=system($cmd);
    
    if ($result != 0)
    {
	print "XDC creation has failed\n";
	print "DONE";
	exit 1;
    }
    else
    {
	sleep(30);
    }       
}
# Created XDC, now need to wait for it to be live
my $retries = 30;
for (my $tries = 0; $tries < $retries; $tries++)
{
    print "Checking if the XDC is up ... this may take a few minutes\n";
    $cmd = "sudo -H -u merge $SSH -F $mconfig xdc-$proj \"ls ~\" 2>&1 > /dev/null < /dev/null ";
    $result=system($cmd);
    if ($result != 0)
    {
	sleep(1);		
    }
    else
    {
	print "XDC is now operational\n";
	last;
    }
}
if ($result != 0)
{
    print "XDC did not come up within prescribed time, will delete it\n";
    $cmd = "mrg delete xdc xdc.$proj";
    system($cmd);
    print "DONE";
    exit 1;
}
my $custom="";
if ($result == 0)
{
    print "XDC exists and is running, we will now create the VM\n";
    # Now create the VM in that project
    # Check if we have a custom topology
    my $modelpath = "";
    if ($vmtype eq "file")
    {
	# There is a custom topology, parse out the nodes and put them into nodes file
	my $uploadspath=$opt{'webpath'} . "/uploads";
	my $topofile =  $uploadspath . "/" . $vmtype . ".$proj.model";
	parsenodes($topofile);
	open(my $oh, ">", $uploadspath . "/" . $vmtype . ".$proj.nodes");
	for my $n (@nodes)
	{
	    print $oh "$n\n";
	}
	close($oh);
	# Do a sanity check, does it compile?
	$cmd = "mrg compile " .  $uploadspath . "/" . $vmtype . ".$proj.model";
	my $output = `$cmd`;
	if ($output =~ /Error/)
	{
	    print "This model does not compile. Please check the topology file.\n";
	    print "DONE";
	    exit 1;
	}
	$cmd = "mrg xdc scp upload " . $uploadspath . "/" . $vmtype . ".$proj.model xdc.$proj:. 2>&1";
	print "$cmd\n";
	$result=system($cmd);
	if ($result != 0)
	{
	    print "Could not upload the custom topology $vmtype.$proj.model to the testbed\n";
	    print "DONE";
	    exit 1;
	}
	# Assume second upload will work
	$cmd = "mrg xdc scp upload " . $uploadspath . "/" . $vmtype . ".$proj.nodes xdc.$proj:.";
	$result=system($cmd);
	$custom="-n /home/$admin/$vmtype.$proj.nodes";
	$modelpath = "/home/$admin/$vmtype.$proj.model";
    }
    else
    {
	$modelpath = "/share/EAC/$vmtype/$vmtype.model";
    }
    # Try to start the experiment
    my $xdccmd="/share/staging/startexp -p $proj -n $vmtype -m $modelpath $vmtype";
    print "$xdccmd\n";
    $cmd = "sudo -H -u merge $SSH -F $mconfig xdc-$proj \"$xdccmd\"";
    $result=system($cmd);
    if ($result == 0)
    {
	print "Experiment is now running\n";
	# Insert info into DB
	$cmd="mrg show realization real.$vmtype.$proj";
	my $output=`$cmd| grep Expires | sed 's/Expires:  //'`;
	$output =~ s/\n//;
	#2024-06-08 17:16:24 +0000 UTC
	my @items = split /[\s\-\:]/, $output;
	my $end_time=timegm_posix($items[5], $items[4], $items[3], $items[2], $items[1]-1, $items[0]-1900);
	my $create_time=time();
	
	my $sth = $dbh->prepare(
	    'SELECT * FROM VMs WHERE vmid = ?')
	    or die "prepare statement failed: $dbh->errstr()";
	$sth->execute("$vmtype.$proj") or die "execution failed: $dbh->errstr()";
	# If VM doesn't exist, insert info
	if ($sth->rows == 0)
	{
	    $vncpass = substr(randompass(), 0, 8);
	    $sth = $dbh->prepare(
	    'INSERT INTO VMs(vmid, vmtype, VNCpass, vmdesc, paperId, create_time, end_time) values (?, ?, ?, ?, ?, ?, ?)')
		or die "prepare statement failed: $dbh->errstr()";
	    my $vmdesc = "";
	    if ($vmtype eq "file")
	    {
		$vmdesc="Custom topology";
	    }
	    else
	    {
		$vmdesc = $vms{$vmtype};
		push(@nodes, $node);
	    }
	       
	    $sth->bind_param(1, $vmid);
	    $sth->bind_param(2, $vmtype);
	    $sth->bind_param(3, $vncpass);	
	    $sth->bind_param(4, $vmdesc);
	    $sth->bind_param(5, $paperID);
	    $sth->bind_param(6, $create_time);
	    $sth->bind_param(7, $end_time);
	    $sth->execute or die "execution failed: $dbh->errstr()";
	    $sth->finish;
	    # Remember all the nodes that a user could access
	    for my $n (@nodes)
	    {
		$sth = $dbh->prepare(
		    'INSERT INTO VMnodes(vmid, node) values (?, ?)')
		    or die "prepare statement failed: $dbh->errstr()";
		$sth->bind_param(1, $vmid);
		$sth->bind_param(2, $n);
		$sth->execute or die "execution failed: $dbh->errstr()";		
		$sth->finish;
	    }
	}
	for (my $i = 3; $i <= $#ARGV; $i++)
	{
	    my $id = $ARGV[$i];

	    # Check if we need to insert into access                                                                                           
	    my $sth = $dbh->prepare(
		'SELECT * FROM VMaccess WHERE vmid = ? AND contactID = ?')
		or die "prepare statement failed: $dbh->errstr()";
	    $sth->bind_param(1, "$vmtype.$proj");
	    $sth->bind_param(2, $id);
	    $sth->execute or die "execution failed: $dbh->errstr()";
	    $sth->finish;
	    
	    if ($sth->rows == 0)
	    {
		
		$sth = $dbh->prepare(
		    'INSERT INTO VMaccess (vmid, contactId) values (?, ?)')
		    or die "prepare statement failed: $dbh->errstr()";
		$sth->bind_param(1, "$vmtype.$proj");
		$sth->bind_param(2, $id);
		$sth->execute or die "execution failed: $dbh->errstr()";
		$sth->finish;
		# Also reserve ports
		for my $n (@nodes)
		{
		    $sth = $dbh->prepare(
			'INSERT INTO Ports (vmid, contactId, node) values (?, ?, ?)')
			or die "prepare statement failed: $dbh->errstr()";
		    $sth->bind_param(1, "$vmtype.$proj");
		    $sth->bind_param(2, $id);
		    $sth->bind_param(3, $n);
		    $sth->execute or die "execution failed: $dbh->errstr()";
		    $sth->finish;
		}
	    }
	}
    }
    else
    {
	print "Experiment failed to start\n";
	print "DONE\n";
	exit 1;
    }
}
# Now we should wait for the node to come up and initialize it
my $retries = 30;
my $running = 0;
for (my $tries = 0; $tries < $retries; $tries++)
{
    print "Checking if node is reachable\n";
    my $xdccmd="ping -c 1 $node";
    $cmd = "sudo -H -u merge $SSH -F $mconfig xdc-$proj \"$xdccmd\"";
    open(my $cmdh, " $cmd | ");
    my $output = "";
    while (<$cmdh>)
    {
	$output .= $_;
    }
    if ($output ne "")
    {
	print "Experiment is running and reachable\n";
	$running = 1;
	last;
    }
}
# Now run runlab
if ($running)
{
    print "Setting up experiment\n";
    $cmd = "sudo -H -u merge $SSH -F $mconfig xdc-$proj \"/share/staging/runlab -f /share/EAC $custom -v $vncpass $vmtype\" 2>&1 < /dev/null ";
    $result=system($cmd);
    if ($result != 0)
    {
	print "Something failed in experiment setup\n";
	print "DONE\n";
	exit 1;
    }
    else
    {
	print "Experiment has been set up\n";
	print "DONE";
	exit 0;
    }
}