InfoMagic Internet Tools 1995 April/Internet Tools.iso/mail/listserv/utils/better-redux.pl.Z/better-redux.pl

Internet Message Format | 1993-10-25 | 9.8 KB

From bahainvs![e-mail] Sun Oct 24 14:20:57 1993
Return-Path: <bahainvs![e-mail]>
Received: from mimsy.cs.umd.edu by cs-mail.bu.edu (5.61+++/Spike-2.1)
    id AA23292; Sun, 24 Oct 93 14:20:53 -0400
Received: from bahainvs.UUCP
    by mimsy.cs.UMD.EDU (5.64/UMIACS-0.9/04-05-88)
    id AA10406; Sun, 24 Oct 93 14:20:52 -0400
Received: by bahainvs.org
    id m0or9tg-000KgjC; Sun, 24 Oct 93 14:10 EDT
Message-Id: <[e-mail]>
From: [e-mail] (John Wiegley)
Subject: A new version of redux, and a command-line utility for ListProc 6.0
To: [e-mail] (Anastasios Kotsikonas)
Date: Sun, 24 Oct 1993 14:10:31 EDT
In-Reply-To: <[e-mail]> from "Anastasios Kotsikonas" at Oct 21, 93 11:28:49 am
Reply-To: [e-mail]
X-Mailer: ELM [version 2.4 PL22]
Content-Type: text
Content-Length: 9196
Status: RO

Tasos,

First, here's a new version of "redux", rewritten in perl, along with a
program called "mgzip", which I use to archive mailboxes rather than
just "gzip".  That is, of course, unless your users really WANT all
those e-mail headers.  I figure that they can have them if they're
non-digested, but if they aren't, they can live with straight text and
very few headers.

(This script is about 4 times slower, but much more complete than
 the shell version.  That is, it ONLY finds matches inside of
 headers.)

---[ file: redux ]---
#!/usr/bin/perl

open(FILE, $file = shift(@ARGV));
open(TMP, "> /tmp/redux.$$");
select TMP;

while( <FILE> )
{
    study;

    $inheader = 1            if( ! $inheader && /^From / );
    print, next            if( ! $inheader );
    $inheader = 0, print, next    if(   $inheader && /^\n/ );

    /^Apparently-/            && next;
    /^Approved-By:/            && next;
    /^Comment:/            && next;
    /^Content-/            && next;
    /^Date:/            && next;
    /^Delivered-By-The-Graces-Of:/    && next;
    /^Errors-To:/            && next;
    /^In-Reply-To:/            && next;
    /^M[Ii][Mm][Ee]-/        && next;
    /^Mail-System-Version:/        && next;
    /^Mailer:/            && next;
    /^Message-[Ii]d:/        && next;
    /^Newsgroups:/            && next;
    /^Organization:/        && next;
    /^Originator:/            && next;
    /^Posted-Date:/            && next;
    /^Precedence:/            && next;
    /^Received/            && next;
    /^References:/            && next;
    /^Resent-/            && next;
    /^Return-Path:/            && next;
    /^Return-Receipt-To:/        && next;
    /^Sender:/            && next;
    /^Status:/            && next;
    /^Version:/            && next;
    /^X-/                && next;
    /^X400-/            && next;
    /^\s+/                && next;

    print;
}

close(FILE);
close(TMP);

exec("mv /tmp/redux.$$ $file");

---EOF---
---[ file: mgzip ]---
#!/usr/bin/perl

$flag = shift(@ARGV);

foreach $file ( @ARGV )
{
    if( $file !~ /\.gz$/ )
    {
        system("redux $file");
        system("gzip $flag $file");
    }
}
---EOF---

Also, here's a command-line interface for ListProcessor.  I
prefer this to the e-mail interface when I'm on my home computer.

---[ file: prc ]---
#!/usr/bin/perl

$listproc    = "/usr/listserv";    # SET TO LISTPROCESSOR HOMEDIR DIRECTORY

#
# Filename:    prc    - ListProcessor Control Program
#
# Purpose:    to facilitate command-line manipulation of
#        mailing list user accounts.
#
# Notes:    to apply any command to a file containing
#        multiple addresses/lists, use the features
#        of your shell.  Such functionality is not
#        necessary to 'prc'.
#

