

#!/usr/local/bin/perl

# Name:         ftp.pl (upload.pl)
# Version:      1.2
# Date:         June 23, 1996
#
# Description:  This program allows uploading files.
#               A user must work with Netscape Navigator 2.0 or later.
#
# Author:               Dr Andrey Tsouladze
# E-mail:               andy@spl.co.il
# URL:                  http://spl.co.il/~andy/
# Organization:         SPL WorldGroup

# User defined variables

# Server-path and name of your cgi-bin directory.
# The program calls itself, and has to know how to find itself.
# If this variable is specified correctly, you can move the program to subdirs,
# (e.g. from `cgi-bin' to `cgi-bin/utils') without making any changes.
# You can even change program name, and it will still work.
$CgiBin = "/export/home/httpd/cgi-bin";

# Settings of your HTTP and FTP servers.
# Must be full paths. Do not forget trailing slash "/".
# IMPORTANT: Make sure this directory is writable by the user your Web server
# runs under!

# Document Root of HTTP server
$DocumentRoot = "/export/home/www/";

# Anonymous FTP root directory
$FtpRoot = "/export/home/www/mindseye/upload/";

# Directory to write temporary files
$TempDir = "/export/home/www/mindseye/temp/";

# If you want to allow your users to overwrite existing files, re-define the
# following variable.
#$AllowOverwrite = 1;
$AllowOverwrite = 1;

# This is a message which appears at the bottom of every HTML page.
$Reference = <<EOR;
If you experience problems with this program, please report them to the <A
HREF="mailto:webmaster\@spl.co.il">Webmaster</A> of <A HREF="http://www.spl.co.il">SPL Worldgroup</A>
EOR

######################################################################
# I do not think you need to edit anything below
######################################################################

$TempFile = "$TempDir$$.TEMP";

# Let the program identify itself, whatever its name.
@ProgName = split ("$CgiBin", $0, 2);
$ProgName = "/$CgiBin$ProgName[1]";

if ($ENV{'REQUEST_METHOD'} eq 'GET') {
        &GetPath;
        &CheckAll;
        &CleanUp;
        &KeepEnv;
        &InitialForm;
}
&StoredData;
&Process;
&Success;

