#!/usr/bin/perl -w
# Receive attachments by email, store them & mail the sender URLs to the attachments.
# Run with --help for quick usage.
# Author: Alain D D Williams  <addw@phcomp.co.uk> of Parliament Hill Computers, http://www.phcomp.co.uk.
# Copyright (C) the Author 2006, all rights reserved.
# For licensing information see the LICENSE that came with the program.
# SCCS: @(#)MailToUrl	1.18 05/09/11 17:15:14

use strict;
use MIME::Parser;
use Data::Dumper;
use File::Copy;
use POSIX qw(strftime);
use Fcntl ':flock';
use Sys::Hostname;

my ($progname) = $0 =~ m|([^/]+)$|;

use constant KILO => 1024;

# Eventual generated is: $protocol://$domain/$ProtoRoot$mailbox/$AttachmentName
# Stored at: $FileDirRoot/$mailbox/$AttachmentName
my $protocol = 'http';			# Could be ftp
my $domain = hostname();		# Domain where this hangs off
my $ProtoRoot = '';			# From root to the files directory when access via $protocol
my $EmailFrom;				# Where the sender address is
my $EmailReplyTo;			# Where to reply to
my $FileDirRoot = "/var/www/files";	# Where we put files
my $FileDir;				# For this instance
my $StatFile = '.list';			# Update this with list of files
my $LogFile = "/var/log/$progname";	# Where we record what we did
my $LogTime = strftime("%Y-%m-%d %H:%M:%S", localtime);
my %FileInfo;
my $Update = 0;				# If true write list back
my $newfile = 0;			# True if at least one file put up
my $FoundPart = 0;			# If true we found a mime part in the mail
my $Quota;				# Quota in KiB, no limit if 0
my $MaxNameLen = 32;			# Check ListFiles() if you change this
my $DiskUsed;
my $DiskUsedK;
my $LogOpen = 0;			# True if LOG open
my $purge = 0;				# Purging
my $SayPurged = 0;			# Tell a file owner if a file of their's has been purged
my $WarnPurge = 0;			# # days in advance of a purge to warn a file owner that the file will go
my $UserFile;				# File that contains users one per line. Lines starting '.' preserved
my $UserReadOnly = 0;			# True if only able to read the user file

# The next 2: key is email, value array ref of file names
my %WarnPurges;				# Warn file owner of impending file purge
my %TellPurges;				# Tell file owner that file removed

my $WorkDir = "/var/tmp";
my $wd;

my $MinSize;				# Min size of file to be kept - Kibytes
my $MaxSize;				# Max size of file to be kept - Kibytes

my %periods = (		# Time periods in seconds
	day	=>	86400,
	week	=>	86400 * 7,
	month	=>	86400 * 31,
	year	=>	86400 * 366,
);
my $Keep;				# How long to keep a file. Units change: initially days, then seconds
my $now = time;
my ($Expire, $ExpireStr);

my $Reply = '';				# What we send back to the user

my ($mailbox, $sender, $subject);	# Command line args. $mailbox is where the mail was received

# Parameters that can be tweaked.
# Hash: key is parameter, value is array: [0] description, [1] default value, [2] ref to var, [3] RE for a value
my %ParmDesc = (
	MinSize		=> ['minimum size attachment that will be archived (unit KiBytes)', 2, \$MinSize, '\d+'],
	MaxSize		=> ['maximum size attachment that will be archived (unit KiBytes)', 2 * KILO, \$MaxSize, '\d+'],
	Quota		=> ['maximum total size of all files that will be archived (unit KiBytes), 0 means no limit', 20 * KILO, \$Quota, '\d+'],
	SayPurged	=> ["0 - don't, 1 - do: tell a file owner of their file being purged", 0, \$SayPurged, , '[01]'],
	WarnPurge	=> ['days in advance to warn that a file will be purged', 0, \$WarnPurge, '\d+'],
	KeepDays	=> ['default days to keep a file', 31, \$Keep, '\d+'],
	MaxNameLen	=> ['maximum length of an attachment (file) name', $MaxNameLen, \$MaxNameLen, '\d+'],
);

# Assign default values:
${$ParmDesc{$_}[2]} = $ParmDesc{$_}[1] foreach (sort keys %ParmDesc);

