FS/FS/svc_IP_Mixin.pm

   1 package FS::svc_IP_Mixin;
   2 use base 'FS::IP_Mixin';
   3
   4 use strict;
   5 use NEXT;
   6 use Carp qw(croak carp);
   7 use FS::Record qw(qsearchs qsearch dbh);
   8 use FS::Conf;
   9 use FS::router;
  10 use FS::part_svc_router;
  11
  12 =item addr_block
  13
  14 Returns the address block assigned to this service.
  15
  16 =item router
  17
  18 Returns the router assigned to this service, if there is one.
  19
  20 =cut
  21
  22 #addr_block and router methods provided by FS::IP_Mixin
  23
  24 =item NetAddr
  25
  26 Returns the address as a L<NetAddr::IP> object.  Use C<$svc->NetAddr->addr>
  27 to put it into canonical string form.
  28
  29 =cut
  30
  31 sub NetAddr {
  32   my $self = shift;
  33   NetAddr::IP->new($self->ip_addr);
  34 }
  35
  36 =item ip_addr
  37
  38 Wrapper for set/get on the IP address field.
  39
  40 =cut
  41
  42 sub ip_addr {
  43   my $self = shift;
  44   my $ip_field = $self->table_info->{'ip_field'}
  45     or return '';
  46   if ( @_ ) {
  47     $self->set($ip_field, @_);
  48   } else {
  49     $self->get($ip_field);
  50   }
  51 }
  52
  53 =item allowed_routers
  54
  55 Returns a list of L<FS::router> objects allowed on this service.
  56
  57 =cut
  58
  59 sub allowed_routers {
  60   my $self = shift;
  61   my $svcpart = $self->svcnum ? $self->cust_svc->svcpart : $self->svcpart;
  62   my @r = map { $_->router }
  63     qsearch('part_svc_router', { svcpart => $svcpart });
  64
  65   if ( $self->cust_main ) {
  66     my $agentnum = $self->cust_main->agentnum;
  67     return grep { !$_->agentnum or $_->agentnum == $agentnum } @r;
  68   } else {
  69     return @r;
  70   }
  71 }
  72
  73 =item svc_ip_check
  74
  75 Wrapper for C<ip_check> which also checks the validity of the router.
  76
  77 =cut
  78
  79 sub svc_ip_check {
  80   my $self = shift;
  81   my $error = $self->ip_check;
  82   return $error if $error;
  83   if ( my $router = $self->router ) {
  84     if ( grep { $_->routernum eq $router->routernum } $self->allowed_routers ) {
  85       return '';
  86     } else {
  87       return 'Router '.$router->routername.' not available for this service';
  88     }
  89   }
  90   '';
  91 }
  92
  93 sub _used_addresses {
  94   my ($class, $block, $exclude_svc) = @_;
  95
  96   croak "_used_addresses() requires an FS::addr_block parameter"
  97     unless ref $block && $block->isa('FS::addr_block');
  98
  99   my $ip_field = $class->table_info->{'ip_field'};
 100   if ( !$ip_field ) {
 101     carp "_used_addresses() skipped, no ip_field";
 102     return;
 103   }
 104
 105   my %qsearch = ( $ip_field => { op => '!=', value => '' });
 106   $qsearch{svcnum} = { op => '!=', value => $exclude_svc->svcnum }
 107     if ref $exclude_svc && $exclude_svc->svcnum;
 108
 109   my $block_na = $block->NetAddr;
 110
 111   my $octets;
 112   if ($block->ip_netmask >= 24) {
 113     $octets = 3;
 114   } elsif ($block->ip_netmask >= 16) {
 115     $octets = 2;
 116   } elsif ($block->ip_netmask >= 8) {
 117     $octets = 1;
 118   }
 119
 120   #  e.g.
 121   # SELECT ip_addr
 122   # FROM svc_broadband
 123   # WHERE ip_addr != ''
 124   #   AND ip_addr != '0e0'
 125   #   AND ip_addr LIKE '10.0.2.%';
 126   #
 127   # For /24, /16 and /8 this approach is fast, even when svc_broadband table
 128   # contains 650,000+ ip records.  For other allocations, this approach is
 129   # not speedy, but usable.
 130   #
 131   # Note: A use case like this would could greatly benefit from a qsearch()
 132   #       parameter to bypass FS::Record objects creation and just
 133   #       return hashrefs from DBI.  200,000 hashrefs are many seconds faster
 134   #       than 200,000 FS::Record objects
 135   my %qsearch = (
 136       table     => $class->table,
 137       select    => $ip_field,
 138       hashref   => \%qsearch,
 139       extra_sql => " AND $ip_field != '0e0' ",
 140   );
 141   if ( $octets ) {
 142     my $block_str = join('.', (split(/\D/, $block_na->first))[0..$octets-1]);
 143     $qsearch{extra_sql} .= " AND $ip_field LIKE ".dbh->quote("${block_str}.%");
 144   }
 145
 146   if ( $block->ip_netmask % 8 ) {
 147     # Some addresses returned by qsearch may be outside the network block,
 148     # so each ip address is tested to be in the block before it's returned.
 149     return
 150       grep { $block_na->contains( NetAddr::IP->new( $_ ) ) }
 151       map { $_->$ip_field }
 152       qsearch( \%qsearch );
 153   }
 154
 155   return
 156     map { $_->$ip_field }
 157     qsearch( \%qsearch );
 158 }
 159
 160 sub _is_used {
 161   my ($class, $addr, $exclude) = @_;
 162   my $ip_field = $class->table_info->{'ip_field'}
 163     or return '';
 164
 165   my $svc = qsearchs($class->table, { $ip_field => $addr })
 166     or return '';
 167
 168   return '' if ( ref $exclude and $exclude->svcnum == $svc->svcnum );
 169
 170   my $cust_svc = $svc->cust_svc;
 171   if ( $cust_svc ) {
 172     my @label = $cust_svc->label;
 173     # "svc_foo 1234 (Service Desc)"
 174     # this should be enough to identify it without leaking customer
 175     # names across agents
 176     "$label[2] $label[3] ($label[0])";
 177   } else {
 178     join(' ', $class->table, $svc->svcnum, '(unlinked service)');
 179   }
 180 }
 181
 182 =item attached_router
 183
 184 Returns the L<FS::router> attached via this service (as opposed to the one
 185 this service is connected through), that is, a router whose "svcnum" field
 186 equals this service's primary key.
 187
 188 If the 'router_routernum' pseudo-field is set, returns that router instead.
 189
 190 =cut
 191
 192 sub attached_router {
 193   my $self = shift;
 194   if ( length($self->get('router_routernum') )) {
 195     return FS::router->by_key($self->router_routernum);
 196   } else {
 197     qsearchs('router', { 'svcnum' => $self->svcnum });
 198   }
 199 }
 200
 201 =item attached_block
 202
 203 Returns the address block (L<FS::addr_block>) assigned to the attached_router,
 204 if there is one.
 205
 206 If the 'router_blocknum' pseudo-field is set, returns that block instead.
 207
 208 =cut
 209
 210 sub attached_block {
 211   my $self = shift;
 212   if ( length($self->get('router_blocknum')) ) {
 213     return FS::addr_block->by_key($self->router_blocknum);
 214   } else {
 215     my $router = $self->attached_router or return '';
 216     my ($block) = $router->addr_block;
 217     return $block || '';
 218   }
 219 }
 220
 221 =item radius_check
 222
 223 Returns nothing.
 224
 225 =cut
 226
 227 sub radius_check { }
 228
 229 =item radius_reply
 230
 231 Returns RADIUS reply items that are relevant across all exports and
 232 necessary for the IP address configuration of the service.  Currently, that
 233 means "Framed-Route" if there's an attached router.
 234
 235 =cut
 236
 237 sub radius_reply {
 238   my $self = shift;
 239
 240   my %reply = ();
 241
 242   if ( my $block = $self->attached_block ) {
 243     # block routed over dynamic IP: "192.168.100.0/29 0.0.0.0 1"
 244     # or
 245     # block routed over fixed IP: "192.168.100.0/29 192.168.100.1 1"
 246     # (the "1" at the end is the route metric)
 247     $reply{'Framed-Route'} = $block->cidr . ' ' .
 248                              ($self->ip_addr || '0.0.0.0') . ' 1';
 249   }
 250
 251   $reply{'Motorola-Canopy-Gateway'} = $self->addr_block->ip_gateway
 252     if FS::Conf->new->exists('radius-canopy') && $self->addr_block;
 253
 254   %reply;
 255 }
 256
 257 sub replace_check {
 258   my ($new, $old) = @_;
 259   # this modifies $old, not $new, which is a slight abuse of replace_check,
 260   # but there's no way to ensure that replace_old gets called...
 261   #
 262   # ensure that router_routernum and router_blocknum are set to their
 263   # current values, so that exports remember the service's attached router
 264   # and block even after they've been replaced
 265   my $router = $old->attached_router;
 266   my $block = $old->attached_block;
 267   $old->set('router_routernum', $router ? $router->routernum : 0);
 268   $old->set('router_blocknum', $block ? $block->blocknum : 0);
 269   my $err_or_ref = $new->NEXT::replace_check($old) || '';
 270   # because NEXT::replace_check($old) ends up trying to AUTOLOAD replace_check
 271   # which is dumb, but easily worked around
 272   ref($err_or_ref) ? '' : $err_or_ref;
 273 }
 274
 275 =item addr_status
 276
 277 Returns the ping status record for this service's address, if there
 278 is one.
 279
 280 =cut
 281
 282 sub addr_status {
 283   my $self = shift;
 284   my $addr = $self->ip_addr or return;
 285   qsearchs('addr_status', { 'ip_addr'  => $addr });
 286 }
 287
 288 =item addr_status_color
 289
 290 Returns the CSS color for the ping status of this service.
 291
 292 =cut
 293
 294 # subject to change; should also show high/low latency (yellow?) and
 295 # staleness of data (probably means the daemon is not running) and packet
 296 # loss (once we measure that)
 297
 298 sub addr_status_color {
 299   my $self = shift;
 300   if ( my $addr_status = $self->addr_status ) {
 301     if ( $addr_status->up ) {
 302       return 'green';
 303     } else {
 304       return 'red';
 305     }
 306   } else {
 307     return 'gray';
 308   }
 309 }
 310
 311
 312 1;