source: trunk/cgi-bin/IPDB.pm@ 78

Last change on this file since 78 was 78, checked in by Kris Deugau, 19 years ago

/trunk

Updated allocBlock() to properly handle and return errors
"Temporarily" copy-pasted initPool() code into allocBlock()

-> Depending on real functionality, this may become permanent. :(
File size: 11.7 KB
Line 
1# ipdb/cgi-bin/IPDB.pm
2# Contains functions for IPDB - database access, subnet mangling, block allocation, etc
3###
4# SVN revision info
5# $Date$
6# SVN revision $Rev$
7# Last update by $Author$
8###
9# Copyright (C) 2004 - Kris Deugau
10
11package IPDB;
12
13use strict;
14use warnings;
15use Exporter;
16use DBI;
17use Net::SMTP;
18use POSIX;
19use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
20
21$VERSION = 2.0;
22@ISA = qw(Exporter);
23@EXPORT_OK = qw(&initIPDBGlocals &connectDB &finish &checkDBSanity &allocateBlock
24 &mailNotify);
25
26@EXPORT = (); # Export nothing by default.
27%EXPORT_TAGS = ( ALL => [qw( &initIPDBGlocals &connectDB &finish &checkDBSanity
28 &allocateBlock &mailNotify)]
29 );
30
31##
32## Global variables
33##
34our %disp_alloctypes;
35our %list_alloctypes;
36
37# Let's initialize the globals.
38## IPDB::initIPDBGlobals()
39# Initialize all globals. Takes a database handle, returns a success or error code
40sub initIPDBGlobals {
41 my $dbh = $_[0];
42 my $sth;
43
44 $sth = $dbh->prepare("select type,dispname from alloctypes");
45 $sth->execute;
46 return (undef,$sth->errstr) if $sth->err;
47
48 while (my @data = $sth->fetchrow_array) {
49 $disp_alloctypes{$data[0]} = $data[1];
50 }
51 return (1,"OK");
52} # end initIPDBGlobals
53
54
55## IPDB::connectDB()
56# Creates connection to IPDB.
57# Requires the database name, username, and password.
58# Returns a handle to the db.
59# Set up for a PostgreSQL db; could be any transactional DBMS with the
60# right changes.
61# This definition should be sub connectDB($$$) to be technically correct,
62# but this breaks. GRR.
63sub connectDB {
64 my ($dbname,$user,$pass) = @_;
65 my $dbh;
66 my $DSN = "DBI:Pg:dbname=$dbname";
67# my $user = 'ipdb';
68# my $pw = 'ipdbpwd';
69
70# Note that we want to autocommit by default, and we will turn it off locally as necessary.
71# We may not want to print gobbledygook errors; YMMV. Have to ponder that further.
72 $dbh = DBI->connect($DSN, $user, $pass, {
73 AutoCommit => 1,
74 PrintError => 0
75 })
76 or return (undef, $DBI::errstr) if(!$dbh);
77
78# Return here if we can't select. Note that this indicates a
79# problem executing the select.
80 my $sth = $dbh->prepare('select cidr from masterblocks');
81 $sth->execute();
82 return (undef,$DBI::errstr) if ($sth->err);
83
84# See if the select returned anything (or null data). This should
85# succeed if the select executed, but...
86 $sth->fetchrow();
87 return (undef,$DBI::errstr) if ($sth->err);
88
89# If we get here, we should be OK.
90 return ($dbh,"DB connection OK");
91} # end connectDB
92
93
94## IPDB::finish()
95# Cleans up after database handles and so on.
96# Requires a database handle
97sub finish {
98 my $dbh = $_[0];
99 $dbh->disconnect;
100} # end finish
101
102
103# Quick check to see if the db is responding. A full integrity
104# check will have to be a separate tool to walk the IP allocation trees.
105sub checkDBSanity {
106 my $dbh = connectDB();
107
108 if (!$dbh) {
109 print "Cannot connect to the database!";
110 } else {
111 # it connects, try a stmt.
112 my $sth = $dbh->prepare('select cidr from masterblocks');
113 my $err = $sth->execute();
114
115 if ($sth->fetchrow()) {
116 # all is well.
117 return 1;
118 } else {
119 print "Connected to the database, but could not execute test statement. ".$sth->errstr();
120 }
121 }
122 # Clean up after ourselves.
123 $dbh->disconnect;
124} # end checkDBSanity
125
126
127## IPDB::allocateBlock()
128# Does all of the magic of actually allocating a netblock
129# Requires database handle, block to allocate, custid, type, city,
130# description, notes, circuit ID, block to allocate from,
131# Returns a success code and optional error message.
132sub allocateBlock {
133 my ($dbh,undef,undef,$custid,$type,$city,$desc,$notes,$circid) = @_;
134
135 my $cidr = new NetAddr::IP $_[1];
136 my $alloc_from = new NetAddr::IP $_[2];
137 my $sth;
138 my $msg; # To contain the error message, if any.
139
140 # Enable transactions and error handling
141 local $dbh->{AutoCommit} = 0; # These need to be local so we don't
142 local $dbh->{RaiseError} = 1; # step on our toes by accident.
143
144 if ($type =~ /^[cdsmw]i$/) {
145 eval {
146 # We'll just have to put up with the oddities caused by SQL (un)sort order
147 $sth = $dbh->prepare("select * from poolips where pool='$alloc_from'".
148 " and available='y' order by ip");
149 $sth->execute;
150
151# update poolips set custid='$custid',city='$city',available='n',
152# description='$desc',notes='$notes',circuitid='$circid'
153# where ip=(select ip from poolips where pool='$alloc_from'
154# and available='y' order by ip limit 1);
155##err Need better handling here; what if there's no free IPs when this sub gets called?
156 my @data = $sth->fetchrow_array;
157 my $cidr = $data[1];
158
159 $sth = $dbh->prepare("update poolips set custid='$custid',".
160 "city='$city',available='n',description='$desc',notes='$notes'".
161 "circuitid='$circid'".
162 " where ip='$cidr'");
163 $sth->execute;
164##err handle the error
165 };
166 if ($@) {
167 $msg = $@;
168 eval { $dbh->rollback; };
169 return ('FAIL',$msg);
170 } else {
171 return ('OK',"OK");
172 }
173
174 } else { # end IP-from-pool allocation
175
176 if ($cidr == $alloc_from) {
177 # Easiest case- insert in one table, delete in the other, and go home. More or less.
178 # insert into allocations values (cidr,custid,type,city,desc) and
179 # delete from freeblocks where cidr='cidr'
180 # For data safety on non-transaction DBs, we delete first.
181
182 eval {
183 if ($type eq 'rr') {
184 $sth = $dbh->prepare("update freeblocks set routed='y',city='$city'".
185 " where cidr='$cidr'");
186 $sth->execute;
187 $sth = $dbh->prepare("insert into routed values ('$cidr',".
188 $cidr->masklen.",'$city')");
189 $sth->execute;
190 } else {
191 # common stuff for end-use, dialup, dynDSL, pools, etc, etc.
192 $sth = $dbh->prepare("delete from freeblocks where cidr='$cidr'");
193 $sth->execute;
194
195 $sth = $dbh->prepare("insert into allocations values ('$cidr',".
196 "'$custid','$type','$city','$desc','$notes',".
197 $cidr->masklen.",'$circid')");
198 $sth->execute;
199
200 # And initialize the pool, if necessary
201 if ($type =~ /^.p$/) {
202 my ($pooltype) = ($type =~ /^(.)p$/);
203 # have to insert all pool IPs into poolips table as "unallocated".
204 $sth = $dbh->prepare("insert into poolips values ('$cidr',".
205 " ?, '6750400', '$city', '$pooltype', 'y', '', '', '')");
206 my @poolip_list = $cidr->hostenum;
207 if ($type eq 'dp') { # (DSLish block - *all* IPs available
208 $sth->execute($cidr->addr);
209 for (my $i=0; $i<=$#poolip_list; $i++) {
210 $sth->execute($poolip_list[$i]->addr);
211 }
212 $cidr--;
213 $sth->execute($cidr->addr);
214 } else { # (real netblock)
215 for (my $i=1; $i<=$#poolip_list; $i++) {
216 $sth->execute($poolip_list[$i]->addr);
217 }
218 }
219 } # end type = pool
220 } # routing vs non-routing netblock
221 $dbh->commit;
222 }; # end of eval
223 if ($@) {
224 $msg = $@;
225 eval { $dbh->rollback; };
226 return ('FAIL',$@);
227 } else {
228 return ('OK',"OK");
229 }
230
231 } else { # cidr != alloc_from
232
233 # Hard case. Allocation is smaller than free block.
234 my $wantmaskbits = $cidr->masklen;
235 my $maskbits = $alloc_from->masklen;
236
237 my @newfreeblocks; # Holds free blocks generated from splitting the source freeblock.
238
239 # This determines which blocks will be left "free" after allocation. We take the
240 # block we're allocating from, and split it in half. We see which half the wanted
241 # block is in, and repeat until the wanted block is equal to one of the halves.
242 my $i=0;
243 my $tmp_from = $alloc_from; # So we don't munge $alloc_from
244 while ($maskbits++ < $wantmaskbits) {
245 my @subblocks = $tmp_from->split($maskbits);
246 $newfreeblocks[$i++] = (($cidr->within($subblocks[0])) ? $subblocks[1] : $subblocks[0]);
247 $tmp_from = ( ($cidr->within($subblocks[0])) ? $subblocks[0] : $subblocks[1] );
248 } # while
249
250 # Begin SQL transaction block
251 eval {
252 # Delete old freeblocks entry
253 $sth = $dbh->prepare("delete from freeblocks where cidr='$alloc_from'");
254 $sth->execute();
255
256 # now we have to do some magic for routing blocks
257 if ($type eq 'rr') {
258 # Insert the new freeblocks entries
259 # Note that non-routed blocks are assigned to <NULL>
260 $sth = $dbh->prepare("insert into freeblocks values (?, ?, '<NULL>','n')");
261 foreach my $block (@newfreeblocks) {
262 $sth->execute("$block", $block->masklen);
263 }
264 # Insert the entry in the routed table
265 $sth = $dbh->prepare("insert into routed values ('$cidr',".
266 $cidr->masklen.",'$city')");
267 $sth->execute;
268 # Insert the (almost) same entry in the freeblocks table
269 $sth = $dbh->prepare("insert into freeblocks values ('$cidr',".
270 $cidr->masklen.",'$city','y')");
271 $sth->execute;
272
273 } else { # done with alloctype == rr
274
275 # Insert the new freeblocks entries
276 $sth = $dbh->prepare("insert into freeblocks values (?, ?, ".
277 "(select city from routed where cidr >>= '$cidr'),'y')");
278 foreach my $block (@newfreeblocks) {
279 $sth->execute("$block", $block->masklen);
280 }
281 # Insert the allocations entry
282 $sth = $dbh->prepare("insert into allocations values ('$cidr',".
283 "'$custid','$type','$city','$desc','$notes',".$cidr->masklen.
284 ",'$circid')");
285 $sth->execute;
286
287 # And initialize the pool, if necessary
288 if ($type =~ /^.p$/) {
289 my ($pooltype) = ($type =~ /^(.)p$/);
290 # have to insert all pool IPs into poolips table as "unallocated".
291 $sth = $dbh->prepare("insert into poolips values ('$cidr',".
292 " ?, '6750400', '$city', '$pooltype', 'y', '', '', '')");
293 my @poolip_list = $cidr->hostenum;
294 if ($type eq 'dp') { # (DSLish block - *all* IPs available
295 $sth->execute($cidr->addr);
296 for (my $i=0; $i<=$#poolip_list; $i++) {
297 $sth->execute($poolip_list[$i]->addr);
298 }
299 $cidr--;
300 $sth->execute($cidr->addr);
301 } else { # (real netblock)
302 for (my $i=1; $i<=$#poolip_list; $i++) {
303 $sth->execute($poolip_list[$i]->addr);
304 }
305 }
306 } # end type = pool
307 } # done with netblock alloctype != rr
308 $dbh->commit;
309 }; # end eval
310 if ($@) {
311 $msg = $@;
312 eval { $dbh->rollback; };
313 return ('FAIL',$msg);
314 } else {
315 return ('OK',"OK");
316 }
317
318 } # end fullcidr != alloc_from
319
320 } # end static-IP vs netblock allocation
321
322} # end allocateBlock()
323
324
325## IPDB::initPool()
326# Initializes a pool
327# Requires a database handle, the pool CIDR, type, city, and a parameter
328# indicating whether the pool should allow allocation of literally every
329# IP, or if it should reserve network/gateway/broadcast IPs
330# Note that this is NOT done in a transaction, that's why it's a private
331# function and should ONLY EVER get called from allocateBlock()
332sub initPool {
333 my ($dbh,undef,$type,$city,$class) = @_;
334 my $pool = new NetAddr::IP $_[1];
335
336 my ($pooltype) = ($type =~ /^(.)p$/);
337 my $sth;
338
339 # have to insert all pool IPs into poolips table as "unallocated".
340 $sth = $dbh->prepare("insert into poolips values ('$pool',".
341 " ?, '6750400', '$city', '$pooltype', 'y', '', '', '')");
342 my @poolip_list = $pool->hostenum;
343 if ($class eq 'all') { # (DSL-ish block - *all* IPs available
344 $sth->execute($pool->addr);
345 for (my $i=0; $i<=$#poolip_list; $i++) {
346 $sth->execute($poolip_list[$i]->addr);
347 }
348 $pool--;
349 $sth->execute($pool->addr);
350 } else { # (real netblock)
351 for (my $i=1; $i<=$#poolip_list; $i++) {
352 $sth->execute($poolip_list[$i]->addr);
353 }
354 }
355} # end initPool()
356
357
358## IPDB::mailNotify()
359# Sends notification mail to recipients regarding an IPDB operation
360sub mailNotify ($$$) {
361 my ($recip,$subj,$message) = @_;
362 my $mailer = Net::SMTP->new("smtp.example.com", Hello => "ipdb.example.com");
363
364 $mailer->mail('ipdb@example.com');
365 $mailer->to($recip);
366 $mailer->data("From: \"IP Database\" <ipdb\@example.com>\n",
367 "Date: ".strftime("%a, %d %b %Y %H:%M:%S %z",localtime)."\n",
368 "Subject: {IPDB} $subj\n",
369 "X-Mailer: IPDB Notify v".sprintf("%.1d",$IPDB::VERSION)."\n",
370 "Organization: Example Corp\n",
371 "\n$message\n");
372 $mailer->quit;
373}
374
375# Indicates module loaded OK. Required by Perl.
3761;
Note: See TracBrowser for help on using the repository browser.