dumpdescriptor.in

#!/usr/bin/perl -w
#
# Copyright (c) 2010-2017 University of Utah and the Flux Group.
# 
# {{{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 English;
use strict;
use Getopt::Std;
use CGI;
use Data::Dumper;

#
# Dump an EZ descriptor out.
#
sub usage()
{
    print("Usage: dumpdescriptor ".
	  "[-d] [-e] [-v clientvers] [-i <imageid> [-t]] | [-o <osid>]\n");
    exit(-1);
}
my $optlist    = "di:o:tev:";
my $debug      = 0;
my $dotypes    = 0;
my $export     = 0;
my $clientvers = 0;
my $argumentid;

#
# Configure variables
#
my $TB		= "@prefix@";
my $TBOPS       = "@TBOPSEMAIL@";
my $TBAUDIT	= "@TBAUDITEMAIL@";
my $TBGROUP_DIR	= "@GROUPSROOT_DIR@";
my $TBPROJ_DIR	= "@PROJROOT_DIR@";
my $TBBASE	= "@TBBASE@";
my $PGENISUPPORT= @PROTOGENI_SUPPORT@;
my $OURDOMAIN   = "@OURDOMAIN@";
my $WITHPROVENANCE= @IMAGEPROVENANCE@;
my $MAINSITE    = @TBMAINSITE@;

#
# When fetching the metadata, we now tell the server what client
# version of the software we are so it gives something we can handle.
# Be sure to update this if you change the version in image_import
#
my $METADATA_SERVERVERSION = 2;

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

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

#
# Load the Testbed support stuff.
#
use lib "@prefix@/lib";
use libdb;
use libtestbed;
use User;
use Project;
use Image;
use OSinfo;
use NodeType;
use EmulabFeatures;
$EmulabFeatures::verbose = 0;

# Protos
sub fatal($);
sub DumpImage($);
sub DumpOS($);

#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
my %options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (defined($options{"d"})) {
    $debug = 1;
}
if (defined($options{"t"})) {
    $dotypes = 1;
}
if (defined($options{"e"})) {
    $export = 1;
}
if (defined($options{"v"})) {
    $clientvers = $options{"v"};
}

if (@ARGV) {
    usage();
}

if (defined($options{"i"})) {
    $argumentid = $options{"i"};
    my $image = Image->Lookup($argumentid);
    if (!defined($image)) {
	fatal("No such image: $argumentid");
    }
    DumpImage($image);
}
elsif (defined($options{"o"})) {
    $argumentid = $options{"o"};
    my $osinfo = OSinfo->Lookup($argumentid);
    if (!defined($osinfo)) {
	fatal("No such osid: $argumentid");
    }
    DumpOS($osinfo);
}
else {
    fatal("Must supply an image or os ID");
}

