1 package FS::addr_block;
5 use FS::Record qw( qsearchs qsearch dbh );
14 use List::Util qw( first );
16 @ISA = qw( FS::Record );
20 FS::addr_block - Object methods for addr_block records
26 $record = new FS::addr_block \%hash;
27 $record = new FS::addr_block { 'column' => 'value' };
29 $error = $record->insert;
31 $error = $new_record->replace($old_record);
33 $error = $record->delete;
35 $error = $record->check;
39 An FS::addr_block record describes an address block assigned for broadband
40 access. FS::addr_block inherits from FS::Record. The following fields are
45 =item blocknum - primary key, used in FS::svc_broadband to associate
46 services to the block.
48 =item routernum - the router (see FS::router) to which this
51 =item ip_gateway - the gateway address used by customers within this block.
53 =item ip_netmask - the netmask of the block, expressed as an integer.
55 =item manual_flag - prohibit automatic ip assignment from this block when true.
57 =item agentnum - optional agent number (see L<FS::agent>)
67 Create a new record. To add the record to the database, see "insert".
71 sub table { 'addr_block'; }
75 Adds this record to the database. If there is an error, returns the error,
76 otherwise returns false.
80 Deletes this record from the database. If there is an error, returns the
81 error, otherwise returns false.
87 return 'Block must be deallocated and have no services before deletion'
88 if $self->router || $self->svc_broadband;
90 local $SIG{HUP} = 'IGNORE';
91 local $SIG{INT} = 'IGNORE';
92 local $SIG{QUIT} = 'IGNORE';
93 local $SIG{TERM} = 'IGNORE';
94 local $SIG{TSTP} = 'IGNORE';
95 local $SIG{PIPE} = 'IGNORE';
97 my $oldAutoCommit = $FS::UID::AutoCommit;
98 local $FS::UID::AutoCommit = 0;
101 my $error = $self->SUPER::delete;
103 $dbh->rollback if $oldAutoCommit;
107 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
112 =item replace OLD_RECORD
114 Replaces OLD_RECORD with this one in the database. If there is an error,
115 returns the error, otherwise returns false.
117 At present it's not possible to reallocate a block to a different router
118 except by deallocating it first, which requires that none of its addresses
119 be assigned. This is probably as it should be.
122 my ( $new, $old ) = ( shift, shift );
124 unless($new->routernum == $old->routernum) {
125 my @svc = $self->svc_broadband;
127 return 'Block has assigned addresses: '.
128 join ', ', map {$_->ip_addr} @svc;
131 return 'Block is already allocated'
132 if($new->routernum && $old->routernum);
141 Checks all fields to make sure this is a valid record. If there is an error,
142 returns the error, otherwise returns false. Called by the insert and replace
151 $self->ut_number('routernum')
152 || $self->ut_ip('ip_gateway')
153 || $self->ut_number('ip_netmask')
154 || $self->ut_enum('manual_flag', [ '', 'Y' ])
155 || $self->ut_agentnum_acl('agentnum', 'Broadband global configuration')
157 return $error if $error;
160 # A routernum of 0 indicates an unassigned block and is allowed
161 return "Unknown routernum"
162 if ($self->routernum and not $self->router);
164 my $self_addr = $self->NetAddr;
165 return "Cannot parse address: ". $self->ip_gateway . '/' . $self->ip_netmask
168 if (not $self->blocknum) {
170 my $block_addr = $_->NetAddr;
171 if($block_addr->contains($self_addr)
172 or $self_addr->contains($block_addr)) { $_; };
173 } qsearch( 'addr_block', {});
175 return "Block intersects existing block ".$_->ip_gateway."/".$_->ip_netmask;
185 Returns the FS::router object corresponding to this object. If the
186 block is unassigned, returns undef.
192 return qsearchs('router', { routernum => $self->routernum });
197 Returns a list of FS::svc_broadband objects associated
204 return qsearch('svc_broadband', { blocknum => $self->blocknum });
209 Returns a list of FS::svc_broadband objects associated
216 return qsearch('svc_acct', { blocknum => $self->blocknum });
221 Returns a NetAddr::IP object for this block's address and netmask.
227 new NetAddr::IP ($self->ip_gateway, $self->ip_netmask);
232 Returns a CIDR string for this block's address and netmask, i.e. 10.4.20.0/24
238 $self->NetAddr->cidr;
243 Returns a sorted list of free addresses in the block.
252 FS::IP_Mixin->used_addresses_in_block($self),
253 FS::Conf->new()->config('exclude_ip_addr');
255 grep { !exists $used_addr_map{$_} } map { $_->addr } $self->NetAddr->hostenum;
260 Returns a NetAddr::IP object corresponding to the first unassigned address
261 in the block (other than the network, broadcast, or gateway address). If
262 there are no free addresses, returns nothing. There are never free addresses
263 when manual_flag is true.
265 There is no longer a method to return all free addresses in a block.
271 my $selfaddr = $self->NetAddr;
273 return () if $self->manual_flag;
275 my $conf = new FS::Conf;
276 my @excludeaddr = $conf->config('exclude_ip_addr');
278 my %used = map { $_ => 1 }
282 $selfaddr->network->addr,
283 $selfaddr->broadcast->addr,
284 FS::IP_Mixin->used_addresses_in_block($self)
287 # just do a linear search of the block
288 my $freeaddr = $selfaddr->network + 1;
289 while ( $freeaddr < $selfaddr->broadcast ) {
290 # also make sure it's not blocked from assignment by an address range
291 if ( !$used{$freeaddr->addr } ) {
292 my ($range) = grep { !$_->allow_use }
293 FS::addr_range->any_contains($freeaddr->addr);
295 # then we've found a free address
298 # otherwise, skip to the end of the range
299 $freeaddr = NetAddr::IP->new($range->end, $self->ip_netmask);
307 =item allocate -- deprecated
309 Allocates this address block to a router. Takes an FS::router object
312 At present it's not possible to reallocate a block to a different router
313 except by deallocating it first, which requires that none of its addresses
314 be assigned. This is probably as it should be.
319 my ($self, $router) = @_;
320 carp "deallocate deprecated -- use replace";
322 return 'Block must be allocated to a router'
323 unless(ref $router eq 'FS::router');
325 my $new = new FS::addr_block {$self->hash};
326 $new->routernum($router->routernum);
327 return $new->replace($self);
331 =item deallocate -- deprecated
333 Deallocates the block (i.e. sets the routernum to 0). If any addresses in the
334 block are assigned to services, it fails.
339 carp "deallocate deprecated -- use replace";
342 my $new = new FS::addr_block {$self->hash};
344 return $new->replace($self);
349 Splits this address block into two equal blocks, occupying the same space as
350 the original block. The first of the two will also have the same blocknum.
351 The gateway address of each block will be set to the first usable address, i.e.
352 (network address)+1. Since this method is designed for use on unallocated
353 blocks, this is probably the correct behavior.
355 (At present, splitting allocated blocks is disallowed. Anyone who wants to
356 implement this is reminded that each split costs three addresses, and any
357 customers who were using these addresses will have to be moved; depending on
358 how full the block was before being split, they might have to be moved to a
359 different block. Anyone who I<still> wants to implement it is asked to tie it
360 to a configuration switch so that site admins can disallow it.)
366 # We should consider using Attribute::Handlers/Aspect/Hook::LexWrap/
367 # something to atomicize functions, so that we can say
369 # sub split_block : atomic {
371 # instead of repeating all this AutoCommit verbage in every
372 # sub that does more than one database operation.
374 my $oldAutoCommit = $FS::UID::AutoCommit;
375 local $FS::UID::AutoCommit = 0;
382 return 'Block is already allocated';
385 #TODO: Smallest allowed block should be a config option.
386 if ($self->NetAddr->masklen() ge 30) {
387 return 'Cannot split blocks with a mask length >= 30';
391 $ip[0] = $self->NetAddr;
392 @ip = map {$_->first()} $ip[0]->split($self->ip_netmask + 1);
395 $new[$_] = new FS::addr_block {$self->hash};
396 $new[$_]->ip_gateway($ip[$_]->addr);
397 $new[$_]->ip_netmask($ip[$_]->masklen);
400 $new[1]->blocknum('');
402 $error = $new[0]->replace($self);
408 $error = $new[1]->insert;
414 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
424 Returns the agent (see L<FS::agent>) for this address block, if one exists.
429 qsearchs('agent', { 'agentnum' => shift->agentnum } );
434 Returns text including the router name, gateway ip, and netmask for this
441 my $router = $self->router;
442 ($router ? $router->routername : '(unallocated)'). ':'. $self->NetAddr;
447 Minimum block size should be a config option. It's hardcoded at /30 right
448 now because that's the smallest block that makes any sense at all.