1

我正在编写一个 Perl 脚本，它充当一个简单的 Web 服务器，通过 HTML5 提供音频文件。我已经成功地让它向带有 HTML5 音频元素的 Web 浏览器显示页面。当浏览器通过 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 接收到 GET 请求 ogg，我将其发送过来，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 打印出这条消息；否则没有其他错误。它会在我 syswrite() 到套接字的 while 循环内的某个地方退出。

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

这是指这条线。

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

我不知道为什么会有任何未初始化的值。

有人知道为什么会发生这种情况吗？如果可能的话，我想在不需要 CPAN 的其他模块的情况下完成此操作。

4

2 回答 2

3

使用真正的 Web 服务器，它已经在工作并经过彻底调试，而不是自己弄乱套接字。网络总是比你想象的要复杂。运行以下应用程序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);
};
于 2011-04-30T10:22:29.473 回答
2

您的错误说明Use of uninitialized value in addition这意味着它不在 syswrite 中，而是在 += 操作中。syswrite()如果有错误返回undef。这似乎与您对 Chrome 的整体错误一致。该$!变量包含有关写入错误的一些信息。

于 2011-04-29T10:52:31.530 回答