you-dont-need-pihole/make-block.pl

124 lines
3.4 KiB
Perl
Raw Normal View History

2021-01-30 03:26:05 +00:00
#!/usr/bin/perl
###############################################################################
# You Don't Need Pi-hole
# Network-wide DNS blocking without extra hardware.
#
# Project URL: https://codeberg.org/h3xx/you-dont-need-pihole
#
# License GPLv3: GNU GPL version 3.0 (https://www.gnu.org/licenses/gpl-3.0.html)
# with Commons Clause 1.0 (https://commonsclause.com/).
# This is free software: you are free to change and redistribute it.
# There is NO WARRANTY, to the extent permitted by law.
# You may NOT use this software for commercial purposes.
###############################################################################
2021-01-30 03:26:05 +00:00
use strict;
use warnings;
use Getopt::Long qw/ GetOptions :config no_ignore_case /;
use FindBin qw//;
2021-01-30 03:26:05 +00:00
my %domains;
my $dupes = 0;
my $skip = 0;
2022-11-25 22:15:13 +00:00
my $removed_allowed = 0;
2021-01-30 03:26:05 +00:00
sub add_domain_list {
my $file = shift;
2023-09-04 15:08:00 +00:00
foreach my $line (read_stripped($file)) {
2021-01-30 03:26:05 +00:00
my $domain = lc $line;
++$dupes if defined $domains{$domain};
$domains{$domain} = 1;
}
}
sub add_host_file {
my $file = shift;
2023-09-04 15:08:00 +00:00
foreach my $line (read_stripped($file)) {
2021-01-30 03:26:05 +00:00
my @parts = split /\s+/, $line;
die "Malformed line in $file: $line; @parts"
unless @parts > 1;
if (lc $parts[0] eq lc $parts[1]) {
++$skip;
next;
}
unless (lc $parts[0] eq '0.0.0.0') {
++$skip;
next;
}
my $domain = lc $parts[1];
++$dupes if defined $domains{$domain};
$domains{$domain} = 1;
}
}
sub read_stripped {
my $file = shift;
open my $fni, '<', $file
or die "Failed to open file $file for reading: $!";
map {
chomp;
# Strip whitespace and comments
s/^\s+|\s+$|\s*#.*$//;
$_ || ()
} <$fni>;
}
2021-01-30 03:26:05 +00:00
MAIN: {
my $out;
my $block_ip = '0.0.0.0 ::';
my $workdir = $FindBin::RealBin;
2021-01-30 03:26:05 +00:00
2023-09-04 15:08:00 +00:00
unless (GetOptions(
2023-09-04 15:08:36 +00:00
'out|O=s' => \$out,
'block-ip|i=s' => \$block_ip,
2021-01-30 03:26:05 +00:00
)) {
exit 2;
}
my @domain_lists = glob "$workdir/lists/*.domains";
my @hosts_lists = glob "$workdir/lists/*.hosts";
2022-11-25 22:15:13 +00:00
my @allow_lists = glob "$workdir/allowlists/*.domains";
2021-01-30 03:26:05 +00:00
foreach my $listfile (@domain_lists) {
2023-09-04 15:08:00 +00:00
add_domain_list($listfile);
2021-01-30 03:26:05 +00:00
}
foreach my $hostfile (@hosts_lists) {
2023-09-04 15:08:00 +00:00
add_host_file($hostfile);
2021-01-30 03:26:05 +00:00
}
2022-11-25 22:15:13 +00:00
# Apply allowlists
my @allow_domains;
foreach my $allowlist (@allow_lists) {
2023-09-04 15:08:00 +00:00
push @allow_domains, read_stripped($allowlist);
2022-11-25 22:15:13 +00:00
}
my $before = %domains;
delete %domains{@allow_domains};
# Count number removed
$removed_allowed = $before - %domains;
2021-01-30 03:26:05 +00:00
my $written = 0;
my $fho = \*STDOUT;
if (defined $out && length $out) {
open $fho, '>', $out
or die "Failed to open file $out for writing: $!";
}
2022-10-09 18:28:57 +00:00
my @block_ip = sort split /\s+/, $block_ip;
2021-01-30 03:26:05 +00:00
print $fho map {
++$written;
2022-10-09 18:28:57 +00:00
my $domain = $_;
map {
"$_ $domain\n"
} @block_ip;
2021-01-30 03:26:05 +00:00
} sort keys %domains;
2023-07-11 16:54:52 +00:00
printf STDERR "%d domains written to %s from\n", $written, $out // 'STDOUT';
2021-01-30 03:26:05 +00:00
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;
2022-11-25 22:15:13 +00:00
printf STDERR "(%d domains removed via allowlist)\n", $removed_allowed if $removed_allowed;
2021-01-30 03:26:05 +00:00
printf STDERR "(%d skipped)\n", $skip if $skip;
}