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