使 Perl Web 服务器通过 HTTP 向 Chrome 传送 HTML5 音频元素的 ogg

发布于 2024-11-04 17:52:22 字数 3798 浏览 0 评论 0原文

我正在编写一个 Perl 脚本，它充当一个简单的 Web 服务器，通过 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 "";
}

当 GET 请求与 hh.ogg 的正则表达式匹配时，将调用 sendFile 子例程。在关闭之前将 ogg 写入套接字之前，我在响应中发送了一些标头。这段代码的工作原理与我在 Firefox 中的预期完全一样。当我按下播放按钮时，脚本会从 Firefox 收到请求 ogg 的 GET，我将其发送出去，然后 Firefox 就会播放该曲目。

我的问题是脚本在 Google Chrome 中崩溃。 Chrome 的开发者工具只是说无法检索 hh.ogg。当我在脚本运行时在浏览器中访问 127.0.0.1:8888 时，我可以下载 hh.ogg。我注意到 Chrome 会对 hh.ogg 发出多个 GET 请求，而 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 额外模块的情况下完成此任务。

原文

I am writing a Perl script that acts as a simple web server that serves audio files over HTML5. I have succeeded in getting it to show a page to a web browser with an HTML5 audio element. It continues to listen to the socket for when the browser asks for an audio file via a GET request; hh.ogg in this example and tries to respond with the ogg inside the message body. It works over port 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 "";
}

The sendFile subroutine is called when the GET request matches a regex for hh.ogg.
I send a few headers in the response before writing the ogg to the socket before closing.
This code works exactly as I'd expect in Firefox. When I press play the script receives a GET from Firefox asking for the ogg, I send it over and Firefox plays the track.

My problem is the script crashes in Google Chrome. Chrome's developer tools just says it cannot retrieve hh.ogg. When I visit 127.0.0.1:8888 in my browser while the script is running I can download hh.ogg. I have noticed that Chrome will make multiple GET requests for hh.ogg whereas Firefox just makes one. I've read that it may do this for caching reasons? This could be a reason as to why the script crashes.

I have

print $client "Accept-Ranges: none\015\012";

to try and stop this behaviour but it didn't work.

I'm not sure of exactly what headers to respond to Chrome to let it receive the file within one HTTP response. When the script crashes I also occasionally get this message printed out from Perl; otherwise there are no other errors. It will quit somewhere inside the while loop where I syswrite() to the socket.

Use of uninitialized value in addition (+) at ./test.pl line 91, <$fh> line 1.

Which is referring to this line.

$offset += syswrite($client, $scalar, $size, $offset);

I don't know why there would be any uninitialized values.

Would anyone have any ideas why this could be happening? If at all possible I'd like to accomplish this without requiring additional modules from CPAN.

分享到QQ

分享到微博

如果你对这篇内容有疑问，欢迎到本站社区发帖提问参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

发布评论

需要登录才能够评论，你可以免费注册一个本站的账号。

初相遇 2024-11-11 17:52:22

使用真正的网络服务器，而不是已经在工作并经过彻底调试的服务器，而不是自己搞乱套接字。网络总是比你想象的更复杂。使用 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);
};

Use a real web server instead that is already working and thorougly debugged instead of messing with sockets yourself. The Web is always more complicated than you think. Run the following app with 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);
};

回复收藏 0 原文