# Recurse through parts in the email that are sent:
sub Parts {
	my $mime = $_[0];
	my @parts = $mime->parts;

	if(@parts) {
		$FoundPart = 1;
		map { Parts($_) } @parts;
	} else {
		$FoundPart = 1;
		my ($fn) = $mime->bodyhandle->path =~ m|([^/]+)$|;	# Get the name

		$Reply .= "\n";		# Separate entries

		# Validate the name, be nice - people like spaces in names, replace with '_':
		$fn =~ s/ *(.*[-\w\.]) */$1/;
		$fn =~ s/ +/_/g;
		unless($fn =~ /^\w[-\w\.]+$/i) {
			$Reply .= "File name is bad, '$fn' should only contain alphanumeric, '.' and '-' characters\n";
			$fn =~ s/[^ -~]/X/g;
			print LOG "\tBad filename: $fn\n";
			return;
		}
		my @stat = stat $mime->bodyhandle->path;
		return unless(@stat);
		print LOG "\t$fn size $stat[7]\n";

		# If too small/big say so, then various other tests:
		if($stat[7] < $MinSize * KILO) {
			$Reply .= "Attachment '$fn' is too small to be archived. It is $stat[7] bytes in size\n";
		} elsif($stat[7] > $MaxSize * KILO) {
			$Reply .= "Attachment '$fn' is too large to be archived. It is $stat[7] bytes in size\n";
		} elsif(length($fn) > $MaxNameLen) {
			$Reply .= "Attachment name '$fn' is too long, longest allowed is $MaxNameLen\n";
		} elsif(exists($FileInfo{$fn}) and lc($sender) ne lc($FileInfo{$fn}[0])) {
			# Will only overwrite if it is the owner replacing it:
			$Reply .= "Attachment '$fn' already exists, owned by: $FileInfo{$fn}[0]\n";
		} elsif($Quota != 0 && $DiskUsed + $stat[7] > $Quota * KILO) {
			$DiskUsedK = int($DiskUsed / KILO);
			$Reply .= "Attachment '$fn' size $stat[7] would take the store over the quota of $Quota KiB, $DiskUsedK KiB used\n";
		} else {
			# Looks OK - copy it up:
			my $verb = exists($FileInfo{$fn}) ? 'replaced' : 'copied';
			if(move($mime->bodyhandle->path, "$FileDir/$fn")) {
				$Reply .= "Attachment '$fn' $verb, ($stat[7] bytes in size), will be removed after $ExpireStr\n" .
					"URL of the attachment:\n\t$protocol://$domain/$ProtoRoot$mailbox/$fn\n";
				print LOG "\t$fn $verb expire $ExpireStr\n";
				$newfile = 1;
				$Update = 1;
				$FileInfo{$fn} = [$sender, $Expire, $ExpireStr];
			} else {
				$Reply .= "Attachment '$fn' not $verb: $!\n";
				print LOG "\t$fn not $verb: $!\n";
			}
		}
	}
}

# Make a subdirectory into which the message will be expanded.
# (Stolen from mimeexplode).
sub MakeWorkDir {
	my	$Dn = "$WorkDir/$$";
	my	$Cnt = 1;

	while (-d "$Dn$Cnt") {
		MyDie("Can't create work directory, too many old ones\n")
			if(++$Cnt > 500);
	}

	mkdir("$Dn$Cnt", 0700) || MyDie("Can't create '$Dn$Cnt' as: $!\n");

	return "$Dn$Cnt";
}

# Remove work directory & die with message:
sub MyDie {
	print LOG $_[0] if($LogOpen);
	print MAIL $_[0];
	system "rm -rf $wd" if(defined($wd));
	exit(2);
}

# Return the disk used (in bytes)
sub DiskUsage {
	my $du = `du -sb "$FileDir/"`;
	$du =~ /^(\d+)/;
	$1;
}

