update-services.pl [plain text]
use strict;
use IO::File;
if (!defined($ARGV[0]) || !defined($ARGV[1])) {
die "usage: update-services.pl services port-numbers\n";
}
sub parse_services {
my $file = shift;
my $names = shift;
my $descs = shift;
my $emails = shift;
my $service = qr/[a-zA-Z0-9_+\/.*-]+/;
my $protocol = qr/[0-9]+\/[ut][dc]p/;
my $description = qr/.*/;
my $prevserv;
my $handle = new IO::File;
open($handle, $file) or die "$file: $!";
while (<$handle>) {
if (m/^ my $key = $2;
my $str = $3;
$prevserv = $key;
$names->{$key} = $1;
$str =~ s/\x0d//g;
chomp($str);
$descs->{$key} = $str;
} elsif (defined($prevserv) && m/^ my $str = $1;
$str =~ s/\x0d//g;
chomp($str);
$emails->{$prevserv} = $str;
$prevserv = undef;
}
}
close($handle);
}
my %iana_names = ();
my %iana_descs = ();
my %iana_emails = ();
my %local_names = ();
my %local_descs = ();
my %local_emails = ();
&parse_services($ARGV[0], \%local_names, \%local_descs, \%local_emails);
&parse_services($ARGV[1], \%iana_names, \%iana_descs, \%iana_emails);
sub protonum {
my ($a) = split(/\//, shift);
return $a;
}
sub _cmpproto {
my $a = shift;
my $b = shift;
my $res = protonum($a) <=> protonum($b);
if ($res == 0) {
$res = $a cmp $b;
}
return $res;
}
sub cmpproto {
return &_cmpproto($a, $b);
}
my @additions = ();
foreach my $key (sort cmpproto keys(%iana_names)) {
if (not exists $local_names{$key}) {
push @additions, $key;
}
}
my @deletions = ();
foreach my $key (sort cmpproto keys(%local_names)) {
if (not exists $iana_names{$key}) {;
push @deletions, $key;
}
}
my @conflicts = ();
foreach my $key (sort cmpproto keys(%local_names)) {
if (exists $iana_names{$key} &&
exists $local_names{$key} &&
$iana_names{$key} ne $local_names{$key}) {
push @conflicts, $key;
}
}
my $service = qr/[a-zA-Z0-9_+\/.*-]+/;
my $protocol = qr/[0-9]+\/[ut][dc]p/;
my $description = qr/.*/;
my $prev_add;
my $next_add = shift @additions;
my $prev_del;
my $next_del = shift @deletions;
my $handle = new IO::File;
open($handle, $ARGV[0]) or die "$ARGV[0]: $!";
my $line = <$handle>;
while (defined($next_add) && defined($line)) {
if ($line =~ m/^ my $proto = $2;
my $res;
if (undef) {
print "# ";
print sprintf "% -11s ", protonum($next_del);
print "Unassigned\n";
$prev_del = $next_del;
$next_del = shift @deletions;
$line = <$handle>;
next;
}
$res = &_cmpproto($next_add, $proto);
if ($res == 1) {
if (defined($prev_add) && _cmpproto($prev_add, $proto) == -1) {
my $start = &protonum($prev_add) + 1;
my $end = &protonum($proto) - 1;
print "# ";
if ($start < $end) {
print sprintf "% -11s ", "$start-$end";
} else {
print sprintf "% -11s ", "$start";
}
print "Unassigned\n";
$prev_add = undef;
}
print "$line";
$line = <$handle>;
next;
} elsif ($res == 0) {
die "conflicting entry: $next_add";
print "$line";
$line = <$handle>;
} elsif ($res == -1) {
if (defined($prev_add)) {
my $start = &protonum($prev_add);
my $end = &protonum($next_add);
if (($end - $start) > 1) {
++$start;
--$end;
print "# ";
if ($start < $end) {
print sprintf "% -11s ", "$start-$end";
} else {
print sprintf "% -11s ", "$start";
}
print "Unassigned\n";
}
}
print sprintf "% -15s ", $iana_names{$next_add};
print sprintf "% -11s ", $next_add;
print "# ". $iana_descs{$next_add} if exists $iana_descs{$next_add};
print "\n";
if (exists $iana_emails{$next_add}) {
print "# ";
print $iana_emails{$next_add};
print "\n";
}
$prev_add = $next_add;
$next_add = shift @additions;
}
} elsif ($line =~ m/^ if ($1 != &protonum($next_add)) {
print "$line";
}
$line = <$handle>;
} else {
print "$line";
$line = <$handle>;
}
}
close($handle);