#!/usr/bin/perl5.00503
#
# File Upload Script        Version 6.00
# Created by Jeff Carnahan  jeffc@terminalp.com
# Created on: 4/8/95        Last Modified on: 01/23/98 23:06
# Scripts Archive:          http://www.terminalp.com/scripts/
#
# ---------------------------------------------------------------------
#
# Copyright (C) 1996 Jeffrey D. Carnahan
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or (at
# your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# A full copy of the GNU General Public License can be retrieved from
# http://www.terminalp.com/scripts/license.shtml
#
# - Jeff Carnahan <jeffc@terminalp.com
#
# ---------------------------------------------------------------------
# Program Specific Quickie Notes:
#   * Make Sure The First Line Is Pointing To The Correct Location Of Perl 5.
#   * Make Sure This Program is chmodded with the permissions '755'.
#
#  Version:  Time Stamp:        History:
#  ____________________________________________________________________
#
#     1.00  04/08/96 00:00     The script was created.
#     1.10  04/23/96 00:00     Added User and Group ID to allow file
#                              changing by the actual user, also updated
#                              a security hole which allowed any user with
#                              the UID of 1376 to own the uploaded files.
#                              Also Updated the INSTALL program and README
#                              files.
#     3.00  05/07/96 00:00     New release with group and user id fixes, it
#                              updates a previously unreleased version (2.0)
#     3.10  05/10/96 00:00     Stupid Typo in script fixed, it was
#                              causing problems for some users.
#     4.00  08/04/96 23:16     Security hole regarding '../' paths
#                              fixed.  Thanks to: Rus Berrett.  Mime
#                              type error fixed.  Thanks to: Bob Stewart.
#     4.01  08/07/96 11:20     Typo fixed in &NoOpen.  Thanks to Marco
#                              Dings.
#     5.00  10/06/96 21:42     Fully rewrote script around CGI.pm library.
#                              As soon as I get the time, I'll write more
#                              features into it, but for now, this version
#                              is stable (to the best of my knowledge).
#     5.01  02/09/97 12:41     Fixed some typo's, and added support for
#                              Netscape Communicator.
#     5.02  05/07/97 15:37     Fixed a possible binary file uploading,
#                              added easier support for NT, and fixed
#                              documentation problems. Added the FAQ.
#     5.03  06/19/97 17:30     Fixed a bug which resulted in all files
#                              appearing to be less than one byte in
#                              size, thus uploads weren't saved.
#     6.00  01/23/98 23:06     Added multiple-file uploading.  You can
#                              now upload more than one file at a time.
#                              Also added $MAXIMUM_UPLOAD variable to
#                              restrict file upload sizes.  Script 
#                              completely re-written.  Removed buggy
#                              NT support, and simplified variables.
#                              CGI.pm is no longer bundled with this 
#                              script.  If you need it, download it 
#                              from:
#       http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
#                             
# ---------------------------------------------------------------------
# Configurable Options Follow:
#
$Inputdir = "/tmp"; # no trailing slash please

BEGIN {
    

    # --> Variable:
    #         $Inputdir
    # --> Function:
    #         Defines the path to the directory
    #         on the server that should be used
    #         as the folder to save files into.
    # --> Directory Permissions:
    #         a+rwx
    # --> Additional Notes:
    #         This path should not have a
    #         trailing forward slash.  Also
    #         remember that this is a path, not
    #         a URL.  Use something similar to:
    #
    #         /home/myself/www/uploads
    #
    
    $MAXIMUM_UPLOAD = 500000;
    #
    # --> Variable:
    #         $MAXIMUM_UPLOAD
    # --> Function:
    #         Defines the number of bytes that
    #         can be uploaded.  Files that exceed
    #         this limit will not be saved on the
    #         server.
    # --> Additional Notes:
    #         Set this to zero in order to 
    #         disable size checking.
    #
    
    $ALLOW_INDEX = 0;
    #
    # --> Variable:
    #         $ALLOW_INDEX
    # --> Function:
    #         If set to zero, files whose
    #         names begin with the word 
    #         index will not be saved.
    # 
    #         Set to one to allow files
    #         named index* to be uploaded.
    # --> Additional Notes:
    #
    
    $SUCCESS_LOCATION = ""
      #
      # --> Variable:
      #         $SUCCESS_LOCATION
      # --> Function:
      #         Defines the URL that users
      #         should be redirected to if 
      #         the script works properly.  If
      #         this is left blank, a default
      #         page will be returned to the
      #         user.
      # --> Additional Notes:
      #         This is a COMPLETE URL, not
      #         a path.
}
#
# End of Configurable Options.
# ---------------------------------------------------------------------
# ---------------------------------------------------------------------
# -->           Do Not Change Anything Below This Line.           <-- #
# ---------------------------------------------------------------------
# ---------------------------------------------------------------------

$| = 1;
chop $Inputdir if ($Inputdir =~ /\/$/);
use CGI qw(:standard);
$query = new CGI;

if ( (!(-e $Inputdir)) ||
     (!(-W $Inputdir)) ||
     (!(-d $Inputdir)) ) {
  print header;
  print <<__END_OF_HTML_CODE__;
  
  <HTML>
    <HEAD>
      <TITLE>Error: Bad Directory</TITLE>
        </HEAD>
            <H1>Bad Directory</H1>
              <P>
                The directory you specified:
                <BR>
                  <BLOCKQUOTE>
                    <TT>\$Inputdir = "<B>$Inputdir</B>";</TT>
                      </BLOCKQUOTE>
                        <BR>
                          is invalid.  This problem is caused by one of the three following reasons
                  </BODY>
                    </HTML>
                      
__END_OF_HTML_CODE__
                        exit;
}

foreach $key (sort {$a <=> $b} $query->param()) {
  next if ($key =~ /^\s*$/);
  next if ($query->param($key) =~ /^\s*$/);
  next if ($key !~ /^file-to-upload-(\d+)$/);
  $Number = $1;
  
  if ($query->param($key) =~ /([^\/\\]+)$/) {
    $Filename = $1;
    $Filename =~ s/^\.+//;
    $File_Handle = $query->param($key);
    
    if (!$ALLOW_INDEX && $Filename =~ /^index/i) {
      print header;
      print <<__END_OF_HTML_CODE__;
      
      <HTML>
        <HEAD>
          <TITLE>Error: Filename Problem</TITLE>
            </HEAD>
                <H1>Filename Problem</H1>
                  <P>
                    
                    </BODY>
                      </HTML>
                        
__END_OF_HTML_CODE__
                          exit;
    }
  } else {
    $FILENAME_IN_QUESTION = $query->param($key);
    
    print header;
    print <<__END_OF_HTML_CODE__;
    
    <HTML>
      <HEAD>
        <TITLE>Error: Filename Problem</TITLE>
          </HEAD>
            <BODY BGCOLOR="#FFFFCC">
      <H1>Filename Problem</H1>
                <P>
                 
                  </BODY>
                    </HTML>
                      
__END_OF_HTML_CODE__
                        exit;
  }
  if (!open(OUTFILE, ">$Inputdir\/$Filename")) {
    print "Content-type: text/plain\n\n";
    print "-------------------------\n";
    print "Error:\n";
    print "-------------------------\n";
    print "File: $Inputdir\/$Filename\n";
    print "-------------------------\n";
    print "There was an error opening the Output File\n";
    print "for Writing.\n\n";
    print "Make sure that the directory:\n";
    print "$Inputdir\n";
    print "has been chmodded with the permissions '777'.\n\n";
    print "Also, make sure that if your attempting\n";
    print "to overwrite an existing file, that the\n";
    print "existing file is chmodded '666' or better.\n\n";
    print "The Error message below should help you diagnose\n";
    print "the problem.\n\n";
    print "Error: $!\n";
    exit;
  }
  
                undef $BytesRead;
  undef $Buffer;
  
  while ($Bytes = read($File_Handle,$Buffer,1024)) {
    $Buffer =~ s/\r//g;
#   ALI/SUSHIL's filter for allowing only numbers
    if($Buffer =~ /[^0123456789. \t\n]/) {
	print("\nThe file $Filename has an invalid format\nExiting program..\n");
	close(OUTFILE);
	unlink("$Inputdir\/$Filename");
	exit;
    }
#  END FILTER
    $Bytes = length($Buffer);
    $BytesRead += $Bytes;
    print OUTFILE $Buffer;
  }
  
  push(@Files_Written, "$Inputdir\/$Filename");
  $TOTAL_BYTES += $BytesRead;
  $Confirmation{$File_Handle} = $BytesRead;
  
  close($File_Handle);
  close(OUTFILE);
  
  chmod (0666, "$Inputdir\/$Filename");
}

$FILES_UPLOADED = scalar(keys(%Confirmation));


if ($TOTAL_BYTES > $MAXIMUM_UPLOAD && $MAXIMUM_UPLOAD > 0) {
  foreach $File (@Files_Written) {
    unlink $File;
  }
  
  print header;
  print <<__END_OF_HTML_CODE__;
  
  <HTML>
    <HEAD>
      <TITLE>Error: Limit Reached</TITLE>
        </HEAD>
            <H1>You have exceeded the maximum upload limit.  Please contact
technical support.</H1>
              <P>
        
                </BODY>
                  </HTML>
                    
__END_OF_HTML_CODE__
                      exit;
}

if ($SUCCESS_LOCATION !~ /^\s*$/) {
  print $query->redirect($SUCCESS_LOCATION);
} else {
  
  
  print header;
  print <<__END_OF_HTML_CODE__;
  <HTML>
    <HEAD>
          <TITLE>Upload Finished</TITLE>
            </HEAD>
                                  <P>
                    You uploaded <B>$FILES_UPLOADED</B> files totalling <B>$TOTAL_BYTES</B> total bytes.  Individual
                      file information is listed below:
			<P>
                      <PRE>
__END_OF_HTML_CODE__
  $ii = 0;
  foreach $key (keys (%Confirmation)) {
    print "$key - $Confirmation{$key} bytes\n";
    $fnames[$ii] = $key;
    $ii++;
  }
  print <<__END_OF_HTML_CODE__;
      </PRE>
	  <CENTER>
        <B>  Data File(s) Has/Have Been Uploaded </B> <BR>
 <B> <a href="http://gaspac.cs.unr.edu:8080/~sushil/gaas/"> Continue </a> </B>
                      <PRE>
			  </CENTER>

        
                  </HTML>
                    
__END_OF_HTML_CODE__

  exit; 
}

# ---------------------------------------------------------------------
# EOF