# Remove a file if it is owned by the mail sender
# Args:
# 0	name of file
# 1	true if OK to delete file not owned by the sender of the email
sub DeleteFiles {
	printf LOG "%s: Delete $mailbox $sender %s\n", $LogTime, $subject;
	my $file = $_[0];
	my $admin = $_[1];
	if( !exists($FileInfo{$file})) {
		print MAIL "File '$file' does not exist and so cannot be deleted\n";
	} elsif( !$admin and lc($sender) ne lc($FileInfo{$file}[0])) {
		print MAIL "File '$file' is not owned by you, so you cannot delete it\n";
		print MAIL "It is owned by $FileInfo{$file}[0]\n";
	} elsif(unlink "$FileDir/$file") {
		print MAIL "File '$file' deleted\n";
		delete $FileInfo{$file};
		UpdateList();
	} else {
		print MAIL "File '$file' not deleted as: $!\n";
	}
	CloseMail();
	exit;
}

# Show what files there are
sub ListFiles {
	printf LOG "%s: List $mailbox $sender %s\n", $LogTime, $subject;
	close(STAT);	# Won't be updating it

	print MAIL "List of files:\n";
	printf MAIL "%-$MaxNameLen.${MaxNameLen}s Uploaded by                        Size  When uploaded          Expires\n", "Name";

	foreach my $file (sort keys %FileInfo) {
		next if($file =~ /^\./);

		my @stat = stat "$FileDir/$file";
		next unless(@stat);

		my $size = int($stat[7] / KILO);
		my $mtime = strftime("%A %d %B %Y", localtime($stat[9]));
		printf MAIL "%-$MaxNameLen.${MaxNameLen}s %-32.32s %4dKiB %-22s %-22s\n", $file, $FileInfo{$file}[0], $size, $mtime, $FileInfo{$file}[2];
	}

	print MAIL "\n";
	print MAIL "To download these files you can make the URL by prefixing the file names with:\n";
	print MAIL "\t$protocol://$domain/$ProtoRoot$mailbox/\n";

	CloseMail();
	exit;
}

# Open the mail handle to $sender, take care on return address, write headers
# If $sender starts '-' then we are being run through cron or something, dup mail on STDOUT
sub OpenMail {
	if($purge) {
		open(MAIL, ">&STDOUT");
		return;
	}
	# Do it this way so that we can get the return address correct
	my $act = 'file upload to';
	$act = "file $1 on" if($subject =~ /^(list|delete|remove)/i);
	$act = "$1 on" if($subject =~ /^(admin)/i);

	open(MAIL, '|-', "/usr/sbin/sendmail -f $EmailFrom $sender") or
		MyDie("Can't open pipe to mail: $!\n");
	my $maildate = strftime("%a, %d %b %Y %H:%M:%S %z", localtime);
	print MAIL <<End;
To: $sender
From: $EmailFrom
Reply-To: $EmailReplyTo
Subject: Result of $act $mailbox
Date: $maildate

End
}

# Append a usage message & disk stats to the mail that we send back to the user
sub CloseMail {
	$DiskUsedK = int($DiskUsed / KILO);
	print MAIL &UpHelpMsg;
	my $allowed = $Quota == 0 ? "none" : "$Quota KiB";
	print MAIL <<End;

Disk used: $DiskUsedK KiB. Quota (maximum): $allowed.

Inappropriate email may be removed without warning.
By sending a file you certify it is copyright cleared to be viewed/downloaded by anyone.
End
	close(MAIL);
}

# Update the list of files:
sub UpdateList {
	MyDie("Can't truncate: $!\n") unless(truncate STAT, 0);
	seek(STAT, 0, 0);
	foreach my $k (keys %FileInfo) {
		print STAT "$k\t" . join("\t", @{$FileInfo{$k}}) . "\n";
	}
	close(STAT);
	$DiskUsed = DiskUsage();	# Work out since it has changed
}

