OFFLIST Re: [lbo-talk] Divide and Conquer

[ravi]

At around 18/9/06 11:10 pm, Miles Jackson wrote:
> Angelus Novus wrote:
>> I do not want to exceed the posting limit, so...
> 
> At this point, I have to assume that this "I don't want to exceed the
> posting limit" and then posting to the list is an intentional strategy
> that AN uses to thumb his nose at Doug's rules.  I have a hard time
> believing that someone can repeatedly be so clueless about what the "to"
> line says in the email he or she is composing.
> 

#!/usr/bin/perl
#
# !!!! THERE ARE MUCH BETTER WAYS TO DO THIS !!!!
# !!!! untested !!!!
# !!!! needs filelocking on quota file !!!!!
# !!!! perhaps could avoid lock if we append to the file !!!!
# !!!! from: checking for email address needs more accuracy !!!!
# !!!! isn't RFC822 (and friends) compliant (ignores Reply-To: etc) !!!!
# !!!! assumes sendmail (or equiv) -- see below !!!!
#

use strict;
use Data::Dumper;

#-- configurable stuff -----------------------------------------------
$::quotafile    = "/var/mailman/quota.txt";
$::adminaddress = 'jmhayes at speakeasy.NOT';
$::sendmail     = "/usr/sbin/sendmail -t"; # use postfix/qmail?
@::special      = ('dhenwood at panix.com', 'gadfly at exitleft.org'); # ;-)
$::listname     = "lbo-talk";
$::limit        = 3;
#-- end configurable stuff --------------------------------------------

&main();
exit(0);

#---------------------------------------------------------------------------
#
sub main
{

    my($filedate, %usage);

    ($filedate, %usage) = &get_usage();

    my $accept  = 0;

    my @ltime   = localtime(time);

    my $today   = join(":", splice(@ltime, 3, 3));

    %usage      = () if( $filedate ne $today );

    my $hdrs    = "";

    my $msg     = "";

    my $from    = "";

    my $line    = "";

    while( ($line = <STDIN>) !~ /^$/ )

    {

        # TODO: need to handle other formats of From: here

        $hdrs .= $line;

        $from ||= $1 if( $line =~ /^From: [^\<]*\<(\S+\@\S+\.\S+)\>/ );

    }

    $msg .= join("", <STDIN>);

    ( $from ne "" )

        || &exiterror("No legitimate From: header! Headers:\n$hdrs\n");

    $usage{$from} ||= 0;

    if( grep(/$from/, @::special) || ($usage{$from} < $::limit) )

    {

        $usage{$from}++;

        print STDOUT "$hdrs\n$msg";

    }

    else

    {

        &return_msg($from, $msg);

    }

    # TODO: avoid costly/useless write for overquota users by saving

    #       newdate separately

    &save_usage($today, %usage);
}

#---------------------------------------------------------------------------
#
sub get_usage
{

    my $date    = "";

    my %usage   = ();

    if( open(USAGE, $::quotafile) )

    {

        chomp( $date = <USAGE> );

        while( chomp(my $line = <USAGE>) )

        {

            ( $line =~ /^(\S+) (\d+)$/ )

                || &exiterror("Invalid line in $::quotafile:\n$line\n");

            $usage{$1} = $2;

        }

        close(USAGE);

    }

    return($date, %usage);
}

#---------------------------------------------------------------------------
#
sub save_usage
{

    my $date    = shift;

    my %usage   = @_;

    open(USAGE, "> $::quotafile")

        || &exiterror("Could not write to $::quotafile: $!\n");

    print USAGE "$date\n";

    map { print USAGE "$_ $usage{$_}\n"; } keys(%usage);

    close(USAGE);
}

#---------------------------------------------------------------------------
#
sub return_msg
{

    my $user = shift;

    my $msg  = shift;

    open(MAIL, "| $::sendmail")

            || &exiterror("Failed to pipe to $::sendmail: $!\n");

    print MAIL "From: $::adminaddress\n";

    print MAIL "To: $user\n";

    print MAIL "Subject: Sorry, you are over quota on $::listname\n\n";

    print MAIL "

        We are sorry but your message below is being returned since you

        are over limit ($::limit) for today. Please post again tomorrow!

        ";

    print MAIL "\n$msg\n";

    close(MAIL)

        || &exiterror("Failed to pipe to $::sendmail: $!\n");
}

#---------------------------------------------------------------------------
#
sub exiterror
{

    my $msg = shift;

    print STDERR $msg;

    exit(1);
}

#---------------------------------------------------------------------------

-- 
Support something better than yourself: ;-)
PeTA:       http://www.peta.org/
GreenPeace: http://www.greenpeace.org/
If you have nothing better to do: http://platosbeard.org/