Listing 5: upload-file.pl for uploading files to Web servers.

#!/usr/bin/perl -w

use strict;
use diagnostics;
use CGI;

# ------------------------------------------------------------
# Define some fairly constants
my %PASSWORD = ();
$PASSWORD{"A"} = "passA";
$PASSWORD{"B"} = "passB";
$PASSWORD{"C"} = "passC";

# What is the root of our Web site?
my $web_root =
  "/export/home/apache/httpd-oursite/docs";

my $query = new CGI;
print $query->header("text/html");

# Make sure we were invoked via POST
&log_and_die("Please invoke with POST!") 
    unless ($query->request_method eq "POST");

# ------------------------------------------------------------
# Get the information from the user, and indicate if one or more
# elements was not filled out

my $userfile = $query->param("userfile");
&log_and_die("Please enter a filename to upload!") 
    unless $userfile;

my $filename = $query->param("filename");
&log_and_die("Please enter the destination name!") 
    unless $filename;

# Remove slashes from the filename for added security
$filename =~ s|/||g;

my $section = $query->param("section");
&log_and_die("Please indicate a section name.")
    unless $section;

my $password = $query->param("password");
&log_and_die("You didn't enter a password.") 
    unless $password;

# ------------------------------------------------------------
# Check the password
&log_and_die("Incorrect password") 
    unless ($PASSWORD{$section} eq $password);

# ------------------------------------------------------------
# Save the contents to the correct place
my $save_name = "$web_root/$section/$filename";

open (FILE, ">$save_name") || 
    &log_and_die("Cannot write to $save_name: $! ");

while (<$userfile>)
{
    print FILE;
}

close (FILE);

# ------------------------------------------------------------
# Return a note to the user indicating 
# that it was successful, as well as printing
# a directory listing for easier site maintenance.

print $query->start_html(-title => "Done");
print "<H1>File successfully uploaded</H1>\n";
print "<P>\"$section/$filename\" uploaded.</P>\n";
print "<P>Other files in this directory:</P>\n";

opendir (DIR, "$web_root/$section");

my @allfiles = readdir(DIR);
@allfiles = grep(!/^..?$/, @allfiles);

my $filename = "";
foreach $filename (sort @allfiles)
{
    my @stats = stat $filename;
    my $mtime = localtime ($stats[9]);
    my $ctime = localtime ($stats[10]);

    print "<P><a href=\"/$section/$filename\">";
    print "$filename</a></P>\n";
}

closedir (DIR);

print $query->end_html;

# ------------------------------------------------------------
# Log a message to the error log (or whatever is set up to
# accept STDERR), present a message to the user, and die.

sub log_and_die
{
    my $message = shift;

    print $query->start_html(-title => "Error!");
    print "<H1>Error uploading a file</H1>\n";
    print "<P>$message</P>\n";
    print $query->end_html;

    die $message;
}