1 package FS::addr_block;
5 use FS::Record qw( qsearchs qsearch dbh );
12 use List::Util qw( first );
14 @ISA = qw( FS::Record );
18 FS::addr_block - Object methods for addr_block records
24 $record = new FS::addr_block \%hash;
25 $record = new FS::addr_block { 'column' => 'value' };
27 $error = $record->insert;
29 $error = $new_record->replace($old_record);
31 $error = $record->delete;
33 $error = $record->check;
37 An FS::addr_block record describes an address block assigned for broadband
38 access. FS::addr_block inherits from FS::Record. The following fields are
43 =item blocknum - primary key, used in FS::svc_broadband to associate
44 services to the block.
46 =item routernum - the router (see FS::router) to which this
49 =item ip_gateway - the gateway address used by customers within this block.
51 =item ip_netmask - the netmask of the block, expressed as an integer.
53 =item manual_flag - prohibit automatic ip assignment from this block when true.
55 =item agentnum - optional agent number (see L<FS::agent>)
65 Create a new record. To add the record to the database, see "insert".
69 sub table { 'addr_block'; }
73 Adds this record to the database. If there is an error, returns the error,
74 otherwise returns false.
78 Deletes this record from the database. If there is an error, returns the
79 error, otherwise returns false.
85 return 'Block must be deallocated and have no services before deletion'
86 if $self->router || $self->svc_broadband;
88 local $SIG{HUP} = 'IGNORE';
89 local $SIG{INT} = 'IGNORE';
90 local $SIG{QUIT} = 'IGNORE';
91 local $SIG{TERM} = 'IGNORE';
92 local $SIG{TSTP} = 'IGNORE';
93 local $SIG{PIPE} = 'IGNORE';
95 my $oldAutoCommit = $FS::UID::AutoCommit;
96 local $FS::UID::AutoCommit = 0;
99 my $error = $self->SUPER::delete;
101 $dbh->rollback if $oldAutoCommit;
105 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
110 =item replace OLD_RECORD
112 Replaces OLD_RECORD with this one in the database. If there is an error,
113 returns the error, otherwise returns false.
115 At present it's not possible to reallocate a block to a different router
116 except by deallocating it first, which requires that none of its addresses
117 be assigned. This is probably as it should be.
120 my ( $new, $old ) = ( shift, shift );
122 unless($new->routernum == $old->routernum) {
123 my @svc = $self->svc_broadband;
125 return 'Block has assigned addresses: '.
126 join ', ', map {$_->ip_addr} @svc;
129 return 'Block is already allocated'
130 if($new->routernum && $old->routernum);
139 Checks all fields to make sure this is a valid record. If there is an error,
140 returns the error, otherwise returns false. Called by the insert and replace
149 $self->ut_number('routernum')
150 || $self->ut_ip('ip_gateway')
151 || $self->ut_number('ip_netmask')
152 || $self->ut_enum('manual_flag', [ '', 'Y' ])
153 || $self->ut_agentnum_acl('agentnum', 'Broadband global configuration')
155 return $error if $error;
158 # A routernum of 0 indicates an unassigned block and is allowed
159 return "Unknown routernum"
160 if ($self->routernum and not $self->router);
162 my $self_addr = $self->NetAddr;
163 return "Cannot parse address: ". $self->ip_gateway . '/' . $self->ip_netmask
166 if (not $self->blocknum) {
168 my $block_addr = $_->NetAddr;
169 if($block_addr->contains($self_addr)
170 or $self_addr->contains($block_addr)) { $_; };
171 } qsearch( 'addr_block', {});
173 return "Block intersects existing block ".$_->ip_gateway."/".$_->ip_netmask;
183 Returns the FS::router object corresponding to this object. If the
184 block is unassigned, returns undef.
190 return qsearchs('router', { routernum => $self->routernum });
195 Returns a list of FS::svc_broadband objects associated
202 return qsearch('svc_broadband', { blocknum => $self->blocknum });
207 Returns a NetAddr::IP object for this block's address and netmask.
213 new NetAddr::IP ($self->ip_gateway, $self->ip_netmask);
218 Returns a CIDR string for this block's address and netmask, i.e. 10.4.20.0/24
224 $self->NetAddr->cidr;
229 Returns a NetAddr::IP object corresponding to the first unassigned address
230 in the block (other than the network, broadcast, or gateway address). If
231 there are no free addresses, returns nothing. There are never free addresses
232 when manual_flag is true.
234 There is no longer a method to return all free addresses in a block.
240 my $selfaddr = $self->NetAddr;
242 return () if $self->manual_flag;
244 my $conf = new FS::Conf;
245 my @excludeaddr = $conf->config('exclude_ip_addr');
247 my %used = map { $_ => 1 }
251 $selfaddr->network->addr,
252 $selfaddr->broadcast->addr,
253 FS::IP_Mixin->used_addresses($self)
256 # just do a linear search of the block
257 my $freeaddr = $selfaddr->network + 1;
258 while ( $freeaddr < $selfaddr->broadcast ) {
259 return $freeaddr unless $used{ $freeaddr->addr };
266 =item allocate -- deprecated
268 Allocates this address block to a router. Takes an FS::router object
271 At present it's not possible to reallocate a block to a different router
272 except by deallocating it first, which requires that none of its addresses
273 be assigned. This is probably as it should be.
278 my ($self, $router) = @_;
279 carp "deallocate deprecated -- use replace";
281 return 'Block must be allocated to a router'
282 unless(ref $router eq 'FS::router');
284 my $new = new FS::addr_block {$self->hash};
285 $new->routernum($router->routernum);
286 return $new->replace($self);
290 =item deallocate -- deprecated
292 Deallocates the block (i.e. sets the routernum to 0). If any addresses in the
293 block are assigned to services, it fails.
298 carp "deallocate deprecated -- use replace";
301 my $new = new FS::addr_block {$self->hash};
303 return $new->replace($self);
308 Splits this address block into two equal blocks, occupying the same space as
309 the original block. The first of the two will also have the same blocknum.
310 The gateway address of each block will be set to the first usable address, i.e.
311 (network address)+1. Since this method is designed for use on unallocated
312 blocks, this is probably the correct behavior.
314 (At present, splitting allocated blocks is disallowed. Anyone who wants to
315 implement this is reminded that each split costs three addresses, and any
316 customers who were using these addresses will have to be moved; depending on
317 how full the block was before being split, they might have to be moved to a
318 different block. Anyone who I<still> wants to implement it is asked to tie it
319 to a configuration switch so that site admins can disallow it.)
325 # We should consider using Attribute::Handlers/Aspect/Hook::LexWrap/
326 # something to atomicize functions, so that we can say
328 # sub split_block : atomic {
330 # instead of repeating all this AutoCommit verbage in every
331 # sub that does more than one database operation.
333 my $oldAutoCommit = $FS::UID::AutoCommit;
334 local $FS::UID::AutoCommit = 0;
341 return 'Block is already allocated';
344 #TODO: Smallest allowed block should be a config option.
345 if ($self->NetAddr->masklen() ge 30) {
346 return 'Cannot split blocks with a mask length >= 30';
350 $ip[0] = $self->NetAddr;
351 @ip = map {$_->first()} $ip[0]->split($self->ip_netmask + 1);
354 $new[$_] = new FS::addr_block {$self->hash};
355 $new[$_]->ip_gateway($ip[$_]->addr);
356 $new[$_]->ip_netmask($ip[$_]->masklen);
359 $new[1]->blocknum('');
361 $error = $new[0]->replace($self);
367 $error = $new[1]->insert;
373 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
383 Returns the agent (see L<FS::agent>) for this address block, if one exists.
388 qsearchs('agent', { 'agentnum' => shift->agentnum } );
393 Returns text including the router name, gateway ip, and netmask for this
400 my $router = $self->router;
401 ($router ? $router->routername : '(unallocated)'). ':'. $self->NetAddr;
408 Minimum block size should be a config option. It's hardcoded at /30 right
409 now because that's the smallest block that makes any sense at all.