Perlのソケット接続のタイムアウト

質問

Perlのソケット接続、connectで接続に失敗した時にdieではなく、別の接続先に接続するよう、次のように書きました。
connect(ファイルハンドル, 接続先1) || connect(ファイルハンドル, 接続先2) || die;

上記のコードではundefが帰って来た時にしか次の接続先に接続せず、例えばサーバーが応答せず、パケットをドロップしているような場合だと接続先1への接続でプログラムがハングアップしたような状態になります。

それぞれのconnectにタイムアウト時間を設けたいのですが、どのようにしたらよろしいのでしょうか。
また、ソケット接続にタイムアウトを設定できるモジュールがありましたらそちらを利用したいと思います。

Perl初心者で大変恐縮ですが、何卒宜しくお願い致します。

回答No.3

kumoz · ベストアンサー

次のプログラムを使って、自宅でテストしたところ接続に成功しました。プログラムの誤りではなく、connect 試行中に時間切れになっているのではないかと思います。

use strict;
use warnings;
use Socket;

socket(SOCK, PF_INET, SOCK_STREAM, 6) or die $!;

eval {
local $SIG{ALRM} = sub { die "timeout1"; };
alarm 5;
connect(SOCK, sockaddr_in("80", inet_aton("192.168.0.13"))) || die "$!";
alarm 0;
};

if ($@) {
alarm 0;
print $@;
die;
}

close SOCK;
print "connect test OK\n";

参考までに記すと、開いていないポート番号を指定した場合は、瞬時にエラーになります。

> 接続を拒否されました at xxx.pl line 10.
> 接続を拒否されました at xxx.pl line 10.
> ...propagated at xxx.pl line 17.

誤った IP アドレスに指定すると、数秒後に以下のエラーメッセージが表示されます。

> ホストへの経路がありません at xxx.pl line 10.
> ホストへの経路がありません at xxx.pl line 10.
> ...propagated at xxx.pl line 17.

alarm 2; に変更すると、タイムアウトエラーに変わります。

> timeout1 at xxx.pl line 8.
> timeout1 at xxx.pl line 8.
> ...propagated at xxx.pl line 17.

お礼

丁寧に実証して頂きありがとうございます。
こちらでも同じことは確認できました。
ただ、本来の目的である、つながらない場合は次の接続先につなぐということ（先ほどお礼に書かせて頂いたコード）をしようとすると2つ目以降のconnectが必ずタイムアウトしてしまうのです。
再三お恥ずかしいのですが、何卒よろしくお願い致します。

回答No.4

kumoz

「Perl ネットワークプログラミング」(2002年、ピアソン・エデュケーション刊) の 86 頁に以下のような記述があります。

-----------------------------------------------
$boolean = connect(SOCK, $dest_addr)
connect() 関数は、コネクション指向のソケットを指定された送信先アドレスに接続しようとする。ソケットは socket() 関数を使用して、パックされた送信先アドレスは sockaddr_in() 関数などを使用して、あらかじめ作成しておかなければならない。 ソケットのローカルアドレスに使用する短命なポートは、システムによって自動的に選択される。

connect() 関数は、正常終了した場合に true の値を返す。それ以外の場合は false を返し、$! に問題を説明するエラーコードが設定される。コネクション指向のソケットで connect() 関数を複数回呼び出すことは違法である。connect() 関数を２回目に呼び出すと、EISCONN (「トランスポートエンドポイントがすでに接続されている」) エラーが発生する。
------------------------------------------------

私も知らなかったのですが、２度目の接続ではソケットの流用はできず、新しく作り直す必要があるようです。テストしてみたところ、それでうまくいくようです。

use strict;
use warnings;
use Socket;

socket(SOCK, PF_INET, SOCK_STREAM, 6) or die $!;

eval {
local $SIG{ALRM} = sub { die "timeout1"; };
alarm 2;
connect(SOCK, sockaddr_in("80", inet_aton("192.168.0.99"))) || die "$!";
alarm 0;
};

if ($@) {
alarm 0;
print $@;

# 次の２行を追加
close SOCK;
socket(SOCK, PF_INET, SOCK_STREAM, 6) or die $!;

eval {
local $SIG{ALRM} = sub { die "timeout2"; };
alarm 2;
connect(SOCK, sockaddr_in("80", inet_aton("192.168.0.13"))) || die "$!";
alarm 0;
};

if ($@) {
alarm 0;
print $@;
die;
}
}

close SOCK;

お礼

