IPBuddyWrapper.pm 10.1 KB
Newer Older
Kirk Webb's avatar
Kirk Webb committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
#!/usr/bin/perl -wT
#
# Copyright (c) 2013 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/>.
# 
# }}}
#
# Emulab wrapper class for the IP range buddy allocator.  Handles all of the
# Emulab-specific goo around allocating address ranges.
#
27 28 29
# Note:  Currently this class only supports a single global address range
#        type.  It really should be augmented to support multiple.
#
Kirk Webb's avatar
Kirk Webb committed
30 31 32 33 34 35 36 37 38 39 40
package IPBuddyWrapper;

use strict;
use Exporter;
use vars qw(@ISA @EXPORT);

@ISA = qw(Exporter);
@EXPORT = qw ( );

use English;
use emdb;
41
use emutil qw( TBGetUniqueIndex );
42
use libtestbed;
Kirk Webb's avatar
Kirk Webb committed
43
use libtblog_simple;
44
use Experiment;
Kirk Webb's avatar
Kirk Webb committed
45 46 47 48
use IPBuddyAlloc;
use Socket;

# Constants
49
my $BUDDYRESLOCK = "reserved_addresses";
Kirk Webb's avatar
Kirk Webb committed
50 51 52 53 54 55 56 57 58

# Prototypes


#
# Create a new IPBuddyAlloc wrapper object.  Pass in a string specifying
# the type of address reservations to target.
#
sub new($$) {
Kirk Webb's avatar
Kirk Webb committed
59
    my ($class, $intype) = @_;
Kirk Webb's avatar
Kirk Webb committed
60 61 62
    my $self = {};

    return undef
Kirk Webb's avatar
Kirk Webb committed
63
	unless defined($intype);
Kirk Webb's avatar
Kirk Webb committed
64 65

    # Get the address range corresponding to this type from the database.
66
    # Currently this only supports one type, and one range for that type.
Kirk Webb's avatar
Kirk Webb committed
67
    my $qres =
Kirk Webb's avatar
Kirk Webb committed
68
	DBQueryWarn("select * from address_ranges where type='$intype'");
Kirk Webb's avatar
Kirk Webb committed
69 70 71 72
    return undef
	if (!$qres);
    if ($qres->numrows() != 1) {
	tberror("More than one range entry found for this address ".
Kirk Webb's avatar
Kirk Webb committed
73
		"type in the DB: $intype\n");
Kirk Webb's avatar
Kirk Webb committed
74 75 76 77 78 79
	return undef;
    }

    my ($baseaddr, $prefix, $type, $role) = $qres->fetchrow();

    # IPBuddyAlloc throws exceptions.
80
    my $buddy = eval { IPBuddyAlloc->new("$baseaddr/$prefix") };
Kirk Webb's avatar
Kirk Webb committed
81 82 83 84 85
    if ($@) {
	tberror("Could not allocate a new IP Buddy Allocator object: $@\n");
	return undef;
    }

86 87
    $self->{'TYPE'}  = $type;
    $self->{'ROLE'}  = $role;
Kirk Webb's avatar
Kirk Webb committed
88 89 90 91 92 93 94 95 96 97 98
    $self->{'BUDDY'} = $buddy;
    $self->{'ALLOC_RANGES'} = {};
    $self->{'NEWLIST'} = [];
    
    bless($self, $class);
    return $self;
}

# Internal Accessors
sub _getbuddy($)   { return $_[0]->{'BUDDY'}; }
sub _gettype($)    { return $_[0]->{'TYPE'}; }
99
sub _getrole($)    { return $_[0]->{'ROLE'}; }
Kirk Webb's avatar
Kirk Webb committed
100 101 102 103 104 105 106 107
sub _allranges($)  { return $_[0]->{'ALLOC_RANGES'}; }
sub _allnew($)     { return $_[0]->{'NEWLIST'}; }
sub _getrange($$)  { return $_[0]->_allranges()->{$_[1]}; }
sub _putrange($$$) { $_[0]->_allranges()->{$_[1]} = $_[2]; }
sub _newrange($$$) { $_[0]->_putrange($_[1],$_[2]); 
		     push @{$_[0]->_allnew()}, $_[2]; }

#
108
# Grab the reserved address lock.
Kirk Webb's avatar
Kirk Webb committed
109 110 111
#
sub lock($) {
    my $self = shift;
112 113 114 115 116 117

    # Use a file lock instead of a table lock since we don't know what
    # other tables might be used while this is locked.
    TBScriptLock($BUDDYRESLOCK) == TBSCRIPTLOCK_OKAY()
	or return 0;

Kirk Webb's avatar
Kirk Webb committed
118 119 120 121
    return 1;
}

#
122
# Release the lock.
Kirk Webb's avatar
Kirk Webb committed
123 124 125
#
sub unlock($) {
    my $self = shift;
126 127 128

    TBScriptUnlock();

Kirk Webb's avatar
Kirk Webb committed
129 130 131 132 133 134 135 136 137 138 139 140 141
    return 1;
}