# Zap files that are too old.
sub PurgeFiles {
	# Compute warning 24 hour period for when to send a warning of impending purge:
	my $WarnPurgeDate = $now + $WarnPurge * $periods{day};
	my $WarnPurgeDate_1 = $now + ($WarnPurge + 1) * $periods{day};

	printf LOG "%s: Purge $mailbox %s\n", $LogTime, $FileDir;

	foreach my $file (sort keys %FileInfo) {
		next if($file =~ /^\./);		# Ignore params

		if($now < $FileInfo{$file}[1]) {	# Too young
			if($WarnPurgeDate < $FileInfo{$file}[1] && $FileInfo{$file}[1] < $WarnPurgeDate_1) {
				# No files for this owner ?
				$WarnPurges{$FileInfo{$file}[0]} = () unless(exists($WarnPurges{$FileInfo{$file}[0]}));

				push @{$WarnPurges{$FileInfo{$file}[0]}}, $file;	# one more for this owner
			}
			next;
		}
		my $msg;
		if(unlink "$FileDir/$file") {
			$msg = "File $file deleted, was uploaded by $FileInfo{$file}[0]\n";
			if($SayPurged) {
				$TellPurges{$FileInfo{$file}[0]} = () unless(exists($TellPurges{$FileInfo{$file}[0]}));
				push @{$TellPurges{$FileInfo{$file}[0]}}, $file;
			}
			delete($FileInfo{$file});
			$Update = 1;
		} else {
			$msg = "File $file not deleted: $!\n";
		}
		print MAIL $msg;
		print LOG $LogTime . ': ' . $msg;
	}

	UpdateList() if($Update);

	my $maildate = strftime("%a, %d %b %Y %H:%M:%S %z", localtime);

	# For every owner that we need to say something to:
	foreach my $owner (keys %{{%WarnPurges, %TellPurges}}) {
		local $" = "\n\t";

		open(OWNERMAIL, '|-', "/usr/sbin/sendmail -f $EmailFrom $owner") or
			MyDie("Can't open pipe to mail purge info to '$owner': $!\n");
		print OWNERMAIL <<End;
To: $owner
From: $EmailFrom
Reply-To: $EmailReplyTo
Subject: File Deletions from store $mailbox
Date: $maildate
End
		print OWNERMAIL "\nThe following file(s) have been deleted:\n\t@{$TellPurges{$owner}}\n"
			if(exists($TellPurges{$owner}));

		print OWNERMAIL "\nThe following file(s) will soon be deleted:\n\t@{$WarnPurges{$owner}}\n$WarnPurge day advance warning.\n"
			if(exists($WarnPurges{$owner}));

		print OWNERMAIL "\nThis email is for your information, you do not need to do anything.\n";

		close OWNERMAIL;
	}

	exit;	# No need to CloseMail or anything
}

# Very simple usage:
sub Help {
	print <<End;
Store mail attachments for URL retrieval.

Help:
	$progname --help
Remove expired attachments from Web/Ftp page:
	$progname --purge mailbox [File Directory]
Upload new arrachments, mail on stdin:
	$progname mailbox sender subject_command [File Directory]
End
	print &UpHelpMsg;
	exit 0;
}

# The point is that the message can change slightly if substituted variables change.
# Return a string.
sub UpHelpMsg {
	return <<End;

Attachment (file) names may be up to $MaxNameLen characters long and are case sensitive.
Their names must start with an alphanumeric character and may contain alphanumeric, '-', '_' and '.'
characters, any spaces will be replaced by underlines ('_').
The attachment must be between $MinSize and $MaxSize Kibytes in size.

Email Subject may be:
on uploading an attachment to be saved as a file, how long before it is removed, eg:
	keep 2 days
	keep 2 weeks
	keep 1 months
	keep 1 year
to see what files are present:
	list
to remove a file called FileName:
	delete FileName
to learn about administrative commands:
	admin help
End
}

# Print out some help
# Optional arg is a message to prepend to help.
sub AdminHelp {
	print MAIL "$_[0]\n\n" if @_;
	print MAIL <<End;
Administrative command help.

The following commands may be sent as the mail Subject:

Set options (parameters):
	admin set parameter value

    Parameters are:
	name	   current
		    value
End
	printf MAIL "\t%-11.11s%-8.8s %s\n", $_, ${$ParmDesc{$_}[2]}, $ParmDesc{$_}[0]
		foreach (sort keys %ParmDesc);

	print MAIL <<End;

    Eg, to set the maximum size attachment that will be archived to 3 MBytes:
	admin set MaxSize 3000

Delete a file, overriding ownership:
	admin delete FileName

Change the keep time for a file currently kept (counting from today):
	admin keep FileName period
eg:
	admin keep report.pdf 2 weeks

User commands deal with those who may use the service, these are not always available:
	admin user list
	admin user add local_part\@domain ...
	admin user del local_part\@domain ...
eg:
	admin user add addw\@phcomp.co.uk info\@phcomp.co.uk
End
	close(MAIL);
	exit;
}

