view release on metacpan or  search on metacpan

bin/wpbl  view on Meta::CPAN

#!/usr/bin/perl
#############################################################################
## wpbl helper script
## Copyright (C) 2004  Martin Ward  http://www.cse.dmu.ac.uk/~mward/
## Email: martin@gkc.org.uk
##
## This program is free software; you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 2 of the License, or
## (at your option) any later version.
##
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
## GNU General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#############################################################################
#
# Append an IP to the WPBL log with the tag "good" or "spam"
#
# Usage: wpbl -send  OR  wpbl [spam|good] < msg
#
# With no spam/good argument the script checks for an X-Spam-Votes: header.
#
# The "-send" option rotates the log, summarises it
# and sends it to WPBL_URL via curl
#
# Format of summary is:
# IP<tab>goodcount<tab>spamcount
#

use strict;
use warnings;

sub summarise();
sub rotate($);

umask 077;

(my $myname = $0) =~ s|(.*/)*||;	# strip path component from name
my $Usage = "Usage: wpbl -send  OR  wpbl [spam|good] < msg\n";
# Check for zero or one arguments:
die $Usage unless (@ARGV == 0) || (@ARGV == 1);

my $HOME = $ENV{'HOME'} || $ENV{'LOGDIR'} ||
		(getpwuid($<))[7] || die "You're homeless!\n";

my $base = "$HOME/.wpbl";
my $exclude = "$base/data/exclude";
my $log = "$base/log";
my $auth = "$base/data/auth";
my $url = "http://wpbl.pc9.org/cgi-bin/wpbl-submit.cgi";
my $request = "$base/data/request";
my $levels = 9; # Number of backup log and request files to keep

if (@ARGV && ($ARGV[0] eq "-send")) {
  # Rotate logfile, summarise and upload
  summarise();
  exit(0);
}

my ($spam, $good);
if (@ARGV && ($ARGV[0] eq "spam")) {
  $spam = 1;
  shift;
}
if (@ARGV && ($ARGV[0] eq "good")) {
  $good = 1;
  shift;
}

die $Usage if @ARGV;

# Compute a regexp of IPs to exclude:
my $excl_pat = "";

open(EX, $exclude) or die "Can't read $exclude: $!\n";
while (<EX>) {
  chomp;
  s/#.*$//;
  next unless /\S/;
  s/\s+//g;
  s/\./\\./g;
  $excl_pat .= "$_|";
}
# Remove trailing |
$excl_pat =~ s/\|$//;
$excl_pat = "^($excl_pat)";


# Slurp message from STDIN:
undef $/;
$_ = <STDIN>;

# Trim body if present:
s/\n\n.*/\n/s;

# Join broken header lines:
s/\n[ \t]+/ /g;

# Get list of IPs in Received lines:
my @ips = /\nReceived:.*?\[(\d+\.\d+\.\d+\.\d+)\]/g;

# Delete exclusions:
@ips = grep { !/$excl_pat/ } @ips;