1 package FS::addr_block;
5 use FS::Record qw( qsearchs qsearch dbh );
11 use List::Util qw( first );
13 @ISA = qw( FS::Record );
17 FS::addr_block - Object methods for addr_block records
23 $record = new FS::addr_block \%hash;
24 $record = new FS::addr_block { 'column' => 'value' };
26 $error = $record->insert;
28 $error = $new_record->replace($old_record);
30 $error = $record->delete;
32 $error = $record->check;
36 An FS::addr_block record describes an address block assigned for broadband
37 access. FS::addr_block inherits from FS::Record. The following fields are
42 =item blocknum - primary key, used in FS::svc_broadband to associate
43 services to the block.
45 =item routernum - the router (see FS::router) to which this
48 =item ip_gateway - the gateway address used by customers within this block.
50 =item ip_netmask - the netmask of the block, expressed as an integer.
52 =item manual_flag - prohibit automatic ip assignment from this block when true.
54 =item agentnum - optional agent number (see L<FS::agent>)
64 Create a new record. To add the record to the database, see "insert".
68 sub table { 'addr_block'; }
72 Adds this record to the database. If there is an error, returns the error,
73 otherwise returns false.
77 Deletes this record from the database. If there is an error, returns the
78 error, otherwise returns false.
84 return 'Block must be deallocated and have no services before deletion'
85 if $self->router || $self->svc_broadband;
87 local $SIG{HUP} = 'IGNORE';
88 local $SIG{INT} = 'IGNORE';
89 local $SIG{QUIT} = 'IGNORE';
90 local $SIG{TERM} = 'IGNORE';
91 local $SIG{TSTP} = 'IGNORE';
92 local $SIG{PIPE} = 'IGNORE';
94 my $oldAutoCommit = $FS::UID::AutoCommit;
95 local $FS::UID::AutoCommit = 0;
98 my $error = $self->SUPER::delete;
100 $dbh->rollback if $oldAutoCommit;
104 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
109 =item replace OLD_RECORD
111 Replaces OLD_RECORD with this one in the database. If there is an error,
112 returns the error, otherwise returns false.
114 At present it's not possible to reallocate a block to a different router
115 except by deallocating it first, which requires that none of its addresses
116 be assigned. This is probably as it should be.
119 my ( $new, $old ) = ( shift, shift );
121 unless($new->routernum == $old->routernum) {
122 my @svc = $self->svc_broadband;
124 return 'Block has assigned addresses: '.
125 join ', ', map {$_->ip_addr} @svc;
128 return 'Block is already allocated'
129 if($new->routernum && $old->routernum);
138 Checks all fields to make sure this is a valid record. If there is an error,
139 returns the error, otherwise returns false. Called by the insert and replace
148 $self->ut_number('routernum')
149 || $self->ut_ip('ip_gateway')
150 || $self->ut_number('ip_netmask')
151 || $self->ut_enum('manual_flag', [ '', 'Y' ])
152 || $self->ut_agentnum_acl('agentnum', 'Broadband global configuration')
154 return $error if $error;
157 # A routernum of 0 indicates an unassigned block and is allowed
158 return "Unknown routernum"
159 if ($self->routernum and not $self->router);
161 my $self_addr = $self->NetAddr;
162 return "Cannot parse address: ". $self->ip_gateway . '/' . $self->ip_netmask
165 if (not $self->blocknum) {
167 my $block_addr = $_->NetAddr;
168 if($block_addr->contains($self_addr)
169 or $self_addr->contains($block_addr)) { $_; };
170 } qsearch( 'addr_block', {});
172 return "Block intersects existing block ".$_->ip_gateway."/".$_->ip_netmask;
182 Returns the FS::router object corresponding to this object. If the
183 block is unassigned, returns undef.
189 return qsearchs('router', { routernum => $self->routernum });
194 Returns a list of FS::svc_broadband objects associated
201 return qsearch('svc_broadband', { blocknum => $self->blocknum });
206 Returns a NetAddr::IP object for this block's address and netmask.
212 new NetAddr::IP ($self->ip_gateway, $self->ip_netmask);
217 Returns a CIDR string for this block's address and netmask, i.e. 10.4.20.0/24
223 $self->NetAddr->cidr;
228 Returns a NetAddr::IP object corresponding to the first unassigned address
229 in the block (other than the network, broadcast, or gateway address). If
230 there are no free addresses, returns nothing. There are never free addresses
231 when manual_flag is true.
233 There is no longer a method to return all free addresses in a block.
239 my $selfaddr = $self->NetAddr;
241 return if $self->manual_flag;
243 my $conf = new FS::Conf;
244 my @excludeaddr = $conf->config('exclude_ip_addr');
246 my %used = map { $_ => 1 }
250 $selfaddr->network->addr,
251 $selfaddr->broadcast->addr,
252 (map { $_->NetAddr->addr }
253 qsearch('svc_broadband', { blocknum => $self->blocknum })
257 # just do a linear search of the block
258 my $freeaddr = $selfaddr->network + 1;
259 while ( $freeaddr < $selfaddr->broadcast ) {
260 return $freeaddr unless $used{ $freeaddr->addr };
267 =item allocate -- deprecated
269 Allocates this address block to a router. Takes an FS::router object
272 At present it's not possible to reallocate a block to a different router
273 except by deallocating it first, which requires that none of its addresses
274 be assigned. This is probably as it should be.
279 my ($self, $router) = @_;
280 carp "deallocate deprecated -- use replace";
282 return 'Block must be allocated to a router'
283 unless(ref $router eq 'FS::router');
285 my $new = new FS::addr_block {$self->hash};
286 $new->routernum($router->routernum);
287 return $new->replace($self);
291 =item deallocate -- deprecated
293 Deallocates the block (i.e. sets the routernum to 0). If any addresses in the
294 block are assigned to services, it fails.
299 carp "deallocate deprecated -- use replace";
302 my $new = new FS::addr_block {$self->hash};
304 return $new->replace($self);
309 Splits this address block into two equal blocks, occupying the same space as
310 the original block. The first of the two will also have the same blocknum.
311 The gateway address of each block will be set to the first usable address, i.e.
312 (network address)+1. Since this method is designed for use on unallocated
313 blocks, this is probably the correct behavior.
315 (At present, splitting allocated blocks is disallowed. Anyone who wants to
316 implement this is reminded that each split costs three addresses, and any
317 customers who were using these addresses will have to be moved; depending on
318 how full the block was before being split, they might have to be moved to a
319 different block. Anyone who I<still> wants to implement it is asked to tie it
320 to a configuration switch so that site admins can disallow it.)
326 # We should consider using Attribute::Handlers/Aspect/Hook::LexWrap/
327 # something to atomicize functions, so that we can say
329 # sub split_block : atomic {
331 # instead of repeating all this AutoCommit verbage in every
332 # sub that does more than one database operation.
334 my $oldAutoCommit = $FS::UID::AutoCommit;
335 local $FS::UID::AutoCommit = 0;
342 return 'Block is already allocated';
345 #TODO: Smallest allowed block should be a config option.
346 if ($self->NetAddr->masklen() ge 30) {
347 return 'Cannot split blocks with a mask length >= 30';
351 $ip[0] = $self->NetAddr;
352 @ip = map {$_->first()} $ip[0]->split($self->ip_netmask + 1);
355 $new[$_] = new FS::addr_block {$self->hash};
356 $new[$_]->ip_gateway($ip[$_]->addr);
357 $new[$_]->ip_netmask($ip[$_]->masklen);
360 $new[1]->blocknum('');
362 $error = $new[0]->replace($self);
368 $error = $new[1]->insert;
374 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
384 Returns the agent (see L<FS::agent>) for this address block, if one exists.
389 qsearchs('agent', { 'agentnum' => shift->agentnum } );
394 Returns text including the router name, gateway ip, and netmask for this
401 my $router = $self->router;
402 ($router ? $router->routername : '(unallocated)'). ':'. $self->NetAddr;
409 Minimum block size should be a config option. It's hardcoded at /30 right
410 now because that's the smallest block that makes any sense at all.