package FS::svc_IP_Mixin; use base 'FS::IP_Mixin'; use strict; 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 Returns the address block assigned to this service. =item router Returns the router assigned to this service, if there is one. =cut #addr_block and router methods provided by FS::IP_Mixin =item NetAddr Returns the address as a L object. Use C<$svc->NetAddr->addr> to put it into canonical string form. =cut sub NetAddr { my $self = shift; NetAddr::IP->new($self->ip_addr); } =item ip_addr Wrapper for set/get on the IP address field. =cut sub ip_addr { my $self = shift; my $ip_field = $self->table_info->{'ip_field'} or return ''; if ( @_ ) { $self->set($ip_field, @_); } else { $self->get($ip_field); } } =item allowed_routers Returns a list of L objects allowed on this service. =cut sub allowed_routers { my $self = shift; my $svcpart = $self->svcnum ? $self->cust_svc->svcpart : $self->svcpart; my @r = map { $_->router } qsearch('part_svc_router', { svcpart => $svcpart }); if ( $self->cust_main ) { my $agentnum = $self->cust_main->agentnum; return grep { !$_->agentnum or $_->agentnum == $agentnum } @r; } else { return @r; } } =item svc_ip_check Wrapper for C which also checks the validity of the router. =cut sub svc_ip_check { my $self = shift; my $error = $self->ip_check; return $error if $error; if ( my $router = $self->router ) { 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_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 { my ($class, $addr, $exclude) = @_; my $ip_field = $class->table_info->{'ip_field'} or return ''; my $svc = qsearchs($class->table, { $ip_field => $addr }) or return ''; return '' if ( ref $exclude and $exclude->svcnum == $svc->svcnum ); my $cust_svc = $svc->cust_svc; if ( $cust_svc ) { my @label = $cust_svc->label; # "svc_foo 1234 (Service Desc)" # this should be enough to identify it without leaking customer # names across agents "$label[2] $label[3] ($label[0])"; } else { join(' ', $class->table, $svc->svcnum, '(unlinked service)'); } } =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;