IPBuddyAlloc.pm 9.78 KB
Newer Older
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
#!/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/>.
# 
# }}}
#
# IP Address Range buddy allocator, a la memory management.
#
26
package IPBuddyAlloc;
27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46

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

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

use English;
use Tree::Binary;
use Net::IP;

# Global vars
my $debug    = 0;

# Prototypes
sub setSpace($$);
sub embedAddressRange($$);
sub requestAddressRange($$);
47 48
sub printTree($);
sub getRanges($);
49 50 51
sub _findFree($$$);

#
52
# Constructor takes the base address space (e.g. x.x.x.x/y) as a parameter.
53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83
#
sub new($$) {
    my ($class, $addr) = @_;
    my $self = {};

    my $ip = Net::IP->new($addr);
    if (!defined($ip)) {
	die Net::IP::Error();
    }

    $self->{'ROOT'} = Tree::Binary->new("*");
    $self->{'BASE_IPOBJ'} = $ip;

    bless($self,$class);
    return $self;
}

# Accessors
sub getobj($) { my $self = shift; return $self->{'BASE_IPOBJ'} }
sub getip($) { my $self = shift; return $self->getobj->ip() }
sub getprefix($) { my $self = shift; return $self->getobj()->prefixlen() }
sub getroot($) { my $self = shift; return $self->{'ROOT'} }

# Turn debugging on/off
sub setDebug($$) {
    my ($self,$dbg) = @_;

    $debug = defined($dbg) && $dbg ? $dbg : 0;
}

#
84
# Set the base IP space in which addresses will be embedded and
85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112
# requested.
#
sub setSpace($$) {
    my ($self, $addr) = @_;

    my $ip = Net::IP->new($addr);
    if (!defined($ip)) {
	die Net::IP::Error();
    }

    $self->{'BASE_IPOBJ'} = $ip;

    return 0;
}