# Set an option:
sub AdminSet {
	AdminHelp("Wrong number of parameters to 'admin set' in '$subject'") unless @_ == 4;
	my ($ad, $set, $parm, $val) = @_;

	# Be kind: param name may not be in the correct case
	my %parms = map { lc $_ => $_ } keys %ParmDesc;
	AdminHelp("Unknown set parameter: $parm")
		unless(exists($parms{lc $parm}));
	my $pname = $parms{lc $parm};

	AdminHelp("Bad value for $parm: $subject")	# Check it looks about right
		unless($val =~ /^$ParmDesc{$pname}[3]$/);

	# If we are changing something - set the value & report what we did
	if( ! exists($FileInfo{".$pname"}) or $val ne $FileInfo{".$pname"}[0]) {
		my $old = exists($FileInfo{".$pname"}) ? $FileInfo{".$pname"}[0] : "unset (default $ParmDesc{$pname}[1])";
		print MAIL "Setting parameter $pname, from $old to $val\n";
		print LOG $LogTime . ": Admin $mailbox $sender: Setting parameter $pname, from $old to $val\n";

		$FileInfo{".$pname"} = [$val];
		$Update = 1;

		# Remove entry if the value is the default
		foreach (keys %ParmDesc) {
			delete $FileInfo{".$_"} if(exists($FileInfo{".$_"}) and $ParmDesc{$_}[1] == $FileInfo{".$_"}[0])
		}
	} else {
		print MAIL "Parameter $pname, unchanged from current $val\n";
	}
}

# Delete a file -- irrespective of who owns it
sub AdminDelete {
	AdminHelp("File name for admin delete is not valid: $_[0]") unless($_[0] =~ /^\w[-\w\.]+$/i);
	DeleteFiles($_[0], 1);	
}

# Change the retention time on a file
# Args are like:
#	admin keep report.pdf 2 weeks
sub AdminKeep {
	my ($ad, $k, $file, $num, $period) = @_;

	# Check parmeters:
	AdminHelp("Bad period in: $subject")
		unless($num =~ /^\d+$/ && $period =~ /^(day|week|month|year)/);
	$Keep = $num * $periods{lc $1};
	$Expire = $now + $Keep;
	$ExpireStr = strftime "%A %d %B %Y", localtime($Expire);

	AdminHelp("File name for admin keep is not valid: $file") unless($file =~ /^\w[-\w\.]+$/i);
	AdminHelp("File does not exist, command: $subject") unless exists($FileInfo{$file});

	my @curr = @{$FileInfo{$file}};
	$Update = 1;
	$FileInfo{$file} = [$curr[0], $Expire, $ExpireStr];
	print MAIL "File $file keep date changed, was $curr[2] now $ExpireStr\n";
	print LOG "$LogTime: $mailbox File $file keep date changed, was $curr[2] now $ExpireStr\n";
}

