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