#
# Load ranges into this object from the Emulab database.  Also, optionally
# add the subnets for a specified experiment to the set of reservations.
#
# $self   - Reference to class instance.
# $vexperiment - (optional) VirtExperiment object reference.  virtlans
#                that are a member of this experiment will be added to the
#                set of reserved address ranges.
#
sub loadReservedRanges($;$) {
142
    my ($self, $experiment) = @_;
Kirk Webb's avatar
Kirk Webb committed
143 144

    my $bud      = $self->_getbuddy();
145
    my $ranges   = $self->_allranges();
Kirk Webb's avatar
Kirk Webb committed
146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169
    my $addrtype = $self->_gettype();

    my $qres =
	DBQueryWarn("select * from reserved_addresses where type='$addrtype'");
    return -1
	if (!$qres);

    # Go through each row in the reserved addresses table for the type
    # specified, and add the ranges to the internal buddy allocator.
    # Create and stash an object for other bookkeeping.
    while (my ($ridx, $pid, $eid, $exptidx, $rtime, 
	       $baseaddr, $prefix, $type, $role) = $qres->fetchrow()) 
    {
	my $rval = eval { $bud->embedAddressRange("$baseaddr/$prefix") };
	if ($@) {
	    tberror("Error while embedding reserved address range: $@\n");
	    return -1
	}
	$self->_putrange("$baseaddr/$prefix",
			 IPBuddyWrapper::Allocation->new($exptidx, 
							 "$baseaddr/$prefix"));
    }

    # Add an experiment's virtlans if that parameter was passed in.
170
    if (defined($experiment)) {
171
	if (!ref($experiment)) {
172
	    tberror("Experiment argument is not an object!\n");
Kirk Webb's avatar
Kirk Webb committed
173 174
	    return -1;
	}
175 176 177
	my $exptidx    = $experiment->idx();
	my $virtexpt   = $experiment->GetVirtExperiment();
	my $virtlans   = $virtexpt->Table("virt_lans");
178 179 180
	foreach my $vlrow ($virtlans->Rows()) {
	    my $ip     = inet_aton($vlrow->ip());
	    my $mask   = inet_aton($vlrow->mask());
Kirk Webb's avatar
Kirk Webb committed
181 182
	    my $prefix = unpack('%32b*', $mask);
	    my $base   = inet_ntoa($ip & $mask);
183
	    next if $self->_getrange("$base/$prefix");
Kirk Webb's avatar
Kirk Webb committed
184 185
	    my $rval   = eval { $bud->embedAddressRange("$base/$prefix") };
	    if ($@) {
186
		# Just skip if the current range isn't in the base
187 188 189
		# address range or conflicts with an existing
		# range. We only care about adding new ranges within
		# the base range considered for allocation.
190
		next if $@ =~ /must belong to base range/;
191
		next if $@ =~ /found conflicting node/;
Kirk Webb's avatar
Kirk Webb committed
192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210
		tberror("Error while embedding experiment lan range: $@\n");
		return -1;
	    }
	    $self->_putrange("$base/$prefix",
			     IPBuddyWrapper::Allocation->new($exptidx,
							     "$base/$prefix"));
	}
    }

    return 0;
}

#
# Request an address range from the buddy IP address pool given the
# input (dotted quad) mask and a virt experiment to stash away for
# later when the code needs to push the reservations into the
# database.
#
sub requestAddressRange($$$) {
211
    my ($self, $experiment, $mask) = @_;
Kirk Webb's avatar
Kirk Webb committed
212 213

    return undef unless 
214
	ref($experiment) &&
Kirk Webb's avatar
Kirk Webb committed
215 216
	defined($mask);

217 218
    # Check mask argument to see if it is a dotted-quad mask or a CIDR
    # prefix.  Convert dotted-quad masks to CIDR prefixes.
Kirk Webb's avatar
Kirk Webb committed
219 220 221
    my $prefix;
    if ($mask =~ /^\d+\.\d+\.\d+\.\d+$/) {
	$prefix = unpack('%32b*', inet_aton($mask));
222
    } elsif ($mask =~ /^\d+$/) {
Kirk Webb's avatar
Kirk Webb committed
223 224
	$prefix = $mask;
    } else {
225
	tberror("Invalid mask or prefix: $mask\n");
Kirk Webb's avatar
Kirk Webb committed
226 227 228
	return undef;
    }

229
    my $exptidx = $experiment->idx();
Kirk Webb's avatar
Kirk Webb committed
230 231
    my $bud     = $self->_getbuddy();

232
    # IPBuddyAlloc throws exceptions.
233
  again:
234
    my $base = eval { $bud->requestAddressRange($prefix) };
Kirk Webb's avatar
Kirk Webb committed
235 236 237 238
    if ($@) {
	tberror("Error while requesting address range: $@");
	return undef;
    }
239
    if (!defined($base)) {
Kirk Webb's avatar
Kirk Webb committed
240 241 242
	tberror("Could not get a free address range!\n");
	return undef;
    }
243 244 245 246 247 248 249 250
    # Throw away any ranges where all the bits are set in the quad.
    # We want to avoid confusion and potential issues with broadcast
    # addresses.
    foreach my $quad (split(/\./, $base)) {
	if ($quad == 255) {
	    goto again;
	}
    }
251
    my $range = "$base/$prefix";
252 253
    # Push the new range onto the new range list.  This also puts it
    # into the "allocated" hash.
Kirk Webb's avatar
Kirk Webb committed
254 255 256 257 258 259 260 261
    $self->_newrange($range, IPBuddyWrapper::Allocation->new($exptidx,
							     $range));

    return $range;
}