# User manipulation commands
# Args:
#	admin user list
#	admin user add local@domain ...
#	admin user del local@domain ...
sub AdminUser {
	close(STAT);

	shift; shift;	# Loose 'admin user'

	AdminHelp("'admin user' commands are not enabled. User file unknown or not readable")
		unless(defined($UserFile) and -r $UserFile);

	AdminHelp("Wrong number of parameters to 'admin user' in '$subject'") unless @_ >= 1;

	# Check the command and get the file open mode, check that we can do this:
	my %cmds = ( list => 'read', add => 'write', del => 'write', delete => 'write' );
	my $cmd  = shift;
	my $mode = $cmds{$cmd};
	AdminHelp("Unknown command: admin user $cmd")
		unless(defined($mode));
	AdminHelp("Not enough parameters to 'admin user $cmd' in '$subject'")
		unless $cmd eq 'list' or @_ >= 1;	# Others need at least one address
	AdminHelp("The user file is read only, you cannot use the command: admin user $cmd")
		if($mode eq 'write' && ! -w $UserFile);
	AdminHelp("The user file is configured read only, you cannot use the command: admin user $cmd")
		if($mode eq 'write' && $UserReadOnly);

	my $openMode = $mode eq 'write' ? '+<' : '<';
	open(USER, $openMode, $UserFile) or
		AdminHelp("Open of user file for '$mode' failed: $!");

	flock(USER, $mode eq 'write' ? LOCK_EX : LOCK_SH);	# Don't want it changed elsewhere
	chomp(my @users = <USER>);
	my %users = map { lc $_ => 1 } @users;			# For easy checking list membership
	my $writeback = 0;					# If true, write back at end

	if($cmd eq 'list') {
		print MAIL "List of users:\n";
		print MAIL map { "\t$_\n" } grep { /^[^.]/ } @users;	# Suppress .dir line
		print MAIL "End of user list\n";
	} elsif($cmd eq 'add') {
		for (@_) {
			# Naive check, stop fiddling with .dir, no spaces & only one @:
			unless(/^[^@\s.][^@\s]*@[^@\s]+\.[^@\s]+$/) {
				print MAIL "Bad mail address, not added: $_\n";
				next;
			}
			if(exists($users{lc $_})) {
				print MAIL "User $_ is already a user, not added another time\n";
			} else {
				push @users, $_;
				print MAIL "Added mail address: $_\n";
				$writeback = 1;
			}
		}
	} elsif($cmd eq 'del' or $cmd eq 'delete') {
		for (@_) {
			unless(/^[^@\s.][^@\s]*@[^@\s]+\.[^@\s]+$/) {
				print MAIL "Bad mail address, not deleted: $_\n";
				next;
			}
			if(exists($users{lc $_})) {
				my $m = lc $_;
				@users = grep { lc $_ ne $m } @users;
				print MAIL "Deleted mail address: $_\n";
				$writeback = 1;
			} else {
				print MAIL "User $_ is not a user, not removed\n";
			}
		}
	} else {
		AdminHelp("Internal error, failed to execute command 'admin user $cmd'");
	}

	# Write back if we changed it, keep file sorted for MailToUrlUsers
	if($writeback) {
		# We may not have write permission to the directory, have to do it like this:
		truncate(USER, 0) or
			AdminHelp("Error truncating user file: $!\nGet your sysadmin to check - it may be corrupted");
		seek USER, 0, 0;
		print USER map { "$_\n" } sort @users;
		print MAIL "User file rewritten\n";
	}

	close(USER);	# Since it is locked

	exit;
}

# Administrative commands, Subject is 'admin' followed by something.
sub AdminCommands {
	print LOG $LogTime . ": Admin $mailbox $sender: $subject\n";

	my @AdCmds = split /\s+/, $subject;
	AdminHelp unless(exists $AdCmds[1]);
	my $Cmd = lc $AdCmds[1];

	# verify $sender is an administrator:
	AdminHelp("You are not an administrator, admin commands refused")
		unless( exists($FileInfo{'.Admins'}) and grep { lc $_ eq lc $sender } @{$FileInfo{'.Admins'}});

	if($Cmd eq 'help') {
		AdminHelp();
	} elsif($Cmd eq 'set') {
		AdminSet(@AdCmds);
	} elsif($Cmd eq 'delete') {
		AdminDelete($AdCmds[2]);
	} elsif($Cmd eq 'keep') {
		AdminKeep(@AdCmds);
	} elsif($Cmd eq 'user') {
		AdminUser(@AdCmds);
	} else {
		AdminHelp("Unknown admin command: $Cmd");
	}

	UpdateList() if($Update);

	exit;
}

# **** Start here ****

