RT# 30783 Improve speed of ip address auto-assignment

[freeside.git] / FS / FS / addr_block.pm

diff --git a/FS/FS/addr_block.pm b/FS/FS/addr_block.pm
index c5ddca7..eb84daf 100755 (executable)
--- a/FS/FS/addr_block.pm
+++ b/FS/FS/addr_block.pm
@@ -1,14 +1,14 @@
 package FS::addr_block;
 package FS::addr_block;

+use base qw(FS::Record);

 
 use strict;
 
 use strict;

-use vars qw( @ISA );
-use FS::Record qw( qsearchs qsearch dbh );
-use FS::router;
-use FS::svc_broadband;
-use FS::Conf;
+use Carp qw( carp );
+use List::Util qw( first );

 use NetAddr::IP;
 use NetAddr::IP;

-
-@ISA = qw( FS::Record );
+use FS::Conf;
+use FS::Record qw( qsearch dbh ); #qsearchs
+use FS::IP_Mixin;
+use FS::addr_range;

 
 =head1 NAME
 
 
 =head1 NAME
 


@@ -47,6 +47,10 @@ block is assigned.
 
 =item ip_netmask - the netmask of the block, expressed as an integer.
 
 
 =item ip_netmask - the netmask of the block, expressed as an integer.
 

+=item manual_flag - prohibit automatic ip assignment from this block when true. 
+
+=item agentnum - optional agent number (see L<FS::agent>)
+

 =back
 
 =head1 METHODS
 =back
 
 =head1 METHODS


@@ -71,19 +75,62 @@ otherwise returns false.
 Deletes this record from the database.  If there is an error, returns the
 error, otherwise returns false.
 
 Deletes this record from the database.  If there is an error, returns the
 error, otherwise returns false.
 

+=cut
+

 sub delete {
   my $self = shift;
 sub delete {
   my $self = shift;

-  return 'Block must be deallocated before deletion'
-    if $self->router;
-
-  $self->SUPER::delete;
+  return 'Block must be deallocated and have no services before deletion'
+    if $self->router || $self->svc_broadband;
+
+    local $SIG{HUP} = 'IGNORE';
+    local $SIG{INT} = 'IGNORE';
+    local $SIG{QUIT} = 'IGNORE';
+    local $SIG{TERM} = 'IGNORE';
+    local $SIG{TSTP} = 'IGNORE';
+    local $SIG{PIPE} = 'IGNORE';
+
+    my $oldAutoCommit = $FS::UID::AutoCommit;
+    local $FS::UID::AutoCommit = 0;
+    my $dbh = dbh;
+    
+    my $error = $self->SUPER::delete;
+    if ( $error ) {
+       $dbh->rollback if $oldAutoCommit;
+       return $error;
+    }
+  
+    $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+    '';

 }
 
 }
 

+

 =item replace OLD_RECORD
 
 Replaces OLD_RECORD with this one in the database.  If there is an error,
 returns the error, otherwise returns false.
 
 =item replace OLD_RECORD
 
 Replaces OLD_RECORD with this one in the database.  If there is an error,
 returns the error, otherwise returns false.
 

+At present it's not possible to reallocate a block to a different router 
+except by deallocating it first, which requires that none of its addresses 
+be assigned.  This is probably as it should be.
+
+sub replace_check {
+  my ( $new, $old ) = ( shift, shift );
+
+  unless($new->routernum == $old->routernum) {
+    my @svc = $self->svc_broadband;
+    if (@svc) {
+      return 'Block has assigned addresses: '.
+             join ', ', map {$_->ip_addr} @svc;
+    }
+
+    return 'Block is already allocated'
+      if($new->routernum && $old->routernum);
+
+  }
+
+  '';
+}
+

 =item check
 
 Checks all fields to make sure this is a valid record.  If there is an error,
 =item check
 
 Checks all fields to make sure this is a valid record.  If there is an error,


