perl script to redeliver mail

redeliver (text/plain), 1.21 KB, created by Kristian Kallenberg on 2008-01-11 00:43:19 UTC

#!/usr/bin/perl -w

# Redelivers mail using a modified version of smtpclient
# By: Jens Hilligsoe <[e-mail]>

use strict;

if(!($#ARGV == 0)) {
        die "Usage:\n$0 maildir_mail\n";
}

my $mail = $ARGV[0];
my $to = "";
my $from = "";

sub prunefile ( $ );

# Retrive To and From envelope adresses
open (MAIL, $mail) or die "Could not open $mail: $?\n";
while(<MAIL>) {
    if(($to eq "") || ($from eq "")) {
	chop;
	(my $key, my $value) = split (/:/);
	if($key eq "X-Envelope-To") {
	    $to = $value;
	    $to =~ s/[\<\>,]//g; # Remove "<", ">" and ","
	    $to =~ s/^\s+|\s+$//g; #Remove whitespace before and after
	}
	if($key eq "X-Envelope-From") {
	    $from = $value;
	    $from =~ s/[\<\>,]//g;
	    $from =~ s/^\s+|\s+$//g;
	    if($from eq "") {
		$from = "postmaster"; # Lets see if the works out
	    }
	}
    }
}

if($to eq "") {
    prunefile($ARGV[0]); # Just nuke it if to is empty
} else {
    my $redelivercmd = "cat $ARGV[0] | smtpclient -F -S 127.0.0.1 -P 10025 -f $from $to";
    unless (system($redelivercmd) == 0 ) {
	die "Unable to redeliver: $?";
    }
    prunefile($ARGV[0]); # Clean up
}

sub prunefile ( $ ) {
    my ($file) = @_;
    unless (unlink $file) {
	die "Unable to remove mail: $?";
    }
}