forked from pool/netcfg
Petr Gajdos
28d36cff37
[bnc#831522], [bnc#731391] (both internal) OBS-URL: https://build.opensuse.org/package/show/Base:System/netcfg?expand=0&rev=14
112 lines
2.4 KiB
Perl
112 lines
2.4 KiB
Perl
#!/usr/bin/perl -w
|
|
|
|
use strict;
|
|
|
|
my $sfile = 'services';
|
|
my $snewfile = 'services.new';
|
|
|
|
my %s;
|
|
my %snew;
|
|
|
|
parse_services_file($sfile, \%s);
|
|
parse_services_file($snewfile, \%snew);
|
|
|
|
my @preserved_pairs;
|
|
my @services_changing_port;
|
|
my @services_renamed;
|
|
my @removed_pairs;
|
|
my @new_pairs;
|
|
|
|
BEGINLOOP: foreach my $port (keys %s)
|
|
{
|
|
if (exists($snew{$port}) and $snew{$port} eq $s{$port})
|
|
{
|
|
# service port pair preserved
|
|
push(@preserved_pairs, "$snew{$port} $port");
|
|
next BEGINLOOP;
|
|
}
|
|
|
|
foreach my $portnew (keys %snew)
|
|
{
|
|
if ($snew{$portnew} eq $s{$port} and protocol($portnew) eq protocol($port))
|
|
{
|
|
push(@services_changing_port, "$snew{$portnew} $port -> $portnew");
|
|
next BEGINLOOP;
|
|
}
|
|
}
|
|
|
|
if (exists($snew{$port})) # and $snew{$port} ne $s{$port} and service don't use another port
|
|
{
|
|
push(@services_renamed, "$s{$port} -> $snew{$port} ($port)");
|
|
}
|
|
else
|
|
{
|
|
push(@removed_pairs, "$s{$port} $port");
|
|
}
|
|
}
|
|
|
|
my $string_scp = join(" ", @services_changing_port);
|
|
|
|
foreach my $portnew (keys %snew)
|
|
{
|
|
if (not exists($s{$portnew}))
|
|
{
|
|
if (index($string_scp, $snew{$portnew}) == -1)
|
|
{
|
|
push(@new_pairs, "$snew{$portnew} $portnew");
|
|
}
|
|
}
|
|
}
|
|
|
|
print_pairs("Removed pairs", sort (@removed_pairs));
|
|
print_pairs("Renamed or replaced services", sort (@services_renamed));
|
|
print_pairs("Services, that changed port", sort (@services_changing_port));
|
|
print_pairs("New pairs", sort (@new_pairs));
|
|
print_pairs("Preserved pairs", sort (@preserved_pairs));
|
|
|
|
sub print_pairs
|
|
{
|
|
my $heading = shift;
|
|
my @pairs = @_;
|
|
print "\n";
|
|
print "$heading\n";
|
|
my $underline = ('-' x length($heading));
|
|
print $underline, "\n";
|
|
foreach my $pair (@pairs)
|
|
{ print $pair,"\n"; }
|
|
}
|
|
|
|
sub protocol
|
|
{
|
|
my $port = shift;
|
|
$port =~ s/.*\///;
|
|
return $port;
|
|
}
|
|
|
|
sub parse_services_file
|
|
{
|
|
my $filename = shift;
|
|
my $hashref = shift;
|
|
|
|
open(FILE, $filename) or die "cannot read $filename\n";
|
|
while (<FILE>)
|
|
{
|
|
chomp;
|
|
$_ =~ s/#.*//;
|
|
if ($_)
|
|
{
|
|
# my ($service, $port) = split(/[ \t]+/, $_); is not sufficient because of errors in xml like
|
|
# Apple Remote Desktop (Net Assistant) 3283/tcp # Net Assistant (updated 2011-11-09) [Michael_Stein]
|
|
my $service = my $port = $_;
|
|
$service =~ s:[ \t]+[0-9]+/[a-z]+.*$::;
|
|
$port =~ s:^.*[ \t]+([0-9]+/[a-z]+).*$:$1:;
|
|
$hashref->{$port} = $service;
|
|
# printf "[%s] [%s]\n", ($service, $port);
|
|
}
|
|
}
|
|
|
|
close(FILE);
|
|
}
|
|
|
|
|