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