#!/opt/perl/bin/perl -w

require(5.004);
use strict;
use POSIX;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use CGI::Pretty qw(:html3);

# global variables
use vars ($Debug, $Sendmail, $UploadMax);
use vars qw($Query $SelfUrl);

$Debug      = 0;
$Sendmail   = '/usr/sbin/sendmail';
$UploadMax  = 5; # max attachment size (in Mbytes)

main();
exit(0);

###############################################################################
# main program
###############################################################################
sub main {
    my ($key, $value, $status, $title);

    # get inputs from HTML form
    $CGI::POST_MAX = 1024*1024*$UploadMax;
    $Query = new CGI;
    $SelfUrl = $Query->url();

    foreach $key ($Query->param) {
	$value  = $Query->param($key);
	$Att1   = $value if ($key eq 'Att1');
    }

    sanitizeFilename($Att1);
    htmlEscape($Att1);
    urlEscape($Att1);
    
    # CGI error
    if ($Query->cgi_error) {
	$Action = 'ERROR';
	$title = 'Action Failed';
    }

    # process new form
    elsif ($Action eq 'SUBMIT') {
	$Action = 'SUBMIT';
	$title = 'Submit File';
    }
    
    # unknown action
    else {
	$Action = $Action;
	$title = 'Action Failed';
    }
    
    Header($title, undef, $MyStyle);
    
    # CGI error
    if ($Action eq 'ERROR') {
	htmlError('Cannot process request',
		  "total size of uploaded files (if any) must be <= " .
		  "$UploadMax Mbytes");
    }
    
    # process a file
    elsif ($Action eq 'SUBMIT') {
	if ($status = ProcessFile()) {
	    # an error has occurred
	    htmlError('Cannot process file', $status);
	}
	else {
	    SendMail($MyEmail, 'Error processing file');
	    # success
	    htmlNote("Successfully processed file");
	}
    }
    
    # unknown action
    else {
	htmlError('Cannot perform action',
		  "unrecognized action '$Action'");
    }
    
    Tailer();
    exit(0);
}

# fixme
    if ($Action eq 'SUBMIT' && $Att1) {
	if (open(FILE, ">$Uatt1")) {
	    while (read($Query->upload('Att1'), $buffer, 1024)) {
		print(FILE $buffer);
	    }
	    close(FILE);
	}
	else {
	    $status .= "cannot open file '$Uatt1': $!<BR>";
	}
    }

}

###############################################################################
# make form
###############################################################################
sub MakeForm {
    print $Query->start_multipart_form(-action=>"$SelfUrl",
				       -method=>'POST',
				       -name=>'main');
    beginPanel('cellleft');
    print $Query->filefield(-name=>"Att1",
			    -default=>"$Att1",
			    -size=>30);
    midPanel('cellleft');
    print "<INPUT TYPE=SUBMIT NAME=Action VALUE=\"SUBMIT\">\n";
    print "<INPUT TYPE=RESET VALUE=\"Reset\">\n";
    endPanel();
    print $Query->endform;
}

###############################################################################
# send e-mail
###############################################################################
sub SendMail {
    my $subject = shift;
    my $address = shift;
    my $path = $ENV{PATH};

    $ENV{PATH} = '';
    if (! open(MAIL, "| $Sendmail $address")) {
	htmlError("Cannot send e-mail to $address", $!);
	$ENV{PATH} = $path;
	return;
    }
    $ENV{PATH} = $path;
    print(MAIL "To: $address\n");
    print(MAIL "Subject: $subject\n");
    print(MAIL "\n");
    print(MAIL "--------------------------------------------------\n");
    print(MAIL "your text here\n");
    print(MAIL "--------------------------------------------------\n");
    close(MAIL);
}

###############################################################################
# start page
###############################################################################
sub Header {
    my $title = shift;
    my $background = shift;
    my $style = shift;

    print($Query->header);
    print($Query->start_html(-title => $title,
			     -background => $background,
			     -style => {src => $style}));
    beginPanel('title');
    print("$title\n");
    endPanel();
    print("<br>\n");
}

###############################################################################
# end page
###############################################################################
sub Tailer {
    if ($Debug) {
	print("<br>\n");
	beginPanel('header');
	print("Debug Information\n");
	midPanel('cellleft');
	debugPrint();
	endPanel();
    }

    print($Query->end_html);
}

###############################################################################
# print query and environment info
###############################################################################
sub debugPrint {
    my $key;
    
    print("<em>Query:</em>\n");
    print("<pre>\n");
    foreach $key (sort($Query->param)) {
	print("$key = \"" . $Query->param($key) . "\"\n");
    }
    print("</pre>\n");

    print("<em>Environment:</em>\n");
    print("<pre>\n");
    foreach $key (sort(keys(%ENV))) {
	print("$key = \"" . $ENV{$key} . "\"\n");
    }
    print("</pre>\n");
}

###############################################################################
# draw panels
###############################################################################
sub beginPanel {
    my $class = shift;
    print("<table width=800 border=1 cellpadding=4 cellspacing=1>\n");
    print("<tr><td class=\"$class\">\n");
}

sub midPanel {
    my $class = shift;
    print("</td></tr>\n");
    print("<tr><td class=\"$class\">\n");
}

sub endPanel {
    print("</td></tr>\n");
    print("</table>\n");
}

###############################################################################
# print a message in HTML
###############################################################################
sub htmlNote {
    my $mesg = shift;

    beginPanel('header');
    print("$mesg\n");
    endPanel();
}

###############################################################################
# print an error message in HTML
###############################################################################
sub htmlError {
    my $error = shift;
    my $reason = shift;

    beginPanel('header');
    print("ERROR: $error\n");
    midPanel('cellleft');
    print("REASON: $reason\n");
    endPanel();
}

###############################################################################
# replace unsafe characters in filename with underscores and untaint the
# filename
#
# safe characters are: a-z A-Z 0-9 _ .
###############################################################################
sub sanitizeFilename {
    my $i;
    for ($i = 0; $i < @_; $i++) {
	$_[$i] =~ s/[^\w\.]/_/g;
	$_[$i] = $1 if ($_[$i] =~ /^([\w\.]+)$/);
    }
}

###############################################################################
# escape URL special characters
###############################################################################
sub urlEscape {
    my $i;
    for ($i = 0; $i < @_; $i++) {
	$_[$i] = CGI::escape($_[$i]);
    }
}

###############################################################################
# escape HTML special characters
###############################################################################
sub htmlEscape {
    my $i;
    for ($i = 0; $i < @_; $i++) {
	$_[$i] =~ s/\&/&amp;/g;
	$_[$i] =~ s/\</&lt;/g;
	$_[$i] =~ s/\>/&gt;/g;
	$_[$i] =~ s/\"/&quot;/g;
    }
}

###############################################################################
# remove leading and trailing whitespace
###############################################################################
sub trimSpace {
    my $i;
    for ($i = 0; $i < @_; $i++) {
	$_[$i] =~ s/^\s+//g;
	$_[$i] =~ s/\s+$//g;
    }
}

###############################################################################
# convert Unix timestamp to dd-mmm-yyyy
###############################################################################
sub t2d {
    my $time = shift;
    my ($junk, $Day, $Mon, $Year);
    return('') unless ($time);
    ($junk,$junk,$junk,$Day,$Mon,$Year,$junk,$junk,$junk) = localtime($time);
    $Year += 1900; # localtime() returns year-1900
    $Mon = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
	    'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec')[$Mon];
    return(sprintf("%02d-%3s-%04d", $Day, $Mon, $Year));
}