Я пишу Perl-скрипт, который действует как простой веб-сервер, который обслуживает аудиофайлы через HTML5. Мне удалось заставить его показывать страницу в веб-браузере с аудио-элементом HTML5. Он продолжает прослушивать сокет, когда браузер запрашивает аудиофайл через запрос GET; hh.ogg в этом примере и пытается ответить ogg внутри тела сообщения. Работает через порт 8888.
#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket;
my $port = 8888;
my $server = new IO::Socket::INET( Proto => 'tcp',
LocalPort => $port,
Listen => SOMAXCONN,
ReuseAddr => 1)
or die "Unable to create server socket";
# Server loop
while(my $client = $server->accept())
{
my $client_info;
my $faviconRequest = 0;
while(<$client>)
{
last if /^\r\n$/;
$faviconRequest = 1 if ($_ =~ m/favicon/is);
print "\n$_" if ($_ =~ m/GET/is);
$client_info .= $_;
}
if ($faviconRequest == 1)
{
#Ignore favicon requests for now
print "Favicon request, ignoring and closing client";
close($client);
}
incoming($client, $client_info) if ($faviconRequest == 0);
}
sub incoming
{
print "\n=== Incoming Request:\n";
my $client = shift;
print $client &buildResponse($client, shift);
print "Closing \$client";
close($client);
}
sub buildResponse
{
my $client = shift;
my $client_info = shift;
my $re1='.*?';
my $re2='(hh\\.ogg)';
my $re=$re1.$re2;
print "client info is $client_info";
# Send the file over socket if it's the ogg the browser wants.
return sendFile($client) if ($client_info =~ m/$re/is);
my $r = "HTTP/1.0 200 OK\r\nContent-type: text/html\r\n\r\n
<html>
<head>
<title>Hello!</title>
</head>
<body>
Hello World.
<audio src=\"hh.ogg\" controls=\"controls\" preload=\"none\"></audio>
</body>
</html>";
return $r;
}
sub sendFile
{
print "\n>>>>>>>>>>>>>>>>>>>>>>> sendFile";
my $client = shift;
open my $fh, '<' , 'hh.ogg';
my $size = -s $fh;
print "\nsize: $size";
print $client "Allow: GET\015\012";
print $client "Accept-Ranges: none\015\012";
print $client "Content-Type: \"audio/ogg\"\015\012";
print $client "Content-Length: $size\015\012";
print "\nsent headers before sending file";
############################################
#Take the filehandle and send it over the socket.
my $scalar = do {local $/; <$fh>};
my $offset = 0;
while(1)
{
print "\nsyswriting to socket. Offset: $offset";
$offset += syswrite($client, $scalar, $size, $offset);
last if ($offset >= $size);
}
print "Finished writing to socket.";
close $fh;
return "";
}
Подпрограмма sendFile вызывается, когда запрос GET соответствует регулярному выражению для hh.ogg.
Я отправляю несколько заголовков в ответе перед записью ogg в сокет перед закрытием.
Этот код работает точно так же, как и следовало ожидать в Firefox. Когда я нажимаю play, скрипт получает GET от Firefox с просьбой о ogg, я отправляю его, и Firefox воспроизводит трек.
Моя проблема в том, что скрипт вылетает в Google Chrome. Инструменты разработчика Chrome просто говорят, что не могут получить hh.ogg. Когда я захожу в браузер 127.0.0.1:8888 во время работы скрипта, я могу скачать hh.ogg. Я заметил, что Chrome будет делать несколько запросов GET для hh.ogg, тогда как Firefox просто делает один. Я читал, что это может сделать это по причинам кэширования? Это может быть причиной сбоя скрипта.
У меня есть
print $client "Accept-Ranges: none\015\012";
чтобы попытаться остановить это поведение, но оно не сработало.
Я не уверен, какие именно заголовки должны отвечать Chrome, чтобы он мог получить файл в одном HTTP-ответе. Когда происходит сбой скрипта, я также иногда получаю это сообщение из Perl; в противном случае нет других ошибок. Он выйдет где-то внутри цикла while, где я syswrite () к сокету.
Use of uninitialized value in addition (+) at ./test.pl line 91, <$fh> line 1.
Что относится к этой строке.
$offset += syswrite($client, $scalar, $size, $offset);
Я не знаю, почему будут неинициализированные значения.
У кого-нибудь есть идеи, почему это может происходить? Если это вообще возможно, я бы хотел выполнить это, не требуя дополнительных модулей от CPAN.