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   $self->SUPER::check;
 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
 186   my @free = $self->NetAddr->hostenum;
 187   while (my $ip = shift @free) {
 188     if (not grep {$_ eq $ip->addr;} @used) { return $ip; };
 189   }
 190
 191   '';
 192
 193 }
 194
 195 =item allocate
 196
 197 Allocates this address block to a router.  Takes an FS::router object
 198 as an argument.
 199
 200 At present it's not possible to reallocate a block to a different router
 201 except by deallocating it first, which requires that none of its addresses
 202 be assigned.  This is probably as it should be.
 203
 204 =cut
 205
 206 sub allocate {
 207   my ($self, $router) = @_;
 208
 209   return 'Block is already allocated'
 210     if($self->router);
 211
 212   return 'Block must be allocated to a router'
 213     unless(ref $router eq 'FS::router');
 214
 215   my @svc = $self->svc_broadband;
 216   if (@svc) {
 217     return 'Block has assigned addresses: '. join ', ', map {$_->ip_addr} @svc;
 218   }
 219
 220   my $new = new FS::addr_block {$self->hash};
 221   $new->routernum($router->routernum);
 222   return $new->replace($self);
 223
 224 }
 225
 226 =item deallocate
 227
 228 Deallocates the block (i.e. sets the routernum to 0).  If any addresses in the
 229 block are assigned to services, it fails.
 230
 231 =cut
 232
 233 sub deallocate {
 234   my $self = shift;
 235
 236   my @svc = $self->svc_broadband;
 237   if (@svc) {
 238     return 'Block has assigned addresses: '. join ', ', map {$_->ip_addr} @svc;
 239   }
 240
 241   my $new = new FS::addr_block {$self->hash};
 242   $new->routernum(0);
 243   return $new->replace($self);
 244 }
 245
 246 =item split_block
 247
 248 Splits this address block into two equal blocks, occupying the same space as
 249 the original block.  The first of the two will also have the same blocknum.
 250 The gateway address of each block will be set to the first usable address, i.e.
 251 (network address)+1.  Since this method is designed for use on unallocated
 252 blocks, this is probably the correct behavior.
 253
 254 (At present, splitting allocated blocks is disallowed.  Anyone who wants to
 255 implement this is reminded that each split costs three addresses, and any
 256 customers who were using these addresses will have to be moved; depending on
 257 how full the block was before being split, they might have to be moved to a
 258 different block.  Anyone who I<still> wants to implement it is asked to tie it
 259 to a configuration switch so that site admins can disallow it.)
 260
 261 =cut
 262
 263 sub split_block {
 264
 265   # We should consider using Attribute::Handlers/Aspect/Hook::LexWrap/
 266   # something to atomicize functions, so that we can say
 267   #
 268   # sub split_block : atomic {
 269   #
 270   # instead of repeating all this AutoCommit verbage in every
 271   # sub that does more than one database operation.
 272
 273   my $oldAutoCommit = $FS::UID::AutoCommit;
 274   local $FS::UID::AutoCommit = 0;
 275   my $dbh = dbh;
 276
 277   my $self = shift;
 278   my $error;
 279
 280   if ($self->router) {
 281     return 'Block is already allocated';
 282   }
 283
 284   #TODO: Smallest allowed block should be a config option.
 285   if ($self->NetAddr->masklen() ge 30) {
 286     return 'Cannot split blocks with a mask length >= 30';
 287   }
 288
 289   my (@new, @ip);
 290   $ip[0] = $self->NetAddr;
 291   @ip = map {$_->first()} $ip[0]->split($self->ip_netmask + 1);
 292
 293   foreach (0,1) {
 294     $new[$_] = new FS::addr_block {$self->hash};
 295     $new[$_]->ip_gateway($ip[$_]->addr);
 296     $new[$_]->ip_netmask($ip[$_]->masklen);
 297   }
 298
 299   $new[1]->blocknum('');
 300
 301   $error = $new[0]->replace($self);
 302   if ($error) {
 303     $dbh->rollback;
 304     return $error;
 305   }
 306
 307   $error = $new[1]->insert;
 308   if ($error) {
 309     $dbh->rollback;
 310     return $error;
 311   }
 312
 313   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 314   return '';
 315 }
 316
 317 =item merge
 318
 319 To be implemented.
 320
 321 =back
 322
 323 =head1 BUGS
 324
 325 Minimum block size should be a config option.  It's hardcoded at /30 right
 326 now because that's the smallest block that makes any sense at all.
 327
 328 =cut
 329
 330 1;
 331