|
you might want to look at a cgi scripts like this one, which i use. It
provides an upload/download area. you will need to configure
authentication in apache in case you want security, the script does not
do any authentication. i run it on an apache ssl server and use basic
auth. I cant seem to locate the original source. i suspect it is this one - Jeff's Scripts Archive: File Upload - http://www.terminalp.com/scripts/file_upload.shtml but the domain seems to have expired right now. anyway i am attaching the script. i have made some very minor changes to make it more useful. steve wrote: -----BEGIN PGP SIGNED MESSAGE----- |
#!C:/Perl/bin/perl.exe # Ultra simple uploader script. =pod =head1 NAME upload.cgi
This is an extremely basic, simple uploader script. It does NOT provide
any authentication, you are expected to provide authentication youself
via Apache directives.
This is an ideal solution for intranets or quickly allowing clients/staff
to upload files to your server. For example, you could place it in
a members area for staff to quickly exchange documents.
It is B<NOT> an ideal solution for public access.
=head1 INSTALL
In a hurry? Installed CGI scripts in the past? look for BEGIN CONFIGURATION
and start from there.
=over 4
=item drop in cgi-bin
Or wherever your server is configured to run CGI scripts.
Set it's permissions to 755.
=item Create upload directorie(s)
Create one or more directories to upload into, make sure the server can write
to them. (may need permissions set to 777)
=item Configure Script.
Set up an upload areas and toggle desired features.
Skip ahead to: BEGIN CONFIGURATION
=head1 WARRANTY
There is no warranty expressed nor implied, USE AT YOUR OWN RISK. It
can be dangerous to allow people to upload files to your server. Even
more dangerous to allow pipes.
You must leave the footers in this message. (the link to the geniegate
site)
=head1 CONFIGURATION
Configuration is done by editing a few variables near the
top of this file. The only critical one is %UPLOADS,
which is, where you want the files to go.
(The form can have multiple upload areas, each one labeled)
=over 4
=cut
#use strict;
use CGI;
use vars qw(%UPLOADS $REQUIRE_PASSWORD $ALLOW_PIPE);
=item %UPLOADS
This is a map of labels to directories (or programs)
Each label is shown on the form within the select box. The directory
is where the file is placed after uploading.
$UPLOADS{Staff} = '/home/staff/uploads';
Pipes are also supported.
You can specify a pipe instead of a directory, in which
case, the directory is expected to be a program. The program
is then opened, with the file contents piped into it's standard
input.
If a program is used, it's output is sent to the browser
in the form of text.
Here is how one could upload to the "sort" directory.
$UPLOADS{Sort_Me} = '|/usr/bin/sort';
In the above example, the file is sorted and sent back to the
browser.
The program has the environment variables C<WANT_FILENAME>
and C<REMOTE_FILENAME> set.
PIPES are meant to provide a simple web interface to unix commands.
=cut
#----------- BEGIN CONFIGURATION -----------------
$UPLOADS{Current} = '.';
# $UPLOADS{Sort} = '|/usr/bin/sort';
# $UPLOADS{Env} = '|/usr/bin/env';
# $UPLOADS{Staff} = '/path/to/staff/dir';
=item REQUIRE_PASSWORD
If set to a true value, this script will not run without
a remote_user. This isn't a guarantee of security! it is just meant to
protect against accidental installations.
=cut
$REQUIRE_PASSWORD = 1;
=item ALLOW_PIPE
To use pipes, you need to set this to a TRUE value. This is
a safety measure, designed to prevent accidental pipe usage.
=cut
$ALLOW_PIPE = 0;
# Script URI.
my($NAME) = $ENV{SCRIPT_NAME};
#---------------- END OF CONFIGURATION --------------
&main();
sub main {
$cgi = new CGI();
#$ENV{PATH} = '/bin:/usr/bin';
delete($ENV{TERM});
my($self) = {};
bless($self);
if(! $ENV{REMOTE_USER}){
if($REQUIRE_PASSWORD){
return($self->error("This form must be password
protected"));
}
}
my($opt) = $cgi->param('ACTION');
if(! $opt){
$self->header();
#print $self;
#print $cgi->script_name;
$sort = $cgi->param('sort');
$self->form($cgi);
$self->footer();
return;
}
eval {
$self->do_upload($cgi);
};
if($@){
$self->error($@);
}
}
sub do_upload {
my($self,$cgi) = (shift,shift);
my($name) = $cgi->param('NAME') || $cgi->param('FILE');
my($dir) = $cgi->param('DIR');
my($upload) = $UPLOADS{$dir};
my($is_pipe) = 0;
$name =~ s/\\/\//g;
$name =~ s/\:/\//g;
my(@path) = split(/\//,$name);
$name = pop(@path);
$name =~ /([^\\\/\:\*\?\"\<\>\|]+)/;
$name = $1;
if(! $name){
die "Must supply a <I>valid filename name</I> (no weird
characters)\n";
}
if($upload =~ /^\|/){
die "\$ALLOW_PIPE has not been set" unless($ALLOW_PIPE);
print "Content-Type: text/plain\n\n";
$is_pipe = 1;
$ENV{WANT_FILENAME} = $name;
$ENV{REMOTE_FILENAME} = $cgi->param('FILE');
open(OUT,"$upload 2>&1");
}elsif(-d $upload){
my($of) = "$upload/$name";
if(-e $of){
die "Filename: $name exists, please use another name\n";
}
open(OUT,">$of") || die "$of : $!\n";
}else{
die "$dir does not exist";
}
my($fh) = $cgi->upload('FILE');
binmode($fh);
binmode(OUT);
while(<$fh>){
print OUT;
}
close(OUT); # No way to report exit code, we're sending the output to
the command.
if(! $is_pipe){
$self->header();
$self->status("Upload of <i>$name</i> OK");
$self->footer();
}
}
sub status {
my($self,$msg) = (shift,shift);
print <<__EOF;
<div class="box">
<h1>Upload status</h1>
<p>$msg</p>
</div>
<div class="bar"> </div>
__EOF
$self->form();
}
sub form {
my($self) = shift;
my($n,$opt);
my $post = $cgi->script_name;
foreach $n (keys(%UPLOADS)){
$opt .= "<option value='$n'>$n</option>";
}
print <<__EOF;
<form class="box" action="$post" method="post"
enctype="multipart/form-data">
<h1>Upload File</h1>
<input name="ACTION" value="upload" type="hidden">
<p> <label>Local File</label><input
name="FILE" value="" type="file"> </p>
<p> <label>Remote Name</label><input name="NAME" type="text"> </p>
<p> <label>Directory</label>
<select name="DIR">$opt</select>
</p>
<p>
<input value="Upload" type="submit"> </p>
</form>
<p style="text-align: center;"> Select area via the pulldown menu,
optionally provide a new name
and click <i>Upload</i> to upload your file. </p>
__EOF
$self->dirlist();
}
sub error {
my($self,$ermsg) = (shift,shift);
$self->header();
print "<div class=\"box\">\n";
print "<h1>Error</h1>\n";
print "<p><b>$ermsg</b></p>\n";
print "</div>\n";
$self->footer();
}
sub header {
print "Content-Type: text/html\n\n";
my $style = qq(
<style>
body { margin-left: 5%; margin-right: 5%; background-color: #f5f1c4;}
p { margin-left: 5%; margin-right: 5%; }
label { margin-left: 5%; padding: 0%; }
input { position: absolute; left: 50%; }
form { background-color: #ffefb4; }
select { position: absolute; left: 50%; }
.bar { background-color: #b295b1; }
input[type=SUBMIT] { color: blue; position: absolute; left: 50%; }
h1 { color: blue; text-align: center; font-size: 14pt;
border-bottom-width: 2px; border-bottom-color: blue; border-bottom-style:
solid; }
.box { border-style: solid; border-color: black; margin-top: 5%;
margin-bottom: 5%;
border-width: 1px; margin-left: 20%; margin-right: 20%; }
</style>
);
print <<__EOF;
<html>
<head><title>File Upload</title>
$style
</head>
<body>
<div class="bar"> </div>
__EOF
}
sub footer {
# You MUST leave the advertisement intact! Contact us if you have a problem
# with this, as there are exceptions granted. Clients are permitted to
# remove the ad if they so desire.
print qq(
<hr />
<div style="text-align: center">
Copyright © 2006
::
<a href="http://www.terminalp.com/scripts/";>Jeff's
Scripts Archive</a>
</div>
<div style="text-align: center">
<i>No warranty, expressed or implied. Use at your own risk.</i>
</div>
<br />
</p>
</body>
</html>
);
}
#sub sortby($$);
sub dirlist()
{
#----------------- Configuration -------------------
#$htroot = "/www/"; # The location of your html documents (must end
in /)
#$dirroot = "/"; # The toplevel url path... no links to above this
#$defaultdir = "/"; # the default url path to look in if no
arguments --
# relative to $dirroot.
$printsizes = 1; # print file sizes with the names?
$printtypes = 1; # print file kinds with the names?
$printdates = 1; # print file mod dates with names?
$usetables = 1; # use HTML 3 Tables in output?
#----------------- End Configuration ---------------
#use CGI;
#$q = new CGI;
@months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
# Choose the directory to list
#$dir = $q->param("keywords");
#$dir = $defaultdir if !$dir;
#while ($dir =~ s%(^|/)\.\.($|/)%%g) {;} # Don't allow listing ..
#$htroot .= "/" if $htroot !~ m%/$%;
#$dirroot .= "/" if $dirroot !~ m%/$%;
my $dir = ".";
$dir .= "/" if $dir !~ m%/$%;
# Try to go to the directory
#chdir ($htroot . $dirroot . $dir) or
# &fatal ("Cannot list directory $dir: $!");
# We are in the directory. Now we get the list of files.
#opendir DIR , "$htroot$dirroot$dir";
opendir DIR , ".";
foreach (readdir DIR) {
($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
$atime, $mtime, $ctime, $blksize, $blocks) = stat $_;
#next if !$dev;
next if /^\./; # Ignore . files
next if /~$/; # Ignore emacs backup files
# Add any extra ignored files here...
$dates{$_} = $mtime;
#print $mtime;
$sizes{$_} = $size;
{
$types{$_} = "Directory", last if -d _;
$types{$_} = "MPEG movie", last if /\.mpg$/i;
$types{$_} = "Quicktime movie", last if /.mov$/i;
$types{$_} = "JPEG image", last if /\.jpg$/i;
$types{$_} = "GIF image", last if /\.gif$/i;
$types{$_} = "HTML document", last if /\.html$/i;
$types{$_} = "CGI program", last if /\.cgi/i;
# Add any extra file types here...
}
}
closedir DIR;
# Output routine ----------------------------
#print "Content-type: text/html\n\n";
$started = 1;
#print <<EOHTML;
#<HTML>
#<HEAD><TITLE>Listing of $dir</TITLE></HEAD>
#<BODY>
print <<EOHTML;
<H3>Download file $dir</H3>
EOHTML
print "<TABLE>\n" if $usetables;
print '<TR><TD> <A HREF="',$cgi->script_name,'?sort=name">Sort by
Name</A><TD><A HREF="',$cgi->script_name,'?sort=type">Sort by Type</A><TD><A
HREF="',$cgi->script_name,'?sort=time">Sort by Time</A><TD><A
HREF="',$cgi->script_name,'?sort=size">Sort by Size</A></TR>';
#print keys %dates;
foreach (sort sortby keys %dates) {
print "<TR><TD>\n" if $usetables;
print "<b>";
{
$href="$dir$_";
$href=~ s%//%/%g; # remove extra // pairs.
#print (qq%<A HREF="%, $cgi->script_name, qq%?$href">$_/</A>%), last
# if $types{$_} =~ /Directory/i;
# Add any extra link types here...
#$href="$dirroot$dir$_";
#$href=~ s%//%/%g; # remove extra // pairs.
print qq%<A HREF="$href">$_</A> %;
}
print "</b>";
$date = (localtime($dates{$_}))[3] . " " .
$months[(localtime($dates{$_}))[4]] . " " .
(localtime($dates{$_}))[5]. " " .
(localtime($dates{$_}))[2] . ":" .
sprintf("%02d", (localtime($dates{$_}))[1]);
$size = $sizes{$_} < (1024) ?
($sizes{$_}) . " bytes" : (
$sizes{$_} < (1024 ** 2) ?
(int (10 * $sizes{$_}/1024)/10) . "K" : (
$sizes{$_} < (1024 ** 3) ?
(int (10 * $sizes{$_}/(1024 ** 2) )/10) . "MB" :
((int (10 * $sizes{$_}/(1024 ** 3) )/10) . "GB")));
print "<TD>" if $printtypes && $usetables;
print qq% [$types{$_}]% if $printtypes && $types{$_};
print "<TD>" if $printdates && $usetables;
print qq% [$date]% if $printdates && $date;
print "<TD>" if $printsizes && $usetables;
print qq% [$size]% if $printsizes &&
$types{$_} !~ /Directory/i && $size;
print "<BR>\n" unless $usetables;
print "</TR>\n" if $usetables;
}
print "</TABLE>\n" if $usetables;
#($up) = $dir =~ m%([^/]+)/$%;
#$parent = $`;
#($up) = $parent =~ m%([^/]+)/?$%;
#if ($dir ne $dirroot && $parent) {
# print "<HR>";
# print qq%<A HREF="%, $q->script_name,
# qq%?$parent">Up a dir ($up/)</A>%;
#
}
#print "</BODY></HTML>\n";
sub sortby {
#print $cgi->param('sort');
#print $a,$b;
return $sizes{$b} <=> $sizes{$a} if $sort =~ /size/;
return $types{$a} cmp $types{$b} if $sort =~ /type/;
return $dates{$b} <=> $dates{$a} if $sort =~ /time/;
return lc $a cmp lc $b ;
}
#--------------- Subroutines --------------------------------------
sub fatal {
#print "Content-type: text/html\n\n" if !$started;
#print "<TITLE>Error...</TITLE>";
print "<H2>Error!</H2>";
print "An error occured while listing this directory. " .
"The message was:";
print "<PRE>@_</PRE>";
#exit;
}
--------------------------------------------------------------------- The official User-To-User support forum of the Apache HTTP Server Project. See <URL:http://httpd.apache.org/userslist.html> for more info. To unsubscribe, e-mail: [EMAIL PROTECTED] " from the digest: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
