1 package FS::addr_block;
5 use FS::Record qw( qsearchs qsearch dbh );
13 use List::Util qw( first );
15 @ISA = qw( FS::Record );
19 FS::addr_block - Object methods for addr_block records
25 $record = new FS::addr_block \%hash;
26 $record = new FS::addr_block { 'column' => 'value' };
28 $error = $record->insert;
30 $error = $new_record->replace($old_record);
32 $error = $record->delete;
34 $error = $record->check;
38 An FS::addr_block record describes an address block assigned for broadband
39 access. FS::addr_block inherits from FS::Record. The following fields are
44 =item blocknum - primary key, used in FS::svc_broadband to associate
45 services to the block.
47 =item routernum - the router (see FS::router) to which this
50 =item ip_gateway - the gateway address used by customers within this block.
52 =item ip_netmask - the netmask of the block, expressed as an integer.
54 =item manual_flag - prohibit automatic ip assignment from this block when true.
56 =item agentnum - optional agent number (see L<FS::agent>)
66 Create a new record. To add the record to the database, see "insert".
70 sub table { 'addr_block'; }
74 Adds this record to the database. If there is an error, returns the error,
75 otherwise returns false.
79 Deletes this record from the database. If there is an error, returns the
80 error, otherwise returns false.
86 return 'Block must be deallocated and have no services before deletion'
87 if $self->router || $self->svc_broadband;
89 local $SIG{HUP} = 'IGNORE';
90 local $SIG{INT} = 'IGNORE';
91 local $SIG{QUIT} = 'IGNORE';
92 local $SIG{TERM} = 'IGNORE';
93 local $SIG{TSTP} = 'IGNORE';
94 local $SIG{PIPE} = 'IGNORE';
96 my $oldAutoCommit = $FS::UID::AutoCommit;
97 local $FS::UID::AutoCommit = 0;
100 my $error = $self->SUPER::delete;
102 $dbh->rollback if $oldAutoCommit;
106 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
111 =item replace OLD_RECORD
113 Replaces OLD_RECORD with this one in the database. If there is an error,
114 returns the error, otherwise returns false.
116 At present it's not possible to reallocate a block to a different router
117 except by deallocating it first, which requires that none of its addresses
118 be assigned. This is probably as it should be.
121 my ( $new, $old ) = ( shift, shift );
123 unless($new->routernum == $old->routernum) {
124 my @svc = $self->svc_broadband;
126 return 'Block has assigned addresses: '.
127 join ', ', map {$_->ip_addr} @svc;
130 return 'Block is already allocated'
131 if($new->routernum && $old->routernum);
140 Checks all fields to make sure this is a valid record. If there is an error,
141 returns the error, otherwise returns false. Called by the insert and replace
150 $self->ut_number('routernum')
151 || $self->ut_ip('ip_gateway')
152 || $self->ut_number('ip_netmask')
153 || $self->ut_enum('manual_flag', [ '', 'Y' ])
154 || $self->ut_agentnum_acl('agentnum', 'Broadband global configuration')
156 return $error if $error;
159 # A routernum of 0 indicates an unassigned block and is allowed
160 return "Unknown routernum"
161 if ($self->routernum and not $self->router);
163 my $self_addr = $self->NetAddr;
164 return "Cannot parse address: ". $self->ip_gateway . '/' . $self->ip_netmask
167 if (not $self->blocknum) {
169 my $block_addr = $_->NetAddr;
170 if($block_addr->contains($self_addr)
171 or $self_addr->contains($block_addr)) { $_; };
172 } qsearch( 'addr_block', {});
174 return "Block intersects existing block ".$_->ip_gateway."/".$_->ip_netmask;
184 Returns the FS::router object corresponding to this object. If the
185 block is unassigned, returns undef.
191 return qsearchs('router', { routernum => $self->routernum });
196 Returns a list of FS::svc_broadband objects associated
203 return qsearch('svc_broadband', { blocknum => $self->blocknum });
208 Returns a list of FS::svc_broadband objects associated
215 return qsearch('svc_acct', { blocknum => $self->blocknum });
220 Returns a NetAddr::IP object for this block's address and netmask.
226 new NetAddr::IP ($self->ip_gateway, $self->ip_netmask);
231 Returns a CIDR string for this block's address and netmask, i.e. 10.4.20.0/24
237 $self->NetAddr->cidr;
242 Returns a NetAddr::IP object corresponding to the first unassigned address
243 in the block (other than the network, broadcast, or gateway address). If
244 there are no free addresses, returns nothing. There are never free addresses
245 when manual_flag is true.
247 There is no longer a method to return all free addresses in a block.
253 my $selfaddr = $self->NetAddr;
255 return () if $self->manual_flag;
257 my $conf = new FS::Conf;
258 my @excludeaddr = $conf->config('exclude_ip_addr');
260 my %used = map { $_ => 1 }
264 $selfaddr->network->addr,
265 $selfaddr->broadcast->addr,
266 FS::IP_Mixin->used_addresses($self)
269 # just do a linear search of the block
270 my $freeaddr = $selfaddr->network + 1;
271 while ( $freeaddr < $selfaddr->broadcast ) {
272 # also make sure it's not blocked from assignment by an address range
273 if ( !$used{$freeaddr->addr } ) {
274 my ($range) = grep { !$_->allow_use }
275 FS::addr_range->any_contains($freeaddr->addr);
277 # then we've found a free address
280 # otherwise, skip to the end of the range
281 $freeaddr = NetAddr::IP->new($range->end, $self->ip_netmask);
289 =item allocate -- deprecated
291 Allocates this address block to a router. Takes an FS::router object
294 At present it's not possible to reallocate a block to a different router
295 except by deallocating it first, which requires that none of its addresses
296 be assigned. This is probably as it should be.
301 my ($self, $router) = @_;
302 carp "deallocate deprecated -- use replace";
304 return 'Block must be allocated to a router'
305 unless(ref $router eq 'FS::router');
307 my $new = new FS::addr_block {$self->hash};
308 $new->routernum($router->routernum);
309 return $new->replace($self);
313 =item deallocate -- deprecated
315 Deallocates the block (i.e. sets the routernum to 0). If any addresses in the
316 block are assigned to services, it fails.
321 carp "deallocate deprecated -- use replace";
324 my $new = new FS::addr_block {$self->hash};
326 return $new->replace($self);
331 Splits this address block into two equal blocks, occupying the same space as
332 the original block. The first of the two will also have the same blocknum.
333 The gateway address of each block will be set to the first usable address, i.e.
334 (network address)+1. Since this method is designed for use on unallocated
335 blocks, this is probably the correct behavior.
337 (At present, splitting allocated blocks is disallowed. Anyone who wants to
338 implement this is reminded that each split costs three addresses, and any
339 customers who were using these addresses will have to be moved; depending on
340 how full the block was before being split, they might have to be moved to a
341 different block. Anyone who I<still> wants to implement it is asked to tie it
342 to a configuration switch so that site admins can disallow it.)
348 # We should consider using Attribute::Handlers/Aspect/Hook::LexWrap/
349 # something to atomicize functions, so that we can say
351 # sub split_block : atomic {
353 # instead of repeating all this AutoCommit verbage in every
354 # sub that does more than one database operation.
356 my $oldAutoCommit = $FS::UID::AutoCommit;
357 local $FS::UID::AutoCommit = 0;
364 return 'Block is already allocated';
367 #TODO: Smallest allowed block should be a config option.
368 if ($self->NetAddr->masklen() ge 30) {
369 return 'Cannot split blocks with a mask length >= 30';
373 $ip[0] = $self->NetAddr;
374 @ip = map {$_->first()} $ip[0]->split($self->ip_netmask + 1);
377 $new[$_] = new FS::addr_block {$self->hash};
378 $new[$_]->ip_gateway($ip[$_]->addr);
379 $new[$_]->ip_netmask($ip[$_]->masklen);
382 $new[1]->blocknum('');
384 $error = $new[0]->replace($self);
390 $error = $new[1]->insert;
396 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
406 Returns the agent (see L<FS::agent>) for this address block, if one exists.
411 qsearchs('agent', { 'agentnum' => shift->agentnum } );
416 Returns text including the router name, gateway ip, and netmask for this
423 my $router = $self->router;
424 ($router ? $router->routername : '(unallocated)'). ':'. $self->NetAddr;
429 Minimum block size should be a config option. It's hardcoded at /30 right
430 now because that's the smallest block that makes any sense at all.