FS/FS/addr_block.pm

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