度々のご回答ありがとうございます。
なるほど。connectの結果を待たずに次のconnectをしようとしたことが原因だったんですね。
connect(ファイルハンドル, 接続先1) || connect(ファイルハンドル, 接続先2) || die;で問題が起こらなかったのはconnect関数がちゃんと終了していたからですね。
新たにソケットを生成するように書いたらこちらでもちゃんと動作しました。
本を読むことも大事ですね。その本買ってみようと思います。
いろいろとありがとうございました。

回答No.2

kumoz

eval ブロックでエラーが発生した場合は、特殊変数 $@ にエラーメッセージがセットされます。したがって、直後に $@ をチェックするのが基本になります。

eval {
local $SIG{ALRM} = sub { die "timeout1"; };
alarm 1;
connect(ファイルハンドル, 接続先１);
alarm 0;
};

if ($@) {
alarm 0;
print $@;
eval {
local $SIG{ALRM} = sub { die "timeout2"; };
alarm 1;
connect(ファイルハンドル, 接続先２);
alarm 0;
};

if ($@) {
alarm 0;
print $@;
die;
}
}

「プログラミング Perl 第３版」の alarm 関数のリファレンスには、以下の記述があります。

> 古いマシンでは、秒数の数え方の関係から、経過時間が、
> 指定した秒数より最大で 1 秒短くなることがある。
> さらに、負荷の重いシステムでは、プロセスを時間どおり
> 即時に起動できないこともある。

eval ブロックが正常に終了した場合は、最後に評価された式の値が返されます。(使っているマシンが古いということはないでしょうが)、alarm の秒数を増やしてみてはどうでしょうか。

お礼

再度のご回答いただきありがとうございます。
ご教示のコードの通りにやってもやはり必ずタイムアウトしてしまいます。

コード

#!/usr/bin/perl
use Socket;

#接続先のホスト名
$host = "www.ugtop.com";

#CGIなどへのパス
$path = "/spill.shtml";

$uri = "http://".$host.$path;

# ソケットの生成
$ipaddr = inet_aton($proxy);
socket (SOCK, PF_INET, SOCK_STREAM, 6) || die "$!";

# 接続先プロキシサーバーリスト
# 1 timeout
# 173.193.200.199:8080
# 2 refuse (undef)
# 173.255.142.206:8080

eval {
local $SIG{ALRM} = sub { die "timeout1"; };
alarm 10;
print "first try\n";
connect(SOCK, sockaddr_in("8080", inet_aton("173.193.200.199"))) || die "$!";
alarm 0;
};

if ($@) {
alarm 0;
print $@;
eval {
local $SIG{ALRM} = sub { die "timeout2"; };
alarm 10;
print "second try\n";
connect(SOCK, sockaddr_in("80", inet_aton($host))) || die "$!";
alarm 0;
};

if ($@) {
alarm 0;
print $@;
die;
}
}

select(SOCK); $|=1;
select(STDOUT); $|=1;

# HTTP要求の送信
print SOCK <<EOF;
GET $uri HTTP/1.1
Host: $host
Connection: close

EOF

# HTTP応答を受信
while (<SOCK>) { print; }
close (SOCK);

出力

> ./socket.pl
first try
timeout1 at ./spill.pl line 23.
second try
timeout2 at ./spill.pl line 34.
timeout2 at ./spill.pl line 34.
...propagated at ./spill.pl line 44.

たびたびすみませんが、よろしくお願いいたします。

補足

すみません、出力正しくはこちらです。

> ./socket.pl
first try
timeout1 at ./socket.pl line 23.
second try
timeout2 at ./socket.pl line 34.
timeout2 at ./socket.pl line 34.
...propagated at ./socket.pl line 44.

回答No.1

kumoz

OS でサポートされていれば、シグナルを利用してタイムアウトさせることができます。(以下のコード例は、Unix 系であれば問題なく実行できます。Windows 系については知らないので悪しからず。)

use strict;
my $i;

eval {
local $SIG{ALRM} = sub { die "timeout" };
alarm 3;
++$i while 1; # ここにタイムアウトさせたい処理を書く
alarm 0;
};

alarm 0;
print "$i, $@" if $@;

お礼

ご回答いただきありがとうございます。
ご教示の方法を元のソースに組み込もうと、次のようにしてみたのですが、必ずタイムアウトしてしまいます。

eval {
local $SIG{ALRM} = sub { die "timeout" };
alarm 1;
connect(ファイルハンドル, 接続先1);
alarm 0;
} ||
eval {
local $SIG{ALRM} = sub { die "timeout" };
alarm 1;
connect(ファイルハンドル, 接続先2);
alarm 0;
} ||
die;

orでつないでいるのがいけないのかとも思いますが、それ以外の書き方を知らないので…

ちなみに環境はこちらになります。
> perl -v
This is perl, v5.8.8 built for i686-linux

よろしくお願いいたします。