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   # Will strip extraneous leading zeros from ip adddresses
  98   # e.g. 10.0.022.220 corrected to 10.0.22.220
  99   $self->ut_ip46n('ip_addr');
 100
 101   if ( $self->ip_addr
 102        and !$self->router
 103        and $self->conf->exists('auto_router') ) {
 104     # assign a router that matches this IP address
 105     return $self->check_ip_addr || $self->assign_router;
 106   }
 107   if ( my $router = $self->router ) {
 108     if ( $router->manual_addr ) {
 109       # Router is set, and it's set to manual addressing, so
 110       # clear blocknum and don't tamper with ip_addr.
 111       $self->addr_block(undef);
 112     } else {
 113       my $block = $self->addr_block;
 114       if ( !$block or !$block->manual_flag ) {
 115         my $error = $self->assign_ip_addr;
 116         return $error if $error;
 117       }
 118       # otherwise block is set to manual addressing
 119     }
 120   }
 121   return $self->check_ip_addr;
 122 }
 123
 124 =item assign_ip_addr
 125
 126 Set the IP address to a free address in the selected block (C<addr_block>)
 127 or router (C<router>) for this object.  A block or router MUST be selected.
 128 If the object already has an IP address and it is in that block/router's
 129 address space, it won't be changed.
 130
 131 =cut
 132
 133 sub assign_ip_addr {
 134   my $self = shift;
 135   my %opt = @_;
 136
 137   #otherwise we'll get the same assignment for concurrent identical calls
 138   # this will serialize them
 139   $_->lock_table foreach @subclasses;
 140
 141   my @blocks;
 142   my $na = $self->NetAddr;
 143
 144   if ( $self->addr_block ) {
 145     # choose an address in a specific block.
 146     @blocks = ( $self->addr_block );
 147   } elsif ( $self->router ) {
 148     # choose an address from any block on a specific router.
 149     @blocks = $self->router->auto_addr_block;
 150   } else {
 151     # what else should we do, search ALL blocks? that's crazy.
 152     die "no block or router specified for assign_ip_addr\n";
 153   }
 154
 155   my $new_addr;
 156   my $new_block;
 157   foreach my $block (@blocks) {
 158     if ( $self->ip_addr and $block->NetAddr->contains($na) ) {
 159       return '';
 160     }
 161     # don't exit early on assigning a free address--check the rest of
 162     # the blocks to see if the current address is in one of them.
 163     if (!$new_addr) {
 164       $new_addr = $block->next_free_addr;
 165       $new_block = $block;
 166     }
 167   }
 168
 169   return 'No IP address available on this router' unless $new_addr;
 170
 171   $self->ip_addr($new_addr->addr);
 172   $self->addr_block($new_block);
 173   '';
 174 }
 175
 176 =item assign_router
 177
 178 If the IP address is set, set the router and block accordingly.  If there
 179 is no block containing that address, returns an error.
 180
 181 =cut
 182
 183 sub assign_router {
 184   my $self = shift;
 185   return '' unless $self->ip_addr;
 186   my $na = $self->NetAddr;
 187   foreach my $router (qsearch('router', {})) {
 188     foreach my $block ($router->addr_block) {
 189       if ( $block->NetAddr->contains($na) ) {
 190         $self->addr_block($block);
 191         $self->router($router);
 192         return '';
 193       }
 194     }
 195   }
 196   return $self->ip_addr . ' is not in an allowed block.';
 197 }
 198
 199 =item check_ip_addr
 200
 201 Validate the IP address.  Returns an empty string if it's correct and
 202 available (or null), otherwise an error message.
 203
 204 =cut
 205
 206 sub check_ip_addr {
 207   my $self = shift;
 208   my $addr = $self->ip_addr;
 209   return '' if $addr eq '';
 210   my $na = $self->NetAddr
 211     or return "Can't parse address '$addr'";
 212   # if there's a chosen address block, check that the address is in it
 213   if ( my $block = $self->addr_block ) {
 214     if ( !$block->NetAddr->contains($na) ) {
 215       return "Address $addr not in block ".$block->cidr;
 216     }
 217   }
 218   # if the address is in any designated ranges, check that they don't
 219   # disallow use
 220   foreach my $range (FS::addr_range->any_contains($addr)) {
 221     if ( !$range->allow_use ) {
 222       return "Address $addr is in ".$range->desc." range ".$range->as_string;
 223     }
 224   }
 225   # check that nobody else is sitting on the address
 226   # (this returns '' if the address is in use by $self)
 227   if ( my $dup = $self->is_used($self->ip_addr) ) {
 228     return "Address $addr in use by $dup";
 229   }
 230   '';
 231 }
 232
 233 # sensible defaults
 234 sub addr_block {
 235   my $self = shift;
 236   if ( @_ ) {
 237     my $new = shift;
 238     if ( defined $new ) {
 239       die "addr_block() must take an address block"
 240         unless $new->isa('FS::addr_block');
 241       $self->blocknum($new->blocknum);
 242       return $new;
 243     } else {
 244       #$new is undef
 245       $self->blocknum('');
 246       return undef;
 247     }
 248   }
 249   # could cache this...
 250   FS::addr_block->by_key($self->blocknum);
 251 }
 252
 253 sub router {
 254   my $self = shift;
 255   if ( @_ ) {
 256     my $new = shift;
 257     if ( defined $new ) {
 258       die "router() must take a router"
 259         unless $new->isa('FS::router');
 260       $self->routernum($new->routernum);
 261       return $new;
 262     } else {
 263       #$new is undef
 264       $self->routernum('');
 265       return undef;
 266     }
 267   }
 268   FS::router->by_key($self->routernum);
 269 }
 270
 271 =item used_addresses [ FS::addr_block ]
 272
 273 Returns a list of all addresses in use within the given L<FS::addr_block>.
 274
 275 If called as an instance method, excludes that instance from the search.
 276
 277 =cut
 278
 279 sub used_addresses {
 280   my ($self, $block) = @_;
 281
 282   (
 283     $block->ip_gateway ? $block->ip_gateway : (),
 284     $block->NetAddr->broadcast->addr,
 285     map { $_->_used_addresses($block, $self ) } @subclasses
 286   );
 287 }
 288
 289 sub _used_addresses {
 290   my $class = shift;
 291   die "$class->_used_addresses not implemented";
 292 }
 293
 294 =item is_used ADDRESS
 295
 296 Returns a string describing what object is using ADDRESS, or
 297 an empty string if it's not in use.
 298
 299 =cut
 300
 301 sub is_used {
 302   my $self = shift;
 303   my $addr = shift;
 304   for (@subclasses) {
 305     my $used = $_->_is_used($addr, $self);
 306     return $used if $used;
 307   }
 308   '';
 309 }
 310
 311 sub _is_used {
 312   my $class = shift;
 313   die "$class->_is_used not implemented";
 314 }
 315
 316 =back
 317
 318 =head1 BUGS
 319
 320 We can't reliably check for duplicate addresses across tables.  A
 321 more robust implementation would be to put all assigned IP addresses
 322 in a single table with a unique index.  We do a best-effort check
 323 anyway, but it has a race condition.
 324
 325 =cut
 326
 327 1;