source: branches/htmlform/cgi-bin/extras/db2rwhois.pl@ 870

#!/usr/bin/perl
# -T
# ipdb/cgi-bin/extras/db2rwhois.pl
# Pull data from ipdb and mangle it into RWHOIS
# Initial version 03/26/2004 kdeugau against IPDB v1
###
# Revision info
# $Date: 2010-08-12 16:00:28 +0000 (Thu, 12 Aug 2010) $
# SVN revision $Rev: 468 $
# Last update by $Author: kdeugau $
###
# Copyright (C) 2004-2010 - Kris Deugau

use strict;
use warnings;
use DBI;
use NetAddr::IP;
use File::Path 'rmtree';
use POSIX qw(strftime);

# don't remove!  required for GNU/FHS-ish install from tarball
##uselib##

use MyIPDB;

#$ENV{"PATH"} = "/bin;/usr/bin";

my @autharea;
my $authrw;
# Use the template file to allow us to keep persistent nodes aside from netblock data
open AUTHTEMPLATE, "<$IPDB::rwhoisDataPath/rwhoisd.auth_template";
my $template_persist;
while (<AUTHTEMPLATE>) {
  next if /^##/;
  $template_persist = 1 if /^[a-z]/i;
  $autharea[0] .= $_;
}

my ($dbh,$msg) = connectDB_My;

# For WHOIS purposes this may not be very useful.  YMMV, we'll see.
#initIPDBGlobals($dbh);

my @masterblocks;
my %netnameprefix;

# Get the list of live directories for potential deletion
opendir RWHOISROOT, $IPDB::rwhoisDataPath;
my %rwhoisdirs;
foreach (readdir RWHOISROOT) {
  $rwhoisdirs{$_} = 1 if /^net-/;
}
closedir RWHOISROOT;

# prefetch alloctype data
my $sth = $dbh->prepare("select type,def_custid,arin_netname from alloctypes");
$sth->execute;
while (my @data = $sth->fetchrow_array) {
  $netnameprefix{$data[0]} = $data[2];
}

# Get the list of masters to export
my $msth = $dbh->prepare("select cidr,ctime,mtime from masterblocks where rwhois='y'");
$msth->execute;

# Prepare to select subblocks for each master
# Make sure to remove the private netblocks from this,
# no use or point in broadcasting our use of them.
# Also remove the details of our "reserved CORE/WAN" blocks;  they're not critical.
my $ssth = $dbh->prepare("select cidr,custid,type,city,description,createstamp,modifystamp,swip ".
        "from allocations where ".
        "not (cidr <<= '192.168.0.0/16') and ".
        "not (cidr <<= '172.16.0.0/12') and ".
        "not (cidr <<= '10.0.0.0/8') and ".
        "not (type = 'wr') and ".
        "((masklen(cidr) <=30 and family(cidr)=4) or (masklen(cidr) <=56 and family(cidr)=6)) and ".
        "cidr <<= ?");

# Customer data, for those rare blocks we really need to delegate.
my $custsth = $dbh->prepare("select name,street,city,province,country,pocode,phone,tech_handle,special ".
        "from customers where custid=?");

