#!/usr/bin/perl

# File: Uploader
#
#
#
# User set variables
#

$uploadurl = "http://www.cs.umn.edu/~doyle/AMY";
$path = "/home/grad23/doyle/.www/AMY";
%extrapaths = ("main" => ".", "pictures" => "pics", "thumbnails" => "thumbnails", "extra pictures" => "images");
@okhosts = ('www-users.cs.umn.edu','www.umn.edu','gold.tc.umn.edu','maroon.tc.umn.edu');
@safenames = ('cgi-bin', 'counter');
$password = "enter your password here";
$bgcolor = "#ffffff";

$overwrite = 0;

#
# Local Variables
$ok = 0;

# Main script
#

$| = 1;
print "Content-type: text/html\n\n";


$lib = "./Library";
# Read in core BBS variables
require "$lib/cgi-lib.pl";

&ReadParse;
#print &PrintVariables;

#file these 2 in if necessary
#    $cgi_lib'maxdata = $maximum_attachment_size;
#    $cgi_lib'writefiles = "$attach_dir";


if ( $ENV{'CONTENT_LENGTH'} == "" ) { #if form hasn't been submitted
    &header("Upload Form");
    &gen_form;
    &footer;
}
elsif ($in{'dir'} ne "" ) {
    &Verify;
    &header("Current Directory Listing");
    &print_dir;
    &gen_full;
    &footer;
}
else {
    &Verify;
    &get_data;
    &write_it;

    #change permissions  of file
    chmod (0644, "upload$path/$extrapath/$newfile");

    #show thank you and let add more.
    &header("File Uploaded");
    print qq~
    <center><h1>File Uploaded</h1></center>
    Your file has been uploaded successfully.
    <hr size=3> <p>
    Feel free to upload another<p>~;
    &gen_full;
    &footer;
}
#else
#{
#    &header("Error! Wrong Version");
#    print qq~
#    <h1><center>Sorry!</center></h1>
#    You are using a browser which doesn''t support the transference of files.
#    Which is needed to upload.  Please try again with a different browser.~;
#    &footer;
#}
    
###################### subroutines #############################


sub gen_form
{
    print qq~
    <form enctype="multipart/form-data" action="./upload.cgi" method=post>
    <center><h1>Upload File</h1></center>
    <p>
    Enter Password: <input type=password name="pswd" size="2"0><p>
	New file to be saved as:
    <b>directory</b>
    <select name="extrapath">\n~;
    foreach $path (sort keys %extrapaths) {
	print "<option value=\"$extrapaths{$path}\">$path</option>\n";
    }
    print qq~
    </select>
    <b>filename</b>
    <input name="newfile" length=15><p>
    <!--b>Fill in one of the two below</b><br-->
    File on your computer: <input name="localfile" type="file" size="4"0><p>
    <!--File on another server: <input name="distfile" size="5"0><p-->
    <input type="submit" value="Upload">
    <input type="submit" name="dir" value="List Files">
    </form>~;
}


sub gen_full {
#	&header("Upload Form");
    print qq~
    <form enctype="multipart/form-data" action="./upload.cgi" method=post>
    <center><h1>Upload File</h1></center>
    <p>
    Enter Password: <input type=password name="pswd" size="2"0 value=$pswd><p>
    New file to be saved as:
    <b>directory</b>
    <select name="extrapath">~;
    foreach $path (sort keys %extrapaths) {
	print "<option value=\"$extrapaths{$path}\">$path</option>\n";
    }
    print qq~
    </select>
    <b>filename</b>
    <input name="newfile" length=15 value=$newfile><p>
    <!--b>Fill in one of the two below</b><br-->
    File on your computer: <input name="localfile" type="file"><p>
    <!--File on another server: <input name="distfile" size="5"0><p-->
    <input type="submit" value="Upload">
    <input type="submit" name="dir" value="List Files">
    </form>~;
#	&footer;
}


sub Verify {
    #get information from form
    $pswd = $in{"pswd"};
    
    # first check if they are on an approved host
    
    if ($ENV{'HTTP_REFERER'}) {
	foreach (@okhosts) {
	    if ($ENV{'HTTP_REFERER'} =~ /$_/i) {
		$ok = 1;
		last;
	    }
	}
	if ($ok) {			#check password
	    if ($password ne $pswd) {
		$ok=0; }
	}
	
	if (!$ok) {
	    &header("Not Verified");
	    print qq~
	    <h1>Sorry</h1>
	    I''m sorry, either you are not on an approved server, 
	    or your password is incorrect.<p>
	    You cannot upload a file to this server.~;
	    &footer;
	    exit;
	}
    }
}

