#!/usr/local/bin/perl

# File upload script.  When used in conjunction with an SSL web server,
# this can be more secure than FTP transfers.

use CGI qw(:standard);

print header;
print start_html(-title=>'File Upload Utility in Perl',
  -meta=>{'keywords'=>'interactive AgNews Search Engine'},
  -BGCOLOR=>'white', -TEXT=>'000000', -LINK=>'121255',
  -VLINK=>'782233'),p;

# Default page:

if (!param()) {
  print start_multipart_form;
  print "<table cellspacing=3 bgcolor=000000><tr><td>";
  print "<table cellspacing=3 bgcolor=EEEEEE><tr><td>";
  print "<table cellspacing=0 cellpadding=3 bgcolor=EEEEEE><tr><td>";
  print p, "User Name: ";
  print "</td><td>";
  print textfield("username");
  print "</td></tr><tr><td>";
  print p, "Password: ";
  print "</td><td>";
  print password_field(-name=>"password");
  print "</td></tr><tr><td></td><td align=right>";
  print p, submit(-name=>"Log In");
  print "</td></tr></table>";
  print "</td></tr></table>";
  print "</td></tr></table>";
  print hidden("page", "1");
  print end_form;
}

# File has been uploaded:

if (param("uploaded_file")) {
  # Grab these variables from the CGI.
  $name     = param ("username");
  $password = param ("password");
  $file2    = param ("rename");

  # At some point in the future, I need to implement a mechanism
  # that gaurantees a unique file name to use as a temp file for $file1.
  $file1    = "/tmp/upload-temp";

  $filename = param('uploaded_file');

  open (OUTFILE,">> $file1");
  while ($bytesread=read($filename,$buffer,1024))  { print OUTFILE $buffer; }
  close (OUTFILE);

  $filename =~ s/^.*\///g;
  $filename =~ s/^.*\\//g;
  $filename =~ s/\//\./g;

  `chmod o+r $file1`;

  $home =  (getpwnam $name)[7];
  if (param("options") eq "Upload to home directory.") { 
    $file2 = $home . "/" . $filename;
  }
  if (param("options") eq "Upload to public_html directory.") {
    $file2 = $home . "/public_html/" . $filename;
  }

  # Perl doesn't interact well with other programs, so I am using
  # expect to do a "su -c cp file1 file2".  Delays have been
  # added in because my system likes to think about it..

$expect_script_cp = <<__END_OF_CODE__;
#!/usr/bin/expect
set send_slow {1 .1}
spawn /bin/su $name "-c \\`cp $file1 $file2\\`"
expect -re "^Password: \$"
sleep 1
send -s "$password\\n"
expect eof
__END_OF_CODE__

$expect_script_chmod = <<__END_OF_CODE__;
#!/usr/bin/expect
set send_slow {1 .1}
spawn /bin/su $name "-c \\`chmod o+r $file2\\`"
expect -re "^Password: \$"
sleep 1
send -s "$password\\n"
expect eof
__END_OF_CODE__


  if (!open(OUTFILE, "| expect")) { print STDERR "Problem piping 'cp' to expect..\n"; }
  print OUTFILE $expect_script_cp;
  close (OUTFILE);
  
  if (!open(OUTFILE, "| expect")) { print STDERR "Problem piping 'chmod' to expect..\n"; }
  print OUTFILE $expect_script_chmod;
  close (OUTFILE);
  `rm $file1`;
}

# Ready to upload: (This is also the default page after an upload.)

if (param("page") == 1)
{
# Check for valid user name and password.
  $name = param("username");
  $pwd = (getpwnam $name)[1];
  $home =  (getpwnam $name)[7];
  $salt = substr $pwd, 0, 2;
  if ((crypt(param("password"), $salt) ne $pwd) || ($pwd eq "") || ($name eq "root")) {
    print "Buzz off, hozer.";
  } else {
    print start_multipart_form;
    print "<table cellspacing=3 bgcolor=000000><tr><td>";
    print "<table cellspacing=3 bgcolor=EEEEEE><tr><td>";
    print "<table cellspacing=0 cellpadding=3 bgcolor=EEEEEE><tr><td>";
    print "Enter a filename";
    print "</td><td>";
    print p, filefield(-name=>'uploaded_file',
                  -default=>'starting value',
		  -size=>40,
		  -maxlength=>80);
    print "</td></tr><tr><td colspan=2>";
    print radio_group(-name=>"options", 
                      -values=>["Upload to public_html directory.",
		                "Upload to home directory.",
				"Upload (and rename) to specified directory:"],
		      -default=>"Upload to public_html directory.",
		      -linebreak=>"true");
    print "</td></tr><tr><td>";
    print p, "Rename file as: ";	
    print "</td><td>";
    print textfield(-name=>"rename", -size=>"40", -default=>"$home/");
    print "</td></tr><tr><td colspan=2>";
    print "<p><font size=-1>";
    print "Please be patient while your browser uploads.  <br>Most browsers";
    print "do not have a file upload progress indicator.</font>";
    print "</td></tr><tr><td>";
    print "</td><td align=right>";
    print submit(-name=>'Submit',
               -value=>'Send File');
    print "</td></tr></table>";
    print "</td></tr></table>";
    print "</td></tr></table>";

    print hidden("page", "1");
    print hidden("username", param("username"));
    print hidden("password", param("password"));
    print end_form;
  }
}