sub DumpImage($)
{
    my ($image) = @_;
    
    # Array of string values to print. 
    my %xmlfields = ();

    # For version info.
    my @imagelist = ();

    $xmlfields{"imagename"}    = $image->imagename();
    $xmlfields{"format"}       = $image->format();
    if (!$export) {
	$xmlfields{"pid"}      = $image->pid();
	$xmlfields{"gid"}      = $image->gid();
    }
    $xmlfields{"description"}  = $image->description();
    if (!$image->isdataset()) {
	$xmlfields{"loadpart"} = $image->loadpart();
    }
    $xmlfields{"global"}       = $image->global();
    $xmlfields{"shared"}       = $image->shared();
    if (defined($image->path()) && $image->path() ne "") {
	#
	# Old clients cannot handle directory based paths, so give them
	# a filename instead.
	#
	my $path = $image->path();
	if ($clientvers == 0 && $image->IsDirPath()) {
	    $path .= $image->imagename() . ".ndz" .
		($image->version() ? ":" . $image->version() : "");
	}
	$xmlfields{"path"} = $path;
    }
    $xmlfields{"hash"}         = $image->hash()
    	if ($export && defined($image->hash()) && $image->hash() ne "");
    $xmlfields{"mbr_version"}  = $image->mbr_version();
    if ($export && $clientvers > 0) {
	$xmlfields{"isdataset"}    = $image->isdataset();
	if ($clientvers > 1 && $image->isdataset()) {
	    $xmlfields{"lba_low"}  = $image->lba_low();
	    $xmlfields{"lba_high"} = $image->lba_high();
	    $xmlfields{"lba_size"} = $image->lba_size();
	}
    }

    if ($export) {
	my $url;
	my $imageid    = $image->imageid();
	my $uuid       = $image->uuid();
	my $image_uuid = $image->image_uuid();
	my $access_key = $image->access_key();
	if (!defined($access_key) || $access_key eq "") {
	    $access_key = TBGenSecretKey();
	    if ($image->Update({'access_key' => $access_key})) {
		fatal("Could not initialize access key");
	    }
	}
	#
	# Generate a url that allows the image to be downloaded. This is a
	# little confusing cause of the ways the caller can request an
	# image.  If using the image uuid (which means, whatever the
	# current version is right now), then return a URL that is not
	# version specific. Otherwise, return URL to the actual image
	# version. The messiness is how to determine that we want the
	# version specific or not, from the script arguments.
	#
	if ($argumentid =~ /:/) {
	    $url = "$TBBASE/spewimage.php".
		"?imageid=$uuid&access_key=$access_key";
	}
	else {
	    $url = "$TBBASE/spewimage.php".
		"?imageid=$image_uuid&access_key=$access_key";
	}
	$xmlfields{"imagefile_url"} = $url;

	if ($clientvers > 2) {
	    #
	    # If this is a nonlocal image, send along where it came from.
	    # This allows the caller to trace back to the origin.
	    #
	    if (!$image->IsLocal()) {
		$xmlfields{'metadata_url'} = $image->metadata_url();
	    }
	    # Tell the caller if we have delta/full images.
	    $xmlfields{'havedelta'} = $image->HaveDeltaImage();
	    $xmlfields{'havefull'}  = $image->HaveFullImage();

	    # Tell the caller some extras for debugging image tracking (IMS).
	    $xmlfields{'origin_uuid'} = $image_uuid;
	    $xmlfields{'origin_name'} = $image->versname();
	    
	    if ($PGENISUPPORT) {
		# And the URN is required for image tracking.
		require GeniHRN;
		
		$xmlfields{'origin_urn'}  =
		    GeniHRN::Generate($OURDOMAIN, "authority", "cm");
	    }
	    # Send the architecture if it is set here.
	    if ($image->architecture()) {
		$xmlfields{'architecture'} = $image->architecture();
	    }
	    else {
		#
		# Temporary patch for importing images into the Cloudlab
		# Utah, which is the only multi-architecture cluster. If
		# we do not give it an architecture, then it will assign
		# all types to the image, and that definitely wrong. So
		# lets just assume that if the cluster does not have any
		# m400 node types, its an x86 image. And if the importing
		# cluster is not using architectures, this will be ignored
		# anyway.
		#
		if ($MAINSITE || !defined(NodeType->Lookup("m400"))) {
		    $xmlfields{'architecture'} = "x86_64";
		}
	    }
	    
	    #
	    # Send along the history so that the caller can get all
	    # the versions, which is important for delta based images.
	    #
	    if ($clientvers > 3) {
		#
		# Send the non-version metadata url so that the other side
		# can have it for when an experiment wants whatever the
		# latest version is. This allows different users to ask for
		# different versions or just latest version, and have them
		# come from the same image, instead of making new independent
		# shadow images.
		#
		$xmlfields{'image_metadata_url'} = $image->LocalURL();
		$xmlfields{'metadata_url'}       = $image->LocalVersionURL();
		
		$xmlfields{'image_version'}  = $image->version();
		$xmlfields{"deltahash"}      = $image->deltahash()
		    if (defined($image->deltahash()) &&
			$image->deltahash() ne "");

		if ($clientvers > 4) {
		    $xmlfields{'size'} = $image->size()
			if ($image->size());
		    $xmlfields{'deltasize'} = $image->deltasize()
			if ($image->deltasize());
		    $xmlfields{'notes'} = $image->notes()
			if (defined($image->notes()) and $image->notes() ne '');
		}

		#
		# We need to send the parent info too, for the delta chain
		# to be constructed. 
		#
		if (defined($image->parent_imageid())) {
		    $xmlfields{'parent_imageid'} = $image->parent_imageid();
		    $xmlfields{'parent_version'} = $image->parent_version();
		}
		
		if ($image->version()) {
		    my @tmp;
		    
		    # This returns a reverse ordered list.
		    if ($image->AllVersions(\@tmp, 1)) {
			fatal("Could not get image version list");
		    }
		    #
		    # But just the history prior to this image.
		    #		
		    foreach my $im (@tmp) {
			next
			    if ($im->version() >= $image->version());
			
			$imagelist[$im->version()] = $im;
		    }
		}
	    }
	}
    }

    sub MapOS($) {
	my ($osid) = @_;
	return "none"
	    if (!defined($osid));
	
	my $osinfo = OSinfo->Lookup($osid);
	if (!defined($osinfo)) {
	    fatal("Could not find osid $osid");
	}
	return $osinfo->pid() . "," . $osinfo->osname();
    }

    if (! ($image->ezid() || $image->isdataset())) {
	$xmlfields{"loadlength"}   = $image->loadlength();
	$xmlfields{"part1_osid"}   = MapOS($image->part1_osid());
	$xmlfields{"part2_osid"}   = MapOS($image->part2_osid());
	$xmlfields{"part3_osid"}   = MapOS($image->part3_osid());
	$xmlfields{"part4_osid"}   = MapOS($image->part4_osid());
	$xmlfields{"default_osid"} = MapOS($image->default_osid());
    }
    elsif (!$image->isdataset()) {
	my $osinfo = OSinfo->Lookup($image->imageid());
	if (!defined($osinfo)) {
	    fatal("Could not find osid for $image");
	}
	$xmlfields{"OS"}              = $osinfo->OS();
	$xmlfields{"version"}         = $osinfo->version()
	    if (defined($osinfo->version()) && $osinfo->version() ne "");
	$xmlfields{"op_mode"}         = $osinfo->op_mode();
	$xmlfields{"osfeatures"}      = $osinfo->osfeatures()
	    if (defined($osinfo->osfeatures()) && $osinfo->osfeatures() ne "");
	$xmlfields{"reboot_waittime"} = $osinfo->reboot_waittime()
	    if (defined($osinfo->reboot_waittime()));
	# whole disk images are described differently in EZ format
	if ($image->loadpart() == 0 && $image->loadlength() == 4) {
	    $xmlfields{"wholedisk"} = 1;
	    # find the partition which has an osid defined
	    for (my $i = 1; $i <= 4; $i++) {
		my $func = "part${i}_osid";
		my $foo  = $image->$func();
		if (defined($foo)) {
		    $xmlfields{"loadpart"} = $i;
		    last;
		}
	    }
	}
	if (defined($osinfo->nextosid()) && $osinfo->nextosid()) {
	    my $nextosinfo = OSinfo->Lookup($osinfo->nextosid());
	    if (!defined($nextosinfo)) {
		fatal("Could not look up nextosid for $osinfo");
	    }
	    $xmlfields{"nextosid"} =
		$nextosinfo->pid() . "," . $nextosinfo->osname();
	}
	if (defined($osinfo->def_parentosid()) && $osinfo->def_parentosid()) {
	    my $nextosinfo = OSinfo->Lookup($osinfo->def_parentosid());
	    if (!defined($nextosinfo)) {
		fatal("Could not look up def_parentosid for $osinfo");
	    }
	    $xmlfields{"def_parentosid"} =
		$nextosinfo->pid() . "," . $nextosinfo->osname();
	}
    }
    if ($dotypes) {
	my @typelist = $image->TypeList();
	foreach my $nodetype (@typelist) {
	    my $type = $nodetype->type();
	    
	    $xmlfields{"mtype_$type"} = "1";
	}
    }

    #
    # Old sites cannot handle a version element.
    #
    if ($clientvers > 0) {
	print "<image metadata_version=\"${METADATA_SERVERVERSION}\">\n";
    }
    else {
	print "<image>\n";
    }
    foreach my $key (sort keys(%xmlfields)) {
	my $val = $xmlfields{$key};

	print " <attribute name=\"$key\">";
	print "<value>" . CGI::escapeHTML($val) . "</value>";
	print "</attribute>\n";
    }
    if (@imagelist) {
	foreach my $im (@imagelist) {
	    my $version = $im->version();
	    my $url     = $im->LocalVersionURL();

	    print " <version_history name='$version'>";
	    print CGI::escapeHTML($url);
	    print "</version_history>\n";
	}
    }
    print "</image>\n";

    return 0;
}

