From: tchrist@convex.COM (Tom Christiansen)
Newsgroups: comp.lang.perl
Subject: Re: Perl "mail munger"
Date: 21 Aug 92 13:28:46 GMT
Reply-To: tchrist@convex.COM (Tom Christiansen)
Organization: Convex Computer Corporation, Colorado Springs, CO
Originator: tchrist@pixel.convex.com
X-Disclaimer: This message was written by a user at CONVEX Computer
              Corp. The opinions expressed are those of the user and
              not necessarily those of CONVEX.

From the keyboard of rsnyder@atl.ge.com (Bob Snyder):
:Does anyone have a perl "mail munger" that goes thorugh the mail spool
:directory, and chops up a user's mail file if it is too large, and moves
:that piece someplace else?
:
:This seems like something perl should be good at (I'm learning perl slowly, and
:disecting a script like this would be beneficial).

Consider this....

--tom

#!/usr/bin/perl
# forwmail -- tchrist@convex.com

# ===========   begin configuration section

$DOMAIN  = '\.convex\.com';     # remember to turn off regexp magic
$ALIASES = '/usr/lib/aliases';
$SPOOL   = '/usr/spool/mail';

# ===========   end configuration section

($program = $0) =~ s,.*/,,;

$| = 1;


&source('stat.pl');
&source('getopts.pl');

&Getopts('nv') || die "usage: $program [-nv]\n";

$verbose = $opt_v;
$doit    = !$opt_n;

chop($hostname = `hostname`);
($host = $hostname) =~ s/$DOMAIN//;  # chop domainname

print "running $program on $host";
print " ($hostname)" if $host ne $hostname;
print "\n";

chdir $SPOOL || die "absurd chdir failure to $SPOOL: $!";

unless (-f "$ALIASES.pag" && dbmopen(aliases, $ALIASES, 0644)) {
    $slow++;
    print "no dbm file: doing aliases the hard way\n";
    print STDERR "can't open dbm file $ALIASES: $!\n";
    open ALIASES || die "couldn't read $ALIASES: $!";
    while (<ALIASES>) {
	next if /^#/ || ! /^(\S+)\s*:\s+(.*)/;
	$aliases{$1} = $2;
    } 
    close ALIASES;
}

foreach $mbox ( <*> ) {
    
    unless (&Stat($mbox)) {
	print STDERR "couldn't stat $mbox: $!\n";
	next;
    } 

    if (!($alias = $aliases{$slow ? $mbox : "$mbox\000" })) {
	if ($st_size == 0) {
	    print "deleting zero-length non-mbox $mbox\n";
	    if ($doit) {
		unlink($mbox) || print STDERR "can't unlink $mbox: $!\n";
	    }
	    next;
	} 
	print "forwarding bogus mbox $mbox to postmaster\n";
	if ($doit) {
	    unless (rename($mbox, "$mbox.$$")) {
		print STDERR "can't rename $mbox to $mbox.$$: $!\n";
		next;
	    }
	    system "Mail -s 'bogus mailbox from $mbox@$host' postmaster < $mbox.$$";
	    unlink("$mbox.$$") || print STDERR "can't unlink $mbox.$$: $!\n";
	}
	next;
    }  

    chop($alias) unless $slow;
    $alias =~ s/^\s*(.*)\s*$/$1/g;
    $alias =~ s/$DOMAIN//g;

    if ($alias eq "$host!$mbox"  || 	# uucp style alias to me
	$alias eq "$mbox@$host"  || 	# inet style alias to me
	$alias eq $mbox          || 	# no host specified
	$alias eq "localhost!$host") 	# strange alias
    {
	print "ok for $mbox to live on $host, as alias is $alias\n" 
	    if $verbose;
	next;
     } 

    if ($st_size == 0) {
	print "deleting zero-length mbox $mbox\n";
	if ($doit) {
	    unlink($mbox) || print STDERR "can't unlink $mbox: $!\n";
	}
	next;
    } 


    print "forwarding misdelivered $mbox to $alias "; 

    unless ($doit) {
	print "\n";
	next;
    } 

    $alias = $mbox if $alias =~ /\|/;

    unless (rename($mbox, "$mbox.$$")) {
	print STDERR "can't rename $mbox to $mbox.$$: $!\n";
	next;
    }

    unless (open(mbox, "$mbox.$$")) {
	print STDERR "can't read $mbox: $!\n";
	next;
    }

    $mail = '';
    $count = 0;
    $status = 0;
    while (<mbox>) {
	if (/^From\s/) {
	    if ($mail) {
		chop($mail);
		$status |= &send($mail, $alias);
		$mail = '';
	    } 
	} else {
	    $mail .= $_;
	} 
    } 
    $status |= &send($mail, $alias) if $mail;

    printf "%d piece%s\n", $count, $count == 1 ? "" : "s";

    printf "\ttotal size %d, age %s\n", $st_size, &dtime(time - $st_mtime) 
	if $verbose;

    if ($status) {
	print STDERR "bad status from mail: $status\n";
	next;
    } 

    unlink("$mbox.$$") || print "$mbox.$$ disappeared!\n";
}


###########################################################################
sub source {
    local($file) = @_;
    local($return) = 0;

    $return = do $file;
    die "couldn't parse $file: $@" if $@;
    die "couldn't do $file: $!" unless defined $return;
    die "couldn't run $file" unless $return;
    $return;
}

###########################################################################

sub dtime {
    local($seconds) = $_[0];
    local($days,$hours,$minutes, $retval);

    $days =  int($seconds  / (24 * 3600));
    $seconds -= $days * (24 * 3600);

    $hours =  int($seconds / 3600);
    $seconds -= $hours * 3600;

    $minutes =  int($seconds / 60);
    $seconds -= $minutes * 60;

    $retval =  "$days days" if $days;

    if ($hours) {
	$retval .= ", " if $retval;
	$retval .= "$hours hours";
    }

    if ($minutes) {
	$retval .= ", " if $retval;
	$retval .= "$minutes minutes";
    }

    if ($seconds) {
	$retval .= ", " if $retval;
	$retval .= "$seconds seconds";
    }

    $retval;
} 

sub send {
    local($text, $whom) = @_;
    $count++;

    printf "\tpiece %d, size %-5d\n", $count, length($text) if $verbose;

    open (PIPE, "|/usr/lib/sendmail -odq -oi -t");
    print PIPE "Resent-to: $alias\n";
    print PIPE "Resent-comment: lost mail for $mbox found on $host\n";
    print PIPE $text;
    !close PIPE;
} 
-- 
    Tom Christiansen      tchrist@convex.com      convex!tchrist
There are probably better ways to do that, but it would make the parser
more complex.  I do, occasionally, struggle feebly against complexity...  :-)
            --Larry Wall in <7886@jpl-devvax.JPL.NASA.GOV>