[8] | 1 | # ipdb/cgi-bin/IPDB.pm
|
---|
[71] | 2 | # Contains functions for IPDB - database access, subnet mangling, block allocation, etc
|
---|
[8] | 3 | ###
|
---|
| 4 | # SVN revision info
|
---|
| 5 | # $Date: 2004-11-19 19:44:18 +0000 (Fri, 19 Nov 2004) $
|
---|
| 6 | # SVN revision $Rev: 76 $
|
---|
| 7 | # Last update by $Author: kdeugau $
|
---|
| 8 | ###
|
---|
[71] | 9 | # Copyright (C) 2004 - Kris Deugau
|
---|
[8] | 10 |
|
---|
[4] | 11 | package IPDB;
|
---|
| 12 |
|
---|
| 13 | use strict;
|
---|
| 14 | use warnings;
|
---|
| 15 | use Exporter;
|
---|
[71] | 16 | use Net::SMTP;
|
---|
| 17 | use POSIX;
|
---|
[4] | 18 | use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
|
---|
| 19 |
|
---|
| 20 | $VERSION = 1.0;
|
---|
| 21 | @ISA = qw(Exporter);
|
---|
[71] | 22 | @EXPORT_OK = qw(&connectDB &checkDBSanity &allocateBlock &mailNotify);
|
---|
[4] | 23 |
|
---|
| 24 | @EXPORT = (); # Export nothing by default.
|
---|
[71] | 25 | %EXPORT_TAGS = ( ALL => [qw( &connectDB &checkDBSanity &allocateBlock &mailNotify)]
|
---|
[4] | 26 | );
|
---|
| 27 |
|
---|
[71] | 28 |
|
---|
[4] | 29 | # Creates connection to IPDB.
|
---|
| 30 | # Default is a PostgreSQL db; could be any DBMS with the
|
---|
| 31 | # right changes. MySQL in comments. Note that some DBMS's don't
|
---|
| 32 | # support transactions, this is a Bad Thing!
|
---|
| 33 | # Returns a handle to the db.
|
---|
| 34 | sub connectDB {
|
---|
| 35 | my $dbh;
|
---|
| 36 | my $DSN = "DBI:Pg:dbname=ipdb";
|
---|
| 37 | my $user = 'ipdb';
|
---|
| 38 | my $pw = 'ipdbpwd';
|
---|
| 39 |
|
---|
| 40 | # Note that we want to autocommit by default, and we will turn it off locally as necessary.
|
---|
| 41 | $dbh = DBI->connect($DSN, $user, $pw, { AutoCommit => 1 } )
|
---|
| 42 | or return undef if(!$dbh);
|
---|
| 43 |
|
---|
| 44 | return $dbh;
|
---|
| 45 | } # end connectDB
|
---|
| 46 |
|
---|
| 47 | # Quick check to see if the db is responding. A full integrity
|
---|
| 48 | # check will have to be a separate tool to walk the IP allocation trees.
|
---|
| 49 | sub checkDBSanity {
|
---|
| 50 | my $dbh = connectDB();
|
---|
| 51 |
|
---|
| 52 | if (!$dbh) {
|
---|
[16] | 53 | print "Cannot connect to the database!";
|
---|
[4] | 54 | } else {
|
---|
| 55 | # it connects, try a stmt.
|
---|
| 56 | my $sth = $dbh->prepare('select cidr from masterblocks');
|
---|
| 57 | my $err = $sth->execute();
|
---|
| 58 |
|
---|
| 59 | if ($sth->fetchrow()) {
|
---|
| 60 | # all is well.
|
---|
| 61 | return 1;
|
---|
| 62 | } else {
|
---|
[16] | 63 | print "Connected to the database, but could not execute test statement. ".$sth->errstr();
|
---|
[4] | 64 | }
|
---|
| 65 | }
|
---|
| 66 | # Clean up after ourselves.
|
---|
| 67 | $dbh->disconnect;
|
---|
| 68 | } # end checkDBSanity
|
---|
| 69 |
|
---|
[71] | 70 |
|
---|
| 71 | # allocateBlock()
|
---|
| 72 | # Does all of the magic of actually allocating a netblock
|
---|
| 73 | sub allocateBlock($) {
|
---|
| 74 | }
|
---|
| 75 |
|
---|
| 76 |
|
---|
| 77 | # mailNotify()
|
---|
| 78 | # Sends notification mail to recipients regarding an IPDB operation
|
---|
| 79 | sub mailNotify ($$$) {
|
---|
| 80 | my ($recip,$subj,$message) = @_;
|
---|
| 81 | my $mailer = Net::SMTP->new("smtp.example.com", Hello => "ipdb.example.com");
|
---|
| 82 |
|
---|
| 83 | $mailer->mail('ipdb@example.com');
|
---|
| 84 | $mailer->to($recip);
|
---|
| 85 | $mailer->data("From: \"IP Database\" <ipdb\@example.com>\n",
|
---|
[76] | 86 | "To: $recip\n",
|
---|
[71] | 87 | "Date: ".strftime("%a, %d %b %Y %H:%M:%S %z",localtime)."\n",
|
---|
| 88 | "Subject: {IPDB} $subj\n",
|
---|
| 89 | "X-Mailer: IPDB Notify v".sprintf("%.1d",$IPDB::VERSION)."\n",
|
---|
| 90 | "Organization: Example Corp\n",
|
---|
| 91 | "\n$message\n");
|
---|
| 92 | $mailer->quit;
|
---|
| 93 | }
|
---|
| 94 |
|
---|
[4] | 95 | # Indicates module loaded OK. Required by Perl.
|
---|
| 96 | 1;
|
---|