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