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 FS::Record qw(qsearchs qsearch);
   7 use FS::Conf;
   8
   9 =item addr_block
  10
  11 Returns the address block assigned to this service.
  12
  13 =item router
  14
  15 Returns the router assigned to this service, if there is one.
  16
  17 =cut
  18
  19 #addr_block and router methods provided by FS::IP_Mixin
  20
  21 =item NetAddr
  22
  23 Returns the address as a L<NetAddr::IP> object.  Use C<$svc->NetAddr->addr>
  24 to put it into canonical string form.
  25
  26 =cut
  27
  28 sub NetAddr {
  29   my $self = shift;
  30   NetAddr::IP->new($self->ip_addr);
  31 }
  32
  33 =item ip_addr
  34
  35 Wrapper for set/get on the IP address field.
  36
  37 =cut
  38
  39 sub ip_addr {
  40   my $self = shift;
  41   my $ip_field = $self->table_info->{'ip_field'}
  42     or return '';
  43   if ( @_ ) {
  44     $self->set($ip_field, @_);
  45   } else {
  46     $self->get($ip_field);
  47   }
  48 }
  49
  50 =item allowed_routers
  51
  52 Returns a list of L<FS::router> objects allowed on this service.
  53
  54 =cut
  55
  56 sub allowed_routers {
  57   my $self = shift;
  58   my $svcpart = $self->svcnum ? $self->cust_svc->svcpart : $self->svcpart;
  59   my @r = map { $_->router }
  60     qsearch('part_svc_router', { svcpart => $svcpart });
  61
  62   if ( $self->cust_main ) {
  63     my $agentnum = $self->cust_main->agentnum;
  64     return grep { !$_->agentnum or $_->agentnum == $agentnum } @r;
  65   } else {
  66     return @r;
  67   }
  68 }
  69
  70 =item svc_ip_check
  71
  72 Wrapper for C<ip_check> which also checks the validity of the router.
  73
  74 =cut
  75
  76 sub svc_ip_check {
  77   my $self = shift;
  78   my $error = $self->ip_check;
  79   return $error if $error;
  80   if ( my $router = $self->router ) {
  81     if ( grep { $_->routernum eq $router->routernum } $self->allowed_routers ) {
  82       return '';
  83     } else {
  84       return 'Router '.$router->routername.' not available for this service';
  85     }
  86   }
  87   '';
  88 }
  89
  90 sub _used_addresses {
  91   my ($class, $block, $exclude) = @_;
  92   my $ip_field = $class->table_info->{'ip_field'}
  93     or return ();
  94   # if the service doesn't have an ip_field, then it has no IP addresses
  95   # in use, yes?
  96
  97   my %hash = ( $ip_field => { op => '!=', value => '' } );
  98   #$hash{'blocknum'} = $block->blocknum if $block;
  99   $hash{'svcnum'} = { op => '!=', value => $exclude->svcnum } if ref $exclude;
 100   map { my $na = $_->NetAddr; $na ? $na->addr : () }
 101     qsearch({
 102         table     => $class->table,
 103         hashref   => \%hash,
 104         extra_sql => " AND $ip_field != '0e0'",
 105     });
 106 }
 107
 108 sub _is_used {
 109   my ($class, $addr, $exclude) = @_;
 110   my $ip_field = $class->table_info->{'ip_field'}
 111     or return '';
 112
 113   my $svc = qsearchs($class->table, { $ip_field => $addr })
 114     or return '';
 115
 116   return '' if ( ref $exclude and $exclude->svcnum == $svc->svcnum );
 117
 118   my $cust_svc = $svc->cust_svc;
 119   if ( $cust_svc ) {
 120     my @label = $cust_svc->label;
 121     # "svc_foo 1234 (Service Desc)"
 122     # this should be enough to identify it without leaking customer
 123     # names across agents
 124     "$label[2] $label[3] ($label[0])";
 125   } else {
 126     join(' ', $class->table, $svc->svcnum, '(unlinked service)');
 127   }
 128 }
 129
 130 =item attached_router
 131
 132 Returns the L<FS::router> attached via this service (as opposed to the one
 133 this service is connected through), that is, a router whose "svcnum" field
 134 equals this service's primary key.
 135
 136 If the 'router_routernum' pseudo-field is set, returns that router instead.
 137
 138 =cut
 139
 140 sub attached_router {
 141   my $self = shift;
 142   if ( length($self->get('router_routernum') )) {
 143     return FS::router->by_key($self->router_routernum);
 144   } else {
 145     qsearchs('router', { 'svcnum' => $self->svcnum });
 146   }
 147 }
 148
 149 =item attached_block
 150
 151 Returns the address block (L<FS::addr_block>) assigned to the attached_router,
 152 if there is one.
 153
 154 If the 'router_blocknum' pseudo-field is set, returns that block instead.
 155
 156 =cut
 157
 158 sub attached_block {
 159   my $self = shift;
 160   if ( length($self->get('router_blocknum')) ) {
 161     return FS::addr_block->by_key($self->router_blocknum);
 162   } else {
 163     my $router = $self->attached_router or return '';
 164     my ($block) = $router->addr_block;
 165     return $block || '';
 166   }
 167 }
 168
 169 =item radius_check
 170
 171 Returns nothing.
 172
 173 =cut
 174
 175 sub radius_check { }
 176
 177 =item radius_reply
 178
 179 Returns RADIUS reply items that are relevant across all exports and
 180 necessary for the IP address configuration of the service.  Currently, that
 181 means "Framed-Route" if there's an attached router.
 182
 183 =cut
 184
 185 sub radius_reply {
 186   my $self = shift;
 187   my %reply = ();
 188   if ( my $block = $self->attached_block ) {
 189     # block routed over dynamic IP: "192.168.100.0/29 0.0.0.0 1"
 190     # or
 191     # block routed over fixed IP: "192.168.100.0/29 192.168.100.1 1"
 192     # (the "1" at the end is the route metric)
 193     $reply{'Framed-Route'} = $block->cidr . ' ' .
 194                              ($self->ip_addr || '0.0.0.0') . ' 1';
 195
 196     $reply{'Motorola-Canopy-Gateway'} = $block->ip_gateway
 197       if FS::Conf->new->exists('radius-canopy');
 198
 199   }
 200   %reply;
 201 }
 202
 203 sub replace_check {
 204   my ($new, $old) = @_;
 205   # this modifies $old, not $new, which is a slight abuse of replace_check,
 206   # but there's no way to ensure that replace_old gets called...
 207   #
 208   # ensure that router_routernum and router_blocknum are set to their
 209   # current values, so that exports remember the service's attached router
 210   # and block even after they've been replaced
 211   my $router = $old->attached_router;
 212   my $block = $old->attached_block;
 213   $old->set('router_routernum', $router ? $router->routernum : 0);
 214   $old->set('router_blocknum', $block ? $block->blocknum : 0);
 215   my $err_or_ref = $new->NEXT::replace_check($old) || '';
 216   # because NEXT::replace_check($old) ends up trying to AUTOLOAD replace_check
 217   # which is dumb, but easily worked around
 218   ref($err_or_ref) ? '' : $err_or_ref;
 219 }
 220
 221 1;