#!/usr/local/bin/perl # Autogenerated block to include site configuration # generated on Tue Mar 21 19:42:47 PST 2000 BEGIN { %::RIPEConfig = ( VERSION => q#3.0.0b2#, LIBDIR => q#/home/david/db/src//lib#, DEFCONFIG => q#/home/david/db/src//etc/ripedb.config#, WHOISHOST => q#whois.6bone.net#, ); # Add library path unless running from source directory use FindBin; if ($FindBin::Bin =~ m#/src$#) { unshift @INC, $FindBin::Bin; $::RIPEConfig{DEFCONFIG}=$FindBin::Bin."/../etc/ripedb.config"; } else { unshift @INC, $::RIPEConfig{LIBDIR}; } # Select DBM package other then the default one use Fcntl; use DB_File; $DBMPACKAGE="DB_File"; } # End of autogenerated block #line 1 #line 0 rpsl2ripe.pl # $Id: rpsl2ripe.pl,v 1.1.1.1 1997/10/27 20:13:45 eddy Exp $ # # # Author(s): David Kessens # # modified and simplified logmessage routine sub logmessage { shift(@_); print STDERR @_, "\n"; } # # hardcoded from config file local($AUTOBOX)='david@Qwest.net'; local($MAXATTRIBUTELENGTH)=12; local(%OBJATSQ)=('cm', 'cm de au tc ac rm ny mb ch so', 'mt', 'mt de ac tc dt mn at rm ny mb ch so', 'ro', 'ro ad ph fx em tb ac tc nh rm rl ny mb ch so', 'dn', 'dn de rf ac tc zc ns sd di rm ny mb ml ch so', 'as', 'as de ms mr rm tc ac ny mb ch so', 'rs', 'rs de ms mr rm tc ac ny mb ch so', 'li', 'li de tx ac ah rm ny mb ch so', 'rt', 'rt de or wd mo ij co ab ag ec ho rm cn ct ny mb ch so av cl', 'in', 'in na de cy ac tc rz st rm ny mb ml ch so', 'dc', 'dc de ac td rp pl rm ny mb ch so', 'ir', 'ir az la if pe ac tc rm ny mb ch so', 'is', 'is or de lo cy pf ap tl cc rm rl ny mb ch so', 'pn', 'pn ad ph fx em nh rm rl ny mb ch so', 'am', 'am de al ny tc ac rm ny mb ch so', 'i6', 'i6 na de cy ac tc rz rm ny mb ml ch so', 'an', 'an aa de mo ip ep df ac tc rm cn ct ny mb ch so av ae ai ao it io'); local(%ATTR)=('rp-attribute', 'rp', 'mnt-lower', 'ml', 'change', 'ch', 'ipv6-site', 'is', 'local-as', 'la', 'prefix', 'pf', 'typedef', 'td', 'export-comps', 'ec', 'descr', 'de', 'author', 'ah', 'refer', 'rf', 'application', 'ap', 'e-mail', 'em', 'warning', 'uw', 'inet6num', 'i6', 'rf', 'rf', 'location', 'lo', 'ri', 'ri', 'zc', 'zc', 'rl', 'rl', 'rm', 'rm', 'ro', 'ro', 'rp', 'rp', 'cross-nfy', 'cn', 'rs', 'rs', 'default', 'df', 'rt', 'rt', 'cc', 'cc', 'origin', 'or', 'rx', 'rx', 'changed', 'ch', 'ch', 'ch', 'rz', 'rz', 'zone-c', 'zc', 'cl', 'cl', 'cm', 'cm', 'cn', 'cn', 'co', 'co', 'as-macro', 'am', 'aggr-mtd', 'ag', 'comm-list', 'cl', 'dictionary', 'dc', 'ct', 'ct', 'sd', 'sd', 'member-of', 'mo', 'cy', 'cy', 'localas', 'la', 'so', 'so', 'components', 'co', 'st', 'st', 'dc', 'dc', 'authority', 'au', 'de', 'de', 'network', 'in', 'df', 'df', 'la', 'la', 'aggr-bndry', 'ab', 'di', 'di', 'auth-num', 'an', 'dn', 'dn', 'mntner', 'mt', 'rev-srv', 'rz', 'remarks', 'rm', 'li', 'li', 'tb', 'tb', 'tc', 'tc', 'dt', 'dt', 'td', 'td', 'notify', 'ny', 'holes', 'ho', 'lo', 'lo', 'tl', 'tl', 'community', 'cm', 'ec', 'ec', 'mnt-nfy', 'mn', 'rs-in', 'ri', 'alias', 'az', 'rs-out', 'rx', 'tx', 'tx', 'mb', 'mb', 'em', 'em', 'ep', 'ep', 'mnt-by', 'mb', 'person', 'pn', 'deleted', 'ud', 'netnum', 'in', 'ml', 'ml', 'ud', 'ud', 'ue', 'ue', 'mn', 'mn', 'mo', 'mo', 'inject', 'ij', 'ex', 'ep', 'mr', 'mr', 'ms', 'ms', 'mt', 'mt', 'uo', 'uo', 'status', 'st', 'text', 'tx', 'address', 'ad', 'fax-no', 'fx', 'members', 'ms', 'uw', 'uw', 'peer', 'pe', 'route', 'rt', 'na', 'na', 'limerick', 'li', 'protocol', 'pl', 'dom-net', 'di', 'inet-rtr', 'ir', 'nh', 'nh', 'withdrawn', 'wd', 'interas-in', 'it', 'phone', 'ph', 'trouble', 'tb', 'fx', 'fx', 'nic-hdl', 'nh', 'override', 'uo', 'inetnum', 'in', 'ns', 'ns', 'remark', 'rm', 'aut-num', 'an', 'ny', 'ny', 'netname', 'na', 'gd', 'ny', 'guardian', 'ny', 'contact', 'cc', 'as-set', 'as', 'advisory', 'av', 'source', 'so', 'role', 'ro', 'delete', 'ud', 'country', 'cy', 'asname', 'aa', 'domain', 'dn', 'upd-to', 'dt', 'as-out', 'ao', 'interas-out', 'io', 'import', 'ip', 'wd', 'wd', 'i6', 'i6', 'or', 'or', 'export', 'ep', 'nserver', 'ns', 'mbrs-by-ref', 'mr', 'route-set', 'rs', 'email', 'em', 'error', 'ue', 'auth', 'at', 'url', 'rl', 'pe', 'pe', 'rev-svr', 'rz', 'pf', 'pf', 'ho', 'ho', 'sub-dom', 'sd', 'ph', 'ph', 'as-in', 'ai', 'admin-c', 'ac', 'pl', 'pl', 'pn', 'pn', '*error*', 'ue', 'fax', 'fx', 'as-name', 'aa', 'aa', 'aa', 'ab', 'ab', 'ac', 'ac', 'ad', 'ad', 'ae', 'ae', 'cross-mnt', 'ct', 'ag', 'ag', 'hole', 'ho', 'ah', 'ah', 'ifaddr', 'if', 'ai', 'ai', 'as-exclude', 'ae', 'al', 'al', 'am', 'am', 'if', 'if', 'an', 'an', 'ao', 'ao', 'ap', 'ap', 'ij', 'ij', 'as', 'as', 'tech-c', 'tc', 'at', 'at', 'au', 'au', 'tunnel', 'tl', 'im', 'ip', 'in', 'in', 'av', 'av', 'io', 'io', 'ip', 'ip', 'ir', 'ir', 'az', 'az', 'is', 'is', 'it', 'it', 'as-list', 'al'); local(%ATTL)=('rp-attribute', 'rp-attribute', 'mnt-lower', 'mnt-lower', 'ipv6-site', 'ipv6-site', 'local-as', 'local-as', 'prefix', 'prefix', 'typedef', 'typedef', 'export-comps', 'export-comps', 'descr', 'descr', 'author', 'author', 'refer', 'refer', 'application', 'application', 'e-mail', 'e-mail', 'inet6num', 'inet6num', 'rf', 'refer', 'location', 'location', 'ri', 'rs-in', 'zc', 'zone-c', 'rl', 'url', 'rm', 'remarks', 'ro', 'role', 'rp', 'rp-attribute', 'cross-nfy', 'cross-nfy', 'rs', 'route-set', 'default', 'default', 'rt', 'route', 'cc', 'contact', 'origin', 'origin', 'rx', 'rs-out', 'changed', 'changed', 'ch', 'changed', 'zone-c', 'zone-c', 'rz', 'rev-srv', 'cl', 'comm-list', 'cm', 'community', 'cn', 'cross-nfy', 'co', 'components', 'as-macro', 'as-macro', 'aggr-mtd', 'aggr-mtd', 'comm-list', 'comm-list', 'dictionary', 'dictionary', 'WARNING', 'WARNING', 'ct', 'cross-mnt', 'sd', 'sub-dom', 'member-of', 'member-of', 'cy', 'country', '*ERROR*', '*ERROR*', 'so', 'source', 'components', 'components', 'st', 'status', 'dc', 'dictionary', 'authority', 'authority', 'de', 'descr', 'df', 'default', 'la', 'local-as', 'aggr-bndry', 'aggr-bndry', 'di', 'dom-net', 'dn', 'domain', 'mntner', 'mntner', 'rev-srv', 'rev-srv', 'remarks', 'remarks', 'li', 'limerick', 'tb', 'trouble', 'tc', 'tech-c', 'td', 'typedef', 'dt', 'upd-to', 'notify', 'notify', 'lo', 'location', 'holes', 'holes', 'tl', 'tunnel', 'community', 'community', 'ec', 'export-comps', 'mnt-nfy', 'mnt-nfy', 'rs-in', 'rs-in', 'alias', 'alias', 'rs-out', 'rs-out', 'tx', 'text', 'mb', 'mnt-by', 'em', 'e-mail', 'ep', 'export', 'mnt-by', 'mnt-by', 'person', 'person', 'ml', 'mnt-lower', 'ud', 'delete', 'ue', '*ERROR*', 'mn', 'mnt-nfy', 'mo', 'member-of', 'inject', 'inject', 'mr', 'mbrs-by-ref', 'ms', 'members', 'mt', 'mntner', 'uo', 'override', 'status', 'status', 'text', 'text', 'address', 'address', 'fax-no', 'fax-no', 'members', 'members', 'uw', 'WARNING', 'peer', 'peer', 'route', 'route', 'na', 'netname', 'limerick', 'limerick', 'protocol', 'protocol', 'dom-net', 'dom-net', 'inet-rtr', 'inet-rtr', 'nh', 'nic-hdl', 'withdrawn', 'withdrawn', 'interas-in', 'interas-in', 'phone', 'phone', 'trouble', 'trouble', 'fx', 'fax-no', 'nic-hdl', 'nic-hdl', 'override', 'override', 'inetnum', 'inetnum', 'ns', 'nserver', 'aut-num', 'aut-num', 'ny', 'notify', 'netname', 'netname', 'contact', 'contact', 'as-set', 'as-set', 'source', 'source', 'advisory', 'advisory', 'role', 'role', 'delete', 'delete', 'country', 'country', 'domain', 'domain', 'as-out', 'as-out', 'upd-to', 'upd-to', 'interas-out', 'interas-out', 'import', 'import', 'wd', 'withdrawn', 'i6', 'inet6num', 'or', 'origin', 'export', 'export', 'nserver', 'nserver', 'mbrs-by-ref', 'mbrs-by-ref', 'route-set', 'route-set', 'auth', 'auth', 'url', 'url', 'pe', 'peer', 'pf', 'prefix', 'ho', 'holes', 'sub-dom', 'sub-dom', 'ph', 'phone', 'as-in', 'as-in', 'admin-c', 'admin-c', 'pl', 'protocol', 'pn', 'person', 'as-name', 'as-name', 'aa', 'as-name', 'ab', 'aggr-bndry', 'ac', 'admin-c', 'ad', 'address', 'ae', 'as-exclude', 'cross-mnt', 'cross-mnt', 'ag', 'aggr-mtd', 'ah', 'author', 'ifaddr', 'ifaddr', 'ai', 'as-in', 'as-exclude', 'as-exclude', 'al', 'as-list', 'am', 'as-macro', 'if', 'ifaddr', 'an', 'aut-num', 'ao', 'as-out', 'ap', 'application', 'ij', 'inject', 'as', 'as-set', 'tech-c', 'tech-c', 'at', 'auth', 'au', 'authority', 'tunnel', 'tunnel', 'in', 'inetnum', 'av', 'advisory', 'io', 'interas-out', 'ip', 'import', 'ir', 'inet-rtr', 'az', 'alias', 'is', 'ipv6-site', 'it', 'interas-in', 'as-list', 'as-list'); # # The file 'defines.pl' is included here # #line 0 defines.pl # $RCSfile: defines.pl,v $ # $Revision: 1.1.1.1 $ # $Author: eddy $ # $Date: 1997/10/27 20:13:48 $ # Original code is written by various authors # Copyright (c) 1993, 1994, 1995, 1996, 1997 The TERENA Association # Copyright (c) 1998 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. # Copyright (c) 1997,1998 by the University of Southern California # All rights reserved. # # Permission to use, copy, modify, and distribute this software and its # documentation in source and binary forms for lawful non-commercial # purposes and without fee is hereby granted, provided that the above # copyright notice appear in all copies and that both the copyright # notice and this permission notice appear in supporting documentation, # and that any documentation, advertising materials, and other materials # related to such distribution and use acknowledge that the software was # developed by the University of Southern California, Information # Sciences Institute. The name of the USC may not be used to endorse or # promote products derived from this software without specific prior # written permission. # # THE UNIVERSITY OF SOUTHERN CALIFORNIA DOES NOT MAKE ANY # REPRESENTATIONS ABOUT THE SUITABILITY OF THIS SOFTWARE FOR ANY # PURPOSE. THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, # TITLE, AND NON-INFRINGEMENT. # # IN NO EVENT SHALL USC, OR ANY OTHER CONTRIBUTOR BE LIABLE FOR ANY # SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES, WHETHER IN CONTRACT, TORT, # OR OTHER FORM OF ACTION, ARISING OUT OF OR IN CONNECTION WITH, THE USE # OR PERFORMANCE OF THIS SOFTWARE. # # Author(s): David Kessens #$DEBUG=1; $DEBUG=0; $MAXQUERYLENGTH=1024; $HELPREQUESTED=0; $STOPUPDATING=0; %RPSLCONVERSIONSOURCES=(); %RPSLCONVERSION=(); %NOTIFY=(); %FORWARD=(); %NOTIFYMAILS=(); %NOIPv4ROUTES=(); @NOIPv4NETS=(); %OVERRIDECREATION=(); %OVERRIDEMODIFY=(); %OVERRIDEDELETION=(); %ACLDEFINED=(); %TYPEDEFS=(); %PROTOCOLS=(); %METHODS=(); @DEFLOOK=(); @ALLLOOK=(); $LOADEDDICTIONARY=""; $OK = 1; $NOK = 0; $EOF = 99; $LOCK_SH = 1; $LOCK_EX = 2; $LOCK_NB = 4; $LOCK_UN = 8; # Return codes for when trying to modify the database # with explanatory messages. These are used deep down in the code # just before or during updates, like dbadd.pl and updatecheck.pl. $E_EXIST = 2; $E_NOT_FOUND = 3; $E_MULT_MATCH = 4; $E_MISMATCH = 5; $E_NOOP = 6; $E_OLDER = 7; $E_AUTHFAIL = 9; $E_HIER_AUTHFAIL = 10; $E_GENERAL = 11; $E_NOAUTOUPDATE = 12; $E_NOTNEW = 13; $E_STILLREFERENCED = 14; $E_NOT_ORIGINAL = 15; $E_NO_MNTNERS_FOUND = 16; $E_NO_TL_FOUND = 17; $E_NO_TL_CREATION = 18; $E_HIER_NO_MNTNERS_FOUND = 19; $MESSAGE[$E_EXIST] = "entry already exists"; $MESSAGE[$E_NOT_FOUND] = "entry not found"; $MESSAGE[$E_MULT_MATCH] = "don\'t know which object to update,\nmore matches found in the database"; $MESSAGE[$E_MISMATCH] = "mismatch between update and original"; $MESSAGE[$E_NOOP] = "update results in NOOP"; $MESSAGE[$E_OLDER] = "update is older than original"; $MESSAGE[$E_AUTHFAIL] = "authorization failed, request forwarded to maintainer"; $MESSAGE[$E_HIER_AUTHFAIL] = "hierarchical authorization failed, request forwarded to maintainer\nof object directly above the to be updated object in the hierarchy"; $MESSAGE[$E_GENERAL] = ""; $MESSAGE[$E_NOTNEW] = "object already exists\n-\nthe database accepts only new objects\nand no changes to existing objects\nwhen the keyword \'new\' is used in the\n\'Subject:\' line of your update message.\nMake sure that you remove \'new\' from your\n\'Subject:\' line if this was not the desired behavior.\n"; $MESSAGE[$E_STILLREFERENCED] = "cannot delete object that is still referenced\nby other objects in one of the databases"; $MESSAGE[$E_NOT_ORIGINAL] = "cannot delete original RIPE181 object through special RPSL update path"; $MESSAGE[$E_NO_MNTNERS_FOUND] = "no maintainers found for to be updated object\nfirst send a request to (re)create an appropriate maintainer\nfor the orginal object"; $MESSAGE[$E_NO_TL_FOUND] = "hierarchical authorization failed,\nno object higher in hierarchy found"; $MESSAGE[$E_NO_TL_CREATION] = "hierarchical authorization failed,\ncannot create automatically top level objects\nplease contact <\$HUMAILBOX>"; $MESSAGE[$E_HIER_NO_MNTNERS_FOUND] = "hierarchical authorization failed,\ncould not find a maintainer for higher level object"; # # Return codes for syntax checking the objects # # we could better have used one unified model for return codes # but for the mean time we at least keep some aliases to # avoid even more trouble $O_OK = $OK; $O_ERROR = $NOK; $O_WARNING = 22; $O_INVALIDIP =24; $O_INVALIDPREFIX =25; $O_INVALIDRANGE =26; $O_SYNTAXERROR =27; $O_NOTFOUND=28; $O_COULDNOTOPEN=29; $MESSAGE[$O_OK] = "object OK"; $MESSAGE[$O_ERROR] = "object has errors"; $MESSAGE[$O_WARNING] = "object has warnings"; # # possible actions for an entry $ADDACTION="ADD"; $DELETEACTION="DEL"; $CHANGEACTION="CHANGE"; $SKIPACTION="SKIP"; # # updatecheck, printstat, maintainer, dbadd & dbdel binary options $NEWOPTION=1; $DELETEOPTION=2; $MODIFYOPTION=4; $OVERRIDEOPTION=8; $NOCHECKSOPTION=16; $OKOPTION=32; $NOOPOPTION=64; $FAILEDOPTION=128; $BACKWARDCOMPATIBILITYOPTION=256; $ASSIGNEDNICOPTION=512; $USENORMALMAINTAINERATTR=1024; $RPSLCONVERSIONOPTION=2048; # # donetdbm (binary) options $CLASSLESSOPTION=1; $CLEANOPTION=2; $CONVERT2RPSLOPTION=4; $KEEPRPSLOPTION=8; # # db(cl)open options $DBOPENWRITEOPTION=1; $DBOPENCLASSLESSONLYOPTION=2; # # dbmatch & lookupandprint (binary) options $INTERSECTIONOPTION=1; $ALLLESSSPECIFICOPTION=2; $MORESPECIFICOPTION=4; $ALLMORESPECIFICOPTION=8; $NONRECURSIVEOPTION=16; $FASTOPTION=32; $NOSYNTACTICSUGAR=64; $EXACTMATCHOPTION=128; $EXACTMATCHIPOPTION=256; $NONEXTERNALRECURSIVEOPTION=512; $UNIQUEKEYSEARCHOPTION=1024; $EXPANDOPTION=2048; $SINGLEOPTION=4096; $SILENTOPTION=8192; $CHANGEDATTROPTION=16384; # # The version of the inputformat we default to $UPDATEVERSION=1; # # Supported update versions @UPDATEVERSIONS=($UPDATEVERSION); # # The file extension for the current serial number files $CURRENTEXTENSION=".CURRENTSERIAL"; # # The file extension for the oldest available serial number files $OLDESTEXTENSION=".OLDESTSERIAL"; # # used for fast computations in range2prefix $ONEDIVLOG2=1/log(2); # # very tiny value for rounding of real values in range2prefix $TINYLOGVALUE=(32-(log(2**32-1)*$ONEDIVLOG2))/100; # # text for the synthetic objects %RSANY=( "rs", "RS-ANY", "de", "all routes in:\r"); %ASANY=( "as", "AS-ANY", "de", "all autonomous systems in:\r"); # # some options as defined in the config file and # are used inside the code itself $REALTIMEMIRRORAUTHORIZATION="REALTIMEMIRRORAUTHORIZATION"; $NETWORKUPDATEAUTHORIZATION="NETWORKUPDATEAUTHORIZATION"; $MAINTAINERQRYAUTHORIZATION="MAINTAINERQRYAUTHORIZATION"; @REALTIMEMIRRORAUTHORIZATION=(); @NETWORKUPDATEAUTHORIZATION=(); @MAINTAINERQRYAUTHORIZATION=(); # # the maximal number of country attributes on a line $MAXCOUNTRIES=7; # # The maximal length of a key measured in characters that is *not* indexed $SMALLESTKEY=1; # # maximal number of initials for NIC handles $MAXLENGTHINITIALS=4; # # which characters are valid for an attribute # Note: the * is for the error attribute! $VALIDATTRCHAR='\w\-\*'; # # valid domain name regular expression $DOMAINNAME='[a-zA-Z\d]+((\.|\-+)[a-zA-Z\d]+)*'; $MIGHTBEADOMAINNAME='[a-zA-Z\d]+((\.|\-+)[a-zA-Z\d]+)*'; # # valid source attribute regular expression $SOURCENAME='([A-Z\d]+[A-Z\d\-]*[A-Z][A-Z\d\-]*[A-Z\d]|[A-Z]{2,2})'; # # the prefix that is used for auto nichandle assignments $AUTONICPREFIX="AUTO-"; $AUTONICPREFIXREGULAR='AUTO\-'; # # some common titles - only use lower case $TITLES='(m[rs]s?|drs?|ir|ing|sign|herr|hr|frau|prof\S*)\.? +'; # # regular expression for splitting up file names in path & name component $SPLITFILENAME='^\s*(\S+\/)?([^\/\s]+)\s*$'; # # ip regular expressions # # generic $VALIDPREFIXKEY='[\d\:\.a-f]+\/\d+'; # # this one has interesting (but no fatal) problems with perl5 & grep, see whoisd $QUADPART= '[12][0-4]\d|25[0-5]|1?[1-9]?\d'; $PADDEDQUADPART='\.0*[12][0-4]\d|\.0*25[0-5]|\.0*1?[1-9]?\d'; $VALIDIP4='0*('.$QUADPART.')('.$PADDEDQUADPART.'){0,3}'; $VALIDFULLIP4='0*('.$QUADPART.')('.$PADDEDQUADPART.'){3,3}'; $VALIDIP4PREFIXLENGTH='0*(3[012]|[12]?[\d])'; $VALIDIP4PREFIX=$VALIDIP4.'\/'.$VALIDIP4PREFIXLENGTH; $VALIDFULLIP4PREFIX=$VALIDFULLIP4.'\/'.$VALIDIP4PREFIXLENGTH; $VALIDIP4PREFIXKEY=$VALIDFULLIP4PREFIX; # # for ipv6 $VALIDIP6='[\da-f]{1,4}(\:[\da-f]{1,4}){7}'; $VALIDIP6PREFIX='[\d\:a-f]+\:[\d\:a-f]+\/\d+'; $VALIDIP6PREFIXKEY=$VALIDIP6.'\/\d+'; # # the attribute value to be used for deleted objects $DELETEDOBJECT="XX"; # # what is the extension for classless databases ? $CLASSLESSEXT=".cl"; # # what is the extension for the overflow files ? $OVERFLOWEXTENSION=".overflow."; # # what is the key for finding a new overflow number $OVERFLOWKEY="\t"; # # what is the prefix before the offset when we find an overflow instead # of offset values $OVERFLOWPREFIX="\t"; $OVERFLOWPREFIXREGULAR='\t'; # # NOTEXISTINGPREFIXESKEY # # key to find the list of existing prefixes $NOTEXISTINGPREFIXESKEY=$OVERFLOWKEY.$OVERFLOWKEY; # # which string do we use as 'binding' for uniquekeys $UNIQUEKEYBINDING="\t"; # # maximal number of entries/objects that we read & process at a time # # entries/objects are stored in a list which length is of the order # of $MAXLISTLENGTH entries $MAXLISTLENGTH=50000; # # this value determines the maximal length of a string # during processing # # usually we are talking about prefix keys: # # example: 536870912/8 # # that is components are about 10 bytes long # and the maximal string length is thus 10*$MAXSTRINGCOMPONENTS # # the more components we allow, the longer in memory copies take # the less components we allow, the more disk accesses we need $MAXSTRINGCOMPONENTS=300; # # line continuation length suffix $CONTINUATIONSUFFIX=" connectlength"; # # binding value for offset and size of object # # This one should ***always*** be equal to '.' # # This allows us to do (easy & fast) sorting of offsets although # the size of the object is connected as a suffix !!!! # # Example: 3.100 (object at offset 3 & size is 100) $SIZESUFFIXBINDING="."; $SIZESUFFIXBINDINGREGULAR='\.'; # # ANSI REAL def: $REAL='(\-|\+)?\s*(\d+)(\.\d+)?([eE][\-\+]\d+)?'; # # allowed routing protocols plus aliases for IPv6 %IPV6PROTOCOLS=( "idrpv6", "IDRPv6", "bgp4+", "BGP4+", "ripv6", "RIPng", "ripng", "RIPng", "static", "STATIC" ); 1; # # End of included 'defines.pl' data is here # # # The file 'dorpsl2ripe.pl' is included here # #line 0 dorpsl2ripe.pl # # $Id: dorpsl2ripe.pl,v 1.2 1997/10/28 21:52:39 eddy Exp $ # # Author: David Kessens # # rpsl2ripe # # converts RPSL %entry to RIPE181 %entry # and removed what cannot be translated or is difficult to translate # # returns new type of the object # sub rpsl2ripe { local(*entry, $type)=@_; local($str, $rest, $mail); my($line, @lines, $lastline, $thisline, $peeras, $pref, $br, $peerbr, $attribute); my(@keys)=(keys %entry); foreach $attribute (@keys) { if (($attribute=~ /$CONTINUATIONSUFFIX$/o) || ($attribute=~ /^ab|ag|co|df|ec|ep|ip|if|ij|mo|pe$/)) { delete($entry{$attribute}); next; } elsif ($attribute=~ /^em|fx|ny|ph|dt|mn$/) { $mail=$entry{$attribute}; &removecommentsemailline(*mail); $entry{$attribute}=$mail; } else { &removecomments(*entry, $attribute); } if ($OBJMULT{$type}!~ /\b$attribute\b/) { $entry{$attribute}=~ tr/\r/\n/; } else { $entry{$attribute}=~ tr/\r/ /; } # # revert comma separated lists back to separate attributes if ($attribute=~ /^mb|ml|al|cl|ho$/) { $entry{$attribute}=join("\n", split(/\s*\,\s*/, $entry{$attribute})); } # # fix ch if ($attribute eq "ch") { if (defined($entry{"ch"})) { $entry{"ch"}=join("\n", $entry{"ch"}, $CHANGEDLINE); } else { $entry{"ch"}=$CHANGEDLINE; } } # # fix remarks if ($attribute eq "rm") { if (defined($entry{"rm"})) { $entry{"rm"}=join("\n", $entry{"rm"}, $REMARKSLINE); } else { $entry{"rm"}=$REMARKSLINE; } } # # fix community if ($attribute eq "rs") { $entry{"cm"}=delete($entry{"rs"}); $entry{"cm"}=~ s/^RS\-//; delete($entry{"mr"}); $type="cm"; } # # fix as-macro if ($attribute eq "as") { $entry{"am"}=delete($entry{"as"}); $type="am"; } # # fix as-list if ($attribute eq "ms") { $entry{"al"}=delete($entry{"ms"}); $entry{"al"}=~ s/\s*\,\s*/ /g; } } return $type; } 1; # # End of included 'dorpsl2ripe.pl' data is here # # # The file 'enread.pl' is included here # #line 0 enread.pl # # enread - read RIPE database entry # # $RCSfile: enread.pl,v $ # $Revision: 1.2 $ # $Author: eddy $ # $Date: 1997/11/12 16:45:03 $ # Original code is written by various authors # Copyright (c) 1993, 1994, 1995, 1996, 1997 The TERENA Association # Copyright (c) 1998 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. # Copyright (c) 1997,1998 by the University of Southern California # All rights reserved. # # Permission to use, copy, modify, and distribute this software and its # documentation in source and binary forms for lawful non-commercial # purposes and without fee is hereby granted, provided that the above # copyright notice appear in all copies and that both the copyright # notice and this permission notice appear in supporting documentation, # and that any documentation, advertising materials, and other materials # related to such distribution and use acknowledge that the software was # developed by the University of Southern California, Information # Sciences Institute. The name of the USC may not be used to endorse or # promote products derived from this software without specific prior # written permission. # # THE UNIVERSITY OF SOUTHERN CALIFORNIA DOES NOT MAKE ANY # REPRESENTATIONS ABOUT THE SUITABILITY OF THIS SOFTWARE FOR ANY # PURPOSE. THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, # TITLE, AND NON-INFRINGEMENT. # # IN NO EVENT SHALL USC, OR ANY OTHER CONTRIBUTOR BE LIABLE FOR ANY # SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES, WHETHER IN CONTRACT, TORT, # OR OTHER FORM OF ACTION, ARISING OUT OF OR IN CONNECTION WITH, THE USE # OR PERFORMANCE OF THIS SOFTWARE. # # Author(s): David Kessens # # This routine reads RIPE database entries in %entry and returns the # type, "" when nothing has been found, $DELETEDOBJECT when # the object has been deleted, and an other invalid type when an # invalid object has been found. # When no valid/deleted object has been found %entry is set to (). # # file file to read from # # enread # # Take care with changing anything in this routine. # It is highly optimized for speed, especially for (sorted) big objects. # # $offset=# # >=0 read from position # and return position first found object # =-1 read from current position and return position first found object # =-2 read from current position and don't return current position sub enread { local($file, *entry, $offset, $size) = @_; my($line,$newtag,$shorttag,$connect,$prefixlength, $standardprefixlength,$linelength,@lines); my($readsize)=0; my($tag)=""; my($type)=""; my(@inputlines)=(); my(@connectlength)=(); %entry=(); # # select the right file for reading for RPSLCONVERSION # special update path data $file.=".rpsl" if ($offset=~ /^0[^0]/); # print STDERR "enread file: $file offset: $offset size: $size\n"; # print STDERR "first line: ", scalar(<$file>); seek($file, $offset, 0); if (defined($size)) { local($object); if ($SYSREAD) { if (-2!=$offset) { if ($offset>=0) { sysseek($file, $offset, 0); } else { $offset=sysseek($file, 0, 1) } } &safesysread($file, *object, $size); $object=~ s/\n+$//; } else { $offset=tell($file) if (-1==$offset); seek($file, $offset, 0) if ($offset>=0); &readparagraph($file, *object); } # print STDERR "enread file: $file offset: $offset size: $size loc: ", tell($file), " ",$object, "-\n"; ($line,@inputlines)=split(/\n/, $object); $line=~ s/\s/ /g; # print STDERR "$line --- \n", join("\n",@inputlines); } else { # print "no seek $offset $!\n"; seek($file, $offset, 0) if ($offset>=0); # print "seek $!\n"; # # skip empty lines until we find the first data and # make sure that we keep the offset $offset=tell($file) if (-1==$offset); while ((defined($line=<$file>)) && (($line=~ /^\s+$/) || ($line=~ /^\s*\#/))) { $offset=tell($file) if (-2!=$offset); # print STDERR "skip lines: ", $line; } $line=~ s/\s/ /g; } # print "start $!\n"; # print STDERR "first line: ", $line; if ($line) { # # return immediately if we found a deleted object # and we are not in scanning mode during the index # process when we intend to skip deleted objects if ($line=~ /^(\*?$DELETEDOBJECT *\:|\*xx)/o) { return ($DELETEDOBJECT, $offset, 0) if ($offset>=0); # print STDERR "XX object $line"; while ($line=~ /^(\*?$DELETEDOBJECT\s*\:|\*xx)/o) { while ((defined($line=<$file>)) && ($line ne "\n")) {}; while ((defined($line=<$file>)) && (($line=~ /^\s*$/) || ($line=~ /^\s*\#/))) { $offset=tell($file) if (-2!=$offset); }; } $line=~ s/\s/ /g; } for (;;) { $linelength=length($line); if (($line=~ s/^(\*)?([^\*\: ]+)\*?( *\: *)//) || ((@lines) && (($line=~ s/^( +)//) || ($line=~ s/^( +)(\S)/$2/) || ($line=~ /^()\#/)))) { $readsize+=$linelength; if ($3) { # # we found another attribute $standardprefixlength=length($1)+length($2)+length($3); ($newtag=$2)=~ tr/A-Z/a-z/; $connect="\n"; } else { # # we have a line continuation $prefixlength=length($1)-$standardprefixlength; push(@connectlength, ($prefixlength<=0)?2:($prefixlength+2)); $connect="\r"; } # # remove trailing spaces $line=~ s/ *$//; if ($tag eq $newtag) { # print STDERR "tag: ", $tag, "\n"; # tag is same as previous one if ($line) { # print STDERR "tag: $tag value: $line\n"; push(@lines, $connect, $line); } else { push(@lines, $connect, "") if ($lines[$#lines]); #&logmessage("ERRLOG", "enread: empty attribute, normal $tag (offset: ".$offset." ".$offset." ".tell($file).") in line: $newtag:"); } } else { # # tag could have been changed # # store old tag if ($entry{$shorttag}) { $entry{$shorttag}=join("", $entry{$shorttag}, $connect, @lines) if (@lines); } else { $entry{$shorttag}=join("", @lines) if (@lines); } # # store line continuation lengths if (@connectlength) { if ($entry{$shorttag.$CONTINUATIONSUFFIX}) { $entry{$shorttag.$CONTINUATIONSUFFIX}=join(" ", $entry{$shorttag.$CONTINUATIONSUFFIX}, @connectlength); } else { $entry{$shorttag.$CONTINUATIONSUFFIX}=join(" ", @connectlength); } } $tag=$newtag; $shorttag=$ATTR{$tag}; if (!$shorttag) { &logmessage("ERRLOG", "enread: unknown attribute: \'$tag\' found,".($offset==-1?"":(" (offset: ".$offset." ".$offset." ".tell($file).")"))." in line: $tag: ".$line); $shorttag=$tag; } # # we keep the type of the object # print STDERR "newtag: ", keys %OBJATSQ, $tag, "\n"; $type=$shorttag if ((!$type) && ($OBJATSQ{$shorttag})); # # print STDERR "type: ", $type, "\n"; if ($line) { # print STDERR "newtag: $tag type: $type value: $value\n"; @lines=($line); } else { @lines=(""); #&logmessage("ERRLOG", "enread: empty attribute, newtag $newtag (offset: ".$offset." ".$offset." ".tell($file).") in line:".$line); } } } else { # now we have the following possibilties: # # - we are at the end of the object # - we found a comment # - we have an error condition # # let's assume the first possibility first since # it is most common if ($line=~ /^ *$/) { # # end of object # # store old tag if ($entry{$shorttag}) { $entry{$shorttag}=join("", $entry{$shorttag},$connect,@lines); } else { $entry{$shorttag}=join("", @lines); } # # store line continuation lengths if ($entry{$shorttag.$CONTINUATIONSUFFIX}) { $entry{$shorttag.$CONTINUATIONSUFFIX}=join(" ", $entry{$shorttag.$CONTINUATIONSUFFIX}, @connectlength) if (@connectlength); } else { $entry{$shorttag.$CONTINUATIONSUFFIX}=join(" ", @connectlength) if (@connectlength); } # print STDERR "type: $type ",$entry{"so"}." $shorttag entry:\n", %entry, "\n"; return ($type, $offset, $readsize) if ($type); &logmessage("ERRLOG", "enread: object has no type".($offset==-1?"":(" (offset: ".$offset." ".$offset." ".tell($file).")"))); %entry=(); # just create a type that is not the same as others and # that is for sure invalid ... return ($DELETEDOBJECT.$DELETEDOBJECT, $offset, 0); } elsif ($line!~ /^\#/) { # # no comment, no end of object # # we have an error condition # # print STDERR "$offset $line"; &logmessage("ERRLOG", "enread: no attribute in line (tag: ".($tag eq ""?"N/A":$tag).", type: ".($type eq ""?"N/A":$type).")".($offset==-1?"":(" (offset: ".$offset." ".$offset." ".tell($file).")")).": ".$line); # skip rest of object if (!defined($size)) { while ((defined($line=<$file>)) && ($line!~ /^\s+$/)) {} } %entry=(); # just create a type that is not the same as others and # that is for sure invalid ... return ($DELETEDOBJECT.$DELETEDOBJECT, $offset, 0); } } if (defined($size)) { ($line=shift(@inputlines)." ")=~ s/\s/ /g; #print STDERR "next: -", $line,"-", @inputlines; } else { ($line=<$file>)=~ s/\s/ /g; #print STDERR "line: ",$line,"\n"; } } } else { return(); } } 1; # # End of included 'enread.pl' data is here # # # The file 'enwrite.pl' is included here # #line 0 enwrite.pl # # enwrite - write RIPE database entry # # $RCSfile: enwrite.pl,v $ # $Revision: 1.1.1.1 $ # $Author: eddy $ # $Date: 1997/10/27 20:13:47 $ # # This routine writes a RIPE database entry to standard output # in long or short form. # # Arguments: # $output file handle for output # *object pointer to assoc array with database entry # $witherrors boolean flag for with or without error messages # Original code is written by various authors # Copyright (c) 1993, 1994, 1995, 1996, 1997 The TERENA Association # Copyright (c) 1998 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. # Copyright (c) 1997,1998 by the University of Southern California # All rights reserved. # # Permission to use, copy, modify, and distribute this software and its # documentation in source and binary forms for lawful non-commercial # purposes and without fee is hereby granted, provided that the above # copyright notice appear in all copies and that both the copyright # notice and this permission notice appear in supporting documentation, # and that any documentation, advertising materials, and other materials # related to such distribution and use acknowledge that the software was # developed by the University of Southern California, Information # Sciences Institute. The name of the USC may not be used to endorse or # promote products derived from this software without specific prior # written permission. # # THE UNIVERSITY OF SOUTHERN CALIFORNIA DOES NOT MAKE ANY # REPRESENTATIONS ABOUT THE SUITABILITY OF THIS SOFTWARE FOR ANY # PURPOSE. THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, # TITLE, AND NON-INFRINGEMENT. # # IN NO EVENT SHALL USC, OR ANY OTHER CONTRIBUTOR BE LIABLE FOR ANY # SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES, WHETHER IN CONTRACT, TORT, # OR OTHER FORM OF ACTION, ARISING OUT OF OR IN CONNECTION WITH, THE USE # OR PERFORMANCE OF THIS SOFTWARE. # # Author(s): David Kessens sub enwrite { local($output, *object, $type, $witherrors) = @_; my($offset)=tell($output)+1; my(@errs)=(); @errs=("uw","ue") if ($witherrors); my(@buffer)=("\n"); my($val, @continuations, $margin); # # If we have an unknown object, let's try # and print this anyway to inform the user ... if ((!$type) || ($object{"ue"})) { my(@keys)=(); my(%doubles)=(); @keys=split(/ /, $OBJATSQ{$type}) if ($type); push(@keys, grep( ! /^u[ew]$/, keys %object), @errs); foreach $key (@keys) { next if ((!defined($object{$key})) || ($doubles{$key}) || ($key=~ /$CONTINUATIONSUFFIX$/o) || ((!$witherrors) && ($key=~ /^u[ew]$/))); $doubles{$key}=1; foreach $val (split(/\n/, $object{$key})) { if ($ATTL{$key}) { push(@buffer, $ATTL{$key}, ": ", " " x ($MAXATTRIBUTELENGTH - length($ATTL{$key}))); } else { push(@buffer, $key, ": "); } # # for just in case: # remove any line continuations at the end of lines ... # # we will not enter 'foreach' when $val="" # so we are repairing it in advance ... push(@buffer, "\n") if ($val eq ""); $val=~ s/[^\S\n]+$//; # # add line continuation leading spaces @continuations=split(/ /, $object{$key.$CONTINUATIONSUFFIX}); foreach (split(/(\r)/, $val)) { if ($_ eq "\r") { $margin=shift(@continuations); $margin=2 if ((!$margin) || ($margin<2)); push(@buffer, (" " x ($MAXATTRIBUTELENGTH + $margin))); } elsif (scalar(@buffer)>$MAXLISTLENGTH) { &fatalerror("in enwrite: cannot write. code: $!") if (!print $output @buffer); @buffer=($_, "\n"); } else { push(@buffer, $_, "\n"); } } } } &fatalerror("in enwrite: cannot write. code: $!") if ((@buffer) && (!print $output @buffer)); return $offset; } foreach $key (split(/ /, $OBJATSQ{$type}), @errs) { next if (!defined($object{$key})); # print STDERR "*",$key,"* ", $object{$key}, "\n"; foreach $val (split(/\n/, $object{$key})) { push(@buffer, $ATTL{$key}, ": ", " " x ($MAXATTRIBUTELENGTH - length($ATTL{$key}))); # # for just in case: # remove any line continuations at the end of lines ... $val=~ s/[^\S\n]+$//; # # we will not enter 'foreach' when $val="" # so we are repairing it in advance ... push(@buffer, "\n") if ($val eq ""); # # add line continuation leading spaces @continuations=split(/ /, $object{$key.$CONTINUATIONSUFFIX}); foreach (split(/(\r)/, $val)) { if ($_ eq "\r") { $margin=shift(@continuations); $margin=2 if ((!$margin) || ($margin<2)); push(@buffer, (" " x ($MAXATTRIBUTELENGTH + $margin))); } elsif (scalar(@buffer)>$MAXLISTLENGTH) { &fatalerror("in enwrite: cannot write. code: $!") if (!print $output @buffer); @buffer=($_, "\n"); } else { push(@buffer, $_, "\n"); } } } } &fatalerror("in enwrite: cannot write. code: $!") if ((@buffer) && (!print $output @buffer)); return $offset; } 1; # # End of included 'enwrite.pl' data is here # # # The file 'entype.pl' is included here # #line 0 entype.pl # entype - return type of RIPE database entry # # $RCSfile: entype.pl,v $ # $Revision: 1.1.1.1 $ # $Author: eddy $ # $Date: 1997/10/27 20:13:47 $ # Original code is written by various authors # Copyright (c) 1993, 1994, 1995, 1996, 1997 The TERENA Association # Copyright (c) 1998 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. # Copyright (c) 1997,1998 by the University of Southern California # All rights reserved. # # Permission to use, copy, modify, and distribute this software and its # documentation in source and binary forms for lawful non-commercial # purposes and without fee is hereby granted, provided that the above # copyright notice appear in all copies and that both the copyright # notice and this permission notice appear in supporting documentation, # and that any documentation, advertising materials, and other materials # related to such distribution and use acknowledge that the software was # developed by the University of Southern California, Information # Sciences Institute. The name of the USC may not be used to endorse or # promote products derived from this software without specific prior # written permission. # # THE UNIVERSITY OF SOUTHERN CALIFORNIA DOES NOT MAKE ANY # REPRESENTATIONS ABOUT THE SUITABILITY OF THIS SOFTWARE FOR ANY # PURPOSE. THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, # TITLE, AND NON-INFRINGEMENT. # # IN NO EVENT SHALL USC, OR ANY OTHER CONTRIBUTOR BE LIABLE FOR ANY # SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES, WHETHER IN CONTRACT, TORT, # OR OTHER FORM OF ACTION, ARISING OUT OF OR IN CONNECTION WITH, THE USE # OR PERFORMANCE OF THIS SOFTWARE. # # Author(s): David Kessens # # This routine returns the type of RIPE database entry given to it. # An entry type is defined in the config file # # Arguments: # *object pointer to database entry in assoc array. sub entype { local(*object) = @_; foreach (keys %OBJATSQ) { return ($_) if ($object{$_}); } # # do a more extensive search if we cannot find the # the type due to an error condition ... local($object,$attribute,$found); foreach $attribute (keys %object) { next if (!$ATTR{$attribute}); $found=""; foreach $otherobject (keys %OBJATSQ) { if ($OBJATSQ{$otherobject}=~ /\b$attribute\b/) { if ($found) { $found=""; last; } else { $found=$otherobject; } } } return ($found) if ($found); } return ""; } 1; # # End of included 'entype.pl' data is here # # # 'convert2domainname' is included from the file 'misc.pl' # # misc - miscellaneaous functions # # $RCSfile: misc.pl,v $ # $Revision: 1.2 $ # $Author: eddy $ # $Date: 1997/11/12 16:45:05 $ # sub convert2domainname { my($domain)=@_; $domain=(gethostbyaddr(pack("C4", split(/\./, $domain)), PF_INET))[0] if ($domain=~ /^$VALIDFULLIP4$/o); return "" if (!&isdomname($domain)); return $domain; } # # End of included 'misc.pl' data is here # # # 'getYYYYMMDDandHHMMSS' is included from the file 'misc.pl' # # misc - miscellaneaous functions # # $RCSfile: misc.pl,v $ # $Revision: 1.2 $ # $Author: eddy $ # $Date: 1997/11/12 16:45:05 $ # # # the name says all ...: sub getYYYYMMDDandHHMMSS { my($s,$m,$h,$day,$month,$year,$wd,$yd,$is)=localtime(time); $year+=1900; my($YYYYMMDD)=sprintf("%4d%2d%2d",$year,++$month,$day); $YYYYMMDD=~ tr/ /0/; my($HHMMSS)=sprintf("%2d:%2d:%2d",$h,$m,$s); $HHMMSS=~ s/ /0/g; return ($YYYYMMDD,$HHMMSS); } # # End of included 'misc.pl' data is here # # # 'isdomname' is included from the file 'misc.pl' # # misc - miscellaneaous functions # # $RCSfile: misc.pl,v $ # $Revision: 1.2 $ # $Author: eddy $ # $Date: 1997/11/12 16:45:05 $ # sub isdomname { return scalar($_[0]=~ /^\s*$DOMAINNAME\s*$/o); } # # End of included 'misc.pl' data is here # # # 'removecomments' is included from the file 'misc.pl' # # misc - miscellaneaous functions # # $RCSfile: misc.pl,v $ # $Revision: 1.2 $ # $Author: eddy $ # $Date: 1997/11/12 16:45:05 $ # sub removecomments { local(*object, $key)=@_; local($*)=1; my(@comments)=(); my(@text)=(); my($value); if ($key ne "") { $value=$object{$key}; } else { $value=$object; } foreach (split(/([\n\r])/, $value)) { if (/^\r$/) { push(@comments, ""); push(@text, "\r"); } else { if (s/^([^\#]+[^\s]|)(\s*\#.*)$//) { push(@text, $1, "\r"); push(@comments, $2); } else { push(@text, $_); } } } # # compose line and remove leading & trailing white space if ($key ne "") { $*=0; $value=join("", @text); $value=~ s/(\s*)$//; push(@comments, $1); $value=~ s/^(\s*)//; push(@comments, $1); $object{$key}=$value; } else { $*=0; $object=join("", @text); $object=~ s/(\s*)$//; push(@comments, $1); $object=~ s/^(\s*)//; push(@comments, $1); } return @comments; } # # End of included 'misc.pl' data is here # # # 'removecommentsemailline' is included from the file 'misc.pl' # # misc - miscellaneaous functions # # $RCSfile: misc.pl,v $ # $Revision: 1.2 $ # $Author: eddy $ # $Date: 1997/11/12 16:45:05 $ # # # remove comments in line with e-mail address sub removecommentsemailline { local(*email)=@_; local($*)=1; my(@comments)=(); my($before); # # remove leading comments/white space while (($email=~ s/^(\s*\#[^\r]*\r)//) || ($email=~ s/^([^\S\r]*\r)//)) { push(@comments, $1); } # print STDERR "start: ", @comments, " -*- ", $email, "\n"; # # remove leading white space push(@comments, $1) if ($email=~ s/^([^\S\r]*\r)//); $before=join("", @comments); # print STDERR "removed leading stuff: ", @comments, " -*- ", $email, "\n"; # # the login part of E-mail address might contain '#'! # the following should take care of 99% of all cases but not all. my($loginpart); if ($email=~ s/^(\"[^\"]*[^\"\\]\"\@|[^\s\@]+)//) { $loginpart=$1; } else { $loginpart=""; } # print STDERR $loginpart, "\n"; # print STDERR "got login: ", @comments, " -*- ", $email, "\n"; # # remove trailing comments/white space while (($email=~ s/(\s*\#[^\r]*)$//) || ($email=~ s/(\r[^\S\r]*)//)) { push(@comments, $1); } push(@comments, $1) if ($email=~ s/(\s*)$//); $email=$loginpart.$email; return($before, join("", @comments)); } # # End of included 'misc.pl' data is here # #line 38 rpsl2ripe.pl # # end of included code ($DATE,$TIME)=&getYYYYMMDDandHHMMSS(); $REMARKSLINE="This object is automatically converted from the RPSL registry\nMany attributes cannot be translated\nfrom RPSL to RIPE181 and are removed"; $CHANGEDLINE=$AUTOBOX." ".$DATE; local($type, %entry); while ($type=(&enread(STDIN, *entry, -1))[0]) { $type=&rpsl2ripe(*entry, $type); $ATTL{"la"}="localas"; $ATTL{"ho"}="hole"; &enwrite(STDOUT, *entry, $type, 1); $ATTL{"la"}="local-as"; $ATTL{"ho"}="holes"; } # end of program