source: branches/stable/cgi-bin/IPDB.pm @ 286

Last change on this file since 286 was 286, checked in by Kris Deugau, 17 years ago

/branches/stable

Merge changes from /trunk revisions:

234
237
254 (ipdb.css only)
261
279
284
285

This merges the new search system (234, 237, 254), cleans up
some display CSS (254, 279), cleans up some leftover code (r261),
and merges the "private data" code (284, 285 - note SWIP hacks conflict).

/trunk should now be almost identical to /branches/stable.

  • Property svn:keywords set to Date Rev Author
File size: 21.0 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: 2005-09-23 19:54:31 +0000 (Fri, 23 Sep 2005) $
6# SVN revision $Rev: 286 $
7# Last update by $Author: kdeugau $
8###
9# Copyright (C) 2004,2005 - 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(
24        %disp_alloctypes %list_alloctypes %def_custids @citylist @poplist @masterblocks
25        %allocated %free %routed %bigfree %IPDBacl
26        &initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock &deleteBlock
27        &mailNotify
28        );
29
30@EXPORT         = (); # Export nothing by default.
31%EXPORT_TAGS    = ( ALL => [qw(
32                %disp_alloctypes %list_alloctypes %def_custids @citylist @poplist
33                @masterblocks %allocated %free %routed %bigfree %IPDBacl
34                &initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock
35                &deleteBlock &mailNotify
36                )]
37        );
38
39##
40## Global variables
41##
42our %disp_alloctypes;
43our %list_alloctypes;
44our %def_custids;
45our @citylist;
46our @poplist;
47our @masterblocks;
48our %allocated;
49our %free;
50our %routed;
51our %bigfree;
52our %IPDBacl;
53
54# Let's initialize the globals.
55## IPDB::initIPDBGlobals()
56# Initialize all globals.  Takes a database handle, returns a success or error code
57sub initIPDBGlobals {
58  my $dbh = $_[0];
59  my $sth;
60
61  # Initialize alloctypes hashes
62  $sth = $dbh->prepare("select type,listname,dispname,listorder,def_custid from alloctypes order by listorder");
63  $sth->execute;
64  while (my @data = $sth->fetchrow_array) {
65    $disp_alloctypes{$data[0]} = $data[2];
66    $def_custids{$data[0]} = $data[4];
67    if ($data[3] < 900) {
68      $list_alloctypes{$data[0]} = $data[1];
69    }
70  }
71
72  # City and POP listings
73  $sth = $dbh->prepare("select city,routing from cities order by city");
74  $sth->execute;
75  return (undef,$sth->errstr) if $sth->err;
76  while (my @data = $sth->fetchrow_array) {
77    push @citylist, $data[0];
78    if ($data[1] eq 'y') {
79      push @poplist, $data[0];
80    }
81  }
82
83  # Master block list
84  $sth = $dbh->prepare("select cidr from masterblocks order by cidr");
85  $sth->execute;
86  return (undef,$sth->errstr) if $sth->err;
87  for (my $i=0; my @data = $sth->fetchrow_array(); $i++) {
88    $masterblocks[$i] = new NetAddr::IP $data[0];
89    $allocated{"$masterblocks[$i]"} = 0;
90    $free{"$masterblocks[$i]"} = 0;
91    $bigfree{"$masterblocks[$i]"} = 128; # Larger number means smaller block.
92                                        # Set to 128 to prepare for IPv6
93    $routed{"$masterblocks[$i]"} = 0;
94  }
95
96  # Load ACL data.  Specific username checks are done at a different level.
97  $sth = $dbh->prepare("select username,acl from users");
98  $sth->execute;
99  return (undef,$sth->errstr) if $sth->err;
100  while (my @data = $sth->fetchrow_array) {
101    $IPDBacl{$data[0]} = $data[1];
102  }
103
104  return (1,"OK");
105} # end initIPDBGlobals
106
107
108## IPDB::connectDB()
109# Creates connection to IPDB.
110# Requires the database name, username, and password.
111# Returns a handle to the db.
112# Set up for a PostgreSQL db;  could be any transactional DBMS with the
113# right changes.
114# This definition should be sub connectDB($$$) to be technically correct,
115# but this breaks.  GRR.
116sub connectDB {
117  my ($dbname,$user,$pass) = @_;
118  my $dbh;
119  my $DSN = "DBI:Pg:dbname=$dbname";
120#  my $user = 'ipdb';
121#  my $pw   = 'ipdbpwd';
122
123# Note that we want to autocommit by default, and we will turn it off locally as necessary.
124# We may not want to print gobbledygook errors;  YMMV.  Have to ponder that further.
125  $dbh = DBI->connect($DSN, $user, $pass, {
126        AutoCommit => 1,
127        PrintError => 0
128        })
129    or return (undef, $DBI::errstr) if(!$dbh);
130
131# Return here if we can't select.  Note that this indicates a
132# problem executing the select.
133  my $sth = $dbh->prepare("select type from alloctypes");
134  $sth->execute();
135  return (undef,$DBI::errstr) if ($sth->err);
136
137# See if the select returned anything (or null data).  This should
138# succeed if the select executed, but...
139  $sth->fetchrow();
140  return (undef,$DBI::errstr)  if ($sth->err);
141
142# If we get here, we should be OK.
143  return ($dbh,"DB connection OK");
144} # end connectDB
145
146
147## IPDB::finish()
148# Cleans up after database handles and so on.
149# Requires a database handle
150sub finish {
151  my $dbh = $_[0];
152  $dbh->disconnect;
153} # end finish
154
155
156## IPDB::checkDBSanity()
157# Quick check to see if the db is responding.  A full integrity
158# check will have to be a separate tool to walk the IP allocation trees.
159sub checkDBSanity {
160  my ($dbh) = $_[0];
161
162  if (!$dbh) {
163    print "No database handle, or connection has been closed.";
164    return -1;
165  } else {
166    # it connects, try a stmt.
167    my $sth = $dbh->prepare("select type from alloctypes");
168    my $err = $sth->execute();
169
170    if ($sth->fetchrow()) {
171      # all is well.
172      return 1;
173    } else {
174      print "Connected to the database, but could not execute test statement.  ".$sth->errstr();
175      return -1;
176    }
177  }
178  # Clean up after ourselves.
179#  $dbh->disconnect;
180} # end checkDBSanity
181
182
183## IPDB::allocateBlock()
184# Does all of the magic of actually allocating a netblock
185# Requires database handle, block to allocate, custid, type, city,
186#       description, notes, circuit ID, block to allocate from, private data
187# Returns a success code and optional error message.
188sub allocateBlock {
189  my ($dbh,undef,undef,$custid,$type,$city,$desc,$notes,$circid,$privdata) = @_;
190
191  my $cidr = new NetAddr::IP $_[1];
192  my $alloc_from = new NetAddr::IP $_[2];
193  my $sth;
194
195  # To contain the error message, if any.
196  my $msg = "Unknown error allocating $cidr as '$type'";
197
198  # Enable transactions and error handling
199  local $dbh->{AutoCommit} = 0; # These need to be local so we don't
200  local $dbh->{RaiseError} = 1; # step on our toes by accident.
201
202  if ($type =~ /^.i$/) {
203    $msg = "Unable to assign static IP $cidr to $custid";
204    eval {
205      # We have to do this in two parts because otherwise we lose
206      # the ability to return the IP assigned.  Should that change,
207      # the commented SQL statement below may become usable.
208# update poolips set custid='$custid',city='$city',available='n',
209#       description='$desc',notes='$notes',circuitid='$circid'
210#       where ip=(select ip from poolips where pool='$alloc_from'
211#       and available='y' order by ip limit 1);
212
213      $sth = $dbh->prepare("select ip from poolips where pool='$alloc_from'".
214        " and available='y' order by ip");
215      $sth->execute;
216
217      my @data = $sth->fetchrow_array;
218      $cidr = $data[0];  # $cidr is already declared when we get here!
219
220      $sth = $dbh->prepare("update poolips set custid='$custid',".
221        "city='$city',available='n',description='$desc',notes='$notes',".
222        "circuitid='$circid',privdata='$privdata'".
223        " where ip='$cidr'");
224      $sth->execute;
225      $dbh->commit;
226    };
227    if ($@) {
228      $msg .= ": '".$sth->errstr."'";
229      eval { $dbh->rollback; };
230      return ('FAIL',$msg);
231    } else {
232      return ('OK',"$cidr");
233    }
234
235  } else { # end IP-from-pool allocation
236
237    if ($cidr == $alloc_from) {
238      # Easiest case- insert in one table, delete in the other, and go home.  More or less.
239      # insert into allocations values (cidr,custid,type,city,desc) and
240      # delete from freeblocks where cidr='cidr'
241      # For data safety on non-transaction DBs, we delete first.
242
243      eval {
244        $msg = "Unable to allocate $cidr as '$disp_alloctypes{$type}'";
245        if ($type eq 'rm') {
246          $sth = $dbh->prepare("update freeblocks set routed='y',city='$city'".
247            " where cidr='$cidr'");
248          $sth->execute;
249          $sth = $dbh->prepare("insert into routed (cidr,maskbits,city)".
250                " values ('$cidr',".$cidr->masklen.",'$city')");
251          $sth->execute;
252        } else {
253          # common stuff for end-use, dialup, dynDSL, pools, etc, etc.
254
255          # special case - block is a container/"reserve" block
256          if ($type =~ /^(.)c$/) {
257            $sth = $dbh->prepare("update freeblocks set routed='$1' where cidr='$cidr'");
258            $sth->execute;
259          } else {
260            # "normal" case
261            $sth = $dbh->prepare("delete from freeblocks where cidr='$cidr'");
262            $sth->execute;
263          }
264          $sth = $dbh->prepare("insert into allocations".
265                " (cidr,custid,type,city,description,notes,maskbits,circuitid,privdata)".
266                " values ('$cidr','$custid','$type','$city','$desc','$notes',".
267                $cidr->masklen.",'$circid','$privdata')");
268          $sth->execute;
269
270          # And initialize the pool, if necessary
271          # PPPoE pools (currently dialup, DSL, and WiFi) get all IPs made available
272          # "DHCP" or "real-subnet" pools have the net, gw, and bcast IPs removed.
273          if ($type =~ /^.p$/) {
274            $msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
275            my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"all");
276            die $rmsg if $code eq 'FAIL';
277          } elsif ($type =~ /^.d$/) {
278            $msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
279            my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"normal");
280            die $rmsg if $code eq 'FAIL';
281          }
282
283        } # routing vs non-routing netblock
284
285        $dbh->commit;
286      }; # end of eval
287      if ($@) {
288        $msg .= ": ".$@;
289        eval { $dbh->rollback; };
290        return ('FAIL',$msg);
291      } else {
292        return ('OK',"OK");
293      }
294
295    } else { # cidr != alloc_from
296
297      # Hard case.  Allocation is smaller than free block.
298      my $wantmaskbits = $cidr->masklen;
299      my $maskbits = $alloc_from->masklen;
300
301      my @newfreeblocks;        # Holds free blocks generated from splitting the source freeblock.
302
303      # This determines which blocks will be left "free" after allocation.  We take the
304      # block we're allocating from, and split it in half.  We see which half the wanted
305      # block is in, and repeat until the wanted block is equal to one of the halves.
306      my $i=0;
307      my $tmp_from = $alloc_from;       # So we don't munge $alloc_from
308      while ($maskbits++ < $wantmaskbits) {
309        my @subblocks = $tmp_from->split($maskbits);
310        $newfreeblocks[$i++] = (($cidr->within($subblocks[0])) ? $subblocks[1] : $subblocks[0]);
311        $tmp_from = ( ($cidr->within($subblocks[0])) ? $subblocks[0] : $subblocks[1] );
312      } # while
313
314      # Begin SQL transaction block
315      eval {
316        $msg = "Unable to allocate $cidr as '$disp_alloctypes{$type}'";
317
318        # Delete old freeblocks entry
319        $sth = $dbh->prepare("delete from freeblocks where cidr='$alloc_from'");
320        $sth->execute();
321
322        # now we have to do some magic for routing blocks
323        if ($type eq 'rm') {
324
325          # Insert the new freeblocks entries
326          # Note that non-routed blocks are assigned to <NULL>
327          # and use the default value for the routed column ('n')
328          $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city)".
329                " values (?, ?, '<NULL>')");
330          foreach my $block (@newfreeblocks) {
331            $sth->execute("$block", $block->masklen);
332          }
333
334          # Insert the entry in the routed table
335          $sth = $dbh->prepare("insert into routed (cidr,maskbits,city)".
336                " values ('$cidr',".$cidr->masklen.",'$city')");
337          $sth->execute;
338          # Insert the (almost) same entry in the freeblocks table
339          $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
340                " values ('$cidr',".$cidr->masklen.",'$city','y')");
341          $sth->execute;
342
343        } else { # done with alloctype == rm
344
345          # Insert the new freeblocks entries
346          # Along with some more HairyPerl(TM) in case we're inserting a
347          # subblock (.r) allocation
348          $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
349                " values (?, ?, (select city from routed where cidr >>= '$cidr'),'".
350                (($type =~ /^(.)r$/) ? "$1" : 'y')."')");
351          foreach my $block (@newfreeblocks) {
352            $sth->execute("$block", $block->masklen);
353          }
354          # Special-case for reserve/"container" blocks - generate
355          # the "extra" freeblocks entry for the container
356          if ($type =~ /^(.)c$/) {
357            $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
358                " values ('$cidr',".$cidr->masklen.",'$city','$1')");
359            $sth->execute;
360          }
361          # Insert the allocations entry
362          $sth = $dbh->prepare("insert into allocations (cidr,custid,type,city,".
363                "description,notes,maskbits,circuitid,privdata)".
364                " values ('$cidr','$custid','$type','$city','$desc','$notes',".
365                $cidr->masklen.",'$circid','$privdata')");
366          $sth->execute;
367
368          # And initialize the pool, if necessary
369          # PPPoE pools (currently dialup, DSL, and WiFi) get all IPs made available
370          # "DHCP" or "real-subnet" pools have the net, gw, and bcast IPs removed.
371          if ($type =~ /^.p$/) {
372            $msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
373            my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"all");
374            die $rmsg if $code eq 'FAIL';
375          } elsif ($type =~ /^.d$/) {
376            $msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
377            my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"normal");
378            die $rmsg if $code eq 'FAIL';
379          }
380
381        } # done with netblock alloctype != rm
382
383        $dbh->commit;
384      }; # end eval
385      if ($@) {
386        $msg .= ": ".$@;
387        eval { $dbh->rollback; };
388        return ('FAIL',$msg);
389      } else {
390        return ('OK',"OK");
391      }
392
393    } # end fullcidr != alloc_from
394
395  } # end static-IP vs netblock allocation
396
397} # end allocateBlock()
398
399
400## IPDB::initPool()
401# Initializes a pool
402# Requires a database handle, the pool CIDR, type, city, and a parameter
403# indicating whether the pool should allow allocation of literally every
404# IP, or if it should reserve network/gateway/broadcast IPs
405# Note that this is NOT done in a transaction, that's why it's a private
406# function and should ONLY EVER get called from allocateBlock()
407sub initPool {
408  my ($dbh,undef,$type,$city,$class) = @_;
409  my $pool = new NetAddr::IP $_[1];
410
411##fixme Need to just replace 2nd char of type with i rather than capturing 1st char of type
412  $type =~ s/[pd]$/i/;
413  my $sth;
414  my $msg;
415
416  # Trap errors so we can pass them back to the caller.  Even if the
417  # caller is only ever supposed to be local, and therefore already
418  # trapping errors.  >:(
419  local $dbh->{AutoCommit} = 0; # These need to be local so we don't
420  local $dbh->{RaiseError} = 1; # step on our toes by accident.
421
422  eval {
423    # have to insert all pool IPs into poolips table as "unallocated".
424    $sth = $dbh->prepare("insert into poolips (pool,ip,custid,city,type)".
425        " values ('$pool', ?, '6750400', '$city', '$type')");
426    my @poolip_list = $pool->hostenum;
427    if ($class eq 'all') { # (DSL-ish block - *all* IPs available
428      if ($pool->addr !~ /\.0$/) {      # .0 causes weirdness.
429        $sth->execute($pool->addr);
430      }
431      for (my $i=0; $i<=$#poolip_list; $i++) {
432        $sth->execute($poolip_list[$i]->addr);
433      }
434      $pool--;
435      if ($pool->addr !~ /\.255$/) {    # .255 can cause weirdness.
436        $sth->execute($pool->addr);
437      }
438    } else { # (real netblock)
439      for (my $i=1; $i<=$#poolip_list; $i++) {
440        $sth->execute($poolip_list[$i]->addr);
441      }
442    }
443  };
444  if ($@) {
445    $msg = "'".$sth->errstr."'";
446    eval { $dbh->rollback; };
447    return ('FAIL',$msg);
448  } else {
449    return ('OK',"OK");
450  }
451} # end initPool()
452
453
454## IPDB::deleteBlock()
455# Removes an allocation from the database, including deleting IPs
456# from poolips and recombining entries in freeblocks if possible
457# Also handles "deleting" a static IP allocation, and removal of a master
458# Requires a database handle, the block to delete, and the type of block
459sub deleteBlock {
460  my ($dbh,undef,$type) = @_;
461  my $cidr = new NetAddr::IP $_[1];
462
463  my $sth;
464
465  # To contain the error message, if any.
466  my $msg = "Unknown error deallocating $type $cidr";
467  # Enable transactions and exception-on-errors... but only for this sub
468  local $dbh->{AutoCommit} = 0;
469  local $dbh->{RaiseError} = 1;
470
471  # First case.  The "block" is a static IP
472  # Note that we still need some additional code in the odd case
473  # of a netblock-aligned contiguous group of static IPs
474  if ($type =~ /^.i$/) {
475
476    eval {
477      $msg = "Unable to deallocate $disp_alloctypes{$type} $cidr";
478      $sth = $dbh->prepare("update poolips set custid='6750400',available='y',".
479        "city=(select city from allocations where cidr >>= '$cidr'),".
480        "description='',notes='',circuitid='' where ip='$cidr'");
481      $sth->execute;
482      $dbh->commit;
483    };
484    if ($@) {
485      eval { $dbh->rollback; };
486      return ('FAIL',$msg);
487    } else {
488      return ('OK',"OK");
489    }
490
491  } elsif ($type eq 'mm') { # end alloctype =~ /.i/
492
493    $msg = "Unable to delete master block $cidr";
494    eval {
495      $sth = $dbh->prepare("delete from masterblocks where cidr='$cidr'");
496      $sth->execute;
497      $sth = $dbh->prepare("delete from freeblocks where cidr='$cidr'");
498      $sth->execute;
499      $dbh->commit;
500    };
501    if ($@) {
502      eval { $dbh->rollback; };
503      return ('FAIL', $msg);
504    } else {
505      return ('OK',"OK");
506    }
507
508  } else { # end alloctype master block case
509
510    ## This is a big block; but it HAS to be done in a chunk.  Any removal
511    ## of a netblock allocation may result in a larger chunk of free
512    ## contiguous IP space - which may in turn be combined into a single
513    ## netblock rather than a number of smaller netblocks.
514
515    eval {
516
517      if ($type eq 'rm') {
518        $msg = "Unable to remove routing allocation $cidr";
519        $sth = $dbh->prepare("delete from routed where cidr='$cidr'");
520        $sth->execute;
521        # Make sure block getting deleted is properly accounted for.
522        $sth = $dbh->prepare("update freeblocks set routed='n',city='<NULL>'".
523                " where cidr='$cidr'");
524        $sth->execute;
525        # Set up query to start compacting free blocks.
526        $sth = $dbh->prepare("select cidr from freeblocks where ".
527                "maskbits<=".$cidr->masklen." and routed='n' order by maskbits desc");
528
529      } else { # end alloctype routing case
530
531        # Delete all allocations within the block being deleted.  This is
532        # deliberate and correct, and removes the need to special-case
533        # removal of "container" blocks.
534        $sth = $dbh->prepare("delete from allocations where cidr <<='$cidr'");
535        $sth->execute;
536
537        # Special case - delete pool IPs
538        if ($type =~ /^.[pd]$/) {
539          # We have to delete the IPs from the pool listing.
540          $sth = $dbh->prepare("delete from poolips where pool='$cidr'");
541          $sth->execute;
542        }
543
544        # Set up query for compacting free blocks.
545        $sth = $dbh->prepare("select cidr from freeblocks where cidr <<= ".
546                "(select cidr from routed where cidr >>= '$cidr') ".
547                " and maskbits<=".$cidr->masklen.
548                " and routed='".(($type =~ /^(.)r$/) ? '$1' : 'y').
549                "' order by maskbits desc");
550
551      } # end alloctype general case
552
553##TEMP
554## Temporary wrapper to "properly" deallocate sIP PPPoE/DSL "netblocks" in 209.91.185.0/24
555## Note that we should really general-case this.
556my $staticpool = new NetAddr::IP "209.91.185.0/24";
557##TEMP
558if ($cidr->within($staticpool)) {
559##TEMP
560  # We've already deleted the block, now we have to stuff its IPs into the pool.
561  $sth = $dbh->prepare("insert into poolips values ('209.91.185.0/24',?,'6750400','Sudbury','d','y','','','')");
562  $sth->execute($cidr->addr);
563  foreach my $ip ($cidr->hostenum) {
564    $sth->execute("$ip");
565  }
566  $cidr--;
567  $sth->execute($cidr->addr);
568
569##TEMP
570} else {
571##TEMP
572
573      # Now we look for larger-or-equal-sized free blocks in the same master (routed)
574      # (super)block. If there aren't any, we can't combine blocks anyway.  If there
575      # are, we check to see if we can combine blocks.
576      # Execute the statement prepared in the if-else above.
577
578      $sth->execute;
579
580# NetAddr::IP->compact() attempts to produce the smallest inclusive block
581# from the caller and the passed terms.
582# EG:  if you call $cidr->compact($ip1,$ip2,$ip3) when $cidr, $ip1, $ip2,
583#       and $ip3 are consecutive /27's starting on .0 (.0-.31, .32-.63,
584#       .64-.95, and .96-.128), you will get an array containing a single
585#       /25 as element 0 (.0-.127).  Order is not important;  you could have
586#       $cidr=.32/27, $ip1=.96/27, $ip2=.0/27, and $ip3=.64/27.
587
588      my (@together, @combinelist);
589      my $i=0;
590      while (my @data = $sth->fetchrow_array) {
591        my $testIP = new NetAddr::IP $data[0];
592        @together = $testIP->compact($cidr);
593        my $num = @together;
594        if ($num == 1) {
595          $cidr = $together[0];
596          $combinelist[$i++] = $testIP;
597        }
598      }
599
600      # Clear old freeblocks entries - if any.  They should all be within
601      # the $cidr determined above.
602      $sth = $dbh->prepare("delete from freeblocks where cidr <<='$cidr'");
603      $sth->execute;
604
605      # insert "new" freeblocks entry
606      if ($type eq 'rm') {
607        $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city)".
608                " values ('$cidr',".$cidr->masklen.",'<NULL>')");
609      } else {
610        $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
611                " values ('$cidr',".$cidr->masklen.
612                ",(select city from routed where cidr >>= '$cidr'),'".
613                (($type =~ /^(.)r$/) ? "$1" : 'y')."')");
614      }
615      $sth->execute;
616
617##TEMP
618}
619##TEMP
620
621      # If we got here, we've succeeded.  Whew!
622      $dbh->commit;
623    }; # end eval
624    if ($@) {
625      eval { $dbh->rollback; };
626      return ('FAIL', $msg);
627    } else {
628      return ('OK',"OK");
629    }
630
631  } # end alloctype != netblock
632
633} # end deleteBlock()
634
635
636## IPDB::mailNotify()
637# Sends notification mail to recipients regarding an IPDB operation
638sub mailNotify ($$$) {
639  my ($recip,$subj,$message) = @_;
640  my $mailer = Net::SMTP->new("smtp.example.com", Hello => "ipdb.example.com");
641
642  $mailer->mail('ipdb@example.com');
643  $mailer->to($recip);
644  $mailer->data("From: \"IP Database\" <ipdb\@example.com>\n",
645        "To: $recip\n",
646        "Date: ".strftime("%a, %d %b %Y %H:%M:%S %z",localtime)."\n",
647        "Subject: {IPDB} $subj\n",
648        "X-Mailer: IPDB Notify v".sprintf("%.1d",$IPDB::VERSION)."\n",
649        "Organization: Example Corp\n",
650        "\n$message\n");
651  $mailer->quit;
652}
653
654# Indicates module loaded OK.  Required by Perl.
6551;
Note: See TracBrowser for help on using the repository browser.