Commit 9c17c18d authored by Kirk Webb's avatar Kirk Webb
Browse files

Merge branch 'stordev-parser'

parents 8b322701 07f6693e
#!/usr/bin/perl -wT
#
# Copyright (c) 2012 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/>.
#
# }}}
#
package BlockstoreType;
use strict;
use Exporter;
use vars qw(@ISA @EXPORT);
@ISA = "Exporter";
@EXPORT = qw ( );
use libdb;
use libtestbed;
use English;
use Data::Dumper;
use overload ('""' => 'Stringify');
# Cache of instances to avoid regenerating them.
my %bstypes = ();
my $debug = 0;
# Little helper and debug function.
sub mysystem($)
{
my ($command) = @_;
print STDERR "Running '$command'\n"
if ($debug);
return system($command);
}
#
# Lookup a (physical) storage object type and create a class instance to
# return.
#
sub Lookup($$)
{
my ($class, $type) = @_;
# Look in cache first
return $bstypes{$type}
if (exists($bstypes{$type}));
my $self = {};
$self->{"TYPE"} = $type;
$self->{"ATTRS"} = undef;
bless($self, $class);
# Load attributes for type from DB. No attrs means type doesn't exist.
$self->LoadAttributes();
if (!$self->{"ATTRS"}) {
return undef;
}
# Add to cache.
$bstypes{$type} = $self;
return $self;
}
#
# Force a reload of the data.
#
sub LookupSync($$)
{
my ($class, $type) = @_;
# delete from cache
delete($bstypes{$type})
if (exists($bstypes{$type}));
return Lookup($class, $type);
}
#
# Return a list of all types.
#
sub AllTypes($)
{
my ($class) = @_;
my @alltypes = ();
my $query_result =
DBQueryWarn("select distinct type from blockstore_type_attributes");
return ()
if (!$query_result || !$query_result->numrows);
while (my ($type) = $query_result->fetchrow_array()) {
my $typeinfo = Lookup($class, $type);
# Something went wrong?
return ()
if (!defined($typeinfo));
push(@alltypes, $typeinfo);
}
return @alltypes;
}
sub AllClasses($)
{
my ($class) = @_;
my @allclasses = ();
my @alltypes = $class->AllTypes();
foreach my $bst (@alltypes) {
my $cl = $bst->class();
if ($cl) {
push(@allclasses, $cl)
}
}
return @allclasses;
}
sub AllProtocols($)
{
my ($class) = @_;
my @allprotos = ();
my @alltypes = $class->AllTypes();
foreach my $bst (@alltypes) {
my $proto = $bst->protocol();
if ($proto) {
push(@allprotos, $proto)
}
}
return @allprotos;
}
#
# Load attributes if not already loaded.
#
sub LoadAttributes($)
{
my ($self) = @_;
return -1
if (!ref($self));
return 0
if (defined($self->{"ATTRS"}));
#
# Get the attribute array.
#
my $type = $self->type();
my $query_result =
DBQueryWarn("select attrkey,attrvalue,attrtype ".
" from blockstore_type_attributes ".
"where type='$type'");
$self->{"ATTRS"} = {};
while (my ($key,$val,$type) = $query_result->fetchrow_array()) {
$self->{"ATTRS"}->{$key} = { "key" => $key,
"value" => $val,
"type" => $type };
}
return 0;
}
#
# Stringify for output.
#
sub Stringify($)
{
my ($self) = @_;
my $type = $self->type();
my $class = $self->class();
return "[BlockstoreType: $type/$class]";
}
#
# Look for an attribute.
#
sub GetAttribute($$;$$)
{
my ($self, $attrkey, $pattrvalue, $pattrtype) = @_;
goto bad
if (!ref($self));
$self->LoadAttributes() == 0
or goto bad;
if (!exists($self->{"ATTRS"}->{$attrkey})) {
return undef
if (!defined($pattrvalue));
$$pattrvalue = undef;
return 0;
}
my $ref = $self->{"ATTRS"}->{$attrkey};
# Return value instead if a $pattrvalue not provided.
return $ref->{'value'}
if (!defined($pattrvalue));
$$pattrvalue = $ref->{'value'};
$$pattrtype = $ref->{'type'}
if (defined($pattrtype));
return 0;
bad:
return undef
if (!defined($pattrvalue));
$$pattrvalue = undef;
return -1;
}
#
# Grab all attributes.
#
sub GetAttributes($)
{
my ($self) = @_;
return undef
if (!ref($self));
$self->LoadAttributes() == 0
or return undef;
return $self->{"ATTRS"};
}
# Shortcuts for typical attributes.
sub type($) { return $_[0]->{'TYPE'}; }
sub class($;$) {return GetAttribute($_[0], "class", $_[1]); }
sub protocol($;$) {return GetAttribute($_[0], "protocol", $_[1]); }
#
# Set the value of an attribute
#
sub SetAttribute($$$;$)
{
my ($self, $attrkey, $attrvalue, $attrtype) = @_;
goto bad
if (!ref($self));
$self->LoadAttributes() == 0
or return -1;
$attrtype = "string"
if (!defined($attrtype));
my $safe_attrvalue = DBQuoteSpecial($attrvalue);
my $type = $self->type();
DBQueryWarn("replace into blockstore_type_attributes set ".
" type='$type', attrkey='$attrkey', ".
" attrtype='$attrtype', attrvalue=$safe_attrvalue")
or return -1;
$self->{"ATTRS"}->{$attrkey} = $attrvalue;
return 0;
}
# _Always_ make sure that this 1 is at the end of the file...
1;
......@@ -174,7 +174,9 @@ $EXPT_RESOURCESHOSED = 0;
"virt_blobs",
"virt_client_service_ctl",
"virt_client_service_hooks",
"virt_client_service_opts");
"virt_client_service_opts",
"virt_blockstores",
"virt_blockstore_attributes");
%physicalTables = ("delays" => ["node_id", "vname", "vnode0", "vnode1"],
"v2pmap" => ["node_id", "vname"],
......
......@@ -48,7 +48,7 @@ LIB_SCRIPTS = libdb.pm Node.pm libdb.py libadminctrl.pm Experiment.pm \
Image.pm OSinfo.pm Archive.pm Logfile.pm Lan.pm emdbi.pm \
emdb.pm emutil.pm Firewall.pm VirtExperiment.pm libGeni.pm \
libEmulab.pm EmulabConstants.pm TraceUse.pm EmulabFeatures.pm \
Port.pm
Port.pm BlockstoreType.pm
# Stuff installed on plastic.
USERSBINS = genelists.proxy dumperrorlog.proxy backup
......
......@@ -98,6 +98,8 @@ my $debug = 0;
"virt_client_service_hooks"=> [ "vnode", "service_idx", "env", "whence",
"hook_vblob_id" ],
"virt_client_service_opts" => [ "vnode", "opt_name", "opt_value" ],
"virt_blockstores" => [ "vname" ],
"virt_blockstore_attributes" => [ "vname", "attrkey" ],
);
#
......@@ -1260,5 +1262,15 @@ use vars qw(@ISA);
@ISA = "VirtExperiment::VirtTableRow";
use VirtExperiment;
package VirtExperiment::VirtTableRow::virt_blockstores;
use vars qw(@ISA);
@ISA = "VirtExperiment::VirtTableRow";
use VirtExperiment;
package VirtExperiment::VirtTableRow::virt_blockstore_attributes;
use vars qw(@ISA);
@ISA = "VirtExperiment::VirtTableRow";
use VirtExperiment;
# _Always_ make sure that this 1 is at the end of the file...
1;
......@@ -163,6 +163,13 @@ my %virtual_tables =
"virt_client_service_opts" => { rows => undef,
tag => "virt_client_service_opts",
row => "virt_client_service_opt"},
"virt_blockstores" => { rows => undef,
tag => "blockstores",
row => "blockstore"},
"virt_blockstore_attributes" => { rows => undef,
tag => "virt_blockstore_attributes",
row => "virt_blockstore_attribute"},
# This is a fake table. See below. If we add more, lets generalize.
"external_sourcefiles" => { rows => undef,
tag => "nsfiles",
......
......@@ -37,7 +37,8 @@ LIB_STUFF = lanlink.tcl node.tcl sim.tcl tb_compat.tcl null.tcl \
elabinelab.ns elabinelab-withfsnode.ns elabinelab-opsvm.ns \
fw.ns timeline.tcl sequence.tcl \
topography.tcl console.tcl path.tcl \
disk.tcl custom.tcl elabinelab-xen.ns
disk.tcl custom.tcl elabinelab-xen.ns \
blockstore.tcl
BOSSLIBEXEC = parse-ns
USERLIBEXEC = parse.proxy
......
# -*- tcl -*-
#
# Copyright (c) 2012 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/>.
#
# }}}
#
######################################################################
# blockstore.tcl
#
# This class defines the blockstore storage object.
#
######################################################################
Class Blockstore -superclass NSObject
namespace eval GLOBALS {
set new_classes(Blockstore) {}
}
Blockstore instproc init {s} {
global ::GLOBALS::last_class
$self set sim $s
$self set node {}
$self set type {}
$self set size 0
$self set type {}
$self set role "unknown"
# storage attributes (class, protocol, etc.)
$self instvar attributes
array set attributes {}
set ::GLOBALS::last_class $self
}
Blockstore instproc rename {old new} {
$self instvar sim
$sim rename_blockstore $old $new
}
Blockstore instproc set-class {newclass} {
var_import ::TBCOMPAT::soclasses
$self instvar attributes
if {![info exists soclasses($newclass)]} {
perror "\[set-class] Invalid storage class: $newclass"
return
}
$self set attributes(class) $newclass
return
}
Blockstore instproc set-protocol {newproto} {
var_import ::TBCOMPAT::soprotocols
$self instvar attributes
if {![info exists soprotocols($newproto)]} {
perror "\[set-protocol] Invalid storage protocol: $newproto"
return
}
$self set attributes(protocol) $newproto
return
}
Blockstore instproc set-type {newtype} {
var_import ::TBCOMPAT::sotypes
if {![info exists sotypes($newtype)]} {
perror "\[set-type] Invalid storage object type: $newtype"
return
}
$self set type $type
return
}
Blockstore instproc set-size {newsize} {
set mindisksize 1; # 1 MiB
# Convert various input size strings to mebibytes.
set convsize [convert_to_mebi $newsize]
# Do some boundary checks.
if { $convsize < $mindisksize } {
perror "\[set-size] $newsize is smaller than allowed minimum (1 MiB)"
return
}
$self set size $convsize
return
}
# Create a node object to represent the host that contains this blockstore,
# or return it if it already exists.
Blockstore instproc get_node {} {
$self instvar sim
$self instvar node
if {$node != {}} {
return $node
}
# Allocate parent host and bind to it.
set hname "sanhost-${self}"
uplevel "#0" "set $hname [$sim node]"
$hname set subnodehost 1
$hname set subnodechild $self
set node $hname
# Return parent node object.
return $hname
}
# updatedb DB
# This adds rows to the virt_blockstores and virt_blockstore_attributes
# tables, corresponding to this storage object.
Blockstore instproc updatedb {DB} {
var_import ::GLOBALS::pid
var_import ::GLOBALS::eid
$self instvar sim
$self instvar node
$self instvar type
$self instvar size
$self instvar role
$self instvar attributes
# XXX: role needs more thought...
#if { $role == "unknown" } {
# puts stderr "*** WARNING: blockstore role not set and unable to infer it."
#}
# Emit top-level storage object stuff.
set vb_fields [list "vname" "type" "role" "size" "fixed"]
set vb_values [list $self $type $role $size $node]
$sim spitxml_data "virt_blockstores" $vb_fields $vb_values
# Emit attributes.
foreach key [lsort [array names attributes]] {
set val $attributes($key)
$sim spitxml_data "virt_blockstore_attributes" [list "vname" "attrkey" "attrvalue"] [list $self $key $val]
}
}
......@@ -238,6 +238,9 @@ LanLink instproc init {s nodes bw d type} {
$self set layer {}
$self set implemented_by {}
# Is this a SAN?
$self set sanlan 0
# A simulated lanlink unless we find otherwise
$self set simulated 1
# Figure out if this is a lanlink that has at least
......@@ -300,6 +303,13 @@ LanLink instproc init {s nodes bw d type} {
$self set ofenabled 0
foreach node $nodes {
# If the node is actually a blockstore object, then we need
# to grab the parent host object and substitute it in here.
if {[$node info class] == "Blockstore"} {
set bs $node
set node [$bs get_node]
$self set sanlan 1
}
set nodepair [list $node [$node add_lanlink $self]]
set bandwidth($nodepair) $bw
set rbandwidth($nodepair) $bw
......@@ -1178,6 +1188,7 @@ Lan instproc updatedb {DB} {
$self instvar ofenabled
$self instvar ofcontroller
$self instvar bridge_links
$self instvar sanlan
set vindex 0
if {$modelnet_cores > 0 || $modelnet_edges > 0} {
......@@ -1197,6 +1208,13 @@ Lan instproc updatedb {DB} {
$sim spitxml_data "virt_lan_settings" $fields $values
}
#
# If this is a SAN, then nullify shaping
#
if {$sanlan == 1} {
set nobwshaping 1
}
foreach nodeport $nodelist {
set node [lindex $nodeport 0]
set isvirt [$node set isvirt]
......
......@@ -331,6 +331,10 @@ Simulator instproc make-path {linklist} {
Simulator instproc make-portinvlan {node token} {
}
Simulator instproc blockstore {args} {
return [$self node]
}
Node instproc program-agent {args} {
}
......
......@@ -109,6 +109,7 @@ use NodeType;
use Template;
use Experiment;
use User;
use BlockstoreType;
use constant false => 0;
use constant true => 1;
......@@ -869,9 +870,24 @@ sub GenDefsFile($)
}
}
}
print TCL "\n\n";
print TCL "\n";
print TCL "# Storage Objects\n";
my @sotypes = BlockstoreType->AllTypes();
foreach my $sot (@sotypes) {
my $type = $sot->type();
my $cl = $sot->class();
my $proto = $sot->protocol();
print TCL "set sotypes($type) 1\n"
if defined($type);
print TCL "set soclasses($cl) 1\n"
if defined($cl);
print TCL "set soprotocols($proto) 1\n"
if defined($proto);
}
print TCL "\n";
print TCL "}\n";
print TCL "}\n\n";
close(TCL);
}
......
......@@ -394,6 +394,7 @@ source ${GLOBALS::libdir}/sequence.tcl
source ${GLOBALS::libdir}/console.tcl
source ${GLOBALS::libdir}/topography.tcl
source ${GLOBALS::libdir}/disk.tcl
source ${GLOBALS::libdir}/blockstore.tcl
source ${GLOBALS::libdir}/custom.tcl
##################################################
......@@ -558,11 +559,14 @@ proc new {class args} {
# in Kbps.
proc parse_bw {bspec {islink 1}} {
#
# Special case; "*" means let assign pick the bandwidth. Make it zero.
# Special cases
#