script for generating complaints about botnets attacking a Synology NAS

nas-botnet-complaint.pl

#!/usr/bin/env perl

# Script for pulling "admin" login failure logs from a Synology NAS and
# generating complaint emails to the abuse contacts for the IP addresses in the
# logs.
#
# You need to have the NAS set up so that you can SSH into it as root to be
# able to use this script. Follow the instructions here to enable SSH to the
# admin accounts:
# https://kb.synology.com/en-us/DSM/tutorial/How_to_login_to_DSM_with_root_permission_via_SSH_Telnet
# Then follow the instructions here to enable ssh for root:
# https://3os.org/infrastructure/synology/enable-ssh-root-login/
# except instead of setting a root password I recommend adding an SSH public
# key to /root/.ssh/authorized_keys so that you can SSH in securely without
# a password.
#
# Edit the config section below before using the script.
#
# I don't really have time to fully document the script, so you'll have to read
# it to figure out what it does.
#
# Copyright (c) 2025 Jonathan Kamens <[email protected]>.
#
# This script is released under the terms of the GNU General Public License,
# v3.0 or at your discretion any newer version, with the following
# modifications:
#
# * You may not use or redistribute this script if you are affiliated with any
#   entity which supports, or if you personally support, the Russian war
#   against Ukraine; acts of violence by Israel in Gaza or the West Bank; or
#   terrorist acts against Israel within its internationally recognized
#   borders.
# * You may not use or redistribute this script if you are affiliated with any
#   entity which supports, or if you personally support, the presidential
#   administration of Donald Trump.
# * You may not use or redistribute this script if you are affiliated with any
#   entity which supports, or if you personally support, a fascist or
#   authoritarian government or political movement or party in any state or
#   country.
# * If you're unsure whether any of the restrictions above apply to you, they
#   probably do. This is not complicated.

use strict;
use warnings;

use Data::Dumper;
use Digest::MD5 qw(md5);
use Email::Stuffer;
use File::Basename;
use File::Temp qw(tempfile);
use Getopt::Long;
use JSON;
use Storable;

# Host name that SSH can use to connect to the NAS.
my $nas_ssh_hostname = "FIXME";  
# Host name that resolves to the public IP address of the NAS, or the actual
# IP address if there is no host name that results to the public IP.
my $nas_ip_hostname = "FIXME";  
# Path to a file on disk where the script's state can be stored between
# invocations.
my $db_file = "FIXME";  
# Your email address, to be used in the From line of the complaint emails.
# Remember to put a backslash before the @ sign.
my $me = "FIXME";  
# Email address to BCC copies of all complaint emails. Set to undef if you
# don't want to receive copies.
my $bcc_address = $me;
# Email address to send complaints to instead of the actual abuse inboxes, if
# --test-email is specified on the command line.
my $test_addr = "FIXME";  
my $whoami = basename $0;
my $usage = "Usage: $whoami [--no-send] [--dry-run] [--test-email] [--reset]
        [--block=address] [--edit-db] [--set-last=log-line]\n";
my $complaint_period = 24 * 60 * 60; # one day

my $db;
my($no_send, $dry_run, $test_email, $reset, $block, $edit_db, $set_last);

die $usage if (! GetOptions("no-send" => \$no_send,
                            "dry-run" => \$dry_run,
                            "test-email" => \$test_email,
                            "reset" => \$reset,
                            "block=s" => \$block,
                            "edit-db" => \$edit_db,
                            "set-last=s" => \$set_last));

if (-f $db_file) {
    $db = retrieve($db_file) or die;
}
else {
    $db = {};
}

END {
    if (!$dry_run and %{$db}) {
        store($db, $db_file);
    }
}

$db->{block} = {} if (! $db->{block});
$db->{groups} = {} if (! $db->{groups});
$db->{timestamps} = {} if (! $db->{timestamps});
$db->{counters} = [] if (! $db->{counters});

my $nas_ip = &get_nas_ip;
my $now = time;
my $then = $now - $complaint_period;

if ($edit_db) {
    my($fh, $filename) = tempfile();
    my $pid = open(JQ, "|-");
    die if (! defined($pid));
    if ($pid) {
        # Parent
        print(JQ encode_json($db)) or die;
        close(JQ);
    }
    else {
        # Child
        open(STDOUT, ">", $filename) or die;
        exec("jq") or die;
    }
    system($ENV{"EDITOR"}, $filename) and die;
    my $encoded;
    {
        local($/) = undef;
        $encoded = <$fh>;
    }
    my $ref = decode_json($encoded) or die;
    $db = $ref;
    exit;
}

if ($block) {
    if ($db->{block}->{lc $block}) {
        print("$block is already blocked\n");
    }
    else {
        print("Blocking $block\n");
        $db->{block}->{lc $block} = 1;
    }
    exit;
}

my(@logs) = &get_logs;
if (! @logs) {
    print("No logs\n");
    exit;
}

if ($reset) {
    print("Resetting to $logs[-1]");
    $db->{last_log} = $logs[-1];
    exit;
}

if ($set_last) {
    if ($set_last !~ /\n$/s) {
        $set_last .= "\n";
    }
    if (! grep($_ eq $set_last, @logs)) {
        die "Bad log: $set_last";
    }
    $db->{last_log} = $set_last;
    exit;
}

&group_logs(@logs);
$db->{last_log} = $logs[-1];

foreach my $ip (keys %{$db->{timestamps}}) {
    if ($db->{timestamps}->{$ip} < $then) {
        delete $db->{timestamps}->{$ip};
    }
}