sub Process {
# Read form input and write it to a temporary file.
read (STDIN, $Input, $ENV{'CONTENT_LENGTH'});
open (FILE,">$TempFile");
print FILE $Input;
close (FILE);

# Free the memory
undef $Input;

# Now try to make sense of it.
open (FILE, "$TempFile");

# Get control sequence which always consists of digitals and put it aside.
$_ = <FILE>;
($Control) = /(\d+)/;

# Get original file info
$_ = <FILE>;
$FileInfo = $1 if (/filename=\"(.*)\"/);

# Get rid of the prepending info.
@Chunks = (split(/\\/,$FileInfo));
$FileName = $Chunks[$#Chunks];

# Translate filename to lowercase if from Win3.X
if ($ENV{'HTTP_USER_AGENT'} =~ /Win16/) {
        $FileName =~ tr/A-Z/a-z/;
}

# In case the file comes from Unix:
if ($FileName =~ (/\//)) {
        @Chunks = (split(/\//, $FileName));
        $FileName = $Chunks[$#Chunks];
}

# If a stupid user forgets to specify a file, I re-draw the Initial Form
# with an error message.
if ($FileName eq '') {
        close(FILE);
        unlink $TempFile;
        $Error="<FONT COLOR=\"#FF0000\" SIZE=\"+1\">No file name specified!<BR>Please try again.</FONT>";
        &InitialForm;
}

# If a file with this name already exists, I re-draw the Initial Form
# with an error message.
if (($AllowOverwrite == 0) && (-f "$WriteDir/$FileName")) {
        close(FILE);
        unlink $TempFile;
        $Error=<<EOE;
<FONT COLOR="#FF0000" SIZE="+1">File</FONT>
<FONT COLOR="#000080" SIZE="+1">$FileName</FONT>
<FONT COLOR="#FF0000" SIZE="+1">already exists!<BR>
You have to rename your file first.</FONT>
EOE
        &InitialForm;
}

# Write the real file
open (Output, ">$WriteDir/$FileName");

# Throw away two unwanted lines.
$Null = (<FILE>);
$Null = (<FILE>);

# Write to the output file until control series is found, then exit the loop.
while (<FILE>) {
        if (/-{28,29}$Control/) {last;}
        else {print Output $_;}
}
close (FILE);
close (Output);
chmod 0666, "$WriteDir/$FileName";
unlink ("$TempFile", "$TempDir.upload.$ENV{'REMOTE_ADDR'}.pl");
}       # End sub Process

sub InitialForm {
print <<EOF;
Content-type: text/html\n\n
<HTML>
<HEAD>
<TITLE>Upload File</TITLE>
<!-- Author: Andy Tsouladze, andy\@spl.co.il -->
</HEAD>
<BODY>
<CENTER>
<H1 ALIGN="center">Upload a File</H1>
$Error
<P>Press this button to start browsing:
<FORM ENCTYPE="multipart/form-data" ACTION="$ProgName" METHOD="POST">
<INPUT TYPE="file" NAME="file" size="60"><P>
<INPUT TYPE="reset" VALUE="Start again">
<INPUT TYPE="submit" VALUE="Send the file over">
</FORM>
</CENTER>
<HR SIZE="4" NOSHADE>
$Reference
</BODY>
</HTML>
EOF
exit(0);
}       # End sub InitialForm


sub Success {
print <<EOF;
Content-type: text/html\n\n
<HTML>
<HEAD>
<TITLE>File Uploaded</TITLE>
<!-- Author: Andy Tsouladze, andy\@spl.co.il -->
</HEAD>
<BODY>
<H1 ALIGN="center">Thank You!</H1>
<HR SIZE="3" WIDTH="70%">
<P ALIGN="center">File <FONT SIZE="+1" COLOR="#FF0000">$FileName</FONT>
has been successfully uploaded.<BR>
<A HREF="$URL/$FileName">Please check it here</A></P>
<HR SIZE="4" NOSHADE>
$Reference
</BODY>
</HTML>
EOF
exit(0);
}       # End sub Success

sub GetPath {
@Protocol=split('/', $ENV{'HTTP_REFERER'});
$URL=join('/', @Protocol[0 .. $#Protocol -1]);
if ($Protocol[0] =~ /ftp/i) {
# Private ftp
        if ($Protocol[2] =~ /@/) {
                $BaseDir = '/';
                $Path = join ('/', @Protocol[3 .. $#Protocol -1]);
        }
# Public ftp
        else {
                $BaseDir = $FtpRoot;
                $Path = join ('/', @Protocol[3 .. $#Protocol -1]);
        }
}
elsif ($Protocol[0] =~ /http/i) {
# Private http
        if (($Protocol[3] =~ /~/) || ($Protocol[3] =~ /%7E/i)) {
                $Protocol[3] =~ s/~//;
                $Protocol[3] =~ s/%7E//i;
                open (FILE, "/etc/passwd");
                        while (<FILE>) {
                                if (/^$Protocol[3]:/) {
                                        @User = split (/:/, $_);
                                        last;
                                }
                        }
                close (FILE);
                $BaseDir = "$User[5]/public_html/";
                $Path = join ('/', @Protocol[4 .. $#Protocol -1]);
        }
# Public http
        else {
                $BaseDir = $DocumentRoot;
                $Path = join ('/', @Protocol[3 .. $#Protocol -1]);
        }
}
else {
        &CheatingError;
}
}

sub CheckAll {
# User browser is not Netscape 2
$_ = $ENV{'HTTP_USER_AGENT'};
if (/Mozilla/)  {
        $Ver = $1 if (/Mozilla\/\"(.*)\"/);
        if ($Ver >= 2) {}
}
else {
        $ErrorMsg = <<EOM;
<P>Your browser does not support file uploading. Please use
<A HREF="http://www.netscape.com">Netscape</A> 2.0 or later versions.
<P>Your browser is: $ENV{'HTTP_USER_AGENT'}
EOM
&CheatingError;
}

# No write permission
if (! (-w "$BaseDir$Path")) {
        $ErrorMsg = <<EOM;
<P>The program cannot create a file in the specified directory. You have to
change write permissions before calling this program.
EOM
&CheatingError;
}
}       # End sub CheckAll

sub KeepEnv {

open (FILE, ">$TempDir.upload.$ENV{'REMOTE_ADDR'}.pl");
print FILE "\$WriteDir = \"$BaseDir$Path\"\;\n";
print FILE "\$Time = ", time, "\;\n";
print FILE "\$URL = \"$URL\"\;\n";
close (FILE);
}

sub StoredData {
if (-f "$TempDir.upload.$ENV{'REMOTE_ADDR'}.pl") {
        require "$TempDir.upload.$ENV{'REMOTE_ADDR'}.pl";
}
else {
        $ErrorMsg = "Unknown Error";
        &CheatingError;
}
if (time - $Time > 600) {
        $ErrorMsg = "Timeout. You have ten minutes to choose a file. Please start again.";
        &CheatingError;
}
}       # End sub StoredData

sub CheatingError {
if ($ErrorMsg eq '') {
        $ErrorMsg = "This program (<B>$ProgName</B>) must be accessed from a file on the server system using HTTP or FTP protocol.";
}
print <<EOF;
Content-type: text/html\n\n
<HTML>
<HEAD>
<TITLE>ERROR</TITLE>
<!-- Author: Andy Tsouladze, andy\@spl.co.il -->
</HEAD>
<BODY>
<H1 ALIGN="center">Error!</H1>
$ErrorMsg
<HR SIZE="4" NOSHADE>
$Reference
</BODY>
</HTML>
EOF
exit(0);
}       # End sub CheatingError

sub CleanUp {
# Find `leftovers' of aborted processes, and delete them if files are
# at least one hour old.
opendir (DIR, "$TempDir");
@files = readdir(DIR);
closedir (DIR);
foreach $i (<@files>) {
        if (($i =~ /^\.upload/) || ($i =~ /\.TEMP$/)) {
                unlink "$TempDir$i" if ((-M "$TempDir$i") > .04);
        }
}
}       # End sub CleanUp
