1

HTML5 経由でオーディオ ファイルを提供する単純な Web サーバーとして機能する Perl スクリプトを作成しています。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 は 1 つしか作成しないことに気付きました。キャッシングの理由でこれを行う可能性があることを読みましたか? これが、スクリプトがクラッシュする理由である可能性があります。

私は持っている

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

この動作を停止しようとしましたが、うまくいきませんでした。

Chrome が 1 回の 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 から追加のモジュールを必要とせずにこれを達成したいと考えています。

4

2 に答える 2

3

自分でソケットをいじる代わりに、すでに機能していて徹底的にデバッグされている実際のWebサーバーを使用してください。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 に答える