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