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