#
# Request the next address from the input range.  It should have been
262
# previously allocated with requestAddressRange().
Kirk Webb's avatar
Kirk Webb committed
263 264 265 266 267 268 269 270
#
sub getNextAddress($$) {
    my ($self, $range) = @_;

    return undef
	unless defined($range);

    my $robj = $self->_getrange($range);
271 272 273 274
    if (!defined($robj)) {
	tberror("Can't find allocation object for range: $range!\n");
	return undef
    }
Kirk Webb's avatar
Kirk Webb committed
275 276 277 278 279 280
    return $robj->getNextAddress();
}

sub DESTROY($) {
    my $self = shift;

281 282
    $self->{'TYPE'} = undef;
    $self->{'ROLE'} = undef;
Kirk Webb's avatar
Kirk Webb committed
283 284 285 286 287 288
    $self->{'BUDDY'} = undef;
    $self->{'ALLOC_RANGES'} = undef;
    $self->{'NEWLIST'} = undef;
}

#
289
# Splat the list of newly allocated address ranges into the database.
Kirk Webb's avatar
Kirk Webb committed
290 291 292
#
sub commitReservations($) {
    my ($self) = @_;
293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314
    my $type = $self->_gettype();
    my $role = $self->_getrole();

    foreach my $alloc (@{$self->_allnew()}) {
	my $exptidx = $alloc->exptidx();
	my ($base, $prefix) = split(/\//, $alloc->getrange());
	my $expt    = Experiment->Lookup($exptidx);
	return -1
	    if !$expt;
	my $pid = $expt->pid();
	my $eid = $expt->eid();
	# Other IPBuddyWrapper objects should already be blocked on
	# our lock on the "reserved_addresses" table.
	my $nolock = 1;
	my $idxinitval = 1;
	my $ridx = TBGetUniqueIndex("next_resvaddridx",$idxinitval,$nolock);
	
	DBQueryWarn("insert into reserved_addresses ".
		    "values ('$ridx','$pid','$eid','$exptidx',".
		    "NOW(),'$base','$prefix','$type','$role')")
	    || return -1;
    }
Kirk Webb's avatar
Kirk Webb committed
315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346

    return 0;
}

##############################################################################
#
# Internal module to keep track of address range allocations.
#
package IPBuddyWrapper::Allocation;
use strict;
use English;
use Net::IP;
use libtblog_simple;

sub new($$$) {
    my ($class, $exptidx, $range) = @_;
    my $self = {};

    return undef unless 
	defined($exptidx) && 
	defined($range);

    my $ipobj = Net::IP->new($range);
    if (!defined($ipobj)) {
	tberror(Net::IP::Error() . "\n");
	return undef;
    }
    
    $self->{'EXPTIDX'} = $exptidx;
    $self->{'RANGE'} = $range;
    $self->{'IPOBJ'} = $ipobj;
    
Kirk Webb's avatar
Kirk Webb committed
347
    bless($self, $class);
Kirk Webb's avatar
Kirk Webb committed
348 349 350 351
    return $self;
}

# accessors
352 353
sub getrange($) { return $_[0]->{'RANGE'}; }
sub exptidx($) { return $_[0]->{'EXPTIDX'}; }
Kirk Webb's avatar
Kirk Webb committed
354 355 356 357 358 359 360

#
# Get next available address in the range. ('+' is overloaded in Net::IP).
#
sub getNextAddress($) {
    my ($self) = @_;

361 362
    if (++$self->{'IPOBJ'}) {
	return $self->{'IPOBJ'}->ip();
Kirk Webb's avatar
Kirk Webb committed
363 364 365 366 367 368 369 370 371
    }
    
    return undef;
}

#
# Reset back to base address from this object's range.
#
sub resetAddress($) {
Kirk Webb's avatar
Kirk Webb committed
372
    my $self = shift;
Kirk Webb's avatar
Kirk Webb committed
373

374
    my $ipobj = Net::IP->new($self->getrange());
Kirk Webb's avatar
Kirk Webb committed
375 376 377 378 379 380 381 382 383 384 385 386 387 388
    $self->{'IPOBJ'} = $ipobj;
}


sub DESTROY($) {
    my $self = shift;

    $self->{'EXPTIDX'} = undef;
    $self->{'RANGE'} = undef;
    $self->{'IPOBJ'} = undef;
}

# Required by perl
1;