diff -urN tiarra-20040729/ChangeLog tiarra-20040822/ChangeLog --- tiarra-20040729/ChangeLog 2004-08-04 07:24:47 +0900 +++ tiarra-20040822/ChangeLog 2005-01-01 05:28:51 +0900 @@ -1,3 +1,185 @@ +2004-08-22 Topia + + * HACKING: + - ModuleManager/*_blacklist, Multicast/attach_for_client, + remark/IRCMessage/always-use-colon-on-last-param, + Hook の使い方を追加。 + + * tiarra: + (shutdown): + - runloop->terminate を使った shutdown を行うようにした。 + - runloop->terminate が失敗した時のために、2度以上 shutdown が + 呼ばれれば強制終了する。 + + * doc-src/conf-main.tdoc, main/Configuration.pm: + - general/messages/quit/netconf-changed-{re,dis}connect を追加。 + + * main/IrcIO.pm: + (disconnect): + - runloop->unregister_receive_socket を呼ぶ。 + + * main/IRCMessage.pm: + (serialize): + - remark/always-use-colon-on-last-param 追加。最後のパラメータの + シリアライズ時に必ずコロンを使うようにする。 + 主にクライアント対策用。 + + * main/ModuleManager.pm: + (add_to_blacklist, remove_from_blacklist, check_blacklist, _set_blacklist): + - blacklist の実装。 + (_clear_module_cache, get_modules): + - blacklist を除いた、使用可能モジュールのキャッシュを作る。 + (terminate): + - mod_timestamp にあるモジュールも destruct/_unload する。 + (check_timestamp_update): + - 共通ルーチンとしてメソッドにした。 + (update_modules): + - blacklist 関連処理と、設定は変更されていないがアップデート + されていて、前回ロード失敗しているモジュールの再試行を追加した。 + (reload_modules_if_modified, _unload): + - blacklist 関連処理の追加。 + + * main/Multicast.pm: + (_NOTICE_from_server): + - 追加。 MODE で代用していると、メッセージとして global nick + のみが送られてきたときに、改変してしまう。 + ($server_sent): + - NOTICE と PRIVMSG を _NOTICE_from_server へ変更。 + (attach_for_client): + - 追加。multi-server-mode のときのみ attach する。 + + * main/RunLoop.pm: + - set-current-nick フックを追加した。 + (_new): + - 一時変数として $conf を追加して見やすくする。 + - terminated_networks, terminating を追加。 + (network): + - networks, disconnected_networks, terminated_networks の各 + ジャンルを順に検索して、最初に見つかったものとジャンル名を返す。 + (set_current_nick): + - set-current-nick フックを呼ぶようにした。 + (_conf, _conf_{general,networks,messages}): + - Configuration::shared_conf->... の短縮形として追加。 + (_cleanup_closed_link): + - unregister_receive_socket を使うようにした。 + - state として reconnecting/terminating/finalizing を受け入れる。 + (_action_{part_and_join,message_for_each}): + - Multicast::attach_for_client を使うようにした。 + (update_networks): + - ->_conf* を使うようにした。 + - state として reconnecting/finalizing を使う。 + (terminate_server): + - 追加。 quit し、 conf 変更がない限り自動再接続しない。 + - state として terminating を使う。 + (reconnect_server): + - 何らかのジャンルにあるネットワークを再接続する。 + (disconnect_server): + - セレクタからの削除は IO->disconnect に任せる。 + (close_client): + - ERROR を送信してクライアントを切断する。 + ({,un}install_socket): + - ->{,un}register_receive_socket を使うようにした。 + ({,un}register_receive_socket): + - 追加。 ->{receive_selector}->{add,remove} を呼ぶだけ。 + (run): + - ->_conf* を使うようにした。 + - ->{,un}register_receive_socket を使うようにした。 + - 終了処理中はクライアントからの接続を受けても即切断する。 + - 終了処理を追加。また、 400 回以上ループを回ったら強制終了する。 + (terminate): + - 全てのサーバ・クライアントを切断する。 + - 終了処理フラグを立てる。 + (apply_filters): + - エラーメッセージを表示するときに、再帰を防ぐために一時的に + ブラックリストに入れる。 + - 処理がまわってきているということはブラックリストにないという + ことなので、そのまま解除しても大丈夫なはず。 + (_apply_filters): + - バージョン管理もしているし、いらないコメントを削除する。 + (notify_msg): + - ->_conf* を使うようにした。 + + * main/TiarraDoc.pm: + (_makeconf): + - 空行のときはインデントしないようにした。 + + * main/Configuration/Preprocessor.pm: + - 解説コメントが間違っているので訂正。 + + * main/IrcIO/Client.pm: + (new): + - runloop->register_receive_socket を呼ぶようにした。 + (username, client_host): + - 追加。プロパティ取得専用。 + (do_namreply): + - ->inform_joinning_channels の中の names 関連処理だけ分けた。 + (inform_joinning_channels): + - ->do_namreply を使うようにした。 + + * main/IrcIO/Server.pm: + - RunLoop 用の ->state を追加。 + (connect): + - runloop->register_receive_socket を呼ぶようにした。 + (quit): + - quit メッセージを送信する。 + + * module/Skelton.pm: + (message_io_hook): + - 過去から現在進行へ修正。 + + * module/Auto/Utils.pm: + (sendto_channel_closure): + - Multicast::attach_for_client を使うようにした。 + + * module/Client/Cache.pm: + - network が存在しないのはあまり特別な事態ではなくなったので、 + debug 時でさえも表示しないようにした。 + + * module/Client/Eval.pm: + - 無意味なリスト生成をやめて、配列をそのまま使うようにした。 + + * module/Client/Rehash.pm: + - 追加。 nick と names による rehash を行う。 + + * module/Log/Channel.pm: + - Log::Writer フレームワークを使うようにした。 + - always-flush 設定を追加。 + - 現在、 dir の都合によりプロトコルを混ぜることはできません。 + + * module/Log/Writer.pm: + - 追加。ログ記録に必要なメソッド(reserve, flush)に限った + マルチプロトコル対応可能なフレームワーク。 + + * module/Log/Writer/Base.pm: + - Log::Writer のプロトコルプラグインのベースクラス。 + + * module/Log/Writer/File.pm: + - Log::Writer の File プロトコルプラグイン。 + - fallback として動作するため、プロトコルを省略したときも + (そして他の fallback によってハンドルされなかったときも) + このプロトコルで処理する。 + - ないディレクトリは勝手に作るので注意。 + + * module/System/Error.pm: + - 追加。 ERROR メッセージをクライアントに送る前に NOTICE に埋め込む。 + - デフォルトオンです。機構的に以前からの conf は救済できません(^^;; + + * module/System/Shutdown.pm: + - シャットダウンメッセージを受け入れるようにした。 + + * module/System/NotifyIcon/Win32.pm: + - iconfile と hide-console-on-load 設定を追加。 + - 他の雑多な機能は 128 文字対応が全然動いてくれない上に、 + 実装自体も全然進んでいないので見送りです。 + + * module/Tools/FileCache.pm: + - use Carp を追加。 + - shared で __PACKAGE__ を使うようにした。 + + * module/Tools/FileCache/EachFile.pm: + - ->{add,del}_refcount を ->{add_ref,release} に変更。 + 内部 API だから影響はないはず。 + 2004-07-29 Topia * main/ModuleManager.pm: @@ -1811,7 +1993,7 @@ * これ以前のログは書いていません。 -# Id: $Id: ChangeLog,v 1.157 2004/07/29 06:23:47 topia Exp $ +# Id: $Id: ChangeLog,v 1.158 2004/08/22 11:28:41 topia Exp $ # Author: $Author: topia $ -# Date: $Date: 2004/07/29 06:23:47 $ -# Revision: $Revision: 1.157 $ +# Date: $Date: 2004/08/22 11:28:41 $ +# Revision: $Revision: 1.158 $ diff -urN tiarra-20040729/HACKING tiarra-20040822/HACKING --- tiarra-20040729/HACKING 2004-08-04 07:24:47 +0900 +++ tiarra-20040822/HACKING 2005-01-01 05:28:51 +0900 @@ -19,26 +19,45 @@ Mask::match_deep([$this->config->keyword('all')], $keyword) だと思います。 + - ModuleManager(main/ModuleManager.pm) + ここで紹介する関数は、全て ModuleManager->shared_manager->function(...) と呼んで下さい。 + + add_to_blacklist($modname) + $modname で指定されたモジュールをブラックリストに入れる。 + ブラックリストに入れられたモジュールは、リロードするか削除される + まで呼び出されない。成功したら正を返す。 + + remove_from_blacklist($modname) + $modname で指定されたモジュールをブラックリストから削除する。 + 成功したら正を返す。 + + check_blacklist($modname) $modname で指定されたモジュールがブラックリストに入っていれば + 正を返す。 + + - Multicast(main/Multicast.pm) - + detach($str) 文字列 $str からネットワーク名を外す。 - 戻り値: (セパレータ前の文字列,ネットワーク名,ネットワーク名が明示されたかどうか) - ただしスカラーコンテクストではセパレータ前の文字列のみを返す。 - + attach($str, $network_name) $str にネットワーク名を付ける。 - $strはChannelInfoのオブジェクトでも良い。 - $network_nameは省略可能。IrcIO::Serverのオブジェクトでも良い。 - + nick_p($str) 文字列 $str が nick name として許される形式なら 1 を返す。 - ネットワーク名は付けたままでも構わない。処理前に detach される。 - + channel_p($str) 文字列 $str が channel name として許される形式なら 1 を返す。 - ネットワーク名は付けたままでも構わない。処理前に detach される。 + + detach($str) 文字列 $str からネットワーク名を外す。 + 戻り値: (セパレータ前の文字列,ネットワーク名,ネットワーク名が明示されたかどうか) + ただしスカラーコンテクストではセパレータ前の文字列のみを返す。 + + attach($str, $network_name) + $str にネットワーク名を付ける。 + $strはChannelInfoのオブジェクトでも良い。 + $network_nameは省略可能。IrcIO::Serverのオブジェクトでも良い。 + + attach_for_client($str, $network_name) + クライアント向けに、 multi-server-mode でなければ attach しない。 + + nick_p($str) 文字列 $str が nick name として許される形式なら 1 を返す。 + ネットワーク名は付けたままでも構わない。処理前に detach される。 + + channel_p($str) 文字列 $str が channel name として許される形式なら 1 を返す。 + ネットワーク名は付けたままでも構わない。処理前に detach される。 - RunLoop(main/RunLoop.pm) ここで紹介する関数は、全て RunLoop->shared_loop->function(...) と呼んで下さい。 - + channel($str) チャンネルを探す。 - ネットワーク名付きのチャンネル名が引数です。無ければ undef を返します。 - + broadcast_to_clients(@messages) メッセージを全てのクライアントに送信する。 + + channel($str) チャンネルを探す。 + ネットワーク名付きのチャンネル名が引数です。 + 無ければ undef を返します。 + + broadcast_to_clients(@messages) + メッセージを全てのクライアントに送信する。 + notify_msg($str) 全てのクライアントと、 STDOUT にメッセージを通知します。 + notify_error($str) notify_msg を使ってエラーを通知します。 + notify_warn($str) notify_msg を使って警告を通知します。 + + terminate($message) サーバとクライアントを切断して終了します。 - main(tiarra) + ::printmsg() STDOUT にのみメッセージを通知します。 @@ -49,15 +68,17 @@ - BulletinBoard(main/BulletinBoard.pm) ここで紹介する関数は、全て BulletinBoard->shared->function(...) と呼んで下さい。 + set($key, $value) 掲示板に $key という名前で値 $value をセットします。 - $key を __PACKAGE__."/key" という名前にすれば + $key を __PACKAGE__."/key" という名前にすれば 被りにくいと思います。 + get($key) $key でセットした値を得ます。 + keys BulletinBoard が保持しているテーブルを返します。 - この内容を変更すると、当然 BulletinBoard の内容も変わります。 + この内容を変更すると、当然 BulletinBoard の内容も変わります。 - Auto::Utils(module/Auto/Utils.pm) - + generate_reply_closures(...) 一般的な自動反応をするのに有用なクロージャを生成する。 - + sendto_channel_closure(...) チャンネル等に PRIVMSG / NOTICE を送るクロージャを生成する。 + + generate_reply_closures(...) + 一般的な自動反応をするのに有用なクロージャを生成する。 + + sendto_channel_closure(...) + チャンネル等に PRIVMSG / NOTICE を送るクロージャを生成する。 一般的な使い方は Skelton.pm に書いておきました。 * remark のあるオブジェクト @@ -88,6 +109,9 @@ 残すけれど)クライアントには送信しないようにします。 * do-not-send-to-servers do-not-send-to-clients と同じような理由で、サーバに送信しない ようにします。 + * always-use-colon-on-last-param + シリアライズするとき、最終パラメータに常にコロンを使用する + ようにします。 - ChannelInfo + 情報取得系 * kicked-out そのチャンネルから蹴り出されている(すでにそのチャンネルに @@ -97,6 +121,25 @@ - PersonInChannel - PersonalInfo +* Hook + - 基本的な使い方: + use SomePackage::Hook; + my $hook = SomePackage::Hook->new(sub{ + my $hook = shift; + # do something + })->install('someplace'); + - Hook のあるパッケージ、 Hook 名と簡単な説明 + + RunLoop + * before-select select 前 + * after-select select 後 + * set-current-nick set_current_nick が呼ばれたとき + + Configuration + * reloaded conf が再読込されたとき + + IrcIO::Client + * channel-info($client, $ch_name, $network, $ch) + 接続時に Join しているチャンネルごとに呼ばれる。 + チャンネル情報とともに recent log を送ったりする場合に使える。 + Local variables: mode: text End: diff -urN tiarra-20040729/NEWS tiarra-20040822/NEWS --- tiarra-20040729/NEWS 2004-08-04 07:24:47 +0900 +++ tiarra-20040822/NEWS 2005-01-01 05:28:51 +0900 @@ -1,3 +1,19 @@ +2004-08-22 Topia + + * Client::Rehash + - 追加。クライアントの nick と names を訂正する。 + + * System::Error + - 追加。クライアントに送信するときに ERROR メッセージを + NOTICE に埋め込む。 + - このモジュールはデフォルトオンです。アップデートの際は忘れずに + 追加するようにしてください。 + + * Log::Channel + - Log::Writer フレームワークを使うようにしました。 + - file system full 等で書き込みに失敗しても、出来る限りログを + 保持します。 + 2004-07-29 Topia * System::NotifyIcon::Win32 diff -urN tiarra-20040729/doc/module/Client.html tiarra-20040822/doc/module/Client.html --- tiarra-20040729/doc/module/Client.html 2004-08-04 07:24:53 +0900 +++ tiarra-20040822/doc/module/Client.html 2005-01-01 05:29:03 +0900 @@ -85,6 +85,41 @@ +
+ + +
+ Client::Rehash 全チャンネル分の names の内部キャッシュをクライアントに送信する。 +
+

+もともとはクライアントの再初期化目的に作ったのですが、 names を送信しても
+更新されないクライアントが多いので、主に multi-server-mode な Tiarra の
+下にさらに Tiarra をつないでいる人向けにします。
+

+

+names でニックリストを更新してくれるクライアント:
+  Tiarra
+してくれないクライアント: (括弧内は確認したバージョンまたは注釈)
+  LimeChat(1.18)
+

+

+nick rehash に使うコマンドを指定します。
+第二パラメータとして現在クライアントが認識している nick を指定してください。
+

+command-nick:rehash-nick
+

+names rehash に使うコマンドを指定します。
+

+command-names:rehash-names
+

+チャンネルとチャンネルの間のウェイトを指定します。
+

+interval:2
+ +
+
+ + diff -urN tiarra-20040729/doc/module/Log.html tiarra-20040822/doc/module/Log.html --- tiarra-20040729/doc/module/Log.html 2004-08-04 07:24:53 +0900 +++ tiarra-20040822/doc/module/Log.html 2005-01-01 05:29:02 +0900 @@ -62,9 +62,18 @@ このオプションは多くの場合、ディスクアクセスを抑えて効率良くログを保存しますが
ログを記録すべき全てのファイルを開いたままにするので、50や100のチャンネルを
別々のファイルにログを取るような場合には使うべきではありません。
+万一 fd があふれた場合、クライアントから(またはサーバへ)接続できない・
+新たなモジュールをロードできない・ログが全然できないなどの症状が起こる可能性が
+あります。limit の詳細については OS 等のドキュメントを参照してください。

keep-file-open:1

+keep-file-open 時に各行ごとに flush するかどうか。
+open/close の負荷は気になるが、ログは失いたくない人向け。
+keep-file-open が有効でないなら無視され(1になり)ます。
+

+always-flush:0
+

keep-file-openを有効にした場合、発言の度にログファイルに追記するのではなく
一定の分量が溜まってから書き込まれる。そのため、ファイルを開いても
最近の発言はまだ書き込まれていない可能性がある。
diff -urN tiarra-20040729/doc/module/System.html tiarra-20040822/doc/module/System.html --- tiarra-20040729/doc/module/System.html 2004-08-04 07:24:53 +0900 +++ tiarra-20040822/doc/module/System.html 2005-01-01 05:29:02 +0900 @@ -12,6 +12,27 @@ +

+ System::Error サーバーからのERRORメッセージをNOTICEに埋め込む +
+

+これをoffにするとクライアントにERRORメッセージがそのまま送られます。
+クライアントとの間ではERRORメッセージは主に切断警告に使われており、
+そのまま流してしまうとクライアントが混乱する可能性があります。
+  設定項目はありません。
+

+

+このモジュールを回避してERRORメッセージをクライアントに送りたい場合は、
+remarkのsend-error-as-is-to-clientを指定してください。
+

+ +
+
+ + +
+ +
System::Macro 新規にコマンドを追加し、そのコマンドが使われた時に特定の動作をまとめて実行します。
@@ -48,6 +69,16 @@ Win32 イベントループを処理する最大間隔を指定します。

interval:2
+

+通知領域に表示するアイコンを指定します。
+Win32::GUI の制限でちゃんとしたアイコンファイルしか指定できません。
+

+iconfile:guiperl.ico
+

+モジュールが読み込まれたときにコンソールウィンドウを隠すかどうかを
+指定します。
+

+hide-console-on-load:1
@@ -174,6 +205,7 @@

Tiarraをシャットダウンさせるprivの発言。
省略された場合はprivでのシャットダウンは無効になります。
+パラメータとして shutdown メッセージを指定できます。

message:shutdown

diff -urN tiarra-20040729/doc/module-toc.html tiarra-20040822/doc/module-toc.html --- tiarra-20040729/doc/module-toc.html 2004-08-04 07:24:53 +0900 +++ tiarra-20040822/doc/module-toc.html 2005-01-01 05:29:02 +0900 @@ -94,6 +94,8 @@

  • Client::GetVersion クライアントに CTCP Version を発行してバージョン情報を得る
    • +
  • Client::Rehash 全チャンネル分の names の内部キャッシュをクライアントに送信する。
    • + @@ -121,6 +123,8 @@ System Tiarra自身の動作に関するもの
      +
    • System::Error サーバーからのERRORメッセージをNOTICEに埋め込む
      • +
    • System::Macro 新規にコマンドを追加し、そのコマンドが使われた時に特定の動作をまとめて実行します。
    • System::NotifyIcon::Win32 タスクトレイにアイコンを表示する。
      • diff -urN tiarra-20040729/doc-src/conf-main.tdoc tiarra-20040822/doc-src/conf-main.tdoc --- tiarra-20040729/doc-src/conf-main.tdoc 2004-08-04 07:24:51 +0900 +++ tiarra-20040822/doc-src/conf-main.tdoc 2005-01-01 05:28:53 +0900 @@ -1,5 +1,5 @@ -*- outline -*- -$Id: conf-main.tdoc,v 1.5 2004/06/19 09:33:42 topia Exp $ +$Id: conf-main.tdoc,v 1.6 2004/08/22 11:28:42 topia Exp $ perlのソースに使うpodパーサを流用しているので、package文と=pod〜=cutで書く必要があります。 ヘッダのinfo-is-ommitedとno-switchはどちらも値を真に定義しなければなりません。 @@ -123,6 +123,18 @@ # -*::log を指定しておくといいかもしれません。 channel: * } + +messages { + # Tiarra が使用する、いくつかのメッセージを指定する。 + + quit { + # ネットワーク設定が変更され、再接続する場合の切断メッセージ + netconf-changed-reconnect: Server Configuration changed; reconnect + + # ネットワーク設定が変更され、切断する場合の切断メッセージ + netconf-changed-disconnect: Server Configuration changed; disconnect + } +} =cut * networks diff -urN tiarra-20040729/main/Configuration/Preprocessor.pm tiarra-20040822/main/Configuration/Preprocessor.pm --- tiarra-20040729/main/Configuration/Preprocessor.pm 2004-08-04 07:24:49 +0900 +++ tiarra-20040822/main/Configuration/Preprocessor.pm 2005-01-01 05:28:51 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Preprocessor.pm,v 1.8 2004/07/08 15:13:13 topia Exp $ +# $Id: Preprocessor.pm,v 1.9 2004/08/22 11:28:43 topia Exp $ # ----------------------------------------------------------------------------- # tiarraのconfファイルのプリプロセッサです。 # このクラスは次のような機能を持ちます。 @@ -16,7 +16,7 @@ # @if 'DEBUG' == '1' # debug: a # @endif -# 例外は@undef文。この文に対しては置換が行なわれない。 +# 例外は@undef, @ifdef, @ifndef文。これらの文に対しては置換が行なわれない。 # # ・@undef 文字列A # @defineで定義した置換を、次の行からキャンセルする。 diff -urN tiarra-20040729/main/Configuration.pm tiarra-20040822/main/Configuration.pm --- tiarra-20040729/main/Configuration.pm 2004-08-04 07:24:48 +0900 +++ tiarra-20040822/main/Configuration.pm 2005-01-01 05:28:51 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Configuration.pm,v 1.26 2004/07/08 15:13:13 topia Exp $ +# $Id: Configuration.pm,v 1.27 2004/08/22 11:28:42 topia Exp $ # ----------------------------------------------------------------------------- # このクラスはフック`reloaded'を用意します。 # フック`reloaded'は、設定ファイルがリロードされた時に呼ばれます。 @@ -200,6 +200,14 @@ 'priv' => '', 'channel' => '*', }, + 'messages' => { + 'quit' => { + 'netconf-changed-reconnect' => + 'Server Configuration changed; reconnect', + 'netconf-changed-disconnect' => + 'Server Configuration changed; disconnect', + } + }, }, networks => { 'name' => 'main', diff -urN tiarra-20040729/main/IRCMessage.pm tiarra-20040822/main/IRCMessage.pm --- tiarra-20040729/main/IRCMessage.pm 2004-08-04 07:24:47 +0900 +++ tiarra-20040822/main/IRCMessage.pm 2005-01-01 05:28:51 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: IRCMessage.pm,v 1.18 2004/06/04 12:57:30 topia Exp $ +# $Id: IRCMessage.pm,v 1.19 2004/08/22 11:28:42 topia Exp $ # ----------------------------------------------------------------------------- # IRCMessageはIRCのメッセージを表わすクラスです。実際のメッセージはUTF-8で保持します。 # 生のメッセージのパース、シリアライズ、そしてメッセージの生成をサポートします。 @@ -254,10 +254,13 @@ # 最後のパラメタなら頭にコロンを付けて後にはスペースを置かない。 # 但し半角スペースが一つも無く、且つコロンで始まっていなければコロンを付けない。 # パラメタが空文字列であった場合は例外としてコロンを付ける。 + # また、 remark/always-use-colon-on-last-param が付いていた場合も + # コロンを付ける。 my $arg = $unicode->set($this->[PARAMS]->[$i])->conv($encoding); if (length($arg) > 0 and index($arg, ' ') == -1 and - index($arg, ':') != 0) { + index($arg, ':') != 0 and + !$this->remark('always-use-colon-on-last-param')) { $result .= $arg; } else { diff -urN tiarra-20040729/main/IrcIO/Client.pm tiarra-20040822/main/IrcIO/Client.pm --- tiarra-20040729/main/IrcIO/Client.pm 2004-08-04 07:24:47 +0900 +++ tiarra-20040822/main/IrcIO/Client.pm 2005-01-01 05:28:51 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Client.pm,v 1.31 2004/07/08 15:13:13 topia Exp $ +# $Id: Client.pm,v 1.32 2004/08/22 11:28:43 topia Exp $ # ----------------------------------------------------------------------------- # IrcIO::Clientはクライアントからの接続を受け、 # IRCメッセージをやり取りするクラスです。 @@ -48,6 +48,7 @@ } } ::printmsg("One client at ".$obj->{client_host}." connected to me."); + RunLoop->shared_loop->register_receive_socket($sock); $obj; } @@ -55,6 +56,14 @@ shift->{logging_in}; } +sub username { + shift->{username}; +} + +sub client_host { + shift->{client_host}; +} + sub fullname { # このクライアントをtiarraから見たnick!username@userhostの形式で表現する。 my ($this,$type) = @_; @@ -379,25 +388,81 @@ return $msg; } +sub do_namreply { + my ($this, $ch, $network, $max_length, $flush_func) = @_; + + $max_length = 400 if !defined $max_length; + croak('$ch is not specified') if !defined $ch; + croak('$network is not specified') if !defined $network; + croak('$flush_func is not specified') if !defined $flush_func; + my $global_to_local = sub { + Multicast::global_to_local(shift, $network); + }; + my $ch_property_char = do { + if ($ch->switches('s')) { + '@'; + } + elsif ($ch->switches('p')) { + '*'; + } + else { + '='; + } + }; + # 余裕を見てnickの列挙部が $max_length(デフォルト:400) バイトを越えたら行を分ける。 + my $nick_enumeration = ''; + my $flush_enum_buffer = sub { + if ($nick_enumeration ne '') { + $flush_func->( + IRCMessage->new( + Prefix => $this->fullname, + Command => RPL_NAMREPLY, + Params => [RunLoop->shared_loop->current_nick, + $ch_property_char, + Multicast::attach_for_client($ch->name, $network->network_name), + $nick_enumeration])); + $nick_enumeration = ''; + } + }; + my $append_to_enum_buffer = sub { + my $nick_to_append = shift; + if ($nick_enumeration eq '') { + $nick_enumeration = $nick_to_append; + } + else { + $nick_enumeration .= ' '.$nick_to_append; + } + }; + map { + my $person = $_; + my $mode_char = do { + if ($person->has_o) { + '@'; + } + elsif ($person->has_v) { + '+'; + } + else { + ''; + } + }; + $append_to_enum_buffer->($mode_char . $global_to_local->($person->person->nick)); + if (length($nick_enumeration) > $max_length) { + $flush_enum_buffer->(); + } + } values %{$ch->names}; + $flush_enum_buffer->(); + + undef; +} + sub inform_joinning_channels { my $this = shift; - my $multi = RunLoop->shared->multi_server_mode_p; my $local_nick = RunLoop->shared_loop->current_nick; my $send_channelinfo = sub { my ($network, $ch) = @_; - my $global_nick = $network->current_nick; - my $global_to_local = sub { - $_[0] eq $global_nick ? $local_nick : $_[0]; - }; - my $ch_name = do { - if ($multi) { - Multicast::attach($ch->name, $network->network_name); - } - else { - $ch->name; - } - }; + my $ch_name = Multicast::attach_for_client($ch->name, $network->network_name); # まずJOIN $this->send_message( @@ -422,60 +487,11 @@ Params => [$local_nick,$ch_name,$ch->topic_who,$ch->topic_time])); } # 次にRPL_NAMREPLY - my $ch_property_char = do { - if ($ch->switches('s')) { - '@'; - } - elsif ($ch->switches('p')) { - '*'; - } - else { - '='; - } + my $flush_namreply = sub { + my $msg = shift; + $this->send_message($msg); }; - # 余裕を見てnickの列挙部が400バイトを越えたら行を分ける。 - my $nick_enumeration = ''; - my $flush_enum_buffer = sub { - if ($nick_enumeration ne '') { - $this->send_message( - IRCMessage->new( - Prefix => $this->fullname, - Command => RPL_NAMREPLY, - Params => [$local_nick, - $ch_property_char, - $ch_name, - $nick_enumeration])); - $nick_enumeration = ''; - } - }; - my $append_to_enum_buffer = sub { - my $nick_to_append = shift; - if ($nick_enumeration eq '') { - $nick_enumeration = $nick_to_append; - } - else { - $nick_enumeration .= ' '.$nick_to_append; - } - }; - map { - my $person = $_; - my $mode_char = do { - if ($person->has_o) { - '@'; - } - elsif ($person->has_v) { - '+'; - } - else { - ''; - } - }; - $append_to_enum_buffer->($mode_char . $global_to_local->($person->person->nick)); - if (length($nick_enumeration) > 400) { - $flush_enum_buffer->(); - } - } values %{$ch->names}; - $flush_enum_buffer->(); + $this->do_namreply($ch, $network, undef, $flush_namreply); # 最後にRPL_ENDOFNAMES $this->send_message( IRCMessage->new( diff -urN tiarra-20040729/main/IrcIO/Server.pm tiarra-20040822/main/IrcIO/Server.pm --- tiarra-20040729/main/IrcIO/Server.pm 2004-08-04 07:24:47 +0900 +++ tiarra-20040822/main/IrcIO/Server.pm 2005-01-01 05:28:51 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Server.pm,v 1.58 2004/06/09 09:27:37 topia Exp $ +# $Id: Server.pm,v 1.59 2004/08/22 11:28:43 topia Exp $ # ----------------------------------------------------------------------------- # IrcIO::ServerはIRCサーバーに接続し、IRCメッセージをやり取りするクラスです。 # このクラスはサーバーからメッセージを受け取ってチャンネル情報や現在のnickなどを保持しますが、 @@ -58,6 +58,13 @@ shift->{isupport}; } +sub state { + my ($this, $state) = @_; + + $this->{state} = $state if defined $state; + $this->{state}; +} + sub nick_p { my ($this, $nick) = @_; @@ -183,6 +190,7 @@ return if $this->connected; # 初期化すべきフィールドを初期化 + $this->{state} = undef; $this->{nick_retry} = 0; $this->{logged_in} = undef; @@ -265,6 +273,7 @@ } }; ::printmsg("Opened connection to $this->{destination} ($ip_version)"); + RunLoop->shared_loop->register_receive_socket($sock); } else { die "Couldn't connect to $this->{destination}\n"; @@ -315,6 +324,14 @@ ::printmsg("Disconnected from $this->{destination}."); } +sub quit { + my ($this, $msg) = @_; + return $this->send_message( + IRCMessage->new( + Command => 'QUIT', + Param => $msg)); +} + sub send_message { my ($this,$msg) = @_; diff -urN tiarra-20040729/main/IrcIO.pm tiarra-20040822/main/IrcIO.pm --- tiarra-20040729/main/IrcIO.pm 2004-08-04 07:24:47 +0900 +++ tiarra-20040822/main/IrcIO.pm 2005-01-01 05:28:51 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: IrcIO.pm,v 1.23 2004/05/09 12:46:18 admin Exp $ +# $Id: IrcIO.pm,v 1.24 2004/08/22 11:28:42 topia Exp $ # ----------------------------------------------------------------------------- # IrcIOはIRCサーバー又はクライアントと接続し、IRCメッセージをやり取りする抽象クラスです。 # ----------------------------------------------------------------------------- @@ -42,6 +42,7 @@ my $this = shift; $this->{sock}->shutdown(2); $this->{connected} = undef; + RunLoop->shared_loop->unregister_receive_socket($this->{sock}); } sub sock { diff -urN tiarra-20040729/main/ModuleManager.pm tiarra-20040822/main/ModuleManager.pm --- tiarra-20040729/main/ModuleManager.pm 2004-08-04 07:24:49 +0900 +++ tiarra-20040822/main/ModuleManager.pm 2005-01-01 05:28:51 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: ModuleManager.pm,v 1.17 2004/07/29 06:23:47 topia Exp $ +# $Id: ModuleManager.pm,v 1.18 2004/08/22 11:28:43 topia Exp $ # ----------------------------------------------------------------------------- # このクラスは全てのTiarraモジュールを管理します。 # モジュールをロードし、リロードし、破棄するのはこのクラスです。 @@ -25,16 +25,65 @@ my $class = shift; my $obj = { modules => [], # 現在使用されている全てのモジュール + using_modules_cache => undef, # ブラックリストを除いた全てのモジュールのキャッシュ。 mod_configs => {}, # 現在使用されている全モジュールのConfiguration::Block mod_timestamps => {}, # 現在使用されている全モジュールおよびサブモジュールの初めてuseされた時刻 + mod_blacklist => {}, # 過去に正常動作しなかったモジュール。 updated_once => 0, # 過去にupdate_modulesが実行された事があるか。 }; bless $obj,$class; } +sub add_to_blacklist { + my ($this,$modname) = @_; + $this->_set_blacklist($modname, 1); +} + +sub remove_from_blacklist { + my ($this,$modname) = @_; + $this->_set_blacklist($modname, 0); +} + +sub check_blacklist { + my ($this,$modname) = @_; + + exists $this->{mod_blacklist}->{$modname}; +} + +sub _set_blacklist { + my ($this,$modname,$add_or_remove) = @_; + + $this->_clear_module_cache; + if ($add_or_remove) { + # modname の存在テストはしない: && defined $this->get($modname) + $this->{mod_blacklist}->{$modname} = 1; + } elsif (!$add_or_remove && exists $this->{mod_blacklist}->{$modname}) { + delete $this->{mod_blacklist}->{$modname}; + } else { + return undef; + } + return 1; +} + +sub _clear_module_cache { + shift->{using_modules_cache} = undef; +} + sub get_modules { + # @options(省略可能): + # 'even-if-blacklisted': ブラックリスト入りのものを含める。 # モジュールの配列への参照を返すが、これを変更してはならない！ - shift->{modules}; + my ($this,@options) = @_; + if (defined $options[0] && $options[0] eq 'even-if-blacklisted') { + return $this->{modules}; + } else { + if (!defined $this->{using_modules_cache}) { + $this->{using_modules_cache} = [grep { + !$this->check_blacklist(ref($_)); + } @{$this->{modules}}]; + } + return $this->{using_modules_cache}; + } } sub get { @@ -54,9 +103,18 @@ }; if ($@) { print "$@\n"; } + $this->_unload(ref($_)); + } + foreach (keys %{$this->{mod_timestamps}}) { + eval { + $_->destruct; + }; + $this->_unload($_); } @{$this->{modules}} = (); + $this->_clear_module_cache; %{$this->{mod_configs}} = (); + %{$this->{mod_timestamps}} = (); } sub timestamp { @@ -67,6 +125,24 @@ $this->{mod_timestamps}->{$module}; } +sub check_timestamp_update { + my ($this,$module,$timestamp) = @_; + + $timestamp = $this->{mod_timestamps}->{$module} if !defined $timestamp; + if (defined $timestamp) { + (my $mod_filename = $module) =~ s|::|/|g; + my $mod_fpath = $INC{$mod_filename.'.pm'}; + return if (!defined($mod_fpath) || !-f $mod_fpath); + if ((stat($mod_fpath))[9] > $timestamp) { + return 1; + } else { + return 0; + } + } else { + return undef; + } +} + sub update_modules { # +で指定されたモジュール一覧を読み、modulesを再構成する。 # 必要なモジュールがまだロードされていなければロードし、 @@ -100,7 +176,8 @@ # モジュール名 => Moduleの形式でテーブルにする。 my %new_mods = map { # 新たに追加されたモジュール。 - $show_msg->("Module ".$_->block_name." will be loaded newly."); + $show_msg->("Module ".$_->block_name." will be loaded newly."); + $this->remove_from_blacklist($_->block_name); $_->block_name => $this->_load($_); } @$new; my %rebuilt_mods = map { @@ -108,12 +185,22 @@ # %loaded_modsに古い物が入っているので、破棄する。 $show_msg->("Configuration of the module ".$_->block_name." has been changed. It will be restarted."); $loaded_mods{$_->block_name}->destruct; + $this->remove_from_blacklist($_->block_name); $_->block_name => $this->_load($_); } @$changed; my %not_changed_mods = map { # 設定変更されなかったモジュール。 # %loaded_modsに実物が入っている。 - $_->block_name => $loaded_mods{$_->block_name}; + my $modname = $_->block_name; + if (!defined $loaded_mods{$modname} && + $this->check_timestamp_update($modname)) { + # ロードできてなくて、なおかつアップデートされていたらロードしてみる。 + $show_msg->("$modname has been modified. It will be reloaded."); + $this->remove_from_blacklist($modname); + $modname => $this->_load($_); + } else { + $modname => $loaded_mods{$modname}; + } } @$not_changed; # $mod_configsに書かれた順序に従い、$this->{modules}を再構成。 @@ -138,6 +225,9 @@ $this->_unload($_); } + # gc の前に一度キャッシュクリア + $this->_clear_module_cache; + if ($deleted_any > 0) { # 何か一つでもアンロードしたモジュールがあれば、最早参照されなくなったモジュールが # あるかどうかを調べ、一つでもあればmark and sweepを実行。 @@ -147,6 +237,8 @@ } } + $this->_clear_module_cache; + $this->{updated_once} = 1; $this; } @@ -210,10 +302,7 @@ # 既に更新されたものとしてマークされていれば抜ける。 return if $mods_to_be_reloaded->{$modname}; - (my $mod_filename = $modname) =~ s|::|/|g; - my $mod_fpath = $INC{$mod_filename.'.pm'}; - return if (!defined($mod_fpath) || !-f $mod_fpath); - if ((stat($mod_fpath))[9] > $timestamp) { + if ($this->check_timestamp_update($modname, $timestamp)) { # 更新されている。少なくともこのモジュールはリロードされる。 $mods_to_be_reloaded->{$modname} = 1; $show_msg->("$modname has been modified. It will be reloaded."); @@ -262,10 +351,12 @@ my $conf_block = $this->{mod_configs}->{$modname}; # message_io_hook が定義されているモジュールが死ぬと怖いので - # とりあえず undef を入れて無視させる + # とりあえず undef を入れて無視させる。 $this->{modules}->[$idx] = undef; $this->_unload($conf_block); $this->{modules}->[$idx] = $this->_load($conf_block); # 失敗するとundefが入る。 + # _unload でブラックリストから消えるから大丈夫だと思うが、一応。 + $this->remove_from_blacklist($modname); } else { # アンロード後、use。 @@ -299,6 +390,8 @@ @{$this->{modules}} = grep { defined $_; } @{$this->{modules}}; + + $this->_clear_module_cache; } } @@ -379,6 +472,9 @@ # このモジュールのuse時刻を消去 delete $this->{mod_timestamps}->{$modname}; + # このモジュールのブラックリストを消去。 + $this->remove_from_blacklist($modname); + # このモジュールのファイル名を求めておく。 (my $mod_filename = $modname) =~ s|::|/|g; $mod_filename .= '.pm'; diff -urN tiarra-20040729/main/Multicast.pm tiarra-20040822/main/Multicast.pm --- tiarra-20040729/main/Multicast.pm 2004-08-04 07:24:49 +0900 +++ tiarra-20040822/main/Multicast.pm 2005-01-01 05:28:51 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Multicast.pm,v 1.26 2004/05/09 04:08:00 topia Exp $ +# $Id: Multicast.pm,v 1.27 2004/08/22 11:28:43 topia Exp $ # ----------------------------------------------------------------------------- # サーバーからクライアントにメッセージが流れるとき、このクラスはフィルタとして # ネットワーク名を付加します。 @@ -157,6 +157,7 @@ } return $message; } + sub _MODE_from_client { my ($message,$sender) = @_; my $to; @@ -193,6 +194,19 @@ $message; } +sub _NOTICE_from_server { + my ($message,$sender) = @_; + $message->nick(global_to_local($message->nick,$sender)); + + my $target = $message->params->[0]; + unless (nick_p($target)) { + # nick(つまり自分)の場合はそのままクライアントに配布。 + # この場合はチャンネルなので、ネットワーク名を付加。 + $message->params->[0] = attach($target,$sender->network_name); + } + return $message; +} + sub _WHOIS_from_client { my ($message,$sender) = @_; my $to; @@ -331,10 +345,10 @@ 'KICK' => \&_KICK_from_server, 'MODE' => \&_MODE_from_server, 'NICK' => undef, # 本体は鯖からのNICKを弄らない。これを見て情報を更新するのはIrcIO::Serverである。 - 'NOTICE' => \&_MODE_from_server, # MODEと同じ処理で良い。Prefixを弄るとすれば、それはモジュールの役目。 + 'NOTICE' => \&_NOTICE_from_server, # Prefixを弄るとすれば、それはモジュールの役目。 'PART' => \&_JOIN_from_server, # JOINと同じ処理で良い。 'PING' => undef, - 'PRIVMSG' => \&_MODE_from_server, # NOTICEと同じ処理で良い。 + 'PRIVMSG' => \&_NOTICE_from_server, # NOTICEと同じ処理で良い。 'QUIT' => undef, # QUITしたのが自分だったら捨てる、といった処理はIrcIO::Serverが行なう。 'SQUERY' => \&_MODE_from_server, # 多分これは鯖からも来るだろうが、良く分からない。 'TOPIC' => \&_MODE_from_server, @@ -585,6 +599,16 @@ $str; } +sub attach_for_client { + my ($str, $network_name) = @_; + + if ($runloop->multi_server_mode_p) { + attach($str, $network_name); + } else { + $str; + } +} + sub classify { # array: 配列への参照 # 戻り値: ネットワーク名→パース後の文字列を並べた配列への参照 diff -urN tiarra-20040729/main/RunLoop.pm tiarra-20040822/main/RunLoop.pm --- tiarra-20040729/main/RunLoop.pm 2004-08-04 07:24:49 +0900 +++ tiarra-20040822/main/RunLoop.pm 2005-01-01 05:28:51 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: RunLoop.pm,v 1.57 2004/03/27 10:41:17 admin Exp $ +# $Id: RunLoop.pm,v 1.58 2004/08/22 11:28:43 topia Exp $ # ----------------------------------------------------------------------------- # このクラスはTiarraのメインループを実装します。 # select()を実行し、サーバーやクライアントとのI/Oを行うのはこのクラスです。 @@ -47,6 +47,7 @@ sub _new { my $class = shift; + my $conf = Configuration::shared_conf; my $this = { # 受信用セレクタ。あらゆるソケットは常に受信の必要があるため、あらゆるソケットが登録されている。 receive_selector => new IO::Select, @@ -58,7 +59,7 @@ tiarra_server_socket => undef, # 現在のnick。全てのサーバーとクライアントの間で整合性を保ちつつnickを変更する手段を、RunLoopが用意する。 - current_nick => Configuration->shared_conf->general->nick, + current_nick => $conf->general->nick, # 鯖から切断された時の動作。 action_on_disconnected => do { @@ -67,7 +68,7 @@ 'one-message' => \&_action_one_message, 'message-for-each' => \&_action_message_for_each, }; - my $action_name = Configuration->shared_conf->networks->action_when_disconnected; + my $action_name = $conf->networks->action_when_disconnected; unless (defined $action_name) { $action_name = 'part-and-join'; } @@ -84,12 +85,15 @@ networks => {}, # ネットワーク名 → IrcIO::Server disconnected_networks => {}, # 切断されたネットワーク。 + terminated_networks => {}, # 終了したネットワーク。 clients => [], # 接続されている全てのクライアント IrcIO::Client timers => [], # インストールされている全てのTimer external_sockets => [], # インストールされている全てのExternalSocket conf_reloaded_hook => undef, # この下でインストールするフック + + terminating => 0, # 正のときは終了処理中。 }; bless $this, $class; @@ -117,7 +121,13 @@ sub network { my ($this,$network_name) = @_; - $this->{networks}->{$network_name}; + my $network; + foreach my $genre (qw(networks disconnected_networks terminated_networks)) { + $network = $this->{$genre}->{$network_name}; + next unless defined $network; + return wantarray ? ($network, $genre) : $network; + } + return wantarray ? () : undef; } sub networks { @@ -160,6 +170,7 @@ sub set_current_nick { my ($this,$new_nick) = @_; $this->{current_nick} = $new_nick; + $this->call_hooks('set-current-nick'); } sub change_nick { @@ -190,6 +201,12 @@ undef; } +# shorthand for Configuration::shared_conf->... +sub _conf { Configuration::shared_conf; } +sub _conf_general { shift->_conf->general; } +sub _conf_networks { shift->_conf->networks; } +sub _conf_messages { shift->_conf_general->messages; } + sub sysmsg_prefix { my ($this,$purpose,$category) = @_; $category = (caller)[0] . (defined $category ? "::$category" : ''); @@ -197,12 +214,12 @@ # いまのところ system(NumericReply など)/priv/channel # $category は、大まかなカテゴリ。 # いまのところ log/system/notify があるが、 - # どうしようか決めかねている…。 + # 明確な仕様はまだない。 if (Mask::match_array([ - Configuration->shared_conf->general-> - sysmsg_prefix_use_masks('block')->get($purpose, 'all')], $category)) { - Configuration->shared->general->sysmsg_prefix; + $this->_conf_general->sysmsg_prefix_use_masks('block')-> + get($purpose, 'all')], $category)) { + $this->_conf_general->sysmsg_prefix; } else { undef } @@ -323,19 +340,27 @@ while (my ($network_name,$io) = each %{$this->{networks}}) { $networks_closed{$network_name} = $io unless $io->connected; } - my $do_update_networks = 0; + my $do_update_networks_after = 0; while (my ($network_name,$io) = each %networks_closed) { # セレクタから外す。 - $this->{receive_selector}->remove($io->sock); - $this->{send_selector}->remove($io->sock); - # networksからは削除して、代わりにdisconnected_networksに入れる。 + $this->unregister_receive_socket($io->sock); + # networksから削除する。 delete $this->{networks}->{$network_name}; - $this->{disconnected_networks}->{$network_name} = $io; - $do_update_networks = 1; + if (!defined $io->state || $io->state eq 'reconnecting') { + $this->{disconnected_networks}->{$network_name} = $io; + $do_update_networks_after = 3; + } elsif ($io->state eq 'terminating') { + $this->{terminated_networks}->{$network_name} = $io; + $do_update_networks_after = 1; + } elsif ($io->state eq 'finalizing') { + # remove + } else { + $this->notify_warn('Unknown network state('.$io->state.') on '.$network_name); + } } - if ($do_update_networks) { + if ($do_update_networks_after) { Timer->new( - After => 3, + After => $do_update_networks_after, Code => sub { $this->update_networks; }, @@ -346,7 +371,7 @@ my $io = $this->{clients}->[$i]; unless ($io->connected) { ::printmsg("Connection with ".$io->fullname." has been closed."); - $this->{receive_selector}->remove($io->sock); + $this->unregister_receive_socket($io->sock); splice @{$this->{clients}},$i,1; $i--; } @@ -368,7 +393,7 @@ IRCMessage->new( Prefix => $client->fullname, Command => 'PART', - Params => [Multicast::attach($ch->name,$network_name), + Params => [Multicast::attach_for_client($ch->name,$network_name), $network->host." closed the connection."])); } } @@ -407,11 +432,7 @@ Params => ['', # チャンネル名は後で設定。 '*** The connection has been revived between '.$network->network_name.'.']); foreach my $ch (values %{$network->channels}) { - if ($this->{multi_server_mode}) { - $msg->param(0,Multicast::attach($ch->name,$network_name)); - } else { - $msg->param(0,$ch->name); - } + $msg->param(0,Multicast::attach_for_client($ch->name,$network_name)); $this->broadcast_to_clients($msg); } } @@ -422,11 +443,7 @@ Params => ['', # チャンネル名は後で設定。 '*** The connection has been broken between '.$network->network_name.'.']); foreach my $ch (values %{$network->channels}) { - if ($this->{multi_server_mode}) { - $msg->param(0,Multicast::attach($ch->name,$network_name)); - } else { - $msg->param(0,$ch->name); - } + $msg->param(0,Multicast::attach_for_client($ch->name,$network_name)); $this->broadcast_to_clients($msg); } } @@ -493,8 +510,7 @@ my $this = shift; # networks/nameを読み、その中にまだ接続していないネットワークがあればそれを接続し、 # 接続中のネットワークで既にnetworks/nameに列挙されていないものがあればそれを切断する。 - my $general_conf = Configuration::shared_conf->get('general'); - my @net_names = Configuration::shared_conf->get('networks')->name('all'); + my @net_names = $this->_conf_networks->name('all'); my $do_update_networks_after = 0; # 秒数 my $do_cleanup_closed_links_after = 0; my $host_tried = {}; # {接続を試みたホスト名 => 1} @@ -507,31 +523,14 @@ @net_names = $net_names[0]; } + my ($net_conf, $network, $genre); foreach my $net_name (@net_names) { - my $net_conf = Configuration::shared_conf->get($net_name); - - if (defined($_ = $this->{networks}->{$net_name})) { - # 既に接続されている。 - # このサーバーについての設定が変わっていたら、一旦接続を切る。 - if (!$net_conf->equals($_->config)) { - $_->disconnect; - $do_cleanup_closed_links_after = 1; - } - next; - } + $net_conf = $this->_conf->get($net_name); - # 切断されたネットワークかも知れない。 - my $network = $this->{disconnected_networks}->{$net_name}; + ($network, $genre) = $this->network($net_name); eval { - if (defined $network) { - # 再接続 - $network->reload_config; - $network->connect; - # disconnected_networksからnetworksへ移す。 - $this->{networks}->{$net_name} = $network; - delete $this->{disconnected_networks}->{$net_name}; - } - else { + if (!defined $genre || !defined $network) { + # 新しいネットワーク if ($host_tried->{$net_conf->host}) { $do_update_networks_after = 15; $network = undef; @@ -543,8 +542,27 @@ $this->{networks}->{$net_name} = $network; # networksに登録 } } - if (defined $network) { - $this->{receive_selector}->add($network->sock); # 受信セレクタに登録 + elsif ($genre eq 'networks') { + # 既に接続されている。 + # このサーバーについての設定が変わっていたら、一旦接続を切る。 + if (!$net_conf->equals($network->config)) { + #$network->disconnect; + #$do_cleanup_closed_links_after = 1; + $network->state('reconnecting'); + $network->quit( + $this->_conf_messages->quit->netconf_changed_reconnect); + } + } + elsif ($genre eq 'terminated_networks') { + # 終了している + # このサーバーについての設定が変わっていたら、接続する。 + if (!$net_conf->equals($network->config)) { + $this->reconnect_server($net_name); + } + } + elsif ($genre eq 'disconnected_networks') { + # 切断されている + $this->reconnect_server($net_name); } }; if ($@) { if ($@ =~ /^[Cc]ouldn't connect to /i) { @@ -557,15 +575,6 @@ } } - if ($do_update_networks_after) { - Timer->new( - After => $do_update_networks_after, - Code => sub { - $this->update_networks; - }, - )->install($this); - } - if ($do_cleanup_closed_links_after) { $this->_cleanup_closed_link; } @@ -589,19 +598,55 @@ } foreach my $net_name (@nets_to_disconnect) { my $server = $this->{networks}->{$net_name}; - $this->disconnect_server($server); - # 手動で全チャンネルへのPARTを送信 - $this->_action_part_and_join($server, 'disconnected'); - } - # disconnected_networksから不要なネットワークを削除 - while (my ($net_name,$server) = each %{$this->{disconnected_networks}}) { - # 入っていなかったら忘れる。 - unless ($is_there_in_net_names->($net_name)) { - push @nets_to_forget,$net_name; + $server->state('finalizing'); + $server->quit( + $this->_conf_messages->quit->netconf_changed_disconnect); + } + # 不要なネットワークを削除 + foreach my $genre (qw(disconnected_networks terminated_networks)) { + while (my ($net_name,$server) = each %{$this->{$genre}}) { + # 入っていなかったら忘れる。 + unless ($is_there_in_net_names->($net_name)) { + if (!$server->connected) { + push @nets_to_forget,$net_name; + } else { + $do_update_networks_after ||= 3; + } + } + } + foreach (@nets_to_forget) { + delete $this->{$genre}->{$_}; } } - foreach (@nets_to_forget) { - delete $this->{disconnected_networks}->{$_}; + + if ($do_update_networks_after) { + Timer->new( + After => $do_update_networks_after, + Code => sub { + $this->update_networks; + }, + )->install($this); + } +} + +sub terminate_server { + my ($this,$network, $msg) = @_; + + $network->state('terminating'); + $network->quit($msg); +} + +sub reconnect_server { + # terminate/disconnect(サーバから)されたサーバへ接続しなおす。 + my ($this,$network_name) = @_; + my ($network, $genre) = $this->network($network_name); + + if (defined $genre && $genre ne 'networks') { + $network->reload_config; + $network->connect; + # 今のジャンルからnetworksへ移す。 + $this->{networks}->{$network_name} = $network; + delete $this->{$genre}->{$network_name}; } } @@ -610,12 +655,24 @@ # fdの監視をやめてしまうので、この後IrcIO::Serverのreceiveはもう呼ばれない事に注意。 # $server: IrcIO::Server my ($this,$server) = @_; - $this->{receive_selector}->remove($server->sock); - $this->{send_selector}->remove($server->sock); $server->disconnect; delete $this->{networks}->{$server->network_name}; } +sub close_client { + # 指定したクライアントとの接続を切る。 + # $client: IrcIO::Client + my ($this, $client, $message) = @_; + $client->send_message( + IRCMessage->new( + Command => 'ERROR', + Param => 'Closing Link: ['.$client->fullname_from_client. + '] ('.$message.')', + Remarks => {'send-error-as-is-to-client' => 1}, + )); + $client->disconnect_after_writing; +} + sub reconnected_server { my ($this,$network) = @_; # 再接続だった場合の処理 @@ -634,7 +691,7 @@ } push @{$this->{external_sockets}},$esock; - $this->{receive_selector}->add($esock->sock); # 受信セレクタに登録 + $this->register_receive_socket($esock->sock); # 受信セレクタに登録 undef; } @@ -647,13 +704,23 @@ for (my $i = 0; $i < @{$this->{external_sockets}}; $i++) { if ($this->{external_sockets}->[$i] == $esock) { splice @{$this->{external_sockets}},$i,1; - $this->{receive_selector}->remove($esock->sock); # 受信セレクタから登録解除 + $this->unregister_receive_socket($esock->sock); # 受信セレクタから登録解除 $i--; } } $this; } +sub register_receive_socket { + # 内部 API です。外部から使うときは ExternalSocket を使用してください。 + shift->{receive_selector}->add(@_); +} + +sub unregister_receive_socket { + # 内部 API です。外部から使うときは ExternalSocket を使用してください。 + shift->{receive_selector}->remove(@_); +} + sub find_esock_with_socket { my ($this,$sock) = @_; foreach my $esock (@{$this->{external_sockets}}) { @@ -713,11 +780,11 @@ sub run { my $this = shift; - my $conf_general = Configuration::shared_conf->get('general'); + my $conf_general = $this->_conf_general; # マルチサーバーモード $this->{multi_server_mode} = - Configuration::shared->networks->multi_server_mode; + $this->_conf_networks->multi_server_mode; # まずはtiarra-portをlistenするソケットを作る。 # 省略されていたらlistenしない。 @@ -772,7 +839,7 @@ if (defined $tiarra_server_socket) { $tiarra_server_socket->autoflush(1); $this->{tiarra_server_socket} = $tiarra_server_socket; - $this->{receive_selector}->add($tiarra_server_socket); # セレクタに登録。 + $this->register_receive_socket($tiarra_server_socket); # セレクタに登録。 main::printmsg("Tiarra started listening ${tiarra_port}/tcp. (IP$ip_version)"); } else { @@ -895,12 +962,15 @@ # クライアントからの新規の接続 my $new_sock = $sock->accept; if (defined $new_sock) { - eval { - my $client = new IrcIO::Client($new_sock); - push @{$this->{clients}},$client; - $this->{receive_selector}->add($new_sock); - }; if ($@) { - $this->notify_msg($@); + if (!$this->{terminating}) { + eval { + my $client = new IrcIO::Client($new_sock); + push @{$this->{clients}},$client; + }; if ($@) { + $this->notify_msg($@); + } + } else { + $new_sock->close; } } } @@ -1032,7 +1102,43 @@ # 発動すべき全てのタイマーを発動させる $this->_execute_all_timers_to_fire; + + # 終了処理中でサーバもクライアントもいなくなればループ終了。 + if ($this->{terminating}) { + if ((scalar $this->networks_list <= 0) && + (scalar $this->clients_list <= 0) + ) { + last; + } else { + ++$this->{terminating}; + if ($this->{terminating} >= 400) { + # quit loop でそんなに回るとは思えない。 + $this->notify_error( + "very long terminating loop!". + "(".$this->{terminating}." count(s))\n". + "maybe something is wrong; exit force..."); + last; + } + } + } } + + # 終了処理 + if (defined $this->{tiarra_server_socket}) { + $this->{tiarra_server_socket}->close; + $this->unregister_receive_socket($this->{tiarra_server_socket}); + } + ModuleManager->shared_manager->terminate; +} + +sub terminate { + my ($this, $message) = @_; + + $this->{terminating} = 1; + map { $this->terminate_server($_, $message) } $this->networks_list; + map { $this->close_client($_, $message) } $this->clients_list; + # なぜかこの位置でサーバソケットを閉じるとおかしくなる。 + # accept で処理することにする。 } sub broadcast_to_clients { @@ -1065,8 +1171,7 @@ sub notify_modules { my ($this,$method,@args) = @_; - my $mods = ModuleManager->shared->get_modules; - foreach my $mod (@$mods) { + foreach my $mod (@{ModuleManager->shared_manager->get_modules}) { eval { $mod->$method(@args); }; if ($@) { @@ -1080,11 +1185,10 @@ sub apply_filters { # @extra_args: モジュールに送られる第二引数以降。第一引数は常にIRCMessage。 my ($this, $src_messages, $method, @extra_args) = @_; - my $mods = ModuleManager->shared_manager->get_modules; my $source = $src_messages; my $filtered = []; - foreach my $mod (@$mods) { + foreach my $mod (@{ModuleManager->shared_manager->get_modules}) { # (普通ないはずだが) $mod が undef だったらこのモジュールをとばす。 next unless defined $mod; # sourceが空だったらここで終わり。 @@ -1098,10 +1202,15 @@ eval { @reply = $mod->$method($src, @extra_args); }; if ($@) { + my $modname = ref($mod); + # ブラックリストに入れておく + ModuleManager->shared_manager->add_to_blacklist($modname); $this->notify_error( - "Exception in ".ref($mod).".\n". - "The message was '".$src->serialize."'.\n". - " $@"); + "Exception in ".$modname.".\n". + "This module added to blacklist!\n". + "The message was '".$src->serialize."'.\n". + " $@"); + ModuleManager->shared_manager->remove_from_blacklist($modname); } if (defined $reply[0]) { @@ -1118,7 +1227,7 @@ # これをfilteredに追加。 push @$filtered,@reply; - } + } } # 次のsourceはfilteredに。filteredは空の配列に。 @@ -1133,55 +1242,6 @@ my ($this, $src_messages, $sender) = @_; $this->apply_filters( $src_messages, 'message_arrived', $sender); - -=pod - - my $mods = ModuleManager->shared_manager->get_modules; - - my $source = $src_messages; - my $filtered = []; - foreach my $mod (@$mods) { - # sourceが空だったらここで終わり。 - if (scalar(@$source) == 0) { - return $source; - } - - foreach my $src (@$source) { - my @reply = (); - # 実行 - eval { - @reply = $mod->message_arrived($src,$sender); - - }; if ($@) { - $this->notify_error("Exception in ".ref($mod).".\n". - "The message was '".$src->serialize."'.\n". - " $@"); - } - - if (defined $reply[0]) { - # 値が一つ以上返ってきた。 - # 全てIRCMessageのオブジェクトなら良いが、そうでなければエラー。 - foreach my $msg_reply (@reply) { - unless (UNIVERSAL::isa($msg_reply,'IRCMessage')) { - $this->notify_error("Reply of ".ref($mod)."::message_arived contains illegal value.\n". - "It is ".ref($msg_reply)."."); - return $source; - } - } - - # これをfilteredに追加。 - push @$filtered,@reply; - } - } - - # 次のsourceはfilteredに。filteredは空の配列に。 - $source = $filtered; - $filtered = []; - } - return $source; - -=cut - } sub notify_error { @@ -1203,9 +1263,9 @@ ::printmsg($str); # クライアントへ - my $needed_sending = Configuration->shared_conf->general->notice_error_messages; + my $needed_sending = $this->_conf_general->notice_error_messages; if ($needed_sending) { - my $client_charset = Configuration->shared_conf->general->client_out_encoding; + my $client_charset = $this->_conf_general->client_out_encoding; if (@{$this->clients} > 0) { $this->broadcast_to_clients( map { @@ -1233,7 +1293,7 @@ use base 'Hook'; our $HOOK_TARGET_NAME = 'RunLoop'; -our @HOOK_NAME_CANDIDATES = qw/before-select after-select/; +our @HOOK_NAME_CANDIDATES = qw/before-select after-select set-current-nick/; our $HOOK_NAME_DEFAULT = 'after-select'; our $HOOK_TARGET_DEFAULT; FunctionalVariable::tie( diff -urN tiarra-20040729/main/TiarraDoc.pm tiarra-20040822/main/TiarraDoc.pm --- tiarra-20040729/main/TiarraDoc.pm 2004-08-04 07:24:48 +0900 +++ tiarra-20040822/main/TiarraDoc.pm 2005-01-01 05:28:51 +0900 @@ -1,5 +1,5 @@ # ------------------------------------------------------------------------ -# $Id: TiarraDoc.pm,v 1.2 2004/02/23 02:46:18 topia Exp $ +# $Id: TiarraDoc.pm,v 1.3 2004/08/22 11:28:43 topia Exp $ # ------------------------------------------------------------------------ # tiarra-docのパーサとトランスレータ群。 # ------------------------------------------------------------------------ @@ -334,34 +334,38 @@ die "$errstr\n$list"; }; - $result .= $indent . do { + $result .= do { if ($line eq '') { ''; } - elsif ($line =~ m/^\s*#/) { - (my $stripped = $line) =~ s/^\s*//; - "$block_indent$stripped"; - } - elsif ($line =~ m/^(.+?)\s*:\s*(.*)$/) { - my ($key,$value) = ($1,$2); - if ($key =~ s/^-//) { - "$block_indent#$key: $value"; - } - else { - "$block_indent$key: $value"; - } - } - elsif ($line =~ m/^(.+?)\s*{\s*$/) { - $_ = "$block_indent$1 {"; - $block_indent .= ' ' x 2; - $_; - } - elsif ($line =~ m/^}\s*$/) { - substr($block_indent, 0, 2) = ''; - "$block_indent}"; - } else { - $error->('illegal line'); + $indent . do { + if ($line =~ m/^\s*#/) { + (my $stripped = $line) =~ s/^\s*//; + "$block_indent$stripped"; + } + elsif ($line =~ m/^(.+?)\s*:\s*(.*)$/) { + my ($key,$value) = ($1,$2); + if ($key =~ s/^-//) { + "$block_indent#$key: $value"; + } + else { + "$block_indent$key: $value"; + } + } + elsif ($line =~ m/^(.+?)\s*{\s*$/) { + $_ = "$block_indent$1 {"; + $block_indent .= ' ' x 2; + $_; + } + elsif ($line =~ m/^}\s*$/) { + substr($block_indent, 0, 2) = ''; + "$block_indent}"; + } + else { + $error->('illegal line'); + } + }; } } . "\n"; } diff -urN tiarra-20040729/module/Auto/Utils.pm tiarra-20040822/module/Auto/Utils.pm --- tiarra-20040729/module/Auto/Utils.pm 2004-08-04 07:24:50 +0900 +++ tiarra-20040822/module/Auto/Utils.pm 2005-01-01 05:28:52 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Utils.pm,v 1.11 2004/07/29 06:23:47 topia Exp $ +# $Id: Utils.pm,v 1.12 2004/08/22 11:28:44 topia Exp $ # ----------------------------------------------------------------------------- package Auto::Utils; use strict; @@ -95,13 +95,7 @@ $specified_network ? $network_name : Configuration->shared_conf->networks->default; }; - my $sendto_client = sub { - if (RunLoop->shared_loop->multi_server_mode_p) { - $sendto; - } else { - $rawname; - } - }; + my $sendto_client = Multicast::attach_for_client($rawname, $network_name); if (!defined $sender) { # 鯖にはチャンネル名にネットワーク名を付けない。 my $for_server = $msg_to_send->clone; @@ -114,7 +108,7 @@ # クライアントにはチャンネル名にネットワーク名を付ける。 # また、クライアントに送られる時にはPrefixがそのユーザーに設定されるよう註釈を付ける。 my $for_client = $msg_to_send->clone; - $for_client->param(0, $sendto_client->()); + $for_client->param(0, $sendto_client); $for_client->remark('fill-prefix-when-sending-to-client',1); RunLoop->shared_loop->broadcast_to_clients($for_client); } elsif ($sender->isa('IrcIO::Server')) { @@ -126,7 +120,7 @@ # クライアントにはチャンネル名にネットワーク名を付ける。 # また、クライアントに送られる時にはPrefixがそのユーザーに設定されるよう註釈を付ける。 my $for_client = $msg_to_send->clone; - $for_client->param(0, $sendto_client->()); + $for_client->param(0, $sendto_client); $for_client->remark('fill-prefix-when-sending-to-client',1); push @$result,$for_client; } elsif ($sender->isa('IrcIO::Client')) { @@ -137,7 +131,7 @@ my $for_client = $msg_to_send->clone; $for_client->prefix($sender->fullname); - $for_client->param(0, $sendto_client->()); + $for_client->param(0, $sendto_client); $sender->send_message($for_client); } }; diff -urN tiarra-20040729/module/Client/Cache.pm tiarra-20040822/module/Client/Cache.pm --- tiarra-20040729/module/Client/Cache.pm 2004-08-04 07:24:50 +0900 +++ tiarra-20040822/module/Client/Cache.pm 2005-01-01 05:28:52 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Cache.pm,v 1.11 2004/06/04 12:57:30 topia Exp $ +# $Id: Cache.pm,v 1.12 2004/08/22 11:28:44 topia Exp $ # ----------------------------------------------------------------------------- # copyright (C) 2003-2004 Topia . all rights reserved. package Client::Cache; @@ -147,10 +147,7 @@ !defined $msg->param(1)) { my %info = $fetch_channel_info->($msg->param(0)); unless (defined $info{network}){ - ::debug_printmsg( - __PACKAGE__.': "'.$info{network_name}. - '" network is not found in tiarra.' - ); + # network not found. maybe disconnected last; } last if !defined $info{ch}; @@ -180,10 +177,7 @@ Multicast::channel_p($msg->param(0))) { my %info = $fetch_channel_info->($msg->param(0)); unless (defined $info{network}){ - ::debug_printmsg( - __PACKAGE__.': "'.$info{network_name}. - '" network is not found in tiarra.' - ); + # network not found. maybe disconnected last; } last if !defined $info{ch}; diff -urN tiarra-20040729/module/Client/Eval.pm tiarra-20040822/module/Client/Eval.pm --- tiarra-20040729/module/Client/Eval.pm 2004-08-04 07:24:50 +0900 +++ tiarra-20040822/module/Client/Eval.pm 2005-01-01 05:28:52 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Eval.pm,v 1.6 2004/07/29 06:23:47 topia Exp $ +# $Id: Eval.pm,v 1.7 2004/08/22 11:28:44 topia Exp $ # ----------------------------------------------------------------------------- package Client::Eval; use strict; @@ -17,7 +17,7 @@ # 指定されたコマンドか? if (Mask::match_deep([$this->config->command('all')], $msg->command)) { # メッセージ再構築 - my ($method) = join(' ', @{$msg->params}[0 .. ($msg->n_params - 1)]); + my ($method) = join(' ', @{$msg->params}); my ($ret, $err); do { # disable warning diff -urN tiarra-20040729/module/Client/Rehash.pm tiarra-20040822/module/Client/Rehash.pm --- tiarra-20040729/module/Client/Rehash.pm 1970-01-01 09:00:00 +0900 +++ tiarra-20040822/module/Client/Rehash.pm 2005-01-01 05:28:52 +0900 @@ -0,0 +1,131 @@ +# ----------------------------------------------------------------------------- +# $Id: Rehash.pm,v 1.1 2004/08/22 11:28:44 topia Exp $ +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Client::Rehash; +use strict; +use warnings; +use base qw(Module); +use Mask; +use Multicast; +use NumericReply; +use Timer; + +my $timer_name = __PACKAGE__.'/timer'; + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); +} + +sub destruct { + my ($this) = shift; + + # timer があれば解除 + foreach my $client (RunLoop->shared_loop->clients_list) { + my $timer = $client->remark($timer_name); + if (defined $timer) { + $client->remark($timer_name, undef, 'delete'); + $timer->uninstall; + } + } +} + +sub message_arrived { + my ($this,$msg,$sender) = @_; + + # クライアントからのメッセージか？ + if ($sender->isa('IrcIO::Client')) { + my $runloop = RunLoop->shared_loop; + # 指定されたコマンドか? + if (Mask::match_deep([$this->config->command_nick('all')], $msg->command)) { + if (!defined $msg->param(0)) { + } elsif ($msg->param(0) eq $runloop->current_nick) { + } else { + $sender->send_message( + IRCMessage->new( + Prefix => $msg->param(0).'!'.$sender->username.'@'. + $sender->client_host, + Command => 'NICK', + Param => $runloop->current_nick, + )); + + } + # ここで消す。 + return undef; + } elsif (Mask::match_deep([$this->config->command_names('all')], $msg->command)) { + my @channels = map { + my $network_name = $_->network_name; + map { + [$network_name, $_->name]; + } $_->channels_list; + } $runloop->networks_list; + $sender->remark($timer_name, Timer->new( + Interval => (defined $this->config->interval ? + $this->config->interval : 2), + Repeat => 1, + Code => sub { + my $timer = shift; + my $runloop = RunLoop->shared_loop; + while (1) { + my $entry = shift(@channels); + if (defined $entry && $sender->connected) { + my ($network_name, $ch_name) = @$entry; + my $network = $runloop->network($network_name); + my $flush_namreply = sub { + my $msg = shift; + $msg->param(0, $runloop->current_nick); + $sender->send_message($msg); + }; + if (!defined $network) { + # network disconnected. ignore + next; + } + my $ch = $network->channel($ch_name); + if (!defined $ch) { + # parted channel; ignore + next; + } + $sender->do_namreply($ch, $network, + undef, $flush_namreply); + } else { + $sender->remark($timer_name, undef, 'delete'); + $timer->uninstall; + } + last; + } + }, + )->install); + + # ここで消す。 + return undef; + } + } + + return $msg; +} + +1; +=pod +info: 全チャンネル分の names の内部キャッシュをクライアントに送信する。 +default: off + +# もともとはクライアントの再初期化目的に作ったのですが、 names を送信しても +# 更新されないクライアントが多いので、主に multi-server-mode な Tiarra の +# 下にさらに Tiarra をつないでいる人向けにします。 + +# names でニックリストを更新してくれるクライアント: +# Tiarra +# してくれないクライアント: (括弧内は確認したバージョンまたは注釈) +# LimeChat(1.18) + +# nick rehash に使うコマンドを指定します。 +# 第二パラメータとして現在クライアントが認識している nick を指定してください。 +command-nick: rehash-nick + +# names rehash に使うコマンドを指定します。 +command-names: rehash-names + +# チャンネルとチャンネルの間のウェイトを指定します。 +interval: 2 +=cut diff -urN tiarra-20040729/module/Log/Channel.pm tiarra-20040822/module/Log/Channel.pm --- tiarra-20040729/module/Log/Channel.pm 2004-08-04 07:24:49 +0900 +++ tiarra-20040822/module/Log/Channel.pm 2005-01-01 05:28:51 +0900 @@ -1,7 +1,6 @@ # ----------------------------------------------------------------------------- -# $Id: Channel.pm,v 1.11 2003/11/16 19:04:39 topia Exp $ +# $Id: Channel.pm,v 1.12 2004/08/22 11:28:44 topia Exp $ # ----------------------------------------------------------------------------- -# Local: $Clovery: tiarra/module/Log/Channel.pm,v 1.4 2003/02/11 07:53:40 topia Exp $ package Log::Channel; use strict; use warnings; @@ -9,9 +8,10 @@ use File::Spec; use Unicode::Japanese; use base qw(Module); -use Module::Use qw(Tools::DateConvert Log::Logger); +use Module::Use qw(Tools::DateConvert Log::Logger Log::Writer); use Tools::DateConvert; use Log::Logger; +use Log::Writer; use ControlPort; use Mask; use Multicast; @@ -21,7 +21,7 @@ my $this = $class->SUPER::new; $this->{channels} = []; # 要素は[ディレクトリ名,マスク] $this->{matching_cache} = {}; # <チャンネル名,ファイル名> - $this->{filehandle_cache} = {}; # <チャンネル名,[ファイルパス,IO::File]> + $this->{writer_cache} = {}; # <チャンネル名,Log::Writer> $this->{sync_command} = do { my $sync = $this->config->sync; if (defined $sync) { @@ -57,7 +57,7 @@ my ($dirname,$mask) = split /\s+/; if (!defined($dirname) || $dirname eq '' || !defined($mask) || $mask eq '') { - die "Illegal definition in Log::Channel/channel : $_\n"; + die 'Illegal definition in '.__PACKAGE__."/channel : $_\n"; } push @{$this->{channels}},[$dirname,$mask]; } @@ -98,7 +98,7 @@ return $message; } - # Log::Channel/commandにマッチするか？ + # __PACKAGE__/commandにマッチするか？ if (Mask::match(lc($this->config->command || '*'),lc($message->command))) { $this->{logger}->log($message,$sender); } @@ -213,118 +213,99 @@ my $header = Tools::DateConvert::replace( $this->config->header || '%H:%M' ); - my $mode = do { - my $mode_conf = $this->config->mode; - if (defined $mode_conf) { - oct('0'.$mode_conf); - } - else { - 0600; + my $always_flush = do { + if ($this->config->keep_file_open) { + if ($this->config->always_flush) { + 1; + } else { + 0; + } + } else { + 1; } }; - # ディレクトリが無ければ作る。 - $this->mkdirs($concrete_fpath); # ファイルに追記 - my $make_path_fh_set = sub { - [$concrete_fpath, - IO::File->new($concrete_fpath,O_CREAT | O_APPEND | O_WRONLY,$mode)]; + my $make_writer = sub { + Log::Writer->shared_writer->find_object( + $concrete_fpath, + always_flush => $always_flush, + file_mode_oct => $this->config->mode, + dir_mode_oct => $this->config->dir_mode, + ); }; - my $fh = sub { + my $writer = sub { # キャッシュは有効か？ if ($this->config->keep_file_open) { # このチャンネルはキャッシュされているか？ - my $cached_elem = $this->{filehandle_cache}->{$channel}; + my $cached_elem = $this->{writer_cache}->{$channel}; if (defined $cached_elem) { # キャッシュされたファイルパスは今回のファイルと一致するか？ - if ($cached_elem->[0] eq $concrete_fpath) { + if ($cached_elem->uri eq $concrete_fpath) { # このファイルハンドルを再利用して良い。 #print "$concrete_fpath: RECYCLED\n"; - return $cached_elem->[1]; + return $cached_elem; } else { # ファイル名が違う。日付が変わった等の場合。 # 古いファイルハンドルを閉じる。 #print "$concrete_fpath: recached\n"; eval { - $cached_elem->[1]->flush; - $cached_elem->[1]->close; + $cached_elem->flush; + $cached_elem->unregister; }; # 新たなファイルハンドルを生成。 - @$cached_elem = @{$make_path_fh_set->()}; - return $cached_elem->[1]; + $cached_elem = $make_writer->(); + if (defined $cached_elem) { + $cached_elem->register; + } + return $cached_elem; } } else { # キャッシュされていないので、ファイルハンドルを作ってキャッシュ。 #print "$concrete_fpath: *cached*\n"; my $cached_elem = - $this->{filehandle_cache}->{$channel} = - $make_path_fh_set->(); - return $cached_elem->[1]; + $this->{writer_cache}->{$channel} = + $make_writer->(); + $cached_elem->register; + return $cached_elem; } } else { # キャッシュ無効。 - return $make_path_fh_set->()->[1]; + return $make_writer->(); } }->(); - if (defined $fh) { - $fh->print( + if (defined $writer) { + $writer->reserve( Unicode::Japanese->new("$header $line\n",'utf8')->conv( $this->config->charset || 'jis')); - } -} - -sub mkdirs { - my ($this,$file) = @_; - my (undef,$directories,undef) = File::Spec->splitpath($file); - my $dir_mode = undef; - - # 直接の親が存在するか - if ($directories eq '' || -d $directories) { - # これ以上辿れないか、存在するので終了。 - return; - } - else { - # 存在しないので作成 - my @dirs = File::Spec->splitdir($directories); - foreach (0 .. (scalar @dirs - 2)) { - my $dir = File::Spec->catdir(@dirs[0 .. $_]); - unless (-d $dir) { - $dir_mode ||= do { - my $mode_conf = $this->config->dir_mode; - if (defined $mode_conf) { - oct('0'.$mode_conf); - } - else { - 0700; - } - }; - mkdir $dir, $dir_mode; - } - } + } else { + # XXX: do warn with properly frequency + #RunLoop->shared_loop->notify_warn("can't write to $concrete_fpath: ". + # "$header $line"); } } sub flush_all_file_handles { my $this = shift; - foreach my $cached_elem (values %{$this->{filehandle_cache}}) { + foreach my $cached_elem (values %{$this->{writer_cache}}) { eval { - $cached_elem->[1]->flush; + $cached_elem->flush; }; } } sub destruct { my $this = shift; - # 開いている全てのファイルハンドルを閉じて、キャッシュを空にする。 - foreach my $cached_elem (values %{$this->{filehandle_cache}}) { + # 開いている全てのLog::Writerを閉じて、キャッシュを空にする。 + foreach my $cached_elem (values %{$this->{writer_cache}}) { eval { - $cached_elem->[1]->flush; - $cached_elem->[1]->close; + $cached_elem->flush; + $cached_elem->unregister; }; } - %{$this->{filehandle_cache}} = (); + %{$this->{writer_cache}} = (); } 1; @@ -370,8 +351,16 @@ # このオプションは多くの場合、ディスクアクセスを抑えて効率良くログを保存しますが # ログを記録すべき全てのファイルを開いたままにするので、50や100のチャンネルを # 別々のファイルにログを取るような場合には使うべきではありません。 +# 万一 fd があふれた場合、クライアントから(またはサーバへ)接続できない・ +# 新たなモジュールをロードできない・ログが全然できないなどの症状が起こる可能性が +# あります。limit の詳細については OS 等のドキュメントを参照してください。 -keep-file-open: 1 +# keep-file-open 時に各行ごとに flush するかどうか。 +# open/close の負荷は気になるが、ログは失いたくない人向け。 +# keep-file-open が有効でないなら無視され(1になり)ます。 +-always-flush: 0 + # keep-file-openを有効にした場合、発言の度にログファイルに追記するのではなく # 一定の分量が溜まってから書き込まれる。そのため、ファイルを開いても # 最近の発言はまだ書き込まれていない可能性がある。 diff -urN tiarra-20040729/module/Log/Writer/Base.pm tiarra-20040822/module/Log/Writer/Base.pm --- tiarra-20040729/module/Log/Writer/Base.pm 1970-01-01 09:00:00 +0900 +++ tiarra-20040822/module/Log/Writer/Base.pm 2005-01-01 05:28:51 +0900 @@ -0,0 +1,203 @@ +# ----------------------------------------------------------------------------- +# $Id: Base.pm,v 1.1 2004/08/22 11:28:44 topia Exp $ +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Log::Writer::Base; +use strict; +use warnings; +use Carp; + +#Log::Writer->register_as_protocol; +#Log::Writer->register_as_fallback; + +# pure virtual function helper +sub not_implemented_error { + my ($class_or_this) = shift; + + die $class_or_this->name . '/' . (caller(1))[3] . + ': Please Implement this!'; +} + +# need override +sub new { + my ($class, $parent, $uri, %options) = @_; + + carp 'Cannot use undef on class, parent, and uri.' + if (grep {(!defined $_) ? 1 : ()} ($class, $parent, $uri)); + + my $this = { + refcount => 0, + parent => $parent, + + buffer => '', + always_flush => $class->first_defined($options{always_flush}, 1), + uri => $uri, + }; + + bless $this, $class; + $this; +} + + +sub scheme { + my $class_or_this = shift; + + # please return scheme string(such as 'file') + ''; +} + +sub name { + my $class_or_this = shift; + + # please return protocol name + 'base (cannot use this directly)'; +} + +sub supported_schemes { + my $class_or_this = shift; + + # please return supported schemes + (); +} + +sub real_flush { + my $this = shift; + + $this->not_implemented_error; + 0; # please return bool(1: successful, 0: failed) +} + +sub real_destruct { + my ($this, $force) = @_; + + $this->not_implemented_error; + # optionally, you can warning if losing data. + # probably $force is useless, because usually does NOT call this + # on (!$this->can_remove && !$force). + # when $force is true, we will destroy instance even if return failed. + 0; # please return bool(1: successful, 0: failed) +} + +# base definition +sub first_defined { + shift; #ignore class/instance + (grep { defined $_ } @_)[0]; +} + +sub define_accessor { + shift; #ignore class/instance + foreach my $name (@_) { + eval ' + sub '.$name.' { + my ($this, $value) = @_; + + $this->{'.$name.'} = $value if defined $value; + return $this->{'.$name.'}; + }'; + } +} +__PACKAGE__->define_accessor(qw(buffer always_flush uri)); + +sub add_ref { ++(shift->{refcount}); } +sub release { --(shift->{refcount}); } +sub refcount { shift->{refcount}; } +sub length { CORE::length(shift->buffer); } +sub clear { shift->buffer(''); } +sub has_data { shift->length > 0; } +sub parent { shift->{parent}; } + +sub path { + my $this = shift; + + if (!defined $this->{path}) { + return undef if (!defined $this->{uri}); + my $scheme = $this->scheme; + return undef if (!defined $scheme); + ($this->{path} = $this->{uri}) =~ s|^\Q$scheme\E://||; + } + $this->{path}; +} + +sub register { + my $this = shift; + + $this->add_ref; + $this; +} + +sub unregister { + my $this = shift; + + $this->release; + if ($this->can_remove) { + return $this->destruct; + } else { + return 1; + } +} + +sub can_remove { + my $this = shift; + + return ($this->refcount <= 0 && !$this->has_data); +} + +sub reserve { + my ($this, $str) = @_; + + $this->{buffer} .= $str; + $this->flush if ($this->always_flush); +} +*write = \&reserve; +*print = \&reserve; + +sub flush { + my $this = shift; + + return 1 if !$this->has_data; + if ($this->real_flush) { + $this->destruct if ($this->can_remove); + return 1; + } else { + return 0; + } +} + +sub destruct { + my ($this, $force) = @_; + + my $ret = $this->real_destruct($force); + $this->parent->object_release($this->uri) if ($ret || $force); + $ret; +} + + +# util + +sub _notify_warn { + my ($this, $str) = @_; + + $this->parent->notify_warn($this->_notify_prefix(1).$str); +} + +sub _notify_error { + my ($this, $str) = @_; + + $this->parent->notify_error($this->_notify_prefix(1).$str); +} + +sub _notify_msg { + my ($this, $str) = @_; + + $this->parent->notify_msg($this->_notify_prefix(1).$str); +} + +sub _notify_prefix { + my ($this, $stack_level) = @_; + + $stack_level = 0 if !defined $stack_level; + $this->name.'/'.(caller(1 + $stack_level))[3].'(' + .$this->uri.'): '; +} + +1; diff -urN tiarra-20040729/module/Log/Writer/File.pm tiarra-20040822/module/Log/Writer/File.pm --- tiarra-20040729/module/Log/Writer/File.pm 1970-01-01 09:00:00 +0900 +++ tiarra-20040822/module/Log/Writer/File.pm 2005-01-01 05:28:51 +0900 @@ -0,0 +1,115 @@ +# ----------------------------------------------------------------------------- +# $Id: File.pm,v 1.1 2004/08/22 11:28:44 topia Exp $ +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Log::Writer::File; +use strict; +use warnings; +use IO::File; +use File::Spec; +use Module::Use qw(Log::Writer::Base); +use Log::Writer::Base; +use base qw(Log::Writer::Base); + +Log::Writer->register_as_protocol; +Log::Writer->register_as_fallback; + +sub new { + my ($class, $parent, $uri, %options) = @_; + my $this = $class->SUPER::new($parent, $uri, %options); + + $this->{file_mode} = $this->first_defined($options{file_mode}, + _oct($options{file_mode_oct}), + 0600); + $this->{dir_mode} = $this->first_defined($options{dir_mode}, + _oct($options{dir_mode_oct}), + 0700); + + $this; +} + +sub _file { + my $this = shift; + + if (!defined $this->{file}) { + $this->mkdirs($this->path); + $this->{file} = IO::File->new($this->path, + O_CREAT | O_APPEND | O_WRONLY, + $this->file_mode); + } + $this->{file}; +} + +sub scheme { + 'file'; +} +*name = \&scheme; +*supported_schemes = \&scheme; + +__PACKAGE__->define_accessor(qw(file_mode dir_mode)); + +sub real_flush { + my $this = shift; + + my $file = $this->_file; + if (!defined $file) { + $this->_notify_warn('can\'t open file'); + return 0; + } + + my $ret = 0; + my $size = 1; + while ($size && $this->has_data) { + # use buffer directly; perhaps reduce memory allocation + my $size = $file->syswrite($this->{buffer}, $this->length); + if (defined $size) { + substr($this->{buffer}, 0, $size) = ''; + $ret = 1; + } else { + $this->_notify_warn($!); + $size = 0; + } + } + return $ret; +} + +sub real_destruct { + my ($this, $force) = @_; + + # make useless efforts + $this->real_flush; + + if (!defined $this->has_data) { + $this->_notify_warn('has can\'t flush data; will lost!'); + } + if (defined $this->{file}) { + # not use ->file. we don't need new allocation. + $this->{file}->close; + } + return 1; +} + +sub _oct { + map { defined $_ ? oct("0$_") : undef } @_; +} + +sub mkdirs { + my ($this,$file) = @_; + my (undef,$directories,undef) = File::Spec->splitpath($file); + + # 直接の親が存在するか + if ($directories eq '' || -d $directories) { + # これ以上辿れないか、存在するので終了。 + return; + } + else { + # 存在しないので作成 + my @dirs = File::Spec->splitdir($directories); + foreach (0 .. (scalar @dirs - 2)) { + my $dir = File::Spec->catdir(@dirs[0 .. $_]); + mkdir $dir, $this->dir_mode unless (-d $dir); + } + } +} + +1; diff -urN tiarra-20040729/module/Log/Writer.pm tiarra-20040822/module/Log/Writer.pm --- tiarra-20040729/module/Log/Writer.pm 1970-01-01 09:00:00 +0900 +++ tiarra-20040822/module/Log/Writer.pm 2005-01-01 05:28:51 +0900 @@ -0,0 +1,260 @@ +# ----------------------------------------------------------------------------- +# $Id: Writer.pm,v 1.1 2004/08/22 11:28:44 topia Exp $ +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Log::Writer; +use strict; +use warnings; +use RunLoop; +use Timer; +use Carp; +use File::Spec; +use DirHandle; +our $_shared_instance; + +# todo: +# - accept uri(maybe: ssh, syslog, ...) + +*shared = \&shared_writer; +sub shared_writer { + if (!defined $_shared_instance) { + $_shared_instance = __PACKAGE__->_new; + $_shared_instance->load_all_protocols; + } + $_shared_instance; +} + +sub _this { + my $class_or_this = shift; + + if (!ref($class_or_this)) { + # fetch shared_writer + $class_or_this = $class_or_this->shared_writer; + } + + $class_or_this; +} + +sub _new { + my $class = shift; + my ($this) = { + objects => {}, + schemes => {}, + protocols => [], + fallbacks => [], + timer => undef, + }; + bless $this, $class; + + return $this; +} + +sub find_object { + my ($this, $path, %options) = @_; + + my $object = $this->{objects}->{$path}; + if (defined($object)) { + # ファイルが存在したので返す。 + return $object; + } else { + # ファイルは存在しないので、登録して返す。 + return $this->_register_inner($path, %options); + } +} + +sub register { + my ($this, $path, %options) = @_; + + my $object = $this->find_object($path, %options); + if (defined $object) { + # ファイルを得られた。 + # 参照回数を増やして返す。 + $object->register; + return $object; + } else { + return undef; + } +} + +sub unregister { + my ($this, $path) = @_; + + my $object = $this->{objects}->{$path}; + if (defined $object) { + return $object->unregister; + } else { + croak('object "' . $path . '" has not registered yet!'); + } +} + +sub _register_inner { + my ($this, $path, %options) = @_; + + my $object; + my @classes; + if ($path =~ m|^([^:]+):|) { + if (defined $this->{schemes}->{$1}) { + push(@classes, @{$this->{schemes}->{$1}}); + } + } + push(@classes, @{$this->{fallbacks}}); + foreach my $class (@classes) { + $object = $class->new($this, $path, %options); + last if defined $object; + } + if (defined $object) { + $this->{objects}->{$path} = $object; + $this->_install_timer; + return $object; + } else { + return undef; + } +} + +sub run { + my ($this, $destruct) = @_; + + # do object + foreach my $key (keys %{$this->{objects}}) { + my $object = $this->{objects}->{$key}; + $object->flush; + $object->destruct(1) if ($destruct); + } +} + +sub destruct { + shared_writer->run(1); +} + +sub object_release { + my ($this, $path) = @_; + + delete $this->{objects}->{$path}; + + if (scalar(keys(%{$this->{objects}})) == 0) { + $this->_uninstall_timer; + } +} + + +# protocol +sub register_as_protocol { + my $class_or_this = shift; + my $pkg = (caller)[0]; + my $this = $class_or_this->_this; + + foreach my $scheme ($pkg->supported_schemes) { + push(@{$this->{schemes}->{$scheme}}, $pkg); + } +} + +sub register_as_fallback { + my $class_or_this = shift; + my $pkg = (caller)[0]; + my $this = $class_or_this->_this; + + push(@{$this->{fallbacks}}, $pkg); +} + +sub load_all_protocols { + my $class_or_this = shift; + my $this = $class_or_this->_this; + + my $pkg_dir = File::Spec->catdir(split(/::/, ref($this))); + foreach (@INC) { + my $dir = File::Spec->catdir($_, $pkg_dir); + my $dh = DirHandle->new($dir); + if (defined $dh) { + my $path; + foreach my $file ($dh->read) { + $path = File::Spec->catdir($dir, $file); + next if !-r $path || -d $path; + next if $file !~ /^(.+)\.pm$/; + $this->load_protocol($1); + } + } + } +} + +sub load_protocol { + my ($class_or_this, $protocol) = @_; + my $this = $class_or_this->_this; + + my $pkg = ref($this) . '::' . $protocol; + eval 'use ' . $pkg; + if ($@) { + $this->notify_error("load protocol($protocol) error: $@"); + return undef; + } + eval 'use Module::Use ($pkg);'; + if ($@) { + $this->notify_error("regist using protocol($protocol) error: $@"); + return undef; + } + push(@{$this->{protocols}}, $protocol); + return 1; +} + +sub unload_protocol { + my ($class_or_this, $protocol) = shift; + my $this = $class_or_this->_this; + + @{$this->{protocols}} = grep { + $_ ne $protocol; + } @{$this->{protocols}}; + return 1; +} + +# util +sub notify_warn { + my ($this, $str) = @_; + + RunLoop->shared_loop->notify_warn($str); +} + +sub notify_error { + my ($this, $str) = @_; + + RunLoop->shared_loop->notify_error($str); +} + +sub notify_msg { + my ($this, $str) = @_; + + RunLoop->shared_loop->notify_msg($str); +} + +# timer +sub _check_timer { + return defined(shift->{timer}); +} + +sub _install_timer { + my $this = shift; + + if (!$this->_check_timer) { + $this->{timer} = Timer->new( + Interval => 120, + Repeat => 1, + Code => sub { + my $timer = shift; + $this->run; + }, + )->install; + } + + return 0; +} + +sub _uninstall_timer { + my $this = shift; + + if ($this->_check_timer) { + $this->{timer}->uninstall; + $this->{timer} = undef; + } + + return 0; +} + +1; diff -urN tiarra-20040729/module/Skelton.pm tiarra-20040822/module/Skelton.pm --- tiarra-20040729/module/Skelton.pm 2004-08-04 07:24:51 +0900 +++ tiarra-20040822/module/Skelton.pm 2005-01-01 05:28:53 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Skelton.pm,v 1.2 2004/02/04 12:08:54 admin Exp $ +# $Id: Skelton.pm,v 1.3 2004/08/22 11:28:44 topia Exp $ # ----------------------------------------------------------------------------- # モジュールのスケルトン。 # ----------------------------------------------------------------------------- @@ -13,7 +13,7 @@ # モジュールが必要になった時に呼ばれる。 # これはモジュールのコンストラクタである。 # 引数は無し。 - my $this = $class->SUPER::new; + my $this = $class->SUPER::new(@_); return $this; } @@ -115,8 +115,8 @@ sub message_io_hook { my ($this,$message,$io,$type) = @_; - # サーバーから受け取ったメッセージ、サーバーに送ったメッセージ、 - # クライアントから受け取ったメッセージ、クライアントに送ったメッセージは + # サーバーから受け取ったメッセージ、サーバーに送るメッセージ、 + # クライアントから受け取ったメッセージ、クライアントに送るメッセージは # このメソッドで各モジュールに通知される。メッセージの変更も可能で、 # 戻り値のルールはmessage_arrivedと同じ。 # @@ -124,10 +124,10 @@ # # $message : # 内容: IRCMessageオブジェクト - # 送受信されたメッセージ + # 送受信しているメッセージ # $io : # 内容: IrcIO::Server又はIrcIO::Clientオブジェクト - # 送受信が行なわれたIrcIO + # 送受信を行っているIrcIO # $type : # 内容: 文字列 # 'in'なら受信、'out'なら送信 diff -urN tiarra-20040729/module/System/Error.pm tiarra-20040822/module/System/Error.pm --- tiarra-20040729/module/System/Error.pm 1970-01-01 09:00:00 +0900 +++ tiarra-20040822/module/System/Error.pm 2005-01-01 05:28:52 +0900 @@ -0,0 +1,38 @@ +# ----------------------------------------------------------------------------- +# $Id: Error.pm,v 1.1 2004/08/22 11:28:44 topia Exp $ +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package System::Error; +use strict; +use warnings; +use base qw(Module); + +sub message_io_hook { + my ($this,$message,$io,$type) = @_; + + if ($io->isa('IrcIO::Client') && + $type eq 'out' && + $message->command eq 'ERROR' && + !$message->remark('send-error-as-is-to-client')) { + $message->param(1, $message->serialize); + $message->param(0, RunLoop->shared_loop->current_nick); + $message->command('NOTICE'); + } + + return $message; +} + +1; + +=pod +info: サーバーからのERRORメッセージをNOTICEに埋め込む +default: on + +# これをoffにするとクライアントにERRORメッセージがそのまま送られます。 +# クライアントとの間ではERRORメッセージは主に切断警告に使われており、 +# そのまま流してしまうとクライアントが混乱する可能性があります。 +# 設定項目はありません。 + +# このモジュールを回避してERRORメッセージをクライアントに送りたい場合は、 +# remarkのsend-error-as-is-to-clientを指定してください。 +=cut diff -urN tiarra-20040729/module/System/NotifyIcon/Win32.pm tiarra-20040822/module/System/NotifyIcon/Win32.pm --- tiarra-20040729/module/System/NotifyIcon/Win32.pm 2004-08-04 07:24:51 +0900 +++ tiarra-20040822/module/System/NotifyIcon/Win32.pm 2005-01-01 05:28:52 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Win32.pm,v 1.1 2004/07/29 06:23:48 topia Exp $ +# $Id: Win32.pm,v 1.2 2004/08/22 11:28:44 topia Exp $ # ----------------------------------------------------------------------------- # use shell notify-icon # based on win32::TaskTray.pm (超ベータVer) @@ -43,14 +43,21 @@ $this->{console_window} = Win32::GUI::GetPerlWindow(); # タスクトレイ登録 - $this->{icon} = new Win32::GUI::Icon('GUIPERL.ICO'); + if (defined $this->config->iconfile) { + $this->{icon} = new Win32::GUI::Icon($this->config->iconfile); + } $this->event_handler_register('NotifyIcon_Click'); $this->event_handler_register('NotifyIcon_RightClick'); $this->{notify_icon} = $this->{main_window}->AddNotifyIcon( -name => __PACKAGE__ . '::NotifyIcon', - -icon => $this->{icon}, + (defined $this->{icon} ? (-icon => $this->{icon}) : ()), -tip => 'Tiarra(irc proxy) #' . ::version()); + if (defined $this->config->hide_console_on_load && + $this->config->hide_console_on_load) { + $this->Win32Event_NotifyIcon_Click(); + } + return $this; } @@ -218,4 +225,12 @@ # Win32 イベントループを処理する最大間隔を指定します。 -interval: 2 + +# 通知領域に表示するアイコンを指定します。 +# Win32::GUI の制限でちゃんとしたアイコンファイルしか指定できません。 +iconfile: guiperl.ico + +# モジュールが読み込まれたときにコンソールウィンドウを隠すかどうかを +# 指定します。 +hide-console-on-load: 1 =cut diff -urN tiarra-20040729/module/System/Shutdown.pm tiarra-20040822/module/System/Shutdown.pm --- tiarra-20040729/module/System/Shutdown.pm 2004-08-04 07:24:51 +0900 +++ tiarra-20040822/module/System/Shutdown.pm 2005-01-01 05:28:52 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Shutdown.pm,v 1.4 2004/02/23 02:46:20 topia Exp $ +# $Id: Shutdown.pm,v 1.5 2004/08/22 11:28:44 topia Exp $ # ----------------------------------------------------------------------------- package System::Shutdown; use strict; @@ -34,7 +34,7 @@ # どうせクライアントには送られないがメッセージ表示 RunLoop->shared->notify_msg( "System::Shutdown received shutdown command from ".$msg->prefix."."); - &::shutdown; + ::shutdown(join(' ', @{$msg->params})); } } } @@ -57,6 +57,7 @@ # Tiarraをシャットダウンさせるprivの発言。 # 省略された場合はprivでのシャットダウンは無効になります。 +# パラメータとして shutdown メッセージを指定できます。 -message: shutdown # privでのシャットダウンを許可する人。 diff -urN tiarra-20040729/module/Tools/FileCache/EachFile.pm tiarra-20040822/module/Tools/FileCache/EachFile.pm --- tiarra-20040729/module/Tools/FileCache/EachFile.pm 2004-08-04 07:24:51 +0900 +++ tiarra-20040822/module/Tools/FileCache/EachFile.pm 2005-01-01 05:28:52 +0900 @@ -1,5 +1,7 @@ # -*- cperl -*- -# $Clovery: tiarra/module/Tools/FileCache/EachFile.pm,v 1.3 2003/07/24 03:03:29 topia Exp $ +# ----------------------------------------------------------------------------- +# $Id: EachFile.pm,v 1.3 2004/08/22 11:28:44 topia Exp $ +# ----------------------------------------------------------------------------- # copyright (C) 2003 Topia . all rights reserved. package Tools::FileCache::EachFile; use strict; @@ -55,41 +57,27 @@ sub register { - my ($this) = @_; + my $this = shift; - $this->add_refcount(); - return $this; + $this->add_ref; + $this; } sub unregister { - my ($this) = @_; - - $this->del_refcount(); - return $this; -} - -sub add_refcount { - my ($this) = @_; - - return ++($this->{refcount}); -} - -sub del_refcount { - my ($this) = @_; + my $this = shift; - return --($this->{refcount}); + $this->release; + $this; } -sub refcount { - my ($this) = @_; - - return $this->{refcount}; -} +sub add_ref { ++(shift->{refcount}); } +sub release { --(shift->{refcount}); } +sub refcount { shift->{refcount}; } sub can_remove { my $this = shift; - return ($this->{refcount} <= 0); + return ($this->refcount <= 0); } sub set_expire { diff -urN tiarra-20040729/module/Tools/FileCache.pm tiarra-20040822/module/Tools/FileCache.pm --- tiarra-20040729/module/Tools/FileCache.pm 2004-08-04 07:24:51 +0900 +++ tiarra-20040822/module/Tools/FileCache.pm 2005-01-01 05:28:52 +0900 @@ -1,18 +1,22 @@ # -*- cperl -*- +# ----------------------------------------------------------------------------- # Tools::FileCache, Data shared file cache service. -# $Id: FileCache.pm,v 1.3 2003/09/25 13:16:00 topia Exp $ +# ----------------------------------------------------------------------------- +# $Id: FileCache.pm,v 1.4 2004/08/22 11:28:44 topia Exp $ +# ----------------------------------------------------------------------------- # copyright (C) 2003 Topia . all rights reserved. package Tools::FileCache; use strict; use warnings; use RunLoop; +use Carp; use Module::Use qw(Tools::FileCache::EachFile); use Tools::FileCache::EachFile; our $_shared; sub shared { if (!defined $_shared) { - $_shared = Tools::FileCache->_new; + $_shared = __PACKAGE__->_new; } return $_shared; diff -urN tiarra-20040729/sample.conf tiarra-20040822/sample.conf --- tiarra-20040729/sample.conf 2004-08-04 07:24:53 +0900 +++ tiarra-20040822/sample.conf 2005-01-01 05:28:58 +0900 @@ -56,66 +56,66 @@ # コード名はjis,sjis,euc,utf8,utf16,utf32等。(この値はUnicode::Japaneseにそのまま渡されます) # autoが指定された、または省略された場合は自動判別します。 conf-encoding: euc - + # ユーザー情報 # 省略不能です。 nick: tiarra user: tiarra name: Tiarra the "Aeon" - + # どのようなユーザーモードでログインするか。+iwや+iのように指定する。 # 省略された場合はユーザーモードを特に設定しない。 #user-mode: +i - + # Tiarraへの接続を許可するホスト名を表わすマスク。 # 制限をしないのであれば"*"を指定するか省略する。 client-allowed: * - + # Tiarraが開くポート。ここに指定したポートへクライアントに接続させる。 # 省略されたらポートを開かない。 tiarra-port: 6667 - + # Tiarraがポートtiarra-portを開く際、IPv6とIPv4のどちらでリスニングを行なうか。 # 'v4'または'v6'で指定します。デフォルトは'v4'です。 # IPv6を使うためにはSocket6.pmが利用可能である必要があります。 #tiarra-ip-version: v4 - + # Tiarraがポートtiarra-portを開く際のローカルアドレス。 # 意味が分からなければ省略して下さい。 # デフォルトは、IPv4のはINADDR_ANY、IPv6のはin6addr_anyになります。 #tiarra-ipv4-bind-addr: 0.0.0.0 #tiarra-ipv6-bind-addr: ::0 - + # Tiarraにクライアントが接続する際に要求するパスワードをcryptした文字列。 # 空の文字列が指定されたり省略された場合はパスワードを要求しない。 # crypt は ./tiarra --make-password で行えます。 tiarra-password: xl7cflIcH9AwE - + # 外部プログラムからtiarraをコントロールする為のUNIXドメインソケットの名前。 # 例えば"foo"を指定した場合、ソケット/tmp/tiarra-control/fooが作られる。 # 省略された場合はこの機能を無効とする。 # また、非UNIX環境ではそもそもUNIXドメインソケットが利用可能でないため、 # そのような場合にもこの機能は無効となる。 #control-socket-name: test - + # IRCサーバーから送られる文字のコードと、IRCサーバーへ送る文字のコード # どちらも省略された場合はjis。 server-in-encoding: jis server-out-encoding: jis - + # クライアントから受け取る文字のコードと、クライアントへ伝える文字のコード # どちらも省略された場合はjis。 client-in-encoding: jis client-out-encoding: jis - + # Tiarraは標準出力に様々なメッセージを出力するが、その文字コードを指定する。省略時にはeucとなる。 # ただしtiarra.confのパースが完了するまでは文字コードの変換は行なわれない(つまりこの設定が有効にならない)ことに注意して下さい。 stdout-encoding: euc - + # Tiarraはエラーメッセージを標準出力に出力するが、その時に接続しているクライアントがあればクライアントにもNOTICEで送る事が出来る。 # この値を1にすると、その機能が有効になる。省略するか0を指定するとこの機能は無効になる。 notice-error-messages: 1 - + # Tiarraでチャンネルとユーザーのマスクを指定するときの形式。 # plum形式とTiarra形式が選択できます。 #----------------- @@ -134,36 +134,48 @@ # mask: * -*!*@* #----------------- # となります。 この二つはまったく同じマスクを表しています。 - + # この値をplumにすると、plum形式、省略するかtiarraを指定すると、Tiarra形式になります。 chanmask-mode: tiarra - + # サーバーに接続する際、ローカル側のどのアドレスにバインドするか。 # 意味が分からなければ省略して下さい。 # デフォルトは、IPv4のはINADDR_ANY、IPv6のはin6addr_anyになります。 #ipv4-bind-addr: 0.0.0.0 #ipv6-bind-addr: ::0 - + # tiarra が、 001 や 002 や、 recent log を送信するときなどに使う prefix # を指定します。 hostname や fqdn っぽいものを指定すると良いかもしれません。 # デフォルトは tiarra です。普通変える必要はありません。 #sysmsg-prefix: tiarra - + sysmsg-prefix-use-masks { # sysmsg-prefix を使用する場所を指定する。 - + # システムメッセージ(NumericReply など)。デフォルトは * です。 # ふつうこれを変更する必要はありません。 system: * - + # 個人宛メッセージ(Notice,Privmsg の中で)。デフォルトはなし。 #priv: - + # チャンネル宛メッセージ(Notice,Privmsg の中で)。デフォルトは * です。 # Ziciz などのクライアントを接続する場合は、 # -*::log を指定しておくといいかもしれません。 channel: * } + + messages { + # Tiarra が使用する、いくつかのメッセージを指定する。 + + quit { + # ネットワーク設定が変更され、再接続する場合の切断メッセージ + netconf-changed-reconnect: Server Configuration changed; reconnect + + # ネットワーク設定が変更され、切断する場合の切断メッセージ + netconf-changed-disconnect: Server Configuration changed; disconnect + } + } } # ----------------------------------------------------------------------------- @@ -185,23 +197,23 @@ # その直後にjoinし直したように見えます。 # デフォルトでは1です。 multi-server-mode: 1 - + # 接続するIRCネットワークに名前を付けます。この名前は後で使用します。 # 複数のネットワークに接続したい場合は多重定義して下さい。 name: ircnet name: 2ch - + # 通常Tiarraではチャンネル名を「#Tiarra@ircnet」のように表現します。 # これはネットワークircnet内の#Tiarraというチャンネルを表わします。 # @以降は省略可能ですが、省略された場合のデフォルトのネットワーク名をここで指定します。 # 省略した場合は最も始めに定義されたnameがデフォルトになります。 # (そしてnameが一つも無かった場合はmainがデフォルトになります) default: ircnet - + # 上に述べた通り、デフォルトではTiarraはチャンネル名とネットワーク名を@で区切ります。 # この区切り文字は任意の文字に変更する事が出来ます。省略された場合は@になります。 channel-network-separator: @ - + # 接続先のサーバーから切断された時に、joinしていたそのサーバーのチャンネルをどうするか。 # 1. "part-and-join"の場合は、切断されるとクライアントにはチャンネルからpartしたように見せ掛け、 # 再接続に成功すると再びjoinしたように見せ掛ける。最も負荷が高い。(これはplumに似た動作である) @@ -213,7 +225,7 @@ # 再接続に成功すると再びNOTICEで報告する。JOINやPARTはしない。 # デフォルトはpart-and-joinです。 action-when-disconnected: message-for-each - + # NICKを変更する度に、変更したサーバーでの新しいNICKをNOTICEで常に通知するかどうか。 # 1なら必ず通知し、0なら変更後のnickがローカルnick(クライアントが見る事の出来るnick)と違っている場合のみ通知する。 # デフォルトは0です。 @@ -230,23 +242,23 @@ # サーバーのホストとポート。省略不可。 host: irc.nara.wide.ad.jp port: 6663 - + # general/userで設定したユーザ名を使わずに、各ネットワークで独自のユーザ名を使用する事も可能。 # 省略されたら当然、general/userで設定したものが使われる。 #user: hoge - + # general/nameで設定した本名(建前上)を使わずに、各ネットワークで独自の本名を使用可能。 #name: hoge - + # このサーバーの要求するパスワード。省略可能。 #password: hoge - + # general/setver-in/out-encodingで設定したエンコーディングを使わずに、 # 各ネットワークで独自のエンコーディングを使用する事も可能。 # 省略されたら当然、generalで設定したものが使われる。 #in-encoding: jis #out-encoding: jis - + # general/(ipv4|ipv6)bind-addrで設定したローカルアドレスを使わずに、 # 各ネットワークで独自のbind_addrを使用する事も可能。 # 省略されたらgeneralで設定したものが使われる。 @@ -300,7 +312,7 @@ # エイリアスは基本的にname,userの二つのフィールドから成っており、 # それぞれユーザー名、ユーザーマスクを表します。 - + # エイリアス定義ファイルのパスと、そのエンコーディング。 # このファイルは次のようなフォーマットである。 # 1. それぞれの行は「<キー>: <値>」の形式である。 @@ -317,29 +329,29 @@ # alias: alias.txt alias-encoding: euc - + # この発言をした人のエイリアスが登録されていれば、それをprivで送る。 confirm: エイリアス確認 - + # 「 user *!*user@*.user.net」のようにして情報を追加。 # 発言をした人のエイリアスが未登録だった場合は、userのみ受け付けて新規追加とする。 add: エイリアス追加 - + # 「 name ユーザー」のようにして情報を削除。 # userを全て削除されたエイリアスは他の情報(name等)も含めて消滅する。 remove: エイリアス削除 - + # メッセージが追加されたときの反応を指定します。 # ランダムなメッセージを発言する際のフォーマットを指定します。 # エイリアス置換が有効です。#(nick.now)、#(channel)は # それぞれ相手のnick、チャンネル名に置換されます。 # #(key)、#(value)は、追加されたキーと値に置換されます。 added-format: #(name|nick.now): エイリアス #(key) に #(value) を追加しました。 - + # メッセージが削除されたときの反応を指定します。 # added-formatで指定できるものと同じです。 removed-format: #(name|nick.now): エイリアス #(key) から #(value) を削除しました。 - + # エイリアスの追加や削除が許されている人。省略された場合は「*!*@*」と見做される。 modifier: *!*@* } @@ -348,7 +360,7 @@ # 特定の発言に反応して対応する発言をする。 # Auto::Aliasを有効にしていれば、エイリアス置換を行ないます。 - + # 反応する発言と、それに対する返事を定義します。 # エイリアス置換が有効です。#(nick.now)と$(channel)はそれぞれ # 相手の現在のnickとチャンネル名に置換されます。 @@ -366,7 +378,7 @@ # +で始まらない特定のチャンネルで、+aモードでも+rモードでもないのに # 誰もチャンネルオペレータ権限を持っていない状態になっている時、 # そこに誰かがJOINする度に特定のメッセージを発言するモジュールです。 - + # 書式: <チャンネル名> <メッセージ> #channel: #IRC談話室@ircnet なると消失しました。 } @@ -375,7 +387,7 @@ # 特定のチャンネルに誰かがJOINする度に特定のメッセージを発言する。 # Auto::Aliasを有効にしていれば、エイリアス置換を行ないます。 - + # 発言を行なうチャンネルと、その内容を定義します。 # #(nick.now)と$(channel)は、それぞれ相手の現在のnickとチャンネル名に置換されます。 # @@ -387,76 +399,76 @@ # 伝言をメールとして送信する。 # メールアドレスはエイリアスの mail を参照します。 - + # Fromアドレス。[default: OSのユーザ名] from: example1@example.jp - + # 送信用のキーワード [default: mesmail_send] send: 速達伝言 - + # 使用を許可する人&チャンネルのマスク。 # 例はTiarraモード時。 [default: なし] mask: * +*!*@* # [plum-mode] mask: +*!*@* - + # maskで拒否されたときのメッセージ [default: なし] deny: 伝言したくない。 - + # 一度に送れる宛先の量 [default: 無制限] max-send-address: 5 - + # 宛先を探すエイリアスエントリ [default: なし] alias-key: name alias-key: nick - + # 宛先の人を判別出来なかったときのメッセージ [default: なし] unknown: #(who)さんと言うのは誰ですか? - + # メールの日付形式 date: %H:%M:%S - + # エイリアスは見付かったけれどメールアドレスが登録されていなかったときのメッセージ。 [default: なし] #none-address: #(who)さんはアドレスを登録していません。 - + # SMTPのホスト [default: localhost] #smtphost: localhost - + # SMTPのポート [default: smtp(25)] #smtpport: 25 - + # SMTPで自ホストのFQDN [default: localhost] #smtpfqdn: localhost - + # 送信するメールの既定件名(エイリアス使用不可) [default: Message from IRC] #subject: Message from IRC - + # 送信するメールの本文 [default: #(date) << #(from.name|from.nick|from.nick.now) >> #(message)] #format: #(date)に#(from.name|from.nick|from.nick.now)さんから#(message)という伝言です。 - + # 送信したときのメッセージ。 [default: なし] accept: #(who)さんに#(message)と伝言しておきました。 - + # ---- POP before SMTP の指定 ---- # POP before SMTPを使う。 [default: no] #use-pop3: yes - + # POP before SMTPのタイムアウト時間(分)。分からない場合は指定しなくて良い。 [default: 0] #pop3-expire: 4 - + # POPのホスト。 [default: localhost] #pop3host: localhost - + # POPのポート。 [default: pop(110)] #pop3port: 110 - + # POPのユーザ [default: OSのユーザ名] #pop3user: example1 - + # POPのパスワード [default: 空パスワード('')] #pop3pass: test-password - + # ---- エラーメッセージの設定 ---- - + # 一般エラー。 # error-[state] と言う形式で詳細エラーメッセージを指定できる。 # [state]は、 @@ -468,12 +480,12 @@ # がある。特に欲しくなければerror-[state]は指定しなくても構わない。 # メッセージを出したくないなら中身の無いエントリを指定すれば良い。 # error-[state]が指定されてない場合は代わりに error を使う。 [default: 未定義] - + #error-rcptto: #error-norcptto: #(who)さんには送れませんでした。送信できるメールアドレスがありません。 #error-data: メールが送信できません。DATAコマンドに失敗しました。#(line;サーバ応答:%s|;) #error: メール送信エラーです。#(line;サーバ応答:%s|;)#(state; on %s|;) - + # 致命的なエラー。メールに個別なエラーではないので送信者(のprefix)毎に1メッセージ送られる。 # fatalerror-[state] # [state]: @@ -482,7 +494,7 @@ # がある。特に欲しくなければfatalerror-[state]は指定しなくても構わない。 # メッセージを出したくないなら中身の無いエントリを指定すれば良い。 # fatalerror-[state]が指定されてない場合は代わりに fatalerror を使う。 [default: 未定義] - + #fatalerror-first: SMTPサーバに接続できません。 #fatalerror: SMTPセッションで致命的なエラーがありました。#(line; サーバ応答:%s|;)#(state; on %s|;) } @@ -491,10 +503,10 @@ # 特定の文字列を発言した人を+oする。 # Auto::Aliasを有効にしていれば、エイリアス置換を行ないます。 - + # +oを要求する文字列(マスク)を指定します。 request: なると寄越せ - + # チャンネルオペレータ権限を要求した人と要求されたチャンネルが # ここで指定したマスクに一致しなかった場合は # denyで指定した文字列を発言し、+oをやめます。 @@ -518,29 +530,29 @@ # この順序を上下逆にすると、全てのチャンネルで全ての人を +o する事になります。 # 何故なら最初の* +*!*@*が全ての人にマッチするからです。 mask: * *!*@* - + # +oを要求した人を実際に+oする時、ここで指定した発言をしてから+oします。 # #(name|nick)のようなエイリアス置換を行います。 # エイリアス以外でも、#(nick.now)を相手のnickに、#(channel)を # そのチャンネル名にそれぞれ置換します。 message: 了解 - + # +oを要求されたが+oすべき相手ではなかった場合の発言。 # 省略されたら何も喋りません。 deny: 断わる - + # +oを要求されたが相手は既にチャンネルオペレータ権限を持っていた場合の発言。 # 省略されたらdenyに設定されたものを使います。 oper: 既に@を持っている - + # +oを要求されたが自分はチャンネルオペレータ権限を持っていなかった場合の発言。 # 省略されたらdenyに設定されたものを使います。 not-oper: @が無い - + # チャンネルに対してでなく自分に対して+oの要求を行なった場合の発言。 # 省略されたらdenyに設定されたものを使います。 private: チャンネルで要求せよ - + # チャンネルの外から+oを要求された場合の発言。+nチャンネルでは起こりません。 # 省略されたらdenyに設定されたものを使います。 out: チャンネルに入っていない @@ -550,56 +562,56 @@ # 特定の発言に反応してランダムな発言をします。 # Auto::Aliasを有効にしていれば、エイリアス置換を行ないます。 - + # 使用するブロックの定義。 blocks: wimikuji - + wimikuji { # ランダムに発言するメッセージの書かれたファイルと、その文字コードを指定します。 # ファイルの中では一行に一つのメッセージを書いて下さい。 file: random.txt file-encoding: euc - + # 反応する発言を表すマスクを指定します。 request: ゐみくじ - + # メッセージの登録数を返答するキーワードを指定します。 count-query: ゐみくじ登録数 - + # メッセージの登録数を返答するときの反応を指定します。 # formatで指定できるものと同じです。#(count)は登録数になります。 count-format: ゐみくじは#(count)件登録されています。 - + # ランダムなメッセージを発言する際のフォーマットを指定します。 # エイリアス置換が有効です。#(message)、#(nick.now)、#(channel)は # それぞれメッセージ内容、相手のnick、チャンネル名に置換されます。 # 何も登録されていないときのために、#(message|;無登録)のように指定すると良いでしょう。 format: #(name|nick.now)の運命は#(message) - + # 反応する人のマスク。 mask: * *!*@* # plum: mask: *!*@* - + # メッセージが追加されたときの反応を指定します。 # formatで指定できるものと同じです。#(message)は追加されたメッセージになります。 added-format: #(name|nick.now): ゐみくじ #(message) を追加しました。 - + # メッセージが削除されたときの反応を指定します。 # formatで指定できるものと同じです。#(message)は削除されたメッセージになります。 removed-format: #(name|nick.now): ゐみくじ #(message) を削除しました。 - + # 発言に反応する確率を指定します。百分率です。省略された場合は100と見做されます。 rate: 100 - + # メッセージを追加するキーワードを指定します。 # ここで指定したキーワードを発言すると、新しいメッセージを追加します。 # 実際の追加方法は「 <追加するメッセージ>」です。 add: ゐみくじ追加 - + # メッセージを削除するキーワードを指定します。 # 実際の削除方法は「 <削除するキーワード>」です。 remove: ゐみくじ削除 - + # addとremoveを許可する人。省略された場合は誰も変更できません。 modifier: * *!*@* # plum: modifier: *!*@* @@ -610,62 +622,62 @@ # 特定の発言に反応して発言をします。 # Auto::Aliasを有効にしていれば、エイリアス置換を行ないます。 - + # 使用するブロックの定義。 blocks: std - + std { # データファイルと文字コードを指定します。 # ファイルの中では一行に一つの"反応:メッセージ"を書いて下さい。 file: reply.txt file-encoding: euc - + # 反応チェックを行うキーワードを指定します。 # 実際の指定方法は、「 <チェックしたい発言>」です。 request: 反応チェック - + # request に反応するときのフォーマットを指定します。 # #(key) がキーワード、 #(message) が発言に置換されます。 reply-format: 「#(key)」という発言に「#(message)」と反応します。 - + # request に反応する最大個数を指定します。 # あまり大きな値を指定すると、アタックが可能になったり、ログが流れて邪魔なので注意してください。 max-reply: 5 - + # メッセージの登録数を返答するキーワードを指定します。 count-query: 反応登録数 - + # メッセージの登録数を返答するときの反応を指定します。 # formatで指定できるものと同じです。#(count)は登録数になります。 count-format: 反応は#(count)件登録されています。 - + # 反応する人のマスク。 mask: * *!*@* # plum: mask: *!*@* - + # 反応が追加されたときの反応を指定します。 # formatで指定できるものと同じです。#(message)は追加されたメッセージになります。 added-format: #(name|nick.now): #(key) に対する反応 #(message) を追加しました。 - + # メッセージが削除されたときの反応を指定します。 # formatで指定できるものと同じです。#(message)は削除されたメッセージになります。 removed-format: #(name|nick.now): #(key) #(message;に対する反応 %s|;) を #(count) 件削除しました。 - + # 発言に反応する確率を指定します。百分率です。省略された場合は100と見做されます。 rate: 100 - + # メッセージを追加するキーワードを指定します。 # ここで指定したキーワードを発言すると、新しいメッセージを追加します。 # 実際の追加方法は「 <追加するメッセージ>」です。 add: 反応追加 - + # メッセージを削除するキーワードを指定します。 # 実際の削除方法は「 <削除するキーワード>」です。 remove: 反応削除 - + # addとremoveを許可する人。省略された場合は「* *!*@*」と見做します。 modifier: * *!*@* - + # 正規表現拡張を許可するか。省略された場合は許可します。 use-re: 1 } @@ -675,7 +687,7 @@ # データファイルの指定にしたがって反応する。 # 大量の反応データを定義するのに向いています。 - + # データファイルのフォーマット # | pattern: re:^(こん(に)?ちは) # | rate: 90 @@ -690,13 +702,13 @@ # patternは一行しか書けません。(手抜き # maskもrateも省略できます。省略した場合はmaskは全員、rateは100となります。 # responseは複数書いておけばランダムに選択されます。 - + # データファイル file: response.txt - + # 文字コード charset: euc - + # 使用を許可する人&チャンネルのマスク。 mask: * *!*@* # plum: mask: +*!*@* @@ -728,7 +740,7 @@ # CTCP::Versionのintervalと同じ。 interval: 3 - + # USERINFOとして返すメッセージ。 message: テスト } @@ -751,16 +763,16 @@ # 特定のチャンネルの発言を、一時的に受信するのをやめる。 # ログを取っているなら、ログには記録される。 - + # チャンネルの凍結に用いるコマンド名。 # 省略時は freeze であり、/freeze #channel@network のように使う。 # チャンネル名を省略すると、現在フリーズされているチャンネルのリストを表示する。 freeze-command: freeze - + # 凍結解除に用いるコマンド名。 # 省略時は defrost であり、/defrost #channel@network のように使う。 defrost-command: defrost - + # 凍結しているチャンネルが存在する時、一定時間毎にその旨を報告する事も可能。 # この機能は凍結した事を忘れないようにする為にある。 # 単位は分、デフォルトはゼロ(報告しない)。 @@ -788,7 +800,7 @@ # 許可するユーザ/チャンネルのマスク。 mask: * *!*@* # plum: *!*@* - + # 招待されたチャンネルに流すメッセージのフォーマット。 #message: こんばんわ〜。 } @@ -807,7 +819,7 @@ # チャンネルのモードをTiarraが把握しておく必要があります。 # 自動的にモードを取得するクライアントであれば必要ありませんが、 # そうでなければこのモジュールを使うべきです。 - + # 設定項目は無し。 } @@ -816,11 +828,11 @@ # splitからの復帰などで+o対象の人が一度に大量に入って来ても+oは少しずつ実行します。 # Excess Floodにはならない筈ですが、本格的な防衛BOTに使える程の物ではありません。 - + # 対象の人間がjoinしてから実際に+oするまで何秒待つか。 # 省略されたら待ちません。 wait: 0 - + # チャンネルと人間のマスクを定義。Auto::Operと同様。 #mask: * example!~example@*.example.ne.jp } @@ -842,7 +854,7 @@ # +チャンネルや+aされているチャンネル以外でチャンネルオペレータ権限を持たずに # 一人きりになった時、そのチャンネルの@を復活させるために自動的にjoinし直すモジュール。 # トピック、モード、banリスト等のあらゆるチャンネル属性をも保存します。 - + # +b,+I,+eリストの復旧を行なうかどうか。 # あまりに長いリストを取得するとMax Send-Q Exceedで落とされるかも知れません。 save-lists: 1 @@ -854,10 +866,10 @@ # キャッシュを使用しても、使われるのは接続後最初の一度だけです。 # 二度目からは通常通りにサーバに問い合わせます。 # また、クライアントオプションの no-cache を指定すれば動きません。 - + # mode キャッシュを使用するか use-mode-cache: 1 - + # who キャッシュを使用するか use-who-cache: 1 } @@ -868,7 +880,7 @@ # 該当クライアントのオプション client-type に cotton や unknown と指定するか、 # Client::GetVersion を利用してクライアントのバージョンを取得するように # してください。 - + # part shield (rejoin 時に自動で行われる part の無視)を使用するか use-part-shield: 1 } @@ -889,27 +901,50 @@ # (開発者向け情報: 取得した情報は remark の client-version に設定されます。) } +- Client::Rehash { + # 全チャンネル分の names の内部キャッシュをクライアントに送信する。 + + # もともとはクライアントの再初期化目的に作ったのですが、 names を送信しても + # 更新されないクライアントが多いので、主に multi-server-mode な Tiarra の + # 下にさらに Tiarra をつないでいる人向けにします。 + + # names でニックリストを更新してくれるクライアント: + # Tiarra + # してくれないクライアント: (括弧内は確認したバージョンまたは注釈) + # LimeChat(1.18) + + # nick rehash に使うコマンドを指定します。 + # 第二パラメータとして現在クライアントが認識している nick を指定してください。 + command-nick: rehash-nick + + # names rehash に使うコマンドを指定します。 + command-names: rehash-names + + # チャンネルとチャンネルの間のウェイトを指定します。 + interval: 2 +} + - Debug::RawLog { # 標準出力にクライアントやサーバとの通信をダンプする。 # 0 または省略で表示しない。 1 で表示する。 # クライアントオプションの logname によって、ダンプに使う名前を指定できます。 - + # サーバからの入力 enable-server-in: 1 - + # サーバへの出力 enable-server-out: 1 - + # クライアントからの入力 enable-client-in: 0 - + # クライアントへの出力 enable-client-out: 0 - + # PING/PONG を無視する ignore-ping: 1 - + # NumericReply の名前を解決して表示する(ちゃんとした dump では無くなります) resolve-numeric: 1 } @@ -925,44 +960,52 @@ # %H : 時間(2桁) # %M : 分(2桁) # %S : 秒(2桁) - + # ログを保存するディレクトリ。Tiarraが起動した位置からの相対パス。~指定は使えない。 directory: log - + # ログファイルの文字コード。省略されたらjis。 charset: sjis - + # 各行のヘッダのフォーマット。省略されたら'%H:%M'。 header: %H:%M:%S - + # ファイル名のフォーマット。省略されたら'%Y.%m.%d.txt' filename: %Y.%m.%d.txt - + # ログファイルのモード(8進数)。省略されたら600 mode: 600 - + # ログディレクトリのモード(8進数)。省略されたら700 dir-mode: 700 - + # ログを取るコマンドを表すマスク。省略されたら記録出来るだけのコマンドを記録する。 command: privmsg,join,part,kick,invite,mode,nick,quit,kill,topic,notice - + # PRIVMSGとNOTICEを記録する際に、自分の発言と他人の発言でフォーマットを変えるかどうか。1/0。デフォルトで1。 distinguish-myself: 1 - + # 各ログファイルを開きっぱなしにするかどうか。 # このオプションは多くの場合、ディスクアクセスを抑えて効率良くログを保存しますが # ログを記録すべき全てのファイルを開いたままにするので、50や100のチャンネルを # 別々のファイルにログを取るような場合には使うべきではありません。 + # 万一 fd があふれた場合、クライアントから(またはサーバへ)接続できない・ + # 新たなモジュールをロードできない・ログが全然できないなどの症状が起こる可能性が + # あります。limit の詳細については OS 等のドキュメントを参照してください。 #keep-file-open: 1 - + + # keep-file-open 時に各行ごとに flush するかどうか。 + # open/close の負荷は気になるが、ログは失いたくない人向け。 + # keep-file-open が有効でないなら無視され(1になり)ます。 + #always-flush: 0 + # keep-file-openを有効にした場合、発言の度にログファイルに追記するのではなく # 一定の分量が溜まってから書き込まれる。そのため、ファイルを開いても # 最近の発言はまだ書き込まれていない可能性がある。 # syncを設定すると、即座にログをディスクに書き込むためのコマンドが追加される。 # 省略された場合はコマンドを追加しない。 sync: sync - + # 各チャンネルの設定。チャンネル名の部分はマスクである。 # 個人宛てに送られたPRIVMSGやNOTICEはチャンネル名"priv"として検索される。 # 記述された順序で検索されるので、全てのチャンネルにマッチする"*"などは最後に書かなければならない。 @@ -983,20 +1026,32 @@ # クライアントを接続した時に、保存しておいた最近のメッセージを送る。 # クライアントオプションの no-recent-logs が指定されていれば送信しません。 - + # 各行のヘッダのフォーマット。省略されたら'%H:%M'。 header: %H:%M:%S - + # ログをチャンネル毎に何行まで保存するか。省略されたら10。 line: 15 - + # PRIVMSGとNOTICEを記録する際に、自分の発言と他人の発言でフォーマットを変えるかどうか。1/0。デフォルトで1。 distinguish-myself: 1 - + # どのメッセージを保存するか。省略されたら保存可能な全てのメッセージを保存する。 command: privmsg,notice,topic,join,part,quit,kill } ++ System::Error { + # サーバーからのERRORメッセージをNOTICEに埋め込む + + # これをoffにするとクライアントにERRORメッセージがそのまま送られます。 + # クライアントとの間ではERRORメッセージは主に切断警告に使われており、 + # そのまま流してしまうとクライアントが混乱する可能性があります。 + # 設定項目はありません。 + + # このモジュールを回避してERRORメッセージをクライアントに送りたい場合は、 + # remarkのsend-error-as-is-to-clientを指定してください。 +} + - System::Macro { # 新規にコマンドを追加し、そのコマンドが使われた時に特定の動作をまとめて実行します。 @@ -1015,12 +1070,20 @@ # クリックすると表示非表示を切り替えることができ、右クリックすると # Reload と Exit ができるコンテキストメニューを表示します。 # 多少反応が鈍いかもしれませんがちょっと待てば出てくると思います。 - + # Win32::GUI を必要とします。 # コンテキストメニューは表示している間処理をブロックしています。 - + # Win32 イベントループを処理する最大間隔を指定します。 #interval: 2 + + # 通知領域に表示するアイコンを指定します。 + # Win32::GUI の制限でちゃんとしたアイコンファイルしか指定できません。 + iconfile: guiperl.ico + + # モジュールが読み込まれたときにコンソールウィンドウを隠すかどうかを + # 指定します。 + hide-console-on-load: 1 } + System::Pong { @@ -1044,7 +1107,7 @@ # マスクで指定したサーバーにIRCメッセージを加工せずに直接送る。 # 例えばQUITを送る事で一時的な切断が可能。 - + # この機能を利用するためのコマンド名。デフォルトは「raw」。 # 「/raw ircnet quit」のようにして使う。 # 一つ目のパラメータは送り先のネットワーク名。ワイルドカード使用可能。 @@ -1061,7 +1124,7 @@ # この時コマンドはTiarraが握り潰すので、IRCプロトコル上で定義された # コマンド名を設定すべきではありません。 command: load - + # confファイルをリロードしたときに通知します。 # モジュールの設定が変更されていた場合は、ここでの設定にかかわらず、 # モジュールごとに表示されます。1または省略された場合は通知します。 @@ -1073,7 +1136,7 @@ # 実行を許可する人間を表すマスク。 #mask: *!*example@example.net - + # 構文: + # は反応するbotのnickを表すマスク。 # はサーバーに向けて発行するIRCメッセージ。 @@ -1089,14 +1152,15 @@ # クライアントから特定のコマンドが実行された時や、 # 誰かから個人的に(privで)特定の発言が送られた時に # Tiarra を終了させます。 - + # 追加するコマンド。省略された場合はコマンドでのシャットダウンは無効になります。 #command: shutdown - + # Tiarraをシャットダウンさせるprivの発言。 # 省略された場合はprivでのシャットダウンは無効になります。 + # パラメータとして shutdown メッセージを指定できます。 #message: shutdown - + # privでのシャットダウンを許可する人。 # 省略された場合はprivでのシャットダウンは無効になります。 # 複数のマスクを指定した場合は、一つでもマッチするものがあればシャットダウンします。 @@ -1115,7 +1179,7 @@ # ニックネームを変更したときに、そのニックネームに対応するAWAYが # 設定されていれば、そのAWAYを設定します。そうでなければAWAYを取り消します。 - + # 書式: <設定するAWAYメッセージ> # # nickをhoge_zzzに変更すると、「寝ている」というAWAYを設定する。 @@ -1141,7 +1205,7 @@ # 対象となるコマンドのマスク。省略時には"privmsg,notice"が設定されている。 # ただしprivmsgとnotice以外を破棄してしまうと、(Tiarraは平気でも)クライアントが混乱する。 command: privmsg,notice - + # maskは複数定義可能。定義された順番でマッチングが行なわれます。 mask: example!*@*.example.net } @@ -1170,26 +1234,26 @@ # 対象となった人物の発行したJOIN、PART、INVITE、QUIT、NICKは消去され、NAMESの返すネームリストからも消える。 # また、対象となった人物のNJOINも消去される。 - + # Vanish対象が発行したMODEを消去するかどうか。デフォルトで0。 # 消去するとは云え、本当にMODEそのものを消してしまうのではなく、 # そのユーザーの代わりに"HIDDEN!HIDDEN@HIDDEN.BY.USER.VANISH"がMODEを実行した事にする。 drop-mode-by-target: 1 - + # Vanish対象を対象とするMODE +o/-o/+v/-vを消去するかどうか。デフォルトで1。 drop-mode-switch-for-target: 1 - + # Vanish対象が発行したKICKを消去するかどうか。デフォルトで0。 # 本当に消すのではなく、"HIDDEN!HIDDEN@HIDDEN.BY.USER.VANISH"がKICKを実行した事にする。 drop-kick-by-target: 1 - + # Vanish対象を対象とするKICKを消去するかどうか。デフォルトで0。 drop-kick-for-target: 0 - + # Vanish対象が発行したTOPICを消去するかどうか。デフォルトで0。 # 本当に消すのでは無いが、他の設定と同じ。 drop-topic-by-target: 1 - + # チャンネルとVanish対象の定義。 # 特定のチャンネルでのみ対象とする、といった事が可能。 # また、privの場合は「#___priv___@ネットワーク名」という文字列をチャンネル名の代わりとしてマッチングを行なう。 diff -urN tiarra-20040729/tiarra tiarra-20040822/tiarra --- tiarra-20040729/tiarra 2004-08-04 07:24:47 +0900 +++ tiarra-20040822/tiarra 2005-01-01 05:28:51 +0900 @@ -5,7 +5,7 @@ # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # ----------------------------------------------------------------------------- -# $Id: tiarra,v 1.36 2004/04/01 03:18:29 admin Exp $ +# $Id: tiarra,v 1.37 2004/08/22 11:28:42 topia Exp $ # ----------------------------------------------------------------------------- require 5.006; use strict; @@ -35,6 +35,7 @@ my $conf_file = ''; my $quiet = 0; my $no_fork = 0; +my $terminated = 0; # version はバージョン番号 @@ -232,8 +233,6 @@ RunLoop::shared_loop->run; }; if ($@) { die "Tiarra aborted: $@\n"; - } else { - print "Tiarra stopped.\n"; } }; @@ -323,8 +322,10 @@ } sub handle_exit { - print "Signal received.\n"; - &shutdown; + my $signame = shift; + printmsg('Signal received.'); + &shutdown((defined $signame ? "SIG$signame" : 'Signal'). + ' received; exit'); } sub handle_reload { @@ -334,9 +335,18 @@ } sub shutdown { - print "Shutting down...\n"; - ModuleManager->shared_manager->terminate; - exit; + my $msg = shift; + $msg = 'Shutdown Tiarra '.::version if !defined $msg; + if ($terminated) { + printmsg("Second Terminate Request; Force Exit! [$msg]"); + # force + ModuleManager->shared_manager->terminate; + exit; + } else { + $terminated = 1; + printmsg("Shutting down... [$msg]"); + RunLoop->shared_loop->terminate($msg); + } } our $ipv6_is_enabled;