Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
emulab
emulab-devel
Commits
bb5d1074
Commit
bb5d1074
authored
Oct 27, 2008
by
Leigh B. Stoller
Browse files
Checkpoint
parent
c292ac58
Changes
23
Hide whitespace changes
Inline
Side-by-side
protogeni/lib/GNUmakefile.in
View file @
bb5d1074
...
...
@@ -16,20 +16,25 @@ LIB_SCRIPTS = GeniDB.pm GeniUser.pm GeniSAClient.pm \
GeniTicket.pm GeniSliver.pm GeniCredential.pm \
GeniComponent.pm GeniCH.pm GeniCHClient.pm GeniEmulab.pm \
GeniAuthority.pm GeniCertificate.pm GeniAggregate.pm \
GeniUtil.pm
GeniUtil.pm GeniRegistry.pm
SBIN_SCRIPTS = plabnodewrapper plabslicewrapper
SCRIPTS = test.pl addnode.pl test.pl addauthority
SCRIPTS = test.pl addnode.pl test.pl addauthority
regtest.pl
OPS_LIBS = GeniCMClient.pm GeniSAClient.pm GeniCHClient.pm
# These scripts installed setuid, with sudo.
SETUID_SBIN_SCRIPTS = plabnodewrapper plabslicewrapper
#
# Force dependencies on the scripts so that they will be rerun through
# configure if the .in file is changed.
#
all: $(LIB_SCRIPTS) $(SCRIPTS)
all: $(LIB_SCRIPTS)
$(SBIN_SCRIPTS)
$(SCRIPTS)
include $(TESTBED_SRCDIR)/GNUmakerules
install: $(addprefix $(INSTALL_LIBDIR)/, $(LIB_SCRIPTS)) \
$(addprefix $(INSTALL_SBINDIR)/, $(SBIN_SCRIPTS)) \
$(addprefix $(INSTALL_DIR)/opsdir/lib/, $(OPS_LIBS))
control-install:
...
...
protogeni/lib/GeniAggregate.pm.in
View file @
bb5d1074
...
...
@@ -23,6 +23,7 @@ use GeniCredential;
use
GeniCertificate
;
use
GeniSliver
;
use
GeniSlice
;
use
GeniRegistry
;
use
libdb
qw
(
TBGetUniqueIndex
);
use
English
;
use
overload
(
'""'
=>
'Stringify'
);
...
...
@@ -143,6 +144,9 @@ sub Create($$$$$$)
my
$
slice_uuid
=
$
slice
->
uuid
();
my
$
owner_uuid
=
$
owner
->
uuid
();
$
aggregate_type
=
"Aggregate"
if
(
! defined($aggregate_type));
#
Now
tack
on
other
stuff
we
need
.
push
(@
insert_data
,
"created=now()"
);
push
(@
insert_data
,
"idx='$idx'"
);
...
...
@@ -151,8 +155,7 @@ sub Create($$$$$$)
push
(@
insert_data
,
"uuid='$uuid'"
);
push
(@
insert_data
,
"creator_uuid='$owner_uuid'"
);
push
(@
insert_data
,
"slice_uuid='$slice_uuid'"
);
push
(@
insert_data
,
"type='$aggregate_type'"
)
if
(
defined
($
aggregate_type
));
push
(@
insert_data
,
"type='$aggregate_type'"
);
#
Insert
into
DB
.
if
(
!DBQueryWarn("insert into geni_aggregates set " .
...
...
@@ -237,6 +240,32 @@ sub hrn($)
return
"emulab.aggregate_"
.
$
self
->
idx
();
}
#
#
Look
up
toplevel
aggregate
for
a
locally
instantiated
slice
.
#
sub
SliceAggregate
($$)
{
my
($
class
,
$
slice
)
=
@
_
;
my
$
slice_uuid
=
$
slice
->
uuid
();
my
@
result
=
();
my
$
query_result
=
DBQueryWarn
(
"select idx from geni_aggregates "
.
"where slice_uuid='$slice_uuid' and type='Aggregate'"
);
return
undef
if
(
!$query_result);
return
undef
if
($
query_result
->
numrows
!= 1);
my
($
idx
)
=
$
query_result
->
fetchrow_array
();
my
$
aggregate
=
GeniAggregate
->
Lookup
($
idx
);
return
undef
if
(
!defined($aggregate));
return
$
aggregate
;
}
#
#
Look
up
a
list
of
aggregates
for
a
locally
instantiated
slice
.
#
Used
by
the
CM
.
...
...
@@ -690,6 +719,285 @@ sub Stop($)
}
############################################################################
#
#
Tunnel
aggregates
need
special
handling
too
#
package
GeniAggregate
::
Tunnel
;
use
vars
qw
(@
ISA
);
@
ISA
=
"GeniAggregate"
;
use
GeniDB
;
use
GeniSlice
;
use
GeniCredential
;
use
GeniCertificate
;
use
GeniRegistry
;
use
GeniAggregate
;
use
Experiment
;
use
Interface
;
use
Data
::
Dumper
;
sub
Create
($$$$$$)
{
my
($
class
,
$
slice
,
$
owner
,
$
node1sliver
,
$
node2sliver
,
$
rspec
)
=
@
_
;
my
$
clearinghouse
;
my
$
linkname
=
$
rspec
->{
'nickname'
};
return
undef
if
(
!defined($linkname));
my
$
experiment
=
Experiment
->
Lookup
($
slice
->
uuid
());
if
(
!defined($experiment)) {
print
STDERR
"Could not map $slice to its experiment
\n
"
;
return
-
1
;
}
#
#
Form
an
hrn
using
the
slicename
and
linkname
#
my
$
hrn
=
"emulab."
.
$
slice
->
slicename
()
.
"."
.
$
linkname
;
my
$
aggregate
=
GeniAggregate
->
Create
($
slice
,
$
owner
,
"Tunnel"
,
$
hrn
,
$
linkname
);
goto
bad
if
(
!defined($aggregate));
#
#
Create
a
tunnel
entry
in
the
lans
table
.
#
my
$
tunnel
=
Tunnel
->
Create
($
experiment
,
$
aggregate
->
uuid
(),
""
,
"gre"
);
if
(
!defined($tunnel)) {
print
STDERR
"Could not create tunnel entry in lans table
\n
"
;
return
undef
;
}
my
$
node1ref
=
(@{$
rspec
->{
'linkendpoints'
}})[
0
];
my
$
node2ref
=
(@{$
rspec
->{
'linkendpoints'
}})[
1
];
#
These
are
the
ips
of
the
tunnel
.
my
$
ip1
=
$
node1ref
->{
'tunnel_ip'
};
my
$
ip2
=
$
node2ref
->{
'tunnel_ip'
};
my
$
ctrlip1
;
my
$
ctrlip2
;
my
$
iface1
;
my
$
iface2
;
#
We
need
the
control
network
addresses
,
but
it
is
possible
that
#
one
of
the
nodes
is
not
on
this
testbed
.
if
(
defined
($
node1sliver
))
{
my
$
node1
=
Node
->
Lookup
($
node1ref
->{
'node_uuid'
});
my
$
interface
=
Interface
->
LookupControl
($
node1
);
goto
bad
if
(
!defined($interface));
$
ctrlip1
=
$
interface
->
IP
();
$
iface1
=
$
tunnel
->
AddMember
($
node1
);
if
(
!defined($iface1)) {
print
STDERR
"Could not add $node1 to $tunnel
\n
"
;
goto
bad
;
}
}
else
{
#
#
Need
to
ask
the
clearinghouse
where
this
node
comes
from
.
#
$
clearinghouse
=
GeniRegistry
::
ClearingHouse
->
Create
();
my
$
blob
;
if
($
clearinghouse
->
Resolve
($
node1ref
->{
'node_uuid'
},
"Component"
,
\$
blob
)
!= 0) {
print
STDERR
"Could not lookup node at clearinghouse
\n
"
;
goto
bad
;
}
my
$
certificate
=
GeniCertificate
->
LoadFromString
($
blob
->{
'cm'
});
goto
bad
if
(
!defined($certificate));
my
$
component
=
GeniComponent
->
Lookup
($
certificate
->
uuid
());
if
(
!defined($component)) {
$
component
=
GeniComponent
->
CreateFromCertificate
($
certificate
,
$
blob
->{
'url'
});
if
(
!defined($component)) {
print
STDERR
"Could not create component from $certificate
\n
"
;
goto
bad
;
}
}
my
$
credential
=
GeniRegistry
::
Client
->
CreateCredential
($
component
);
if
(
!defined($credential)) {
print
STDERR
"Could not create a credential for $component
\n
"
;
goto
bad
;
}
my
$
registry
=
GeniRegistry
::
Client
->
Create
($
component
,
undef
,
$
credential
);
if
(
!defined($registry)) {
print
STDERR
"Could not create a registry client for $component
\n
"
;
goto
bad
;
}
$
registry
->
Resolve
($
node1ref
->{
'node_uuid'
},
"Node"
,
\$
blob
);
foreach
my
$
ref
(@{
$
blob
->{
'interfaces'
}
})
{
$
ctrlip1
=
$
ref
->{
'IP'
}
if
($
ref
->{
'role'
}
eq
"ctrl"
);
}
}
if
(
defined
($
node2sliver
))
{
my
$
node2
=
Node
->
Lookup
($
node2ref
->{
'node_uuid'
});
my
$
interface
=
Interface
->
LookupControl
($
node2
);
goto
bad
if
(
!defined($interface));
$
ctrlip2
=
$
interface
->
IP
();
$
iface2
=
$
tunnel
->
AddMember
($
node2
);
if
(
!defined($iface2)) {
print
STDERR
"Could not add $node2 to $tunnel
\n
"
;
goto
bad
;
}
}
else
{
#
#
Need
to
ask
the
clearinghouse
where
this
node
comes
from
.
#
$
clearinghouse
=
GeniRegistry
::
ClearingHouse
->
Create
()
if
(
!defined($clearinghouse));
my
$
blob
;
if
($
clearinghouse
->
Resolve
($
node2ref
->{
'node_uuid'
},
"Component"
,
\$
blob
)
!= 0) {
print
STDERR
"Could not lookup node at clearinghouse
\n
"
;
goto
bad
;
}
my
$
certificate
=
GeniCertificate
->
LoadFromString
($
blob
->{
'cm'
});
goto
bad
if
(
!defined($certificate));
my
$
component
=
GeniComponent
->
Lookup
($
certificate
->
uuid
());
if
(
!defined($component)) {
$
component
=
GeniComponent
->
CreateFromCertificate
($
certificate
,
$
blob
->{
'url'
});
if
(
!defined($component)) {
print
STDERR
"Could not create component from $certificate
\n
"
;
goto
bad
;
}
}
my
$
credential
=
GeniRegistry
::
Client
->
CreateCredential
($
component
);
if
(
!defined($credential)) {
print
STDERR
"Could not create a credential for $component
\n
"
;
goto
bad
;
}
my
$
registry
=
GeniRegistry
::
Client
->
Create
($
component
,
undef
,
$
credential
);
if
(
!defined($registry)) {
print
STDERR
"Could not create a registry client for $component
\n
"
;
goto
bad
;
}
$
registry
->
Resolve
($
node2ref
->{
'node_uuid'
},
"Node"
,
\$
blob
);
foreach
my
$
ref
(@{
$
blob
->{
'interfaces'
}
})
{
$
ctrlip2
=
$
ref
->{
'IP'
}
if
($
ref
->{
'role'
}
eq
"ctrl"
);
}
}
print
STDERR
"$ip1, $ip2, $ctrlip1, $ctrlip2
\n
"
;
if
(
defined
($
iface1
))
{
$
iface1
->
SetAttribute
(
"tunnel_ip"
,
$
ip1
);
$
iface1
->
SetAttribute
(
"tunnel_peerip"
,
$
ip2
);
$
iface1
->
SetAttribute
(
"tunnel_srcip"
,
$
ctrlip1
);
$
iface1
->
SetAttribute
(
"tunnel_dstip"
,
$
ctrlip2
);
$
iface1
->
SetAttribute
(
"tunnel_ipmask"
,
"255.255.255.0"
);
$
iface1
->
SetAttribute
(
"tunnel_lan"
,
$
linkname
);
$
iface1
->
SetAttribute
(
"tunnel_unit"
,
$
iface1
->
memberid
());
$
iface1
->
SetAttribute
(
"tunnel_style"
,
"gre"
);
}
if
(
defined
($
iface2
))
{
$
iface2
->
SetAttribute
(
"tunnel_ip"
,
$
ip2
);
$
iface2
->
SetAttribute
(
"tunnel_peerip"
,
$
ip1
);
$
iface2
->
SetAttribute
(
"tunnel_srcip"
,
$
ctrlip2
);
$
iface2
->
SetAttribute
(
"tunnel_dstip"
,
$
ctrlip1
);
$
iface2
->
SetAttribute
(
"tunnel_ipmask"
,
"255.255.255.0"
);
$
iface2
->
SetAttribute
(
"tunnel_lan"
,
$
linkname
);
$
iface2
->
SetAttribute
(
"tunnel_unit"
,
$
iface2
->
memberid
());
$
iface2
->
SetAttribute
(
"tunnel_style"
,
"gre"
);
}
return
$
aggregate
;
bad
:
$
tunnel
->
Destroy
()
if
(
defined
($
tunnel
));
$
aggregate
->
Delete
()
if
(
defined
($
aggregate
));
return
undef
;
}
#
#
All
the
work
done
above
.
#
sub
Provision
($)
{
my
($
self
)
=
@
_
;
return
-
1
if
(
! ref($self));
$
self
->
SetStatus
(
"ready"
);
return
0
;
}
#
#
Destroy
the
underlying
tunnel
in
the
lans
table
.
#
sub
UnProvision
($)
{
my
($
self
)
=
@
_
;
return
-
1
if
(
! ref($self));
my
$
experiment
=
Experiment
->
Lookup
($
self
->
slice_uuid
());
if
(
!defined($experiment)) {
print
STDERR
"Could not map $self to its experiment
\n
"
;
return
-
1
;
}
my
$
tunnel
=
Tunnel
->
Lookup
($
experiment
,
$
self
->
uuid
());
if
(
! defined($tunnel)) {
print
STDERR
"No tunnel associated with $self
\n
"
;
return
0
;
}
if
($
tunnel
->
Destroy
()
!= 0) {
print
STDERR
"Could not destroy $tunnel
\n
"
;
return
-
1
;
}
return
0
;
}
#
#
Nothing
to
do
yet
.
#
sub
Start
($)
{
my
($
self
)
=
@
_
;
return
-
1
if
(
! ref($self));
return
0
;
}
#
#
Nothing
to
do
yet
.
#
sub
Stop
($)
{
my
($
self
)
=
@
_
;
return
-
1
if
(
! ref($self));
return
0
;
}
#
_Always_
make
sure
that
this
1
is
at
the
end
of
the
file
...
1
;
protogeni/lib/GeniCH.pm.in
View file @
bb5d1074
...
...
@@ -166,6 +166,27 @@ sub Resolve($)
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
$
blob
);
}
if
($
type
eq
"Component"
)
{
my
$
component
=
GeniComponent
->
LookupByResource
($
uuid
);
if
(
!defined($component)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_SEARCHFAILED
,
undef
,
"No such resource $uuid"
);
}
my
$
certificate
=
GeniCertificate
->
Lookup
($
uuid
);
if
(
!defined($certificate)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_SEARCHFAILED
,
undef
,
"No certificate for $uuid"
);
}
#
Return
a
blob
.
my
$
blob
=
{
"gid"
=>
$
certificate
->
cert
(),
"cm"
=>
$
component
->
cert
(),
"url"
=>
$
component
->
url
(),
};
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
$
blob
);
}
if
($
type
eq
"SA"
||
$
type
eq
"sa"
)
{
my
$
authority
=
GeniAuthority
->
Lookup
($
uuid
);
if
(
!defined($authority)) {
...
...
@@ -468,6 +489,34 @@ sub Register($)
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
undef
,
"Slice has been registered"
);
}
if
($
type
eq
"Component"
)
{
my
$
resource_type
=
$
info
->{
'resource_type'
};
my
$
resource_uuid
=
$
info
->{
'resource_uuid'
};
my
$
component
=
GeniComponent
->
Lookup
($
ENV
{
'GENIUUID'
});
if
(
!defined($component)) {
print
STDERR
"Could not find component object for caller.
\n
"
;
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
);
}
if
(
! ($resource_uuid =~ /^[-\w]+$/)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"resource_uuid: Invalid characters"
);
}
if
(
! ($resource_type =~ /^[-\w]+$/)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"resource_type: Invalid characters"
);
}
if
($
certificate
->
Store
()
!= 0) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not store certificate"
);
}
if
($
component
->
NewResource
($
resource_uuid
)
!= 0) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not register new resource"
);
}
}
return
GeniResponse
->
Create
(
GENIRESPONSE_UNSUPPORTED
);
}
...
...
@@ -534,7 +583,7 @@ sub Remove($)
if
($
type
eq
"Slice"
)
{
my
$
slice
=
GeniSlice
->
Lookup
($
uuid
);
if
(
!defined($slice)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_S
EARCHFAILED
,
undef
,
return
GeniResponse
->
Create
(
GENIRESPONSE_S
UCCESS
,
undef
,
"No such slice $uuid"
);
}
if
($
slice
->
Delete
())
{
...
...
@@ -552,14 +601,26 @@ sub Remove($)
#
This
is
just
a
placeholder
;
return
a
list
of
all
components
.
Eventually
#
takes
an
rspec
and
we
do
a
resource
mapping
.
#
sub
D
is
coverResource
s
($)
sub
L
is
tComponent
s
($)
{
my
($
argref
)
=
@
_
;
my
$
slice
=
$
argref
->{
'slice'
};
my
$
cred
=
$
argref
->{
'credential'
};
if
(
! defined($cred)) {
return
GeniResponse
->
MalformedArgsResponse
();
}
my
$
credential
=
GeniCredential
->
CreateFromSigned
($
cred
);
if
(
!defined($credential)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not create GeniCredential object"
);
}
#
This
is
a
certificate
.
Ignored
for
now
.
if
(
!defined($slice)) {
return
Protogeni
::
MalformedArgsResponse
();
#
#
Make
sure
the
credential
was
issued
to
the
caller
.
#
if
($
credential
->
owner_uuid
()
ne
$
ENV
{
'GENIUUID'
})
{
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"This is not your credential!"
);
}
#
...
...
@@ -575,7 +636,9 @@ sub DiscoverResources($)
return
GeniResponse
->
Create
(
GENIRESPONSE_DBERROR
)
if
(
!defined($component));
push
(@
results
,
{
"gid"
=>
$
component
->
cert
()
});
push
(@
results
,
{
"gid"
=>
$
component
->
cert
(),
"hrn"
=>
$
component
->
hrn
(),
"url"
=>
$
component
->
url
()
});
}
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
\@
results
);
}
...
...
protogeni/lib/GeniCM.pm.in
View file @
bb5d1074
...
...
@@ -56,19 +56,21 @@ my $AVAIL = "$TB/sbin/avail";
my
$
PTOPGEN
=
"$TB/libexec/ptopgen"
;
my
$
TBSWAP
=
"$TB/bin/tbswap"
;
my
$
SWAPEXP
=
"$TB/bin/swapexp"
;
my
$
PLABSLICE
=
"$TB/sbin/plabslice"
;
my
$
PLABSLICE
=
"$TB/sbin/plabslicewrapper"
;
my
$
NAMEDSETUP
=
"$TB/sbin/named_setup"
;
my
$
VNODESETUP
=
"$TB/sbin/vnode_setup"
;
my
$
GENTOPOFILE
=
"$TB/libexec/gentopofile"
;
#
#
Respond
to
a
GetTicket
request
.
#
Respond
to
a
Resolve
request
.
#
sub
Resolve
($)
{
my
($
argref
)
=
@
_
;
my
$
uuid
=
$
argref
->{
'uuid'
};
my
$
hrn
=
$
argref
->{
'hrn'
};
my
$
cred
=
$
argref
->{
'credential'
};
my
$
type
=
$
argref
->{
'type'
};
my
$
hrn
;
if
(
! defined($cred)) {
return
GeniResponse
->
MalformedArgsResponse
();
...
...
@@ -77,15 +79,12 @@ sub Resolve($)
return
GeniResponse
->
MalformedArgsResponse
();
}
#
Allow
lookup
by
uuid
or
hrn
.
if
(
!
(
defined($uuid)
|| defined($hrn))
) {
if
(
! defined($uuid)) {
return
GeniResponse
->
MalformedArgsResponse
();
}
if
(
defined
($
uuid
)
&&
!($uuid =~ /^[-\w]*$/)) {
return
GeniResponse
->
MalformedArgsResponse
();
}
if
(
defined
($
hrn
)
&&
!($hrn =~ /^[-\w\.]*$/)) {
return
GeniResponse
->
MalformedArgsResponse
();
}
my
$
credential
=
GeniCredential
->
CreateFromSigned
($
cred
);
if
(
!defined($credential)) {
...
...
@@ -507,7 +506,7 @@ sub ModifySliver($$$$)
#
Find
current
nodes
and
record
their
uuids
.
#
if
(
defined
($
object
))
{
if
($
object
->
type
()
eq
"Link
"
)
{
if
($
object
->
type
()
ne
"Aggregate
"
)
{
return
GeniResponse
->
Create
(
GENIRESPONSE_UNSUPPORTED
,
undef
,
"Only node aggregates allowed"
);
}
...
...
@@ -619,11 +618,9 @@ sub ModifySliver($$$$)
#
Bind
the
other
users
too
.
my
@
userbindings
;
if
($
slice
->
UserBindings
(\@
userbindings
)
!= 0) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Error binding users to slice"
);
}
#
XXX
Need
to
figure
out
where
these
come
from
.
my
@
userbindings
=
();
foreach
my
$
otheruuid
(@
userbindings
)
{
my
$
otheruser
=
GeniUser
->
Lookup
($
otheruuid
);
if
(
!defined($otheruser)) {
...
...
@@ -695,7 +692,7 @@ sub ModifySliver($$$$)
my
$
iface_name
=
$
i
->
rspec
()->{
'iface_name'
};
my
$
linkendpoints
=
$
rspec
->{
'link'
}->{$
s
->
hrn
()}->{
'
L
ink
E
nd
P
oints'
};
$
rspec
->{
'link'
}->{$
s
->
hrn
()}->{
'
l
ink
e
nd
p
oints'
};
}
}
...
...
@@ -703,7 +700,8 @@ sub ModifySliver($$$$)
#
Now
for
each
resource
(
okay
,
node
)
in
the
ticket
create
a
sliver
and
#
add
it
to
the
aggregate
.
#
my
%
slivers
=
();
my
%
slivers
=
();
my
@
plabnodes
=
();
foreach
my
$
ref
(@{$
rspec
->{
'node'
}})
{
my
$
resource_uuid
=
$
ref
->{
'uuid'
};
#
Already
in
the
aggregate
?
...
...
@@ -731,6 +729,16 @@ sub ModifySliver($$$$)
#
have
not
turned
into
slivers
yet
.
Ick
.
#
delete
($
toalloc
{$
resource_uuid
});
#
See
below
;
setup
all
pnodes
at
once
.
if
($
node
->
isremotenode
())
{
my
$
vnode
=
Node
->
Lookup
($
sliver
->
uuid
());
if
(
!defined($vnode)) {
print
STDERR
"Could not locate vnode $sliver
\n
"
;
goto
bad
;
}
push
(@
plabnodes
,
$
vnode
);
}
}
#
...
...
@@ -744,6 +752,35 @@ sub ModifySliver($$$$)
$
message
=
"Bad name for link: $linkname"
;
goto
bad
;
}
my
$
linkref
=
$
rspec
->{
'link'
}->{$
linkname
};
#
#
XXX
Tunnels
are
a
total
kludge
right
now
...
#
if
(
exists
($
linkref
->{
'link_type'
})
&&
$
linkref
->{
'link_type'
}
eq
"tunnel"
)
{
my
$
node1ref
=
(@{$
linkref
->{
'linkendpoints'
}})[
0
];
my
$
node2ref
=
(@{$
linkref
->{
'linkendpoints'
}})[
1
];
my
$
node1sliver
=
$
slivers
{$
node1ref
->{
'node_uuid'
}}
||
$
nodelist
{$
node1ref
->{
'node_uuid'
}};
my
$
node2sliver
=
$
slivers
{$
node2ref
->{
'node_uuid'
}}
||
$
nodelist
{$
node2ref
->{
'node_uuid'
}};
my
$
tunnel
=
GeniAggregate
::
Tunnel
->
Create
($
slice
,
$
owner
,
$
node1sliver
,