Сделайте так, чтобы веб-сервер Perl доставлял ogg через HTTP в Chrome для аудиоэлемента HTML5 - PullRequest
1 голос
/ 29 апреля 2011

Я пишу 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.

Ответы [ 2 ]

3 голосов
/ 30 апреля 2011

Используйте реальный веб-сервер , который уже работает и тщательно отлажен, вместо того, чтобы возиться с сокетами самостоятельно. Интернет всегда сложнее, чем вы думаете. Запустите следующее приложение с plackup --port=8888.

use HTTP::Status qw(HTTP_OK);
use Path::Class qw(file);
use Plack::Request qw();
use Router::Resource qw(router resource GET);

my $app = sub {
    my ($env) = @_;
    my $req = Plack::Request->new($env);
    my $router = router {
        resource '/' => sub {
            GET {
                return $req->new_response(
                    HTTP_OK,
                    [Content_Type => 'application/xhtml+xml;charset=UTF-8'],
                    [ '… HTML …' ]  # array of strings or just one big string
                )->finalize;
            };
        };
        resource '/hh.ogg' => sub {
            GET {
                return $req->new_response(
                    HTTP_OK,
                    [Content_Type => 'audio/vorbis'],
                    file(qw(path to hh.ogg))->resolve->openr # file handle
                )->finalize;
            };
        };
    };
    $router->dispatch($env);
};
2 голосов
/ 29 апреля 2011

Ваша ошибка говорит Use of uninitialized value in addition, что означает, что она не внутри syswrite, а в операции + =.syswrite() возвращает undef в случае ошибки.Что, похоже, согласуется с вашей общей ошибкой в ​​Chrome.Переменная $! содержит некоторую информацию об ошибке записи.

...