@@ -99,6 +146,8 @@ sub check {
     $self->ut_number('routernum')
     || $self->ut_ip('ip_gateway')
     || $self->ut_number('ip_netmask')
     $self->ut_number('routernum')
     || $self->ut_ip('ip_gateway')
     || $self->ut_number('ip_netmask')

+    || $self->ut_enum('manual_flag', [ '', 'Y' ])
+    || $self->ut_agentnum_acl('agentnum', 'Broadband global configuration')

   ;
   return $error if $error;
 
   ;
   return $error if $error;
 


@@ -122,7 +171,7 @@ sub check {
     }
   }
 
     }
   }
 

-  '';
+  $self->SUPER::check;

 }
 
 
 }
 
 


@@ -131,67 +180,100 @@ sub check {
 Returns the FS::router object corresponding to this object.  If the 
 block is unassigned, returns undef.
 
 Returns the FS::router object corresponding to this object.  If the 
 block is unassigned, returns undef.
 

+=item svc_broadband
+
+Returns a list of FS::svc_broadband objects associated
+with this object.
+
+=item NetAddr
+
+Returns a NetAddr::IP object for this block's address and netmask.
+

 =cut
 
 =cut
 

-sub router {
+sub NetAddr {

   my $self = shift;
   my $self = shift;

-  return qsearchs('router', { routernum => $self->routernum });
+  new NetAddr::IP ($self->ip_gateway, $self->ip_netmask);

 }
 
 }
 

-=item svc_broadband
+=item cidr

 
 

-Returns a list of FS::svc_broadband objects associated
-with this object.
+Returns a CIDR string for this block's address and netmask, i.e. 10.4.20.0/24

 
 =cut
 
 
 =cut
 

-sub svc_broadband {
+sub cidr {

   my $self = shift;
   my $self = shift;

-  return qsearch('svc_broadband', { blocknum => $self->blocknum });
+  $self->NetAddr->cidr;

 }
 
 }
 

-=item NetAddr
+=item free_addrs

 
 

-Returns a NetAddr::IP object for this block's address and netmask.
+Returns a sorted list of free addresses in the block.

 
 =cut
 
 
 =cut
 

-sub NetAddr {
+sub free_addrs {

   my $self = shift;
 
   my $self = shift;
 

-  return new NetAddr::IP ($self->ip_gateway, $self->ip_netmask);
+  my %used_addr_map =
+    map {$_ => 1}
+    FS::IP_Mixin->used_addresses_in_block($self),
+    FS::Conf->new()->config('exclude_ip_addr');
+
+  grep { !exists $used_addr_map{$_} } map { $_->addr } $self->NetAddr->hostenum;

 }
 
 =item next_free_addr
 
 Returns a NetAddr::IP object corresponding to the first unassigned address 
 in the block (other than the network, broadcast, or gateway address).  If 
 }
 
 =item next_free_addr
 
 Returns a NetAddr::IP object corresponding to the first unassigned address 
 in the block (other than the network, broadcast, or gateway address).  If 

-there are no free addresses, returns false.
+there are no free addresses, returns nothing.  There are never free addresses
+when manual_flag is true.
+
+There is no longer a method to return all free addresses in a block.

 
 =cut
 
 sub next_free_addr {
   my $self = shift;
 
 =cut
 
 sub next_free_addr {
   my $self = shift;

+  my $selfaddr = $self->NetAddr;
+
+  return () if $self->manual_flag;

 
   my $conf = new FS::Conf;
   my @excludeaddr = $conf->config('exclude_ip_addr');
 
   my $conf = new FS::Conf;
   my @excludeaddr = $conf->config('exclude_ip_addr');

-  
-  my @used = (
-    map { $_->NetAddr->addr } 
-      ($self, 
-       qsearch('svc_broadband', { blocknum => $self->blocknum }) ),
-     @excludeaddr );
-
-  my @free = $self->NetAddr->hostenum;
-  while (my $ip = shift @free) {
-    if (not grep {$_ eq $ip->addr;} @used) { return $ip; };
-  }

 
 

-  '';
+  my %used = map { $_ => 1 }
+  (
+    @excludeaddr,
+    $selfaddr->addr,
+    $selfaddr->network->addr,
+    $selfaddr->broadcast->addr,
+    FS::IP_Mixin->used_addresses_in_block($self)
+  );
+
+  # just do a linear search of the block
+  my $freeaddr = $selfaddr->network + 1;
+  while ( $freeaddr < $selfaddr->broadcast ) {
+    # also make sure it's not blocked from assignment by an address range
+    if ( !$used{$freeaddr->addr } ) {
+      my ($range) = grep { !$_->allow_use }
+                  FS::addr_range->any_contains($freeaddr->addr);
+      if ( !$range ) {
+        # then we've found a free address
+        return $freeaddr;
+      }
+      # otherwise, skip to the end of the range
+      $freeaddr = NetAddr::IP->new($range->end, $self->ip_netmask);
+    }
+    $freeaddr++;
+  }
+  return;

 
 }
 
 
 }
 

-=item allocate
+=item allocate -- deprecated

 
 Allocates this address block to a router.  Takes an FS::router object 
 as an argument.
 
 Allocates this address block to a router.  Takes an FS::router object 
 as an argument.


@@ -204,25 +286,18 @@ be assigned.  This is probably as it should be.
 
 sub allocate {
   my ($self, $router) = @_;
 
 sub allocate {
   my ($self, $router) = @_;

-
-  return 'Block is already allocated'
-    if($self->router);
+  carp "deallocate deprecated -- use replace";

 
   return 'Block must be allocated to a router'
     unless(ref $router eq 'FS::router');
 
 
   return 'Block must be allocated to a router'
     unless(ref $router eq 'FS::router');
 

-  my @svc = $self->svc_broadband;
-  if (@svc) {
-    return 'Block has assigned addresses: '. join ', ', map {$_->ip_addr} @svc;
-  }
-

   my $new = new FS::addr_block {$self->hash};
   $new->routernum($router->routernum);
   return $new->replace($self);
 
 }
 
   my $new = new FS::addr_block {$self->hash};
   $new->routernum($router->routernum);
   return $new->replace($self);
 
 }
 

-=item deallocate
+=item deallocate -- deprecated

 
 Deallocates the block (i.e. sets the routernum to 0).  If any addresses in the 
 block are assigned to services, it fails.
 
 Deallocates the block (i.e. sets the routernum to 0).  If any addresses in the 
 block are assigned to services, it fails.


@@ -230,13 +305,9 @@ block are assigned to services, it fails.
 =cut
 
 sub deallocate {
 =cut
 
 sub deallocate {

+  carp "deallocate deprecated -- use replace";

   my $self = shift;
 
   my $self = shift;
 

-  my @svc = $self->svc_broadband;
-  if (@svc) {
-    return 'Block has assigned addresses: '. join ', ', map {$_->ip_addr} @svc;
-  }
-

   my $new = new FS::addr_block {$self->hash};
   $new->routernum(0);
   return $new->replace($self);
   my $new = new FS::addr_block {$self->hash};
   $new->routernum(0);
   return $new->replace($self);


@@ -317,6 +388,41 @@ sub split_block {
 
 To be implemented.
 
 
 To be implemented.
 

+=item agent
+
+Returns the agent (see L<FS::agent>) for this address block, if one exists.
+
+=item label
+
+Returns text including the router name, gateway ip, and netmask for this
+block.
+
+=cut
+
+sub label {
+  my $self = shift;
+  my $router = $self->router;
+  ($router ? $router->routername : '(unallocated)'). ':'. $self->NetAddr;
+}
+
+=item router
+
+Returns the router assigned to this block.
+
+=cut
+
+# necessary, because this can't be foreign keyed
+
+sub router {
+  my $self = shift;
+  my $routernum = $self->routernum;
+  if ( $routernum ) {
+    return FS::router->by_key($routernum);
+  } else {
+    return;
+  }
+}
+

 =back
 
 =head1 BUGS
 =back
 
 =head1 BUGS


@@ -327,4 +433,3 @@ now because that's the smallest block that makes any sense at all.
 =cut
 
 1;
 =cut
 
 1;

-