#!/usr/local/bin/perl
use Config;
use File::Basename qw(basename dirname);
use Cwd;
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
# have to mention them as if they were shell variables, not
# %Config entries. Thus you write
# $startperl
# to ensure Configure will look for $Config{startperl}.
# Wanted: $archlibexp
# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
$origdir = cwd;
chdir dirname($0);
$file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';
$newname = ($ARGV[0]) ? $ARGV[0] : $file;
# Check, should it be private version
my $private = (-f '/ncc/registries/zz.example') ? 1 : 0;
open OUT,">$file" or die "Can't create $file: $!";
print "Extracting $file (with variable substitutions)\n";
# In this section, perl variables will be expanded during extraction.
# You can use $Config{...} to use Configure variables.
# Put into the file perl executable path
print OUT $Config{startperl};
# For public version add blib to included paths
print OUT " -Iblib/lib" unless($private);
print OUT "\n";
print OUT <<"!GROK!THIS!";
eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
if \$running_under_some_shell;
# Copyright (c) 1998,1999,2000,2001,2002 RIPE NCC
#
# All Rights Reserved
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies and that
# both that copyright notice and this permission notice appear in
# supporting documentation, and that the name of the author not be
# used in advertising or publicity pertaining to distribution of the
# software without specific, written prior permission.
#
# THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL
# AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
# DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
# AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#------------------------------------------------------------------------------
# Module Header
# Filename : asused.pl
# Purpose : Check Allocation, Assignments, in reg and RIPE Whois DB
# functional replacement for other existing tools
# Author : Antony Antony <antony\@ripe.net>
# Timur Bakeyev <timur\@ripe.net>
# Date : 199901, 200001
# Description :
# Language Version : Perl 5.00404, 5.00502 & 5.6.0
# OSs Tested : BSDI 3.1
# Command Line : See asused3 --help
# Input Files : reg files red using perl module regread
# Output Files : -
# External Programs : -
# Comments : access to RIPE Whois database 2.1 or compaitable
#------------------------------------------------------------------------------
use strict;
# Global Variables
use vars qw(\$VERSION \$DEBUG \$PRIVATE);
# Command line options
use vars qw(%opt);
# Is this RIPE NCC private version
\$PRIVATE = $private;
!GROK!THIS!
# In the following, perl variables are not expanded during extraction.
print OUT <<'!NO!SUBS!';
# Program version
$VERSION = '3.72';
# Give extra debugging information
$DEBUG = 0;
use Getopt::Long;
use Carp;
# RIPE NCC Site Modules
use ipv4pack; # ip address manipulation
# connect to RIPE whois server
use RipeWhois;
# get inetnum using -F
use Net::RIPEWhois::in qw($INVALID_DATE $MULTIPLE_INETNUM);
# module which does most of the asused.
# this script is calls these modules and print output
use Reg::Asused;
# This modules are not used in public version
if($PRIVATE) {
# Use private modules
# read reg data
eval('use regread;');
die("Module: $@") if($@);
# to lookup registry name from ip range.
eval('use ip2reg;');
die("Module: $@") if($@);
# checking Approval of read reg data for asused
eval('use Reg::Approved;');
die("Module: $@") if($@);
# For network approval
eval('use Reg::ApproveNa qw($NO_REGID_FOUND $REGID_MISMATCH);');
die("Module: $@") if($@);
}
# Location of the configuration files
my $configFile = 'asused.conf';
# That should be in $HOME
my $rcFile = '.asusedrc';
my $NO_ALLOC_INDB = 201; # no allocation found in DB
my $NO_ALLOC_INREG = 217; # no allocation to be checked by asused
my $NO_REGID_FOUND = 218;
my $REGID_MISMATCH = 219;
# MAIN
# Get allocated prefixes and initialize internal data
my $prefix = initAsused(\%opt);
# This is to validate a network or inetnum with --valid
if($opt{'valid'}) {
# Do the network approval
my $whois = new RipeWhois('Host' => $opt{'host'},
'Port' => $opt{'port'},
'KeepAlive' => 1,
'FormatMode' => 1);
$whois || FatalError("Failed to create RipeWhois object!");
my $ana = new Reg::ApproveNa('Whois' => $whois, 'Regid' => $opt{'regid'})
|| FatalError("Failed to create ApproveNa object!");
# Approve netname
my($network, $ret) = $ana->approveNa($opt{'valid'});
# Check errors
my($errNo, $errStr) = $ana->error();
# Exit if there are errors
FatalError($errStr, $errNo) if($errNo);
# Print results of approval
print $ret;
}
# we really don't care about validity of regid - doit() will check it
# if it was a prefix...
elsif ($prefix) {
my $range;
#if no regid on command line try to get it from i2r
unless($opt{'regid'}) {
my($err, $update);
# To map IP range to regid
my $i2r = new ip2reg;
($err, $update, $opt{'regid'}) = $i2r->getRegName($prefix->{'list'}[0], 1);
if($err) {
# on error getting regid terminate the script
FatalError(sprintf("%s %s %s", $err, $prefix->{'list'}[0], $update));
}
}
# Have regid
# proced with ranges
process($opt{'regid'}, %{$prefix}); # rest of the work done in this function
}
# with regid as command line option
else {
foreach my $regid (@ARGV) {
process($regid); # rest of the work done in this function
}
}
exit 0; # on success;
# MAINEND
#------------------------------------------------------------------------------
# Purpose : process with regid or prefix
# Side Effects :
# Comments : still, I think, it's better to check regid directly...
# IN : scalar regid, hash of prefixes
# OUT : return undef on sucess, exit with exit code on errors
sub process {
my($regid, # regid
%regAlloc # hash of prefix to query
) = @_;
# if $regid is invalid - don't bother to deal with it
if($PRIVATE) {
local($^W) = 0; # Bad hack around not safe regread
FatalError("No such registry $regid", $NO_REGID_FOUND)
unless($regid && readreg($regid));
}
# Create all necessary objects
# Object to deal with whois server
my $whois = new RipeWhois('Host' => $opt{'host'},
'Port' => $opt{'port'},
'KeepAlive' => 1,
'FormatMode' => 1);
$whois || FatalError("Failed to create RipeWhois object!");
# Objects to store i-num objects form whois DB
my $alloc = new Net::RIPEWhois::in('Whois' => $whois)
|| FatalError("Failed to create Allocations object!");
my $assign = new Net::RIPEWhois::in('Whois' => $whois)
|| FatalError("Failed to create Assignments object!");
# Object to store internal asused data
my $asu = new Reg::Asused('Whois' => $whois)
|| FatalError("Failed to create Asused object!");
# Returned error
my($errNo, $errStr);
# Set regid as netname
$alloc->validNa($regid);
# XXX: Only for private version
###########################################################################
my $app;
if($PRIVATE) {
# read reg file
$app = new Reg::Approved('Whois' => $whois, 'Regid' => $regid)
|| FatalError("Failed to create Approved object!", $REGID_MISMATCH);
# if we didn't get get allocations with the call...
%regAlloc = $app->getRegAllocs() unless(%regAlloc);
# check any allocations found in reg
FatalError("No allocations from reg", $NO_ALLOC_INREG) unless(%regAlloc);
# print data from reg files
$app->pRegData();
# check any allocations found in reg
FatalError("No allocations from reg", $NO_ALLOC_INREG) unless(@{$regAlloc{'list'}});
}
###########################################################################
# Get Allocations from whois
($errNo, $errStr) = $asu->getDBAlloc($alloc, \%regAlloc);
# Exit, if getDBAlloc failed
FatalError($errStr, $errNo) if(defined($errNo));
# Exit, if nothing was found in whois DB
FatalError("No objects were found in whois DB!", $NO_ALLOC_INDB) unless(@{$alloc->{'dbAlloc'}});
# Get Assignments from whois DB
($errNo, $errStr) = $asu->getAssign($alloc, $assign);
# Exit, if getAssign failed
FatalError($errStr, $errNo) if(defined($errNo)); # exit with error
# Print no of allocations to process
pAllocData($alloc, \%regAlloc);
# Print summary of alloations & assignments
pAllocResults($alloc, $asu);
# Print information about overlaps
pOverlap($alloc, $asu) if($opt{'overlap'});
# Print assignments details
if($opt{'status'} || $opt{'assign'} || $opt{'free'}) {
pStatus($alloc, $asu);
}
# XXX: Only for private version
###########################################################################
if($PRIVATE) {
my $output = '';
# if assignments has invalid date stop approval check
if($opt{'aw'} || $opt{'approval'}) {
FatalError("Assignments have invalid dates. Can\'t proceed with --aw or --approval", $INVALID_DATE)
if($asu->{'invaliddate'});
# --aw | approval
$output .= $app->doApproval($assign);
}
$output .= $app->doSubAllocs($assign);
if($app->{'warning'}) {
print "There are WARNINGS:\n";
foreach my $warn (@{$app->{'warning'}}) {
print "\t$warn";
}
print "\n";
}
print $output;
}
###########################################################################
return; # on success
}
#------------------------------------------------------------------------------
# Purpose : Parse command line and init internal structures
# Side Effects :
# Comments :
# IN :
# OUT :
sub initAsused {
my($opt) = @_;
my $prefix;
$| = 1; # Flush output immediately after printing
# Debug flag
$DEBUG = $ENV{'DEBUG_ASUSED'} if(defined($ENV{'DEBUG_ASUSED'}));
# Read and check command line options
initOptions($opt);
# Get allocated prefixes
if($PRIVATE) {
# Some arguments were left
if(@ARGV) {
# Conver everything to one string
my $args = join(' ', @ARGV);
# put back replaced '-'
$args =~ s/#-#/-/g;
if($opt{'valid'}) {
# put back taken by --valid argument
$args = "$opt{'valid'} $args";
# Try to extract range o prefix from the $args
if($args =~ /^\s*((?:\d+(?:\.\d+){3}\s*-\s*\d+(?:\.\d+){3})|(?:\d+(?:\.\d+){0,3}(?:\/\d+)?))\s*(.*)$/) {
# If there is something left - complain
if($2) {
print "ERROR: Extra parameters '$2' passed to --valid\n";
printUsage();
}
# Save extracted range/prefix
$opt{'valid'} = $1;
}
else {
print "ERROR: Parameters '$args' to --valid are not range/prefix\n";
printUsage();
}
return; # exit
}
# In all othe cases we expect to get regid or range/prefix
# Look if $ARGV[0] is regid or not
if(defined($ARGV[0]) && ($ARGV[0] =~ /^[a-z][a-z]\.\S+$/)) {
# if first argument is regid rest should also be
my @not_regid = grep { !/^[a-z][a-z]\.\S+$/ } @ARGV;
if(@not_regid) {
print "ERROR: Not regid(s) '", join(' ', @not_regid), "'\n";
printUsage();
}
return; # exit
}
# $ARGV[0] is not reg, it may be an IP range.
else {
# hash of allocations
my %allocs;
while ($args =~ /(?:^|\s+)(\d+(?:\.\d+){3}\s*-\s*\d+(?:\.\d+){3})|(\d+(?:\.\d+){0,3}(?:\/\d+)?)/g) {
# Keep results. Only one of the values is defined
my($rng, $pfx) = ($1, $2);
# Convert range to prefix
if($rng) {
# Normalize range
my($range, $err) = normalizerange($rng);
if($err != $O_OK) {
FatalError("Invalid IP range '$rng', error $err", $err);
}
my @prefixes = range2prefixes($range);
$pfx = shift(@prefixes) if(@prefixes);
}
# if we have defined prefix store it
$allocs{$pfx}{'reg'} = $pfx if($pfx);
}
# If any allocation were found, store them
if(%allocs) {
$allocs{'list'} = [keys(%allocs)];
}
else {
# no valid input
print "ERROR: invalid parameters '$args'\n";
printUsage();
}
# Keep reference to hash with registry allocations
$prefix = \%allocs;
} # not regid
} # @ARGV
elsif(!$opt{'valid'}) {
print "ERROR: should specify regid or range\n";
printUsage();
} # No @ARGV
} # $PRIVATE
else {
$prefix = readConfig();
}
return $prefix;
}
#------------------------------------------------------------------------------
# Purpose : Reads config file(s)
# Side Effects : Sets up external global variables $REGID and @ALLOC
# Comments : Expects to find config file on a location:
# specified on a command line;
# in a current directory($configFile);
# in a $HOME/$rcFile;
# This is for useonly with public version
# IN : None
# OUT : Reference to the hash of prefixes
sub readConfig {
# List of possible config files
my @config;
# We prefer config file, supplied in a command line
push(@config, $opt{'config'}) if(defined($opt{'config'}));
# If there is a config in a current directory, pick it
push(@config, $configFile);
# As a last resort, check config in a user's home dir
push(@config, "$ENV{'HOME'}/$rcFile") if(defined($ENV{'HOME'}));
# We use first available config file
foreach my $file (@config) {
if(open(CONF, $file)) {
my $name; # Config variable
my $value; # Config value
my %prefix; # List of all allocations for the registry
while(<CONF>) {
chomp; # no newline
s/#.*//; # no comments
s/^\s+//; # no leading white
s/\s+$//; # no trailing white
next unless length; # anything left?
if(($name, $value)=m%(\w+)\s*=\s*(.+)%) {
# Take RegID
if($name eq 'REGID') {
# Inject regid to the command arguments list
$opt{'regid'} = $value if($value);
}
# Collect all allocation lines
elsif($name eq 'ALLOC') {
# Keep allocations
$prefix{$value}{'reg'} = $value if($value);
}
# What is this?
else {
FatalError("$file: $.: Unrecognized pair \"$name=$value\"");
}
}
# What is this?
else {
FatalError("$file: $.: Unrecognized line \"$_\"");
}
}
close(CONF);
# We didn't find RegID in the config
FatalError("There is no 'REGID' line in the config file '$file'") unless($opt{'regid'});
# We didn't find Allocation(s) in the config
FatalError("There is no 'ALLOC' line(s) in the config file '$file'") unless(%prefix);
# Keep the list of all allocations
$prefix{'list'} = [sort(keys(%prefix))] if(%prefix);
# Everything is ok, return reference to the hash of prefixes
return(\%prefix);
}
}
# We scaned all possible config locations but didn't find anything
FatalError("No config file was found! Please, supply one!");
}
#-----------------------------------------------------------------------------
# Purpose : Initialise command line options
# Side Effects :
# Comments :
# in : hash of command line switches %opt
# out : hash of prefixes from argv or undef
sub initOptions {
my($opt) = @_; # hash of command line switches
printf("Output from %s() function\n", (caller(0))[3]) if($DEBUG);
# Command line options
my @options = (
'host=s', # Hostname of the whois server
'port=s', # Port name of the whois server
'assign', # List all assignments and free addresses
'free', # List of free address space only
'status', # List broken assignments
'pipa', # Give extended PA/PI status
'infra', # Show infrastructual assignments
'cidr', # Express assignment size in CIDR
'overlap', # List overlaps
'summary', # Give only summary, instead of full list
'all', # List overlaps and status
'debug', # Debug mode TBD
'config=s', # Alternative config file
'version', # Program version
'help' # Help screen
);
# Add several flags for the private version of the program
if($PRIVATE) {
# regid
push(@options, 'regid=s');
# invalid nw
push(@options, 'aw');
# invalid & invalid nw
push(@options, 'approval');
# for testing dump the event table of approval
push(@options, 'na=s');
# netname or range
push(@options, 'valid=s');
}
# Get the command line switches
printUsage() unless(@ARGV);
# Convert any standalone '-' into '#-#'
# XXX: A hack to prevent treating standalone '-' as a parameter
map { s/^-$/#-#/; } @ARGV;
# Read options
printUsage() unless(GetOptions($opt, @options));
# Let us start with help;
printUsage() if($opt{'help'});
# Print version
if($opt->{'version'}) {
print "Version $VERSION\n";
exit 0;
}
# Validate the switchs
optConflicts($opt);
# all is synonym for --overlap --status --aw
# summary treated same as all & status don't print details
if($opt->{'all'} || $opt->{'summary'}) {
$opt->{'status'} = 1;
$opt->{'overlap'} = 1;
}
$opt->{'aw'} = 1 if($opt->{'all'} && $PRIVATE);
$opt->{'assign'} = 1 if(defined($opt->{'pipa'}));
$opt->{'free'} = 1 if(defined($opt->{'assign'}));
}
#-----------------------------------------------------------------------------
# Purpose : check option conflicts
# Side Effects :
# Comments :
# in : undef
# out : on sucess return undef on error print usage & exit.
#Option dependency and conflict matrix
#1 when the switch is set to one
#0 Conflict
#x don't care
#- one of them should be present.
#--help take the highest priority
#host and port has no dependecies
#please read this part of the code with more than 120 chars witdh.
# all approval assign aw column overlap regid size sum status valid
#all 1 0 0 0 0 0 x x 0 0 0
#approval 1 x 0 0 x x x 0 x 0
#assign 1 x 0 x x x 0 0 0
#aw 1 0 x x x 0 x 0
#column 1 0 0 0 0 0 0
#overlap 1 x x 0 x 0
#regid 1 x x x x
#size 1 x - 0
#summary 1 0 0
#status 1 0
#valid 1
#na no conflict.
sub optConflicts {
my($opt) = @_; #command line options hash
my %optConflict = ( 'all' => ['assign', 'approval', 'aw', 'overlap',
'size', 'summary','status', 'valid'],
'approval'=> ['aw', 'column', 'summary', 'valid'],
'assign' => ['column', 'status', 'summary', 'valid'],
'free' => ['contacts','valid'],
'aw' => ['column','summary', 'valid'],
'overlap' => ['summary', 'valid'],
'regid' => [''],
'cidr' => [''],
'size' => ['valid'],
'summary' => ['status'],
'status' => ['valid', 'pipa'],
'contacts'=> ['duplicates'],
'pipa' => ['status', 'infra'],
'infra' => ['status', 'pipa'],
);
my $errStr; # Error msg
foreach my $option (sort(keys(%{$opt}))) {
foreach my $invalidOpt (@{$optConflict{$option}}) {
if($opt{$invalidOpt}) {
$errStr .= "ERROR: Invalid options combination $option and $invalidOpt\n";
}
}
}
if($errStr) {
print "\n$errStr\n";
printUsage();
}
return;
}
#------------------------------------------------------------------------------
# Purpose : function to gracefully terminate the program
# Side Effects :
# Comments :
# IN : exit code, exit message
# OUT : script exit's from this sub.
sub FatalError {
my($message, # Error message
$exitcode # Exit code, if any..
) = @_;
print STDERR "FATAL: $message\n\n" if($message);
$!= $exitcode if($exitcode);
exit($exitcode || 255);
}
#-----------------------------------------------------------------------------
# Purpose : print usage and exit the program exit 1
# Side Effects :
# Comments : checks only option conflicts
# in :
# out : on sucess return undef on error printing the usage exit.
sub printUsage {
# Get executable filename
my $program = $0;
# Strip down directory component
$program =~ s%.*/(.+)%$1%;
if($PRIVATE) {
print <<PRIV;
Usage: $program
$program [--all] [--aw | --approval] [--overlap] [--status | --assign [--pipa|--infra]] regid
$program [--all] [--overlap] [--free] [--regid regid] [--status | --assign [--pipa|--infra]] (range..)
$program [--regid regid] [--valid] range | netname
regid is a registry ID as in reg database.
range is a network range in a form A.B.C.D/nn or A.B.C.D - W.X.Y.Z
PRIV
}
else {
print <<PUB;
Usage: $program
$program [--all] [--overlap] [--status | --assign [--pipa|--infra]]
PUB
}
print <<USAGE;
Where options are:
--host host Specify alternative whois server, if not whois.ripe.net
--port port Specify alternative whois port number, if not 43
--assign List all assignments and does --free
--free List free address space
--status List assignments with invalid status only
--pipa In addition show PI/PA status
--infra In addition show infrastructure assignments
--cidr Show assignment size in CIDR notation
--overlap List overlaps in assignments
--summary Show overlapping and status summary
USAGE
if($PRIVATE) {
print <<PRIV;
--all Show combination of -aw, --overlap and --status
--regid Specify regid, if it can not be guessed
--aw Validate networks in allocations and print invalid
--approval Validate networks in allocations and print all of them
--na netname Show events table for given netname with --aw or --approval
--valid netname Validate given netname or IP range
PRIV
}
else {
print <<PUB;
--all Show combination of --overlap and --status
--config file Location of the alternative config file
PUB
}
print <<USAGE;
--debug Print also debug information
--version Prints version of the program
--help This help screen
--assign and --status are mutually exclusive
--pipa and --infra are mutually exclusive
USAGE
if($PRIVATE) {
print <<PRIV;
--aw and --approval are mutually exclusive
"*" in approval's output indicates usage of the same AW
"#" in approval's output indicates INFRA-AW assignment
PRIV
}
print "\n";
exit(1);
}
#------------------------------------------------------------------------------
# Purpose : print allocations located in db
# Side Effects :
# Comments :
# IN : ref to Reg::Approved, ref to hash regAllocs
# OUT : undef
sub pAllocData {
my(
$alloc, # Net::RIPEWhois::in,
$regAllocs # ref to hash regAllocs
) = @_;
printf("Output from %s() function\n", (caller(0))[3]) if($DEBUG);
printf("Allocation(s) Located in RIPE whois DB %d\n", scalar(@{$alloc->{'dbAlloc'}}));
# errors in locating allocations in DB
foreach my $rAlloc (@{$regAllocs->{'list'}}) {
# This filled in Asused.pm
if($regAllocs->{$rAlloc}{'error'}) {
printf STDERR "ERROR: $rAlloc\n\t%s\n", $regAllocs->{$rAlloc}{'error'};
}
}
return;
}
#------------------------------------------------------------------------------
# Purpose : print summary of allocations
# Side Effects :
# Comments :
# IN : ref #Net::RIPEWhois::in, ref to Reg::Asused
# OUT : undef
sub pAllocResults {
my($alloc, # Net::RIPEWhois::in,
$asu # Reg::Asused
) = @_;
printf("Output from %s() function\n", (caller(0))[3]) if($DEBUG);
#all variables in this my def means totals of the same
my ($allocSize, # sum of all allocations
$usage , # sum of all assignments
$infra, # infrastructual usage
$uOverlap, # usage with overlap
$cOverlap, # count of overlap assignments
$cClassfull, # count of classfull assignments
$free,
$pFree, # % free
$noOfAssigns,# no of assignments
$sWarning
);
#print header if any allocations
if (@{$alloc->{'dbAlloc'}}) {
my $allocWarning;
printf("\nDetail of allocation(s) \n\n");
printf("%s\n", "-" x 78);
printf("%-15s %-30s ", ' Reg file Alloc', ' Database Allocation')
unless($opt{'regid'});
printf("%-15s %-30s ", ' Range ', ' Database Allocation')
if($opt{'regid'});
printf(" %-s\n", 'a s s i g n e d');
printf("%s %-6s %-6s %-5s %s\n", ' ' x 51, '%', 'No.', 'free',
'total');
printf ("%s\n", "-" x 78);
}
foreach my $tAlloc (@{$alloc->{'dbAlloc'}}) {
$allocSize += $alloc->{$tAlloc}{'size'};
$usage += $asu->{$tAlloc}{'usage'};
$infra += $asu->{$tAlloc}{'infra'};
# $pUsage
$uOverlap += $asu->{$tAlloc}{'uOverlap'};
$cOverlap += $asu->{$tAlloc}{'cOverlap'};
$cClassfull += $asu->{$tAlloc}{'cClassfull'};
$noOfAssigns += $asu->{$tAlloc}{'noOfAssigns'};
for (my $i = 0; $i < $#{$alloc->{$tAlloc}{'query'}}; $i++) {
printf ("%-15s \n", $alloc->{$tAlloc}{'query'}[$i]);
}
printf ("%-15s ",$alloc->{$tAlloc}{'query'}[$#{$alloc->{$tAlloc}{'query'}}]);
printf ("%-33s ", $tAlloc);
printf ("%5.1f%% ", $asu->{$tAlloc}{'usage'} * 100 / $alloc->{$tAlloc}{'size'});
printf ("%7d " , $asu->{$tAlloc}{'usage'});
printf ("%6d " , $alloc->{$tAlloc}{'size'} - $asu->{$tAlloc}{'usage'});
printf ("%6d\n" , $alloc->{$tAlloc}{'size'});
#Look for warnings
#check for source == RIPE
unless ($alloc->{$tAlloc}{'so'} =~ /^RIPE\s*$/) {
$sWarning .= sprintf("%s allocation without source RIPE %s mnt\n",
$tAlloc, $alloc->{$tAlloc}{'so'});
}
# Check status of the allocation, should be 'ALLOCATED type'
if($alloc->{$tAlloc}{'st'} =~ /^ALLOCATED\s+(\w{2})\w*/) {
# Save first 2 letters of the type for farther output
$alloc->{$tAlloc}{'status'} = uc($1);
}
else {
$sWarning .= sprintf("%s unknown status '%s'\n",
$tAlloc, $alloc->{$tAlloc}{'st'});
# Indicate unknown allocation type
$alloc->{$tAlloc}{'status'} = '--';
}
#mnt-lower type
if(@{$alloc->{$tAlloc}{'ml'}}){
foreach my $mnt (@{$alloc->{$tAlloc}{'ml'}}) {
# Shouldn't be any RIPE maintainers
if($mnt =~ /RIPE-NCC(?:\-\S+)?-MNT/i) {
# Registry haven't paid
if($mnt =~ /RIPE-NCC-HM-MNT/i) {
$sWarning .= sprintf("%s has mnt-lower %s. Didn't pay?\n", $tAlloc, $mnt);
}
# Anything else with RIPE
else {
$sWarning .= sprintf("%s has RIPE NCC mnt-lower %s.\n", $tAlloc, $mnt);
}
}
}
}
else {
$sWarning .= sprintf("%s doesn't have mnt-lower attribute.\n", $tAlloc);
}
#any warning generated from whois
foreach my $wrn (@{$alloc->{$tAlloc}{'warning'}}) {
$sWarning .= sprintf("%s %s\n", $tAlloc, $wrn);
}
}
printf ("%s\n", "-" x 78) if(@{$alloc->{'dbAlloc'}});
printf("\n");
if($opt{'regid'}) {
printf("Total number of addresses in all allocation(s) ");
}
else {
printf("Total number of addresses in allocation ");
}
printf(" %7d\n", $allocSize);
if($opt{'regid'}) {
printf("Total assigned addresses in all allocation(s) ");
}
else {
printf("Total assigned addresses in allocation: ");
}
printf("%7.1f%% %7d\n", ($usage * 100 / $allocSize), $usage);
if($opt{'regid'}) {
printf("Total assigned for infrastructure in alloc(s) ");
}
else {
printf("Total assigned for infrastructure in alloc: ");
}
printf("%7.1f%% %7d\n", ($infra * 100 / $allocSize), $infra);
if($opt{'regid'}) {
printf("Total unused addresses in all allocation(s) ");
}
else {
printf("Total unused addresses in allocation: ");
}
# XXX: allocSize == 0?
printf("%7.1f%% %7d\n", ($allocSize - $usage) * 100 / $allocSize, ($allocSize - $usage));
#if usage is zero can't calculate /$usage
if ($usage) {
printf("Total overlap(s) %5d %7.1f%% %7d\n",
$cOverlap, ($uOverlap - $usage) * 100 / $usage, ($uOverlap - $usage));
}
# Put an additional warning if overlaps
if($cOverlap) {
$sWarning .= sprintf("There are OVERLAPPING ASSIGNMENTS. Check with --overlap\n");
}
# Just to separate output
printf("\n");
printf("No of Assignment(s) %7d\n",
$noOfAssigns);
printf("No of assignment(s) of size /20 - /24 %7.1f%% %7d\n",
($noOfAssigns) ? $cClassfull * 100 / $noOfAssigns : 0,
$cClassfull);
if ($sWarning) {
print ("\nPlease check the following WARNINGS:\n");
print ("$sWarning");
}
else {
print "No WARNINGS found\n";
}
return;
}
#------------------------------------------------------------------------------
# Purpose : print overlap information
# Side Effects :
# Comments :
# IN : allocation ref to Net::RIPEWhois::in, ref to Reg::Asused
# OUT : undef
sub pOverlap {
my (
$alloc, # allocation ref to Net::RIPEWhois::in
$asu # ref to Reg::Asused
) = @_;
printf("Output from %s() function\n", (caller(0))[3]) if($DEBUG);
my $sSummary; # summary string
my $overlapFlag = 1; # flag to pring the heading once
foreach my $tAlloc (@{$alloc->{'dbAlloc'}}) {
#print details
unless($opt{'summary'}) {
# header of overlapping info
if($asu->{$tAlloc}{'sOverlap'} and $overlapFlag) {
printf("\nList of overlapping objects\n");
printf(" %-33s %-12s %s\n", 'inetnum', 'date', 'netname');
printf("%s\n", "-" x 78);
$overlapFlag = 0;
}
# Details about overlaps
printf("%s", $asu->{$tAlloc}{'sOverlap'});
}
$sSummary .= sprintf("%-33s", $tAlloc);
if($asu->{$tAlloc}{'noOfAssigns'}) {
$sSummary .= sprintf("%10.1f",
($asu->{$tAlloc}{'cOverlap'} * 100 /
$asu->{$tAlloc}{'noOfAssigns'}));
}
else {
$sSummary .= sprintf("%10.1f", 0);
}
$sSummary .= sprintf("%8d %6d ", $asu->{$tAlloc}{'cOverlap'},
$asu->{$tAlloc}{'noOfAssigns'});
$sSummary .= sprintf(" %8d\n", $alloc->{$tAlloc}{'created'});
}
# print summary
if($sSummary) {
printf("\nSummary of overlaps per allocation:\n");
printf("%s\n", "-" x 78);
printf("%-33s %11s %8s %13s %s\n", 'Database Allocation', '% of overlps',
'Overlaps', 'No. of assign', 'Date');
printf("%s\n", "-" x 78);
printf("%s", $sSummary);
printf("%s\n", "-" x 78);
}
# no overlap summary to print
else {
printf "No overlaps\n";
}
return;
}
#------------------------------------------------------------------------------
# Purpose : print assignments status information
# Side Effects :
# Comments :
# IN : ref to allocation Net::RIPEWhois::in, ref to Reg::Asused
# OUT : undef
sub pStatus {
my($alloc, #ref to allocation
$asu #ref to Reg::Asused
) = @_;
printf("Output from %s() function\n", (caller(0))[3]) if($DEBUG);
#all variables in this my def means totals of the same for all allocations
my($noOfAssigns, # number of assignments
$paStCount, # number of assignments with status ASSIGNED PA
$piStCount, # number of assignments with status ASSIGNED PI
$missStCount, # number of assignments with missing status value
$otherStCount, # number of assignments with any other status
$sWarning, # salar of formatted output of warnings
$sSummary, # scalar summary
$sInfra, # infra-aw assignments
$sFree, # scalar free formatted output
$free, # no of free IP addresses
);
my $statusFlag = 1; # flag to print header info
foreach my $tAlloc (@{$alloc->{'dbAlloc'}}) {
unless($opt{'summary'}) {
if($opt{'status'} || $opt{'assign'}) {
# print heading if it exists & not printed previously
if($asu->{$tAlloc}{'sStatus'} and $statusFlag) {
if($opt{'status'}) {
print "\nAssignments with incorrect status value\n";
}
elsif($opt{'assign'}) {
print "\nAll assignments\n";
}
printf("%s\n", "-" x 78);
printf('%-32s %5s %7s ', 'Database Allocation', 'size', 'date');
if(defined($opt{'pipa'})) {
printf("%2s ", 'st');
}
elsif(defined($opt{'infra'})) {
printf("%3s ", 'inf');
}
printf("%-15s ", 'netname');
printf("%-6s", 'status') if(defined($opt{'status'}));
printf("\n");
printf("%s\n", "-" x 78);
$statusFlag = 0;
}
# Details about assignments
printf("%s", $asu->{$tAlloc}{'sStatus'});
}
}
# infra
$sInfra = $asu->{$tAlloc}{'sInfra'} if($asu->{$tAlloc}{'sInfra'});
# free space
$sFree .= $asu->{$tAlloc}{'sFree'} if($asu->{$tAlloc}{'sFree'});
$free += $asu->{$tAlloc}{'free'};
# status summary
$sSummary .= sprintf ("%-33s %3s %5d %5d %5d", $tAlloc,
$alloc->{$tAlloc}{'status'},
$asu->{$tAlloc}{'noOfAssigns'},
$asu->{$tAlloc}{'paStCount'},
$asu->{$tAlloc}{'piStCount'});
$sSummary .= sprintf (" %5d %5d", $asu->{$tAlloc}{'missStCount'},
$asu->{$tAlloc}{'otherStCount'});
$sSummary .= sprintf(" %8d\n", $alloc->{$tAlloc}{'created'});
# Print warnings asu if there any
$sWarning .= $asu->{$tAlloc}{'warning'} if($asu->{$tAlloc}{'warning'});
# numbers
$noOfAssigns += $asu->{$tAlloc}{'noOfAssigns'};
$paStCount += $asu->{$tAlloc}{'paStCount'};
$piStCount += $asu->{$tAlloc}{'piStCount'};
$missStCount += $asu->{$tAlloc}{'missStCount'};
$otherStCount += $asu->{$tAlloc}{'otherStCount'};
}
# print warnings if any
unless($opt{'summary'}) {
if($sWarning) {
printf "\nPay attension on this WARNINGS:\n";
printf $sWarning;
}
}
# Infrastructure assignments
if($opt{'infra'}) {
if($sInfra) {
printf("\nInfrastructure assignemts:\n");
printf("%s\n", "-" x 78);
printf('%-32s %5s %7s ', 'Database Allocation', 'size', 'date');
printf("%2s ", 'st') if(defined($opt{'pipa'}));
printf("%-15s ", 'netname');
printf("%-6s", 'status') if(defined($opt{'status'}));
printf("\n");
printf("%s\n", "-" x 78);
printf("%s", $sInfra);
printf("%s\n", "-" x 78);
}
}
# List free address space
if($opt{'free'}) {
# free space
if($sFree) {
printf("\nFree Address Space\n");
printf("%s\n", "-" x 78);
printf("%-33s %6s\n", "Address range", " size");
printf("%s\n", "-" x 78);
printf("%s\n", $sFree);
printf("%s\n", "-" x 78);
printf("%-33s %6d\n", 'Total', $free);
}
else {
printf("\nNo Free Address Space\n");
}
}
# Give summary information
if($opt{'status'} || $opt{'assign'}) {
#print summary
if($sSummary) {
printf("\nSummary of statuses per allocation:\n");
printf("%s\n", "-" x 78);
printf("%-33s %3s %-7s %5s %5s", 'Database Allocation', 'st', '#assign', 'PA ', 'PI ');
printf(" %5s %5s %6s\n", 'miss ', 'other', 'date ');
printf("%s\n", "-" x 78);
printf("%s", $sSummary);
printf("%s\n", "-" x 78);
}
else {
printf "\nNo allocations yet\n";
}
}
return;
}
!NO!SUBS!
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
rename($file, $newname) unless($newname eq $file);
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
chdir $origdir;