Compare commits

...

4 Commits

Author SHA1 Message Date
Dan Church 85d9a5feca
Configure Getopt::Long with better options 2024-04-22 10:17:45 -05:00
Dan Church 7d9188c6fa
Require Perl 5.12
Fix some postfix 'if' statements too.
2023-09-04 10:50:30 -05:00
Dan Church 133b271208
Combine GetOpt::Long options 2023-09-04 10:08:36 -05:00
Dan Church 41ba29d218
Remove Perl 4 sigils (PBP) 2023-09-04 10:08:00 -05:00
1 changed files with 25 additions and 17 deletions

View File

@ -13,10 +13,10 @@
# You may NOT use this software for commercial purposes.
###############################################################################
use strict;
use 5.012;
use warnings;
use Getopt::Long qw/ GetOptions :config no_ignore_case /;
use Getopt::Long qw/ GetOptions :config bundling no_getopt_compat no_ignore_case /;
use FindBin qw//;
my %domains;
@ -25,16 +25,18 @@ my $skip = 0;
my $removed_allowed = 0;
sub add_domain_list {
my $file = shift;
foreach my $line (&read_stripped($file)) {
foreach my $line (read_stripped($file)) {
my $domain = lc $line;
++$dupes if defined $domains{$domain};
if (defined $domains{$domain}) {
++$dupes;
}
$domains{$domain} = 1;
}
}
sub add_host_file {
my $file = shift;
foreach my $line (&read_stripped($file)) {
foreach my $line (read_stripped($file)) {
my @parts = split /\s+/, $line;
die "Malformed line in $file: $line; @parts"
unless @parts > 1;
@ -47,7 +49,9 @@ sub add_host_file {
next;
}
my $domain = lc $parts[1];
++$dupes if defined $domains{$domain};
if (defined $domains{$domain}) {
++$dupes;
}
$domains{$domain} = 1;
}
}
@ -71,11 +75,9 @@ MAIN: {
my $block_ip = '0.0.0.0 ::';
my $workdir = $FindBin::RealBin;
unless (&GetOptions(
'out=s' => \$out,
'O=s' => \$out,
'i=s' => \$block_ip,
'block-ip=s' => \$block_ip,
unless (GetOptions(
'out|O=s' => \$out,
'block-ip|i=s' => \$block_ip,
)) {
exit 2;
}
@ -85,16 +87,16 @@ MAIN: {
my @allow_lists = glob "$workdir/allowlists/*.domains";
foreach my $listfile (@domain_lists) {
&add_domain_list($listfile);
add_domain_list($listfile);
}
foreach my $hostfile (@hosts_lists) {
&add_host_file($hostfile);
add_host_file($hostfile);
}
# Apply allowlists
my @allow_domains;
foreach my $allowlist (@allow_lists) {
push @allow_domains, &read_stripped($allowlist);
push @allow_domains, read_stripped($allowlist);
}
my $before = %domains;
delete %domains{@allow_domains};
@ -119,7 +121,13 @@ MAIN: {
printf STDERR "%d domains written to %s from\n", $written, $out // 'STDOUT';
printf STDERR " - %d .domains files\n", (scalar @domain_lists);
printf STDERR " - %d .hosts files\n", (scalar @hosts_lists);
printf STDERR "(%d duplicates)\n", $dupes if $dupes;
printf STDERR "(%d domains removed via allowlist)\n", $removed_allowed if $removed_allowed;
printf STDERR "(%d skipped)\n", $skip if $skip;
if ($dupes) {
say STDERR "($dupes duplicates)";
}
if ($removed_allowed) {
say STDERR "($removed_allowed domains removed via allowlist)";
}
if ($skip) {
say STDERR "($skip skipped)";
}
}