view release on metacpan or  search on metacpan

script/block-web-flooders  view on Meta::CPAN

        $Opts{lacks_pattern} = [map { qr/$_/ } @{ $Opts{lacks_pattern} }];
    }
}

sub connectdb {
    require DBI;
    require SQL::Schema::Versioned;

    return if $Dbh;

    $Dbh = DBI->connect("dbi:SQLite:dbname=/var/run/block-web-flooders.db");

    my $res = SQL::Schema::Versioned::create_or_update_db_schema(
        dbh => $Dbh, spec => $Dbspec);
    die "Cannot initialize DB: $res->[0] - $res->[1]" unless $res->[0] == 200;
}

sub _set_need_reload {
    $Dbh->do("INSERT OR IGNORE INTO meta (name,value) VALUES ('_need_reload',0)");
    $Dbh->do("UPDATE meta SET value=$_[0] WHERE name='_need_reload'");
}

sub _reload_data_from_db {
    my $force = shift;

    my ($need_reload) = $Dbh->selectrow_array("SELECT value FROM meta WHERE name='_need_reload'");
    return if !$force && defined $need_reload && !$need_reload;

    %Blocked = ();
    my $sth = $Dbh->prepare("SELECT * FROM blocked");
    $sth->execute;
    while (my $row = $sth->fetchrow_hashref) {
        $Blocked{ $row->{ip} } = $row->{ctime};
    }

    unshift @Messages, "(re)loaded data from db";
    _set_need_reload(0);
}

sub _init {
    connectdb();

    _reload_data_from_db(1); # force
    %Whitelisted = map { $_=>1 } @{ $Opts{whitelist_ip} };
}

sub _block_or_unblock_ip {
    my ($which, $ip, $update_messages) = @_;

    $update_messages //= 1;
    if ($which eq 'block') {
        return if $Blocked{$ip};
    } else {
        return unless $Blocked{$ip};
    }

    system(
        {
            die => ($which eq 'block' ? 1:0),
            dry_run => $Opts{dry_run},
            (capture_stderr => \my $stderr) x ($which eq 'block' ? 0:1),
        },
        "iptables", ($which eq 'block' ? "-A" : "-D"), "INPUT", "-s", $ip,
        "-p", "tcp", "-m", "multiport", "--dports", "80,443",
        "-j", "DROP",
    );
    my $now = time();
    if ($which eq 'block') {
        unshift @Messages, "$ip BLOCKED".($Opts{dry_run} ? " (dry-run)" : "")
            if $update_messages;
        $Dbh->do("INSERT OR IGNORE INTO blocked (ip,ctime) VALUES (?,?)", {}, $ip, $now);
        $Blocked{$ip} = time();
    } else {
        unshift @Messages, "$ip unblocked".($Opts{dry_run} ? " (dry-run)" : "")
            if $update_messages;
        $Dbh->do("DELETE FROM blocked WHERE ip=?", {}, $ip);
        delete $Blocked{$ip};
    }
}

sub block_ip { _block_or_unblock_ip("block", @_) }

sub unblock_ip { _block_or_unblock_ip("unblock", @_) }

sub _block_or_unblock_ips {
    my $which = shift;

    _init();

    # get IP's from command-line arguments if specified, otherwise from stdin
    my $iter;
    if (@ARGV) {
        require Array::Iter;
        $iter = Array::Iter::array_iter(\@ARGV);
    } else {
        $iter = sub { scalar <STDIN> };
    }

    while (defined(my $ip = $iter->())) {
        chomp($ip);
        unless ($ip =~ /\A$RE{ipv4}\z/) {
            warn "$PROG: Invalid IP address '$ip', skipped\n";
            next;
        }
        _block_or_unblock_ip($which, $ip, 1); # don't update messages
    }
}

sub action_block {
    _block_or_unblock_ips("block");
    _set_need_reload(1);
}

sub action_unblock {
    _block_or_unblock_ips("unblock");
    _set_need_reload(1);
}

sub action_list_blocked {
    _init();