FS/FS/IP_Mixin.pm

   1 package FS::IP_Mixin;
   2
   3 use strict;
   4 use NetAddr::IP;
   5 use FS::addr_block;
   6 use FS::router;
   7 use FS::addr_range;
   8 use FS::Record qw(qsearch);
   9 use FS::Conf;
  10 # careful about importing anything here--it will end up in a LOT of
  11 # namespaces
  12
  13 use vars qw(@subclasses $DEBUG $conf);
  14
  15 $DEBUG = 0;
  16
  17 # any subclass that can have IP addresses needs to be added here
  18 @subclasses = (qw(FS::svc_broadband FS::svc_acct));
  19
  20 sub conf {
  21   $conf ||= FS::Conf->new;
  22 }
  23
  24 =head1 NAME
  25
  26 FS::IP_Mixin - Mixin class for objects that have IP addresses assigned.
  27
  28 =head1 INTERFACE
  29
  30 The inheritor may provide the following methods:
  31
  32 =over 4
  33
  34 =item ip_addr [ ADDRESS ]
  35
  36 Get/set the IP address, as a string.  If the inheritor is also an
  37 L<FS::Record> subclass and has an 'ip_addr' field, that field will be
  38 used.  Otherwise an C<ip_addr> method must be defined.
  39
  40 =item addr_block [ BLOCK ]
  41
  42 Get/set the address block, as an L<FS::addr_block> object.  By default,
  43 the 'blocknum' field will be used.
  44
  45 =item router [ ROUTER ]
  46
  47 Get/set the router, as an L<FS::router> object.  By default, the
  48 'routernum' field will be used.  This is strictly optional; if present
  49 the IP address can be assigned from all those available on a router,
  50 rather than in a specific block.
  51
  52 =item _used_addresses [ BLOCK ]
  53
  54 Return a list of all addresses in use (within BLOCK, if it's specified).
  55 The inheritor should cache this if possible.
  56
  57 =item _is_used ADDRESS
  58
  59 Test a specific address for availability.  Should return an empty string
  60 if it's free, or else a description of who or what is using it.
  61
  62 =back
  63
  64 =head1 METHODS
  65
  66 =over 4
  67
  68 =item ip_check
  69
  70 The method that should be called from check() in the subclass.  This does
  71 the following:
  72
  73 - In an C<auto_router> situation, sets the router and block to match the
  74   object's IP address.
  75 - Otherwise, if the router and IP address are both set, validate the
  76   choice of router and set the block correctly.
  77 - Otherwise, if the router is set, assign an address (in the selected
  78   block if there is one).
  79 - Check the IP address for availability.
  80
  81 Returns an error if this fails for some reason (an address can't be
  82 assigned from the requested router/block, or the requested address is
  83 unavailable, or doesn't seem to be an IP address).
  84
  85 If router and IP address are both empty, this will do nothing.  The
  86 object's check() method should decide whether to allow a null IP address.
  87
  88 =cut
  89
  90 sub ip_check {
  91   my $self = shift;
  92
  93   if ( $self->ip_addr eq '0.0.0.0' ) { #ipv6?
  94     $self->ip_addr('');
  95   }
  96
  97   # strip user-entered leading 0's from IPv4 addresses
  98   # Parsers like NetAddr::IP interpret them as octal instead of decimal
  99   $self->ip_addr(
 100     join( '.', (
 101         map{ int($_) }
 102         split( /\./, $self->ip_addr )
 103     ))
 104   ) if $self->ip_addr =~ /\./ && $self->ip_addr =~ /[\.^]0/;
 105
 106   if ( $self->ip_addr
 107        and !$self->router
 108        and $self->conf->exists('auto_router') ) {
 109     # assign a router that matches this IP address
 110     return $self->check_ip_addr || $self->assign_router;
 111   }
 112   if ( my $router = $self->router ) {
 113     if ( $router->manual_addr ) {
 114       # Router is set, and it's set to manual addressing, so
 115       # clear blocknum and don't tamper with ip_addr.
 116       $self->addr_block(undef);
 117     } else {
 118       my $block = $self->addr_block;
 119       if ( !$block or !$block->manual_flag ) {
 120         my $error = $self->assign_ip_addr;
 121         return $error if $error;
 122       }
 123       # otherwise block is set to manual addressing
 124     }
 125   }
 126   return $self->check_ip_addr;
 127 }
 128
 129 =item assign_ip_addr
 130
 131 Set the IP address to a free address in the selected block (C<addr_block>)
 132 or router (C<router>) for this object.  A block or router MUST be selected.
 133 If the object already has an IP address and it is in that block/router's
 134 address space, it won't be changed.
 135
 136 =cut
 137
 138 sub assign_ip_addr {
 139   my $self = shift;
 140   my %opt = @_;
 141
 142   #otherwise we'll get the same assignment for concurrent identical calls
 143   # this will serialize them
 144   $_->lock_table foreach @subclasses;
 145
 146   my @blocks;
 147   my $na = $self->NetAddr;
 148
 149   if ( $self->addr_block ) {
 150     # choose an address in a specific block.
 151     @blocks = ( $self->addr_block );
 152   } elsif ( $self->router ) {
 153     # choose an address from any block on a specific router.
 154     @blocks = $self->router->auto_addr_block;
 155   } else {
 156     # what else should we do, search ALL blocks? that's crazy.
 157     die "no block or router specified for assign_ip_addr\n";
 158   }
 159
 160   my $new_addr;
 161   my $new_block;
 162   foreach my $block (@blocks) {
 163     if ( $self->ip_addr and $block->NetAddr->contains($na) ) {
 164       return '';
 165     }
 166     # don't exit early on assigning a free address--check the rest of
 167     # the blocks to see if the current address is in one of them.
 168     if (!$new_addr) {
 169       $new_addr = $block->next_free_addr;
 170       $new_block = $block;
 171     }
 172   }
 173
 174   return 'No IP address available on this router' unless $new_addr;
 175
 176   $self->ip_addr($new_addr->addr);
 177   $self->addr_block($new_block);
 178   '';
 179 }
 180
 181 =item assign_router
 182
 183 If the IP address is set, set the router and block accordingly.  If there
 184 is no block containing that address, returns an error.
 185
 186 =cut
 187
 188 sub assign_router {
 189   my $self = shift;
 190   return '' unless $self->ip_addr;
 191   my $na = $self->NetAddr;
 192   foreach my $router (qsearch('router', {})) {
 193     foreach my $block ($router->addr_block) {
 194       if ( $block->NetAddr->contains($na) ) {
 195         $self->addr_block($block);
 196         $self->router($router);
 197         return '';
 198       }
 199     }
 200   }
 201   return $self->ip_addr . ' is not in an allowed block.';
 202 }
 203
 204 =item check_ip_addr
 205
 206 Validate the IP address.  Returns an empty string if it's correct and
 207 available (or null), otherwise an error message.
 208
 209 =cut
 210
 211 sub check_ip_addr {
 212   my $self = shift;
 213   my $addr = $self->ip_addr;
 214   return '' if $addr eq '';
 215   my $na = $self->NetAddr
 216     or return "Can't parse address '$addr'";
 217   # if there's a chosen address block, check that the address is in it
 218   if ( my $block = $self->addr_block ) {
 219     if ( !$block->NetAddr->contains($na) ) {
 220       return "Address $addr not in block ".$block->cidr;
 221     }
 222   }
 223   # if the address is in any designated ranges, check that they don't
 224   # disallow use
 225   foreach my $range (FS::addr_range->any_contains($addr)) {
 226     if ( !$range->allow_use ) {
 227       return "Address $addr is in ".$range->desc." range ".$range->as_string;
 228     }
 229   }
 230   # check that nobody else is sitting on the address
 231   # (this returns '' if the address is in use by $self)
 232   if ( my $dup = $self->is_used($self->ip_addr) ) {
 233     return "Address $addr in use by $dup";
 234   }
 235   '';
 236 }
 237
 238 # sensible defaults
 239 sub addr_block {
 240   my $self = shift;
 241   if ( @_ ) {
 242     my $new = shift;
 243     if ( defined $new ) {
 244       die "addr_block() must take an address block"
 245         unless $new->isa('FS::addr_block');
 246       $self->blocknum($new->blocknum);
 247       return $new;
 248     } else {
 249       #$new is undef
 250       $self->blocknum('');
 251       return undef;
 252     }
 253   }
 254   # could cache this...
 255   FS::addr_block->by_key($self->blocknum);
 256 }
 257
 258 sub router {
 259   my $self = shift;
 260   if ( @_ ) {
 261     my $new = shift;
 262     if ( defined $new ) {
 263       die "router() must take a router"
 264         unless $new->isa('FS::router');
 265       $self->routernum($new->routernum);
 266       return $new;
 267     } else {
 268       #$new is undef
 269       $self->routernum('');
 270       return undef;
 271     }
 272   }
 273   FS::router->by_key($self->routernum);
 274 }
 275
 276 =item used_addresses [ FS::addr_block ]
 277
 278 Returns a list of all addresses in use within the given L<FS::addr_block>.
 279
 280 If called as an instance method, excludes that instance from the search.
 281
 282 =cut
 283
 284 sub used_addresses {
 285   my ($self, $block) = @_;
 286
 287   (
 288     $block->ip_gateway ? $block->ip_gateway : (),
 289     $block->NetAddr->broadcast->addr,
 290     map { $_->_used_addresses($block, $self ) } @subclasses
 291   );
 292 }
 293
 294 sub _used_addresses {
 295   my $class = shift;
 296   die "$class->_used_addresses not implemented";
 297 }
 298
 299 =item is_used ADDRESS
 300
 301 Returns a string describing what object is using ADDRESS, or
 302 an empty string if it's not in use.
 303
 304 =cut
 305
 306 sub is_used {
 307   my $self = shift;
 308   my $addr = shift;
 309   for (@subclasses) {
 310     my $used = $_->_is_used($addr, $self);
 311     return $used if $used;
 312   }
 313   '';
 314 }
 315
 316 sub _is_used {
 317   my $class = shift;
 318   die "$class->_is_used not implemented";
 319 }
 320
 321 =back
 322
 323 =head1 BUGS
 324
 325 We can't reliably check for duplicate addresses across tables.  A
 326 more robust implementation would be to put all assigned IP addresses
 327 in a single table with a unique index.  We do a best-effort check
 328 anyway, but it has a race condition.
 329
 330 =cut
 331
 332 1;