sub get_data {
    $extrapath = $in{"extrapath"};


    if (!(-e "$path/$extrapath" ))
    {
	&header("Directory doesn't exist");
	print qq~
	    <h1>Sorry</h1>
	    I''m sorry, the directory you've chosen doesn't exist on this server.</p>~;
	&footer;
    }

    $newfile = $in{"newfile"}; #check new filename

    if (($newfile !~ /^[A-Za-z_\-0-9\.]+$/) || ($newfile =~ /\.\./)) {
	&header("Illegal Filename");
	print qq~
	<h1><center>Sorry</center></h1>
        Please only use letters, numbers, hyphens, underscores or periods
	within your filename.<br>
	Please select another filename and try again.	    
	</body></html>~;
	&gen_full;
	&footer;
	exit;
    }

#include protection of safe names
    foreach (@safenames) {
	if ( $newfile eq $_) {
	    &header("Illegal Filename");
	    print qq~
	    <h1><center>Sorry</center></h1>
	    You have chosen a name of a protected file.  Please choose another 
	    name and try again.
	    <p>~;
	    &gen_full;
	    &print_footer;
	    exit;
	}
    }

    if ((!$overwrite) && (-e "$path/$extrapath/$newfile"))
    {
	&header("Duplicate File");
	print qq~
	<h1><center>Sorry</center></h1>
	You have chosen a filename already in use.  Please choose a name other than:
	<p>~;
	&print_dir;
	&gen_full;
	&print_footer;
	exit;
    }
    #get file.  If it's local...
	
    $file_contents = $in{"localfile"};

    if ($file_contents ne "") {
	$filename = $incfn{"localfile"};
    }
    else #distant file
    {
	if ((-e "./http-lib.pl") && (-r "./http-lib.pl")) {
	    require "./http-lib.pl";
	    print "got required library";
	} else {
	    &header("Missing Library");
	    print "Sorry the http-lib.pl file is missing or unreadable.";
	    &footer;
	    exit;
	}
	print "got to distfile";
	print "the line is: $lines[5]<br>";
	@parts = split(/\r\n/,$lines[5]);
	$distfile = $parts[3];
	print "distfile is $distfile";
	$distfile =~ s/http\/\///i;        #remove any header
	$distfile =~ s/\"//g;              #remove any quotes
	$distfile =~ /([\w.:]+)\/(.*)/;     #separate
	$url = $1;
	$hostname = $2;
	$port = 80;
	if ($url =~ /:/) {
	    ($url,$port) = split(/:/,$url);
	}
	print "$distfile <br> $url <br> $hostname <br>\n";
	$oldfile = &HTTPGet($url, $hostname, $port, "" );
    }
}

sub write_it
{
    if ((!(-e "$path/$extrapath$newfile")) || ($overwrite)) { 
	open (OUTPUT, ">$path/$extrapath/$newfile" ) || 
	    die &NoOpen($!);
	print OUTPUT $file_contents;
	close (OUTPUT);
    }
    else {
	&header("Sorry, existing filename");
	print qq~
	<h1><center>Sorry</center></h1>
	The filename you want to use is already in use.  
	Please choose an unused one, and try again.~;
	&print_dir;
	&gen_full;
	&footer;
	exit;
    }
}

sub header {
    local ($title) = @_;
    print qq~
    <html>
    <head><title>$title</title></head>
    <body bgcolor=$bgcolor>~;
}

sub footer{
    print qq~
    <hr><p>
    This script was created by <a href="http://www.cs.umn.edu/\~doyle">
    Dave Doyle</a>
    </body></html>~;
    print "\n";
}

sub print_dir {
    $extrapath = $in{"extrapath"};

    foreach $key (sort keys %extrapaths) {
	if ($extrapaths{$key} eq $extrapath) {
	    $choicename = $key;
	}
    }

    print "<center><h2>Existing Files in $choicename</h2>\n";
    opendir(DIR,"$path/$extrapath") || &unable("$path/$extrapath");
    
    @files = grep(/\w/,readdir(DIR));
    close(DIR);
    @sort_files = sort @files;
    print "<table border=2><tr>\n";
    foreach $item (@sort_files) {
	if($item =~ /\w/) {
	    if(-f "$path/$extrapath/$item") {
		print "<td> $item </td>\n";
		$cell_num++;
	    }
	}
	if ($cell_num%3==0) {
	    print "</tr><tr>\n";
	}
    }
    print "</tr></table></center>\n";
}

sub unable {
    &header("Error");
    print "Unable to open: $_[0]\n";
    &footer;
    exit 0;
}