#!/usr/bin/perl
############################################################################
### Copyright (C) Tripodics.com
### Author: Bruce A. Martin
### File Name: upfile.pl
### Purpose: Upload a binary file
### Versions:
my $ver="8.1";
### 8.1 bam:2009/303 Add .sim to list
### 8.0 bam:2008/521 Revise (dirs, cgi-bin, etc.) and fix security
# FORM METHOD=POST
### 7 bam:2006/11/15 upfile.pl (was fileup.pl) -- might become obsolete, in favor of "upreplace.pl"
### 0.1 bam:2004/10/23 Upload binary file(s) (into parent dir).
### 0.0 (based on modify.pl + upload.cgi)
#############################################################################
#### Boilerplate:
#
use strict;
use CGI qw/:standard/;
$| = 1;
my $bug=1; # Debugging flag.
print header; # Begin HTML output.
print "";
#### Get form parameters from URL.
#
my %in_para;
foreach (param()){
$in_para{$_} = join " ", param($_);
# Multiple-values (checkbox) joined with blanks.
$bug<5 or print "
% $_ : $in_para{$_} ";
}
#FROM: http://www.sitepoint.com/article/uploading-files-cgi-perl/2
my $query = new CGI;
my $filename = $query->param("UPFILE");
$filename =~ s/.*[\/\\](.*)/$1/;
my $upload_filehandle = $query->upload("UPFILE");
#-- my $filename= $in_para{UPFILE};
#?? if ($filename =~ /^[^A-Za-z0-9]*$/) {$filename = "test.dat";}
#
## Allowable characters only.
$filename =~ s|[^-A-Za-z0-9_/.]|_|g;
&sterilize( $filename );
#-- ## Security considerations.
#-- $filename =~ s|[.][.][.]*||g; # Disallow multiple dots.
#-- $filename =~ s|^\.||g; # Disallow leading dot.
#-- $filename =~ s|^/||g; # Disallow leading slash.
#-- $filename =~ s|/\.||g; # Disallow slash dot.
#-- $filename =~ s|//*|/|g; # Disallow multiple slashes.
#-- $filename =~ s|~||g; # Disallow tilde (~username).
if ( -e $filename) {
#if ( ! -d $filename) { print "$filename is directory.\n"; }
if ( ! -d $filename) { ; }
elsif ( ! -T $filename) { print "$filename is a symbolic-link.\n"; }
elsif ( ! -T $filename) { print "$filename is not a text file.\n"; die; }
elsif ( ! -w $filename) { print "$filename cannot be written.\n"; die; }
}
my $ext; # Extract file type. bam:7a08:
$ext= $filename;
$ext =~ s;(^.*)\.([^\.]*$);\2;;
######## PATHS & FILENAMES ########
my $pwd= `pwd`;
my $ppwd= `cd ..; pwd`; # Parent directory.
my $sub= `cd ..; basename \`pwd\` `; chop $sub;
#my $dirname = $path . "./";
my $dirname = "";
my $DIRNAME = $in_para{DIRNAME};
#if ($DIRNAME =~ /^$/) { $DIRNAME="."; }
$DIRNAME =~ s|/*/|/|g; # No adjacent slashes.
#if ($DIRNAME) { $dirname = $path . $DIRNAME . "/"; }
if ($DIRNAME) { $dirname = $DIRNAME . "/"; }
if ($DIRNAME =~ /^\//) { $DIRNAME=~ s/^\/*//g; }
if ($DIRNAME =~ /^\/$/) { $DIRNAME=""; }
#### Set prefix to path. ####
my $prepath = "../..";
#### Useful strings.
#
my $Q = '"';
my $LT = '<';
my $GT = '>';
#$LT="^"; #++++++ FOR DEBUGGING, MAKE TAGS VISIBLE!
my $TAG = $LT;
#
my $TAB= " ";
my $NBSP= " ";
my $SP4= " ";
my $stamp= $^T; # Timestamp.
#### Global variables.
my $text="";
#### Main processing. ####
#
print "
ERROR: Nothing was uploaded: ";
print "$pwd/$f
\n";
}
else {
print "