# Fill in data about our master blocks as allocated from ARIN
# We open separate files for each of these as appropriate.
# Changes in master blocks are treated as complete new masters - since we're exporting
# all data every time, this isn't so terrible as it might seem.
my $i=0;
while (my @data = $msth->fetchrow_array()) {

  $masterblocks[$i] = new NetAddr::IP $data[0];
  my ($ctime,undef) = split /\s/, $data[1];
  my ($mtime,undef) = split /\s/, $data[2];

  print "$masterblocks[$i] $ctime $mtime\n";

  my $date = strftime("%Y-%m-%d", localtime);

  my $rwnet = "net-".$masterblocks[$i]->addr."-".$masterblocks[$i]->masklen;

  # unflag the directory for deletion.  Whee!  Roundabout!
  delete $rwhoisdirs{$rwnet};

# Hokay.  Gonna do checks *here* to see if we need to create new master trees
  my $netdatadir = "$IPDB::rwhoisDataPath/$rwnet";
  if (! -e $netdatadir) {
    print " New master $masterblocks[$i]!\n";
    print "  Creating directories...\n";
    mkdir $netdatadir;
    mkdir "$netdatadir/attribute_defs";
    mkdir "$netdatadir/data";
    mkdir "$netdatadir/data/network";
    mkdir "$netdatadir/data/org";
    mkdir "$netdatadir/data/referral";

    my $serial = strftime("%Y%m%d%H%M%S000", localtime);

##fixme: SOA should be different every time data changes, therefore need to rewrite this ~~ every export :(
    print "  Creating SOA...\n";
    open SOAFILE, ">$netdatadir/soa";
    print SOAFILE qq(Serial-Number: $serial
Refresh-Interval: 3600
Increment-Interval: 1800
Retry-Interval: 1800
Time-To-Live: 86400
Primary-Server: rwhois.$IPDB::domain:4321
Hostmaster: $IPDB::hostmaster
);
    close SOAFILE;

    print "  Creating Schema...\n";
    open SCHEMAFILE, ">$netdatadir/schema";
    print SCHEMAFILE qq(name: network
attributedef: $rwnet/attribute_defs/network.tmpl
dbdir: $rwnet/data/network
Schema-Version: $serial
---
name: organization
attributedef: $rwnet/attribute_defs/org.tmpl
dbdir: $rwnet/data/org
description: Organization object
Schema-Version: $serial
---
name: referral
attributedef:$rwnet/attribute_defs/referral.tmpl
dbdir:$rwnet/data/referral
Schema-Version: $serial
);
    close SCHEMAFILE;

    print "  Copying template files...\n";
##fixme: find a way to do this without a shell (or functional equivalent)
    qx { /bin/cp $IPDB::rwhoisDataPath/skel/attribute_defs/* $netdatadir/attribute_defs/ };

##fixme: not sure if this is even necessary, since it's not referenced anywhere I can recall...
    print "  Creating org data...\n";
    open ORGDATAFILE, ">$netdatadir/data/org/ourorg.txt";
    print ORGDATAFILE qq(ID: NETBLK-ISP.$masterblocks[$i]
Auth-Area: $masterblocks[$i]
Org-Name: $IPDB::org_name
Street-Address: $IPDB::org_street
City: $IPDB::org_city
State: $IPDB::org_prov_state
Postal-Code: $IPDB::org_pocode
Country-Code: $IPDB::org_country
Phone: $IPDB::org_phone
Created: 20040308
Updated: 20040308
);
    close ORGDATAFILE;

    # Generate auth_area record, and add it to the array.
    $authrw = 1;        # Flag for rewrite and daemon reload/restart

  } # new master

  # do this for all masters, so that we can use this array to export the data
  # to rwhoisd.auth_area later if we need to
  push @autharea, qq(type:master
name:$masterblocks[$i]
data-dir: $rwnet/data
schema-file: $rwnet/schema
soa-file: $rwnet/soa
);

  # Recreate the net-nnn.nnn.nnn.nnn-nn.txt data file
  my $masterfilename = "$rwnet/data/network/".$masterblocks[$i]->addr."-".$masterblocks[$i]->masklen.".txt";

  open MASTERFILE,">$IPDB::rwhoisDataPath/$masterfilename";

  print MASTERFILE "ID: NETBLK-ISP.$masterblocks[$i]\n".
        "Auth-Area: $masterblocks[$i]\n".
        "Network-Name: ISP-".$masterblocks[$i]->network."\n".
        "IP-Network: $masterblocks[$i]\n".
        "IP-Network-Block: ".$masterblocks[$i]->range."\n".
        "Org-Name: $IPDB::org_name\n".
        "Street-Address: $IPDB::org_street\n".
        "City: $IPDB::org_city\n".
        "StateProv: $IPDB::org_prov_state\n".
        "Postal-Code: $IPDB::org_pocode\n".
        "Country-Code: $IPDB::org_country\n".
        "Tech-Contact: $IPDB::org_techhandle\n".
        "Created: $ctime\n".
        "Updated: $mtime\n".
        "Updated-By: $IPDB::org_email\n";

  # And now the subblocks
  $ssth->execute("$masterblocks[$i]");
  while (my ($cidr, $custid, $type, $city, $desc, $ctime, $mtime, $swip) = $ssth->fetchrow_array) {

# We get master block info from @masterblocks.
 # ID: NETBLK-ISP.10.0.0.0/8
 # Auth-Area: 10.0.0.0/8
 # Network-Name: ISP-10.0.2.144
 # IP-Network: 10.0.2.144.144/29
 # IP-Network-Block: 10.0.2.144 - 10.0.2.151
 # Organization: WidgetCorp
 # Tech-Contact: bob@widgetcorp.com
 # Admin-Contact: ISP-ARIN-HANDLE
 # Created: 20040314
 # Updated: 20040314
 # Updated-By: noc@example.com

    # Get the "full" network number
    my $net = new NetAddr::IP $cidr;

# Assumptions:  All data in ipdb is public
# If not, we need another field to indicate "public/private".

# cidr custid type city description notes maskbits

# Fill in a generic entry for nameless allocations
if ($desc =~ /^\s*$/) { $desc = $IPDB::org_name; }

    # Fix up datestamps.  We don't *really* need sub-microsecond resolution on our exports...
    ($ctime) = ($ctime =~ /^(\d+-\d+-\d+)\s+/);
    ($mtime) = ($mtime =~ /^(\d+-\d+-\d+)\s+/);

# Notes:
# Network-name should contain some component of "description"
# Cust address/contact data should be included;  NB, no phone for ARIN!
#  network:ID: NET-WIDGET
#  network:Network-Name: WIDGET                 [IPDB description, sort of]
#  network:IP-Network: 10.1.1.0/24
#  network:Org-Name: Widget Corp                [Cust name;  from billing?]
#  network:Street-Address: 211 Oak Drive        [May need more than one line, OR...]
#  network:City: Pineville                      [...this line...]
#  network:StateProv: WI                        [...and this line...]
#  network:Postal-Code: 48888                   [...and this line]
#  network:Country-Code: US
#  network:Tech-Contact: BZ142-MYRWHOIS         [ARIN handle?]
#  network:Updated: 19991221                    [timestamp from db]
#  network:Updated-By: jo@myrwhois.net          [noc@example, since that's our POC for IP netspace issues]
#  network:Class-Name:network                   [Provided by rWHOIS protocol]

    my $netname = $netnameprefix{$type};

    if ($swip eq 'n') {
      print MASTERFILE "---\nID: NETBLK-ISP.$masterblocks[$i]\n".
        "Auth-Area: $masterblocks[$i]\n".
        "Network-Name: $netname-".$net->network."\n".
        "IP-Network: $net\n".
        "IP-Network-Block: ".$net->range."\n".
        "Org-Name: $IPDB::org_name\n".
        "Street-Address: $IPDB::org_street\n".
        "City: $IPDB::org_city\n".
        "StateProv: $IPDB::org_prov_state\n".
        "Postal-Code: $IPDB::org_pocode\n".
        "Country-Code: $IPDB::org_country\n".
        "Tech-Contact: $IPDB::org_techhandle\n".
        "Created: $ctime\n".
        "Updated: $mtime\n".
        "Updated-By: $IPDB::org_email\n";
    } else {
      $custsth->execute($custid);
      my ($name, $street, $city, $prov, $country, $pocode, $phone, $tech, $special) = $custsth->fetchrow_array;
      $custsth->finish;
      if ($special && $special =~ /NetName/ && $special =~ /$cidr/) {
        ($netname) = ($special =~ /NetName$cidr: ([A-Z0-9_-]+)/);
      } else {
        $netname .= "-".$net->network;
      }
      print MASTERFILE "---\nID: NETBLK-ISP.$masterblocks[$i]\n".
        "Auth-Area: $masterblocks[$i]\n".
        "Network-Name: $netname\n".
        "IP-Network: $net\n".
        "IP-Network-Block: ".$net->range."\n".
        "Org-Name: ".($name ? $name : $IPDB::org_name)."\n".
        "Street-Address: ".($street ? $street : $IPDB::org_street)."\n".
        "City: ".($city ? $city : $IPDB::org_city)."\n".
        "StateProv: ".($prov ? $prov : $IPDB::org_prov_state)."\n".
        "Postal-Code: ".($pocode ? $pocode : $IPDB::org_pocode)."\n".
        "Country-Code: ".($country ? $country : $IPDB::org_country)."\n".
        "Tech-Contact: ".($tech ? $tech : $IPDB::org_techhandle)."\n".
        "Created: $ctime\n".
        "Updated: $mtime\n".
        "Updated-By: $IPDB::org_email\n";
    } # swip

  } # while $ssth->fetchrow_array()

  close MASTERFILE;

  $i++;
} # while $msth->fetchrow_array()

# Now we see if there's obsolete netdata directories to be deleted,
# and therefore an auth-area file to regenerate
foreach my $netdir (keys %rwhoisdirs) {
  print "deleting obsolete directory $netdir...\n";
  rmtree ( "$IPDB::rwhoisDataPath/$netdir", { verbose => 1, error => \my $errlist } );
  for my $diag (@$errlist) {
    my ($file, $message) = each %$diag;
    if ($file eq '') {
      print "general error: $message\n";
    }
  }
  $authrw = 1;  # there's probably a more efficient place to put this.  Feh.
}

# Regenerate rwhoisd.auth_area if needed
if ($authrw) {
  print "Regenerating auth_area\n";
  open RWHOISDAUTH, ">$IPDB::rwhoisDataPath/rwhoisd.auth_area";
  print RWHOISDAUTH "# WARNING: This file is autogenerated!  Any static nodes should\n".
                "# be entered in /etc/rwhoisd/rwhoisd.auth_template\n";
  if ($template_persist) {
    print RWHOISDAUTH shift @autharea;
    print RWHOISDAUTH "---\n";
  }
  # feh.  we need to know when we're at the end of the loop, because then
  # we DON'T want to write the separator...
  for (;@autharea;) {   # my head hurts.
    print RWHOISDAUTH shift @autharea;
    print RWHOISDAUTH "---\n" if @autharea;
  }
  close RWHOISDAUTH;

  # restart/reload rwhoisd
  if (-e "$IPDB::rwhoisDataPath/rwhoisd.pid") { # no pidfile, no restart.
    print "Restarting rwhoisd\n";
    open PIDFILE, "<$IPDB::rwhoisDataPath/rwhoisd.pid";
    my ($rwpid) = (<PIDFILE> =~ /^(\d+)/);
    close PIDFILE;
    kill 'HUP', $rwpid;
  }
}

# and finally
$dbh->disconnect;