asused-3.72/0040755000072700117040000000000007740564516012354 5ustar timursoftiesasused-3.72/Whois/0040755000072700117040000000000007740564516013445 5ustar timursoftiesasused-3.72/Whois/RipeWhois/0040755000072700117040000000000007740564516015356 5ustar timursoftiesasused-3.72/Whois/RipeWhois/FormatMode/0040755000072700117040000000000007740564516017413 5ustar timursoftiesasused-3.72/Whois/RipeWhois/FormatMode/FormatMode.pm0100644000072700117040000002161707361063763022007 0ustar timursofties# Copyright (c) 2000 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 : FormatMode.pm # Purpose : Filter objects in RIPE Whois v3 format and make them look # like v2 format. # Author : Timur Bakeyev # Date : 04042001 # Description : Filter to get rid of some RPSL extended syntax # Language Version : Perl5 # OSs Tested : BSD/OS 3.1 # Command Line : None # Input Files : None # Output Files : None # External Programs : None # Problems : None known # To Do : None # Comments : This module provided only to ease the transition to the # RIPE Whois v3 # $Id: FormatMode.pm,v 1.5 2001/10/10 15:23:31 timur Exp $ #------------------------------------------------------------------------------ package RipeWhois::FormatMode; use strict; use vars qw($VERSION @ISA); require Exporter; @ISA = qw(Exporter); $VERSION = '1.03'; # Mapping from short form of attrributes to normal my %shortattr = ( '*ac' => 'admin-c', '*aa' => 'as-name', '*ad' => 'address', '*ag' => 'aggr-mtd', '*ab' => 'aggr-bndry','*ah' => 'author', '*an' => 'aut-num', '*as' => 'as-set', '*at' => 'auth', '*az' => 'alias', '*ce' => 'certif', '*ch' => 'changed', '*cy' => 'country', '*cn' => 'cross-nfy', '*co' => 'components','*ct' => 'cross-mnt', '*da' => 'dom-name', '*de' => 'descr', '*df' => 'default', '*dc' => 'dictionary', '*di' => 'dom-net', '*dn' => 'domain', '*dt' => 'upd-to', '*ec' => 'export-comps', '*en' => 'encapsulation','*em'=> 'e-mail', '*ex' => 'export', '*fi' => 'filter', '*fp' => 'fingerpr', '*fs' => 'filter-set','*fx' => 'fax-no', '*ho' => 'holes', '*if' => 'ifaddr', '*ij' => 'inject', '*in' => 'inetnum', '*i6' => 'inet6num', '*ip' => 'import', '*ir' => 'inet-rtr', '*is' => 'rtr-set', '*kc' => 'key-cert', '*la' => 'local-as', '*li' => 'limerick', '*mh' => 'method', '*mb' => 'mnt-by', '*ml' => 'mnt-lower', '*mo' => 'member-of', '*mr' => 'mbrs-by-ref','*ms' => 'members', '*mt' => 'mntner', '*mn' => 'mnt-nfy', '*na' => 'netname', '*nh' => 'nic-hdl', '*ns' => 'nserver', '*ny' => 'notify', '*or' => 'origin', '*ow' => 'owner', '*pe' => 'peer', '*pg' => 'peering', '*ph' => 'phone', '*pl' => 'protocol', '*pn' => 'person', '*ps' => 'peering-set','*rf' => 'refer', '*rm' => 'remarks', '*ro' => 'role', '*rp' => 'rp-attribute','*rs' => 'route-set', '*rt' => 'route', '*rz' => 'rev-srv', '*sd' => 'sub-dom', '*so' => 'source', '*st' => 'status', '*tb' => 'trouble', '*td' => 'typedef', '*tc' => 'tech-c', '*tx' => 'text', '*wd' => 'withdrawn', '*zc' => 'zone-c', ); # Hash of hashes, which containes the order of the fields for the # most common RIPE Whois objects. my %class = ( 'aut-num' => { 'aut-num' => 1, 'as-name' => 2, 'descr' => 3, 'as-in' => 4, 'as-out' => 5, 'cross-nfy' => 6, 'cross-mnt' => 7, 'interas-in' => 8, 'interas-out' => 9, 'as-exclude' => 10, 'default' => 11, 'guardian' => 12, 'admin-c' => 13, 'tech-c' => 14, 'remarks' => 15, 'notify' => 16, 'mnt-by' => 17, 'changed' => 18, 'source' => 19 }, 'inetnum' => { 'inetnum' => 1, 'netname' => 2, 'descr' => 3, 'country' => 4, 'admin-c' => 5, 'tech-c' => 6, 'rev-srv' => 7, 'status' => 8, 'remarks' => 9, 'notify' => 10, 'mnt-by' => 11, 'mnt-lower' => 12, 'changed' => 13, 'source' => 14 }, 'person' => { 'person' => 1, 'address' => 2, 'phone' => 3, 'fax-no' => 4, 'e-mail' => 5, 'nic-hdl' => 6, 'remarks' => 7, 'notify' => 8, 'mnt-by' => 9, 'changed' => 10, 'source' => 11 }, 'role' => { 'role' => 1, 'address' => 2, 'phone' => 3, 'fax-no' => 4, 'e-mail' => 5, 'trouble' => 6, 'admin-c' => 7, 'tech-c' => 8, 'nic-hdl' => 9, 'remarks' => 10, 'notify' => 11, 'mnt-by' => 12, 'changed' => 13, 'source' => 14 } ); #################################################################### # DESCRIPTION: Return a reference to the hash of weights for the # specified object class or nothing if it is unknown # INPUT: Class name # OUTPUT: Reference to the hash with weights or undef #################################################################### sub short2long { my($short) = @_; # Nothing was passed return unless($short); # Translate my $long = $shortattr{$short}; # Return the result, if any or original return ($long) ? $long : $short; } #################################################################### # DESCRIPTION: Return a reference to the hash of weights for the # specified object class or nothing if it is unknown # INPUT: Class name # OUTPUT: Reference to the hash with weights or undef #################################################################### sub sort_order { my($class) = @_; # Return nothing if nothing was passed return unless($class); # Return the list of weights, corresponding to the # class, or nothing, if we don't know about it return $class{$class}; } #################################################################### # DESCRIPTION: Sorts the passed array according to weights, that # correspond to the specified class # INPUT: Class name; list of the fields # OUTPUT: Sorted list of the fields # SIDE EFFECTS: Unknown fields are going to the bottom of the list #################################################################### sub sort_by_field { my($class, $hash) = @_; # Get the order of the fields for the class my $type = sort_order($class); # Get the list of the fields my @keys = keys(%{$hash}); # Return immedeately, if there is no defined sorting order. return @keys unless($type && (ref($type) eq 'HASH')); # Sort the list of key fields according to the predefined # order. my @list = sort { # Convert short form of the field into long one my $alpha = short2long($a); my $beta = short2long($b); # Assign to unknown fields huge weight, so they # will go to the bottom of the list my $t_alpha = defined($type->{$alpha}) ? $type->{$alpha} : 1000; my $t_beta = defined($type->{$beta}) ? $type->{$beta} : 1000; # Compare two weights $t_alpha <=> $t_beta; } @keys; # Return the result return @list; } #################################################################### # DESCRIPTION: Filter the output of the RIPE Whois v3 to make it look # like v2 output, with some exceptions # INPUT: Object to filter; bool flag, do we need sorting as well # OUTPUT: Filtered object # SIDE EFFECTS: None #################################################################### sub Filter { my($obj, $need_sorting) = @_; # Strip comments $obj =~ s/\s*#.*$//mg; # Assemble the lines $obj =~ s/\n[ \t\+]\s*/ /mg; # Zap spaces and tabs $obj =~ s/[ \t]+/ /mg; # Return, if sorting is not required return $obj unless($need_sorting); # We need to sort fields as well my %obj = (); my @obj = (); my($key_field, $key, $value); # Split object into lines foreach my $line (split(/\n/, $obj)) { # Plain field/value pair if($line =~ /^(\S+):\s*(.*)$/) { ($key, $value) = ($1, $2); # Key field is always the first in the object # If it is in -F form - expand it $key_field = short2long($key) unless($key_field); # Store the values of the field in an array push(@{$obj{$key}}, $value); } } # Return unsorted object, if we don't know the sorting order return $obj unless(sort_order($key_field)); # Sort the fields acording to the RIPE DB v2 foreach my $field (sort_by_field($key_field, \%obj)) { foreach my $line (@{$obj{$field}}) { push(@obj, sprintf("%-14s%s", "$field:", $line)); } } # Merge the list back into the scalar $obj = join("\n", @obj); # Return sorted list of the fields return $obj; } 1; asused-3.72/Whois/RipeWhois/FormatMode/test.pl0100644000072700117040000001510207270636770020723 0ustar timursofties# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..6\n"; } END { print "not ok 1\n" unless $loaded; } use FormatMode; $loaded = 1; print "ok 1\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): my $object = 'person: Nurani Nimpuno fax-no: +31 20 535 4445 address: Netherlands address: 1016 AB AMSTERDAM # genie milt contemptuous cathodic breakdown mnt-by: RIPE-NCC-HM-MNT nic-hdl: NN32-RIPE phone: +31 20 535 4444 changed: hostmaster@ripe.net 19990805 address: Singel 258 # physician strum Uranus deprivation address: RIPE Network Coordination Centre (NCC) source: RIPE # nostalgia changed: hostmaster@ripe.net 20000615'; my $stripped_object = 'person: Nurani Nimpuno fax-no: +31 20 535 4445 address: Netherlands address: 1016 AB AMSTERDAM mnt-by: RIPE-NCC-HM-MNT nic-hdl: NN32-RIPE phone: +31 20 535 4444 changed: hostmaster@ripe.net 19990805 address: Singel 258 address: RIPE Network Coordination Centre (NCC) source: RIPE changed: hostmaster@ripe.net 20000615'; my $sorted_object = 'person: Nurani Nimpuno address: Netherlands address: 1016 AB AMSTERDAM address: Singel 258 address: RIPE Network Coordination Centre (NCC) phone: +31 20 535 4444 fax-no: +31 20 535 4445 nic-hdl: NN32-RIPE mnt-by: RIPE-NCC-HM-MNT changed: hostmaster@ripe.net 19990805 changed: hostmaster@ripe.net 20000615 source: RIPE'; my $as_object = 'aut-num: AS8888 # Calais impose Ising export: to AS2854 announce AS-COMTAT import: from AS8299 action pref=30; accept ANY export: to AS8342 announce AS-COMTAT export: to AS8882 announce ANY # irony import: from AS8882 action pref=10; accept ANY default: to AS8342 action pref=10; networks ANY default: to AS8299 action pref=50; networks ANY descr: Tatarstan Republic descr: Comtat Inc. Autonomous System tech-c: CNH5-RIPE import: from AS2854 action pref=30; accept ANY as-name: COMTAT-AS notify: noc@comtat.ru export: to AS3325 announce AS-COMTAT changed: hostmaster@comtat.ru 20001031 # loophole facsimile churchgo export: to AS8299 announce AS-COMTAT import: from AS3325 action pref=100; accept AS3325 source: RIPE import: from AS8342 action pref=30; accept ANY admin-c: CNH5-RIPE mnt-by: COMTAT-MNT-RIPE default: to AS2854 action pref=30; networks ANY'; my $sorted_as_object = 'aut-num: AS8888 as-name: COMTAT-AS descr: Tatarstan Republic descr: Comtat Inc. Autonomous System default: to AS8342 action pref=10; networks ANY default: to AS8299 action pref=50; networks ANY default: to AS2854 action pref=30; networks ANY admin-c: CNH5-RIPE tech-c: CNH5-RIPE notify: noc@comtat.ru mnt-by: COMTAT-MNT-RIPE changed: hostmaster@comtat.ru 20001031 source: RIPE export: to AS2854 announce AS-COMTAT export: to AS8342 announce AS-COMTAT export: to AS8882 announce ANY export: to AS3325 announce AS-COMTAT export: to AS8299 announce AS-COMTAT import: from AS8299 action pref=30; accept ANY import: from AS8882 action pref=10; accept ANY import: from AS2854 action pref=30; accept ANY import: from AS3325 action pref=100; accept AS3325 import: from AS8342 action pref=30; accept ANY'; my $unknown_object = 'as-block: AS8192 - AS9215 mnt-by: RIPE-NCC-MNT admin-c: NN32-RIPE tech-c: OPS4-RIPE mnt-lower: RIPE-NCC-MNT descr: RIPE NCC ASN block remarks: These AS numbers are + further assigned by RIPE NCC remarks: Please refer to RIPE Document ripe-185 changed: hostmaster@ripe.net 20010423 remarks: and RIPE Document ripe-147 remarks: to LIRs and end-users in the RIPE NCC region # Thai kimono GSA occident mulch source: RIPE'; my $stripped_unknown_object = 'as-block: AS8192 - AS9215 mnt-by: RIPE-NCC-MNT admin-c: NN32-RIPE tech-c: OPS4-RIPE mnt-lower: RIPE-NCC-MNT descr: RIPE NCC ASN block remarks: These AS numbers are further assigned by RIPE NCC remarks: Please refer to RIPE Document ripe-185 changed: hostmaster@ripe.net 20010423 remarks: and RIPE Document ripe-147 remarks: to LIRs and end-users in the RIPE NCC region source: RIPE'; my $short_object = '*pn: Nurani Nimpuno *fx: +31 20 535 4445 *ad: Netherlands *ad: 1016 AB AMSTERDAM # genie milt contemptuous cathodic breakdown *mb: RIPE-NCC-HM-MNT *nh: NN32-RIPE *ph: +31 20 535 4444 *ch: hostmaster@ripe.net 19990805 *ad: Singel 258 # physician strum Uranus deprivation *ad: RIPE Network Coordination Centre (NCC) *so: RIPE # nostalgia *ch: hostmaster@ripe.net 20000615'; my $sorted_short_object = '*pn: Nurani Nimpuno *ad: Netherlands *ad: 1016 AB AMSTERDAM *ad: Singel 258 *ad: RIPE Network Coordination Centre (NCC) *ph: +31 20 535 4444 *fx: +31 20 535 4445 *nh: NN32-RIPE *mb: RIPE-NCC-HM-MNT *ch: hostmaster@ripe.net 19990805 *ch: hostmaster@ripe.net 20000615 *so: RIPE'; my $test2 = RipeWhois::FormatMode::Filter($object); if($test2 ne $stripped_object) { print "not "; } print "ok 2\n"; my $test4 = RipeWhois::FormatMode::Filter($object, 'yes'); if($test4 ne $sorted_object) { print "not "; } print "ok 3\n"; my $test4 = RipeWhois::FormatMode::Filter($as_object, 'yes'); if($test4 ne $sorted_as_object) { print "not "; } print "ok 4\n"; my $test5 = RipeWhois::FormatMode::Filter($unknown_object, 'yes'); if($test5 ne $stripped_unknown_object) { print "not "; } print "ok 5\n"; my $test6 = RipeWhois::FormatMode::Filter($short_object, 'yes'); if($test6 ne $sorted_short_object) { print "not "; } print "ok 6\n"; asused-3.72/Whois/RipeWhois/FormatMode/MANIFEST0100644000072700117040000000006307267345036020536 0ustar timursoftiesChanges FormatMode.pm MANIFEST Makefile.PL test.pl asused-3.72/Whois/RipeWhois/FormatMode/Makefile.PL0100644000072700117040000000123107740560743021355 0ustar timursoftiesuse 5.005; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. # RIPE NCC common configuration my %PARAM = ( 'INSTALLDIRS' => 'vendor', 'INSTALLSCRIPT' => '$(INSTALLVENDORBIN)', # Hack for Perl prior 5.8.1 'dist' => { 'COMPRESS' => 'gzip', 'SUFFIX' => '.gz', 'CI' => 'cvs ci', 'RCS_LABEL' => 'cvs tag -c -F $(NAME_SYM)-$(VERSION_SYM)', }, ); if($] >= 5.005) { $PARAM{AUTHOR} = 'Timur Bakeyev '; }; WriteMakefile( 'NAME' => 'RipeWhois::FormatMode', 'VERSION_FROM' => 'FormatMode.pm', # finds $VERSION %PARAM ); asused-3.72/Whois/RipeWhois/FormatMode/Changes0100644000072700117040000000020607267345036020677 0ustar timursoftiesRevision history for Perl extension RipeWhois::FormatMode. 0.01 Wed Aug 9 18:27:33 2000 - original version; created by h2xs 1.19 asused-3.72/Whois/RipeWhois/Makefile.PL0100644000072700117040000000125507740560730017322 0ustar timursoftiesuse 5.005; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. # RIPE NCC common configuration my %PARAM = ( 'INSTALLDIRS' => 'vendor', 'INSTALLSCRIPT' => '$(INSTALLVENDORBIN)', # Hack for Perl prior 5.8.1 'dist' => { 'COMPRESS' => 'gzip', 'SUFFIX' => '.gz', 'CI' => 'cvs ci', 'RCS_LABEL' => 'cvs tag -c -F $(NAME_SYM)-$(VERSION_SYM)', }, ); if($] >= 5.005) { $PARAM{AUTHOR} = 'Timur Bakeyev '; }; WriteMakefile( 'NAME' => 'RipeWhois', 'VERSION_FROM' => 'RipeWhois.pm', # finds $VERSION 'EXE_FILES' => [qw(cwhois)], %PARAM ); asused-3.72/Whois/RipeWhois/MANIFEST0100644000072700117040000000007107270015411016461 0ustar timursoftiesChanges MANIFEST Makefile.PL RipeWhois.pm cwhois test.pl asused-3.72/Whois/RipeWhois/Changes0100644000072700117040000000017207144507067016642 0ustar timursoftiesRevision history for Perl extension RipeWhois. 0.01 Wed Aug 9 18:27:33 2000 - original version; created by h2xs 1.19 asused-3.72/Whois/RipeWhois/cwhois0100755000072700117040000000776307267546404016612 0ustar timursofties#!/usr/bin/perl # Copyright (c) 2000 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 : RipeWhois.pm # Purpose : Make whois queries to RIPE-like servers # Author : Timur Bakeyev # Date : 08082000 # Description : Simpe whois client that gives you back output, compatiable with # RIPE DB v2, if you'llask it to :) # Language Version : Perl5 # OSs Tested : BSD/OS 3.1 # Command Line : None # Input Files : None # Output Files : None # External Programs : None # Problems : None known # To Do : None # Comments : # $Id: cwhois,v 1.1 2001/04/19 11:33:24 timur Exp $ #------------------------------------------------------------------------------ use RipeWhois; use Getopt::Long; my @cmdline = ( 'host=s', 'port=s', 'mode=i', ); my %opt = ('Host' => 'whois.ripe.net', 'Port' => '43', 'FormatMode' => 0); # Getopt configuration Getopt::Long::Configure('pass_through'); GetOptions(\%opt, @cmdline); my $whois = new RipeWhois(Host => $opt{'host'}, Port => $opt{'port'}, FormatMode => $opt{'mode'}); my $query = join(' ', @ARGV); unless(ref($whois)) { print STDERR "Failed\n"; exit 1; } if($whois->GetErrorCode()) { printf(STDERR "Error: %s\n", $whois->GetErrorString()); exit 2; } my @result = $whois->QueryObjects($query); unless(@result) { printf(STDERR "Query error: %s\n", $whois->GetErrorString()); exit 3; } print < # Date : 08082000 # Description : General purpose, simple client to make whois queries # Language Version : Perl5 # OSs Tested : BSD/OS 3.1 # Command Line : None # Input Files : None # Output Files : None # External Programs : None # Problems : None known # To Do : Make more consistent(?) # Comments : # $Id: RipeWhois.pm,v 1.4 2001/04/18 17:01:20 timur Exp $ #------------------------------------------------------------------------------ package RipeWhois; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); require Exporter; @ISA = qw(Exporter Whois); use Whois qw(:ERROR_CODES); use Whois qw(%ERROR); $VERSION = '1.03'; # This strings are perl regexp my %WHOIS_ERROR = ( $WHOIS_TIMEOUT => '%\s+Timeout', $WHOIS_NO_ENTRY => '%\s+No\s+entries\s+found', $WHOIS_UNKNOWN_QUERY=> '%\s+Request\s+for\+unknown', $CONNECTION_CLOSED => '(Timeout|Connection)\s+closed\s+by\s+foreign', ); # Default parameters for the class my %default = ( 'Host' => 'whois.ripe.net', 'FormatMode' => 0, 'KeepAlive' => 0 ); #################################################################### # DESCRIPTION: Create new object # INPUT: Hash of parameters, can be: # host, port, timeout, retry, KeepAlive. # OUTPUT: Object # SIDE EFFECTS: None # SYNTAX: None #################################################################### sub new { my $proto = shift; my $class = ref($proto) || $proto; my %param = (@_); my $param = ''; my %extend = (); # Keepalive connection $param = delete $param{'KeepAlive'}; $extend{'KeepAlive'} = ($param && $param =~ /^\d+$/) ? $param : $default{'KeepAlive'}; # Extract the value of the mode my $mode = delete $param{'FormatMode'}; if($mode && $mode =~ /^\d+$/) { # We need this module only if we use legacy conversion require RipeWhois::FormatMode; # Strip continuation and comments if($mode == 1) { $extend{'FormatMode'} = 1; } # Sort the fields as well elsif($mode == 2) { $extend{'FormatMode'} = 2; } } else { $extend{'FormatMode'} = $default{'FormatMode'}; } # Set the host to default if nothing was passed unless($param{'Host'} && $param{'Host'} =~ /^\S+$/) { $param{'Host'} = $default{'Host'}; } # Call the parent constructor my $self = $class->SUPER::new(%param); # Fail, if parent constructor failed return unless($self); bless $self, $class; # Fill additional parameters $self->{'KeepAlive'} = $extend{'KeepAlive'}; $self->debug("KeepAlive: ", $self->{'KeepAlive'}); $self->{'FormatMode'} = $extend{'FormatMode'}; $self->debug("FormatMode: ", $self->{'FormatMode'}); return $self; } #################################################################### # DESCRIPTION: Query whois server # INPUT: Query, that should be send to the server # OUTPUT: Error code on error, 0 on success. # SIDE EFFECTS: None # SYNTAX: None #################################################################### sub Query { my $self = shift; # Filter out empty paramters my @query = grep { /\S+/ } @_; # Add keep-alive flag if necessary if($self->{'KeepAlive'}) { # Only for non-empty list unshift(@query, '-k') if(@query); } # Make the query my $error = $self->SUPER::Query(@query); # If query failed return the error code return $error if($error); # On success return 0; } #################################################################### # DESCRIPTION: Split raw query results into array of objects # INPUT: Scalar with the query result or uses internal one # OUTPUT: Error code on error, 0 on success. # SIDE EFFECTS: None # SYNTAX: None #################################################################### sub SplitResult { my $self = shift; # We can obtain result from a parameter my $result = shift || $self->GetResult(); return $self->error($NO_RESULT, $ERROR{$NO_RESULT}) unless($result); # Did we get any errors from the server foreach my $error (keys(%WHOIS_ERROR)) { # Respond containes one of the errors codes # from Whois server return $self->error($error, $ERROR{$error}) if($result =~ m/$WHOIS_ERROR{$error}/m); } # Get rid of all comment lines $result =~ s/^%.*$//mg; # Remove spaces from the begining # and end of the result $result =~ s/^\s*//s; $result =~ s/\s*$//s; # No results or failure return $self->error($NO_RESULT, $ERROR{$NO_RESULT}) unless($result); # Split result into objects my @objects = split(/\n\n/, $result); # If we need to do conversion to the legacy format if($self->{'FormatMode'}) { # Do inline modification of the objects, if required foreach my $object (@objects) { # Stripping if($self->{'FormatMode'} == 1) { $object = RipeWhois::FormatMode::Filter($object); } # ...or stripping and sorting elsif($self->{'FormatMode'} == 2) { $object = RipeWhois::FormatMode::Filter($object, 'yes'); } } } # Save results $self->{'Objects'} = \@objects; return 0; } #################################################################### # DESCRIPTION: Return array of objects # INPUT: None # OUTPUT: Array or reference to array of objects # SIDE EFFECTS: None # SYNTAX: None #################################################################### sub GetObjects { my $self = shift; return wantarray() ? @{ $self->{'Objects'} } : $self->{'Objects'}; } #################################################################### # DESCRIPTION: Query whois server and return array of objects # INPUT: Query, that should be send to the server # OUTPUT: Array of objects, or empty on error # SIDE EFFECTS: None # SYNTAX: None #################################################################### sub QueryObjects { my $self = shift; my @query = @_; if(!$self->Query(@query) && !$self->SplitResult()) { return $self->GetObjects(); } return; } #################################################################### # DESCRIPTION: Close connection with the whois server # INPUT: None # OUTPUT: None # SIDE EFFECTS: None # SYNTAX: None #################################################################### sub Close { my $self = shift; # Don't close keep-alive session unless($self->{'KeepAlive'}) { # Call the parent method $self->SUPER::Close(); } } #################################################################### # DESCRIPTION: Destructor for the object. # INPUT: None # OUTPUT: None # SIDE EFFECTS: None # SYNTAX: None #################################################################### sub DESTROY { my $self = shift; if(defined($self->{'Sock'}) && $self->{'Sock'}->opened()) { # Send notification to the server to close it's side of the # connection if we were in keep-alive mode if($self->{'KeepAlive'}) { # $self->debug("Terminate keep alive connection"); # We don't care about possible connection # errors at this stage $self->{'Sock'}->print("-k\x0d\x0a"); } } $self->SUPER::Close(); $self->debug(ref($self), " object was destroyed"); } 1; __END__ # Below is the stub of documentation for your module. You better edit it! =head1 NAME RipeWhois - Perl extension to retrieve information from RIPE Whois database. =head1 SYNOPSIS use RipeWhois; blah blah blah =head1 DESCRIPTION Stub documentation for RipeWhois was created by h2xs. It looks like the author of the extension was negligent enough to leave the stub unedited. Blah blah blah. =head1 AUTHOR Timur Bakeyev =head1 SEE ALSO perl(1). =cut asused-3.72/Whois/RipeWhois/test.pl0100644000072700117040000000252307267344140016662 0ustar timursofties# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..4\n"; } END { print "not ok 1\n" unless $loaded; } use RipeWhois; $loaded = 1; print "ok 1\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): my $whois = new RipeWhois('KeepAlive' => 1, 'FormatMode' => 2, 'Debug' => 1); if(ref($whois)) { print "ok 2\n"; } else { print "not ok 2\n"; exit; } if($whois->GetErrorCode()) { printf("Query error: %s\n", $whois->GetErrorString()); print "not ok 3\n"; exit; } else { print "ok 3\n"; } my $test = 4; foreach my $object (qw(BAT-RIPE TIB-RIPE CREW-RIPE)) { my @result = $whois->QueryObjects($object); unless(@result) { printf("Query error: %s\n", $whois->GetErrorString()); print "not ok $test\n"; exit; } else { print "ok $test\n"; print "-" x 30, "\n"; foreach (@result) { print "$_\n"; print "-" x 30, "\n"; } } $test++; } asused-3.72/Whois/ArinWhois/0040755000072700117040000000000007740564516015350 5ustar timursoftiesasused-3.72/Whois/ArinWhois/test.pl0100644000072700117040000000205107270043672016650 0ustar timursofties# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..4\n"; } END { print "not ok 1\n" unless $loaded; } use ArinWhois; $loaded = 1; print "ok 1\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): my $whois = new ArinWhois('Debug' => 0); if(ref($whois)) { print "ok 2\n"; } else { print "not ok 2\n"; exit; } my @result = $whois->QueryObjects("BT235-ARIN"); unless(@result) { printf("Query error: %s\n", $whois->GetErrorString()); print "not ok 3\n"; exit; } else { print "ok 3\n"; } print "-" x 30, "\n"; foreach (@result) { print "$_\n"; print "-" x 30, "\n"; } asused-3.72/Whois/ArinWhois/Makefile.PL0100644000072700117040000000121407740560717017314 0ustar timursoftiesuse 5.005; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. # RIPE NCC common configuration my %PARAM = ( 'INSTALLDIRS' => 'vendor', 'INSTALLSCRIPT' => '$(INSTALLVENDORBIN)', # Hack for Perl prior 5.8.1 'dist' => { 'COMPRESS' => 'gzip', 'SUFFIX' => '.gz', 'CI' => 'cvs ci', 'RCS_LABEL' => 'cvs tag -c -F $(NAME_SYM)-$(VERSION_SYM)', }, ); if($] >= 5.005) { $PARAM{AUTHOR} = 'Timur Bakeyev '; }; WriteMakefile( 'NAME' => 'ArinWhois', 'VERSION_FROM' => 'ArinWhois.pm', # finds $VERSION %PARAM ); asused-3.72/Whois/ArinWhois/ArinWhois.pm0100644000072700117040000001341307270647134017604 0ustar timursofties# Copyright (c) 2000,2001 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 : ArinWhois.pm # Purpose : Make whois queries to ARIN-style servers # Author : Timur Bakeyev # Date : 08082000 # Description : General purpose, simple client to make whois queries # Language Version : Perl5 # OSs Tested : BSD/OS 3.1 # Command Line : None # Input Files : None # Output Files : None # External Programs : None # Problems : None known # To Do : Make more consistent(?) # Comments : # $Id: ArinWhois.pm,v 1.5 2001/04/22 21:34:20 timur Exp $ #------------------------------------------------------------------------------ package ArinWhois; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); require Exporter; @ISA = qw(Exporter Whois); use Whois qw(:ERROR_CODES); use Whois qw(%ERROR); $VERSION = '1.05'; # This strings are perl regexp my %WHOIS_ERROR = ( $WHOIS_TIMEOUT => '%\s+Timeout', $WHOIS_NO_ENTRY => 'No\s+match\s+for', $WHOIS_UNKNOWN_QUERY=> '%\s+Request\s+for\+unknown', $CONNECTION_CLOSED => '(Timeout|Connection)\s+closed\s+by\s+foreign', ); # Regexp for disclamer, returned by ARIN server my $disclamer = '^\s+The\sARIN\sRegistration\sServices\sHost.*\Z'; # Default values for the class my %default = ( 'Host' => 'whois.arin.net', ); #################################################################### # DESCRIPTION: Create new object # INPUT: Hash of parameters, can be: # Host, Port, Timeout, Retry. # OUTPUT: Object reference # SIDE EFFECTS: None # SYNTAX: None #################################################################### sub new { my $proto = shift; my $class = ref($proto) || $proto; my %param = (@_); # Set the host to default if nothing was passed unless($param{'Host'} && $param{'Host'} =~ /^\S+$/) { $param{'Host'} = $default{'Host'}; } # Call the parent constructor my $self = $class->SUPER::new(%param); # Fail, if parent constructor failed return unless($self); bless $self, $class; return $self; } #################################################################### # DESCRIPTION: Split raw query results into array of objects # INPUT: Scalar with the query result or uses internal one # OUTPUT: Error code on error, 0 on success. # SIDE EFFECTS: None # SYNTAX: None #################################################################### sub SplitResult { my $self = shift; # We can obtain result from a parameter my $result = shift || $self->GetResult(); return $self->error($NO_RESULT, $ERROR{$NO_RESULT}) unless($result); foreach my $error (keys(%WHOIS_ERROR)) { # Respond containes one of the errors codes # from Whois server return $self->error($error, $ERROR{$error}) if($result =~ m/$WHOIS_ERROR{$error}/m); } # Get rid of all comment lines $result =~ s/^%.*$//mg; # Remove spaces from the begining # and end of the result $result =~ s/^\s*//s; $result =~ s/\s*$//s; $result =~ s/$disclamer//ms; # No results or failure return $self->error($NO_RESULT, $ERROR{$NO_RESULT}) unless($result); # Split result into objects my @objects = split(/\n\n\n/, $result); # Return result $self->{'objects'} = \@objects; return 0; } #################################################################### # DESCRIPTION: Return array of objects # INPUT: None # OUTPUT: Array or reference to array of objects # SIDE EFFECTS: None # SYNTAX: None #################################################################### sub GetObjects { my $self = shift; return wantarray() ? @{ $self->{'objects'} } : $self->{'objects'}; } #################################################################### # DESCRIPTION: Query whois server and return array of objects # INPUT: Query, that should be send to the server # OUTPUT: Array of objects, or empty on error # SIDE EFFECTS: None # SYNTAX: None #################################################################### sub QueryObjects { my $self = shift; my @query = @_; if(!$self->Query(@query) && !$self->SplitResult()) { return $self->GetObjects(); } return; } 1; __END__ # Below is the stub of documentation for your module. You better edit it! =head1 NAME ArinWhois - Perl extension to retrieve information from ARIN Whois database. =head1 SYNOPSIS use ArinWhois; blah blah blah =head1 DESCRIPTION Stub documentation for ArinWhois was created by h2xs. It looks like the author of the extension was negligent enough to leave the stub unedited. Blah blah blah. =head1 AUTHOR Timur Bakeyev =head1 SEE ALSO perl(1), Whois.pm(3). =cut asused-3.72/Whois/ArinWhois/MANIFEST0100644000072700117040000000006207144507065016466 0ustar timursoftiesArinWhois.pm Changes MANIFEST Makefile.PL test.pl asused-3.72/Whois/ArinWhois/Changes0100644000072700117040000000017207144507065016632 0ustar timursoftiesRevision history for Perl extension ArinWhois. 0.01 Wed Aug 9 18:27:45 2000 - original version; created by h2xs 1.19 asused-3.72/Whois/test.pl0100644000072700117040000000302307342722362014745 0ustar timursofties# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) #use strict; #BEGIN { $| = 1; print "1..7\n"; } #END { print "not ok 1\n" unless $loaded; } use Whois; #$loaded = 1; print "ok 1\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): my $failure = new Whois('Host' => '127.0.0.2'); print "not " if($failure); print "ok 2\n"; print "not " unless($Whois::ERRORCODE); print "ok 3\n"; my $whois = new Whois('Host' => 'whois.ripe.net'); if(ref($whois)) { print "ok 4\n"; } else { print "not ok 4\n"; exit; } if($whois->GetError()) { printf("Query error: %s\n", $whois->GetError()); print "not ok 5\n"; exit; } else { print "ok 5\n"; } my $test = 6; foreach my $object (qw(BAT-RIPE TIB-RIPE)) { if($whois->Query($object)) { printf("Query error: %s\n", $whois->GetError()); print "not ok $test\n"; exit; } else { print "ok $test\n"; } $test++; my $result = $whois->GetResult(); if($result) { print "ok $test\n"; print "-" x 30, "\n"; print $result; print "-" x 30, "\n"; } else { print "not ok $test\n"; exit; } $test++; } asused-3.72/Whois/MANIFEST0100644000072700117040000000064307270015622014561 0ustar timursoftiesChanges MANIFEST Makefile.PL Whois.pm test.pl ArinWhois/ArinWhois.pm ArinWhois/Changes ArinWhois/MANIFEST ArinWhois/Makefile.PL ArinWhois/test.pl RipeWhois/Changes RipeWhois/MANIFEST RipeWhois/Makefile.PL RipeWhois/RipeWhois.pm RipeWhois/test.pl RipeWhois/cwhois RipeWhois/FormatMode/Changes RipeWhois/FormatMode/MANIFEST RipeWhois/FormatMode/Makefile.PL RipeWhois/FormatMode/test.pl RipeWhois/FormatMode/FormatMode.pm asused-3.72/Whois/Changes0100644000072700117040000000016607144507061014726 0ustar timursoftiesRevision history for Perl extension Whois. 0.01 Wed Aug 9 18:21:46 2000 - original version; created by h2xs 1.19 asused-3.72/Whois/Whois.pm0100644000072700117040000003552207714473667015107 0ustar timursofties# Copyright (c) 2000 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 : Whois.pm # Purpose : Make whois queries # Author : Timur Bakeyev # Date : 08082000 # Description : General purpose, simple client to make whois queries # Language Version : Perl5 # OSs Tested : BSD/OS 3.1 # Command Line : None # Input Files : None # Output Files : None # External Programs : None # Problems : None known # To Do : Make more consistent(?) # Comments : # $Id: Whois.pm,v 1.8 2001/08/28 14:04:33 timur Exp $ #------------------------------------------------------------------------------ package Whois; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); use vars qw($ERRORSTRING $ERRORCODE); require Exporter; @ISA = qw(Exporter); # External modules use IO::Socket; # Error handling use Carp; use vars qw( $WHOIS_TIMEOUT $WHOIS_NO_ENTRY $WHOIS_UNKNOWN_QUERY $REQUEST_IGNORED $HOST_CONNECT_ERROR $NO_RESPONSE_FROM_SOCKET $CONNECTION_CLOSED $ERROR_WRITING_SOCKET $NO_RESULT $EMPTY_QUERY $SOCKET_ERROR $NO_HOST_PASSED $NO_PORT_PASSED ); # Error codes use vars qw(%ERROR); @EXPORT = (); @EXPORT_OK = qw(%WHOIS_ERROR %ERROR); %EXPORT_TAGS = ( 'ERROR_CODES' => [qw( $WHOIS_TIMEOUT $WHOIS_NO_ENTRY $WHOIS_UNKNOWN_QUERY $REQUEST_IGNORED $HOST_CONNECT_ERROR $NO_RESPONSE_FROM_SOCKET $CONNECTION_CLOSED $ERROR_WRITING_SOCKET $NO_RESULT $EMPTY_QUERY $SOCKET_ERROR $NO_HOST_PASSED $NO_PORT_PASSED )] ); Exporter::export_ok_tags('ERROR_CODES'); $VERSION = '1.04'; #6xx Other software/system errors $WHOIS_TIMEOUT = 602; $WHOIS_NO_ENTRY = 603; $WHOIS_UNKNOWN_QUERY = 604; $REQUEST_IGNORED = 605; $HOST_CONNECT_ERROR = 622; $NO_RESPONSE_FROM_SOCKET= 623; $CONNECTION_CLOSED = 624; $ERROR_WRITING_SOCKET = 625; $NO_RESULT = 626; $EMPTY_QUERY = 627; $SOCKET_ERROR = 628; $NO_HOST_PASSED = 629; $NO_PORT_PASSED = 630; # List of error messages, that correspond to error codes %ERROR = ( $NO_RESULT => 'No results were returned', $NO_HOST_PASSED => 'No hostname was passed', $NO_PORT_PASSED => 'No port was passed', $WHOIS_TIMEOUT => 'Timeout', $WHOIS_NO_ENTRY => 'No such entry in the database', $WHOIS_UNKNOWN_QUERY=> 'Unknown type of the query', $CONNECTION_CLOSED => 'Connection closed by foreign host', $EMPTY_QUERY => 'Query is empty', ); # Global error variables, work ONLY for constructor $ERRORSTRING = ''; $ERRORCODE = 0; # http://www.ripe.net/ripencc/pub-services/db/rpsl/errors.html # %ERROR:101: no entries found # %ERROR:102: unknown source # %ERROR:103: unknown object type # %ERROR:104: unknown attribute # %ERROR:105: attribute is not searchable # %ERROR:106: no search key specified # # %ERROR:201: access denied # %ERROR:202: access control limit reached # %ERROR:203: address passing not allowed # %ERROR:204: maximum referral lines exceeded # # %ERROR:301: connection has been closed # %ERROR:302: referral timeout # %ERROR:303: no referral host # %ERROR:304: referral host not responding # # %ERROR:401: invalid range: Not within - # %ERROR:402: not authorized to mirror the database # %ERROR:403: unknown source # Default values for the object my %default = ( 'Port' => 'whois(43)', # Default whois port 'Timeout' => 5, # Connection timeout 'Retry' => 3, # Retry count 'Debug' => 0 # Debuging ); #################################################################### # DESCRIPTION: Show debug message, if debugging is on # INPUT: Debug message # OUTPUT: None # SIDE EFFECTS: None # SYNTAX: None #################################################################### sub debug { my $self = shift; my(@dbgString) = @_; if($self->{'Debug'}) { print STDERR @dbgString, "\n"; } } #################################################################### # DESCRIPTION: Set an error code and string and return code # INPUT: Error code, error string # OUTPUT: Error code # SIDE EFFECTS: None # SYNTAX: None #################################################################### sub error { my $self = shift; my($errCode, $errString) = @_; $self->{'ErrorString'} = $errString; $self->{'ErrorCode'} = $errCode; if(wantarray()) { return ($self->{'ErrorCode'}, $self->{'ErrorString'}); } else { return $self->{'ErrorCode'}; } } #################################################################### # DESCRIPTION: Retrive current error # INPUT: None # OUTPUT: Last error string # SIDE EFFECTS: None # SYNTAX: None #################################################################### sub GetError { my $self = shift; if(wantarray()) { return ($self->{'ErrorCode'}, $self->{'ErrorString'}); } else { return $self->{'ErrorCode'}; } } #################################################################### # DESCRIPTION: Retrive current error code # INPUT: None # OUTPUT: Last error string # SIDE EFFECTS: None # SYNTAX: None #################################################################### sub GetErrorCode { my $self = shift; return $self->{'ErrorCode'}; } #################################################################### # DESCRIPTION: Retrive current error code # INPUT: None # OUTPUT: Last error string # SIDE EFFECTS: None # SYNTAX: None #################################################################### sub GetErrorString { my $self = shift; return $self->{'ErrorString'}; } #################################################################### # DESCRIPTION: Clean error status # INPUT: None # OUTPUT: None # SIDE EFFECTS: None # SYNTAX: None #################################################################### sub ClearError { my $self = shift; $self->{'ErrorString'} = ''; $self->{'ErrorCode'} = 0; } #################################################################### # DESCRIPTION: Create new object # INPUT: Hash of parameters, can be: # host, port, timeout, retry. # OUTPUT: Object # SIDE EFFECTS: None # SYNTAX: None #################################################################### sub new { my $proto = shift; my $class = ref($proto) || $proto; my %param = (@_); my $param = ''; my $self = { }; bless $self, $class; # Clear global error variables $ERRORSTRING = ''; $ERRORCODE = 0; # Turn debugging on if necessary $self->{'Debug'} = $default{'Debug'}; $param = delete $param{'Debug'}; if($param && $param =~ /^\d+$/) { $self->{'Debug'} = $param; } # We can override debuging switch through the environment if($ENV{'WHOIS_DEBUG'} && $ENV{'WHOIS_DEBUG'} =~ /^\d+$/) { $self->{'Debug'} = $ENV{'WHOIS_DEBUG'}; } # Get server name and port $param = delete $param{'Host'}; $self->{'Host'} = ($param && $param =~ /^\S+$/) ? $param : $default{'Host'}; # We can override hostname through the environment if($ENV{'WHOIS_HOST'} && $ENV{'WHOIS_HOST'} =~ /^\S+$/) { $self->{'Host'} = $ENV{'WHOIS_HOST'}; } $self->debug("Host: ", $self->{'Host'}); $param = delete $param{'Port'}; $self->{'Port'} = ($param && $param =~ /^\S+$/) ? $param : $default{'Port'}; # We can override port through the environment if($ENV{'WHOIS_PORT'} && $ENV{'WHOIS_PORT'} =~ /^\S+$/) { $self->{'Port'} = $ENV{'WHOIS_PORT'}; } $self->debug("Port: ", $self->{'Port'}); # Use passed timeout if supplied $param = delete $param{'Timeout'}; $self->{'Timeout'} = ($param && $param =~ /^\d+$/) ? $param : $default{'Timeout'}; $self->debug("Timeout: ", $self->{'Timeout'}); # Use passed retry count if supplied $param = delete $param{'Retry'}; $self->{'Retry'} = ($param && $param =~ /^\d+$/) ? $param : $default{'Retry'}; $self->debug("Retry count: ", $self->{'Retry'}); croak("Illeagal attributes: " . join(' ', sort(keys(%param)))) if(%param); # Clear errors $self->ClearError(); # Try to open connection and destroy object, if fail. if($self->Open()) { # Put the connection error into the global variables # for farther investigations of the failure ($ERRORCODE, $ERRORSTRING) = $self->GetError(); # No object was created return; } $self->debug(ref($self), " object was created"); return $self; } #################################################################### # DESCRIPTION: Open connection to whois server # INPUT: None # OUTPUT: Error code on error, 0 on success. # SIDE EFFECTS: None # SYNTAX: None #################################################################### sub Open { my $self = shift; # Clear error $self->ClearError(); # Check, that we really do have where to connect to return $self->error($NO_HOST_PASSED, $ERROR{$NO_HOST_PASSED}) unless($self->{'Host'}); return $self->error($NO_PORT_PASSED, $ERROR{$NO_PORT_PASSED}) unless($self->{'Port'}); # Retry count my $retry = 0; # Create connection do { if($retry++ > $self->{'Retry'}) { return $self->error($HOST_CONNECT_ERROR, sprintf("Can't connect to %s:%s after %d attempts", $self->{'Host'}, $self->{'Port'}, $retry)); } # Delay between attempts sleep($retry); # Create connection $self->{'Sock'} = IO::Socket->new( Domain => AF_INET, PeerAddr => $self->{'Host'}, PeerPort => $self->{'Port'}, Proto => 'tcp', Type => SOCK_STREAM, Timeout => $self->{'Timeout'} ); } until($self->{'Sock'}); # Ok return 0; } #################################################################### # DESCRIPTION: Query whois server # INPUT: Query, that should be send to the server # OUTPUT: Error code on error, 0 on success. # SIDE EFFECTS: None # SYNTAX: None #################################################################### sub Query { my $self = shift; # Filter out empty paramters my @query = grep { /\S+/ } @_; # Convert an array of parameters into string my $query = join(' ', @query); # Make sure we don't have trailing "\r|\n" if($query) { $query =~ s/\s*$//s; $query =~ s/^\s*//s; } # Clear error $self->ClearError(); # If query is empty - fail return $self->error($EMPTY_QUERY, $ERROR{$EMPTY_QUERY}) unless($query); # Store query for farther references $self->{'Query'} = $query; # Check, that connection exist unless(defined($self->{'Sock'}) && $self->{'Sock'}->opened()) { # Try to re-open connection my $error = $self->Open(); $self->debug("Try to re-open connection"); # Return, if reconnection failed return $error if($error); } # Make local change of input record separator # XXX This is RIPE specific, but, hopefuly, harmless local $/ = "\n\n\n"; # Clear old result undef($self->{'Result'}); # Just make shortcut to ease access my $sock = $self->{'Sock'}; # In case of any other error also terminate return $self->error($SOCKET_ERROR, $sock->error()) if($sock->error()); $self->debug("Query: ", $self->{'Query'}); # Pass a query to the server $sock->printf("%s\x0d\x0a", $self->{'Query'}); # In case of any other error also terminate return $self->error($SOCKET_ERROR, $sock->error()) if($sock->error()); # Obtain results from the server $self->{'Result'} = $sock->getline(); $self->debug("Result: ", $self->{'Result'}); # In case of any other error also terminate return $self->error($SOCKET_ERROR, $sock->error()) if($sock->error()); # Close the connection $self->Close(); # Everything is ok return 0; } #################################################################### # DESCRIPTION: Return raw result of the query # INPUT: None # OUTPUT: Scalar with the result # SIDE EFFECTS: None # SYNTAX: None #################################################################### sub GetResult { my $self = shift; return $self->{'Result'}; } #################################################################### # DESCRIPTION: Close connection with the whois server # INPUT: None # OUTPUT: None # SIDE EFFECTS: None # SYNTAX: None #################################################################### sub Close { my $self = shift; if(defined($self->{'Sock'}) && $self->{'Sock'}->opened()) { $self->debug("Shutdown the connection"); $self->{'Sock'}->shutdown(2); $self->{'Sock'}->close(); } # Destroy socket undef($self->{'Sock'}); } #################################################################### # DESCRIPTION: Destructor for the object. # INPUT: None # OUTPUT: None # SIDE EFFECTS: None # SYNTAX: None #################################################################### sub DESTROY { my $self = shift; $self->Close(); $self->debug(ref($self), " object was destroyed"); } 1; __END__ # Below is the stub of documentation for your module. You better edit it! =head1 NAME Whois - Perl extension to make queries to the whois servers =head1 SYNOPSIS use Whois; $whois = new Whois('Host' => 'whois.ripe.net'); die("Failed to create object") unless(ref($whois)); die($whois->GetError()) if($whois->GetError()); if($whois->Query("BAT-RIPE")) { printf("Query error: %s\n", $whois->GetError()); exit; } my $result = $whois->GetResult(); if($result) { print "$result\n"; } else { printf("No results: %s\n", $whois->GetError()); } $whois->Close(); =head1 DESCRIPTION Stub documentation for Whois was created by h2xs. It looks like the author of the extension was negligent enough to leave the stub unedited. Blah blah blah. =head1 AUTHOR Timur Bakeyev =head1 SEE ALSO perl(1). =cut asused-3.72/Whois/Makefile.PL0100644000072700117040000000127007740560705015410 0ustar timursoftiesuse 5.005; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. # RIPE NCC common configuration my %PARAM = ( 'INSTALLDIRS' => 'vendor', 'INSTALLSCRIPT' => '$(INSTALLVENDORBIN)', # Hack for Perl prior 5.8.1 'dist' => { 'COMPRESS' => 'gzip', 'SUFFIX' => '.gz', 'CI' => 'cvs ci', 'RCS_LABEL' => 'cvs tag -c -F $(NAME_SYM)-$(VERSION_SYM)', }, ); if($] >= 5.005) { $PARAM{AUTHOR} = 'Timur Bakeyev '; }; WriteMakefile( 'NAME' => 'Whois', 'VERSION_FROM' => 'Whois.pm', # finds $VERSION 'PREREQ_PM' => { 'IO::Socket' => '1.20' }, %PARAM ); asused-3.72/NCC/0040755000072700117040000000000007740564516012757 5ustar timursoftiesasused-3.72/NCC/CountryCode/0040755000072700117040000000000007740564516015215 5ustar timursoftiesasused-3.72/NCC/CountryCode/CountryCode.pm0100644000072700117040000007426307347161125020012 0ustar timursofties# Copyright (c) 2001 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 : NCC::CountryCode.pm # Author : Timur I. Bakeyev # Date : 200104 # Description : Provides OO interface to the list of country codes # Language Version : Perl 5.6.0 # OSs Tested : BSD/OS 3.1 # Command Line : - # Input Files : - # Output Files : - # External Programs : - # Problems : - # Comments : # $Id: CountryCode.pm,v 1.5 2001/09/10 15:55:01 timur Exp $ #------------------------------------------------------------------------------ package NCC::CountryCode; use strict; use vars qw($VERSION @ISA); require Exporter; @ISA = qw(Exporter); $VERSION = '0.04'; # Location of the local is 3166 file my $codes = '/usr/local/etc/NCC/iso3166-codes'; #################################################################### # DESCRIPTION: Constructor # INPUT: None # OUTPUT: New instance of the class or undef # SIDE EFFECTS: None #################################################################### sub new { my $proto = shift; my $class = ref($proto) || $proto; my %param = @_; my $self = { }; bless $self, $class; # Don't return object, if failed to initialiaze return unless($self->_init()); return $self; } #################################################################### # DESCRIPTION: Read country code list and put it into the hash # INPUT: None # OUTPUT: 1, if initialization was successful # 0, otherwise # SIDE EFFECTS: None #################################################################### sub _init { my $self = shift; # Try to use external data if(open(FILE, $codes)) { while() { if(m%^(.+?)\s+([A-Z]{2})\s+([A-Z]{3})\s+(\d{3})\s*$%) { $self->{'CC'}{uc($2)} = uc($1); } } close(FILE); } else { # Get the begining of the DATA stream my $filepos = tell(DATA); # Load list of country codes while() { if(m%^(.+?)\s+([A-Z]{2})\s+([A-Z]{3})\s+(\d{3})\s*$%) { $self->{'CC'}{uc($2)} = uc($1); } } # Rewind to the begining of the DATA stream seek(DATA, $filepos, 0); } # XXX: Hack(tm) # UK and EU are non-official, but widely used country codes, so # we insert the information about them. $self->{'CC'}{'UK'} = $self->{'CC'}{'GB'}; $self->{'CC'}{'EU'} = 'EUROPE'; # Success return 1; } #################################################################### # DESCRIPTION: Return a reference to the hash of country codes # and assotiated countries # INPUT: None # OUTPUT: Reference to the hash # SIDE EFFECTS: None #################################################################### sub getCCs { my $self = shift; # return the CC hash ref return $self->{'CC'}; } #################################################################### # DESCRIPTION: Check if passed CC is valid # INPUT: Country code # OUTPUT: Valid CC or empty string, if no # SIDE EFFECTS: None #################################################################### sub isCC { my $self = shift; my($cc) = @_; return '' unless($cc); # Uppercase the possible country code $cc = uc($cc); my $ret = $self->{'CC'}{$cc}; # Return country code if there is one or nothing. return ($ret) ? $cc : ''; } #################################################################### # DESCRIPTION: Return country name by country code # INPUT: Country code # OUTPUT: Country name or empty string if no # SIDE EFFECTS: None #################################################################### sub CC2Country { my $self = shift; my($cc) = @_; return '' unless($cc); # Uppercase the possible country code $cc = uc($cc); my $ret = $self->{'CC'}{$cc}; # Return country name if there is one or nothing. return ($ret) ? $ret : ''; } #################################################################### # DESCRIPTION: Return country code(s) by country name # INPUT: Country name # OUTPUT: Hash of matching country codes with country names # or a string in scalar context # SIDE EFFECTS: Return nothing if passed string less than 4 chars #################################################################### sub Country2CC { my $self = shift; my($country) = @_; return '' unless($country); # Skip too short names return if(length($country) < 4); # Quote possible meta chars $country = quotemeta($country); # The resulting hash my %ret = (); foreach my $cc (keys(%{$self->{'CC'}})) { # If passed string is a part of country name - store the result if($self->{'CC'}{$cc} =~ /$country/i) { $ret{$cc} = $self->{'CC'}{$cc}; } } # Return the result if(wantarray()) { # As a hash(array) return(%ret); } else { # As a scalar my $ret = ''; # Walk through the hash and convert it into scalar foreach my $cc (sort(keys(%ret))) { $ret .= sprintf("%s: %s; ", $cc, $ret{$cc}); } return $ret; } } 1; =head1 NAME NCC::CountryCode - Perl extension for blah blah blah =head1 SYNOPSIS use NCC::CountryCode; my $cc = new NCC::CountryCode(); my $cc_hash = $cc->getCCs(); print ($cc->isCC('NL')) ? "exists" : "non-existing"; $cc->CC2Country('fr'); $cc->Country2CC('russia'); =head1 DESCRIPTION This module provides class and several methods to simplify mapping between country names and country codes, as they assigned in the ISO3166. The CC2Country() method maps country code to the corresponding country name or empty string, if it doesn\'t exist. The Country2CC() tries to map passed country name into country code. As the spelling of the name may vary, this function tries to find all possible matches for passed name. In array context method returns hash of country codes and names, in scalar - a string, containing all possible country codes and corresponding country names. The isCC() method verifies, that passed country code is a legal one and returns it in upper case. Otherwise it returns empty string. The getCCs() method returns the reference to the internal hash, that containes all the country codes with corresponding them country names. =head1 BUGS In addition to the country codes defined by ISO3166 standart this module also introduce 'UK' as a synonim for 'GB' and 'EU' as additional 'virtual' name for the Europe itself. =head1 AUTHOR Timur Bakeyev, timur@ripe.net =head1 SEE ALSO perl(1). =cut __DATA__ Some Codes from ISO 3166 Updated by the RIPE Network Coordination Centre. Source: ISO 3166 Maintenance Agency Latest change: Thu Aug 7 17:59:51 MET DST 1997 Country A 2 A 3 Number ---------------------------------------------------------------------- AFGHANISTAN AF AFG 004 ALBANIA AL ALB 008 ALGERIA DZ DZA 012 AMERICAN SAMOA AS ASM 016 ANDORRA AD AND 020 ANGOLA AO AGO 024 ANGUILLA AI AIA 660 ANTARCTICA AQ ATA 010 ANTIGUA AND BARBUDA AG ATG 028 ARGENTINA AR ARG 032 ARMENIA AM ARM 051 ARUBA AW ABW 533 AUSTRALIA AU AUS 036 AUSTRIA AT AUT 040 AZERBAIJAN AZ AZE 031 BAHAMAS BS BHS 044 BAHRAIN BH BHR 048 BANGLADESH BD BGD 050 BARBADOS BB BRB 052 BELARUS BY BLR 112 BELGIUM BE BEL 056 BELIZE BZ BLZ 084 BENIN BJ BEN 204 BERMUDA BM BMU 060 BHUTAN BT BTN 064 BOLIVIA BO BOL 068 BOSNIA AND HERZEGOWINA BA BIH 070 BOTSWANA BW BWA 072 BOUVET ISLAND BV BVT 074 BRAZIL BR BRA 076 BRITISH INDIAN OCEAN TERRITORY IO IOT 086 BRUNEI DARUSSALAM BN BRN 096 BULGARIA BG BGR 100 BURKINA FASO BF BFA 854 BURUNDI BI BDI 108 CAMBODIA KH KHM 116 CAMEROON CM CMR 120 CANADA CA CAN 124 CAPE VERDE CV CPV 132 CAYMAN ISLANDS KY CYM 136 CENTRAL AFRICAN REPUBLIC CF CAF 140 CHAD TD TCD 148 CHILE CL CHL 152 CHINA CN CHN 156 CHRISTMAS ISLAND CX CXR 162 COCOS (KEELING) ISLANDS CC CCK 166 COLOMBIA CO COL 170 COMOROS KM COM 174 CONGO CG COG 178 CONGO, THE DEMOCRATIC REPUBLIC OF THE CD COD 180 COOK ISLANDS CK COK 184 COSTA RICA CR CRI 188 COTE D'IVOIRE CI CIV 384 CROATIA (local name: Hrvatska) HR HRV 191 CUBA CU CUB 192 CYPRUS CY CYP 196 CZECH REPUBLIC CZ CZE 203 DENMARK DK DNK 208 DJIBOUTI DJ DJI 262 DOMINICA DM DMA 212 DOMINICAN REPUBLIC DO DOM 214 EAST TIMOR TP TMP 626 ECUADOR EC ECU 218 EGYPT EG EGY 818 EL SALVADOR SV SLV 222 EQUATORIAL GUINEA GQ GNQ 226 ERITREA ER ERI 232 ESTONIA EE EST 233 ETHIOPIA ET ETH 231 FALKLAND ISLANDS (MALVINAS) FK FLK 238 FAROE ISLANDS FO FRO 234 FIJI FJ FJI 242 FINLAND FI FIN 246 FRANCE FR FRA 250 FRANCE, METROPOLITAN FX FXX 249 FRENCH GUIANA GF GUF 254 FRENCH POLYNESIA PF PYF 258 FRENCH SOUTHERN TERRITORIES TF ATF 260 GABON GA GAB 266 GAMBIA GM GMB 270 GEORGIA GE GEO 268 GERMANY DE DEU 276 GHANA GH GHA 288 GIBRALTAR GI GIB 292 GREECE GR GRC 300 GREENLAND GL GRL 304 GRENADA GD GRD 308 GUADELOUPE GP GLP 312 GUAM GU GUM 316 GUATEMALA GT GTM 320 GUINEA GN GIN 324 GUINEA-BISSAU GW GNB 624 GUYANA GY GUY 328 HAITI HT HTI 332 HEARD AND MC DONALD ISLANDS HM HMD 334 HOLY SEE (VATICAN CITY STATE) VA VAT 336 HONDURAS HN HND 340 HONG KONG HK HKG 344 HUNGARY HU HUN 348 ICELAND IS ISL 352 INDIA IN IND 356 INDONESIA ID IDN 360 IRAN (ISLAMIC REPUBLIC OF) IR IRN 364 IRAQ IQ IRQ 368 IRELAND IE IRL 372 ISRAEL IL ISR 376 ITALY IT ITA 380 JAMAICA JM JAM 388 JAPAN JP JPN 392 JORDAN JO JOR 400 KAZAKHSTAN KZ KAZ 398 KENYA KE KEN 404 KIRIBATI KI KIR 296 KOREA, DEMOCRATIC PEOPLE'S REPUBLIC OF KP PRK 408 KOREA, REPUBLIC OF KR KOR 410 KUWAIT KW KWT 414 KYRGYZSTAN KG KGZ 417 LAO PEOPLE'S DEMOCRATIC REPUBLIC LA LAO 418 LATVIA LV LVA 428 LEBANON LB LBN 422 LESOTHO LS LSO 426 LIBERIA LR LBR 430 LIBYAN ARAB JAMAHIRIYA LY LBY 434 LIECHTENSTEIN LI LIE 438 LITHUANIA LT LTU 440 LUXEMBOURG LU LUX 442 MACAU MO MAC 446 MACEDONIA, THE FORMER YUGOSLAV REPUBLIC OF MK MKD 807 MADAGASCAR MG MDG 450 MALAWI MW MWI 454 MALAYSIA MY MYS 458 MALDIVES MV MDV 462 MALI ML MLI 466 MALTA MT MLT 470 MARSHALL ISLANDS MH MHL 584 MARTINIQUE MQ MTQ 474 MAURITANIA MR MRT 478 MAURITIUS MU MUS 480 MAYOTTE YT MYT 175 MEXICO MX MEX 484 MICRONESIA, FEDERATED STATES OF FM FSM 583 MOLDOVA, REPUBLIC OF MD MDA 498 MONACO MC MCO 492 MONGOLIA MN MNG 496 MONTSERRAT MS MSR 500 MOROCCO MA MAR 504 MOZAMBIQUE MZ MOZ 508 MYANMAR MM MMR 104 NAMIBIA NA NAM 516 NAURU NR NRU 520 NEPAL NP NPL 524 NETHERLANDS NL NLD 528 NETHERLANDS ANTILLES AN ANT 530 NEW CALEDONIA NC NCL 540 NEW ZEALAND NZ NZL 554 NICARAGUA NI NIC 558 NIGER NE NER 562 NIGERIA NG NGA 566 NIUE NU NIU 570 NORFOLK ISLAND NF NFK 574 NORTHERN MARIANA ISLANDS MP MNP 580 NORWAY NO NOR 578 OMAN OM OMN 512 PAKISTAN PK PAK 586 PALAU PW PLW 585 PALESTINIAN TERRITORY, OCCUPIED PS PSE 275 PANAMA PA PAN 591 PAPUA NEW GUINEA PG PNG 598 PARAGUAY PY PRY 600 PERU PE PER 604 PHILIPPINES PH PHL 608 PITCAIRN PN PCN 612 POLAND PL POL 616 PORTUGAL PT PRT 620 PUERTO RICO PR PRI 630 QATAR QA QAT 634 REUNION RE REU 638 ROMANIA RO ROM 642 RUSSIAN FEDERATION RU RUS 643 RWANDA RW RWA 646 SAINT KITTS AND NEVIS KN KNA 659 SAINT LUCIA LC LCA 662 SAINT VINCENT AND THE GRENADINES VC VCT 670 SAMOA WS WSM 882 SAN MARINO SM SMR 674 SAO TOME AND PRINCIPE ST STP 678 SAUDI ARABIA SA SAU 682 SENEGAL SN SEN 686 SEYCHELLES SC SYC 690 SIERRA LEONE SL SLE 694 SINGAPORE SG SGP 702 SLOVAKIA (Slovak Republic) SK SVK 703 SLOVENIA SI SVN 705 SOLOMON ISLANDS SB SLB 090 SOMALIA SO SOM 706 SOUTH AFRICA ZA ZAF 710 SOUTH GEORGIA AND THE SOUTH SANDWICH ISLANDS GS SGS 239 SPAIN ES ESP 724 SRI LANKA LK LKA 144 ST. HELENA SH SHN 654 ST. PIERRE AND MIQUELON PM SPM 666 SUDAN SD SDN 736 SURINAME SR SUR 740 SVALBARD AND JAN MAYEN ISLANDS SJ SJM 744 SWAZILAND SZ SWZ 748 SWEDEN SE SWE 752 SWITZERLAND CH CHE 756 SYRIAN ARAB REPUBLIC SY SYR 760 TAIWAN, PROVINCE OF CHINA TW TWN 158 TAJIKISTAN TJ TJK 762 TANZANIA, UNITED REPUBLIC OF TZ TZA 834 THAILAND TH THA 764 TOGO TG TGO 768 TOKELAU TK TKL 772 TONGA TO TON 776 TRINIDAD AND TOBAGO TT TTO 780 TUNISIA TN TUN 788 TURKEY TR TUR 792 TURKMENISTAN TM TKM 795 TURKS AND CAICOS ISLANDS TC TCA 796 TUVALU TV TUV 798 UGANDA UG UGA 800 UKRAINE UA UKR 804 UNITED ARAB EMIRATES AE ARE 784 UNITED KINGDOM GB GBR 826 UNITED STATES US USA 840 UNITED STATES MINOR OUTLYING ISLANDS UM UMI 581 URUGUAY UY URY 858 UZBEKISTAN UZ UZB 860 VANUATU VU VUT 548 VENEZUELA VE VEN 862 VIET NAM VN VNM 704 VIRGIN ISLANDS (BRITISH) VG VGB 092 VIRGIN ISLANDS (U.S.) VI VIR 850 WALLIS AND FUTUNA ISLANDS WF WLF 876 WESTERN SAHARA EH ESH 732 YEMEN YE YEM 887 YUGOSLAVIA YU YUG 891 ZAMBIA ZM ZMB 894 ZIMBABWE ZW ZWE 716 ---------------------------------------------------------------------- List of changes applied, as specified in registration newsletters: Newsletter III-1, 1989-12-5: Burma deleted, Myanmar added (same numeric value, change of country name) Newsletter III-2, 1990-07-16 Namibia, changing information not included in this file Newsletter III-3, 1990-08-14 Afghanistan, changing information not included in this file Newsletter III-4, 1990-08-14 Ethiopia, changing information not included in this file Newsletter III-5, 1990-08-14 Fiji, changing information not included in this file Newsletter III-6, 1990-08-14 Hungary, changing information not included in this file Newsletter III-7, 1990-08-14 Unification of Yemen, under new numeric code Newsletter III-8, 1990-08-14 Romania, changing information not included in this file Newsletter III-9, 1990-08-14 Poland, changing information not included in this file Newsletter III-10, 1990-08-14 Kampuchea deleted, Cambodia added (same numeric value, change of name) Newsletter III-11, 1990-08-14 Benin, changing information not included in this file Newsletter III-12, 1990-12-04 Czechoslovakia, changing information not included in this file Newsletter III-13, 1990-10-30 Germany unified (DDR deleted, new name and numeric code for unified Germany) Newsletter III-14 1991-02-10 Mozambique, changing information not included in this file Newsletter III-15 1991-02-10 Bulgaria, changing information not included in this file Newsletter III-16 1992-06-15 ESTONIA added (EE, EST, 233) Newsletter III-17 1992-06-15 LATVIA added (LV, LVA, 428) Newsletter III-18 1992-06-15 Lithuania added Newsletter III-19 1992-06-15 Belarus, named and 3c changed Newsletter III-20 1992-04-06 Albania, changing information not included in this file Newsletter III-21 1992-04-06 Congo, changing information not included in this file Newsletter III-22 1992-04-19 Micronesia, name changed to Micronesia (Federated States of) Newsletter III-23 1992-04-19 Ukraine, name changed Newsletter III-24 1993-06-18 France, Metropolitan (FX) added (European part of France thus excluding: GF, GP, MQ, NC, PF, PM, RE, TF, WF, YT) Newsletter III-25, 1991-12-18 Pitcairn, changing information not included in this file Newsletter III-26, 1992-06-15 Croatia, added NR, HRV, 191 Newsletter III-27, 1992-06-15 Armenia, added AM, ARM, 051 Newsletter III-28, 1992-08-28 Georgia added Newsletter III-29, 1992-06-15 Russian Federation added Newsletter III-30, 1992-06-15 Turkmenistan added Newsletter III-31, 1992-06-15 Kazakhstan added Newsletter III-32, 1992-06-15 Kyrgyzstan added Newsletter III-33, 1992-06-15 Tajikistan added Newsletter III-34, 1992-06-15 Uzbekistan added Newsletter III-35, 1992-06-15 Azerbaijan added Newsletter III-36 1992-06-15 MOLDOVA, REPUBLIC OF added (MD, MDA, 498) Newsletter III-37 1992-08-30 USSR deleted Newsletter III-38, 1993-06-15 Slovenia, number code 705 assigned Newsletter III-39 (undated) BOSNIA AND HERZEGOWINA added (BA, BIH, 070) Newsletter III-40 1993-07-12 YEMEN, REPUBLIC OF changed to YEMEN Newsletter III-41 1993-07-28 MAURITIUS, changes outside this document Newletter III-42 1993-07-12 SAINT VINCENT AND THE GRENADINES, changes outside this document Newsletter III-43 1993-07-12 MONGOLIA, changes outside this document Newsletter III-44 1993-07-22 PANAMA, changed numeric code from 590 to 591 Newsletter III-45 1993-07-28 YUGOSLAVIA changed numeric code from 890 to 891 Newsletter III-46 1993-07-12 NEUTRAL ZONE deleted Newsletter III-47 1993-07-12 NETHERLANDS ANTILLES changed numeric code from 532 to 530 Newsletter III-48, 1993-07-12 Added MAYOTTE Newsletter III-49, 1993-06-15 Slovakia added Newsletter III-50, 1993-06-15 Czech Republic added Newsletter III-51, 1993-06-15 Czechoslovakia officially deleted Newsletter III-52, 1993-07-02 Angola, changing information not included in this file. Offical name change to Republic of Angola Newsletter III-53, 1993-07-12 Madagascar, changing information not included in this file. Official name change to Republic of Madagascar Newsletter III-54, 1993-07-23 South Georgia and the South Sandwich Islands, previously covered by Falkland Islands Newsletter III-55, 1993-07-16 Ethiopia, numeric code change to 231 Newsletter III-56, 1993-07-16 Eritrea, changing information not included in this file Previously covered by the entry ET Newsletter III-57, 1993-07-16 Macedonia, the former Yugolslav Republic of, Previously covered by the entry YU Newsletter III-58, 1993-07-16 Afghanistan, changing information not included in this file Official name change to Islamic State of Afghanistan Newsletter III-32, 1993-07-25 ammendment Kyrgyzstan, changing information not included in this file. Offical name change to Kyrgyz Republic Newsletter III-59, 1994-01-26 Andorra, changing information not included in this file. Offical name change to Pricipality of Andorra Newsletter III-60, 1994-01-26 Cambodia, changing information not included in this file. Offical name change to Kingdom of Cambodia Announcement, 1994-02-02 At this point the fourth edition of ISO 3166 appears. It can *now* be ordered from national standards institutions. The RIPE NCC will continue tracking changes. Newsletter IV-1, 1996-04-03 Vatican, change name from VATICAN CITY STATE (HOLY SEE) to HOLY SEE (VATICAN CITY STATE) Annual Report 1996, 1996-12-20 No further changes have been made to 3166-IV. The fifth edition will consist of three parts: 3166-1 country codes / DIS published April 96 / IS expected summer|fall 97 "The list of country names remains basically unchanged." 3166-2 country subdivision code / DIS published November 1996 3166-3 Code for formerly used names of countries / DIS expected spring 97 Quote: We are delighted to notice that the acceptance of ISO3166 among users of country codes is growing. However, the use of ISO3166 e.g. in the Internet confronts ISO3166/MA with formerly unknown problems. One among these problems is that more and more "non-country-entities" as e.g. organisations, interest groups or groupings of countries request ISO3166 code elements. The scope of the standard does not allow for allocation of code elements to such "groups". Newsletter IV-2 1997-07-14 ZAIRE (ZA) changed to CONGO, THE DEMOCRATIC REPUBLIC OF THE (CD) change of name, alpha-2 and alpha-3, numeric remains 180 3166-1 is now expected to be published by August/September 1997 asused-3.72/NCC/CountryCode/Changes0100644000072700117040000000017407261045024016471 0ustar timursofties29-03-2001 Timur Bakeyev * Module for easy access to the country code information was created. asused-3.72/NCC/CountryCode/Makefile.PL0100644000072700117040000000122607714474124017161 0ustar timursoftiesuse 5.005; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. # RIPE NCC common configuration my %PARAM = ( 'INSTALLDIRS' => 'vendor', 'INSTALLSCRIPT' => '$(INSTALLVENDORBIN)', # Hack for Perl prior 5.8.1 'dist' => { 'COMPRESS' => 'gzip', 'SUFFIX' => '.gz', 'CI' => 'cvs ci', 'RCS_LABEL' => 'cvs tag -c -F $(NAME_SYM)-$(VERSION_SYM)', }, ); if($] >= 5.005) { $PARAM{AUTHOR} = 'Timur Bakeyev '; }; WriteMakefile( 'NAME' => 'NCC::CountryCode', 'VERSION_FROM' => 'CountryCode.pm', # finds $VERSION %PARAM ); asused-3.72/NCC/CountryCode/MANIFEST0100644000072700117040000000006407261045024016325 0ustar timursoftiesChanges CountryCode.pm MANIFEST Makefile.PL test.pl asused-3.72/NCC/CountryCode/test.pl0100644000072700117040000000234507261045025016515 0ustar timursofties# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..8\n"; } END {print "not ok 1\n" unless $loaded;} use NCC::CountryCode; $loaded = 1; print "ok 1\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): my $cc = new NCC::CountryCode(); print "not " unless $cc; print "ok 2\n"; unless($cc->isCC('ru')) { print "not "; } print "ok 3\n"; unless($cc->isCC('GB')) { print "not "; } print "ok 4\n"; unless($cc->isCC('zw')) { print "not "; } print "ok 5\n"; if($cc->CC2Country('kp') ne 'KOREA, DEMOCRATIC PEOPLE\'S REPUBLIC OF') { print "not "; } print "ok 6\n"; if($cc->Country2CC('korea') ne 'KP: KOREA, DEMOCRATIC PEOPLE\'S REPUBLIC OF; KR: KOREA, REPUBLIC OF; ') { print "not "; } print "ok 7\n"; if($cc->Country2CC('xxxxxxxxxx')) { print "not "; } print "ok 8\n"; asused-3.72/NCC/Makefile.PL0100644000072700117040000000026007265044707014721 0ustar timursoftiesuse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'NCC', ); asused-3.72/NCC/RipeDelegations/0040755000072700117040000000000007740564516016035 5ustar timursoftiesasused-3.72/NCC/RipeDelegations/test.pl0100644000072700117040000000274207347156160017346 0ustar timursofties# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..10\n"; } END {print "not ok 1\n" unless $loaded;} use NCC::RipeDelegations qw(@DELEGATIONS); $loaded = 1; print "ok 1\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): unless(@DELEGATIONS) { print "not "; } print "ok 2\n"; my $del = new NCC::RipeDelegations(); unless($del) { print "not "; } print "ok 3\n"; unless($del->isDelegation('217.0.0.0 - 217.255.255.255')) { print "not "; } print "ok 4\n"; unless($del->isDelegation('81.0.0.0 - 81.255.255.255')) { print "not "; } print "ok 5\n"; unless($del->Contains('81.100.2.3 - 81.100.22.33')) { print "not "; } print "ok 6\n"; unless($del->Contains('81.0.0.0 - 81.255.255.255')) { print "not "; } print "ok 7\n"; unless(!$del->Contains('181.100.2.3 - 181.100.22.33')) { print "not "; } print "ok 8\n"; unless($del->Contains('192.162.0.0 - 192.162.255.255')) { print "not "; } print "ok 9\n"; unless(!$del->Contains('192.168.0.0 - 192.168.255.255')) { print "not "; } print "ok 10\n"; asused-3.72/NCC/RipeDelegations/RipeDelegations.pm0100644000072700117040000001757107740564472021462 0ustar timursofties# Copyright (c) 2001 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 : NCC::RipeDelegations.pm # Author : Timur I. Bakeyev # Date : 200104 # Description : Provides OO interface to the list of IP delegations from IANA # Language Version : Perl 5.6.0 # OSs Tested : BSD/OS 3.1 # Command Line : - # Input Files : - # Output Files : - # External Programs : - # Problems : - # Comments : # $Id: RipeDelegations.pm,v 1.7 2001/09/10 15:47:23 timur Exp $ #------------------------------------------------------------------------------ package NCC::RipeDelegations; use strict; use vars qw($VERSION @ISA @EXPORT_OK @DELEGATIONS); require Exporter; @ISA = qw(Exporter); @EXPORT_OK = qw(@DELEGATIONS); $VERSION = '0.04'; use ipv4pack; # XXX: This should be separate module! my $OCTET = "(?:\\d|[1-9]\\d|1\\d\\d|2[0-4]\\d|25[0-5])"; my $IP = "(?:$OCTET(?:\\.$OCTET){0,3})"; my $IP_RANGE = "$IP\\s*\\-\\s*$IP"; my $IP_RANGE_RE = "($IP) *\\- *($IP)"; # Location of the external delegations data file(RIPE) my $delegations = '/ncc/ip-reg/delegations'; #################################################################### # DESCRIPTION: Constructor # INPUT: None # OUTPUT: New instance of the class or undef # SIDE EFFECTS: None #################################################################### sub new { my $proto = shift; my $class = ref($proto) || $proto; my %param = @_; my $self = { }; bless $self, $class; # Don't return object, if failed to initialiaze return unless($self->_init()); return $self; } #################################################################### # DESCRIPTION: Read RIPE delegations list and put it into the hash # INPUT: None # OUTPUT: 1, if initialization was successful # 0, otherwise # SIDE EFFECTS: None #################################################################### sub _init { my $self = shift; # List of delegated ranges my @delegations = (); # Try to use external data if(open(FILE, $delegations)) { while() { # Skip comments next if(/^#.*/); # Skip empty lines next if(/^\s*$/); # Extract the range push(@delegations, $1) if(/\"(.*?\s*\-\s*.*?)\"/); } close(FILE); } # Fall back to bundled list else { # Get the initial pozition of in the DATA stream my $filepos = tell(DATA); # Load list of ranges while() { # Skip comments next if(/^#.*/); # Skip empty lines next if(/^\s*$/); # Extract the range push(@delegations, $1) if(m%^\s*($IP_RANGE)\s*$%); } # Rewind to the begining of the stream seek(DATA, $filepos, 0); } # Try to normalize obtained ranges foreach my $range (@delegations) { # Normalize the range my($inetnum, $respond) = normalizerange($range); # If the range is ok, we'll keep it if($respond == $O_OK && $inetnum) { my($ip1, $ip2) = ($inetnum =~ m%^$IP_RANGE_RE$%); # Skip, if didn't extract quads next unless($ip1 && $ip2); my $int1 = quad2int($ip1); my $int2 = quad2int($ip2); # Skip bogus ranges next unless($int1 >= 0 && $int2 >= 0 && $int2 >= $int1); # Store range boundaries in array $self->{'inetnum'}{$inetnum} = [$int1, $int2]; } } # Make a sorted list of delegations @{$self->{'DELEGATIONS'}} = sort { $self->{'inetnum'}{$a}[0] <=> $self->{'inetnum'}{$b}[0] || $self->{'inetnum'}{$a}[1] <=> $self->{'inetnum'}{$b}[1] } keys(%{$self->{'inetnum'}}); # Success return 1; } #################################################################### # DESCRIPTION: Returns a sorted array of RIPE delegations # INPUT: None # OUTPUT: Array or ref to array of delegations # SIDE EFFECTS: None #################################################################### sub getDelegations { my $self = shift; return wantarray() ? @{$self->{'DELEGATIONS'}} : $self->{'DELEGATIONS'}; } #################################################################### # DESCRIPTION: Check if a range one of the RIPE delegations # INPUT: IP range # OUTPUT: 1, if range is a RIPE delegation, 0 - otherwise # SIDE EFFECTS: None #################################################################### sub isDelegation { my $self = shift; my($in) = @_; # Normalize the range my($inetnum, $respond) = normalizerange($in); # Return false if passed range was invalid return 0 unless($respond == $O_OK); # Return true, if the range part of the delegation return (defined($self->{'inetnum'}{$inetnum})) ? 1 : 0; } #################################################################### # DESCRIPTION: Check, if a range is part of one of the delegations # INPUT: IP range # OUTPUT: 1, if range a part of delegation, 0 - otherwise # SIDE EFFECTS: None #################################################################### sub Contains { my $self = shift; my($in) = @_; # Normalize the range my($inetnum, $respond) = normalizerange($in); # Return false if passed range was invalid return 0 unless($respond == $O_OK); # Split the range into quads my($ip1, $ip2) = ($inetnum =~ m%^$IP_RANGE_RE$%); # Skip, if didn't extract quads return 0 unless($ip1 && $ip2); my $int1 = quad2int($ip1); my $int2 = quad2int($ip2); # Skip bogus ranges return 0 unless($int1 >= 0 && $int2 >= 0 && $int2 >= $int1); # Perform a lookup foreach my $range (@{ $self->getDelegations() }) { # Get range boundarues my($start, $end) = @{ $self->{'inetnum'}{$range} }; # Return true, if passed range within the delegated range return 1 if($int1 >= $start && $int2 <= $end); } return 0; } #################################################################### # DESCRIPTION: Main # INPUT: None # OUTPUT: None # SIDE EFFECTS: Initialze global array @DELEGATIONS #################################################################### @DELEGATIONS = new NCC::RipeDelegations()->getDelegations(); 1; =head1 NAME NCC::RipeDelegations - OO interface to the list of IP delegations from IANA =head1 SYNOPSIS use NCC::RipeDelegations; =head1 DESCRIPTION This module provides interface to the list of IP delegations to RIPE NCC from IANA. =head1 AUTHOR Timur Bakeyev, timur@ripe.net =head1 SEE ALSO perl(1). =cut __DATA__ # List of delegated to RIPE IP ranges 24.132.0.0 - 24.132.255.255 24.133.0.0 - 24.135.255.255 62.0.0.0 - 62.255.255.255 80.0.0.0 - 80.255.255.255 81.0.0.0 - 81.255.255.255 82.0.0.0 - 82.255.255.255 145.0.0.0 - 145.127.255.255 146.188.0.0 - 146.188.255.255 192.106.0.0 - 192.106.255.255 192.162.0.0 - 192.162.255.255 192.164.0.0 - 192.167.255.255 193.0.0.0 - 193.255.255.255 194.0.0.0 - 194.255.255.255 195.0.0.0 - 195.255.255.255 196.200.0.0 - 196.207.255.255 212.0.0.0 - 212.255.255.255 213.0.0.0 - 213.255.255.255 217.0.0.0 - 217.255.255.255 asused-3.72/NCC/RipeDelegations/MANIFEST0100644000072700117040000000007007265037572017157 0ustar timursoftiesChanges MANIFEST Makefile.PL RipeDelegations.pm test.pl asused-3.72/NCC/RipeDelegations/Makefile.PL0100644000072700117040000000123607714474104020000 0ustar timursoftiesuse 5.005; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. # RIPE NCC common configuration my %PARAM = ( 'INSTALLDIRS' => 'vendor', 'INSTALLSCRIPT' => '$(INSTALLVENDORBIN)', # Hack for Perl prior 5.8.1 'dist' => { 'COMPRESS' => 'gzip', 'SUFFIX' => '.gz', 'CI' => 'cvs ci', 'RCS_LABEL' => 'cvs tag -c -F $(NAME_SYM)-$(VERSION_SYM)', }, ); if($] >= 5.005) { $PARAM{AUTHOR} = 'Timur Bakeyev '; }; WriteMakefile( 'NAME' => 'NCC::RipeDelegations', 'VERSION_FROM' => 'RipeDelegations.pm', # finds $VERSION %PARAM ); asused-3.72/NCC/RipeDelegations/Changes0100644000072700117040000000074007347160213017313 0ustar timursoftiesMon Sep 10 17:45:24 2001 Timur Bakeyev * Replace binary search with plain linear - on such small quantities it doesn't give benefits. * Bumped version to 0.04 Mon Sep 10 17:25:47 2001 Timur Bakeyev * Made @DELEGATIONS sorted. Also, anything, returned by getDelegations() also sorted in ascending order. * Add new method Contains() which return true, if an IP range within one of the delegations. * Bumped version to 0.03 asused-3.72/Changes0100644000072700117040000001360707711442766013653 0ustar timursoftiesRevision history for asused3. 3.71 Mon Jul 28 16:37:14 2003 * With the '-valid' option map IP (range) back to an allocation, not an assignment - that will help to avoid false errors in case of PI assignments(That belong to eu.zz). * Fix a broken '-pcheck|-contacts' check(Pierfrancesco Caci) 3.70 Tue Apr 22 18:21:11 2003 * Fixed calculation of a free space in case when only last address overlaps firs one of another range. Was falsly reported as free. * Add -cidr flag to the options, so, together with -assign option asused gives output, suitable for submission into the IP forms. * Implement recognition of the SUB-ALLOCATED ranges with size vali- dation. Also, duplicated netnames and issue dates are reported as warnings. 3.67 Mon Sep 30 17:41:18 2002 * Don't check assigned: lines in registry, as we keep only PI info there since now * Work around case, when registry has no assignments, but has LIR- PARTITIONED block. 3.66 Thu Aug 15 17:14:56 2002 * Ignore inetnum objects with LIR-PARTITIONED status - they are for internal use by ISP's. * One year AW usage delay was calculated wrongly, so it didn't give errors after 3(?) month period. * Reporting of invalid INFRA-AW assignments is fixed. Now it's consistent with --valid option and gives expected results. 3.65 Fri Jan 18 15:01:41 2002 * This release is aimed to handle new attribute in the INFRA-AW for inetnum objects. Read more about it at: http://www.ripe.net/ripe/mail-archives/lir-wg/20010701-20020101/msg00443.html 3.64 Wed Oct 10 14:22:24 2001 * Fixed recognition of inetnum objects with sign in the range. * Broken dates in changed: field now handled properly, without exiting the program. * Fixed failure in case of registry with no allocations. * Recognize mixed case status: fields. 3.63 Tue Aug 21 13:52:04 2001 * Fixed netname handling according to the RIPE223 - now, case doesn't matter, so netnames with different letter-case still match. * There have been reports about Makefile failure with Perl 5.002, due changed format in the output of the MakeMaker. This is fixed now, by using our own stubs in the Makefile.PL. * Couple of strange inetnum objects were found in the DB, namely - 192.0.0.0 - 192.255.255.255, which broke proper recognition of the allocation. Now they are recognized by asused. Still, it's possible that there are other similar objects in DB. 3.62 Never was released 3.61 Never was released 3.60 Thu Apr 19 10:48:45 2001 * Bumped version to 3.60 as substantial changes are included. * This version was written to be able to handle data in RPSL Whois DB Version 3 format. The major problem for asused with the new DB format was the comments and continuation lines in the new object format. That meant changing the code that parses inetnum objects. Also, the Net::RIPEWhois module was replaced with RipeWhois - a cleaner OO implementation of a whois client. Other modules were changed to co-operate with this new one. As a side effect, the memory usage was substantially decreased - by around 25% or 6MB, for one, large, registry. * This release still uses the Net::RIPEWhois::in and Net::RIPEWhois::pcheck modules. * The required iso3166-codes and delegations data are now supplied by the new NCC::CountryCode and NCC::RipeDelegations modules respectively. You should therefore remove the 'iso3166-codes' and 'delegations' files from your Perl library directiory. 3.52 Wed Sep 20 16:19:44 2000 * Fixed problem with huge free address space reports, caused by bug in the Whois DB - "-Tin" returns rev-srv: fields as well. * Fixed (hopefully) problem with RIPEWhois.pm module, which didn't return anything on some Linux'es. Was reported several times, visible effect was: FATAL ERROR: ERROR: 10.65.0.0/19 No allocation object in DB, inetnum found * Fixed small compatability problem - some systems don't let to use IO::Socket::INET directly, so, turned that into "use IO::Socket". * Put IO-1.20.tar.gz into extra/ directory, as some Perl distributions come with outdated modules and CPAN suggests perl5.6.0 as an update :> * Added --free flag to show only free address space list. * Produce a warning if a registry doesn't have mnt-lower attribute on it's allocation. * Fixed the case that --status didn't report assignments with missed status lines and gave incorrect balance. 3.51 Tue Sep 5 18:42:38 2000 * Program name now derived from $0 (several reports) * ReadConf() in a public version exited after first guess without checking other locations(reported by Jeroen Ruigrok van der Werven ) * Fixed command line argument parsing: ranges, prefixes and regids now accepted * Fixed behaviour with RIPE* mnt-by and mnt-lower * Produce a warning if an assignment overlaps allocation * Report lost Asused object warnings * Spelling of "overlapping" was fixed * Fixed installation procedure to copy 'iso3166-codes' and 'delegations' files with other libraries to make them available with side-wide in- stallation. 3.5b Mon Aug 28 12:59:55 2000 - asused3 and asused-public code base were merged back. - Code of the modules was tided up from local RIPE NCC dependencies and all such stuff went to the main executable. Still, modules are not completely standalone, as the do refer to main::* variables. (Should be fixed in future). - Several bugs there fixed: * Not calculated free space at the beginning of the allocation. * Missed overlapping assignments. * Not always correctly calculated assigned address space. * Weird 1000% of address usage within overlaps. * Weird 1000% ration between totaly used addrresses and within overlaps. - Output of several functions was cleaned, aligned, beatified. 0.01b Wed Dec 2 19:13:26 1998 - RIPE NCC asused3 program was striped down for public use. asused-3.72/ipv4pack/0040755000072700117040000000000007740564516014075 5ustar timursoftiesasused-3.72/ipv4pack/ipv4pack.pm0100644000072700117040000007036707361063764016164 0ustar timursofties# Copyright (c) 1998,2001 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 : ipv4pack.pm # Purpose : provide translation functions for the different address # space notations, and other ip functionalities # Author : Monica Cortes # Date : August 1998 # Description : # Language Version : Perl (Tested with v5.00401 and v5.00404) # OSs Tested : BSD/OS 3.1 # Command Line : - # Input Files : - # Output Files : - # External Programs : - # Problems : # To Do : # Comments : most of these routines where taken form # /ncc/db/dbase/src/net2net.pl coded originally by D. # Kessens. I have added comments! and made some changes # to adapt it to be a module and be able to work with # use strict, added more checks where relvant. (19980626) # Comments : the exported variables are used by the routines and # taken from /ncc/db/dbase/src/defines.pl (19980626) # Comments : there are some non exported routines # Comments : NOT all routines make all the checking! To manipulate # IPs the best is to use integers, so use # 1- normalizerange # 2- quad2int # To go back to a prefix or quad notation after # manipulation use # 1- range2prefixes # or 2- int2quad #------------------------------------------------------------------------------ # # Changes : 19981130 Monica # new exported routine normalizerange121 to comply # with RIPE 121 document (outdated but still # valid), new control value to indicate that # a range has been treated classfull # # Changes : 19990527 Monica # changes to normalizerange121 # there are inetnums with only one IP address # the routine treated this as "systax error" # will now be treated as a /32 with a proper warning code # # Changes : 20001115 BaT # add a function to translate error code into string # Changes : 20010410 BaT # add handling of encompassing object as valid one # fixed bunch of typos require 5.004; package ipv4pack; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); require Exporter; @ISA = qw(Exporter); use vars qw($O_OK $O_NOK $O_PRIVATERANGE $O_INVALIDIP $O_INVALIDPREFIX $O_INVALIDRANGE $O_SYNTAXERROR $O_NOVERLAP $O_OVERLAP $O_BINAOVERLAP $O_AINBOVERLAP $O_RESERVEDCLASS $O_CLASSFULL $O_IPADDRONLY); @EXPORT=qw($O_OK $O_NOK $O_PRIVATERANGE $O_INVALIDIP $O_INVALIDPREFIX $O_INVALIDRANGE $O_SYNTAXERROR $O_NOVERLAP $O_OVERLAP $O_BINAOVERLAP $O_AINBOVERLAP $O_RESERVEDCLASS $O_CLASSFULL $O_IPADDRONLY &quad2int &int2quad &normalizerange &range2prefixes &testoverlap &aggregate &normalizerange121 &error2str); @EXPORT_OK=qw($O_OK $O_NOK $O_PRIVATERANGE $O_INVALIDIP $O_INVALIDPREFIX $O_INVALIDRANGE $O_SYNTAXERROR $O_NOVERLAP $O_OVERLAP $O_BINAOVERLAP $O_AINBOVERLAP $O_RESERVEDCLASS $O_CLASSFULL $O_IPADDRONLY &quad2int &int2quad &normalizerange &range2prefixes &testoverlap &aggregate &normalizerange121 &error2str); $VERSION = '1.04'; # # these are error codes for checking the results of the # different net-routines # $O_OK = 1; # no problem found $O_NOK = 0; # an unknown problem was found $O_IPADDRONLY = 20; # range treated as an /32 only $O_CLASSFULL = 21; # ip treated as of classfull ranges $O_RESERVEDCLASS= 22; # ip from reserved range was given $O_PRIVATERANGE = 23; # ip from private range was given $O_INVALIDIP = 24; # wrong ip was given $O_INVALIDPREFIX= 25; # invalid index was given $O_INVALIDRANGE = 26; # invalid range was given $O_SYNTAXERROR = 27; # syntax error was found $O_NOVERLAP = -1; # no overlap between two ranges $O_OVERLAP = 100; # overlap between two ranges $O_AINBOVERLAP = 101; # range A is part of range B $O_BINAOVERLAP = 110; # range B is part of range A # Correspondence between error codes and their meaning my %errorcode = ( $O_OK => "No problems were found", $O_NOK => "An unknown problem was found", $O_IPADDRONLY => "Range treated as an /32 only", $O_CLASSFULL => "IP treated as of classfull ranges", $O_RESERVEDCLASS=> "IP from reserved range was given", $O_PRIVATERANGE => "IP from private range was given", $O_INVALIDIP => "Wrong IP was given", $O_INVALIDPREFIX=> "Invalid index was given", $O_INVALIDRANGE => "Invalid range was given", $O_SYNTAXERROR => "Syntax error was found", $O_NOVERLAP => "No overlap between two ranges", $O_OVERLAP => "Overlap between two ranges", $O_AINBOVERLAP => "Range A is part of the range B", $O_BINAOVERLAP => "Range B is part of the range A" ); # # these variables are just constants for obtaining prefix lengths # # TINYLOGVALUE is important if the range for which one wants to optain a # prefix is very big. The algorithm for obtaining the prefix relies # on the integer part of a logarithm (log(x)). If x is small, there # are no problems, but if x is big, the precision of the log can be # insufficient to give the correct int value (think of (2**32-1)). # TINYLOGVALUE is used to force precision on this cases and is # sufficiently small to let the other cases un-affected. # my($ONEDIVLOG2)=1/log(2); # log constant my($TINYLOGVALUE)=(32-(log(2**32-1)*$ONEDIVLOG2))/100; # another log constant my @masks= (0x0, 0x80000000, 0xc0000000, 0xe0000000, 0xf0000000, 0xf8000000, 0xfc000000, 0xfe000000, 0xff000000, 0xff800000, 0xffc00000, 0xffe00000, 0xfff00000, 0xfff80000, 0xfffc0000, 0xfffe0000, 0xffff0000, 0xffff8000, 0xffffc000, 0xffffe000, 0xfffff000, 0xfffff800, 0xfffffc00, 0xfffffe00, 0xffffff00, 0xffffff80, 0xffffffc0, 0xffffffe0, 0xfffffff0, 0xfffffff8, 0xfffffffc, 0xfffffffe, 0xffffffff ); # network masks ## ## ## exported functions ## ## ## # # #------------------------------------------------------------------------------ # Subroutine Header # Purpose : translate an quad written IP number into a long int # Side Effects : # Comments : # Exported Routine : yes # Routine Arguments : scalar value of an IP in quad notation # Return values : -1 if wrong quad number # long int translation of quad to int #------------------------------------------------------------------------------ # sub quad2int ($) { my($quad) = @_; # split quad into each byte my(@bytes) = split(/\./, $quad); # check the value of each byte [0,255] and pack the info return unpack("N",pack("C4",@bytes)) if (@bytes == 4 && scalar(grep {$_>=0 && $_<=255} @bytes) == 4); return(-1); } ## # #------------------------------------------------------------------------------ # Subroutine Header # Purpose : translate an IP written as long int into a quad # Side Effects : # Comments : different perl versions handle variables differently # in the sense that the default is on some "string" in # others "int". To avoid problems a very ugly hack is # put in place to make sure perl handles it as a number # Exported Routine : yes # Routine Arguments : scalar value of an IP in long int notation # Return values : scalar quad translation of int to quad # -1 if wrong int #------------------------------------------------------------------------------ # sub int2quad ($) { my($integer)=@_; my($MaxValidInt)=4294967295; # int corresponding to 255.255.255.255 # here are some checks of the int value, it has to be bigger than 0 # but smaller than the highest ip possible: 255.255.255.255 return -1 if ($integer !~ /^\d+$/ || $integer < 0 || $integer > $MaxValidInt); # ugly hack $integer += 0; return join(".", unpack("C4",pack("N",$integer))); } ## # #------------------------------------------------------------------------------ # Subroutine Header # Purpose : gets a range as argument and tries to identify the # range notation and translate it into quad - quad format # Side Effects : # Comments : it understands following notations: # quad - quad # quad/prefix # quad (class-full ip) # # it checks for the use of private ips and reserved classes: # # quad int value # 0.0.0.0 - 0.255.255.255 # 10.0.0.0 - 10.255.255.255 # 127.0.0.0 - 127.255.255.255 # 172.16.0.0 - 172.31.255.255 2886729728 - 2887778303 # 192.168.0.0 - 192.168.255.255 3232235520 - 3232301055 # # Classes D,F and reserved # 223.0.0.0 - 255.255.255.255 # # Exported Routine : yes # Routine Arguments : scalar value with the range information in one # of the above notations # Return values : an array with a first field: quad - quad # and a second field: errorcode #------------------------------------------------------------------------------ # sub normalizerange ($) { my($range)=@_; my($ip1); # test the syntax of $range if ($range=~ /^(\d+)(\.[\.\d]*)?\s*([\/\-])\s*([\d\.]+)*$/) { # range is in format quad/prefix or quad - quad # check for a valid range: no CLASS-D and upper (223-255), no 127/8 # and no private networks allowed (10/8) return ("", $O_PRIVATERANGE) if ($1 =~ /^10|127$/); return ("", $O_RESERVEDCLASS) if ($1 > 223); if ($3 eq '/') { # range is in format quad/prefix my($len)=$4; # complete the trailing quads if missing ($range,$ip1)=&completeip(defined($2)?$1.$2:$1,0); return ("", $O_INVALIDIP) if ($ip1 < 0); # check valid prefix and its mask if (($len=~ /^0*([12]?[\d]|3[012])$/) && (!($ip1 & (~$masks[$len])))) { my($ip2)=$ip1+(2**(32-$len)-1); # BaT 20010410: We should reject 0/8, but accept 0/0 as legal if($ip1 == 0) { if($ip2 == 4294967295) { return ($range." - ".int2quad($ip2), $O_OK); } elsif($ip2 <= 16777215) { return ("", $O_RESERVEDCLASS); } } # check that it does not overlap a private network (172.16/12 & # 192.168/16) return ("",$O_PRIVATERANGE) unless (&testoverlap("$ip1:$ip2","2886729728:2887778303") == -1); return ("",$O_PRIVATERANGE) unless (&testoverlap("$ip1:$ip2","3232235520:3232301055") == -1); return ($range." - ".int2quad($ip2), $O_OK); } return ("", $O_INVALIDPREFIX); } elsif ($3 eq '-') { # range is in format quad - quad my($torange)=$4; ($range,$ip1)=&completeip(defined($2)?$1.$2:$1,0); my($ip2); ($torange,$ip2)=&completeip($torange,1); # check that the quads where valid and the second is greater return ("", $O_INVALIDIP) if (($ip1 < 0) || ($ip2 < 0)); return ("", $O_INVALIDRANGE) if ($ip2 < $ip1); # BaT 20010410: We should reject 0/8, but accept 0/0 as legal if($ip1 == 0) { if($ip2 == 4294967295) { return ($range." - ".$torange, $O_OK); } elsif($ip2 <= 16777215) { return ("", $O_RESERVEDCLASS); } } # check that it does not overlap a private network (172.16/12 & # 192.168/16 ) return ("",$O_PRIVATERANGE) unless (&testoverlap("$ip1:$ip2","2886729728:2887778303") == -1); return ("",$O_PRIVATERANGE) unless (&testoverlap("$ip1:$ip2","3232235520:3232301055") == -1); return ($range." - ".$torange, $O_OK); } } elsif ($range=~ /^(\d+)(\.[\.\d]*)?$/) { # range is in format quad it will be treated CLASSFULL so # the errorcodes will be $O_CLASSFULL return ("", $O_PRIVATERANGE) if($1=~ /^10|127$/); return ("", $O_RESERVEDCLASS) if($1 > 223 || $1 == 0); ($range,$ip1)=&completeip($range,0); return ("", $O_INVALIDIP) if ($ip1 < 0); # note that the order in the comparisons is important # *and* the order of the if's is important !!! if (($range=~ /^(\d+)(\.\d+\.\d+)\.0$/) && ($1>=192)) { # CLASS C # check that it is not a private network 192.168/16 return ("",$O_PRIVATERANGE) if ( $1 == 192 && $2 =~ /^\.168/ ); return ($1.$2.".0 - ".$1.$2.".255", $O_CLASSFULL); } elsif (($range=~ /^(\d+)(\.(\d+))\.0\.0$/) && ($1>=128)) { # CLASS B # check that it is not a private network 172.16/12 return ("",$O_PRIVATERANGE) if ( $1 == 172 && ($3 >= 16 && $3 <= 31) ); return ($1.$2.".0.0 - ".$1.$2.".255.255", $O_CLASSFULL); } elsif ($range=~ /^(\d+)\.0\.0\.0$/) { # CLASS A return ($1.".0.0.0 - ".$1.".255.255.255", $O_CLASSFULL); } } return ("", $O_SYNTAXERROR); # nothing useful found } ## # #------------------------------------------------------------------------------ # Subroutine Header # Purpose : gets a range as argument and tries to identify the # range notation and translate it into quad - quad format # this routine is compliant with RIPE 121 document # Side Effects : # Comments : it understands following notations: # quad - quad # quad/prefix # quad (class-full ip) # # it checks for the use of private ips and reserved classes: # # quad int value # 0.0.0.0 - 0.255.255.255 # 10.0.0.0 - 10.255.255.255 # 127.0.0.0 - 127.255.255.255 # 172.16.0.0 - 172.31.255.255 2886729728 - 2887778303 # 192.168.0.0 - 192.168.255.255 3232235520 - 3232301055 # # Classes D,F and reserved # 223.0.0.0 - 255.255.255.255 # # Exported Routine : yes # Routine Arguments : scalar value with the range information in one # of the above notations # Return values : an array with a first field: quad - quad # and a second field: errorcode # # Changes : 19981130 Monica # this routine was included to be compliant with # RIPE 121 document which should be updated and then # this routine can be removed again # # Changes : 19990527 Monica # there are inetnums with only one IP address # the routine treated this as "systax error" # will now be treated as a /32 with a proper warning code #------------------------------------------------------------------------------ # sub normalizerange121 ($) { my($range)=@_; my($ip1); # test the syntax of $range if ($range=~ /^(\d+)(\.[\.\d]*)?\s*([\/\-])\s*([\d\.]+)*$/) { # range is in format quad/prefix or quad - quad # check for a valid range: no CLASS-D and upper (223-255), no 127/8 # and no private networks allowed (10/8) return ("", $O_PRIVATERANGE) if ($1 =~ /^10|127$/); return ("", $O_RESERVEDCLASS) if ($1 > 223); if ($3 eq '/') { # range is in format quad/prefix my($len)=$4; # complete the trailing quads if missing ($range,$ip1)=&completeip(defined($2)?$1.$2:$1,0); return ("", $O_INVALIDIP) if ($ip1 < 0); # check valid prefix and its mask if (($len=~ /^0*([12]?[\d]|3[012])$/) && (!($ip1 & (~$masks[$len])))) { my($ip2)=$ip1+(2**(32-$len)-1); # BaT 20010410: We should reject 0/8, but accept 0/0 as legal if($ip1 == 0) { if($ip2 == 4294967295) { return ($range." - ".int2quad($ip2), $O_OK); } elsif($ip2 <= 16777215) { return ("", $O_RESERVEDCLASS); } } # check that it does not overlap a private network (172.16/12 & # 192.168/16) return ("",$O_PRIVATERANGE) unless (&testoverlap("$ip1:$ip2","2886729728:2887778303") == -1); return ("",$O_PRIVATERANGE) unless (&testoverlap("$ip1:$ip2","3232235520:3232301055") == -1); return ($range." - ".&int2quad($ip2), $O_OK); } return ("", $O_INVALIDPREFIX); } elsif ($3 eq '-') { # range is in format quad - quad my($torange)=$4; my($errorcode)=$O_OK; ($range,$ip1)=&completeip(defined($2)?$1.$2:$1,0); my($ip2); ($torange,$ip2)=&completeip($torange,1); # check that the quads where valid and the second is greater return ("", $O_INVALIDIP) if (($ip1 < 0) || ($ip2 < 0)); return ("", $O_INVALIDRANGE) if ($ip2 < $ip1); # BaT 20010410: We should reject 0/8, but accept 0/0 as legal if($ip1 == 0) { if($ip2 == 4294967295) { return ($range." - ".$torange, $O_OK); } elsif($ip2 <= 16777215) { return ("", $O_RESERVEDCLASS); } } # check that it does not overlap a private network (172.16/12 & # 192.168/16) return ("",$O_PRIVATERANGE) unless (&testoverlap("$ip1:$ip2","2886729728:2887778303") == -1); return ("",$O_PRIVATERANGE) unless (&testoverlap("$ip1:$ip2","3232235520:3232301055") == -1); # 19981130 Monica # changes to routine normalizerange my(@quads_ip1)=split(/\./,$range); my(@quads_ip2)=split(/\./,$torange); if ( $quads_ip1[-1] == 0 && $quads_ip2[-1] == 0 ) { # old classfull notation, check if it is an old CLASS C if ($quads_ip1[0] >= 192) { # replace ip2 last quad by 255 $quads_ip2[-1] = 255; $torange=join('.',@quads_ip2); $errorcode=$O_CLASSFULL; } else { # NOT a CLASS C: do give an error, invalid range return ("", $O_INVALIDRANGE); } } return ($range." - ".$torange, $errorcode); } } elsif ($range=~ /^(\d+)(\.[\.\d]*)?$/) { # range is in format quad it will be treated CLASSFULL return ("", $O_PRIVATERANGE) if($1=~ /^10|127$/); return ("", $O_RESERVEDCLASS) if($1 > 223 || $1 == 0); ($range,$ip1)=&completeip($range,0); return ("", $O_INVALIDIP) if ($ip1 < 0); # note that the order in the comparisons is important # *and* the order of the if's is important !!! if ($range !~ /\.0$/) { # the last quad contains a non null argument # it will be treated as on IP number => /32 with a # warning that it was treated as such return ( $range." - ".$range, $O_IPADDRONLY); } elsif (($range=~ /^(\d+)(\.\d+\.\d+)\.0$/) && ($1>=192)) { # CLASS C # check that it is not a private network 192.168/16 return ("",$O_PRIVATERANGE) if ( $1 == 192 && $2 =~ /^\.168/ ); return ($1.$2.".0 - ".$1.$2.".255", $O_CLASSFULL); } elsif (($range=~ /^(\d+)(\.(\d+))\.0\.0$/) && ($1>=128)) { # CLASS B # check that it is not a private network 172.16/12 return ("",$O_PRIVATERANGE) if ( $1 == 172 && ($3 >= 16 && $3 <= 31) ); return ($1.$2.".0.0 - ".$1.$2.".255.255", $O_CLASSFULL); } elsif ($range=~ /^(\d+)\.0\.0\.0$/) { # CLASS A return ($1.".0.0.0 - ".$1.".255.255.255", $O_CLASSFULL); } } return ("", $O_SYNTAXERROR); # nothing useful found } ## # #------------------------------------------------------------------------------ # Subroutine Header # Purpose : gets a range in the format "int - int" or "quad - quad" # and splits it into the necessary prefixes finding # always the smallest prefix possible # Side Effects : # Comments : No checks are performed on the validity of the ips # for checks use normalizerange and quad2int first # Comments : To get the prefix decomposition of a range one # needs to do two things: # - get the smallest posible prefix, which depends # on the size of the range # - the mask for that prefix has to match the start # address of the range # Exported Routine : yes # Routine Arguments : a scalar value with the range in "int - int" # or "quad - quad" format # Return values : an array of ip-ranges in the format quad/prefix # or -1 if a problem ocurred #------------------------------------------------------------------------------ # sub range2prefixes ($) { my(@prefixes)=(); my($bits); my($ip1,$ip2)=split(/ \- /, $_[0], 2); $ip1=&quad2int($ip1) if ($ip1 =~ /\./); # quad notation $ip2=&quad2int($ip2) if ($ip2 =~ /\./); # quad notation # check ip1 and ip2 return (-1) if ( $ip1 == -1 || $ip2 == -1 ); do { # get smallest useful prefix length based on size of range. # $TINYLOGVALUE is used to account for the pecision lost by # the log calculation on large range sizes (see definition of # TINYLOGVALUE at the begining of the module). $bits = 32-int(log($ip2-$ip1+1)*$ONEDIVLOG2+$TINYLOGVALUE); { use integer; # for the following bitwise & # find smallest prefix that masks all bits of starting address of the # range until ($ip1 == ($ip1 & $masks[$bits])) { $bits++; } } push(@prefixes, &int2quad($ip1)."/".$bits); # add on block we've just found $ip1 += 2**(32-$bits); # stop when we've reached the top end of range } until (($ip1-1) == $ip2); return @prefixes; } ## # #------------------------------------------------------------------------------ # Subroutine Header # Purpose : gets two ip ranges in the format "int [-:] int" or # "quad [-:] quad" and test if they overlap and what # type of overlap # Side Effects : # Comments : # Exported Routine : yes # Routine Arguments : two scalar variables, # 1- range A in format "int [-:] int" or "quad [-:] quad" # 2- range B in format "int [-:] int" or "quad [-:] quad" # Return values : a scalar value indicating the type of overlap #------------------------------------------------------------------------------ # sub testoverlap { my($rangeA,$rangeB)=@_; my($Aip1,$Aip2,$Bip1,$Bip2); if ($rangeA =~ /^\s*(\S*)\s*[\-:]\s*(\S*)\s*$/ ) { $Aip1=$1; $Aip2=$2; $Aip1=&quad2int($Aip1) if ( $Aip1 =~ /\./ ); $Aip2=&quad2int($Aip2) if ( $Aip2 =~ /\./ ); return $O_INVALIDRANGE if ($Aip1 == -1 || $Aip2 == -1); } else { return $O_SYNTAXERROR; #wrong syntax } return $O_INVALIDRANGE if ($Aip1 > $Aip2); #wrong syntax if ($rangeB =~ /^\s*(\S*)\s*[\-:]\s*(\S*)\s*$/ ) { $Bip1=$1; $Bip2=$2; $Bip1=&quad2int($Bip1) if( $Bip1 =~ /\./ ); $Bip2=&quad2int($Bip2) if( $Bip2 =~ /\./ ); return $O_INVALIDRANGE if ($Bip1 == -1 || $Bip2 == -1); } else { return $O_SYNTAXERROR; #wrong syntax } return $O_INVALIDRANGE if ($Bip1 > $Bip2); #wrong syntax # test if both ranges overlap if ( $Bip1 <= $Aip2 && $Bip2 >=$Aip1 ) { # range A is part of range B return $O_AINBOVERLAP if ( $Bip1 <= $Aip1 && $Bip2 >=$Aip2 ); # range B is part of range A return $O_BINAOVERLAP if ( $Bip1 >= $Aip1 && $Bip2 <=$Aip2 ); # partial overlap only return $O_OVERLAP; } return $O_NOVERLAP; # no overlap } ## # #------------------------------------------------------------------------------ # Subroutine Header # Purpose : gets two ip ranges in the format "int [-:] int" or # "quad [-:] quad" and checks if they are aggregatable # Side Effects : # Comments : only checks if the second range is contiguos with the # first range # Comments : To get the prefix of a range one needs to do: # - get the smallest posible prefix, which depends # on the size of the range # - check that the size of the prefix found accounts # for the complete range size # - the mask for that prefix has to match the start # address of the range # Exported Routine : yes # Routine Arguments : two scalar variables, # 1- range A in format "int [-:] int" or "quad [-:] quad" # 2- range B in format "int [-:] int" or "quad [-:] quad" # Return values : a scalar value indicating # the aggregate in quad/prefix # or -1 if not aggregatable #------------------------------------------------------------------------------ # sub aggregate { my($rangeA,$rangeB)=@_; my($Aip1,$Aip2,$Bip1,$Bip2); if ($rangeA =~ /^\s*(\S*)\s*[\-:]\s*(\S*)\s*$/ ) { $Aip1=$1; $Aip2=$2; $Aip1=&quad2int($Aip1) if ( $Aip1 =~ /\./ ); $Aip2=&quad2int($Aip2) if ( $Aip2 =~ /\./ ); return $O_INVALIDRANGE if ($Aip1 == -1 || $Aip2 == -1); } else { return $O_SYNTAXERROR; #wrong syntax } return $O_INVALIDRANGE if ($Aip1 > $Aip2); #wrong syntax if ($rangeB =~ /^\s*(\S*)\s*[-:]\s*(\S*)\s*$/ ) { $Bip1=$1; $Bip2=$2; $Bip1=&quad2int($Bip1) if( $Bip1 =~ /\./ ); $Bip2=&quad2int($Bip2) if( $Bip2 =~ /\./ ); return $O_INVALIDRANGE if ($Bip1 == -1 || $Bip2 == -1); } else { return $O_SYNTAXERROR; #wrong syntax } return $O_INVALIDRANGE if ($Bip1 > $Bip2); #wrong syntax # test contiguity return -1 unless ( ($Aip2+1) == $Bip1 ); # get smallest useful prefix length based on size of range. # $TINYLOGVALUE is used to account for the pecision lost by # the log calculation on large range sizes (see definition of # TINYLOGVALUE at the begining of the module). my($bits)=32-int(log($Bip2-$Aip1+1)*$ONEDIVLOG2+$TINYLOGVALUE); # check that the prefix found accounts for the size of the range return -1 unless ( ($Bip2-$Aip1+1) == (2**(32-$bits))); use integer; # for the following bitwise & if ($Aip1 == ($Aip1 & $masks[$bits])) { return &int2quad($Aip1).'/'.$bits; } # ranges are not aggregatable return -1; } ## ## non exported subroutines ## ## ## # #------------------------------------------------------------------------------ # Subroutine Header # Purpose : gets an ip in quad format of any length and tries # to complete it with as many trailing ".0" as necessary # Side Effects : # Comments : # Exported Routine : no (called by normalizerange) # Routine Arguments : two scalar variables, # 1- ip quad to complete # 2- flag to know if it completes the ip with 0 o 255 # 0 completes with .0 # >0 completes with .255 # Return values : an array of two field: # first field: completed quad # second field: integer value of the quad # or # -1 if there was a problem #------------------------------------------------------------------------------ # sub completeip { my($range,$type)=@_; my($int,$CompleteQuad); # what do we complete with? if ($type) { $CompleteQuad='.255'; } else { $CompleteQuad='.0'; } # clean up the range of trailing dots $range=~ s/\.*$//; # get number of valid dots my($nrofdots)= $range=~ s/\./\./g; # complete the quad with trailing .0 $range=join("", $range, ("$CompleteQuad") x (3 - $nrofdots)) if ($nrofdots<3); # get the int value of the completed quad if (($int=&quad2int($range))>=0) { return (&int2quad($int),$int); } # nothing valid found return ("",-1); } ## # #------------------------------------------------------------------------------ # Subroutine Header # Purpose : conver error code into the string # Side Effects : # Comments : BaT 20001115 # Exported Routine : yes # Routine Arguments : error code if any # Return values : an error string #------------------------------------------------------------------------------ # sub error2str { my($code) = @_; my $str = $errorcode{$code}; # Return the string if exists return $str if($str); # Nothing to return return ""; } 1; asused-3.72/ipv4pack/test.pl0100644000072700117040000002704707270014435015404 0ustar timursofties# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..42\n"; } END {print "not ok 1\n" unless $loaded;} use ipv4pack; $loaded = 1; print "ok 1\n"; my $t = 1; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): # # test of routine quad2int # # print ("\n\nTesting quad2int\n",'=' x 16,"\n"); # known quad 1.1.1.1 is 16843009 (2**0+2**8+2**16+2**24) # print ("\nvalid arguments: \n"); # print (" quad 1.1.1.1 int value should be 16843009: int = ",&quad2int('1.1.1.1'),"\n"); if (&quad2int('1.1.1.1') == 16843009) { $t++, print "ok 2\n" } else { print "not ok 2\n" } if (&quad2int('1.400.0.0') == -1) { $t++, print "ok 3\n" } else { print "not ok 3\n" } if (&quad2int('1.40.-1.0') == -1) { $t++, print "ok 4\n" } else { print "not ok 4\n" } if (&quad2int('1.40.1') == -1) { $t++, print "ok 5\n" } else { print "not ok 5\n" } # non valid quads # print ("\nnon-valid quads: \n"); # print (" quad 1.400.0.0: int =",&quad2int('1.400.0.0'),"\n"); # print (" quad 1.40.-1.0: int =",&quad2int('1.40.-1.0'),"\n"); # print (" quad 1.40.1 : int =",&quad2int('1.40.1'),"\n"); if (&int2quad(16843009) eq '1.1.1.1') { $t++, print "ok 6\n" } else { print "not ok 6\n" } # print ("\nTesting int2quad\n",'=' x 16,"\n"); # print ("\nvalid arguments: \n"); # known quad 1.1.1.1 is 33686017 # print ("int 16843009 quad value 1.1.1.1 : quad = ",&int2quad(16843009),"\n"); if (&int2quad(9999999999) == -1) { $t++, print "ok 7\n" } else { print "not ok 7\n" } if (&int2quad(-1) == -1) { $t++, print "ok 8\n" } else { print "not ok 8\n" } # non valid ints # print ("\nnon-valid ints: \n"); # print (" int 9999999999: quad =",&int2quad(1.400.0.0),"\n"); # print (" int -1: quad =",&int2quad(1.40.-1.0),"\n"); my ($range,$error) = &normalizerange('1 - 1.128'); if (($range eq '1.0.0.0 - 1.128.255.255') and ($error == 1)) { $t++, print "ok 9\n" } else { print "not ok 9\n"} ($range,$error) = &normalizerange('172.1 - 172.2'); if (($range eq '172.1.0.0 - 172.2.255.255') and ($error == 1)) { $t++, print "ok 10\n" } else { print "not ok 10\n"} ($range,$error) = &normalizerange('192.168 - 192.168.5'); if ($error == 23) { $t++, print "ok 11\n" } else { print "not ok 11\n"} ($range,$error) = &normalizerange('192.150 - 192.150.5'); if (($range eq '192.150.0.0 - 192.150.5.255') and ($error == 1)) { $t++, print "ok 12\n" } else { print "not ok 12\n"} ($range,$error) = &normalizerange('1/12'); if (($range eq '1.0.0.0 - 1.15.255.255') and ($error == 1)) { $t++, print "ok 13\n" } else { print "not ok 13\n"} ($range,$error) = &normalizerange('172.8/16'); if (($range eq '172.8.0.0 - 172.8.255.255') and ($error == 1)) { $t++, print "ok 14\n" } else { print "not ok 14\n"} ($range,$error) = &normalizerange('192.17/16'); if (($range eq '192.17.0.0 - 192.17.255.255') and ($error == 1)) { $t++, print "ok 15\n" } else { print "not ok 15\n"} ($range,$error) = &normalizerange('1'); if (($range eq '1.0.0.0 - 1.255.255.255') and ($error == 21)) { $t++, print "ok 16\n" } else { print "not ok 16\n"} # print ("\nTesting normalizerange\n",'=' x 22,"\n"); # print ("\nvalid arguments: \n"); # known valid range quad - quad: 1.0.0.0 - 1.255.255.255 #print (" quad range 1 - 1.128: range = ",join(' ERRORCODE: ',&normalizerange('1 - 1.128')),"\n"); #print (" quad range 172.1 - 172.2: range = ",join(' ERRORCODE: ',&normalizerange('172.1 - 172.2')),"\n"); #print (" quad range 192.168 - 192.168.5: range = ",join(' ERRORCODE: ',&normalizerange('192.168 - 192.168.5')),"\n"); #print (" quad range 192.150 - 192.150.5: range = ",join(' ERRORCODE: ',&normalizerange('192.150 - 192.150.5')),"\n"); # known valid range quad - quad: 1.0.0.0 - 1.128.255.255 # print (" quad range 1/12: range = ",join(' ERRORCODE: ',&normalizerange('1/12')),"\n"); # print (" quad range 172.8/16: range = ",join(' ERRORCODE: ',&normalizerange('172.8/16')),"\n"); # print (" quad range 192.17/16: range = ",join(' ERRORCODE: ',&normalizerange('192.17/16')),"\n"); # known valid range quad: 1.0.0.0 - 1.255.255.255 # print (" quad range 1: range = ",join(' ERRORCODE: ',&normalizerange('1')),"\n"); ($range,$error) = &normalizerange('1.128 - 1.5'); if ($error == 26) { $t++, print "ok 17\n" } else { print "not ok 17\n"} ($range,$error) = &normalizerange('127.1 - 127.2'); if ($error == 23) { $t++, print "ok 18\n" } else { print "not ok 18\n"} ($range,$error) = &normalizerange('0 - 0.0.0.128'); if ($error == 22) { $t++, print "ok 19\n" } else { print "not ok 19\n"} # non valid ints # print ("\nnon-valid ranges: \n"); # quad - quad # print (" quad range 1.128 - 1.5: range = ",join(' ERRORCODE: ',&normalizerange('1.128 - 1.5')),"\n"); # print (" quad range 127.1 - 127.2: range = ",join(' ERRORCODE: ',&normalizerange('127.1 - 127.2')),"\n"); # print (" quad range 223 - 230: range = ",join(' ERRORCODE: ',&normalizerange('127.1 - 127.2')),"\n"); # print (" quad range 0 - 0.128: range = ",join(' ERRORCODE: ',&normalizerange('0 - 0.128')),"\n"); ($range,$error) = &normalizerange('1/128'); if ($error == 25) { $t++, print "ok 20\n" } else { print "not ok 20\n"} ($range,$error) = &normalizerange('1/-28'); if ($error == 27) { $t++, print "ok 21\n" } else { print "not ok 21\n"} ($range,$error) = &normalizerange('1.5/8'); if ($error == 25) { $t++, print "ok 22\n" } else { print "not ok 22\n"} ($range,$error) = &normalizerange('172.17/16'); if ($error == 23) { $t++, print "ok 23\n" } else { print "not ok 23\n"} ($range,$error) = &normalizerange('192.168/16'); if ($error == 23) { $t++, print "ok 24\n" } else { print "not ok 24\n"} # quad/prefix # print (" quad range 1/128: range = ",join(' ERRORCODE: ',&normalizerange('1/128')),"\n"); # print (" quad range 1/-28: range = ",join(' ERRORCODE: ',&normalizerange('1/-28')),"\n"); # print (" quad range 1.5/8: range = ",join(' ERRORCODE: ',&normalizerange('1.5/8')),"\n"); # print (" quad range 172.17/16: range = ",join(' ERRORCODE: ',&normalizerange('172.17/16')),"\n"); # print (" quad range 192.168/16: range = ",join(' ERRORCODE: ',&normalizerange('192.168/16')),"\n"); ($range,$error) = &normalizerange('1/128'); if (error2str($error) eq 'Invalid index was given') { $t++, print "ok 25\n" } else { print "not ok 25\n"} ($range,$error) = &normalizerange('1/-28'); if (error2str($error) eq 'Syntax error was found') { $t++, print "ok 26\n" } else { print "not ok 26\n"} ($range,$error) = &normalizerange('1.5/8'); if (error2str($error) eq 'Invalid index was given') { $t++, print "ok 27\n" } else { print "not ok 27\n"} ($range,$error) = &normalizerange('172.17/16'); if (error2str($error) eq 'IP from private range was given') { $t++, print "ok 28\n" } else { print "not ok 28\n"} ($range,$error) = &normalizerange('192.168/16'); if (error2str($error) eq 'IP from private range was given') { $t++, print "ok 29\n" } else { print "not ok 29\n"} # error2str # print (" quad range 1/128: range = ",error2str((&normalizerange('1/128'))[1]),"\n"); # print (" quad range 1/-28: range = ",error2str((&normalizerange('1/-28'))[1]),"\n"); # print (" quad range 1.5/8: range = ",error2str((&normalizerange('1.5/8'))[1]),"\n"); # print (" quad range 172.17/16: range = ",error2str((&normalizerange('172.17/16'))[1]),"\n"); # print (" quad range 192.168/16: range = ",error2str((&normalizerange('192.168/16'))[1]),"\n"); ($range,$error) = &normalizerange('192.168'); if ($error == 23) { $t++, print "ok 30\n" } else { print "not ok 30\n"} ($range,$error) = &normalizerange('172.20'); if ($error == 23) { $t++, print "ok 31\n" } else { print "not ok 31\n"} ($range,$error) = &normalizerange('10.10'); if ($error == 23) { $t++, print "ok 32\n" } else { print "not ok 32\n"} ($range,$error) = &normalizerange('10000000'); if ($error == 23) { $t++, print "ok 33\n" } else { print "not ok 33\n"} # classful quad # print (" classful quad range 192.168: range = ",join(' ERRORCODE: ',&normalizerange('192.168')),"\n"); # print (" classful quad range 172.20: range = ",join(' ERRORCODE: ',&normalizerange('172.20')),"\n"); # print (" classful quad range 10.10: range = ",join(' ERRORCODE: ',&normalizerange('10.10')),"\n"); # completely wrong # print (" range in ints 99900000: range = ",join(' ERRORCODE: ',&normalizerange('10000000')),"\n"); # print ("\nTesting range2prefixes\n",'=' x 22,"\n"); # print ("\nvalid arguments: \n"); # known range int - int if ([&range2prefixes('3232235520 - 3232301055')]->[0] eq '192.168.0.0/16') { $t++, print "ok 34\n" } else { print "not ok 34\n"} # print (" int range 3232235520 - 3232301055; /16: prefix = ",&range2prefixes('3232235520 - 3232301055'),"\n"); my ($r1, $e1) = &normalizerange('1.1/16'); my ($r2, $e2) = &normalizerange('1.1.128/24'); if (&testoverlap($r1,$r2) == 110) { $t++, print "ok 35\n" } else { print "not ok 35\n"} if (&testoverlap($r2,$r1) == 101) { $t++, print "ok 36\n" } else { print "not ok 36\n"} ($r1,$e1) = &normalizerange('1.2/16'); if (&testoverlap($r1,$r2) == -1) { $t++, print "ok 37\n" } else { print "not ok 37\n"} if (&testoverlap('1.1.0.0 - 1.2.255.255','1.2.0.0 - 1.3.255.255') == 100) { $t++, print "ok 38\n" } else { print "not ok 38\n"} if (&testoverlap('0','0') == 27) { $t++, print "ok 39\n" } else { print "not ok 39\n"} # test testoverlap # print ("\n\nTesting testoverlap\n",'=' x 19,"\n"); # print ("\nvalid arguments: \n"); # known quad 1.1/16 and 1.1.128/8 # my($range,$errorcode)=&normalizerange('1.1/16'); # my($range1,$errorcode1)=&normalizerange('1.1.128/24'); # print (" overlap value between 1.1/16 and 1.1.128/24: ",&testoverlap($range,$range1),"\n"); # print (" overlap value between 1.1.128/24 and 1.1/16: ",&testoverlap($range1,$range),"\n"); # ($range,$errorcode)=&normalizerange('1.2/16'); # print (" overlap value between 1.2/16 and 1.1.128/24: ",&testoverlap($range,$range1),"\n"); # print (" overlap value between 1.1.0.0 - 1.2.255.255 and 1.2.0.0 - 1.3.255.255: ",&testoverlap('1.1.0.0 - 1.2.255.255','1.2.0.0 - 1.3.255.255'),"\n"); # print ("\ninvalid arguments: \n"); # print (" overlap value between 0 and 0: ",&testoverlap('0','0'),"\n"); ($r1,$e1) = &normalizerange('1.0/16'); ($r2,$e2) = &normalizerange('1.1/16'); if (&aggregate($r1,$r2) eq '1.0.0.0/15') { $t++, print "ok 40\n" } else { print "not ok 40\n"} ($r1,$e1) = &normalizerange('1.2/16'); if (&aggregate($r2,$r1) == -1) { $t++, print "ok 41\n" } else { print "not ok 41\n"} ($range,$error)=&normalizerange121('195.19.209.22'); if (($error=='20') and ($range eq '195.19.209.22 - 195.19.209.22')) { $t++, print "ok 42\n" } else { print "not ok 42\n"} # test aggregate # print ("\n\nTesting aggregate\n",'=' x 17,"\n"); # print ("\nvalid arguments: \n"); # ($range,$errorcode)=&normalizerange('1.0/16'); # $range1,$errorcode1)=&normalizerange('1.1/16'); # print (" aggregatable range between 1.0/16 and 1.1/16: ",&aggregate($range,$range1),"\n"); # print ("\ninvalid arguments: \n"); # ($range,$errorcode)=&normalizerange('1.2/16'); # print (" aggregatable range between 1.1/16 and 1.2/16: ",&aggregate($range1,$range),"\n"); # iprange being just a number # print ("\n\nTesting iprange being just a number\n",'=' x 17,"\n"); # ($range,$errorcode)=&normalizerange121('195.19.209.22'); # print (" range of 195.19.209.22 : ",$range,"\n"); # print "\n"; if ($t == 42) { print "\nAll tests successful.\n\n"; } else { print ("Failed ",(42 - $t)," tests.\n"); } asused-3.72/ipv4pack/Changes0100644000072700117040000000017107152434431015351 0ustar timursoftiesRevision history for Perl extension ipv4pack. 0.01 Mon Aug 28 11:49:50 2000 - original version; created by h2xs 1.19 asused-3.72/ipv4pack/MANIFEST0100644000072700117040000000006107152434432015206 0ustar timursoftiesChanges MANIFEST Makefile.PL ipv4pack.pm test.pl asused-3.72/ipv4pack/Makefile.PL0100644000072700117040000000121307740560643016036 0ustar timursoftiesuse 5.005; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. # RIPE NCC common configuration my %PARAM = ( 'INSTALLDIRS' => 'vendor', 'INSTALLSCRIPT' => '$(INSTALLVENDORBIN)', # Hack for Perl prior 5.8.1 'dist' => { 'COMPRESS' => 'gzip', 'SUFFIX' => '.gz', 'CI' => 'cvs ci', 'RCS_LABEL' => 'cvs tag -c -F $(NAME_SYM)-$(VERSION_SYM)', }, ); if($] >= 5.005) { $PARAM{AUTHOR} = 'Monica Cortes '; }; WriteMakefile( 'NAME' => 'ipv4pack', 'VERSION_FROM' => 'ipv4pack.pm', # finds $VERSION %PARAM ); asused-3.72/MANIFEST0100644000072700117040000000252407740563052013477 0ustar timursoftiesChanges MANIFEST MANIFEST.SKIP Makefile.PL README WARNING asused.PL asused.conf asused.pod test.pl NCC/Makefile.PL NCC/CountryCode/Changes NCC/CountryCode/CountryCode.pm NCC/CountryCode/MANIFEST NCC/CountryCode/Makefile.PL NCC/CountryCode/test.pl NCC/RipeDelegations/Changes NCC/RipeDelegations/MANIFEST NCC/RipeDelegations/Makefile.PL NCC/RipeDelegations/RipeDelegations.pm NCC/RipeDelegations/test.pl Net/Makefile.PL Net/RIPEWhois/Makefile.PL Net/RIPEWhois/in/Changes Net/RIPEWhois/in/MANIFEST Net/RIPEWhois/in/Makefile.PL Net/RIPEWhois/in/in.pm Net/RIPEWhois/in/test.pl extra/IO-1.20.tar.gz extra/README Reg/Makefile.PL Reg/Asused/Asused.pm Reg/Asused/Changes Reg/Asused/MANIFEST Reg/Asused/Makefile.PL Reg/Asused/test.pl ipv4pack/Changes ipv4pack/MANIFEST ipv4pack/Makefile.PL ipv4pack/ipv4pack.pm ipv4pack/test.pl Whois/Changes Whois/MANIFEST Whois/Makefile.PL Whois/Whois.pm Whois/test.pl Whois/ArinWhois/ArinWhois.pm Whois/ArinWhois/Changes Whois/ArinWhois/MANIFEST Whois/ArinWhois/Makefile.PL Whois/ArinWhois/test.pl Whois/RipeWhois/Changes Whois/RipeWhois/MANIFEST Whois/RipeWhois/Makefile.PL Whois/RipeWhois/RipeWhois.pm Whois/RipeWhois/cwhois Whois/RipeWhois/test.pl Whois/RipeWhois/FormatMode/Changes Whois/RipeWhois/FormatMode/FormatMode.pm Whois/RipeWhois/FormatMode/MANIFEST Whois/RipeWhois/FormatMode/Makefile.PL Whois/RipeWhois/FormatMode/test.pl asused-3.72/Reg/0040755000072700117040000000000007740564516013071 5ustar timursoftiesasused-3.72/Reg/Asused/0040755000072700117040000000000007740564516014315 5ustar timursoftiesasused-3.72/Reg/Asused/MANIFEST0100644000072700117040000000005707014015456015431 0ustar timursoftiesAsused.pm Changes MANIFEST Makefile.PL test.pl asused-3.72/Reg/Asused/Asused.pm0100644000072700117040000006256407711230657016103 0ustar timursofties#!/usr/local/bin/perl5.00502 # # Copyright (c) 1999, 2000 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.pm # Purpose : Perl module for asused # Author : AA # Date : Dec 1998 # Description : functionality of asused in a module # Language Version : perl 5.00502 & perl 5.00404 # OSs Tested : BSDI 3.1 # Command Line : - # Input Files : # Output Files : # External Programs : # Problems : # To Do : check how to intialize ref to a scalar \$scal type # aggree on policy regarding normalize121 to use # static IP addresses # Comments : # # $Id: Asused.pm,v 1.45 2003/07/28 14:22:00 timur Exp $ #------------------------------------------------------------------------------ #fix once RS fix the date problems in DB do strcit check on dates #To do specify the approveNa in a better way. #waiting for Ro to update regread functions to include. package Reg::Asused; # general Modules use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); # export stuff require Exporter; use Carp; # To connect to RIPE Whois server use RipeWhois; use Net::RIPEWhois::in qw( $STATUS_MISMATCH $MNT_BY_MISMATCH $INVALID_IP4_RANGE $INVALID_DATE $NETNAME_MISMATCH ); # Module for manipulation with IPs representations use ipv4pack; $VERSION = '1.21'; @ISA = qw(Exporter); @EXPORT = qw(); # command-line options for whois my $ALLOCOPT = '-L -T in'; # find all Less specific matches # I think this is an undocumented feature, so might change in future # Also used in pcheck.pm $ALLOCOPT .= " -Vasu$VERSION"; # send the vesrion info whois server # only works with RIPE whois server my $ASSIGNALLOPT = '-M -T in'; # find all More specific matches # I think this is an undocumented feature, so might change in future $ASSIGNALLOPT .= " -Vasu$VERSION"; my %default = ( 'VERSION' => $VERSION, 'errNo' => '', # error no. 'errMsg' => '', # error message 'errNoAll' => [], # array of error no. 'errMsgAll'=> [] # array of error msgs. ); #------------------------------------------------------------------------------ # Purpose : Bless the new progeny # Side Effects : # Comments : # IN : - # OUT : - sub new { my $proto = shift; my $class = ref($proto) || $proto; my %param = (%default, @_); my $self = { %param }; bless $self, $class; # Make new whois object if necessary unless(ref($self->{'Whois'})) { # We create an object with stripped comments by default my $whois = new RipeWhois('FormatMode' => 1); # On error don't create and instance of the class return unless($whois); # Store the object for farther use $self->{'Whois'} = $whois; } return $self; } #------------------------------------------------------------------------------ # Purpose : set/get the error message # Side Effects : # Comments : # IN : errorno; errmsg; reset flag # OUT : list - (error no.; errmsg) # # The errors are stored in list, return value is recent one scalar # If you need a list access @{$self->{'errMsgAll'}}, set $debug sub error { my $self = shift; my($num, #error no $msg, #scalar message $reset #reset flag used for resetting list ) = @_; #set error message and number #reset the error message and number if($reset){ $self->{'errNo'} = ''; $self->{'errMsg'} = ''; } # We have error code elsif($num) { $msg ||= ''; $self->{'errNo'} = $num; $self->{'errMsg'} = $msg; #if debug is used keep a list of errors if($self->{'debug'}){ push(@{$self->{'errNoAll'}}, $num); push(@{$self->{'errMsgAll'}}, $msg); } } # else - why did you call me :)? return($self->{'errNo'}, $self->{'errMsg'}) if($self->{'errNo'}); #error return; #on no errors } #----------------------------------------------------------------------------- # Purpose : Get the allocation objects from DB # Side Effects : # Comments : # IN : ref alloc object, hash of regalloc lines # OUT : 0 on success, error code on error, message in $! sub getDBAlloc { my $self = shift; my($alloc, $regAllocs) = @_; my @sortAllocList; # list of allocation sorted in the of # @{$regAllocs->{'list'}} # Get DB Allocation objects my @wList; # warnings in getting alloc object my %in; #temp hash used to keep unique list of allocations foreach my $rAlloc (@{$regAllocs->{'list'}}) { # Temp alloc object my $tempAlloc = new Net::RIPEWhois::in('Whois' => $self->{'Whois'}); # Netname $tempAlloc->validNa($alloc->validNa()); #get list of allocations from DB my @inList = $tempAlloc->getIn($rAlloc, $ALLOCOPT); #validate the list got from DB my @allocList = $tempAlloc->validAlloc(@inList); my($errNo, $errStr) = $tempAlloc->error(); #check if the errors are mnt-by, status, and na errors if((defined($errNo)) && ($errNo == $STATUS_MISMATCH || $errNo == $MNT_BY_MISMATCH || $errNo == $NETNAME_MISMATCH)) { # ignore this prefix and proceed $regAllocs->{$rAlloc}{'error'} .= $errStr; } #if still error better return elsif($errNo) { return($errNo, "ERROR: $rAlloc $errStr"); # on error } #DB returned multiple objects Discard the allocations if(scalar(@allocList) > 1){ my $errMsg = "ERROR: DB returned multiple inetnums as alloc for:\n\t"; $errMsg .= join("\n\t", @allocList); $regAllocs->{$rAlloc}{'error'} = "$errMsg\n"; } #found one allocation object elsif(@allocList) { my $allocation = $allocList[0]; #trick to keep unique list in order #push allocation object to list if this object don't exist in %in push(@sortAllocList, $allocation) unless($in{$allocation}); push(@{$in{$allocation}{'query'}}, $rAlloc); #what was prefix unless ($alloc->{$allocation}){ $alloc->{$allocation} = $tempAlloc->{$allocation}; } $alloc->{$allocation}{'query'} = $in{$allocation}{'query'}; } #if no allocations found copy error and proceed with the rest else{ $regAllocs->{$rAlloc}{'error'} .= "No allocation found in DB\n"; } } $alloc->{'dbAlloc'} = \@sortAllocList; #keep the list of allocation return(undef, @wList); # on success } #----------------------------------------------------------------------------- # Purpose : Get all assignments for an allocations from DB # Side Effects : # Comments : # IN : ref to alloc and assign (Net::RIPEWhois::in), # ref to Net::RIPEWhois # OUT : 0 on sucess, error code on error, message in $! sub getAssign { my $self = shift; my($alloc, # ref to alloc $assign, # ref to assign ) = @_; # each allocations found in db foreach my $allocation (@{$alloc->{'dbAlloc'}}){ # get list of assignments my @assign = $assign->getIn($allocation, $ASSIGNALLOPT); my($errNo, $errStr) = $assign->error(); if(defined($errNo)) { if ($errNo == $INVALID_DATE){ #invalid date exception till RS correct them #if invalid date is found don't proced to checking nw $self->{'invaliddate'} = $errStr; $assign->error('No', 'errors', 'found'); #reset the error } else { return($errNo, $errStr); # on error } } # Get only assignments within this allocation # XXX: Fix for the bug in Whois DB when unrelated objects # returned with -Tin flag. @assign = grep { (($assign->{$_}{'start'} >= $alloc->{$allocation}{'start'}) && ($assign->{$_}{'end'} <= $alloc->{$allocation}{'end'})); } @assign; # Sort the inetnum by start + end # XXX: Larger assignments first my @assignSort = sort { (($assign->{$a}{'start'} <=> $assign->{$b}{'start'}) || ($assign->{$b}{'end'} <=> $assign->{$a}{'end'})); } @assign; # Get stastistic on allocation $self->stats($alloc, $allocation, $assign, @assignSort); # Store assignments push(@{$assign->{'dbAssign'}}, @assignSort); # stats calculates free space from the begining of the allocation # till the last assignment. Map free space from last assignment # till the end of the allocation. if(defined($main::opt{'free'})) { if(@assignSort) { my $Abot = $assignSort[0]; # Find the real bottom of all assignments foreach my $asn (@assignSort) { $Abot = $asn if($assign->{$asn}{'end'} > $assign->{$Abot}{'end'}); } my $free = $self->findFree($assign->{$Abot}{'end'}, ($alloc->{$allocation}{'end'} + 1), $allocation); $self->{$allocation}{'sFree'} .= $free if($free); } # no assignments, just count the allocation else { my $free = $self->findFree($alloc->{$allocation}{'start'}, $alloc->{$allocation}{'end'}, $allocation); $self->{$allocation}{'sFree'} .= $free if($free); } } } return; #on success } #----------------------------------------------------------------------------- # Purpose : count usage, overlap, overlapped usage, classfull assign # Comments : # in : ref to assign, alloc, the sorted list of assign # out : undef sub stats { my$self = shift; my($alloc, # ref alloc Net::RIPEWhois::in $allocation, # inetnum the allocation Net::RIPEWhois::in $assign, # ref assign Net::RIPEWhois::in @assign # sorted on inetnum list of assignments ) = @_; my $usage = 0; # no of IP adresses used my $infra = 0; # no of IP's used for infrastructure my $oUsage = 0; # overlapped usage my $oCount = 0; # overlap count my $overlap = 0; # no of overlaps my $sOverlap = ''; # overlap output formatted string my $cCount = 0; # classfull count no of assignments of size /20 - 24 my $i = 0; # count assignment in this allocation #initialize the counts and strings $self->{$allocation}{'noOfAssigns'} = 0; $self->{$allocation}{'paStCount'} = 0; $self->{$allocation}{'piStCount'} = 0; $self->{$allocation}{'otherStCount'} = 0; $self->{$allocation}{'missStCount'} = 0; $self->{$allocation}{'sStatus'} = ''; $self->{$allocation}{'sFree'} = ''; $self->{$allocation}{'free'} = 0; # Calculate boundaries my $allocStart = $alloc->{$allocation}{'start'}; my $allocEnd = $alloc->{$allocation}{'end'}; # end of previous inetnum # just step back one address my $prevEnd = $allocStart - 1; # look at every inetnum # We assume, that starts of assignments are lined up # in asceding order. We not sure about the ends. foreach my $in (@assign) { # start of inetnum in decimal my $start = $assign->{$in}{'start'}; # end of inetnum in decimal my $end = $assign->{$in}{'end'}; # If assignment completely overlappes allocation if($start <= $allocStart && $end >= $allocEnd) { push(@{$alloc->{$allocation}{'warning'}}, sprintf("overlapped by %s assignment", $in)); } # Cut the end of assignment on allocation # boundary, if there are errors in assign data. $start = $allocStart if($start <= $allocStart); $end = $allocEnd if($end >= $allocEnd); # | 1 | #---------------- # | 2 | if($start > $prevEnd){ #Clean next assignment $usage += ($end - $start + 1); # map the free space if --assign if(defined($main::opt{'free'})) { my $free = $self->findFree($prevEnd, $start, $allocation); $self->{$allocation}{'sFree'} .= $free if($free); } $prevEnd = $end; } # | 1 | #------------- # | 2 | elsif($end > $prevEnd){ # An overlapping assignment $usage += ($end - $prevEnd); $prevEnd = $end; } # | 1 | #--------- # | 2 | else { # ignore # print "fully overlapped ones \n"; } #usage including overlap $oUsage += $assign->{$in}{'size'}; # infrastructual usage(with overlaps) $infra += $assign->{$in}{'size'} if($assign->{$in}{'infra'}); #no of assigments $self->{$allocation}{'noOfAssigns'}++; #count class full assignments $cCount += $self->countClassFull($assign, $in); # If there are any overlaps $oCount += $self->checkOverlap($assign, $i, \@assign, \$sOverlap); # format output string if --status, --assign, --infra and count status PI,PA etc $self->doStatus($assign, $allocation, $in); #format string for warnings if any foreach (@{$assign->{$in}{'warning'}}) { $self->{$allocation}{'warning'} .= sprintf("%s %s\n", $in, $_); } $i++; #count the assignment used in checking overlap } $self->{$allocation}{'usage'} = $usage; $self->{$allocation}{'infra'} = $infra; $self->{$allocation}{'uOverlap'} = $oUsage; $self->{$allocation}{'cOverlap'} = $oCount; $self->{$allocation}{'sOverlap'} = $sOverlap; $self->{$allocation}{'cClassfull'} = $cCount; return; #on success } #----------------------------------------------------------------------------- # Purpose : check and count overlaps # Side Effects : # Comments : checking done on a square Matrix of assignmetns [A]nxn # for i = 0; i < n; # for j= i+1; j < n # last if start of Aj > end of Ai # check if overlaps Ai with Aj # # # IN : $i start count in the list # ref to list of assignments # ref to output scalar # OUT : overlap count sub checkOverlap { my $self = shift; my($assign, $i, # start count to check overlap $assignList, # ref to list of assignments $sOverlap # ref to output scalar ) =@_; my $oCount = 0; # no of overlapping assignmenets return value; # start of first assignment my $start = $assign->{$assignList->[$i]}{'start'}; # end of first assignment my $end = $assign->{$assignList->[$i]}{'end'}; my $j = $i+1; #counter on inetnum my $jLast = $#{$assignList}; while ($j <= $jLast) { my $checkStart = $assign->{$assignList->[$j]}{'start'}; my $checkEnd = $assign->{$assignList->[$j]}{'end'}; #skip if inetnum is allready covered. last if ($checkStart > $end); #it is same inet num if(($start == $checkStart) and ($end == $checkEnd)) { push(@{$assign->{$assignList->[$i]}{'warning'}}, sprintf("inconsitant with %s\n", $assignList->[$j])); } #check for overlap if($start <= $checkEnd && $end >= $checkStart){ # +*----------x+ start # |x----------------*+ check $oCount++; if(defined($main::opt{'overlap'})){ #formatted output for overlap $$sOverlap .= sprintf ("OVERLAP %-33s %8d %s\n", $assignList->[$i], $assign->{$assignList->[$i]}{'created'}, $assign->{$assignList->[$i]}{'na'}) if (scalar(@{$assign->{$assignList->[$i]}{'overlap'}}) == 0); $$sOverlap .= sprintf (" %-33s %8d %s\n", $assignList->[$j], $assign->{$assignList->[$j]}{'created'}, $assign->{$assignList->[$j]}{'na'}); } #also push list to each inetnum push(@{$assign->{$assignList->[$i]}{'overlap'}}, $assignList->[$j]); } $j++; } return $oCount; #overlap count for this inetnum } #----------------------------------------------------------------------------- # Purpose : classfull assign count and usage # Side Effects : # Comments : # in : ref to $assign, inetnum value, # : class full usage no of addresses # : no of class full assignments # out : class full usage, classfull count sub countClassFull { my $self = shift; my($assign, #ref to assign Net::RIPEWhois::in $in #inetnum value ) = @_; # @{$assign->{'classFullSizes'}} # defined in Net::RIPEWhois::in foreach my $size (@{$assign->{'classFullSizes'}}){ # If assignment is a classfull size, return 1 return 1 if($size == $assign->{$in}{'size'}); } return 0; # Otherwise } #----------------------------------------------------------------------------- # Purpose : format the output string for --status and --assign, # probably, with --pipa or --infra # Side Effects : # Comments : # IN : ref; $assign; $allocation; inetnum value # OUT : undef sub doStatus { my $self = shift; my($assign, $allocation, $in) = @_; if($assign->{$in}{'st'}) { #status is ASSIGNED PA if($assign->{$in}{'st'} =~ /^\s*ASSIGNED\s+PA/i){ $self->{$allocation}{'paStCount'}++; $self->{$allocation}{'sStat'} = 'PA'; if(defined($main::opt{'assign'})){ $self->printStatus($assign, $allocation, $in); } return; } #status ASSIGNED PI elsif($assign->{$in}{'st'} =~ /^\s*ASSIGNED\s+PI/i){ $self->{$allocation}{'piStCount'}++; $self->{$allocation}{'sStat'} = 'PI'; if(defined($main::opt{'assign'})){ $self->printStatus($assign, $allocation, $in); } return; } #any other status elsif($assign->{$in}{'st'}){ $self->{$allocation}{'otherStCount'}++; $self->{$allocation}{'sStat'} = 'UN'; $self->printStatus($assign, $allocation, $in); } return; } #missing status $self->{$allocation}{'missStCount'}++; $self->{$allocation}{'sStat'} = '--'; $self->printStatus($assign, $allocation, $in); return; } #----------------------------------------------------------------------------- # Purpose : print inetnum size, date, netname, staus to scalar # Side Effects : # Comments : # IN : ref ref to $assign , allocation , inetnum value # OUT : undef sub printStatus { my $self = shift; my($assign, $allocation, $in) = @_; #print inetnum value, size $self->{$allocation}{'sStatus'} .= sprintf("%-33s ", $in); if(defined($main::opt{'cidr'})) { $self->{$allocation}{'sStatus'} .= sprintf("%s ", join(',', map { "/$_" } $self->slashed($assign->{$in}{'size'}))); } else { $self->{$allocation}{'sStatus'} .= sprintf("%5d ", $assign->{$in}{'size'}); } #date of creation if($assign->{$in}{'created'}){ $self->{$allocation}{'sStatus'} .= sprintf("%8d", $assign->{$in}{'created'}); } else { $self->{$allocation}{'sStatus'} .= "********"; } # PI/PA if(defined($main::opt{'pipa'})) { $self->{$allocation}{'sStatus'} .= sprintf(" %-2s", $self->{$allocation}{'sStat'}); } # INFRA-AW elsif(defined($main::opt{'infra'})) { $self->{$allocation}{'sStatus'} .= sprintf(" %-3s", ($assign->{$in}{'infra'}) ? ' # ' : ' '); } # NETNAME $self->{$allocation}{'sStatus'} .= sprintf(" %-15s ", $assign->{$in}{'na'}); # status $self->{$allocation}{'sStatus'} .= $assign->{$in}{'st'} || "" if(defined($main::opt{'status'}) && !defined($main::opt{'pipa'})); # Infra-aw if($assign->{$in}{'infra'}) { $self->{$allocation}{'sInfra'} .= sprintf("%-33s %5d ", $in, $assign->{$in}{'size'}); #date of creation if($assign->{$in}{'created'}){ $self->{$allocation}{'sInfra'} .= sprintf("%8d", $assign->{$in}{'created'}); } else { $self->{$allocation}{'sInfra'} .= "********"; } # NETNAME $self->{$allocation}{'sInfra'} .= sprintf(" %-15s ", $assign->{$in}{'na'}); # status $self->{$allocation}{'sInfra'} .= $assign->{$in}{'st'} || "" if(defined($main::opt{'status'}) && !defined($main::opt{'pipa'})); $self->{$allocation}{'sInfra'} .= "\n"; } $self->{$allocation}{'sStatus'} .= "\n"; return; # on success } #----------------------------------------------------------------------------- # Purpose : map the free space between two inetnums, format scalar # print prefix notation if can be expressed as single prefix # Side Effects : # Comments : # IN : end of the last assignemnet in decimal # start of the next assignment in decimal # OUT : formatted scalar sub findFree { my $self = shift; my($prevEnd, #end of the last assignemnet $start, #start of the next assignment $allocation #allocation inetnum ) = @_; my $sFree; #return string if($start > ($prevEnd + 1)) { # convert the decimal into range a.b.c.d - p.q.r.s my $range = sprintf ("%s - %s", int2quad(($prevEnd + 1)), int2quad(($start - 1))); $sFree = sprintf ("%-33s %6d", $range, $start - $prevEnd - 1); $self->{$allocation}{'free'} = 0 unless(defined($self->{$allocation}{'free'})); $self->{$allocation}{'free'} += ($start - $prevEnd - 1); # get the prefix for the free range my(@prefixes) = &range2prefixes($range); # print prefix if it is single prefix if(scalar(@prefixes) == 1) { $sFree .= sprintf(" %10s free range", $1) if($prefixes[0] =~ m%(/\d+)$%); } # Add trailing carriage return $sFree .= "\n"; return $sFree; #on success } return; } # By Oleg # Has problems with /0 sub slashed { my $self = shift; my($size) = @_; my @prefix = (); my $i = 32; do { push(@prefix, $i) if($size & 1); $i--; } while($size = $size >> 1); return reverse(@prefix); } 1; __END__ # POD for methods that can be called. =head1 NAME Reg::Asused - Perl module for asused. =head1 SYNOPSIS use Reg::Asused; use regread; use ipv4pack; my($asu) = new Reg::Asused; my($errNo, $errStr ) = $asu->getDBAlloc($alloc, $whois, \%regAlloc); ($errNo, $errStr ) = $asu->getAssign($alloc, $assign, $whois); ($network, $ret) = $asu->approveNa($whois, $opt{'valid'}, $opt{'regid'}); =head1 DESCRIPTION =head2 approveNa my ($network, $ret, $vlid) = $asu->approveNa($whois, $arg, $regid); Will return ref to inetnum result in string and valid result. On error will return undef. ($errno, $errstr) = $asu->error will return error. =head2 checkOverlap $oCount = $self->checkOverlap($assign, $i, \@assign, \$sOverlap); Check for overlap in list of inetnum objects. The list @{$assign->{$assignList->[$i]}{'overlap'}}. have list of overlapping inetnums. If two inetnums are logically sme will set warning in the list @{$assign->{$assignList->[$i]}{'warning'}} have list of overlapping inetnums. =head2 error return error number and string. ($errorno, $errorstr ) = $asu->error; reset the error $asu->(undef, undef, 1); =head2 getAssign Get all assignments for each prefix in @{$alloc->{'dbAlloc'}}. ($errNo, $errStr ) = $asu->getAssign($alloc, $assign, $whois); Return undef on success. =head2 getDBAlloc Get allocaions from RIPE whois database for all prefix or allocation under a registary. C<-L> C<-F> C<-c> C<-T> in . check netname same are regid (translated "." "-"), mnt-by is one of valid RIPE maintiner, status is ALLOCATED PA, PI or UNSPECIFIED. my($errNo, $errStr ) = $asu->getDBAlloc($alloc, $whois, $regAlloc); $alloc Ref to Net::RIPEWhois::in $whois Ref to Net::RIPEWhois $regAlloc ref to hash with keys as queries to locate Allocations. =head1 AUTHOR Antony software group RIPE NCC =head1 SEE ALSO perl(1). =cut asused-3.72/Reg/Asused/test.pl0100644000072700117040000000122006636245352015616 0ustar timursofties# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..1\n"; } END {print "not ok 1\n" unless $loaded;} use Reg::Asused; $loaded = 1; print "ok 1\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): asused-3.72/Reg/Asused/Changes0100644000072700117040000000042706676424115015605 0ustar timursoftiesRevision history for Perl extension Reg::Asused. 1.19 Mon Mar 15 17:04:09 1999 Fixed Bug of counting free space if there are no assignments 1.18 Wed Mar 10 17:57:41 1999 Installed in /usr/local/lib 0.01 Tue Dec 15 20:32:18 1998 - original version; created by h2xs 1.19 asused-3.72/Reg/Asused/Makefile.PL0100644000072700117040000000035407014010160016235 0ustar timursoftiesuse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Reg::Asused', 'VERSION_FROM' => 'Asused.pm', # finds $VERSION ); asused-3.72/Reg/Makefile.PL0100644000072700117040000000026007146536025015030 0ustar timursoftiesuse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Reg', ); asused-3.72/asused.PL0100644000072700117040000011406507740557717014106 0ustar timursofties#!/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 # Timur Bakeyev # 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() { 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 <{'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; asused-3.72/Net/0040755000072700117040000000000007740564516013102 5ustar timursoftiesasused-3.72/Net/Makefile.PL0100644000072700117040000000026007267522260015041 0ustar timursoftiesuse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Net', ); asused-3.72/Net/RIPEWhois/0040755000072700117040000000000007740564516014653 5ustar timursoftiesasused-3.72/Net/RIPEWhois/in/0040755000072700117040000000000007740564516015261 5ustar timursoftiesasused-3.72/Net/RIPEWhois/in/MANIFEST0100644000072700117040000000005306624621475016403 0ustar timursoftiesChanges MANIFEST Makefile.PL in.pm test.pl asused-3.72/Net/RIPEWhois/in/in.pm0100644000072700117040000005760307711230657016227 0ustar timursofties# Copyright (c) 1999 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 : Reg::Allocation.pm # Purpose : Get an allocation # Author : AA # Date : 19980921 # Description : Get inetnum objects from RIPE Whois db 2.1 # Language Version : perl5.04004, perl5.00502 # OSs Tested : BSDI # Command Line : # Input Files : # Output Files : # External Programs : # Problems : # To Do : use conf file from whois db to read attributs # Don't use STDERR in the module # # # Comments : if RIPE DB change changed attribute check the consistancy # : this module uses -F to get fast output. # : Module uses %main::opt which isn't graceful. # $Id: in.pm,v 2.49 2003/07/28 14:21:56 timur Exp $ #------------------------------------------------------------------------------ package Net::RIPEWhois::in; use strict; use vars qw(@ISA @EXPORT @EXPORT_OK); require Exporter; @ISA = qw(Exporter); @EXPORT = qw(); use vars qw($VERSION); $VERSION = '0.03'; # Time functions use Time::Local; # RIPE NCC delegations use NCC::RipeDelegations; # Make Whois queries use RipeWhois; # Manipulations with ip address ranges and prefixes use ipv4pack; use vars qw($NETNAME_MISMATCH $MULTIPLE_INETNUM $INVALID_IP4_RANGE $INVALID_DATE $MNT_BY_MISMATCH $STATUS_MISMATCH); #2xx Allocations $MNT_BY_MISMATCH = 211; # incorrect MNT-BY Attribute my $MNT_BY_MULTIPLE = 212; # multiple mnt-by attribute my $STATUS_MISSING = 213; # missing status my $STATUS_OTHER = 214; # other status $NETNAME_MISMATCH = 215; # netname mismatch $STATUS_MISMATCH = 216; # status mismatch # NO_ALLOC_INREG = 217; # NO_REGID_FOUND = 218; # REGID_MISMATH = 219; #5xx my $NOT_IN_RIPE_DELEGATION = 511; $INVALID_IP4_RANGE = 512; $INVALID_DATE = 513; my $SOURCE_NOT_RIPE = 514; #3xx $Assignments my $NO_ALLOC_INDB = 301; my $SIZE_MISMATCH = 302; my $NOT_WITHIN_ALLOCATION = 311; my $NOT_APPROVED = 321; $MULTIPLE_INETNUM = 322; #4xxx my $NO_VALID_ALLOCS = 401; my $NO_ALLOCS = 402; # Preloaded methods go here. @EXPORT_OK = qw($MNT_BY_MISMATCH $INVALID_DATE $INVALID_IP4_RANGE $STATUS_MISMATCH $NETNAME_MISMATCH $MULTIPLE_INETNUM &checkYYYYmmDD); # We do have 3 RIPE maintainers at the moment: # 'RIPE-NCC-MNT', 'RIPE-NCC-HM-MNT', 'RIPE-NCC-HM-PI-MNT' my %default = ( 'validNa' => [], # list of the valid netnames for allocations 'validMb' => ['RIPE-NCC-HM-MNT'], # valid mnt-by for allocations 'whoisOpt' => '-r -T in', # default options for inetnum query 'validSt' => [ # valid status for allocations 'ALLOCATED\s+PA', 'ALLOCATED\s+PI', 'ALLOCATED\s+UNSPECIFIED', 'LIR\-PARTITIONED\s+P[AI]', 'SUB\-ALLOCATED\s+P[AI]', ], # Correct status allocation inetnum objects 'strict' => [], # not yet used. for checking error levels 'errNo' => '', # error number. 'errMsg' => '', # error Message 'dbAlloc' => [], # list of db allocations 'query' => [], # inetnum query 'dbAssign' => [], # list of assignments # list of assignments of size counted 'classFullSizes' => ['256', '512', '1024', '2048', '4096'], ); #------------------------------------------------------------------------------ # Purpose : bless the new progeny # Side Effects : # Comments : # sub new { my $proto = shift; my $class = ref($proto) || $proto; my %param = (%default, @_); my $self = { %param }; bless $self, $class; # Create a list IP delegations to RIPE my $deleg = new NCC::RipeDelegations(); # XXX: We treate abcence of the list as # non-fatal error at the moment if(ref($deleg)) { $self->{'Delegations'} = $deleg; } # Make new whois object if necessary unless(ref($self->{'Whois'})) { # We create an object with stripped comments by default my $whois = new RipeWhois('FormatMode' => 1); # On error don't create and instance of the class return unless($whois); # Store the object for farther use $self->{'Whois'} = $whois; } return $self; } # Some people have reported that Net::DNS dies because AUTOLOAD picks up # calls to DESTROY. # I saw that once. sub DESTROY {} #------------------------------------------------------------------------------ # Purpose : set/get the mnt-by: attribute # Side Effects : # Comments : Want do better syntax check # has to read RIPE DOC sub validMb { my $self = shift; my(@validMb) = @_; # list of valid mnt-by values $self->{'validMb'} = [@validMb] if(@validMb); return @{$self->{'validMb'}}; # valid mnt-by values } #------------------------------------------------------------------------------ # Purpose : set/get the NetName # Side Effects : # Comments : Want do better syntax check # has to read RIPE DOC sub validNa { my $self = shift; my(@validNa) = @_; $self->{'validNa'} = [@validNa] if(@validNa); return @{$self->{'validNa'}}; # valid Na } #------------------------------------------------------------------------------ # Purpose : set/get the error message # Side Effects : # Comments : # IN : errorno, errmsg to set message # undef, undef, true to reset message # with out any arg to get error # OUT : list error no. errmsg # undef when called with undef, undef, true # # # The errors are stored in list, return value is recent one scalar # If you need a list access @{$self->{'errMsgAll'}},set $debug sub error { my $self = shift; my($num, #error no $msg, #scalar message $reset #reset flag used for resetting list ) = @_; #set error message and number #reset the error message and number if($reset){ $self->{'errNo'} = ''; $self->{'errMsg'} = ''; } # We have error code elsif($num) { $msg ||= ''; # but, maybe, don't have message $self->{'errNo'} = $num; $self->{'errMsg'} = $msg; #if debug is used keep a list of errors if($self->{'debug'}){ push(@{$self->{'errNoAll'}}, $num); push(@{$self->{'errMsgAll'}}, $msg); } } # else - why did you call me :)? return ($self->{'errNo'}, #error number $self->{'errMsg'}) if($self->{'errNo'}); #error message return; #on no errors } #------------------------------------------------------------------------------ # Purpose : Get inetnum objects from database. # Side Effects : # Comments : We enforce fast (-F) output # IN : ref RipeWhois, query string, query opt # OUT : list of inetnums, undef on error sub getIn { my $self = shift; my($inQuery, $whoisOpt) = @_; # Use default options if nothing passed $whoisOpt = $self->{'whoisOpt'} unless($whoisOpt); # Get inetnum objects my @objects = $self->{'Whois'}->QueryObjects('-F', $whoisOpt, $inQuery); # Return nothing if no results return unless(@objects); my @in; # List of recognized inetnum objects # Parse each of the objects foreach my $object (@objects) { my $inetnum; # temp inetnum my %in; # inetnum object # Split each object into lines foreach my $line (split(/\n/, $object)) { # Parse each line # XXX: (.*) means, that value can be empty; not v.3 compliant if($line =~ /^\*(\w\w):\s+(.*?)\s*$/) { # Extract attribute/value pair my($attr, $value) = ($1, $2); if($attr eq 'in') { # Normalize the inetnum range my($in, $resp) = normalizerange($value); # BaT 20010410 # XXX: Skip the encompassing object, we hardcode it here if($resp == $O_OK && $value eq '0.0.0.0 - 255.255.255.255') { # Skip this object last; } elsif($resp == $O_PRIVATERANGE && $value eq '192.0.0.0 - 192.255.255.255') { # Skip this object last; } elsif(($resp > 1) && ($resp != $O_CLASSFULL) && ($resp != $O_IPADDRONLY)) { # Error for normalizerange my $error = error2str($resp); $self->error($INVALID_IP4_RANGE, "Invalid IP address range $value: $error"); return; } # Get start and end of the IP range my($quadStart, $quadEnd) = split(/\-/, $in); my $start = quad2int($quadStart); my $end = quad2int($quadEnd); # If it is strange object probably DB people will say it is not possible if(($start < 0) || ($end < 0) || ($end < $start)) { # Strange Object, never seen one so far,but IMHO it is possible $self->error($INVALID_IP4_RANGE, "Invalid IP address range $value"); return; } # New valid normalized inetnum object $inetnum = $in; # Initialize the hash values initHashValues(\%in); # Set ref to self $self->{$inetnum} = \%in; # Fill in the hash $in{'start'} = $start; $in{'end'} = $end; $in{'size'} = $end - $start + 1; # Catch the old style classfull object # Produce the warning. if($resp == $O_CLASSFULL) { my $warning = sprintf("Classfull notation %s?", $in{'size'}); push(@{$in{'warning'}}, $warning); } elsif($resp == $O_IPADDRONLY) { #special case for /32 inetnum in the format a.b.c.d my $warning = sprintf("Range with one address %s?", $in{'size'}); push(@{$in{'warning'}}, $warning); } } # Next get all needed attributes into hash elsif($inetnum && $attr eq 'na') { # Netname $in{'na'} = $value; } elsif($inetnum && $attr eq 'st') { # Status $in{'st'} = $value; } elsif($inetnum && $attr eq 'mb') { # Mnt-by push(@{$in{'mb'}}, $value); } elsif($inetnum && $attr eq 'ac') { # Admin-c push(@{$in{'ac'}}, $value); } elsif($inetnum && $attr eq 'tc') { # Tech-c push(@{$in{'tc'}}, $value); } elsif($inetnum && $attr eq 'ch') { # Changed push(@{$in{'ch'}}, $value); } elsif($inetnum && $attr eq 'so') { # Source $in{'so'} = $value; } elsif($inetnum && $attr eq 'ml') { # Mnt-lwr push(@{$in{'ml'}}, $value); } elsif($inetnum && $attr eq 'rm') { # Remarks $in{'infra'} = 1 if($value =~ /^\bINFRA\-AW\b/i); } } } # Get creation date for valid inetnum object if($inetnum) { # Validate date my $date = $self->creationDate(@{$in{'ch'}}); if($date) { $in{'created'} = $date; } else { $self->error($INVALID_DATE, ("Invalid date in " . join('; ', @{$in{'ch'}}))); push(@{$in{'warning'}}, ($self->error())[1]); } # Skip LIR-PARTITIONED PA next if($in{'st'} =~ /^LIR\-PARTITIONED\s+P[AI]$/i); # Special treatment for SUB-ALLOCATED PA if($in{'st'} =~ /^SUB\-ALLOCATED\s+P[AI]$/i) { push(@{$self->{'sub-alloc'}}, $inetnum); next; } # This is a valid inetnum, put it into the list push(@in, $inetnum); } } # We do have objects to show return(@in) if(@in); # Spit the whole ans for debug. $self->error($NO_ALLOCS, "No inetnum object found"); # on error return; } #------------------------------------------------------------------------------ # Purpose : Get valid allocations from Hash of Inetnum # Side Effects : error no will be the last error, Error messages are # concatenated. # Comments : # IN : : list of inetnums # OUT : : list of valid allocations sub validAlloc { my $self = shift ; my(@inList) = @_; # list of inetnums my($netName, @dbInetNums); # If empty whois respond unless(@inList) { $self->error($NO_ALLOCS, 'No object(s) in DB'); return; #on error } foreach my $inetnum (@inList){ # Skip if it is an IANA delegation and we # have a delegations list if(defined($self->{'Delegations'})) { next if($self->{'Delegations'}->isDelegation($inetnum)); } # check status, netname and mnt-by to verify identity as allocation if($self->checkSt($inetnum, $self->{$inetnum}{'st'}) && # Status $self->checkNa($inetnum, $self->{$inetnum}{'na'}) && # Netname $self->checkMb($inetnum, @{$self->{$inetnum}{'mb'}}) # Mnt-by ) { # valid allocation push(@dbInetNums, $inetnum); } } #push to allocation list if (@dbInetNums){ # Reset errors $self->error(); push(@{$self->{'dbAlloc'}}, @dbInetNums); return(@dbInetNums); # on sucess } # if there is no error message $self->error($NO_ALLOC_INDB, 'No allocation object in DB, inetnum(s) found ' . join(', ', @inList)) unless($self->error()); return; # on error } #------------------------------------------------------------------------------ # Purpose : check for correct status form list of valid status # Side Effects : is a special case of error concatinate the error message. # error number will be last message # Comments : # IN : : inetnum value, status value. # OUT : : 1 if matches, undef otherwise sub checkSt { my $self = shift; my($inetnum, #inetnum $st #status attribute ) = @_; my $err; #check against valid status foreach my $validSt (@{$self->{'validSt'}}) { # Valid status return 1 if($st =~ /$validSt/i); } $err .= sprintf("status %s is invalid %s\n\t", $st, $inetnum); $err .= ($self->error())[1] if($self->error()); $self->error($STATUS_MISMATCH, $err); return; #on error } #------------------------------------------------------------------------------ # Purpose : check mnt-by value # Side Effects : is a special case of error concatinate the error message. # error number will be last message # Comments : # IN : : inetnum value, mnt-by value. # OUT : : 1 if matches, undef otherwise sub checkMb { my $self = shift; my($inetnum, # inetnum @mb # list of mnt-by found from DB ) = @_; my $err; #check for each mnt-by value foreach my $mbValue (@mb) { #against valid values foreach my $validMb (@{$self->{'validMb'}}) { # Valid mnt-by return 1 if($mbValue =~ /$validMb/i); } $err .= sprintf("mnt-by: %s is invalid for %s\n\t", $mbValue, $inetnum); } #is a special case of error concatinate the error message. # error number will be last message $err .= ($self->error())[1] if($self->error()); $self->error($MNT_BY_MISMATCH, $err); return; } #------------------------------------------------------------------------------ # Purpose : #check valid netname # Side Effects : is a special case of error concatinate the error message. # error number will be last message # Comments : # IN : : inetnum value, na value. # OUT : : 1 if matches, undef otherwise sub checkNa { my $self = shift; my($inetnum, # inetnum $na # netname from db ) = @_; my $err; #check against valid na foreach my $validNa ($self->validNa){ $validNa =~ s/\./-/; # tranlate first "." to - # Skip empty values next unless($validNa); # Valid netname(case-insensitive match according to RIPE 223) return 1 if($na =~ /\Q$validNa\E/i); } #Keep error list in Buffer may correct one follows $err .= sprintf("netname %s is invalid for %s\n\t", $na, $inetnum); $err .= ($self->error())[1] if($self->error()); $self->error($NETNAME_MISMATCH, $err); return; # on error } #------------------------------------------------------------------------------ # Purpose : get the create date from ch attribute # Side Effects : # Comments : date related routine if changed attribute # in db cahnge may need modifcication # IN : : list of changed value from DB # OUT : : date of createion in YYYYMMDD sub creationDate { my $self = shift; my(@ch #list of ch from DB ) = @_; my @dateList; #don't trust the date from db foreach my $dateStr (@ch) { if($dateStr =~ /(\d+)$/) { my $date = $1; return unless ($date = checkYYYYmmDD($date)) ; #look if it is valid date push(@dateList, $date); #make list of valid dates } } my @sortedDate = sort { $a <=> $b } @dateList; return $sortedDate[0]; #on success return the earliest date } #------------------------------------------------------------------------------ # Purpose : Check a date is valid date for unix too # Side Effects : if passed arb. string localtime will produce warning # Comments : a is valid if a == (1/(1/a)) # IN : date as YYYYMMDD or YYMMDD # OUT : date in the format YYYYMMDD on success, # undef on error. sub checkYYYYmmDD { my($yyyyMMdd) = @_; #date my($yy, $mm, $dd, $utc, $yyActual, $mmActual, $ddActual, $date); my($sec, $min, $hour, $wday, $yday, $isdst); # Temp vars #YYYYMMDD if($yyyyMMdd =~ /^(\d{4})(\d{2})(\d{2})$/) { $yy = $1 - 1900; $mm = $2; $mm--; $dd = $3; } #YYMMDD #asume it is 20th century date elsif($yyyyMMdd =~ /^(\d{2})(\d{2})(\d{2})$/) { #in the format yyddmm $yy = $1; $mm = $2; $mm--; $dd = $3; # just in case if($yy > 70) { # 20th century $yyyyMMdd += 19000000; } else { # looks like 21st $yyyyMMdd += 20000000; } } else { # print STDERR "invalid date $yyyyMMdd YYYYMMDD or yyddmm\n"; return 0; #error in input format } if($mm < 0 or $mm > 11) { #invalid month return; } return if($dd < 1 or $dd > 31); #invalid date # Sometimes date is so weird, it dies here... $utc = eval { timelocal('0', '0', '0', $dd, $mm, $yy); }; # Invalid date return if($@ || !$utc); ($sec, $min, $hour, $ddActual, $mmActual, $yyActual, $wday, $yday, $isdst) = localtime($utc); $yyActual +=1900; $mmActual++; #make YYYYMMDD format $date = sprintf("%04d%02d%02d", $yyActual, $mmActual, $ddActual); return $date if($date == $yyyyMMdd); #success #print "$yyyyMMdd not $date invalid date\n" if $$debug; return; #date mismatch } #------------------------------------------------------------------------------ # Purpose : initialize a nested hash so perl -w wont complain # Side Effects : # Comments : # # IN : : ref to the hash to be initialized, # OUT : : undef sub initHashValues { my($dest, # ref to the hash to be initialized, ) = @_; #inetnum attributes as returned by whois -F $dest->{'mb'} = []; # list of mnt-by values $dest->{'ac'} = []; # list of admin-c values $dest->{'tc'} = []; # list of tech-c values $dest->{'ch'} = []; # list of changed values $dest->{'so'} = ''; # source $dest->{'ml'} = []; # list of mnt-lower $dest->{'na'} = ''; # netname $dest->{'st'} = ''; # status # derived values from attributes $dest->{'start'} = ''; # start of inetnum in decimal $dest->{'end'} = ''; # end of inetnum in decimal after normalizing $dest->{'size'} = ''; # end +1 - start $dest->{'created'} = ''; # normalized date in the format YYYYMMDD $dest->{'warning'} = []; # list of warnings if any $dest->{'valid'} = ''; # scalar if inetnum is valid $dest->{'invalid'} = ''; # scalar if inetnum is invalid $dest->{'overlap'} = [];# list of overlapping inetnums return; #on success } 1; __END__ # Below is the stub of documentation for your module. You better edit it! =head1 NAME Net::RIPWhois::in - Perl extension for accessing inetnum objects from RIPE whois database. =head1 SYNOPSIS use Net::RIPEWhois::in $in = new Net::RIPEWhois::in; @in = getIn($whois, $prefix, $ALLOCOPT); $whois->closeWhois(); =head1 DESCRIPTION Get inetnum objects from RIPE whois server. Validate as allocation object. =head1 METHODS =head2 debug Get or set the debug. $in->debug(1); set the debug. $in->debug(undef); turn off the $debug; =head2 error ($errNo, $errMsg) = $in->error; $in->(undef, undef, true); reset the error message Will get the last error no and error string; if $whois->debug is set @{$in->{'errMsgAll'}} and @{$in->{'errNoAll'}} will have the list of all errors and error numbers. =head2 new $in = new Net::RIPEWhois::in Creates a new inetnum object. ENV variables WHOISHOST and WHOISPORT =head2 getIn Return a list of inetnum objects returned by whois. $whois = new Net::RIPEWhois; @in = $in->getIn($whois, $prefix, $ALLOCOPT); Selected attributes of inetnum are stored in data structure i. Should always query with fast raw output used by the RIPE whois db. $in->{inetnum}{attribute} return undef on error. use $in->error() to get error no. and message. =head2 splitWhoisAns Split the response string from whois ans and return list of inetnum on sucess. @inList = $in->splitWhoisAns( $whoisAnsRef); Returns undef on error. Spliting depending on fast raw output format from whois db. Use C<-F> to get fast raw output. =head2 validAlloc Check the inetnum is an alloation or not. Using netname same as regid, translated "." to C<-> . mnt-by RIPE-NCC-MNT ,RIPE-NCC-HM-MNT status ALLOCATED PA, ALLOCATED PI, ALLOCATED UNSPECIFIED and not in IANA Delegated list. As specified in the specification when queried C<-L> C<-T> in the range database should return max 3 inetnum objects. Assignment, Allocation & IANA delegation to RIPE. Skip if it is an IANA delegation and aply the previous check. @valid = $in->validAlloc(@inlist); undef on error. =head2 checkYYYYmmDD Function used to check dates are valid or not. Converts to UTC on YYYYMMDD and concert back to date format if these to matchs treated ad valid date. $YYYYMMDD = checkYYYYmmDD($YYYYMMDD); Accepts YYMMDD and YYYYMMDD formats. YYMMDD is treated as 19YYMMDD =head1 FILES F perl file with list of IANA delegations. =head1 REQUIRES perl module ipv4pack =head1 AUTHOR Antony software group RIPE NCC =head1 SEE ALSO perl(1), Net::RIPEWhois(3), whois(1) =cut asused-3.72/Net/RIPEWhois/in/test.pl0100644000072700117040000000210607267334431016564 0ustar timursofties# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..1\n"; } END { print "not ok 1\n" unless $loaded; } use RipeWhois; use Net::RIPEWhois::in; $loaded = 1; print "ok 1\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): my $whois = new RipeWhois('FormatMode' => 1); my $assign = new Net::RIPEWhois::in(Whois => $whois); my @assign = $assign->getIn('212.22/16', '-r -M -T in'); foreach my $inetnum (sort(@assign)) { print "$inetnum:\n"; print "\tna: ", $assign->{$inetnum}{'na'}, "\n"; print "\tac: ", join('; ', @{$assign->{$inetnum}{'ac'}}), "\n"; print "\ttc: ", join('; ', @{$assign->{$inetnum}{'tc'}}), "\n"; }asused-3.72/Net/RIPEWhois/in/Makefile.PL0100644000072700117040000000035706624621477017235 0ustar timursoftiesuse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Net::RIPEWhois::in', 'VERSION_FROM' => 'in.pm', # finds $VERSION ); asused-3.72/Net/RIPEWhois/in/Changes0100644000072700117040000000044506725707262016553 0ustar timursoftiesRevision history for Perl extension Net::RIPEWhois::in. 2.19 Fri Jun 04 08:29:42 added exception /32 inetnums of the format a.b.c.d 2.17 Thu Mar 25 12:16:05 -noticed YYYYMMDD could accept date 0, Fixed this. 0.01 Wed Oct 21 12:26:54 1998 - original version; created by h2xs 1.18 asused-3.72/Net/RIPEWhois/Makefile.PL0100644000072700117040000000027307267522264016622 0ustar timursoftiesuse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Net::RIPEWhois', ); asused-3.72/asused.conf0100644000072700117040000000063207156145234014476 0ustar timursofties## ## Please change these details to match your registry information. ## ## You can find which allocations your registry has at: ## URL: http://www.ripe.net/ripencc/mem-services/general/allocs4.html ## or at http://www.ripe.net/ripencc/mem-services/general/allocs.html ## # Registry ID REGID = nl.surfnet # List of allocations to that registry # One line per allocation ALLOC = 194.171/16 ALLOC = 195.169/16 asused-3.72/WARNING0100644000072700117040000000023607740563026013375 0ustar timursoftiesDear 'asused' users! Please, note, that support of this program is discontinued and that RIPE NCC is coming with the new improved program as a replacement. asused-3.72/extra/0040755000072700117040000000000007740564516013477 5ustar timursoftiesasused-3.72/extra/README0100644000072700117040000000147207162143554014351 0ustar timursoftiesThis is the perl5 IO distribution. This distribution is included in the perl5 core distribution. You should only need to install this distribution if it is newer than your perl installation. To install this distribution you will need access rights to the perl install ation on your system, as it overwrites your currently installed version of IO. This distribution relies upon the Socket module (version 1.3), which is avaliable from CPAN. Although you should not need to get this if your version of perl is fairly recent, as Socket is also distributed in the core perl distribution. If you do not have the required modules, you will see a warning when the Makefile is built. To build, test and install this distribution type: perl Makefile.PL make test make install Share and Enjoy! Graham Barr asused-3.72/extra/IO-1.20.tar.gz0100644000072700117040000007554307162142742015515 0ustar timursofties5IO-1.20.tar=wǮ Y>n8Ml;MO>8 fK۟XNz/h4FҌ['93_,<V.*1V_,?ƪJP(*%-*G~o=XwGq?-wUY]iOUcBYwZ(*f׿XTf'8301ILCyڅ'l3;;ke=t=eY?>S#le4_EyjJ] gܷ/q=<͞K9<P5eD,سv>tΝ%?tv؟Xg] tѱՓ' kZ oϳ:"@7ףXĵ>K|8݈+glR's%1&;<@6{= 0kYϙ?o9w`xw,Ǚl̙5XI5`I+8u){|al/qgN [gb|TE*'Ll!+4$1I^ A^{zkL{tᮘ^QfA.Hr璙bؾ^jDpIr\vFF(3׼>̟cJWDYY4l"䌂4NmrTvЃyx1biD>eMދ,ݑ8 @kd92&hLJobjT.mC|k,zI;spxv7Ra7n( ʁ03_xk#|@TE?1IieUtˊ(D= ;N#0ao`{@cT)N~RGIיB PF#Vpڞ/@GyTRF(h?sĜkF(FUxަ(^@?*R(p%z #ҩ(Ֆ5L[S܇%Dj }g0]šhCO}a62?i6[z{ŲY_R1kFo/]d[qbƁuFm݈$ECY*t< hc-c}MGIg,8/cgt{RĦ:T&a)ڭcT'/~mrǿzɀ(C\w0fYQgeC6p&>HQܓcSITJȵZt/^WK:~H ?H*_t%WMV4R[0$+#NS(-^XMM׏ށc׾8#XS@3cFW qŚH'XҢ@)4O-ڤ5Tzk7*cyM=L֕W(''zE0tf)/,((.KٓóگNNN)nF$ЂiF)|vͅۀK@A|cj;vTs<^XUyH +9-66f]g0߽9X^>H|\I}L8IB39TbZN8פZMr> Hl?] Y LW#:j 4=ǭjRa-iR`"\>q6`c#\9o>ΈY̵g Fsakhv56|3׬*"MPT6 M'Agd$dڃ``Nh%q5EaVS+dG|,jƢ aboJc,BgkL҈Ԃ`I:BL%=A|U'zQt `IŊ圻 IK%(cX~ثs:6[eťA }i/,5Җ.6`ZPE_u w)+OIJ6EMUj$8 >G=T<o k\^۸`\E@(z`d;`!#*0=">Zbnºx~R@-얜_zwN $dAĂ:Q'0"H %Z*ƌD/R|Iðr]}$0oCfP*?oeH#B |sV b{Go:y4$4_s;(ess3u~{u܂ =ǏW:!ahoI ӋF&\܏㋄l6 Gdj#LUO; 6ejK;#9$O??#hz8ڿ0I !%}Ũsf{`vUVuCq!X !H%(-qg&0㣉OÓ,0iR )Xvo%r`⿷ǭ_g #Ѯz?~_zLm%b mlS Tdt9<{2҂Q`ណJNj,VNjӺ:3=枲_\k`@#H7q:U댚y?21|{yJ =8-9.}s}f)tw PƽDž#gS]c&oDsw1˃;ztCA22/t,]Ngˠ0o3䰴܉t~=8![`)\A/tt-lṮPOQ15i5rR[< U#=Su NS\a%g`bN8.ػi!; 1k_uБ z%_YbB7?IG"Wi޺ i4dkM M^?_B7XRp5Qi{kޤ[p1s+oT]Xdw B ^~pUavUX<쓁/0DPn; xHS-`FAK&,ǍদQwp+ c@va{,.#u}C0Āpt|`Dm̉ }_[A~1?F|QGrFQxW\WKޤ&Oqo!?$5X9aiI*nœ\?[C`3iƜ#&{'oC>e @!$-3UDUZxad`3٘8 /rTcѸM\t,LZ 6_`rvmPPDOް3|H J:*?s_?2%d`*B,*L '?#GF]Uk,QDX+zGXXD@2†fF`숰ږ'֊n2L!$ GjL : q k6+'ZӅ[|O3GjEuTQ$h[!{RP}c0ױeQxh֘3XcѺ&Il@4e]*RAeAJ.NHX 0/{d[KC/okoSH<>LԄYytjJ.Y^y 6֊WKb%nD#[US#`^[Z0<;Rl AHM`roMH2Hn!6/=` ڜ^R j,T:Z7ȥJ%n>hTKdO޹ ۩ַtOL8K^m:4@v`WީCx.P;Tl۵=Kp9}!à)E9?UtD QPšGOY] b<5f[Oi((BWd$0An#I2Juʽ&}y^e4sz5Ir(+UJJTD0&f9:WҩDLB.c:Sc·oZDSes?V=M%}1BTl*- c1&ЕD\3$j%hU #n*x%;móOPfOrlU\d҈0ț(~Pѷj.EneQ j/)qo\MCoz3:g{#kxqfiM 'gvp֫pk^ }+y G{?8UKzBǷb|cu.K͎~? 6I&|Vvtܨ| =Àw1d ,WWiB3sZCw z1a|?9G;mHa|~?ekr^f6_TmƚijYVyU888K,SQ9t@??> ?|ڐG&HaPIml98qV-/ s3F[(d VM&-#~4ؾ[땷0tl(kK /#"׃Λ]ψM2OŁ_}@Wqe *J) &"8?|Wakv} sRl% 櫟P*6miTk4aݸ˸Y rhJ-N#. |:Ie_fT>182cJJf,խׂJT[roH2*3܈ GQJ_񣋰']]Anָ`޹'ș7+:oE`|̘l}ys5ULRZ`pI1mUMajR>baMϊJFu<_Ya0cWuMyۛuӲۜMxУލ:>?zO@d BZ)]!/Kv92糖f/1QH1CE6E4(aO#ӥRULbZUoEb\V7^n#"e>1o{Io_ U nHNm9# Or~?1>΢;螂fJVEZuV܉4I GTDjY텪Va,lfB4dF0kr5q  ^rٳF}u"@TͦvC**YC·Z,i}_CENEe?&]w{]`-6ċm3!w P }o [Y}lUǶF%2t'&lɤtwh- < ӜeVOYLuJ;\6X#$Y%V|-agc14PSgh 5͸flFm#UIw)6}Do8RQBPNPPVVTr:Tbk&upZCb$$6QMsj8moPBQֶ1?&> &&`-q5Θgо0FSp4!+PkǭPb+Q';Z$av:ǠJY^}Q=خ%j8-wQrRF?"r#;n|W?;4|ċ4yh1^~k+V🾡`h~r)soҗ.P|'* 26`L/Yb!y ԗAPEMx##4F9,5PnV[Zv2: CԉOǃ(@zNxq@.-'z Y7?/X]zm4H`ge).B{mAڲ>uZFz<)/?m'Л7isHN7u%Q9:VhLW =J0Qٟ?KA1՜^ĮJIu JLigPLM,?Lc8f.˸FY^f(>i$N8`?⛡GlԲq>zG{Uoz5P*Q1kmHh*[ omlh5>!G&ƾEIoƢl&Zeð̮@‚s%h?_1G[/ /z)I1*W؉;I`B={ktZ1"3˺ AI{e{av'ːЋb6TR[p'-;}#gu:/ZF-TL h7QEd˦%!Lľ9.Nw]Sе-iKҩjeBguxf/+RTa?Ӝ )ըKՇcm۟??߃ƧӠ 9BMʆhm/moM:7G[?oϜVۈ{V,!'txPwdTA O0Ȝߝ`]IзpX^/~s|,nIJz0U7;f6<;.Y|:vO7&Kz-)ti.,m0X|2%U^&t^˙/!HZ6?EC6T@eP(MV[1JV ޠ8mfO1hμNk_uwQǥ3憒~r^P;z3wƛBosra=,yN{*5m )m'O6ݘHxmr;eQiMCڧ%VQkagt)ظz`f@m?JAJ[gZE9,AӕeiEY`i&~rj0~f_hyɥsCI7B8W`dQ,ʓB1M2ƣi̶rxmjk–,ϴ /@hrdl^})fo:qj)YiZyO #᳁v@<ɦS=`SXuެͼqOLRH*M"EԌ5MwgM!("wVGzqT}UbWg]OCB78e- 9]1)97:ܬLt@Q%5L/GjG8. <鈁/`.S!<$=sǃ<TFg t An Q: Lpy lT 2 AYST&,mzD1PQQ"̤ ۊl0nV0}H=7ge/UԣΜ 且* ߘ׳Ύ\vLʔ$<\X9,/Xo}ʉ!tRe'cm?Smnoh2=C U'Y$0}0LnA#=iĪy Z!Fib/qPqߢM[29?YuN6ɿ4ޢM[va-:y5I_7&̯?&mHlmˆM6tWTsaʹ#yvi 5'i=1'omnWwu#iSk"nE|lކC|qgQL"ڹ:A-Хa3MHdkUH5ɡ^qv3Z6\.qvL~ )'A*RY^+lLB-~WOY>I*؂C̄}MeBvacG sŭK؋YYn!n"H?iQ_q;/btwq*f5Cs i7XY_ ANC>MYtF!lV!D{[2Fy^G$$~D43&iǽw<*MS!r9OwT?Gwt=h7^;lQf45cq=<.3/Fӯ /һFU_..e.2KuP標DlBW?ǟ )  p=GZ x7i!|HfZcu~ k_*DdCk]&Rm*ke_==Q#Y7 @ڟ9_vSCS/y>s+)^ C1beJ2Y ɗld[ ޕ6Xەր?[$_!7-:G}L Uy@k@#\`aIBr 9[3vTf?gQEkUAwauv sjy;+ig}SIU>a |u+tp.@|tJp^0AmQos UdRSV ,Tu9MLCT x$-(U0ZU}P^s |,0j]6:6fLQ[ A3.Д&(ꆥJ8 xJG#*ejIN[.QX'4\ =撰dTr(ȒͿq^9 {1%l5 Ǘ!6#5*!xx#AcбF8ނ7ˎOܙNReEzSxgڜ80ԱgcxUoSWUq}d` 7b}6G6m5=6?,~ׅ;p ī#Lm7vZcaG+FǑ~24{|8- Vi3׏w ae,TX|@gS|8Q5!UmOҁhaTb"‡uwobV^憣fUBF1|ZIU80U:ff\oiRifӋJǀ bw@/!ױ UuXe:3'sPJŽ.KA( a$bWGCnlOpMàW$iU J:z AhAjI8* xwVXZWVyku:凗k8^  C1E-SGvԌ>5ƶ=i[PmS9ڂV)ع6_g sF;nGĤ!g wMRZRtFHtfُ̜TN!D@b H AL4~`EVGA}ܛLKj~09xyƭ3OZ<,bT[=xL456N kRf#Ynt}0a#RJ:Mq =zDt2|q*f[6WaJo3|cv[w+$̿y1z݃4Xe0ݽ=ߴ.Q` ߺŜDz7Ovz'pvE>†t;(g~RD4 Ul7PFvk]`dR9|]HǏ7ZiBxi=5%"Xbk0hIU`[~(CT39H2n{-XT:LMaa9,9SlcA ~=uO{[,b%*Mx.=[+;PZzi/M--SAwΌ3IpvcUsrvCxy0 #Q LkIpV=Uy#Gi%-T`c,{?zǛ7Ko."ևjl҈LRқߧR8 5WWV y.ӷ3]BFx >"/9f҂ZaJ7] c4$ZB(vq=?Nc|r5~,rzbu).-x]M9 76oW^Y J:Ƹߦnq/^t&^ fL#^Fi(H,?Xui)Mcfn8.Zʜ [GG[c+-"lIku_kNbEm4M ޘZɸ7`"_1/r(gkkm&3[Ua̵s~%HmSR,joEtp0o)غhIˁ$lTlcBU娞#ZPoA" WW0rç3J+A|RgG;yҤOPq։ʣbh!״k@6}:0 w *ϲ,7 ebE 9Qے{y)r[{CYs؈C-I#9!YnDr4d\3ba[OS Zܱ. R}*cD#uV`tlfC= ]tNƧرv2u|X 9K,ѩZ^<*O]"qMprP)U]\2d OL6pƭ \KwIо˷+'+7 fmQj7ߛ]Y?)Ϸܦۤ!9CR~mOu󆾜L;I1ġ;]q!4P:ceC1؇`@bJ~3G˙aK,N:͆l`eg[<:j8bڼBTMҦ>}䧏4Z i| P x(kYO̰8\L 'F%ʁ ">k F1=}LU`N{Y.ZeLB1*6Je2Ŋo7 3BSY;9X.yI҈B2ͼt. W wЍOr.|;o qg`]f/pC93ZO<TKN_R@;ZY%y~*%w(G7;{>uCzxh?RI"fSe+;^Z9Qk\xGAA&-τYOUޘJ xĻ- ^-02ǥL;9 BAh_[!U/vu> f ;zmf7 Qt|ǃq"-ZXMW{Q4h`)ތڰ/8yĤä.]3(pv{ ar4B8i'1֋y'*&WnM;ADOZeL 0n/'97c6Λe*t3&[ӵ't'Tg_dn4c]H#FDSIBR8`@h^PE#6 D͐f{^$rfU"cE2K)1M|w^0tK,/{/p`zOG"l+1Ms>lb tٌGL& ?x:H2KHmuEʀPƋcD!5pzEyʍNC(;J~Py9u$Df;i\L:'`.9pdCeL{Xn"𝙎NH4Ƽwf9 8K/ =2'q/)HǞ#!@GdXOpSD֔&csqwHz5 l>3|!:FAIo2a> jk {Ope n+4֏?.[>Ēr5꣮}^g8 5Z;S&Vt6#(SdSPR:/3I 0~Sl^aψdI_<JN̞̄3L1kD3^&d|P;qQ^s)!tBC`f#%ҼR2~󔩶,^4gp.f(_!@`B ,'1a2dKa3~ r[icnrܕ+'شAbrgGcl`H9g:@vroDI :oOXaO?gzTcSfvo?Mmu9 1+D5G8fK`52,fZ0'Z9 whuj b @ g_kgIϫiw:Qಕc3qWqgb^{ŖS ϘӮ)٢+󣔒Zoɹ[x0avf,7yb(q mx(FǨexP.wU c<M1M- BU#Z:UAew 8+SX7'UhPp'c< 25T!-k=u[wd{㮋w)7ĭcxFNRRB0%\DYh7mF4谅㸶UO 3taPv:C]D]` :b;Zs~PgGYkXʩ2$:?ovn&9r h!޼ހIQoGTb0׹ ede')Uzc2[ w6]K8 NݺRSho\3CQy>,23T(MxO]G~[ϵǏ=^fG+w4؜8ӛ!jXŌҼ(&i3]raI:aۘdiϨLIb+[ K ]Uq$\1ɦqCIVWWEA ż A)? 7j,9~V`V^d: lU:.͍s摰8ݫrGf; Luoڔ@NJ'uv%ؘU(9N;iɘAtjP:wC.{HD=@@B]|u.B ʯ:<;N[.܀Cs M9Cb$H3۩$R &9/3ls#Py}-TX_Ac81ns?~( h1POnq%Vʖ7֫ǩ,ChX'w0^֭m4_WF GbY<\;ѯѿP(ss`[idd]>ajP* u }k>X %.a<|2q[n?zy4)Vo{%Vۧ }?N> 9PR^DFu41-)Qg4p~q"#{giOd%de{PMnʬx؁ݐKĴEc O݀OqB]pM_:Qִ]Dd+ICH|d*Ş?YinmJ43Ga2e2w{$ƣ+E4sC&⳵$sTwkϽW yASUyG1L/@_bQfY=6Gn5, fy֡ƹKyE 3'uEI=ьdA6iaq)GKfI>ej!0,B׻"ٺ̥_$1~)n㌢XƔ2m 1MCc6m( V) Sƍn48ޅ"/z?|40Iå?EJCoWLIqiSlNIt)$*0.RG&kV-)y(-߳ ϳ!\P2$^gCSg4:ExM *L֨RM95'b >)<$W==ihr $Ԧf͂&R,VkOv}iXr| _=0 ʹŐ`mNqҒe@xՕaxsK"4,:L"V["NN3Ȑt BT{JgQi]/ֺqߍ/$sxWuljN*N6@[ne m@IhUo)( `m[埽 / S"iw)pB?z\沒UE 8{ϣx"͗"f$+*ROI^RnC>h/\ЃcVRo@?8l-l2lgIyT}isP_J D_Y^ؗ&Zn<^ Rht_??253Z֕[ Iͣ׾R$o8s"#e`ϩ*U⪷m)HŧIie'"M'> bRY9Abt#=q椔jvT]_WUsiUa T^- Pu'eԼSR?n:X=)}?x|4ଟXg~K)g#~׸Bo2dN-yk5Vv{yn79Ƭh^lCX ;R ;߯pFÕ++deme7Lb\>iwVaQhʥc2'I25i9IOg]QQգW!<6NlIqI+ *|ewT|sCiQ%,lhG~+lQϮ Cޓ̺6=vq7}Ï/Ce9$*`0,&64|(f@v]ȽqoFXM| KxԶd8RBoգY{O?}Q@HY`M'DfpA;.}6DT!@ $V]J~//p~HmX<"nØ3^VͦaFA/#ӲW[amF_>d>/j{렁xsE;?:χWCz͏[;oۇhIã=HR=87^nSj.Gy`&hk1pKzn˩ Gʹ|PGQߪ`r~:%nĵHL{2侻{Ɋ%EG= c~vwoV*Nw~zt9(T{TDz#'|i^Vd}sc`DԔ #٫Q/nvNM Mrl=}}zkJ*. VNiY62IEqIL`v.hH`K )ƒĖ7NS%ؤ}ji4za NѲ2H-#*"!RW4u~u,lSή rӡ6Yp;ln=)Sdm2:i?SKK,j,&ծ5d5vR|o}[[~-swohF7Bǖ[fp<;^R@d>%.---?2G4 7}VMѫQ%+_X\\ _nՉFdHgHH΁~stśJ1CA:B& $؆@l"ݮ`Dyƒw T|SmyQ<>? 0 (EX~9-l\no|>\I$IMAJ\3I̠LfIUjn 4l& .>j/U(?I̷6з)o$xzp`IK'WuIRZ*zӓ6sbT> ¦Z95!*fRY5a[OA O}ܫեI 1,ӷC"_5J/a8Qi&!jJa7'ӫgE tS5# v: ,(5bf/]c23pHuH}0oDM 7y#o ;3M0mbS^tlWqLumW `#FXӪC55naUADcXQ j(%ݍN•7oDbeŪd,*` K &pą!.9[Bl  Ɍ֖圄P ëN~8EH i( \Be+Q _&p6;,f(:O.$t!(w(jqyUŵ<3J*8|hRPʍ+#־-398q$M` lR;_$<`.D~h9k1DDA t*dimFq +BC9kϣ+OB ҽQizg]+ygh0,0.\~\h>A>>L]{1WW'|&Vb{8ЖxR0 t>flLC# C<*{ڦ5mѝK%<AB|?>6A(܅Q\ҙ=VnDfI+Xa1ȾvpTDg$L1^^9wف<Wo:LAxsΆx?pGfXZjQzcZ,L#'X|rl =wAW(C{URGA4 GI(8#XGY%[1E*qx2HEyw#r8ґ?G5$=D7LΡ_Ja-׀.T5>➍Gm &7 v1y&0)U̎VZ}D-G@xIE-:Ok›ƶaNCp3d`b,'tԟա;Z3 EKR kh+=M닥 ~ 7bߔi`U|y`lG"LӎpG6%WK*r;d`qў:qk[ `Y[@Φ!A1 q[ `hxfSb7c27SLJ2pfcW ].v-;aR/1]!4&QZrs.Gt 'y+0VNӯq{f6z {VUj(=&L ZB;G2TAbVyU--"+zҬ`z3\lz9f=WU^bf9@ӢQXh>~gˌpǏ;o|rv8\\u uUapo[]V\gRHGw%,*s͘fbi>*,VTyڋg`Fd`}Ҽ zBã=}z^{uu\~`9F.ޚ̙Lc6yCkM-LjdvK ŰvY<~6gi3~L=Pdjek.]F[Stv]cKFV溟PuoL~x_V3OѣWVV3Ӄ[|58@qSjmwJfi ^s6p\K􎪬I-$c>pw * "U FNx~Ĝ@pJcP޺@֚878!Ga]*6Ld.:Oϸj#5.a걢@Nا4tEM֭VE;t}pM[ѫQmdNΜ̧2Nqw$tg'Z6!--|KЯZF8([3.)ULZfVÇ+ˏig,#_h87;D`5LpܣִӀLsw8}d{3?MMS)W<)WC:lg j缭qZϥiV-fUۈӪwL,ka!`fZpx~>PiE!@:z H> WWK%AZ، BR3ib|TtRX2<4#KP OYB2E!?S},/zvxp-w7t-TjEB`bTboayoZg$1xKh>+r\[]dۑfЂy/ sƒ[BXxЬ# POPɼV/x$?b$  I_a~H޷+ۏ/6Ҧ])S }wzXQ{>[;;՝pFo!韝*~gj/# <602_B=ҥH!x}ֵ}Bu]%*bAzh%}e$rie^J/_ \ VҎS$LyAl0cDl _s$Qq;rS'bbgy^q;6ΐǪ7f'ȉzwDM* )& M=e۟H[h}8]0̖j_K'-OJxcr8mU&j`M㭽cܺ;R'̝8^s}|T-eԆћ:xLĈ| _ws}>ws}>ws}>ws}>w0asused-3.72/MANIFEST.SKIP0100644000072700117040000000000507267527350014241 0ustar timursoftiesCVS/ asused-3.72/asused.pod0100644000072700117040000001337707740562264014352 0ustar timursofties=head1 NAME B - summaries address space used and according to the RIPE DB and REG. =head1 SYNOPSIS B [B<--all>] [B<--aw> | B<--approval>] [B<--overlap>] [B<--status> | B<--assign>[B<--pipa>] ] I B [B<--all>] [B<--aw> | [B<--approval>] [B<--overlap>] [B<--status> | B<--assign> [B<--pipa>] ] [B<--regid> I] (I ...) B [--B<>] I | prefix =head1 DESCRIPTION B is a tool to summaries address space is registered in the RIPE database. For each allocated inetnum object a summary of used and free address space is printed. A grant total summary for all prefixes is also provided. If there are no errors in locating allocations and and assignments under an allocation. In in the total % are calculated on total allocations. where: I is name of registry as in registry database. I is allocation as in whois database. e.g. a.b.c/16 . Prefix is queried whois DB to find all Less specific matches inetnum with I as netname is interpreted as allocation and summerize the allocation. =head1 OPTIONS =over 4 =item B<--assign> print all assignments under allocations, size, date and net name . Summary of assignments. And free address space. Summary of status attribute. =item B<--all> this same as three options B<--overlap> B<--status> B<--aw>. =item B<--approval> Check the all networks in allocations are valid or not. Print valid and invalid networks. B<--aw> only print invalid networks. =item B<--aw> Check the all networks in allocations are valid or not. Print only Invalid networks. B<--approval> will print valid and invalid. =item B<--contacts> print admin-c/tech-c for all inetnums =item B<--help> Shows the usage of B. =item B<--overlap> print the details of overlapping assignments. Summary of overlap per assignment is printed at the end. =item B<--reg> I. regid to locate the allocation. Netname of allocation is same as regid, translating the first '.' to '-' IN upper case. If not specified uses i2r to get regid. =item B<--status> show assignments under allocations with wrong status attribute other than ASSIGNED PA or PI. B for missing status. size and net name. Summary of assignments. No of Assignment(s) , No Assignments with status ASSIGNED PA or ASSIGNED PI, No Assignments with status B,No Assignments, No Assignments with Missing status attribute,No Assignments with other values status attribute, none of other . Warnings on assignments. =head1 OTHER OPTIONS =over 4 =item B =over 8 =item B<--port> I query another whois server on the I. Default is 43. =item B<--host> I query another whois server. Default is whois.ripe.net. Can query only to RIPE whois server. Server version tested '2.1' =item B<--na> I show event table for approval of I. Used with B<--aw> or B<--approval> =item B<-pipa> additional flag to the B<--assign> option to print allocation status in output. PA is for ALLOCATED PA, PI - ALLOCATED PI, UN for UNSPECIFED, B<--> is for missed B field. =item B<--version> print version of asused. =head1 DIAGNOSTICS =over 4 =item B Could not locate any allocations in use from registry. =item B No inetnum object was recognized as allocation in the RIPE Database. =item B< % No entries found for the selected source(s).> No assignment(s) found under the allocation. May be a new allocation or allocation which has no objects in RIPE DB. Not sure to treat as 100 % free. =item B RIPE DB B attribute has mismatch with I or regid. =item B May be incorrect status attribute in the RIPE DB, Valid status ALLOCATED (PA|PI|UNSPECIFIED) =item BInvalid attribute in RIPE DB expecting RIPE-NCC-MNT|RIPE-NCC-HM-MNT|RIPE-NCC-HM-PI-MNT =item B> Encountered two inetnum objects with same logical start and end. Logical interpretation of inetnum a.b.c.0 => a.b.c.0 - a.b.c.255; a.b.c.0 - a.b.d.0 => a.b.c.0 - a.b.d.255 =item B Intrepreted as class full object. Check if no of address are counted correctly. =item B When tried to locate an allocation inetnum object for I I from RIPE DB with option -L -F -T I returned multiple objects. Every prefix can have only one allocation object. =item B If the assignment is outside the boundaries of allocation. It was returned by -M query RIPE whois server. =item B Logical interpretation of inetnum fails. Probably can not identify start, end of end < start. =item B one of the dates of inetnum in the changed attribute is invalid. =head1 REQUIRES Perl 5.00404 or later. Connection to RIPE whois server V 2.1, Perl Modules Socket Getopt::Long, regread, ipv4pack =head1 BUGS Could give incorrect summary if logical interpretation of Inetnum is not exact a.b.c.0 - a.b.c.0 is intended to be an assignment of size 1 IP No. B Noticed that when the no of assignments are very large, like 5000+ per allocation default data segment size of BSDI 3.1 is not enough. Increasing to 64 M Bytes may help. in bash shell B eg. de.schlund B If the allocations are outside 192,193,194,195,212 /8 and LIR allocation is same inetnum as in /ncc/ip-reg/delegations asused2 will return I. eg. de.callisto =head1 SEE ALSO L L L L L L L =head1 AUTHOR Antony Antony . RIPE NCC software group. =cut asused-3.72/test.pl0100644000072700117040000000121107152714654013655 0ustar timursofties# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..1\n"; } END {print "not ok 1\n" unless $loaded;} `asused`; $loaded = 1; print "ok 1\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): asused-3.72/Makefile.PL0100644000072700117040000000320207740560160014307 0ustar timursoftiesuse Config; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. # RIPE NCC common configuration my %PARAM = ( 'INSTALLDIRS' => 'vendor', 'INSTALLSCRIPT' => '$(INSTALLVENDORBIN)', # Hack for Perl prior 5.8.1 'dist' => { 'COMPRESS' => 'gzip', 'SUFFIX' => '.gz', 'CI' => 'cvs ci', 'RCS_LABEL' => 'cvs tag -c -F $(NAME_SYM)-$(VERSION_SYM)', }, ); if($] >= 5.005) { $PARAM{AUTHOR} = 'Timur Bakeyev '; } my $script_name = 'asused3'; my $private = (-f '/ncc/registries/zz.example') ? 1 : 0; unless($private) { $script_name = 'asused'; $PARAM{INSTALLDIRS} = 'site'; $PARAM{INSTALLSCRIPT} = '$(INSTALLSITEBIN)'; } WriteMakefile( 'NAME' => 'asused', 'PREREQ_PM' => { 'IO::Socket' => '1.20', # We would like to have quiet modern IO::Socket }, 'VERSION_FROM'=> 'asused.PL', # finds $VERSION 'EXE_FILES' => [ $script_name ], 'PL_FILES' => { 'asused.PL' => $script_name }, 'clean' => { 'FILES' => $script_name }, %PARAM ); # Ugly hack to deal with Perl prior 5.00503 sub MY::processPL { my($self) = shift; return "" unless $self->{PL_FILES}; my(@m, $plfile); foreach $plfile (sort keys %{$self->{PL_FILES}}) { my $list = ref($self->{PL_FILES}->{$plfile}) ? $self->{PL_FILES}->{$plfile} : [$self->{PL_FILES}->{$plfile}]; my $target; foreach $target (@$list) { push @m, " all :: $target $self->{NOECHO}\$(NOOP) $target :: $plfile \$(PERL) -I\$(INST_ARCHLIB) -I\$(INST_LIB) -I\$(PERL_ARCHLIB) -I\$(PERL_LIB) $plfile $target "; } } join "", @m; } asused-3.72/README0100644000072700117040000000632007740562145013226 0ustar timursoftiesREADME for the Public Version of asused 3.72 -------------------------------------------- Asused was written by the RIPE NCC: Email: nccs@ripe.net Web: http://www.ripe.net Asused is a tool used by RIPE NCC hostmasters for checking various aspects of our members' IP allocations and assignments as stored in the RIPE database. We make it available to our members so they can also check their own data. Our internal tool uses some more modules to perform more checks which use information that is private to our members, so the public distribution does not contain or require these modules. Instructions for Installing asused ---------------------------------- The installation procedure for asused is standard for modern Perl programs and contains 3 steps: 1. Create the Makefile. You need to cd to the top level distribution directory and enter: perl Makefile.PL where 'perl' is the name of your Perl5 interpretator. That command will create a file named 'Makefile' in the current directory. 2. Compile the distribution. This step is also trivial, all you need is to enter: make This will verify all included packages and prepare them for further usage. When it has finished, you are ready to use asused from the directory with the distribution, just don't forget to provide a file with the relevant registry information (see 'Registry Information File' below). If you would like to use this program system-wide you can install it in the next step: 3. Install the program and supporting modules. To install asused executable and all supporting modules, become a superuser in your system and enter: make install That will copy all supporting modules to the directory where Perl5 keeps it's modules. asused will be installed to the common location of the executables ( usually, /usr/local/bin ). 4. Maybe, you would like to update your IO::Socket and friends if make process will complain that your version is outdated. In this case unpack it from the extra/ directory and inside use the same sequence of: perl Makefile.PL make make install Optionally you can run 'make test' as well. Registry Information File ------------------------- To use asused, you need to fill a config file with your registry information. You can put it into the asused.conf file in the current working directory, or into .asusedrc in your home directory. Alternatively, you can specify an arbitary file location on the asused command line with the --config switch. The config file should contain: REGID = your registry ID, as it was assigned by RIPE NCC ALLOC = a set of strings, each of them should have one allocation string in a prefixed notation. There is a file called asused.conf in this distribution containing example data. OS dependencies --------------- We have tested asused on Slackware Linux, BSD/OS 3.1 and BSD/OS 4.1 but it should work on any modern UNIX-like operating system. Run-time help ------------- The command line options can be obtained by running: asused --help Feedback -------- Please send bug-reports and any other feedback to: RIPE NCC software group, sw-bugs@ripe.net