foreach my $ip (keys %{$db->{groups}}) {
    if ($db->{timestamps}->{$ip}) {
        print("Skipping complaint for $ip, too soon\n");
        next;
    }
    my $ip_logs = $db->{groups}->{$ip};
    &report($ip, $ip_logs);
    $db->{timestamps}->{$ip} = $now;
    delete $db->{groups}->{$ip};
}

my $ip_count = scalar keys %{$db->{timestamps}};
print("$ip_count recent IPs\n");
push(@{$db->{counters}}, [$now, $ip_count]);

sub get_nas_ip {
    if ($nas_ip_hostname =~ /^[\d.]+$/) {
        return $nas_ip_hostname;
    }
    my $host_output = `host $nas_ip_hostname`;
    die if ($host_output !~ /has address (\S+)/);
    return $1;
}
   
sub get_logs {
    local($_);
    my $i = 0;
    my $last_index;
    my(@cmd) = ("ssh", "-a", "-x", "root\@$nas_ssh_hostname", "(xzcat /var/log/auth.log.1.xz; cat /var/log/auth.log) | grep -E 'authentication failure.*ruser=.+ +user=admin'");
    my(@logs);
    open(SSH, "-|", @cmd) or die;
    while (<SSH>) {
        push(@logs, $_);
        if (!defined($last_index) and $db->{last_log} and
            $_ eq $db->{last_log}) {
            $last_index = $i;
        }
        $i++;
    }
    if ($last_index) {
        splice(@logs, 0, $last_index+1);
    }
    return(@logs);
}

sub group_logs {
    local($_);
    my(@logs) = @_;
    my($groups) = $db->{groups};
    
    for (@logs) {
        my($ip) = /rhost=(\S+)/ or die "Bad log: $_";
        if ($groups->{$ip}) {
            push(@{$groups->{$ip}}, $_);
        }
        else {
            $groups->{$ip} = [$_];
        }
    }
}

sub report {
    my($ip, $logs) = @_;
    my(@addresses) = &get_abuse_addresses($ip);
    if (! @addresses) {
        print("No abuse addresses for $ip\n");
        return;
    }

    my $msg = <<EOF . join("", @{$logs});
There is a botnet attempting to break into my NAS, whose public IP address is
$nas_ip.

A device on your network with the IP address $ip has been compromised
and is part of the botnet.

Please see the log entries below showing failed logins from that IP address to
my NAS. The timestamps in the log entries are in the US/Eastern timezone.

Please do the needful.

Thank you.

Log entries:

EOF

    if ($test_email) {
        @addresses = ($test_addr);
    }

    if (!$no_send and ($test_email or !$dry_run)) {
        my(@to) = @addresses;
        if ($bcc_address) {
            push(@to, $bcc_address);
        }
        Email::Stuffer
            ->from($me)
            ->to(@addresses)
            ->subject("Device on your network at $ip compromised by botnet")
            ->text_body($msg)
            # Because ->bcc doesn't work. D'oh.
            ->send({to => \@to}) or die;
    }
    print("Complaint sent for $ip\n");
}

sub get_abuse_addresses {
    my($ip4) = @_;
    my(%addrs, @addrs);
    my(@whois_output) = `whois $ip4`;
    my(@abuse_lines) = grep(/abuse/i, @whois_output);
    my $digest = md5("@abuse_lines");
    if ($db->{addrs}->{$digest}) {
        @addrs = @{$db->{addrs}->{$digest}};
        @addrs = grep(! $db->{block}->{lc $_}, @addrs);
        return(@addrs);
    }
    print("Abuse lines in whois output:\n\n", @abuse_lines, "\n");
    for (@abuse_lines) {
        my(@fields) = split(/[\(\)\<\>\:\'\"\s]+/);
        foreach my $addr (grep(/\@/, @fields)) {
            $addr =~ s/\.+$//;
            next if ($addr eq "\@");
            $addrs{lc $addr} = $addr;
        }
    }
    @addrs = sort values %addrs;
    @addrs = grep(! $db->{block}->{lc $_}, @addrs);
    while (1) {
        last if (! @addrs);
        print("\nAbuse addresses:\n\n");
        for (my $i = 0; $i < @addrs; $i++) {
            print($i + 1, ". ", $addrs[$i], "\n");
        }
        print("\n");
        print(STDERR "Enter # to exclude or Enter to proceed: ");
        my $answer = <STDIN>;
        if (! $answer) {
            print("Exiting on EOF\n");
            exit;
        }
        chomp $answer;
        last if (! $answer);
        if ($answer !~ /^[1-9][0-9]*$/ or $answer > @addrs) {
            print("Bad response\n");
            next;
        }
        splice(@addrs, $answer - 1, 1);
    }
    @addrs = &transform_addresses($ip4, @addrs);
    $db->{addrs}->{$digest} = \@addrs;
    return(@addrs);
}

sub transform_addresses {
    local($_);
    my($ip, @old) = @_;
    my(@new);
    for (@old) {
        my $new = &transform_address($ip, $_, @old);
        if ($new) {
            push(@new, $new);
        }
    }
    return(@new);
}

sub transform_address {
    my($ip, $addr, @all) = @_;
    if (lc $addr eq "abuse-contact\@iij.ad.jp" and
        `host $ip` =~ /\.bbexcite\.jp\.?$/i) {
        return "abuse-isp\@excite.jp";
    }
    if (lc $addr eq "abuse\@ocn.ad.jp" and
        grep(lc $_ eq "super\@plala.or.jp", @all)) {
        return undef;
    }
    return $addr;
}