diff -urN tiarra-20040609/ChangeLog tiarra-20040619/ChangeLog --- tiarra-20040609/ChangeLog 2004-06-09 18:28:31.000000000 +0900 +++ tiarra-20040619/ChangeLog 2004-06-19 18:34:44.000000000 +0900 @@ -1,3 +1,26 @@ +2004-06-19 Topia + + * doc-src/conf-main.tdoc: + - ./tiarra --make-password のことを書き加えた。 + + * main/Timer.pm: + - code 中で die が起こっても abort しないようにした。 + + * module/Channel/Mode/Oper/Grant.pm: + - $myself が undef でないかチェックするようにした。 + + * module/Client/Cotton.pm: + - 追加。いくつかの Cotton の不具合を回避する(予定)。 + - 今は network rejoin 時の自動 part を無視する。 + + * module/Client/Eval.pm: + - runloop に括弧を付け(て関数形式に認識させ)るのを + 忘れていたので修正。 + + * module/Client/GetVersion.pm: + - 追加。クライアントの接続時に CTCP Version を発行して + クライアントのバージョンを取得する。 + 2004-06-09 Topia * main/IrcIO/Server.pm: @@ -1697,7 +1720,7 @@ * これ以前のログは書いていません。 -# Id: $Id: ChangeLog,v 1.153 2004/06/09 09:27:37 topia Exp $ +# Id: $Id: ChangeLog,v 1.154 2004/06/19 09:33:41 topia Exp $ # Author: $Author: topia $ -# Date: $Date: 2004/06/09 09:27:37 $ -# Revision: $Revision: 1.153 $ +# Date: $Date: 2004/06/19 09:33:41 $ +# Revision: $Revision: 1.154 $ diff -urN tiarra-20040609/NEWS tiarra-20040619/NEWS --- tiarra-20040609/NEWS 2004-06-09 18:28:31.000000000 +0900 +++ tiarra-20040619/NEWS 2004-06-19 18:34:44.000000000 +0900 @@ -1,3 +1,14 @@ +2004-06-19 Topia + + * Client::Cotton + - 追加。いくつかの Cotton の不具合を回避する(予定)。 + 今は network rejoin 時の自動 part を無視します。 + Client::GetVersion と組み合わせると良いと思います。 + + * Client::GetVersion + - 追加。クライアントの接続時に CTCP Version を発行して + クライアントのバージョンを取得します。 + 2004-06-04 Topia * 全般 @@ -14,7 +25,7 @@ 2004-02-23 Topia - * Debug::RawLog.pm + * Debug::RawLog - 追加。生の IRC メッセージ(のようなもの?)を ::printmsg を使って 表示する。 diff -urN tiarra-20040609/doc/module/Client.html tiarra-20040619/doc/module/Client.html --- tiarra-20040609/doc/module/Client.html 2004-06-09 18:28:39.000000000 +0900 +++ tiarra-20040619/doc/module/Client.html 2004-06-19 18:34:46.000000000 +0900 @@ -36,6 +36,26 @@
+
+ Client::Cotton Cotton の行うおかしな動作のいくつかを無視する +
+

+該当クライアントのオプション client-type に cotton や unknown と指定するか、
+Client::GetVersion を利用してクライアントのバージョンを取得するように
+してください。
+

+

+part shield (rejoin 時に自動で行われる part の無視)を使用するか
+

+use-part-shield:1
+ +
+
+ + +
+ +
Client::Eval クライアントから Perl 式を実行できるようにする。
@@ -50,6 +70,21 @@
+
+ + +
+ Client::GetVersion クライアントに CTCP Version を発行してバージョン情報を得る +
+

+オプションはいまのところありません。
+(開発者向け情報: 取得した情報は remark の client-version に設定されます。)
+