sub DumpOS($)
{
    my ($osinfo) = @_;
    
    # Array of string values to print. 
    my %xmlfields = ();

    $xmlfields{"description"}     = $osinfo->description();
    $xmlfields{"osname"}          = $osinfo->osname();
    $xmlfields{"pid"}             = $osinfo->pid();
    $xmlfields{"OS"}              = $osinfo->OS();
    $xmlfields{"version"}         = $osinfo->version()
    	if (defined($osinfo->version()) && $osinfo->version() ne "");
    $xmlfields{"path"}            = $osinfo->path()
	if (defined($osinfo->path()) && $osinfo->path() ne "");
    $xmlfields{"magic"}           = $osinfo->magic()
	if (defined($osinfo->magic()));
    $xmlfields{"op_mode"}         = $osinfo->op_mode();
    $xmlfields{"features"}        = $osinfo->osfeatures()
	if (defined($osinfo->osfeatures()) && $osinfo->osfeatures() ne "");
    $xmlfields{"shared"}          = $osinfo->shared();
    $xmlfields{"mfs"}             = $osinfo->mfs() if ($osinfo->mfs());
    $xmlfields{"mustclean"}       = $osinfo->mustclean();
    $xmlfields{"reboot_waittime"} = $osinfo->reboot_waittime()
	if (defined($osinfo->reboot_waittime()));

    if (defined($osinfo->nextosid()) && $osinfo->nextosid()) {
	my $nextosinfo = OSinfo->Lookup($osinfo->nextosid());
	if (!defined($nextosinfo)) {
	    fatal("Could not look up nextosid for $osinfo");
	}
	$xmlfields{"nextosid"} =
	    $nextosinfo->pid() . "," . $nextosinfo->osname();
    }

    print "<osid>\n";
    foreach my $key (sort keys(%xmlfields)) {
	my $val = $xmlfields{$key};

	print " <attribute name=\"$key\">";
	print "<value>" . CGI::escapeHTML($val) . "</value>";
	print "</attribute>\n";
    }
    print "</osid>\n";

    return 0;
}
exit(0);

sub fatal($)
{
    my ($mesg) = @_;

    print STDERR "*** $0:\n".
	         "    $mesg\n";
    exit(-1);
}