package FS::svc_IP_Mixin;
+use base 'FS::IP_Mixin';
use strict;
-use base 'FS::IP_Mixin';
-use FS::Record qw(qsearchs qsearch);
+use NEXT;
+use Carp qw(croak carp);
+use FS::Record qw(qsearchs qsearch dbh);
+use FS::Conf;
+use FS::router;
+use FS::part_svc_router;
=item addr_block
my $error = $self->ip_check;
return $error if $error;
if ( my $router = $self->router ) {
- if ( grep { $_->routernum eq $router->routernum } $self->allowed_routers ) {
+ if ( grep { $_->routernum == $router->routernum } $self->allowed_routers ) {
return '';
} else {
return 'Router '.$router->routername.' not available for this service';
}
sub _used_addresses {
- my ($class, $block, $exclude) = @_;
- my $ip_field = $class->table_info->{'ip_field'}
- or return ();
- # if the service doesn't have an ip_field, then it has no IP addresses
- # in use, yes?
-
- 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);
+ my ($class, $block, $exclude_svc) = @_;
+
+ croak "_used_addresses() requires an FS::addr_block parameter"
+ unless ref $block && $block->isa('FS::addr_block');
+
+ my $ip_field = $class->table_info->{'ip_field'};
+ if ( !$ip_field ) {
+ carp "_used_addresses() skipped, no ip_field";
+ return;
+ }
+
+ my %qsearch = ( $ip_field => { op => '!=', value => '' });
+ $qsearch{svcnum} = { op => '!=', value => $exclude_svc->svcnum }
+ if ref $exclude_svc && $exclude_svc->svcnum;
+
+ my $block_na = $block->NetAddr;
+
+ my $octets;
+ if ($block->ip_netmask >= 24) {
+ $octets = 3;
+ } elsif ($block->ip_netmask >= 16) {
+ $octets = 2;
+ } elsif ($block->ip_netmask >= 8) {
+ $octets = 1;
+ }
+
+ # e.g.
+ # SELECT ip_addr
+ # FROM svc_broadband
+ # WHERE ip_addr != ''
+ # AND ip_addr != '0e0'
+ # AND ip_addr LIKE '10.0.2.%';
+ #
+ # For /24, /16 and /8 this approach is fast, even when svc_broadband table
+ # contains 650,000+ ip records. For other allocations, this approach is
+ # not speedy, but usable.
+ #
+ # Note: A use case like this would could greatly benefit from a qsearch()
+ # parameter to bypass FS::Record objects creation and just
+ # return hashrefs from DBI. 200,000 hashrefs are many seconds faster
+ # than 200,000 FS::Record objects
+ my %qsearch_param = (
+ table => $class->table,
+ select => $ip_field,
+ hashref => \%qsearch,
+ extra_sql => " AND $ip_field != '0e0' ",
+ );
+ if ( $octets ) {
+ my $block_str = join('.', (split(/\D/, $block_na->first))[0..$octets-1]);
+ $qsearch_param{extra_sql}
+ .= " AND $ip_field LIKE ".dbh->quote("${block_str}.%");
+ }
+
+ if ( $block->ip_netmask % 8 ) {
+ # Some addresses returned by qsearch may be outside the network block,
+ # so each ip address is tested to be in the block before it's returned.
+ return
+ grep { $block_na->contains( NetAddr::IP->new( $_ ) ) }
+ map { $_->$ip_field }
+ qsearch( \%qsearch );
+ }
+
+ return
+ map { $_->$ip_field }
+ qsearch( \%qsearch_param );
}
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;
projects / freeside.git / blobdiff