if( ! @ARGV
    || $ARGV[0] =~ /^-h/
    || $ARGV[1] =~ /^-h/ )
{
    print <<"EOH";        # End of Help
usage: $0 option [list_alias] [address [full_name]]

    -a   Add a person to a list
    -d   Delete a person from a list
    -t   Tempdown an address
    -b   Put a user on the "digest" program
    -l   List all addresses that have been tempdown'd
    -i   Reinstate a tempdown'd address
    -r   Reject a person (make them unauthorized)
    -p   Request further information from a person
    -f   Find a subscriber on any list
    -h   This help message

EOH
    exit 0;
}

if( @ARGV == 1 && $ARGV[0] =~ /^-a/ )
{
    warn "This option requires a list_alias.\n";
    exit 1;
}

if( @ARGV == 2 && $ARGV[0] =~ /^-[dbltirp]/ )
{
    warn "This option requires a list_alias and address.\n";
    exit 1;
}

$list = $ARGV[1];
$list =~ tr/[a-z]/[A-Z]/;

$dir = "$listproc/lists/$list";

if( $ARGV[0] =~ /^-a/ )
{
    if( @ARGV == 2 )
    {
        print "\n    Enter the person's full name: ";
        $name = <STDIN>;

        print   "        And their e-mail address: ";
        $address = <STDIN>;
        $address =~ tr/[a-z]/[A-Z]/;
        }
        else
        {
            $address = $ARGV[2];

            shift(@ARGV);
            shift(@ARGV);
            shift(@ARGV);

            if( @ARGV )
            {
                $name = join(" ", @ARGV);
            }
        }
    $address =~ tr/[a-z]/[A-Z/;
    $list =~ tr/[A-Z]/[a-z]/;

    open(SUBS, "$dir/.subscribers")
        || die "Can't open $dir/.subscribers: $!\n";

    while( <SUBS> )
    {
        if( /$address/o )
        {
            warn "$address is already on the $list list.\n";
            close(SUBS);
            exit 1;
        }
    }

    open(SUBS, ">> $dir/.subscribers")
        || die "Can't open $dir/.subscribers: $!\n";

    print SUBS "$address ACK pass NO $name\n";
    close(SUBS);
        print "\n";

    &MailFile("$dir/.welcome", $address,
        "Welcome to the $list mailing list!");

    exit 0;
}
elsif( $ARGV[0] =~ /^-([tidb])/ )
{
    $option = $1;

    open(TMP, "> /tmp/tt.$$");
    select TMP;

    $list =~ tr/[A-Z]/[a-z]/;

    open(SUBS, "$dir/.subscribers")
        || die "Can't open $dir/.subscribers: $!\n";

    while( <SUBS> )
    {
        if( /${ARGV[2]}/io )
        {
            $found = 1;
        }
    }

    if( !$found )
    {
        warn "$ARGV[2] not found on the $list list.\n";
        unlink("/tmp/tt.$$");
        close(SUBS);
        exit 1;
    }

    seek(SUBS, 0, 0);        # rewind

    while( <SUBS> )
    {
        if( /${ARGV[2]}/io )
        {
            next if( $option eq "d" );

            @line = split(" ", $_);
            $line[1] = ($option eq "t") ? "POSTPONE" :
                    (($option eq "b") ? "DIGEST" : "ACK");
            $_ = join(" ", @line);

            print $_, "\n";
        }
        else
        {
            print;
        }
    }

    close(SUBS);
    close(TMP);

    exec("mv /tmp/tt.$$ $dir/.subscribers")
        || die "Can't execute 'mv': $!\n";

    &MailFile("$dir/.removed", $address,
        "You have been removed from the $list mailing list");
}
elsif( $ARGV[0] =~ /^-l/ )
{
    open(SUBS, "$dir/.subscribers")
        || die "Can't open $dir/.subscribers: $!\n";

    while( <SUBS> )
    {
        if( /POSTPONE/io )
        {
            @line = split(" ", $_);
            print $line[0], "\n";
        }
    }
    close(SUBS);
}
elsif( $ARGV[0] =~ /^-r/ )
{
    open(IGN, ">> $dir/.ignored")
        || die "Can't open $dir/.ignored: $!\n";

    print IGN "$ARGV[2]\n";
    close(IGN);
}
elsif( $ARGV[0] =~ /^-p/ )
{
    &MailFile("$dir/.moreinfo", $ARGV[2],
        "Re: Your subscription request; more info is needed..");
}
elsif( $ARGV[0] =~ /^-f/ )
{
    $dir = "$listproc/lists";

    open(DIRS, "find $dir -type d -print |")
        || die "Can't open 'find' pipe: $!\n";

    $junk = <DIRS>;
    while( <DIRS> )
    {
        /([^\/\n]*)$/;

        $list = $1;
        open(FILE, "$dir/$list/.subscribers")
            || die "Can't open $dir/$list/.subscribers: $!\n";

        $title = 0;
        $list =~ tr/[A-Z]/[a-z]/;

        while( <FILE> )
        {
            next if( ! /${ARGV[1]}/i );

            $title = 1 if( /${ARGV[1]}/i && $title == 0 );
            if( $title == 1 )
            {
                print "   --> $list\n";
                $title = 2;
            }
            print;
        }
        close(FILE);
    }

    close(DIRS);
}

#
# Function:    MailFile
#
# Purpose:    to send a file via e-mail
#
# Vars:        $_[0]    - name of file to send
#        $_[1]    - address of recipient
#        $_[2]    - subject text
#
# Notes:    this function uses Elm's 'fastmail'.  You should
#        rewrite this function to use whatever mailer is
#        available on your system.  (Note that any requests
#        sent to this function are not guaranteed to be
#        printing files with e-mail headers in them).
#

sub MailFile
{
    $command = "fastmail -s \"$_[2]\" $_[0] $_[1]";

    system($command);

} # MailFile(...
---EOF---
---[ file: prc.1 ]---
.\" prc.1 by John Wiegley <[e-mail]>.
.\"
.\" $Id: prc.1,v 1.1 93/10/23 18:42:34 jw Exp Locker: jw $
.\"
.TH PRC 1 "prc 1.0"
.SH NAME
prc \- ListProcessor 6.0 Local Control Program
.SH SYNOPSIS
.B prc
[
.B options
]
[
.B list_alias
]
[
.B address
[
.B full name
] ]
.br
.SH DESCRIPTION
.I prc
is a local control utility to facilitate user management under
ListProcessor 6.0.  For those of us who find it faster to do these kinds
of things under the shell, this little utility can save a lot of complex
e-mail strings.
.PP
.I prc
is written in perl, and should run on any system with perl 4.036 (and
perhaps lower).
.SH OPTIONS
.TP 5
.B \-a
Add a user to a list.  If no address is given, one will be asked for.
If a full name is given (shell quotes are not necessary), then it will
also be used.
.TP 5
.B \-d
Delete a person from a list.  ALL occurences matching "address" will
be deleted.
.TP 5
.B \-t
Temporarily mark a user as "down".  This feature uses the POSTPONE
option to do its work.  In addition, it would probably be advantangous
for ListProcessor to have a setting like TEMPDOWN, which would cause
the tempdown'd user to receive an "Are you ok?" message every few
weeks.
.TP 5
.B \-b
Change a user's status to "DIGEST".
.TP 5
.B \-l
List all addresses that are marked as "POSTPONE"d.  This feature
can be used in a shell script (preferably called from cron) that
will ping such addresses every once in a while, to see if they're
back up yet or not.
.TP 5
.B \-i
Reinstate a user who was been tempdown'd.  Basically, this just changes
their status to ACK.  If you prefer NOACK as a default, you'll have to
change the script...
.TP 5
.B \-r
Add an address to the
.I .ignored
file.
.TP 5
.B \-p
Send the contents of the
.I .moreinfo
file to the specified address.  This is not a standard ListProcessor 6.0
file, and should be used only if you manually acknowledge subscription
requests, and require "further information" before allowing them on the
list.
.TP 5
.B \-f
List all occurences of
.I address
in all
.I .subscriber
files.  This is useful for finding out if a person is on any of your lists.
.TP 5
.B \-h
Print out the help message.
.SH BUGS
The code is kind of hard-wired to my own environment.  Also, it's not
suited for being used as a setuid script.
.PP
The default password for all users is "pass".  Perhaps in the next
version I'll support random passwords, and have an expansion variable
available for use in the
.I .welcome
file.
.SH AUTHOR
John Wiegley
<[e-mail]>
---EOF---