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