Commit 3c06a7c8 authored by Kirk Webb's avatar Kirk Webb

Add subnode relationship for blockstores.

Yucky stuff to create parent host objects for blockstores on the
fly, and to insert these hosts into lans when the blockstore shows up in
lan member lists.

Add "best effort" symbol ("~") to parser for bandwidth spec.

Also adjust the copyright dates on new files.
parent 667aa59d
#!/usr/bin/perl -wT
#
# Copyright (c) 2005-2012 University of Utah and the Flux Group.
# Copyright (c) 2012 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
......
# -*- tcl -*-
#
# Copyright (c) 2000-2012 University of Utah and the Flux Group.
# Copyright (c) 2012 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
......@@ -109,6 +109,26 @@ Blockstore instproc set-size {newsize} {
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 node [$sim node]
$node set subnodehost 1
$node set subnodechild $self
# Return parent node object.
return $node
}
# updatedb DB
# This adds rows to the virt_blockstores and virt_blockstore_attributes
# tables, corresponding to this storage object.
......
......@@ -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]
......
......@@ -559,11 +559,18 @@ 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
#
# "*" means let assign pick the bandwidth. Make it zero.
if {"$bspec" == "*"} {
return 0
}
# "~" means "best effort" bandwidth - not conservatively allocated.
# Used when links may be multiplexed onto hosts, where the hosts
# should not attempt to guarantee bandwidth. Make this case -1.
elseif {"$bspec" == "~"} {
return -1
}
# Default to bytes
if {[scan $bspec "%f%s" bw unit] == 1} {
......
......@@ -561,13 +561,21 @@ Simulator instproc run {} {
}
}
# Go through the list of nodes, and find subnode hosts - we have to add a
# desire to them to have the hosts-<type-of-child> feature
# Go through the list of nodes, and find subnode hosts:
# - If the subnode is of class Node, we have to add a
# desire to have the hosts-<type-of-child> feature.
# - If it is of type Blockstore, we add a "sanhost"
# desire.
foreach node [lsort [array names node_list]] {
if { [$node set subnodehost] == 1 } {
set child [$node set subnodechild]
set childtype [$child set type]
$node add-desire "hosts-$childtype" 1.0
if {[$child info class Node]} {
set childtype [$child set type]
$node add-desire "hosts-$childtype" 1.0
}
elseif {[$child info class Blockstore]} {
$node add-desire "sanhost" 1.0
}
}
}
......
......@@ -613,7 +613,7 @@ proc tb-set-hardware {node type args} {
set isv $isvirt($type)
}
set issub 0
if {[info exists isvirt($type)]} {
if {[info exists issubnode($type)]} {
set issub $issubnode($type)
}
$node set_hwtype $type $remote $isv $issub
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment