FS/FS/addr_block.pm

   1 package FS::addr_block;
   2 use base qw(FS::Record);
   3
   4 use strict;
   5 use Carp qw( carp );
   6 use List::Util qw( first );
   7 use NetAddr::IP;
   8 use FS::Conf;
   9 use FS::Record qw( qsearch dbh ); #qsearchs
  10 use FS::IP_Mixin;
  11 use FS::addr_range;
  12
  13 =head1 NAME
  14
  15 FS::addr_block - Object methods for addr_block records
  16
  17 =head1 SYNOPSIS
  18
  19   use FS::addr_block;
  20
  21   $record = new FS::addr_block \%hash;
  22   $record = new FS::addr_block { 'column' => 'value' };
  23
  24   $error = $record->insert;
  25
  26   $error = $new_record->replace($old_record);
  27
  28   $error = $record->delete;
  29
  30   $error = $record->check;
  31
  32 =head1 DESCRIPTION
  33
  34 An FS::addr_block record describes an address block assigned for broadband
  35 access.  FS::addr_block inherits from FS::Record.  The following fields are
  36 currently supported:
  37
  38 =over 4
  39
  40 =item blocknum - primary key, used in FS::svc_broadband to associate
  41 services to the block.
  42
  43 =item routernum - the router (see FS::router) to which this
  44 block is assigned.
  45
  46 =item ip_gateway - the gateway address used by customers within this block.
  47
  48 =item ip_netmask - the netmask of the block, expressed as an integer.
  49
  50 =item manual_flag - prohibit automatic ip assignment from this block when true.
  51
  52 =item agentnum - optional agent number (see L<FS::agent>)
  53
  54 =back
  55
  56 =head1 METHODS
  57
  58 =over 4
  59
  60 =item new HASHREF
  61
  62 Create a new record.  To add the record to the database, see "insert".
  63
  64 =cut
  65
  66 sub table { 'addr_block'; }
  67
  68 =item insert
  69
  70 Adds this record to the database.  If there is an error, returns the error,
  71 otherwise returns false.
  72
  73 =item delete
  74
  75 Deletes this record from the database.  If there is an error, returns the
  76 error, otherwise returns false.
  77
  78 =cut
  79
  80 sub delete {
  81   my $self = shift;
  82   return 'Block must be deallocated and have no services before deletion'
  83     if $self->router || $self->svc_broadband;
  84
  85     local $SIG{HUP} = 'IGNORE';
  86     local $SIG{INT} = 'IGNORE';
  87     local $SIG{QUIT} = 'IGNORE';
  88     local $SIG{TERM} = 'IGNORE';
  89     local $SIG{TSTP} = 'IGNORE';
  90     local $SIG{PIPE} = 'IGNORE';
  91
  92     my $oldAutoCommit = $FS::UID::AutoCommit;
  93     local $FS::UID::AutoCommit = 0;
  94     my $dbh = dbh;
  95
  96     my $error = $self->SUPER::delete;
  97     if ( $error ) {
  98        $dbh->rollback if $oldAutoCommit;
  99        return $error;
 100     }
 101
 102     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 103     '';
 104 }
 105
 106
 107 =item replace OLD_RECORD
 108
 109 Replaces OLD_RECORD with this one in the database.  If there is an error,
 110 returns the error, otherwise returns false.
 111
 112 At present it's not possible to reallocate a block to a different router
 113 except by deallocating it first, which requires that none of its addresses
 114 be assigned.  This is probably as it should be.
 115
 116 sub replace_check {
 117   my ( $new, $old ) = ( shift, shift );
 118
 119   unless($new->routernum == $old->routernum) {
 120     my @svc = $self->svc_broadband;
 121     if (@svc) {
 122       return 'Block has assigned addresses: '.
 123              join ', ', map {$_->ip_addr} @svc;
 124     }
 125
 126     return 'Block is already allocated'
 127       if($new->routernum && $old->routernum);
 128
 129   }
 130
 131   '';
 132 }
 133
 134 =item check
 135
 136 Checks all fields to make sure this is a valid record.  If there is an error,
 137 returns the error, otherwise returns false.  Called by the insert and replace
 138 methods.
 139
 140 =cut
 141
 142 sub check {
 143   my $self = shift;
 144
 145   my $error =
 146     $self->ut_number('routernum')
 147     || $self->ut_ip('ip_gateway')
 148     || $self->ut_number('ip_netmask')
 149     || $self->ut_enum('manual_flag', [ '', 'Y' ])
 150     || $self->ut_agentnum_acl('agentnum', 'Broadband global configuration')
 151   ;
 152   return $error if $error;
 153
 154
 155   # A routernum of 0 indicates an unassigned block and is allowed
 156   return "Unknown routernum"
 157     if ($self->routernum and not $self->router);
 158
 159   my $self_addr = $self->NetAddr;
 160   return "Cannot parse address: ". $self->ip_gateway . '/' . $self->ip_netmask
 161     unless $self_addr;
 162
 163   if (not $self->blocknum) {
 164     my @block = grep {
 165       my $block_addr = $_->NetAddr;
 166       if($block_addr->contains($self_addr)
 167       or $self_addr->contains($block_addr)) { $_; };
 168     } qsearch( 'addr_block', {});
 169     foreach(@block) {
 170       return "Block intersects existing block ".$_->ip_gateway."/".$_->ip_netmask;
 171     }
 172   }
 173
 174   $self->SUPER::check;
 175 }
 176
 177
 178 =item router
 179
 180 Returns the FS::router object corresponding to this object.  If the
 181 block is unassigned, returns undef.
 182
 183 =item svc_broadband
 184
 185 Returns a list of FS::svc_broadband objects associated
 186 with this object.
 187
 188 =item NetAddr
 189
 190 Returns a NetAddr::IP object for this block's address and netmask.
 191
 192 =cut
 193
 194 sub NetAddr {
 195   my $self = shift;
 196   new NetAddr::IP ($self->ip_gateway, $self->ip_netmask);
 197 }
 198
 199 =item cidr
 200
 201 Returns a CIDR string for this block's address and netmask, i.e. 10.4.20.0/24
 202
 203 =cut
 204
 205 sub cidr {
 206   my $self = shift;
 207   $self->NetAddr->cidr;
 208 }
 209
 210 =item free_addrs
 211
 212 Returns an aref sorted list of free addresses in the block.
 213
 214 =cut
 215
 216 sub free_addrs {
 217   my $self = shift;
 218
 219   my %used_addr_map =
 220     map {$_ => 1}
 221     FS::IP_Mixin->used_addresses($self),
 222     FS::Conf->new()->config('exclude_ip_addr');
 223
 224   [
 225     grep { !exists $used_addr_map{$_} }
 226     map { $_->addr }
 227     $self->NetAddr->hostenum
 228   ];
 229 }
 230
 231 =item next_free_addr
 232
 233 Returns a NetAddr::IP object corresponding to the first unassigned address
 234 in the block (other than the network, broadcast, or gateway address).  If
 235 there are no free addresses, returns nothing.  There are never free addresses
 236 when manual_flag is true.
 237
 238 There is no longer a method to return all free addresses in a block.
 239
 240 =cut
 241
 242 sub next_free_addr {
 243   my $self = shift;
 244   my $selfaddr = $self->NetAddr;
 245
 246   return () if $self->manual_flag;
 247
 248   my $conf = new FS::Conf;
 249   my @excludeaddr = $conf->config('exclude_ip_addr');
 250
 251   my %used = map { $_ => 1 }
 252   (
 253     @excludeaddr,
 254     $selfaddr->addr,
 255     $selfaddr->network->addr,
 256     $selfaddr->broadcast->addr,
 257     FS::IP_Mixin->used_addresses($self)
 258   );
 259
 260   # just do a linear search of the block
 261   my $freeaddr = $selfaddr->network + 1;
 262   while ( $freeaddr < $selfaddr->broadcast ) {
 263     # also make sure it's not blocked from assignment by an address range
 264     if ( !$used{$freeaddr->addr } ) {
 265       my ($range) = grep { !$_->allow_use }
 266                   FS::addr_range->any_contains($freeaddr->addr);
 267       if ( !$range ) {
 268         # then we've found a free address
 269         return $freeaddr;
 270       }
 271       # otherwise, skip to the end of the range
 272       $freeaddr = NetAddr::IP->new($range->end, $self->ip_netmask);
 273     }
 274     $freeaddr++;
 275   }
 276   return;
 277
 278 }
 279
 280 =item allocate -- deprecated
 281
 282 Allocates this address block to a router.  Takes an FS::router object
 283 as an argument.
 284
 285 At present it's not possible to reallocate a block to a different router
 286 except by deallocating it first, which requires that none of its addresses
 287 be assigned.  This is probably as it should be.
 288
 289 =cut
 290
 291 sub allocate {
 292   my ($self, $router) = @_;
 293   carp "deallocate deprecated -- use replace";
 294
 295   return 'Block must be allocated to a router'
 296     unless(ref $router eq 'FS::router');
 297
 298   my $new = new FS::addr_block {$self->hash};
 299   $new->routernum($router->routernum);
 300   return $new->replace($self);
 301
 302 }
 303
 304 =item deallocate -- deprecated
 305
 306 Deallocates the block (i.e. sets the routernum to 0).  If any addresses in the
 307 block are assigned to services, it fails.
 308
 309 =cut
 310
 311 sub deallocate {
 312   carp "deallocate deprecated -- use replace";
 313   my $self = shift;
 314
 315   my $new = new FS::addr_block {$self->hash};
 316   $new->routernum(0);
 317   return $new->replace($self);
 318 }
 319
 320 =item split_block
 321
 322 Splits this address block into two equal blocks, occupying the same space as
 323 the original block.  The first of the two will also have the same blocknum.
 324 The gateway address of each block will be set to the first usable address, i.e.
 325 (network address)+1.  Since this method is designed for use on unallocated
 326 blocks, this is probably the correct behavior.
 327
 328 (At present, splitting allocated blocks is disallowed.  Anyone who wants to
 329 implement this is reminded that each split costs three addresses, and any
 330 customers who were using these addresses will have to be moved; depending on
 331 how full the block was before being split, they might have to be moved to a
 332 different block.  Anyone who I<still> wants to implement it is asked to tie it
 333 to a configuration switch so that site admins can disallow it.)
 334
 335 =cut
 336
 337 sub split_block {
 338
 339   # We should consider using Attribute::Handlers/Aspect/Hook::LexWrap/
 340   # something to atomicize functions, so that we can say
 341   #
 342   # sub split_block : atomic {
 343   #
 344   # instead of repeating all this AutoCommit verbage in every
 345   # sub that does more than one database operation.
 346
 347   my $oldAutoCommit = $FS::UID::AutoCommit;
 348   local $FS::UID::AutoCommit = 0;
 349   my $dbh = dbh;
 350
 351   my $self = shift;
 352   my $error;
 353
 354   if ($self->router) {
 355     return 'Block is already allocated';
 356   }
 357
 358   #TODO: Smallest allowed block should be a config option.
 359   if ($self->NetAddr->masklen() ge 30) {
 360     return 'Cannot split blocks with a mask length >= 30';
 361   }
 362
 363   my (@new, @ip);
 364   $ip[0] = $self->NetAddr;
 365   @ip = map {$_->first()} $ip[0]->split($self->ip_netmask + 1);
 366
 367   foreach (0,1) {
 368     $new[$_] = new FS::addr_block {$self->hash};
 369     $new[$_]->ip_gateway($ip[$_]->addr);
 370     $new[$_]->ip_netmask($ip[$_]->masklen);
 371   }
 372
 373   $new[1]->blocknum('');
 374
 375   $error = $new[0]->replace($self);
 376   if ($error) {
 377     $dbh->rollback;
 378     return $error;
 379   }
 380
 381   $error = $new[1]->insert;
 382   if ($error) {
 383     $dbh->rollback;
 384     return $error;
 385   }
 386
 387   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 388   return '';
 389 }
 390
 391 =item merge
 392
 393 To be implemented.
 394
 395 =item agent
 396
 397 Returns the agent (see L<FS::agent>) for this address block, if one exists.
 398
 399 =item label
 400
 401 Returns text including the router name, gateway ip, and netmask for this
 402 block.
 403
 404 =cut
 405
 406 sub label {
 407   my $self = shift;
 408   my $router = $self->router;
 409   ($router ? $router->routername : '(unallocated)'). ':'. $self->NetAddr;
 410 }
 411
 412 =item router
 413
 414 Returns the router assigned to this block.
 415
 416 =cut
 417
 418 # necessary, because this can't be foreign keyed
 419
 420 sub router {
 421   my $self = shift;
 422   my $routernum = $self->routernum;
 423   if ( $routernum ) {
 424     return FS::router->by_key($routernum);
 425   } else {
 426     return;
 427   }
 428 }
 429
 430 =back
 431
 432 =head1 BUGS
 433
 434 Minimum block size should be a config option.  It's hardcoded at /30 right
 435 now because that's the smallest block that makes any sense at all.
 436
 437 =cut
 438
 439 1;