#
# Embed an existing IP range reservation into the binary tree.  Create
# nodes as needed to represent it down to the depth of its prefix.
# 
sub embedAddressRange($$) {
    my ($self, $addr) = @_;

    my $bobj = $self->getobj();
    my $inobj = Net::IP->new($addr);
    if (!defined($inobj)) {
	die Net::IP::Error();
    }

113
    # Check that the incoming address range is inside the base range.
114
    if ($bobj->overlaps($inobj) != $IP_B_IN_A_OVERLAP) {
115 116
	die "range to embed (" . $inobj->prefix() .
	    ") must belong to base range: " . $bobj->prefix();
117 118 119 120
    }

    # Blow up bits representing input IP address into an array for
    # embedding in the binary tree.  Zap the leading bits corresponding
121
    # to the base range prefix.
122 123 124 125 126 127 128 129
    my $ibits   = $inobj->binip();
    my @ibitarr = split(//, $ibits);
    splice(@ibitarr, 0, $bobj->prefixlen());

    print "Inserting address: ". $inobj->prefix() ."\n".
	"bits: @ibitarr\n" if $debug;

    # Set initial depth value to base range address mask depth (prefix)
130
    # so that we skip over the common prefix bits.
131 132
    my $curdepth = $bobj->prefixlen();
    # Loop through the bits in the address, creating corresponding nodes in
133
    # the binary tree (as needed) and looking for collisions.
134 135 136
    my $tptr = $self->getroot();  # start embedding at the root, obviously!
    foreach my $bit (@ibitarr) {
	$curdepth++;
137
	# Are we at terminal depth for the input range?
138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202
	my $term = $inobj->prefixlen() == $curdepth ? 1 : 0;
	# Check bit, and go down correct path
	if ($bit) {
	    # Bit is a '1' - go right.
	    # First check to see if there is already a child node.
	    if ($tptr->hasRight()) {
		print "Visiting bit: $bit\n".
		    "Depth: $curdepth\n" if $debug > 1;
		# There is a child node.  Grab it.
		$tptr = $tptr->getRight();
		# Check to see if the child node conflicts.
		if ($term || $tptr->getNodeValue()->{'term'} == 1) {
		    die "found conflicting node while embedding!";
		}
	    } else {
		# No value exists yet at this location.
		$tptr->setRight(Tree::Binary->new({"value" => 1,
						   "term"  => $term}));
		$tptr = $tptr->getRight();
		print "Set bit: $bit\n".
		    "Depth: $curdepth\n" if $debug > 1;
		last if $term; # Bail if we are at prefix length depth.
	    }
	} else {
	    # Bit is a '0' - go left.
	    # First check to see if there is already a child node.
	    if ($tptr->hasLeft()) {
		print "Visiting bit: $bit\n".
		    "Depth: $curdepth\n" if $debug > 1;
		# There is a child node.  Grab it.
		$tptr = $tptr->getLeft();
		# Check to see if the child node conflicts.
		if ($term || $tptr->getNodeValue()->{'term'} == 1) {
		    die "found conflicting node while embedding!";
		}
	    } else {
		# No value exists yet at this location.
		$tptr->setLeft(Tree::Binary->new({"value" => 0,
						  "term"  => $term}));
		$tptr = $tptr->getLeft();
		print "Set bit: $bit\n".
		    "Depth: $curdepth\n" if $debug > 1;
		last if $term; # Bail if we are at prefix length depth.
	    }
	}
    }
    print "\n" if $debug;
    return 0;
}

#
# Top-level interface to ask for a free address range of the specified size
# (prefix length).  Returns the base address and embeds it in the tree,
# effectively marking it as allocated.
#
sub requestAddressRange($$) {
    my ($self, $prefix) = @_;

    my $bobj = $self->getobj();

    print "Looking for address range with prefix: $prefix\n" if $debug;

    my $reqdepth = $prefix - $bobj->prefixlen();
    # Can we fulfill the request?
    if ($reqdepth <= 0) {
203
	die "Prefix is too big for the base range.\n".
204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235
	    "Requested: $prefix\t Base Range: ". $bobj->prefix();
    }

    # Search the binary tree for a free address range.
    my $addrn = $self->_findFree($self->getroot(), $reqdepth);

    # No address range found - report failure.
    if (!defined($addrn)) {
	return undef;
    }

    # Free address range found!
    my @addrbits = ();
    # Walk backwards through the tree from the leaf, collecting up the
    # bits that make up this address.
    while (!$addrn->isRoot()) {
	unshift(@addrbits, $addrn->getNodeValue()->{'value'});
	$addrn = $addrn->getParent();
    }
    print "address bits found: @addrbits\n". 
	"length: " . scalar(@addrbits) . "\n" if $debug;
    # Put humpty dumpty back together and return.
    my $hbits =
	"0" x $bobj->prefixlen() .  # base range prefix bits.
	join("", @addrbits) .       # unique bits stored in binary tree.
	"0" x (length($bobj->binip()) - $prefix); # host address bits.
    my $hobj = Net::IP->new(Net::IP::ip_bintoip($hbits, 
						$bobj->version()));
    return $hobj->binadd($bobj)->ip();
}

# Helper method.
236
# Traverse the binary tree looking for an empty slot at the correct depth.
237
# Create nodes/branches as necesary to get to the requested depth.  This
238
# procedure walks down the "right side" of the tree, going left only when
239 240 241 242 243
# it must.
#
# $self - Object reference for this class 
# $cn - The "current" Tree::Binary node object in the recursive traversal.
# $reqdepth - The requested depth.  This should be the input prefix size with 
244
#             the base range prefix length subtracted.
245 246 247 248 249 250 251 252 253 254 255 256
#
sub _findFree($$$) {
    my ($self, $cn, $reqdepth) = @_;

    # Did we hit a terminal?  Go back if so!  Skip the tree's root.
    if (!$cn->isRoot() && $cn->getNodeValue()->{'term'} == 1) {
	return undef;
    }

    # Are we just above the requested depth (prefix length)?  If there
    # is a free slot underneath, we'll use/return it!
    if ($cn->getDepth() == $reqdepth-1) {
257
	if (!$cn->hasRight()) {
258 259 260
	    $cn->setRight(Tree::Binary->new({"value" => 1, 
					     "term"  => 1}));
	    return $cn->getRight();
261 262 263 264
	} elsif (!$cn->hasLeft()) {
	    $cn->setLeft(Tree::Binary->new({"value" => 0, 
					    "term"  => 1}));
	    return $cn->getLeft();
265 266 267 268 269 270 271
	} else {
	    # No free slot - dead end.
	    return undef;
	}
    }

    # Not at the terminal depth yet, so keep walking down (keeping
272
    # right), creating nodes as necessary.
273 274 275
    if (!$cn->hasRight()) {
	$cn->setRight(Tree::Binary->new({"value" => 1, 
					 "term"  => 0}));
276
    }
277
    my $rval = $self->_findFree($cn->getRight(), $reqdepth);
278
    if (!$rval) {
279 280 281 282
	# Nothing to the right, go left...
	if (!$cn->hasLeft()) {
	    $cn->setLeft(Tree::Binary->new({"value" => 0, 
					    "term"  => 0}));
283
	}
284
	$rval = $self->_findFree($cn->getLeft(), $reqdepth);
285 286 287 288 289
    }
    return $rval;
}

# print out a traversal of the tree using spaces to demarc levels.
290
sub printTree($) {
291 292 293 294 295 296 297 298 299
    my $self = shift;

    my $cn = $self->getroot();

    $cn->traverse(sub {
	my ($_tree) = @_;
	return if $_tree->isRoot();
	my $val = $_tree->getNodeValue()->{'value'};
	my $term = $_tree->getNodeValue()->{'term'} ? '*' : "";
300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331
	print " " x $_tree->getDepth() . "${val}${term}\n";
    });
}

# print out all ranges embedded in the tree.
sub getRanges($) {
    my $self = shift;

    my $cn = $self->getroot();
    my $bobj = $self->getobj();
    my $pflen = $bobj->prefixlen();
    my $bprebits = substr($bobj->binip(), 0, $pflen);
    my $postlen = length($bobj->binip()) - $pflen;
    my @addr = ();
    my @results = ();

    $cn->traverse(sub {
	my ($_tree) = @_;
	my $depth = $_tree->getDepth();
	return if $_tree->isRoot();
	splice(@addr, $depth-1);
	push @addr, $_tree->getNodeValue()->{'value'};
	if ($_tree->isLeaf()) {
	    my $hbits = "0" x ($postlen - $depth);
	    my $ipstr = 
		Net::IP::ip_bintoip($bprebits . join("", @addr) . $hbits,
				    $bobj->version());
	    push @results, "$ipstr/" . ($depth + $pflen);
	}
    });

    return @results;
332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349
}

#
# Destroy the object.  Must explicitly call DESTROY on the underlying
# Tree::Binary object.
#
sub DESTROY($) {
    my $self = shift;

    if ($self->{'ROOT'}) {
	$self->{'ROOT'}->DESTROY();
    }
    $self->{'ROOT'} = undef;
    $self->{'BASE_IPOBJ'} = undef;
}

# Required by perl
1;