Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • alex_orange/emulab-devel
  • hakasapl/emulab-devel
  • cecchet/emulab-devel
  • srirams/emulab-devel
  • chuck/emulab-devel
  • crd/emulab-devel
  • kwebb/emulab-devel
  • moate/emulab-devel
  • grubb/emulab-devel
  • nasir/emulab-devel
  • asydney/emulab-devel
  • kdownie/emulab-devel
  • wvdemeer/emulab-devel
  • anilmr/emulab-devel
  • bvermeul/emulab-devel
  • emulab/emulab-devel
16 results
Show changes
Hide whitespace changes
Inline Side-by-side
Showing
with 941 additions and 0 deletions
apt/APT_RFRange.pm.in 0 → 100644
View file @ 2800e1e3
#!/usr/bin/perl -wT
#
# Copyright (c) 2007-2022 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 APT_RFRange;
use strict;
use Carp;
use Exporter;
use vars qw(@ISA @EXPORT);
@ISA = "Exporter";
@EXPORT = qw ( );
# Configure variables
my $TB = "@prefix@";
my $TBOPS = "@TBOPSEMAIL@";
my $OURDOMAIN = "@OURDOMAIN@";
my $MAINSITE = @TBMAINSITE@;
#
# Nothing in the main package at the moment.
#
###################################################################
package APT_RFRange::Range;
use emdb;
use Project;
use Brand;
use libtestbed;
use English;
use Carp;
use Data::Dumper;
use vars qw($AUTOLOAD);
use overload ('""' => 'Stringify');
AUTOLOAD {
my $self = $_[0];
my $type = ref($self) or croak "$self is not an object";
my $name = $AUTOLOAD;
$name =~ s/.*://; # strip fully-qualified portion
# A DB row proxy method call.
if (exists($self->{'HASH'}->{$name})) {
return $self->{'HASH'}->{$name};
}
carp("No such slot '$name' field in class $type");
return undef;
}
# Watch for a named range and used the dereferenced values.
sub freq_low($) {
my ($self) = @_;
if (exists($self->{'HASH'}->{"named_low"}) &&
defined($self->{'HASH'}->{"named_low"})) {
return $self->{'HASH'}->{"named_low"};
}
else {
return $self->{'HASH'}->{"freq_low"};
}
}
sub freq_high($) {
my ($self) = @_;
if (exists($self->{'HASH'}->{"named_high"}) &&
defined($self->{'HASH'}->{"named_high"})) {
return $self->{'HASH'}->{"named_high"};
}
else {
return $self->{'HASH'}->{"freq_high"};
}
}
#
# Wrap a DB row.
#
sub Range($$)
{
my ($class, $hash) = @_;
my $self = {};
$self->{'HASH'} = $hash;
bless($self, $class);
return $self;
}
sub hash($) { return $_[0]->{'HASH'}; }
#
# Compare a range against low, high to see if its within.
#
sub Within($$$)
{
my ($self, $freq_low, $freq_high) = @_;
if ($freq_low >= $self->freq_low() &&
$freq_high <= $self->freq_high() && $freq_low <= $freq_high) {
return 1;
}
return 0;
}
# Break circular dependencies
sub DESTROY {
my $self = shift;
$self->{'HASH'} = undef;
}
# Copy (and dereferenced).
sub Copy($)
{
my ($self) = @_;
my $row = {};
$row->{"idx"} = $self->idx();
$row->{"range_id"} = $self->range_id()
if (exists($self->hash()->{"range_id"}));
$row->{"freq_low"} = $self->freq_low();
$row->{"freq_high"} = $self->freq_high();
return APT_RFRange::Range->Range($row);
}
# Print a range,
sub Dump($)
{
my ($self) = @_;
my $range_id = "";
my $freq_low = $self->freq_low();
my $freq_high = $self->freq_high();
if (defined($self->{'HASH'}->{"range_id"})) {
$range_id = $self->{'HASH'}->{"range_id"};
}
elsif (exists($self->{'HASH'}->{"idx"})) {
$range_id = $self->{'HASH'}->{"idx"};
}
printf "%-16s %-8s %-8s\n", $range_id, $freq_low, $freq_high;
}
sub Stringify($)
{
my ($self) = @_;
my $range_id = "";
my $freq_low = $self->freq_low();
my $freq_high = $self->freq_high();
if (defined($self->{'HASH'}->{"range_id"})) {
$range_id = $self->{'HASH'}->{"range_id"};
}
elsif (exists($self->{'HASH'}->{"idx"})) {
$range_id = $self->{'HASH'}->{"idx"};
}
return "[RFRange $range_id,$freq_low,$freq_high]";
}
###################################################################
package APT_RFRange::NamedRange;
use base qw(APT_RFRange::Range);
use emdb;
use Project;
use Brand;
use libtestbed;
use English;
use Carp;
use Data::Dumper;
#
# Lookup a named range
#
sub Lookup($$)
{
my ($class, $range_id) = @_;
my $query_result;
if ($range_id =~ /^[-\w]+$/) {
$query_result =
DBQueryWarn("select * from apt_named_rfranges ".
"where range_id='$range_id'");
}
else {
return undef;
}
return undef
if (!$query_result || !$query_result->numrows);
my $row = $query_result->fetchrow_hashref();
my $self = {};
$self->{'HASH'} = $row;
bless($self, $class);
return $self;
}
sub Create($$$$)
{
my ($class, $range_id, $low, $high) = @_;
DBQueryWarn("insert into apt_named_rfranges set ".
" range_id='$range_id',freq_low='$low',freq_high='$high'")
or return undef;
return Lookup($class, $range_id);
}
sub Update($$$$)
{
my ($self, $range_id, $low, $high) = @_;
DBQueryWarn("replace into apt_named_rfranges set ".
" range_id='$range_id',freq_low='$low',freq_high='$high'")
or return -1;
$self->{'HASH'}->{'freq_low'} = $low;
$self->{'HASH'}->{'freq_high'} = $high;
return 0;
}
#
# Lookup all the named ranges.
#
sub LookupAll($$)
{
my ($class, $pref) = @_;
my $result = {};
my $query_result =
DBQueryWarn("select * from apt_named_rfranges");
return -1
if (!$query_result);
while (my $row = $query_result->fetchrow_hashref()) {
my $range = APT_RFRange::Range->Range($row);
$result->{$range->range_id()} = $range;
}
$$pref = $result;
return 0
}
# Print out the ranges in nice format
sub DumpList($$)
{
my ($class, $ref) = @_;
my @sorted = sort keys(%{$ref});
foreach my $range_id (@sorted) {
$ref->{$range_id}->Dump();
}
}
# Is the named range in a project, global, or set list.
sub InUse($)
{
my ($self) = @_;
my $range_id = $self->range_id();
my $query_result =
DBQueryWarn("(select distinct range_id ".
" from apt_global_rfranges where range_id='$range_id') ".
"union ".
"(select distinct range_id ".
" from apt_project_rfranges where range_id='$range_id') ".
"union ".
"(select distinct range_id ".
" from apt_rfrange_sets where range_id='$range_id')");
return -1
if (!defined($query_result));
return $query_result->numrows;
}
sub Delete($)
{
my ($self) = @_;
my $range_id = $self->range_id();
DBQueryWarn("delete from apt_named_rfranges ".
"where range_id='$range_id'")
or return -1;
return 0;
}
###################################################################
package APT_RFRange::Set;
use emdb;
use Project;
use Brand;
use libtestbed;
use English;
use Carp;
use Data::Dumper;
#
# Lookup all the ranges in a set (which has a name).
#
sub Lookup($$)
{
my ($class, $setname) = @_;
my $query_result;
if ($setname =~ /^[-\w]+$/) {
$query_result =
DBQueryWarn("select s.*,n.freq_low as named_low,".
" n.freq_high as named_high ".
" from apt_rfrange_sets as s ".
"left join apt_named_rfranges as n on ".
" s.range_id is not null and n.range_id=s.range_id ".
"where setname='$setname' and disabled=0 and ".
# Ignore named ranges that have no definition
" not (s.range_id is not null and ".
" n.range_id is null)");
}
else {
return undef;
}
return undef
if (!$query_result || !$query_result->numrows);
my $self = {};
my $ranges = {};
$self->{'SETNAME'} = $setname;
$self->{'RANGES'} = $ranges;
bless($self, $class);
while (my $row = $query_result->fetchrow_hashref()) {
my $range = APT_RFRange::Range->Range($row);
$ranges->{$range->idx()} = $range;
}
return $self;
}
sub setname($) { return $_[0]->{'SETNAME'}; }
sub RangeHash($) { return $_[0]->{'RANGES'}; }
sub RangeList($) { return values(%{ $_[0]->{'RANGES'} }); }
# Print out the ranges in nice format
sub Dump($)
{
my ($self) = @_;
my @sorted = sort { $a <=> $b } keys(%{$self->RangeHash});
foreach my $idx (@sorted) {
$self->RangeHash()->{$idx}->Dump();
}
}
#
# Add a range (by name or low,high) to a set. Rather then worry about
# empty sets, let the the argument be a setname or an object.
#
sub AddRange($$;$)
{
my ($self, $arg1, $arg2) = @_;
my $setname = ref($self) ? $self->setname() : $self;
if (defined($arg2)) {
DBQueryWarn("insert into apt_rfrange_sets set ".
" setname='$setname',freq_low='$arg1',freq_high='$arg2'")
or return -1;
}
else {
DBQueryWarn("insert into apt_rfrange_sets set ".
" setname='$setname',range_id='$arg1'")
or return -1;
}
return 0;
}
sub RemoveRange($$)
{
my ($self, $range) = @_;
my $setname = $self->setname();
my $idx = $range->idx();
DBQueryWarn("delete from apt_rfrange_sets ".
"where setname='$setname' and idx='$idx'")
or return -1;
return 0;
}
#
# Find a range in the list.
#
sub FindRange($$;$)
{
my ($self, $arg1, $arg2) = @_;
foreach my $range ($self->RangeList()) {
if (defined($arg2)) {
return $range
if ($arg1 == $range->freq_low() &&
$arg2 == $range->freq_high());
}
elsif ($arg1 =~ /^\d+$/) {
return $range
if ($arg1 == $range->idx());
}
elsif (defined($range->range_id())) {
return $range
if ($arg1 eq $range->range_id());
}
}
return undef;
}
#
# All sets, returned as a hash.
#
sub LookupAll($$)
{
my ($class, $pref) = @_;
my $result = {};
my $query_result = DBQueryWarn("select setname from apt_rfrange_sets");
return -1
if (!defined($query_result));
while (my ($setname) = $query_result->fetchrow_array()) {
my $set = Lookup($class, $setname);
if (!defined($set)) {
print STDERR "Could not lookup rfrange set $setname\n";
next;
}
$result->{$setname} = $set;
}
$$pref = $result;
return 0;
}
###################################################################
package APT_RFRange::GlobalRange;
use base qw(APT_RFRange::Range);
use emdb;
use Project;
use Brand;
use libtestbed;
use English;
use Carp;
use Data::Dumper;
#
# Lookup a global range by idx, name or low,high
#
sub Lookup($$;$)
{
my ($class, $arg1, $arg2) = @_;
my $clause;
if (!defined($arg2)) {
if ($arg1 =~ /^\d+$/) {
$clause = "g.idx='$arg1'";
}
elsif ($arg1 =~ /^[-\w]+$/) {
$clause = "g.range_id='$arg1'";
}
else {
return undef;
}
}
else {
$clause = "(g.freq_low=$arg1 and g.freq_high=$arg2)";
}
my $query_result =
DBQueryWarn("select g.*,n.freq_low as named_low,".
" n.freq_high as named_high ".
" from apt_global_rfranges as g ".
"left join apt_named_rfranges as n on ".
" g.range_id is not null and n.range_id=g.range_id ".
"where $clause and disabled=0");
return undef
if (!$query_result || !$query_result->numrows);
my $row = $query_result->fetchrow_hashref();
my $self = {};
$self->{'HASH'} = $row;
bless($self, $class);
#
# Check for a named range that is not defined. Print an error.
#
if (defined($self->range_id()) && !defined($self->named_low())) {
print STDERR "Global range named " . $self->range_id() .
" has no definition in named range table\n";
return undef;
}
return $self;
}
sub Create($$;$)
{
my ($class, $arg1, $arg2) = @_;
if (defined($arg2)) {
DBQueryWarn("insert into apt_global_rfranges set ".
" freq_low='$arg1',freq_high='$arg2'")
or return undef;
}
else {
DBQueryWarn("insert into apt_global_rfranges set ".
" range_id='$arg1'")
or return undef;
}
return Lookup($class, $arg1, $arg2);
}
#
# Lookup all of the global ranges and return a list.
#
sub LookupAll($$)
{
my ($class, $pref) = @_;
my $result = {};
my $query_result =
DBQueryWarn("select g.*,n.freq_low as named_low,".
" n.freq_high as named_high ".
" from apt_global_rfranges as g ".
"left join apt_named_rfranges as n on ".
" g.range_id is not null and n.range_id=g.range_id ".
"where disabled=0 and ".
# Ignore named ranges that have no definition
" not (g.range_id is not null and ".
" n.range_id is null)");
return -1
if (!$query_result);
while (my $row = $query_result->fetchrow_hashref()) {
my $range = APT_RFRange::Range->Range($row);
$result->{$range->idx()} = $range;
}
$$pref = $result;
return 0
}
# Print out the ranges in nice format
sub DumpList($$)
{
my ($class, $ref) = @_;
my @sorted = sort { $a <=> $b } keys(%{$ref});
foreach my $idx (@sorted) {
$ref->{$idx}->Dump();
}
}
sub Delete($)
{
my ($self) = @_;
my $idx = $self->idx();
DBQueryWarn("delete from apt_global_rfranges ".
"where idx='$idx'")
or return -1;
return 0;
}
###################################################################
package APT_RFRange::ProjectRange;
use base qw(APT_RFRange::Range);
use emdb;
use Project;
use Brand;
use libtestbed;
use English;
use Carp;
use Data::Dumper;
# Class wrap.
sub new($$$)
{
my ($class, $project, $row) = @_;
my $self = {};
$self->{'HASH'} = $row;
$self->{'PROJECT'} = $project;
bless($self, $class);
return $self;
}
#
# Lookup a project range by idx, name or low,high
#
sub Lookup($$$;$)
{
my ($class, $project, $arg1, $arg2) = @_;
my $pid_idx = $project->pid_idx();
my $clause;
if (!defined($arg2)) {
if ($arg1 =~ /^\d+$/) {
$clause = "p.idx='$arg1'";
}
elsif ($arg1 =~ /^[-\w]+$/) {
$clause = "p.range_id='$arg1'";
}
else {
return undef;
}
}
else {
$clause = "(p.freq_low=$arg1 and p.freq_high=$arg2)";
}
my $query_result =
DBQueryWarn("select p.*,n.freq_low as named_low,".
" n.freq_high as named_high ".
" from apt_project_rfranges as p ".
"left join apt_named_rfranges as n on ".
" p.range_id is not null and n.range_id=p.range_id ".
"where $clause and pid_idx='$pid_idx' and disabled=0");
return undef
if (!$query_result || !$query_result->numrows);
my $self = new($class, $project, $query_result->fetchrow_hashref());
#
# Check for a named range that is not defined. Print an error.
#
if (defined($self->range_id()) && !defined($self->named_low())) {
print STDERR "Project range named " . $self->range_id() .
" has no definition in named range table\n";
return undef;
}
return $self;
}
sub project($) { return $_[0]->{'PROJECT'}; }
#
# Lookup all the ranges in the project list
#
sub LookupAll($$$)
{
my ($class, $project, $pref) = @_;
my $pid_idx = $project->pid_idx();
my $result = {};
my $query_result =
DBQueryWarn("select p.*,n.freq_low as named_low,".
" n.freq_high as named_high ".
" from apt_project_rfranges as p ".
"left join apt_named_rfranges as n on ".
" p.range_id is not null and n.range_id=p.range_id ".
"where pid_idx='$pid_idx' and disabled=0 and ".
# Ignore named ranges that have no definition
" not (p.range_id is not null and ".
" n.range_id is null)");
return -1
if (!$query_result);
while (my $row = $query_result->fetchrow_hashref()) {
my $range = new($class, $project, $row);
$result->{$range->idx()} = $range;
}
$$pref = $result;
return 0
}
sub Create($$$;$)
{
my ($class, $project, $arg1, $arg2) = @_;
my $pid_idx = $project->pid_idx();
my $pid = $project->pid();
if (defined($arg2)) {
DBQueryWarn("insert into apt_project_rfranges set ".
" pid='$pid',pid_idx='$pid_idx',".
" freq_low='$arg1',freq_high='$arg2'")
or return undef;
}
else {
DBQueryWarn("insert into apt_project_rfranges set ".
" pid='$pid',pid_idx='$pid_idx',range_id='$arg1'")
or return undef;
}
return Lookup($class, $project, $arg1, $arg2);
}
# Print out the ranges in nice format
sub DumpList($$)
{
my ($class, $ref) = @_;
my @sorted = sort { $a <=> $b } keys(%{$ref});
foreach my $idx (@sorted) {
$ref->{$idx}->Dump();
}
}
sub Delete($)
{
my ($self) = @_;
my $pid_idx = $self->project()->pid_idx();
my $idx = $self->idx();
DBQueryWarn("delete from apt_project_rfranges ".
"where pid_idx='$pid_idx' and idx='$idx'")
or return -1;
return 0;
}
#
# Delete a named range from all projects.
#
sub DeleteFromAllProjects($$)
{
my ($class, $name) = @_;
DBQueryWarn("delete from apt_project_rfranges ".
"where range_id='$name'")
or return -1;
return 0;
}
###################################################################
#
# This class is used to enumerate all the ranges allowed by a
# project, which can be queried to see if a range is allowed to
# be used.
#
package APT_RFRange::Project;
use emdb;
use Project;
use Brand;
use libtestbed;
use English;
use Carp;
use Data::Dumper;
#
# Enumerate all the ranges allowed by a project and store in an object
# that can be queried. This includes project/global and dereferences
# the named ranges.
#
sub Lookup($$)
{
my ($class, $project) = @_;
my $pid_idx = $project->pid_idx();
my $self = {};
my $pranges = {};
my $granges = {};
$self->{'PROJECT'} = $project;
$self->{'PRANGES'} = $pranges;
$self->{'GRANGES'} = $granges;
$self->{'SMUSHED'} = undef;
bless($self, $class);
my $query_result =
DBQueryWarn("select p.*,n.freq_low as named_low,".
" n.freq_high as named_high ".
" from apt_project_rfranges as p ".
"left join apt_named_rfranges as n on ".
" p.range_id is not null and n.range_id=p.range_id ".
"where pid_idx='$pid_idx' and disabled=0 and ".
# Ignore named ranges that have no definition
" not (p.range_id is not null and ".
" n.range_id is null)");
return undef
if (!$query_result);
while (my $row = $query_result->fetchrow_hashref()) {
my $range = APT_RFRange::Range->Range($row);
$pranges->{$range->idx()} = $range;
}
$query_result =
DBQueryWarn("select p.*,n.freq_low as named_low,".
" n.freq_high as named_high ".
" from apt_global_rfranges as p ".
"left join apt_named_rfranges as n on ".
" p.range_id is not null and n.range_id=p.range_id ".
"where disabled=0 and ".
# Ignore named ranges that have no definition
" not (p.range_id is not null and ".
" n.range_id is null)");
return undef
if (!$query_result);
while (my $row = $query_result->fetchrow_hashref()) {
my $range = APT_RFRange::Range->Range($row);
$granges->{$range->idx()} = $range;
}
return $self;
}
sub Project($) { return $_[0]->{'PROJECT'}; }
sub ProjectHash($) { return $_[0]->{'PRANGES'}; }
sub ProjectList($) { return values(%{ $_[0]->{'PRANGES'} }); }
sub GlobalHash($) { return $_[0]->{'GRANGES'}; }
sub GlobalList($) { return values(%{ $_[0]->{'GRANGES'} }); }
sub Smushed($) { return $_[0]->{'SMUSHED'}; }
# Break circular dependencies
sub DESTROY {
my $self = shift;
$self->{'PROJECT'} = undef;
$self->{'PRANGES'} = undef;
$self->{'GRANGES'} = undef;
$self->{'SMUSHED'} = undef;
}
sub min($$) { return $_[0] < $_[1] ? $_[0] : $_[1]; }
sub max($$) { return $_[0] > $_[1] ? $_[0] : $_[1]; }
#
# Have to consider that a requested range, might fit within two or more
# of the allowed ranges if they were smushed together. So to make this
# easier, smush them all together before trying to check. This does not
# have to be efficient, these lists are short.
#
sub Smush($)
{
my ($self) = @_;
my @all = ($self->ProjectList(), $self->GlobalList());
my @smushed = ();
# Sort all the ranges by the low freq.
@all = sort { $a->freq_low() <=> $b->freq_low() } @all;
# Start with a copy of the first range.
my $range = shift(@all);
$range = $range->Copy();
push(@smushed, $range);
# Try to smush all the rest together.
while (@all) {
my $next = shift(@all);
#print "foo\n";
#print $range->freq_low() . "," . $next->freq_high() . "\n";
#print $next->freq_low() . "," . $range->freq_high() . "\n";
if ($range->freq_low() <= $next->freq_high() &&
$next->freq_low() <= $range->freq_high()) {
my $low = min($range->freq_low(), $next->freq_low());
my $high = max($range->freq_high(), $next->freq_high());
#print "l,w: $low,$high\n";
$range->hash()->{'freq_low'} = $low;
$range->hash()->{'freq_high'} = $high;
}
else {
# Start again with a copy.
$range = $next->Copy();
push(@smushed, $range);
}
}
foreach my $range (@smushed) {
# $range->Dump();
}
$self->{'SMUSHED'} = \@smushed;
}
#
# Can a range be used by the project.
#
sub Allowed($$$)
{
my ($self, $freq_low, $freq_high) = @_;
if (!defined($self->Smushed())) {
$self->Smush();
if (!defined($self->Smushed())) {
print STDERR "Could not smush!\n";
return 0;
}
}
foreach my $range (@{$self->Smushed()}) {
if ($range->Within($freq_low, $freq_high)) {
return 1;
}
}
return 0;
}
# Print out the ranges in nice format
sub Dump($)
{
my ($self) = @_;
$self->DumpList($self->GlobalHash());
$self->DumpList($self->ProjectHash());
}
sub DumpGlobal($)
{
my ($self) = @_;
$self->DumpList($self->GlobalHash());
}
sub DumpProject($)
{
my ($self) = @_;
$self->DumpList($self->ProjectHash());
}
sub DumpList($$)
{
my ($class, $listref) = @_;
my @sorted = sort { $a <=> $b } keys(%{$listref});
foreach my $idx (@sorted) {
$listref->{$idx}->Dump();
}
}
# _Always_ make sure that this 1 is at the end of the file...
1;