1#!<PERL5> 2# **************************************************************************** 3# Creates a hosts file for fidogate from a nodelist 4# 5# Author: Thomas Huber (Thomas.Huber@lemas_oschwand.fidonet.org) 6# Version: 0.1 7# Date: 17.09.95 8# Last modified: 1.10.95 9# 10# Report bugs etc to: Thomas.Huber@2:301/101.19 or huber@iamexwi.unibe.ch 11# **************************************************************************** 12 13sub usage { 14print "ndl2hosts [-h] [-z] [-f zones] [-d domain] [-p parameters] [nodelist]\n 15ndl2hosts slurps in a nodelist an prints out a hosts file 16to use with fidogate. 17\t-h:\t\tPrint this usage text 18\t-z:\t\tNodelist on stdin is compressed 19\t-f zones:\tOnly process nodes in zones contained in string 'zones' 20\t-d domain:\tAppend this domain to hostnames 21\t-p parameters:\tParameters for hosts file 22\t nodelist:\tIf specified, read from this file, else from stdin\n"; 23exit 1; 24} 25 26require "getopts.pl"; 27&Getopts('hzd:f:p:') || &usage; # Get options 28 29# Defaults if no options given 30$params = "-p"; # -p : generate hostnames with point 31$domain = ""; # domain appended to hostnames 32$filter = "2"; # Only process nodes of zone 2 33$COMPRESS = 0; # nodelist not compressed 34 35# Process given options 36if($opt_h) { 37 &usage; 38} 39if($opt_d) { 40 $domain = $opt_d; 41} 42if($opt_f) { 43 $filter = $opt_f; 44} 45if($opt_p) { 46 $params = $opt_p; 47} 48if($opt_z) { 49 $COMPRESS = 1; 50} 51 52$nodefile = @ARGV[$#ARGV]; # name of input file 53if ($nodefile ne "") { # if empty, read from stdin 54 if ($nodefile=~/.*\.(gz|Z|z|gzip)/) { # compressed input 55 open(in,sprintf("zcat %s|",$nodefile)) || die "Error opening nodelist\n"; 56 } 57 else { # uncompressed input 58 open(in,$nodefile) || die "Error opening nodelist"; 59 } 60 $in = in; 61 } 62else { # read from stdin 63 if ($COMPRESS) { # STDIN compressed (-z option) 64 open(in,"cat - | gzip -d |"); # pipe stdin through gzip -d 65 $in = in; 66 } 67 else { # stdin uncompressed 68 $in = "STDIN"; 69 } 70} 71 72 73# Perform various substitutions on the hostnames in order to get acceptable 74# rfc adresses. Eliminates the generation of ugly adresses from braindead 75# nodenames as "(yber**foo(((|3ar>>>]-[otel_23.00-0600++#124-1&2!!" (-; 76sub do_subs { 77 local($name) = @_; 78 study($name); 79 $name=~tr/[A-Z]/[a-z]/; # convert all to lowercase 80 81 # Replace foo_bar(IsDn-Blubb) by foo_bar_isdn 82 $name=~s/(\(|\[).*(I|i)(S|s)(D|d)(N|n).*(\)|])/isdn/go; 83 84 85 $name=~s/\\\\/h/go; # \\ill-foo -> hill-foo 86 $name=~s/\\\\\//w/go; # \\/orld-bar->world-bar 87 $name=~s/\][\\\/=-]\[/h/go; # ]-[ello -> hello 88 $name=~s/\(y/cy/go; # (yber -> cyber 89 90 # Kill unwanted characters 91 $name=~s/([\{\}\[\]~\?\(\)<>=%$\@#\!\/\'\*;:,"`\+]{1,}|\(.*\)|\[.*\])//go; 92 $name=~s/&/and/go; # Replace & by 'and' 93 94 # Replace _-_ . _- -_ by - 95 $name=~s/(_*-{1,}_*|\.)/-/go; 96 97 # Replace ------- by -, ____ by _ 98 $name=~s/-{1,}/-/go; 99 $name=~s/_{1,}/_/go; 100 $name=~s/={1,}/=/go; 101 102 # Kill times in hostname (bar_box-2300-0600) 103 $name=~s/[0-2][0-9][0-5][0-9]-[0-2][0-9][0-5][0-9]//go; 104 $name=~s/([0-1])?[0-9][ap]m-([0-1])?[0-9][ap]m//go; 105 $name=~s/[0-2][0-9](_)?([0-5][0-9])?(-|_)[0-2][0-9](_)?([0-5][0-9])?//go; 106 107 # remove leading _ - = \ / 108 $name=~s/^[-_=\[\]\\\/]{1,}//go; 109 110 # How do you kill trailing _ - etc ? The only way I get it to work 111 # is this one: 112 $name=reverse($name); 113 $name=~s/^[-_=\[\]\\\/]{1,}//go; 114 $name=reverse($name); 115 116 return $name; 117} 118 119 120 121$host=""; # init 122printf stderr ("Doing substitutions..."); 123while (<$in>) { 124 if (index($_,";") == -1 ) { # skip comments 125 split(",",$_); # split at commas 126 if ($_[0] eq "Zone") { # all following hosts 127 $zone=$_[1]; # are from this zone 128 $host=""; 129 } 130 if ($_[0] eq "Host") { # all following nodes are 131 $host=$_[1]; # from this host 132 } 133 134 if (index($filter,$zone) != -1) { 135 if (($_[0] ne "Hub")&&($_[0] ne "Region")&& 136 ($_[0] ne "Host")&&($_[1] ne "")&&($host ne "")&& 137 ($zone ne "")) { 138 $node=$_[1]; 139 $name=$_[2]; 140 $name=&do_subs($name); 141 # unlucky nodenames are deleted by do_subs, i.e. "(foo-box)" 142 if ($name ne "") { 143 push(@hostsfile,sprintf("%s:%s/%s\t%s\t\n",$zone,$host,$node, 144 $name)); 145 } 146 } 147 } 148 } 149} 150printf stderr ("done.\n"); 151 152 153 154# The raw hosts file is now in the array @hostsfile for further processing 155# The purpose of the following code is to guarantee that nodenames are unique 156# If multiple nodes having the same name are found, append a number to make 157# them unique, i.e. foo-1, foo-2, foo-3 etc. 158printf stderr ("Sorting..."); 159 160# Sort by GNU sort, as perl's sort function is so unefficient that 161# it eats up all my memory... 162open(temp,">temp_file"); 163print temp @hostsfile; 164open(temp2,"sort -b +1 temp_file |"); 165$temp2 = temp2; 166while (<$temp2>) { 167 push(@sorted,$_); 168} 169system("rm -f temp_file"); 170 171# @sorted = sort({(split("\t",$a))[1] cmp (split("\t",$b))[1]} @hostsfile); 172printf stderr ("done.\nRemoving duplicates..."); 173 174$tmpspace="\t\t\t\t\t\t\t\t"; 175$counter = ""; 176$isdupe = 0; 177$stroke = ""; # stroke ('-') separates hostname 178foreach $tmp(@sorted) { # and number 179 @current=split("\t",$tmp); # split into adr and hostname 180 if (@current[1] eq @previous[1]) { # same hostnames! 181 if ($counter eq "") { $counter = 0; }# first dupe -> start counting 182 $isdupe = 1; # found dupe 183 $counter++; # one more dupe 184 } 185 else { # hostname not the same as 186 if ($isdupe) { # previous hostname 187 $isdupe = 0; # the current host isn't a dupe, 188 $counter++; # but the previous is one 189 } 190 } 191 if (@previous[0] ne "") { # first loop run ? 192 if ($counter ne "") { # counter set -> dupes found 193 $stroke = "-"; # in hostname, number is 194 } # separated from hostame by - 195 else { 196 $stroke = ""; # no counter, no stroke 197 } 198 # calculate number of Tabs for a good looking hosts file 199 $space=substr($tmpspace,0, 200 (8-(length(@previous[1])+length($counter)+length($stroke) 201 +length($domain)+1)/8)); 202 # push a line on the output-array 203 push(@out,sprintf("%s \t%s%s%s\n", 204 @previous[0],@previous[1].$stroke.$counter.$domain,$space,$params)); 205 if (!$isdupe) { $counter = ""; } # if prev was a dupe but current 206 # isn't delete counter 207 } 208 @previous = @current; # proceed to next loop run 209} 210# the last one 211if (@previous) { 212 if ($isdupe) {$counter++;} 213 $space=substr($tmpspace,0, 214 (8-(length(@previous[1])+length($counter)+length($stroke) 215 +length($domain)+1)/8)); 216 push(@out,sprintf("%s \t%s%s%s\n", 217 @previous[0],@previous[1].$stroke.$counter.$domain,$space,$params)); 218} 219printf stderr ("done.\n"); 220print @out; # print the whole shit'out (-: 221