Download somefile.txt
#!/usr/bin/perl -wT
use strict;
use CGI;
# clean up the environment for CGI use
BEGIN {
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
$ENV{'PATH'} = '/bin:/usr/bin:';
}
$CGI::DISABLE_UPLOADS = 1;
$CGI::POST_MAX = 1024;
my $q = new CGI;
my $filepath = '/vs/www.yoursite.com/';
my $filename = $q->param('filename');
# stop backing up path with filname like ../../../etc/passwd
invalid($filename) if $filename =~ m|../|;
# untaint $filename - allow alphanumerics . - and / in name
($filename) = $filename =~ m|^([\w\d.-/]+)\z|;
download_file( $filepath, $filename );
exit;
sub download_file {
my ($filepath,$filename) = @_;
invalid($filename) unless -e $filepath.$filename;
my $filesize = -s filepath.$filename; # could use _
print "Content-disposition: attachment; filename=$filename\n";
print "Content-Length: $filesize\n";
print "Content-Type: application/octet-stream\n\n";
my $buffer;
open FILE, $filepath.$filename or die "Oops $!";
binmode FILE;
binmode STDOUT;
print $buffer while read(FILE, $buffer, 4096);
close FILE;
}
sub invalid {
my $filename = shift;
print $q->header, "$filename does not exist on this server";
exit;
}