Форум программистов [Powered by Invision Power Board]

Код

#!/usr/bin/perl
####################################
#          perl-script             #
#     Downloader версия 1.01       #
#                                  #
# Авторские права: Путилин Даниил  #
#                  [email protected] #
# Посвещаю: Репиной Анастасии из   #
#           г.Усмань Липецкой обл. #
####################################

@raz=('zip','rar','gz','mp3');
$b=25;#Порция в Kb
#######################################
#     НАСТРОЙКА И ИСПОЛЬЗОВАНИЕ       #
#  Вся настройка скрипта заключается  #
# в указании пути до Perl, и задании  #
# разрешенных для загрузки расширений #
# в массиве @raz (смотреть выше)!!!!  #
#  В использовании все так же просто! #
# Объясняю на примере: допустим вы    #
# установили данный скрипт по следую-  #
#  щему URL:                            #
# ваш_сервер/cgi-bin/nph-download.cgi    #
# и вам нужно закочать файл с URL:        #
# ваш_сервер/file.zip, для этого надо      #
# обратиться по адресу:                     #
#ваш_сервер/cgi-bin/nph-download.cgi/file.zip#
#              ВСЁ!!!                         #
###############################################

$|=1;

sub download(){
if(exists($ENV{'HTTP_RANGE'})){
 print "HTTP/1.1 206 Partial Content\r\n";
 $bytes=$ENV{'HTTP_RANGE'};
 $bytes=~s/bytes=//;
 $bytes=~s/\-//;
 $range=1;
}else{
 print "HTTP/1.1 200 Ok\n";
 $bytes=0;
}
$file=$ENV{'PATH_TRANSLATED'};
if(!open(H,$file)){ &error('405 File Not Open',"File ($ENV{'PATH_INFO'}) Not Open");}
binmode(H);
binmode(STDOUT);
#seek(H, 0, 2);
#$size=tell(H);
$size=-s $file;
print "X-Scripts: Downloader/1.0\r\n";
print "Accept-Ranges: bytes\r\n";
$siz=$size-$bytes;
$sizes=$size-1;
print "Content-Length: $siz\r\n";
if($range){print "Content-Range: bytes $bytes-$sizes/$size\r\n";}
print "Content-Type: application/x-downloader-file; name=\"$filename\"\r\n";
print "\r\n";
seek(H, $bytes, 0);
$b=$b*1024;
while(!$x){
 if($size <= $b){$b=$size;$x=1;}
 if(read(H,$h,$b)){$size=$size-$b;}
 print $h;
 }
close(H);
}
sub main{
 print "HTTP/1.1 200 Ok\r\n";
 print "Content-Type: text/html\r\n\r\n";
 print "<html>\n<head>\n<META HTTP-EQUIV=\"Pragma\" CONTENT=\"no-cache\">\n<title>Downloader 1.01 :: DEMO</title>\n</head>\n";
 print "<body>\n<center><h1>Downloader 1.01</h1>\n<hr>";
 print "<hr></center>Вот вам <a href='/download/np2003.zip'>ссылка архива</a> для испытаний данного скрипта.(В архиве лежит программа налогоплательшик 2003)<br>\nА вот <a href='/cgi-bin/nph-d.cgi/download/np2003.zip'>тот же архив</a> только загружается c помощью данного скрипта.<br>
А сам скрипт находится <a href='/cgi-bin/nph-d.cgi/download/downloader.zip'>здесь</a>!!!<br> УДАЧИ ИСПЫТАТЕЛЯМ!!!
<hr><center><img src=\"/cgi-bin/count/counter.cgi\"></center></body>\n";
 print "</html>";
}
sub error{
 local($kod,$text)=@_;
 print "HTTP/1.1 $kod\n";
 print "Content-Type: text/html\r\n\r\n";
 print "<html>\n<head>\n<META HTTP-EQUIV=\"Pragma\" CONTENT=\"no-cache\">\n<title>perl-script Downloader 1.01 :: $kod </title>\n</head>\n";
 print "<body>\n<center><h1>perl-script Downloader 1.01</h1><hr><h2> $kod </h2><h3> $text </h3>\n<hr>";
 print "</center>\n</body>\n</html>";
}
if(!exists($ENV{'PATH_INFO'})){&main;}
else{
$filename=$ENV{'PATH_INFO'};
$filename=~s/.*\///;
$rashiren=$ENV{'PATH_INFO'};
$rashiren=~s/.+\.//;
$okey='0';
foreach(@raz){
if($rashiren eq $_){$okey='1';}
}
if($okey eq '0'){&error('403 Forbidden',"Файл <a href='$ENV{PATH_INFO}'>$filename</a> не разрешен для загрузки ([$rashiren])");}
elsif(!-e $ENV{'PATH_TRANSLATED'}){&error('404 File Not Found',"Файл <a href='$ENV{PATH_INFO}'>$filename</a> не найден");}
elsif(!-r $ENV{'PATH_TRANSLATED'}){&error('405 File Not Read',"Файл <a href='$ENV{PATH_INFO}'>$filename</a> не доступен для чтения");}
else{&download;}
}