#!/bin/sh
# shar:	Shell Archiver  (v1.22)
#
#	Run the following text with /bin/sh to create:
#	  README
#	  incbounces
#	  decbounces
#	  installbounces
#	  jogbounces
#
sed 's/^X//' << 'SHAR_EOF' > README &&
XHere's my qmail bounce manager, version 0.4.  It's in the public domain.
XThis is not finished software.  Your comments are solicited.
X
XIt consists of four Perl programs, installbounces, decbounces,
Xincbounces, and jogbounces.
X
Xdecbounces gets mail sent to the mailing list.  It decrements
Xeverybody's bounce counter.  To make sure that any program errors come
Xback to me, it's forwarded via a LIST-bounces address that's
Xsubscribed to the list.
X
Xincbounces gets run whenever a bounce arrives at
XLIST-owner-default.  It increments the bouncer's counter by two.  It
Xalso deals with local qmail bounces, which contain a list of bouncing
Xaddresses.  If the bounce count gets up to fifty (chosen arbitrarily),
Xafter seven days (also chosen arbitrarily), it forges an email message
Xfrom them to LIST-request, unsubscribing them.
X
Xjogbounces gets run daily at some convenient time.  It checks
Xthrough the bounce list, and sends mail to users about a month after
Xthey were deleted.  The message reminds them that they were deleted from
Xthe list, in case their mail bounce was only temporary.
X
XInstallation:
X
XCurrently it assumes that you're managing this list with the alias
Xuser.  Run installbounces with the listname on the command line.
XYou must have the mailling list set up as an ordinary list, with
Xa .qmail-list file for the list, a .qmail-list-request, and a
X.qmail-list-owner.  If you have something else as a starting point,
Xyou should install the bounce manager by hand.  Read installbounces
Xto see what it requires.
X
XWeaknesses:
X
X  o Some MTAs send delay warnings.  These have to be filtered out by
X    recognizing that they're a delay, not a bounce.  If they weren't
X    filtered out, then those users would be unsubscribed artificially
X    early.  Unfortunately, they're filtered out using a heuristic of
X    matching against certain magic strings.
X
X  o Compuserve sometimes sends two messages for each bounce, one for
X    the reason and another to return the mail.  They have the same
X    message-id, so there's some hope of recognizing them.
X
X  o The bounce counter system doesn't take the daily traffic of the
X    list into account.  If (bounces * 2 - sent) exceeds fifty after
X    seven days, we give up on them.
X
X  o Since we keep the bounce information in a file whose name is
X    the email address, we'll fail on any address with a '/' in it.
X    really ought to use a database without that restriction on its
X    keys.
X
XRussell Nelson
Xnelson@crynwr.com
X
SHAR_EOF
chmod 0644 README || echo "restore of README fails"
sed 's/^X//' << 'SHAR_EOF' > incbounces &&
X#!/usr/bin/perl
X# Put into the public domain by Russell Nelson, <nelson@crynwr.com>
X# Version 0.4 - add another warning message to be ignored.
X#               use -M to wait seven days before unsubscribing them.
X# Version 0.3 - don't unsubscribe them if they're already off the list.
X# Version 0.2 - don't unlink the file for the offending address.
X#		exit 99 if the message is only a warning.
X# Version 0.1 - botched the list-owner regexp.
X# Version 0.0 - initial release.
X
Xsub incaddr {
X	$addr = shift;
X	$fn = "bounces/$list/$addr";
X	if (-e $fn) {
X		open(HIST, "+<$fn") || die "Cannot open $fn for read/write";
X		flock(HIST, 2) || die "Cannot flock $fn";
X		$count = <HIST>;
X		seek(HIST, 0, 0);
X	} else {
X		open(HIST, ">$fn") || die "Cannot create $fn";
X		flock(HIST, 2) || die "Cannot flock $fn";
X	}
X	$count += 2;
X	print "incbounces: $addr is at $count\n";
X	print HIST "$count\n";
X	close(HIST);
X	# if fifty recent bounces and it's been seven days since the first,
X	if ($count > 50 && -M $fn > 7) {
X		$on_list = 0;
X		open(LIST, ".qmail-$list") || die "cannot open list";
X		$/="\n";
X		while(<LIST>) {
X			if (/^&$addr$/) {
X				$on_list =1;
X				last;
X			}
X		}
X		$/="";
X		close(LIST);
X		if (!$on_list) {
X			print "but $addr is not on the list\n";
X			return;
X		}
X		print "unsubscribing\n";
X		open(MAIL, "|/var/qmail/bin/qmail-inject") || die "can't run qmail-inject";
X		print MAIL "From: $addr\n".
X		           "To: $list-request\n".
X		           "Subject: unsubscribe due to excessive bounces\n".
X			   "\n\nunsubscribe\n" || die "can't write";
X		close MAIL || die "qmail-inject returned an error";
X	}
X}
X
X$list = shift;
X$_ = shift;
Xm/$list-owner-(.*)/i || die "doesn't match the list name";
X$addr = $1;
Xif ($addr) {
X	$addr =~ s/=([^=]*)$/\@$1/;
X	while(<>) {
X		exit 99 if /THIS IS A WARNING MESSAGE ONLY/;
X		exit 99 if /^Subject: WARNING: message delayed at/;
X		exit 99 if /^Subject: Warning From uucp/;
X		exit 99 if /^Subject: Returned mail: Deferred/;
X	}	
X	&incaddr($addr);
X} else {
X	$/="";
X	$_=<>; # get rid of the email header.
X	$_=<>; # get the QSBMF
X	/^Hi. This is the/ || die "This is not a qmail bounce message";
X	while(<>) {
X		last if /^-/;
X		/^<(.*)>/ || die "No recipient address";
X		&incaddr($1);
X	}
X}
SHAR_EOF
chmod 0755 incbounces || echo "restore of incbounces fails"
sed 's/^X//' << 'SHAR_EOF' > decbounces &&
X#!/usr/bin/perl
X# Put into the public domain by Russell Nelson, <nelson@crynwr.com>
X# Version 0.3 - use an @ in the address instead of =.
X# Version 0.0 - initial release
X
X$list = shift;
Xopen(LIST, ".qmail-$list") || die "couldn't open mailing list file";
Xwhile(<LIST>) {
X	chomp;
X	next if !/^&(.*)/;
X	$fn = "bounces/$list/$1";
X	next if !-e $fn;
X	open(HIST, "+<$fn") || die "Cannot open $fn even though it exists";
X	flock(HIST, 2) || die "Cannot flock $fn";
X	$count = <HIST>;
X	if ($count == 1) {
X		close(HIST);
X		unlink($fn);
X	} else {
X		seek(HIST, 0, 0);
X		print HIST ($count-1)."\n";
X		close(HIST);
X	}
X}
SHAR_EOF
chmod 0755 decbounces || echo "restore of decbounces fails"
sed 's/^X//' << 'SHAR_EOF' > installbounces &&
X#!/usr/bin/perl
X
X$list = shift;
X
X#verify our assumptions
Xdie "usage: $0 <listname>" unless $list;
Xdie "$0: Either $list isn't a mailing list, or else you didn't
Xset up the $list-request and $list-owner aliases.\n"
X	unless -e ".qmail-$list-request" && -e ".qmail-$list-owner";
X
X# add the decbounce alias to the end of the list.  We could run
X# decbounce directly from the list .qmail file, but if any errors occur
X# they would get returned to the sender, not the list owner.
Xopen(FILE, ">>.qmail-$list") || die "$0: can't open the list file: $!";
Xprint FILE "&$list-decbounce\n";
X
X# run decbounces from this alias
Xopen(FILE, ">.qmail-$list-decbounce") || die "$0: can't create $list-bounce: $!";
Xprint FILE "|./decbounces LIST\n";
X
X# run incbounces from the owner-default alias.  This gets two kinds of
X# bounces -- ones addressed by this site's qmail to owner-, and ones
X# addressed by the recipient's MTA to owner-$RECIPIENT.  The recipient
X# address gets passed to incbounces.
Xopen(FILE, ">.qmail-$list-owner-default")
X	|| die "$0: can't create $list-owner-default: $!";
Xprint FILE "|./incbounces LIST $EXT\n";
X
X# keep a database of bouncing addresses.
Xmkdir("bounces", 0755);
Xmkdir("bounces/$list", 0755) || die "$0: can't create bounces/$list: $!";
X
X# add jogbounces to our crontab.  Presumes vixie-cron.
Xopen(CRONTAB, "crontab -l|") || die "$0: can't get crontab: $!";
X@crontab = <CRONTAB>;
Xclose CRONTAB || die "$0: can't close crontab after reading: $!";
X
Xopen(CRONTAB, "|crontab -") || die "$0: can't set crontab: $!";
Xprint CRONTAB @crontab;
Xprint "34 0 * * * ./jogbounces $list\n";
Xclose CRONTAB || die "$0: can't close crontab after writing: $!";
SHAR_EOF
chmod 0755 installbounces || echo "restore of installbounces fails"
sed 's/^X//' << 'SHAR_EOF' > jogbounces &&
X#! /usr/bin/perl
X# -*- Perl -*-
X# Put into the public domain by Russell Nelson, <nelson@crynwr.com>
X# Version 0.4 ignore any filenames without an '@' in them.
X#              use perl's -M file test operator to compute age
X
X$list = shift;
Xopendir(DIR, "bounces/$list") || die "cannot open bounces directory";
X@files = readdir(DIR);
Xclosedir(DIR);
Xforeach (@files) {
X	next unless m/\@/;
X	if (-M "bounces/$list/$_" > 30) {
X		open(MAIL, "|/var/qmail/bin/qmail-inject -f discard") || die "unable to start mail";
X		print MAIL "
XTo: $_
XReply-To: $list-request
XFrom: $list-owner
XSubject: reminder
X
XHi.  About a month ago, we signed you off the $list mailing
Xlist because your mail was bouncing.  If you want to re-subscribe
Xto the mailing list, all you have to do is reply to this message.
XIf you want to remain off the mailing list, do nothing.
X";
X	close(MAIL);
X	unlink("bounces/$list/$_") || die "unable to unlink $list/$_";
X	print "Reminder sent to $_\n";
X	}
X}
SHAR_EOF
chmod 0755 jogbounces || echo "restore of jogbounces fails"
exit 0

.