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

# ipdb/cgi-bin/IPDB.pm
# Contains functions for IPDB - database access, subnet mangling, block allocation, etc
###
# SVN revision info
# $Date: 2004-11-19 19:44:18 +0000 (Fri, 19 Nov 2004) $
# SVN revision $Rev: 76 $
# Last update by $Author: kdeugau $
###
# Copyright (C) 2004 - Kris Deugau

package IPDB;

use strict;
use warnings;
use Exporter;
use Net::SMTP;
use POSIX;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

$VERSION        = 1.0;
@ISA            = qw(Exporter);
@EXPORT_OK      = qw(&connectDB &checkDBSanity &allocateBlock &mailNotify);

@EXPORT         = (); # Export nothing by default.
%EXPORT_TAGS    = ( ALL => [qw( &connectDB &checkDBSanity &allocateBlock &mailNotify)]
                  );


# Creates connection to IPDB.
# Default is a PostgreSQL db;  could be any DBMS with the
# right changes.  MySQL in comments.  Note that some DBMS's don't
# support transactions, this is a Bad Thing!
# Returns a handle to the db.
sub connectDB {
  my $dbh;
  my $DSN = "DBI:Pg:dbname=ipdb";
  my $user = 'ipdb';
  my $pw   = 'ipdbpwd';

# Note that we want to autocommit by default, and we will turn it off locally as necessary.
  $dbh = DBI->connect($DSN, $user, $pw, { AutoCommit => 1 } )
    or return undef if(!$dbh);

  return $dbh;
} # end connectDB

# Quick check to see if the db is responding.  A full integrity
# check will have to be a separate tool to walk the IP allocation trees.
sub checkDBSanity {
  my $dbh = connectDB();

  if (!$dbh) {
    print "Cannot connect to the database!";
  } else {
    # it connects, try a stmt.
    my $sth = $dbh->prepare('select cidr from masterblocks');
    my $err = $sth->execute();

    if ($sth->fetchrow()) {
      # all is well.
      return 1;
    } else {
      print "Connected to the database, but could not execute test statement.  ".$sth->errstr();
    }
  }
  # Clean up after ourselves.
  $dbh->disconnect;
} # end checkDBSanity


# allocateBlock()
# Does all of the magic of actually allocating a netblock
sub allocateBlock($) {
}


# mailNotify()
# Sends notification mail to recipients regarding an IPDB operation
sub mailNotify ($$$) {
  my ($recip,$subj,$message) = @_;
  my $mailer = Net::SMTP->new("smtp.example.com", Hello => "ipdb.example.com");

  $mailer->mail('ipdb@example.com');
  $mailer->to($recip);
  $mailer->data("From: \"IP Database\" <ipdb\@example.com>\n",
        "To: $recip\n",
        "Date: ".strftime("%a, %d %b %Y %H:%M:%S %z",localtime)."\n",
        "Subject: {IPDB} $subj\n",
        "X-Mailer: IPDB Notify v".sprintf("%.1d",$IPDB::VERSION)."\n",
        "Organization: Example Corp\n",
        "\n$message\n");
  $mailer->quit;
}

# Indicates module loaded OK.  Required by Perl.
1;