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