&Help if($#ARGV >= 0 && ($ARGV[0] eq '--help' || $ARGV[0] eq '-x'));

my $ai;
if($#ARGV >= 1 && $ARGV[0] eq '--purge') {
	$purge = 1;
	$mailbox = $ARGV[1];
	$ai = 2;
} else {
	die "Local user, sender or subject not specified. Try --help\n" unless($#ARGV >= 2);
	($mailbox, $sender, $subject) = @ARGV;
	$ai = 3;
	$subject =~ s/[^ -~]//g;	# Remove nasties
	die "Sender address bad: $sender\n" unless($sender =~ /^[^@]+@[^@]+\.[^@]+$/); # Very simple
}

# Command line arguments
die "Mailbox name '$mailbox' is bad\n" unless($mailbox =~ /^\w[-\w]*$/);
$FileDir = "$FileDirRoot/$mailbox";
$FileDir = $ARGV[$ai] if(exists($ARGV[$ai]) && $ARGV[$ai] ne '');

# Read what we know about files:
open(STAT, "+<$FileDir/$StatFile") or die("Can't open/read Stat file under $FileDir: $!\n");
flock(STAT, LOCK_EX);
%FileInfo = map { chomp; my @f = split /\t/; shift(@f) => \@f;} <STAT>;
# Leave STAT open & locked in case we update it

# Take specific parameters, names all start '.':
$MaxNameLen= $FileInfo{'.MaxNameLen'}[0] if(exists($FileInfo{'.MaxNameLen'}));
$protocol  = $FileInfo{'.Protocol'}[0]	if(exists($FileInfo{'.Protocol'}));
$ProtoRoot = $FileInfo{'.ProtoRoot'}[0]	if(exists($FileInfo{'.ProtoRoot'}));
$domain    = $FileInfo{'.Domain'}[0]	if(exists($FileInfo{'.Domain'}));
$MaxSize   = $FileInfo{'.MaxSize'}[0]	if(exists($FileInfo{'.MaxSize'}));
$MinSize   = $FileInfo{'.MinSize'}[0]	if(exists($FileInfo{'.MinSize'}));
$FileDir   = $FileInfo{'.FileDir'}[0]	if(exists($FileInfo{'.FileDir'}));
$Quota     = $FileInfo{'.Quota'}[0]	if(exists($FileInfo{'.Quota'}));
$LogFile   = $FileInfo{'.LogFile'}[0]	if(exists($FileInfo{'.LogFile'}));
$WorkDir   = $FileInfo{'.WorkDir'}[0]	if(exists($FileInfo{'.WorkDir'}));
$WarnPurge = $FileInfo{'.WarnPurge'}[0]	if(exists($FileInfo{'.WarnPurge'}));
$SayPurged = $FileInfo{'.SayPurged'}[0]	if(exists($FileInfo{'.SayPurged'}));
$Keep      = $FileInfo{'.KeepDays'}[0]	if(exists($FileInfo{'.KeepDays'}));
$UserFile  = $FileInfo{'.UserFile'}[0]	if(exists($FileInfo{'.UserFile'}));
$UserReadOnly = 1			if(exists($FileInfo{'.UserReadOnly'}));


$EmailFrom = "$mailbox-bounce\@$domain";	# Avoid a mail loop on bounce
$EmailReplyTo = "$mailbox\@$domain";
$EmailFrom = $FileInfo{'.MailFrom'}[0]	if(exists($FileInfo{'.MailFrom'}));
$EmailReplyTo = $FileInfo{'.MailReplyTo'}[0] if(exists($FileInfo{'.MailReplyTo'}));

# Open reporting streams:
OpenMail();
open(LOG, ">>$LogFile") or MyDie("Can't write log file: $!\n");
$LogOpen = 1;

$DiskUsed = DiskUsage();

# Special commands:
&PurgeFiles		if($purge);
&ListFiles		if($subject =~ /^list/i);
&AdminCommands		if($subject =~ /^admin/i);
&DeleteFiles($2, 0)	if($subject =~ /^(delete|remove)\s+(\w[-\w\.]+)/i);

# Upload a new attachment:
printf LOG "%s: New $mailbox $sender '%s' %s\n", $LogTime, $subject, $FileDir;

# When do we throw it away ?
# NB: default is measured in days, internally in seconds
$Keep *= $periods{day};
$Keep = $1 * $periods{lc $2}
	if($subject =~ /^keep\s+(\d+)\s+(day|week|month|year)/i);
$Expire = $now + $Keep;
$ExpireStr = strftime "%A %d %B %Y", localtime($Expire);

# Parse the mail message (unfortunately we have the STAT file locked while we do this):
my $parser = new MIME::Parser;
$wd = MakeWorkDir();
$parser->output_under($wd);
my $entity;
eval { $entity = $parser->parse(\*STDIN) };

my @parts = $entity;
Parts(@parts);

$Reply .= "\nYou may paste the URL(s) into mail that you send to other people.\n\n" if($newfile);

# If we copied in a file: update the list:
UpdateList() if($Update);

$Reply .= "There were not any mime parts (attachments) found in the email.\n"
	unless($FoundPart);

# Send an email back:
print MAIL $Reply;
CloseMail();

system "rm -rf $wd" if(defined($wd));

# end
