enable CardFortress in test database, #71513
[freeside.git] / FS / FS / svc_IP_Mixin.pm
index 7eda7e0..c89245f 100644 (file)
@@ -1,8 +1,12 @@
 package FS::svc_IP_Mixin;
+use base 'FS::IP_Mixin';
 
 use strict;
-use base 'FS::IP_Mixin';
+use NEXT;
 use FS::Record qw(qsearchs qsearch);
+use FS::Conf;
+use FS::router;
+use FS::part_svc_router;
 
 =item addr_block
 
@@ -95,7 +99,12 @@ sub _used_addresses {
   my %hash = ( $ip_field => { op => '!=', value => '' } );
   #$hash{'blocknum'} = $block->blocknum if $block;
   $hash{'svcnum'} = { op => '!=', value => $exclude->svcnum } if ref $exclude;
-  map { $_->NetAddr->addr } qsearch($class->table, \%hash);
+  map { my $na = $_->NetAddr; $na ? $na->addr : () }
+    qsearch({
+        table     => $class->table,
+        hashref   => \%hash,
+        extra_sql => " AND $ip_field != '0e0'",
+    });
 }
 
 sub _is_used {
@@ -120,4 +129,134 @@ sub _is_used {
   }
 }
 
+=item attached_router
+
+Returns the L<FS::router> attached via this service (as opposed to the one
+this service is connected through), that is, a router whose "svcnum" field
+equals this service's primary key.
+
+If the 'router_routernum' pseudo-field is set, returns that router instead.
+
+=cut
+
+sub attached_router {
+  my $self = shift;
+  if ( length($self->get('router_routernum') )) {
+    return FS::router->by_key($self->router_routernum);
+  } else {
+    qsearchs('router', { 'svcnum' => $self->svcnum });
+  }
+}
+
+=item attached_block
+
+Returns the address block (L<FS::addr_block>) assigned to the attached_router,
+if there is one.
+
+If the 'router_blocknum' pseudo-field is set, returns that block instead.
+
+=cut
+
+sub attached_block {
+  my $self = shift;
+  if ( length($self->get('router_blocknum')) ) {
+    return FS::addr_block->by_key($self->router_blocknum);
+  } else {
+    my $router = $self->attached_router or return '';
+    my ($block) = $router->addr_block;
+    return $block || '';
+  }
+}
+
+=item radius_check
+
+Returns nothing.
+
+=cut
+
+sub radius_check { }
+
+=item radius_reply
+
+Returns RADIUS reply items that are relevant across all exports and 
+necessary for the IP address configuration of the service.  Currently, that
+means "Framed-Route" if there's an attached router.
+
+=cut
+
+sub radius_reply {
+  my $self = shift;
+
+  my %reply = ();
+
+  if ( my $block = $self->attached_block ) {
+    # block routed over dynamic IP: "192.168.100.0/29 0.0.0.0 1"
+    # or
+    # block routed over fixed IP: "192.168.100.0/29 192.168.100.1 1"
+    # (the "1" at the end is the route metric)
+    $reply{'Framed-Route'} = $block->cidr . ' ' .
+                             ($self->ip_addr || '0.0.0.0') . ' 1';
+  }
+
+  $reply{'Motorola-Canopy-Gateway'} = $self->addr_block->ip_gateway
+    if FS::Conf->new->exists('radius-canopy') && $self->addr_block;
+
+  %reply;
+}
+
+sub replace_check {
+  my ($new, $old) = @_;
+  # this modifies $old, not $new, which is a slight abuse of replace_check,
+  # but there's no way to ensure that replace_old gets called...
+  #
+  # ensure that router_routernum and router_blocknum are set to their
+  # current values, so that exports remember the service's attached router 
+  # and block even after they've been replaced
+  my $router = $old->attached_router;
+  my $block = $old->attached_block;
+  $old->set('router_routernum', $router ? $router->routernum : 0);
+  $old->set('router_blocknum', $block ? $block->blocknum : 0);
+  my $err_or_ref = $new->NEXT::replace_check($old) || '';
+  # because NEXT::replace_check($old) ends up trying to AUTOLOAD replace_check
+  # which is dumb, but easily worked around
+  ref($err_or_ref) ? '' : $err_or_ref;
+}
+
+=item addr_status
+
+Returns the ping status record for this service's address, if there
+is one.
+
+=cut
+
+sub addr_status {
+  my $self = shift;
+  my $addr = $self->ip_addr or return;
+  qsearchs('addr_status', { 'ip_addr'  => $addr });
+}
+
+=item addr_status_color
+
+Returns the CSS color for the ping status of this service.
+
+=cut
+
+# subject to change; should also show high/low latency (yellow?) and
+# staleness of data (probably means the daemon is not running) and packet
+# loss (once we measure that)
+
+sub addr_status_color {
+  my $self = shift;
+  if ( my $addr_status = $self->addr_status ) {
+    if ( $addr_status->up ) {
+      return 'green';
+    } else {
+      return 'red';
+    }
+  } else {
+    return 'gray';
+  }
+}
+  
+
 1;