#!/usr/bin/perl # Author: Thomas Jacob, Internet24.de # Copyright (C) 2004-2021 Simon Josefsson. # Copyright (C) 2004-2021 Free Software Foundation, Inc. # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . # # I consider the output of this program to be unrestricted. Use it as # you will. # See doc/tld/README and draft-hoffman-idn-reg-*.txt inside Libidn for # more information on the input file syntax. # Use this to generate TLD tables: # $ ./gen-tld-tables *.tld > tlds.c use strict; use warnings; die "Usage: $0 " if ($#ARGV == -1); print "/* This file is automatically generated. DO NOT EDIT!\n"; print " Instead, edit gen-tld-tables.pl and re-run. */\n"; print "\n"; print "#include \"tld.h\"\n"; print "\n"; my @tlds; foreach my $tldfile (@ARGV) { my ($tld, $version); my $data = process_definition ($tldfile, \$tld, \$version); push @tlds, $tld; optimize($data); print_tld_domain($tld, \@$data, $version); } print "/* Main array */\n"; print "const Tld_table * _tld_tables[] =\n"; print "{\n"; foreach (@tlds) { print " &_tld_${_},\n"; } print " NULL\n"; print "};\n"; # Print tld domain structure. # void print_tld_domain($tldfile, \$tld, \@intervals, $version); sub print_tld_domain { my $tld = shift; my $intervals = shift; my $version = shift; my $num_intervals = @$intervals; print "/* TLD $tld */\n"; print "static const Tld_table_element _tld_${tld}_valid[] =\n"; print "{\n"; if (@$intervals) { my $last = pop @$intervals; foreach (@$intervals) { printf " { 0x%x, 0x%x },\n", $_->[0], $_->[1]; } printf " { 0x%x, 0x%x }\n", $last->[0], $last->[1]; } print "};\n"; print "\n"; print "static const Tld_table _tld_${tld} =\n"; print "{\n"; print " \"$tld\",\n"; print " \"$version\",\n"; print " $num_intervals,\n"; print " &_tld_${tld}_valid[0]\n"; print "};\n\n"; } # process a definition file # $filename, \$tld, \$version # return @data on success, die otherwise sub process_definition { my $filename = shift; my $tld = shift; my $version = shift; my $incversion; my $path; my @data; local * FILE; open(FILE, "<$filename") or die "Cannot open $filename"; $path = $filename; $path =~ s/\/[^\/]+$//; my ($is_int,$have_num,$num,$cnum); my $line = 1; while() { chomp; s/#.*$//; if (m/^include\s+(\S+)\s*$/i) { my $incfile = $1; my ($junk, $ver); my $incdata = process_definition("$path/$incfile", \$junk, \$ver); $incversion = $incversion . " $incfile ($ver)"; push @data, @$incdata; next; } if (m/^version\s+"(.*)"\s*$/i) { $$version = $1; next; } if (m/^tld\s+(\S+)\s*$/i) { $$tld = $1; next; } while ($_ ne "") { s/^\s*//; if ( (s/^(0x)([a-f0-9]+)//i) || (s/^(U\+)([a-f0-9]+)//i) || (s/^(0)(\d+)//) || (s/^(\d+)//) ) { $cnum = $1; if (((lc($1) eq "0x") || (lc($1) eq "u+")) && $2) { $cnum = hex($2); } elsif (($1 eq "0") && $2) { $cnum = oct($2); } if ($have_num) { if ($is_int) { push @data, [$num, $cnum]; $have_num = 0; $is_int = 0; } else { push @data, [$num,$num]; $num = $cnum; } } else { $have_num = 1; $num = $cnum; } } elsif (s/^\-//) { $is_int = 1; } elsif (s/^\|//) { $is_int = 0; } elsif (s/^\://) { $is_int = 0; } else { die "Parser error in file $filename at line $line near $_, " if $_ ne ""; } } $line++; } close(FILE); if ($have_num) { if ($is_int) { push @data, [$num, $cnum]; } else { push @data, [$num, $num]; } } $$version = $$version . $incversion if $incversion; return \@data; } # Build minimal set of intervals. # void optimize(\@intervals) sub optimize { my $intervals = shift; return undef unless (@$intervals); my @intervals = sort {$a->[0] <=> $b->[0]} @$intervals; @$intervals = (); my $cur_int = shift @intervals; foreach (@intervals) { if ($_->[0]>($cur_int->[1]+1)) { push @$intervals, $cur_int; $cur_int = $_; } else { if ($_->[1] > $cur_int->[1]) { $cur_int->[1] = $_->[1]; } } } push @$intervals, $cur_int; }