+ +
+
+ + diff -urN tiarra-20040609/doc/module-toc.html tiarra-20040619/doc/module-toc.html --- tiarra-20040609/doc/module-toc.html 2004-06-09 18:28:38.000000000 +0900 +++ tiarra-20040619/doc/module-toc.html 2004-06-19 18:34:46.000000000 +0900 @@ -88,8 +88,12 @@
  • Client::Cache データをキャッシュしてサーバに問い合わせないようにする
    • +
  • Client::Cotton Cotton の行うおかしな動作のいくつかを無視する
    • +
  • Client::Eval クライアントから Perl 式を実行できるようにする。
    • +
  • Client::GetVersion クライアントに CTCP Version を発行してバージョン情報を得る
    • + diff -urN tiarra-20040609/doc-src/conf-main.tdoc tiarra-20040619/doc-src/conf-main.tdoc --- tiarra-20040609/doc-src/conf-main.tdoc 2004-06-09 18:28:32.000000000 +0900 +++ tiarra-20040619/doc-src/conf-main.tdoc 2004-06-19 18:34:45.000000000 +0900 @@ -1,5 +1,5 @@ -*- outline -*- -$Id: conf-main.tdoc,v 1.4 2004/02/23 02:46:18 topia Exp $ +$Id: conf-main.tdoc,v 1.5 2004/06/19 09:33:42 topia Exp $ perlのソースに使うpodパーサを流用しているので、package文と=pod〜=cutで書く必要があります。 ヘッダのinfo-is-ommitedとno-switchはどちらも値を真に定義しなければなりません。 @@ -47,6 +47,7 @@ # Tiarraにクライアントが接続する際に要求するパスワードをcryptした文字列。 # 空の文字列が指定されたり省略された場合はパスワードを要求しない。 +# crypt は ./tiarra --make-password で行えます。 tiarra-password: xl7cflIcH9AwE # 外部プログラムからtiarraをコントロールする為のUNIXドメインソケットの名前。 diff -urN tiarra-20040609/main/Timer.pm tiarra-20040619/main/Timer.pm --- tiarra-20040609/main/Timer.pm 2004-06-09 18:28:31.000000000 +0900 +++ tiarra-20040619/main/Timer.pm 2004-06-19 18:34:44.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Timer.pm,v 1.7 2004/03/27 10:41:17 admin Exp $ +# $Id: Timer.pm,v 1.8 2004/06/19 09:33:42 topia Exp $ # ----------------------------------------------------------------------------- # RunLoopに登録され、指定された時刻に起動するタイマーです。 # 現在の実装では、精度は秒となっています。 @@ -136,8 +136,14 @@ unless ($package_of_caller->isa('RunLoop')) { croak "Only RunLoop may call method execute of Timer.\n"; } - - $this->{code}->($this); + + eval { + $this->{code}->($this); + }; if ($@) { + $this->notify_error( + "Exception in Timer.\n". + " $@"); + } if (defined $this->{interval}) { $this->{fire_time} += $this->{interval}; diff -urN tiarra-20040609/module/Channel/Mode/Oper/Grant.pm tiarra-20040619/module/Channel/Mode/Oper/Grant.pm --- tiarra-20040609/module/Channel/Mode/Oper/Grant.pm 2004-06-09 18:28:32.000000000 +0900 +++ tiarra-20040619/module/Channel/Mode/Oper/Grant.pm 2004-06-19 18:34:45.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Grant.pm,v 1.6 2004/02/23 02:46:19 topia Exp $ +# $Id: Grant.pm,v 1.7 2004/06/19 09:33:42 topia Exp $ # ----------------------------------------------------------------------------- package Channel::Mode::Oper::Grant; use strict; @@ -43,7 +43,7 @@ my $ch_short = Multicast::detatch($ch_full); my $ch = $sender->channel($ch_short); my $myself = $ch->names($sender->current_nick); - if ($myself->has_o && (!defined $mode || $mode !~ /o/)) { + if (defined $myself && $myself->has_o && (!defined $mode || $mode !~ /o/)) { if (Mask::match_deep_chan([$this->config->mask('all')],$msg->prefix,$ch_full)) { # waitで指定された秒数の経過後に、キューに入れる。 # 同時にキュー消化タイマーを準備する。 diff -urN tiarra-20040609/module/Client/Cotton.pm tiarra-20040619/module/Client/Cotton.pm --- tiarra-20040609/module/Client/Cotton.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20040619/module/Client/Cotton.pm 2004-06-19 18:34:45.000000000 +0900 @@ -0,0 +1,95 @@ +# ----------------------------------------------------------------------------- +# $Id: Cotton.pm,v 1.1 2004/06/19 09:33:42 topia Exp $ +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Client::Cotton; +use strict; +use warnings; +use base qw(Module); +use Mask; +use Multicast; + +sub PART_SHIELD_EXPIRE_TIME (){5 * 60;} + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + $this; +} + +sub _yesno { + my ($this, $value, $default) = @_; + + return $default || 0 if (!defined $value); + return 0 if ($value =~ /[fn]/); # false/no + return 1 if ($value =~ /[ty]/); # true/yes + return 1 if ($value); # 数値判定 + return 0; +} + +sub message_io_hook { + my ($this,$msg,$io,$type) = @_; + + if ($io->isa('IrcIO::Client') && + $this->is_cotton($io)) { + if ($this->_yesno($this->config->use_part_shield) && + $type eq 'in' && + $msg->command eq 'PART' && + Multicast::channel_p($msg->param(0)) && + !defined $msg->param(1)) { + my ($chan_short, $network_name) = Multicast::detach($msg->param(0)); + my $network = RunLoop->shared_loop->network($network_name); + if (defined $network) { + my $expire = $network->remark(__PACKAGE__.'/part-shield/expire'); + my $remark = $io->remark(__PACKAGE__.'/part-shield/'.$network_name); + if (defined $expire && + $expire >= time()) { + if (!defined $remark || + (defined $remark->{channels} && + !defined $remark->{channels}->{$chan_short})) { + $remark->{channels}->{$chan_short} = 1; + return undef; + } + } else { + # remove expired network info + $network->remark(__PACKAGE__.'/part-shield/expire', undef, 'delete'); + $io->remark(__PACKAGE__.'/part-shield/'.$network_name, undef, 'delete'); + } + } + } + } + return $msg; +} + +sub connected_to_server { + my ($this,$server,$new_connection) = @_; + + if (!$new_connection) { + # reconnect + $server->remark(__PACKAGE__.'/part-shield/expire', time() + PART_SHIELD_EXPIRE_TIME); + } +} + +sub is_cotton { + my ($this, $client) = @_; + + return 1 if defined $client->remark('client-version') && + $client->remark('client-version') =~ /(Cotton|Unknown) Client/; + return 1 if defined $client->option('client-type') && + $client->option('client-type') =~ /(cotton|unknown)/; + return 0; +} + +1; +=pod +info: Cotton の行うおかしな動作のいくつかを無視する +default: off + +# 該当クライアントのオプション client-type に cotton や unknown と指定するか、 +# Client::GetVersion を利用してクライアントのバージョンを取得するように +# してください。 + +# part shield (rejoin 時に自動で行われる part の無視)を使用するか +use-part-shield: 1 + +=cut diff -urN tiarra-20040609/module/Client/Eval.pm tiarra-20040619/module/Client/Eval.pm --- tiarra-20040609/module/Client/Eval.pm 2004-06-09 18:28:31.000000000 +0900 +++ tiarra-20040619/module/Client/Eval.pm 2004-06-19 18:34:44.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Eval.pm,v 1.4 2004/06/04 12:57:30 topia Exp $ +# $Id: Eval.pm,v 1.5 2004/06/19 09:33:42 topia Exp $ # ----------------------------------------------------------------------------- package Client::Eval; use strict; @@ -57,7 +57,7 @@ # useful functions to call from eval sub network { - return runloop->network(shift); + return runloop()->network(shift); } sub runloop { diff -urN tiarra-20040609/module/Client/GetVersion.pm tiarra-20040619/module/Client/GetVersion.pm --- tiarra-20040609/module/Client/GetVersion.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20040619/module/Client/GetVersion.pm 2004-06-19 18:34:44.000000000 +0900 @@ -0,0 +1,59 @@ +# ----------------------------------------------------------------------------- +# $Id: GetVersion.pm,v 1.1 2004/06/19 09:33:43 topia Exp $ +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Client::GetVersion; +use strict; +use warnings; +use base qw(Module); +use CTCP; + +sub CTCP_VERSION_EXPIRE_TIME (){5 * 60;} + +sub client_attached { + my ($this,$client) = @_; + + my $msg = CTCP::make('VERSION', RunLoop->shared_loop->current_nick, 'PRIVMSG'); + $msg->prefix(RunLoop->shared_loop->sysmsg_prefix(qw(system))); + + $client->send_message($msg); + $client->remark(__PACKAGE__.'/fetching-version-expire', + time() + CTCP_VERSION_EXPIRE_TIME); +} + +sub message_io_hook { + my ($this,$msg,$io,$type) = @_; + + if ($io->isa('IrcIO::Client')) { + if ($type eq 'in' && $msg->command eq 'NOTICE' && + !Multicast::channel_p($msg->param(0)) && + defined $msg->param(1) && + defined $io->remark(__PACKAGE__.'/fetching-version-expire')) { + if ($io->remark(__PACKAGE__.'/fetching-version-expire') + >= time()) { + my $ctcp = CTCP::extract($msg); + if (defined $ctcp) { + my ($command, $text) = split(/ /, $ctcp, 2); + if ($command eq 'VERSION') { + $io->remark('client-version', $text); + return undef; + } + } + } else { + $io->remark(__PACKAGE__.'/fetching-version-expire', undef, 'delete'); + } + } + } + + return $msg; +} + +1; +=pod +info: クライアントに CTCP Version を発行してバージョン情報を得る +default: off + +# オプションはいまのところありません。 +# (開発者向け情報: 取得した情報は remark の client-version に設定されます。) + +=cut diff -urN tiarra-20040609/sample.conf tiarra-20040619/sample.conf --- tiarra-20040609/sample.conf 2004-06-09 18:28:36.000000000 +0900 +++ tiarra-20040619/sample.conf 2004-06-19 18:34:45.000000000 +0900 @@ -88,6 +88,7 @@ # Tiarraにクライアントが接続する際に要求するパスワードをcryptした文字列。 # 空の文字列が指定されたり省略された場合はパスワードを要求しない。 + # crypt は ./tiarra --make-password で行えます。 tiarra-password: xl7cflIcH9AwE # 外部プログラムからtiarraをコントロールする為のUNIXドメインソケットの名前。 @@ -861,6 +862,17 @@ use-who-cache: 1 } +- Client::Cotton { + # Cotton の行うおかしな動作のいくつかを無視する + + # 該当クライアントのオプション client-type に cotton や unknown と指定するか、 + # Client::GetVersion を利用してクライアントのバージョンを取得するように + # してください。 + + # part shield (rejoin 時に自動で行われる part の無視)を使用するか + use-part-shield: 1 +} + - Client::Eval { # クライアントから Perl 式を実行できるようにする。 @@ -870,6 +882,13 @@ command: eval } +- Client::GetVersion { + # クライアントに CTCP Version を発行してバージョン情報を得る + + # オプションはいまのところありません。 + # (開発者向け情報: 取得した情報は remark の client-version に設定されます。) +} + - Debug::RawLog { # 標準出力にクライアントやサーバとの通信をダンプする。