#! /usr/local/bin/perl -w

use strict;
use warnings;

use Mail::Internet ();

# Variables to set -
my $path = '/usr/local/apache2/htdocs/blackhole/';
my $ext  = '.txt';  # WARNING:  Do Not Use HTML!
# End of user configurable items...

my (	$sec,
	$min,
	$hour,
	$mday,
	$mon,
	$year,
	$wday) = localtime;

my $lt = sprintf("%02d%02d%02d%02d%02d%4d%d", 
	$sec, $min, $hour, $mday, 
	++$mon, ($year + 1900), $wday);

$lt 	.= $ext;
$path 	.= $lt;
my $slt	= scalar localtime;
my $fh;	$fh = \*STDIN;

my $msg	= Mail::Internet->new($fh, 'Modify' => 0, 'MailFrom' => 'KEEP');

# Get all headers and body stuff...
my @headers = @{$msg->head()->header()};
my @body = @{$msg->body()};

my @message = ("\n\nThe below message was seen by this sourcer:\n",
	"This mailing was received on $slt\n",
	"Serial: $lt.\n\n",
	"=== The message's E-Mail Header, as sent:\n\n",
	@headers,
	"\n=== The message's E-Mail Body, as sent:\n\n",
	@body,
	"\n\n=== End of Message ===\n\n",
	);

# Do Not Modify this section unless you know
# the whats, whys, and wheres...
# Help ensure file locking integrity...
    use 5.004;
    use Fcntl qw(:DEFAULT :flock);
    sysopen(BLACKHOLE, "$path", O_WRONLY | O_CREAT)
        or die "can't create $path: $!";
    flock(BLACKHOLE, LOCK_EX)
        or die "can't lock $path: $!";
    truncate(BLACKHOLE, 0)
        or die "can't truncate $path: $!";
####################################################


# Now ... Just spray data out and get out fast...

print BLACKHOLE <<_EndOfHeaders_;
$path

This blackhole recently was sent:

@message

... enter any other comments ...
_EndOfHeaders_

exit;

__END__

An example of the capture and
output can be seen at -

http://insecurity.org/blackhole/
