X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fsvc_IP_Mixin.pm;h=4c2180ece677e781002b77fdb9377d7c7ae11a89;hp=7eda7e02c0bd7596c5902b2d8399145bcd89d854;hb=3adb46fccf9f631e188ea5383bd147b340477639;hpb=f197bdbaa16df592a82971c63aa4321a4788d335 diff --git a/FS/FS/svc_IP_Mixin.pm b/FS/FS/svc_IP_Mixin.pm index 7eda7e02c..4c2180ece 100644 --- a/FS/FS/svc_IP_Mixin.pm +++ b/FS/FS/svc_IP_Mixin.pm @@ -1,8 +1,13 @@ 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 @@ -76,7 +81,7 @@ sub svc_ip_check { 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'; @@ -86,16 +91,71 @@ sub svc_ip_check { } 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 { @@ -120,4 +180,134 @@ sub _is_used { } } +=item attached_router + +Returns the L 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) 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;