В догонку - по поводу CGI: чтобы вставить свой код ответа нужно применить заголовок Status.
Status: 404 Not foundВот реализация программы - ограничителя (download-limit). Тестовая версия.
#!/usr/bin/perl
use DBD::mysql;
my ($dbh, $sth, $ipn, $file, $ctime, $session);
my ($file_length, $range_length, $range_start, $range_end);
my ($fd, $length, $buffer, $pos, $chunk);
sub db_open()
{
$dbh = DBI->connect('DBI:mysql:database=test', 'test', 'test', {RaiseError => 1});
}
sub db_close()
{
$dbh->disconnect();
}
sub sess_open()
{
my @ip = split(/\./, $ENV{REMOTE_ADDR});
$ipn = $ip[0] << 24 | $ip[1] << 16 | $ip[2] << 8 | $ip[3];
db_open();
$sth = $dbh->prepare("SELECT ctime, file FROM limit_sessions WHERE ip = $ipn");
$sth->execute();
if ($sth->rows())
{
my $res = $sth->fetchrow_hashref();
$session = 1;
$ctime = $res->{ctime};
$file = $res->{file};
}
else
{
$session = 0;
$ctime = time();
$file = $ENV{PATH_TRANSLATED};
$dbh->do("INSERT INTO limit_sessions (ip, ctime, file) VALUES ($ipn, $ctime, ?)", undef, $file);
}
$sth = undef;
db_close();
}
sub sess_close()
{
db_open();
$dbh->do("DELETE FROM limit_sessions WHERE ip = $ipn");
db_close();
}
sub sig_hup
{
sess_close();
exit 0;
}
sub debug
{
open my $fd, ">>__log__$$";
print $fd shift;
close $fd;
}
##############################
use sigtrap qw(handler sig_hup any);
$| = 1;
sess_open();
print "Connection: closed\n";
for my $k (sort keys %ENV)
{
debug "$k = $ENV{$k}\n";
}
if ($session)
{
print "Status: 503 Service Unavalable\n";
print "Content-Type: text/plain\n";
print "\n";
print "Only one session permitted!\n";
exit 0;
}
###
$file_length = (stat($file))[7];
if (exists $ENV{'HTTP_RANGE'} and $ENV{'HTTP_RANGE'} =~ m/bytes=(\d+)?-(\d+)?/)
{
$range_start = $1;
$range_end = $2;
}
$range_start += 0;
if (!$range_end)
{
$range_end = $file_length - 1;
}
$range_length = $range_end - $range_start + 1;
debug "$file_length, $range_start-$range_end/$range_length\n";
print "Content-Type: application/octet-stream\n";
print "Accept-Ranges: bytes\n";
print "Content-Length: $range_length\n";
if ($range_length != $file_length)
{
print "Content-Range: $range_start-$range_end/$file_length\n";
print "Status: 206 Partial content";
}
print "\n";
open my $fd, "<$file";
seek $fd, $range_start, 0;
$chunk = 1024;
for ($pos = $range_start; $pos <= $range_end; )
{
$length = ($pos + $chunk - 1 <= $range_end) ? $chunk : $range_end - $pos + 1;
read $fd, $buffer, $length;
print $buffer;
}
close $fd;
sess_close();
exit 0;
Настройки Апача:
<Directory /var/www/my.site.com/www/>
Action download-limit /cgi-bin/download-limit.pl
SetHandler download-limit
</Directory>
Таблица для хранения сессий.
CREATE TABLE limit_sessions (
ip INT UNSIGNED NOT NULL,
ctime INT UNSIGNED DEFAULT NULL,
file VARCHAR(400) NOT NULL,
PRIMARY KEY (ip)
);
Смысл такой: в апаче ставится обработчик (в виде CGI-программы) на директорию. Апач проверяет наличие запрашиваемого файла, запускает CGI-скрипт и пережает ему в переменных окружения все необходимые сведения (PATH_TRANSLATED - уже оттранслированный путь к файлу). Далее программа решает, что выдать: 503, 200 или 206 и пережает требуемый диапазон из файла.
В тесте мне удавалась скорость 250 кБ/с. Прямое скачивание - около 500 кБ/с (предел моего инета). Думаю, если поиграться $chunk и $|, то можно поднять производительность.