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 { my $na = $_->NetAddr; $na ? $na->addr : () }
 100     qsearch({
 101         table     => $class->table,
 102         hashref   => \%hash,
 103         extra_sql => " AND $ip_field != '0e0'",
 104     });
 105 }
 106
 107 sub _is_used {
 108   my ($class, $addr, $exclude) = @_;
 109   my $ip_field = $class->table_info->{'ip_field'}
 110     or return '';
 111
 112   my $svc = qsearchs($class->table, { $ip_field => $addr })
 113     or return '';
 114
 115   return '' if ( ref $exclude and $exclude->svcnum == $svc->svcnum );
 116
 117   my $cust_svc = $svc->cust_svc;
 118   if ( $cust_svc ) {
 119     my @label = $cust_svc->label;
 120     # "svc_foo 1234 (Service Desc)"
 121     # this should be enough to identify it without leaking customer
 122     # names across agents
 123     "$label[2] $label[3] ($label[0])";
 124   } else {
 125     join(' ', $class->table, $svc->svcnum, '(unlinked service)');
 126   }
 127 }
 128
 129 =item attached_router
 130
 131 Returns the L<FS::router> attached via this service (as opposed to the one
 132 this service is connected through), that is, a router whose "svcnum" field
 133 equals this service's primary key.
 134
 135 If the 'router_routernum' pseudo-field is set, returns that router instead.
 136
 137 =cut
 138
 139 sub attached_router {
 140   my $self = shift;
 141   if ( length($self->get('router_routernum') )) {
 142     return FS::router->by_key($self->router_routernum);
 143   } else {
 144     qsearchs('router', { 'svcnum' => $self->svcnum });
 145   }
 146 }
 147
 148 =item attached_block
 149
 150 Returns the address block (L<FS::addr_block>) assigned to the attached_router,
 151 if there is one.
 152
 153 If the 'router_blocknum' pseudo-field is set, returns that block instead.
 154
 155 =cut
 156
 157 sub attached_block {
 158   my $self = shift;
 159   if ( length($self->get('router_blocknum')) ) {
 160     return FS::addr_block->by_key($self->router_blocknum);
 161   } else {
 162     my $router = $self->attached_router or return '';
 163     my ($block) = $router->addr_block;
 164     return $block || '';
 165   }
 166 }
 167
 168 =item radius_check
 169
 170 Returns nothing.
 171
 172 =cut
 173
 174 sub radius_check { }
 175
 176 =item radius_reply
 177
 178 Returns RADIUS reply items that are relevant across all exports and
 179 necessary for the IP address configuration of the service.  Currently, that
 180 means "Framed-Route" if there's an attached router.
 181
 182 =cut
 183
 184 sub radius_reply {
 185   my $self = shift;
 186   my %reply;
 187   my ($block) = $self->attached_block;
 188   if ( $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'} =
 194     $block->cidr . ' ' .
 195     ($self->ip_addr || '0.0.0.0') . ' 1';
 196   }
 197   %reply;
 198 }
 199
 200 sub replace_check {
 201   my ($new, $old) = @_;
 202   # this modifies $old, not $new, which is a slight abuse of replace_check,
 203   # but there's no way to ensure that replace_old gets called...
 204   #
 205   # ensure that router_routernum and router_blocknum are set to their
 206   # current values, so that exports remember the service's attached router
 207   # and block even after they've been replaced
 208   my $router = $old->attached_router;
 209   my $block = $old->attached_block;
 210   $old->set('router_routernum', $router ? $router->routernum : 0);
 211   $old->set('router_blocknum', $block ? $block->blocknum : 0);
 212   my $err_or_ref = $new->NEXT::replace_check($old) || '';
 213   # because NEXT::replace_check($old) ends up trying to AUTOLOAD replace_check
 214   # which is dumb, but easily worked around
 215   ref($err_or_ref) ? '' : $err_or_ref;
 216 }
 217
 218 1;