FS/FS/svc_IP_Mixin.pm

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