1# ----------------------------------------------------------------------------- 2# $Id: Server.pm 36720 2010-02-11 18:13:54Z topia $ 3# ----------------------------------------------------------------------------- 4# IrcIO::ServerはIRCサーバーに接続し、IRCメッセージをやり取りするクラスです。 5# このクラスはサーバーからメッセージを受け取ってチャンネル情報や現在のnickなどを保持しますが、 6# 受け取ったメッセージをモジュールに通したり各クライアントに転送したりはしません。 7# それはRunLoopの役目です。 8# ----------------------------------------------------------------------------- 9package IrcIO::Server; 10use strict; 11use warnings; 12use base qw(IrcIO); 13use Carp; 14use ChannelInfo; 15use PersonalInfo; 16use PersonInChannel; 17use UNIVERSAL; 18use Multicast; 19use NumericReply; 20use Tiarra::Utils; 21use Tiarra::Socket::Connect; 22use Tiarra::Resolver; 23utils->define_attr_getter(0, 24 qw(network_name current_nick logged_in), 25 qw(server_hostname isupport config), 26 [qw(host server_host)]); 27utils->define_attr_accessor(0, qw(state finalizing)); 28utils->define_attr_enum_accessor('state', 'eq', 29 qw(connecting finalizing terminating), 30 qw(terminated finalized connected), 31 qw(reconnecting)); 32 33 34sub out_encoding { shift->config_local_or_general('out-encoding', 'server-') } 35sub in_encoding { shift->config_local_or_general('in-encoding', 'server-') } 36 37sub new { 38 my ($class,$runloop,$network_name) = @_; 39 my $this = $class->SUPER::new( 40 $runloop, 41 name => "network/$network_name"); 42 $this->{network_name} = $network_name; 43 $this->{current_nick} = ''; # 現在使用中のnick。ログインしていなければ空。 44 $this->{server_hostname} = ''; # サーバが主張している hostname。こちらもログインしてなければ空。 45 46 $this->{logged_in} = 0; # このサーバーへのログインに成功しているかどうか。 47 $this->{new_connection} = 1; 48 49 $this->{receiving_namreply} = {}; # RPL_NAMREPLYを受け取ると<チャンネル名,1>になり、RPL_ENDOFNAMESを受け取るとそのチャンネルの要素が消える。 50 $this->{receiving_banlist} = {}; # 同上。RPL_BANLIST 51 $this->{receiving_exceptlist} = {}; # 同上。RPL_EXCEPTLIST 52 $this->{receiving_invitelist} = {}; # 同上、RPL_INVITELIST 53 54 $this->{channels} = {}; # 小文字チャンネル名 => ChannelInfo 55 $this->{people} = {}; # nick => PersonalInfo 56 $this->{isupport} = {}; # isupport 57 58 $this->{connecting} = undef; 59 $this->{finalizing} = undef; 60 $this->state('initializing'); 61 62 $this->reconnect; 63} 64 65sub connecting { defined shift->{connecting}; } 66 67sub _connect_interrupted { 68 my $this = shift; 69 $this->state_terminating || $this->state_finalizing || 70 $this->state_terminated || $this->state_finalized; 71} 72 73sub _gen_msg { 74 my ($this, $msg) = @_; 75 76 $this->name.': '.$msg; 77} 78 79sub die { 80 my ($this, $msg) = @_; 81 CORE::die($this->_gen_msg($msg)); 82} 83 84sub warn { 85 my ($this, $msg) = @_; 86 CORE::warn($this->_gen_msg($msg)); 87} 88 89sub printmsg { 90 my ($this, $msg) = @_; 91 92# if (defined $this->{last_msg} && 93# $this->{last_msg}->[0] eq $msg && 94# $this->{last_msg}->[1] <= (time - 10)) { 95# # repeated 96# return 97# } 98# $this->{last_msg} = [$msg, time]; 99 ::printmsg($this->_gen_msg($msg)); 100} 101 102sub nick_p { 103 my ($this, $nick) = @_; 104 105 Multicast::nick_p($nick, $this->isupport->{NICKLEN}); 106} 107 108sub channel_p { 109 my ($this, $name) = @_; 110 111 Multicast::channel_p($name, $this->isupport->{CHANTYPES}); 112} 113 114sub channels { 115 # {小文字チャンネル名 => ChannelInfo}のハッシュリファを返す。 116 # @options(省略可能): 117 # 'even-if-kicked-out': 既に自分が蹴り出されてゐるチャンネルも返す。この動作は高速である。 118 my ($this, @options) = @_; 119 if (defined $options[0] && $options[0] eq 'even-if-kicked-out') { 120 $this->{channels}; 121 } 122 else { 123 # kicked-outフラグが立つてゐないチャンネルのみ返す。 124 my %result; 125 while (my ($name, $ch) = each %{$this->{channels}}) { 126 if (!$ch->remark('kicked-out')) { 127 $result{$name} = $ch; 128 } 129 } 130 \%result; 131 } 132} 133 134sub channels_list { 135 # @options(省略可能): 136 # 'even-if-kicked-out': 既に自分が蹴り出されてゐるチャンネルも返す。この動作は高速である。 137 my ($this, @options) = @_; 138 if (defined $options[0] && $options[0] eq 'even-if-kicked-out') { 139 values %{$this->{channels}}; 140 } 141 else { 142 # kicked-outフラグが立つてゐないチャンネルのみ返す。 143 grep { 144 !$_->remarks('kicked-out'); 145 } values %{$this->{channels}}; 146 } 147} 148 149sub person_list { 150 values %{shift->{people}}; 151} 152 153sub fullname { 154 $_[0]->{current_nick}.'!'.$_[0]->{user_shortname}.'@'.$_[0]->{server_host}; 155} 156 157sub config_local_or_general { 158 my ($this, $base, $general_prefix, $local_prefix, $default) = @_; 159 160 foreach ([$this->config, $local_prefix], 161 [$this->_conf_general, $general_prefix]) { 162 my ($conf, $prefix) = @$_; 163 $prefix = '' unless defined $prefix; 164 my $value = $conf->get("$prefix$base"); 165 if (defined $value) { 166 return $value; 167 } 168 } 169 return $default; 170} 171 172sub reload_config { 173 my $this = shift; 174 my $conf = $this->{config} = $this->_conf->get($this->{network_name}); 175 my @servers = $conf->server('all'); 176 if (!@servers) { 177 @servers = ([$conf->host, $conf->port]); 178 } else { 179 @servers = map {[split(/\s+/, $_)]} @servers; 180 } 181 $this->{server_hosts} = [ 182 map { +{ 183 host => shift(@$_), 184 port => $_, 185 } } @servers, 186 ]; 187 $this->{server_password} = $conf->password; 188 $this->{initial_nick} = $this->config_local_or_general('nick'); # ログイン時に設定するnick。 189 $this->{user_shortname} = $this->config_local_or_general('user'); 190 $this->{user_realname} = $this->config_local_or_general('name'); 191 #$this->{prefer_socket_types} = [qw(ipv6 ipv4)]; 192} 193 194sub destination { 195 my $this = shift; 196 Tiarra::Socket->repr_destination( 197 host => $this->{server_host}, 198 addr => $this->{server_addr}, 199 port => $this->{server_port}, 200 type => $this->{proto}); 201} 202 203sub person_if_exists { 204 my ($this, $nick) = @_; 205 $this->{people}{$nick}; 206} 207 208sub person { 209 # nick以外は全て省略可能。 210 # 未知のnickが指定された場合は新規に追加する。 211 my ($this,$nick,$username,$userhost,$realname,$server) = @_; 212 return if !defined $nick; 213 214 my $info = $this->{people}->{$nick}; 215 if (!defined($info)) { 216 $info = $this->{people}->{$nick} = 217 new PersonalInfo(Nick => $nick, 218 UserName => $username, 219 UserHost => $userhost, 220 RealName => $realname, 221 Server => $server); 222 } 223 else { 224 $info->username($username); 225 $info->userhost($userhost); 226 $info->realname($realname); 227 $info->server($server); 228 } 229 $info; 230} 231 232sub channel { 233 my $this = $_[0]; 234 my $channel_name = Multicast::lc($_[1]); 235 $this->{channels}->{$channel_name}; 236} 237 238sub _queue_retry { 239 my $this = shift; 240 241 $this->state_reconnecting(1); 242 243 $this->_cleanup if defined $this->{timer}; 244 $this->{connecting} = undef; 245 $this->{timer} = Timer->new( 246 Name => $this->_gen_msg('retry timer'), 247 After => 15, 248 Code => sub { 249 $this->{timer} = undef; 250 return if $this->finalizing; 251 $this->reconnect; 252 })->install; 253} 254 255sub reconnect { 256 my $this = shift; 257 $this->reload_config; 258 $this->connect; 259} 260 261# connect --(resolve)--> _connect_try_next --> 262 263sub connect { 264 my $this = shift; 265 #return if $this->connected; 266 croak 'connected!' if $this->connected; 267 croak 'connecting!' if $this->connecting; 268 $this->finalizing(undef); 269 270 # 初期化すべきフィールドを初期化 271 $this->{server_host} = undef; 272 $this->{server_port} = undef; 273 $this->{nick_retry} = 0; 274 $this->{logged_in} = undef; 275 $this->state_connecting(1); 276 277 $this->{server_queue} = $this->{server_hosts}; 278 279 $this->_connect_try_next; 280 $this; 281} 282 283 284sub _connect_try_next { 285 my $this = shift; 286 287 return if $this->finalizing; 288 my $trying = 289 $this->{connecting} = shift @{$this->{server_queue}}; 290 if (defined $trying) { 291 292 $this->{connector} = Tiarra::Socket::Connect->new( 293 host => $this->{connecting}->{host}, 294 port => $this->{connecting}->{port}, 295 callback => sub { 296 my ($subject, $socket, $obj, $errno) = @_; 297 298 if ($subject eq 'sock') { 299 $this->attach($socket); 300 } elsif ($subject eq 'error') { 301 $this->_connect_error($obj); 302 } elsif ($subject eq 'warn') { 303 $this->_connect_warn($obj); 304 } elsif ($subject eq 'progress') { 305 $this->_connect_warn($obj); 306 } 307 }, 308 hooks => { 309 before_connect => sub { 310 $this->_hook_before_connect(@_); 311 }, 312 }, 313 ); 314 315 } else { 316 $this->printmsg("Couldn't connect to any host"); 317 $this->_queue_retry; 318 return; 319 } 320} 321 322sub _hook_before_connect { 323 my ($this, $stage, $connecting) = @_; 324 325 my $type = $connecting->{type}; 326 my $bind_addr; 327 if ($type eq 'ipv4') { 328 # 下は過去互換性の為に残す。 329 $bind_addr = $this->config_local_or_general('ipv4-bind-addr') || 330 $this->config_local_or_general('bind-addr'); 331 } elsif ($type eq 'ipv6') { 332 $bind_addr = $this->config_local_or_general('ipv6-bind-addr'); 333 } 334 if (defined $bind_addr) { 335 $connecting->{bind_addr} = $bind_addr; 336 } 337} 338 339sub attach { 340 my ($this, $connector) = @_; 341 342 $this->SUPER::attach($connector->sock); 343 $this->{connecting} = undef; 344 $this->{server_host} = $connector->host; 345 $this->{server_addr} = $connector->current_addr; 346 $this->{server_port} = $connector->current_port; 347 $this->{proto} = $connector->current_type; 348 $this->state_connected(1); 349 350 $this->_send_connection_messages; 351 352 $this->{connector} = undef; 353 $this->printmsg("Opened connection to ". $this->destination ."."); 354 $this->install; 355 $this; 356} 357 358sub _connect_error { 359 my ($this, $msg) = @_; 360 361 $this->printmsg("$msg"); 362 $this->_connect_try_next; 363} 364 365sub _connect_warn { 366 my ($this, $msg) = @_; 367 368 $this->printmsg("$msg"); 369} 370 371sub _send_connection_messages { 372 my $this = shift; 373 # (PASS) -> NICK -> USERの順に送信し、中に入る。 374 # NICKが成功したかどうかは接続後のreceiveメソッドが判断する。 375 my $server_password = $this->{server_password}; 376 if (defined $server_password && $server_password ne '') { 377 $this->send_message($this->construct_irc_message( 378 Command => 'PASS', 379 Param => $this->{server_password})); 380 } 381 if (!defined $this->{current_nick} || $this->{current_nick} eq '') { 382 $this->{current_nick} = $this->{initial_nick}; 383 } 384 $this->send_message($this->construct_irc_message( 385 Command => 'NICK', 386 Param => $this->{current_nick})); 387 388 # +iなどの文字列からユーザーモード値を算出する。 389 my $usermode = 0; 390 if (my $usermode_str = $this->_conf_general->user_mode) { 391 if ($usermode_str =~ /^\+/) { 392 foreach my $c (split //,substr($usermode_str,1)) { 393 if ($c eq 'w') { 394 $usermode |= (1 << 2); 395 } 396 elsif ($c eq 'i') { 397 $usermode |= (1 << 3); 398 } 399 } 400 } 401 } 402 $this->send_message($this->construct_irc_message( 403 Command => 'USER', 404 Params => [$this->{user_shortname}, 405 $usermode, 406 '*', 407 $this->{user_realname}])); 408} 409 410sub terminate { 411 my ($this, $msg) = @_; 412 413 $this->_interrupt($msg, 'terminating'); 414} 415 416sub finalize { 417 my ($this, $msg) = @_; 418 419 $this->_interrupt($msg, 'finalizing'); 420 $this->finalizing(1); 421} 422 423sub _interrupt { 424 my ($this, $msg, $state) = @_; 425 426 if ($this->logged_in) { 427 $this->state($state); 428 $this->quit($msg); 429 } elsif ($this->state_connecting || $this->state_reconnecting) { 430 $this->state($state); 431 $this->_cleanup; 432 } else { 433 if (!$this->state_connected) { 434 $this->warn('_interrupt/unexpected state: '.$this->state) 435 if &::debug_mode; 436 } 437 $this->state($state); 438 $this->disconnect; 439 } 440} 441 442sub disconnect { 443 my ($this, $genre, $errno, @params) = @_; 444 445 $this->_cleanup; 446 $this->SUPER::disconnect($genre, $errno, @params); 447 if (defined $errno) { 448 $this->printmsg($this->sock_errno_to_msg( 449 $errno, 450 "Disconnected from ".$this->destination.": $genre error")); 451 } else { 452 $this->printmsg("Disconnected from ".$this->destination."."); 453 } 454 if ($this->state_reconnecting || $this->state_connected) { 455 $this->state_reconnecting(1); 456 $this->reload_config; 457 $this->_queue_retry; 458 } 459 $this->{logged_in} = undef; 460} 461 462sub _cleanup { 463 my ($this, $mode) = @_; 464 465 $this->{connecting} = undef; 466 if (defined $this->{connector}) { 467 $this->{connector}->interrupt; 468 $this->{connector} = undef; 469 } 470 if (defined $this->{timer}) { 471 $this->{timer}->uninstall; 472 $this->{timer} = undef; 473 } 474 if (defined $this->{rejoin_timer}) { 475 $this->{rejoin_timer}->uninstall; 476 $this->{rejoin_timer} = undef; 477 } 478 if ($this->state_terminating) { 479 $this->state_terminated(1); 480 } elsif ($this->state_finalizing) { 481 $this->state_finalized(1); 482 } 483 # remove pong drop counter 484 $this->remark('pong-drop-counter', undef, 'delete'); 485} 486 487sub quit { 488 my ($this, $msg) = @_; 489 return $this->send_message( 490 $this->construct_irc_message( 491 Command => 'QUIT', 492 Param => $msg)); 493} 494 495sub send_message { 496 my ($this,$msg) = @_; 497 498 if (!defined $msg) { 499 croak "IrcIO::Server->send_message, Arg[1] was undef.\n"; 500 } 501 elsif (!ref($msg)) { 502 croak "IrcIO::Server->send_message, Arg[1] was not ref.\n"; 503 } 504 elsif (!UNIVERSAL::isa($msg, $this->irc_message_class)) { 505 croak "IrcIO::Server->send_message, Arg[1] was bad ref: ".ref($msg)."\n"; 506 } 507 508 # 各モジュールへ通知 509 #$this->_runloop->notify_modules('notification_of_message_io',$msg,$this,'out'); 510 511 $this->SUPER::send_message( 512 $msg, 513 $this->out_encoding); 514} 515 516sub read { 517 my $this = shift; 518 $this->SUPER::read($this->in_encoding); 519 520 # 接続が切れたら、各モジュールとRunLoopへ通知 521 if (!$this->connected) { 522 $this->_runloop->notify_modules('disconnected_from_server',$this); 523 $this->_runloop->disconnected_server($this); 524 } 525} 526 527sub pop_queue { 528 my ($this) = shift; 529 my $msg = $this->SUPER::pop_queue; 530 531 # このメソッドはログインしていなければログインするが、 532 # パスワードが違うなどで何度やり直してもログイン出来る見込みが無ければ 533 # 接続を切ってからdieします。 534 if (defined $msg) { 535 # ログイン作業中か？ 536 if ($this->logged_in) { 537 # ログイン作業中でない。 538 return $this->_receive_after_logged_in($msg); 539 } 540 else { 541 return $this->_receive_while_logging_in($msg); 542 } 543 } 544 return $msg; 545} 546 547sub _receive_while_logging_in { 548 my ($this,$first_msg) = @_; 549 550 # まだログイン作業中であるのなら、ログインに成功したかどうかを 551 # 最初に受け取った行が001(成功)か433(nick重複)かそれ以外かで判断する。 552 my $reply = $first_msg->command; 553 if ($reply eq RPL_WELCOME) { 554 # 成功した。 555 $this->{current_nick} = $first_msg->param(0); 556 $this->{server_hostname} = $first_msg->prefix; 557 if (!$this->_runloop->multi_server_mode_p && 558 $this->_runloop->current_nick ne $this->{current_nick}) { 559 $this->_runloop->broadcast_to_clients( 560 $this->construct_irc_message( 561 Command => 'NICK', 562 Param => $first_msg->param(0), 563 Remarks => {'fill-prefix-when-sending-to-client' => 1 564 })); 565 566 $this->_runloop->set_current_nick($first_msg->param(0)); 567 } 568 $this->{logged_in} = 1; 569 $this->person($this->{current_nick}, 570 $this->{user_shortname}, 571 $this->{user_realname}); 572 573 574 $this->printmsg("Logged-in successfuly into ".$this->destination."."); 575 576 # 各モジュールにサーバー追加の通知を行なう。 577 $this->_runloop->notify_modules('connected_to_server',$this,$this->{new_connection}); 578 # 再接続だった場合の処理 579 if (!$this->{new_connection}) { 580 $this->_runloop->reconnected_server($this); 581 } 582 $this->{new_connection} = undef; 583 return; 584 } 585 elsif ($reply eq ERR_NICKNAMEINUSE) { 586 # nick重複。 587 $this->_set_to_next_nick($first_msg->param(1)); 588 return; # 何も返さない→クライアントにはこの結果を知らせない。 589 } 590 elsif ($reply eq ERR_UNAVAILRESOURCE) { 591 # nick/channel is temporarily unavailable(この場合は nick) 592 $this->_set_to_next_nick($first_msg->param(1)); 593 return; # 何も返さない→クライアントにはこの結果を知らせない。 594 } 595 elsif ($reply eq RPL_HELLO) { 596 # RPL_HELLO (irc2.11.x) 597 $this->printmsg("Server replied 020(RPL_HELLO). Please wait."); 598 return; # 何も返さない→クライアントにはこの結果を知らせない。 599 } 600 elsif (grep { $_ eq $reply } qw(NOTICE PRIVMSG)) { 601 # NOTICE / PRIVMSG 602 return; # 何もしない 603 } 604 elsif ($reply eq 'PING') { 605 $this->send_message( 606 $this->construct_irc_message( 607 Command => 'PONG', 608 Param => $first_msg->param(0))); 609 } 610 else { 611 # それ以外。手の打ちようがないのでconnectionごと切断してしまう。 612 # 但し、エラーニューメリックリプライでもERRORでもなければ無視する。 613 if ($reply =~ /^[0-3]\d+/) { 614 $this->printmsg("Server replied $reply, ignored.\n".$first_msg->serialize."\n"); 615 return; 616 } elsif ($reply eq 'ERROR' or $reply !~ m/^\d+/) { 617 $this->disconnect; 618 $this->die("Server replied $reply.\n".$first_msg->serialize."\n"); 619 } 620 else { 621 $this->printmsg("Server replied $reply, ignored.\n".$first_msg->serialize."\n"); 622 return; 623 } 624 } 625 return $first_msg; 626} 627 628sub _receive_after_logged_in { 629 my ($this,$msg) = @_; 630 631 $this->person($msg->nick,$msg->name,$msg->host); # nameとhostを覚えておく。 632 633 if (defined $msg->nick && 634 $msg->nick ne $this->current_nick) { 635 $msg->remark('message-send-by-other', 1); 636 } 637 638 if ($msg->command eq 'NICK') { 639 # nickを変えたのが自分なら、それをクライアントには伝えない。 640 my $current_nick = $this->{current_nick}; 641 if ($msg->nick eq $current_nick) { 642 $this->{current_nick} = $msg->param(0); 643 644 if ($this->_runloop->multi_server_mode_p) { 645 # ここで消してしまうとプラグインにすらNICKが行かなくなる。 646 # 消す代わりに"do-not-send-to-clients => 1"という註釈を付ける。 647 $msg->remark('do-not-send-to-clients',1); 648 649 # ローカルnickと違っていれば、その旨を通知する。 650 # 但し、networks/always-notify-new-nickが設定されていれば常に通知する。 651 my $local_nick = $this->_runloop->current_nick; 652 if ($this->_conf_networks->always_notify_new_nick || 653 $this->{current_nick} ne $local_nick) { 654 655 my $old_nick = $msg->nick; 656 $this->_runloop->broadcast_to_clients( 657 $this->construct_irc_message( 658 Prefix => $this->_runloop->sysmsg_prefix(qw(priv nick::system)), 659 Command => 'NOTICE', 660 Params => [$local_nick, 661 "*** Your global nick in ". 662 $this->{network_name}." changed ". 663 "$old_nick -> ". 664 $this->{current_nick}."."])); 665 } 666 } else { 667 $this->_runloop->set_current_nick($msg->param(0)); 668 } 669 } 670 $this->_NICK($msg); 671 } 672 elsif ($msg->command eq ERR_NICKNAMEINUSE) { 673 # nickが既に使用中 674 return $this->_handle_fix_nick($msg); 675 } 676 elsif ($msg->command eq ERR_UNAVAILRESOURCE) { 677 # nick/channel temporary unavaliable 678 if (Multicast::nick_p($msg->param(1))) { 679 return $this->_handle_fix_nick($msg); 680 } 681 } 682 elsif ($msg->command eq 'JOIN') { 683 $this->_JOIN($msg); 684 } 685 elsif ($msg->command eq 'KICK') { 686 $this->_KICK($msg); 687 } 688 elsif ($msg->command eq 'MODE') { 689 $this->_MODE($msg); 690 } 691 elsif ($msg->command eq 'NJOIN') { 692 $this->_NJOIN($msg); 693 } 694 elsif ($msg->command eq 'PART') { 695 $this->_PART($msg); 696 } 697 elsif ($msg->command eq 'QUIT' || $msg->command eq 'KILL') { 698 # QUITとKILLは同じように扱う。 699 $this->_QUIT($msg); 700 } 701 elsif ($msg->command eq 'TOPIC') { 702 $this->_TOPIC($msg); 703 } 704 else { 705 my $name = NumericReply::fetch_name($msg->command); 706 if (defined $name) { 707 foreach ( 708 map("RPL_$_", 709 qw(CHANNELMODEIS NOTOPIC TOPIC TOPICWHOTIME 710 CREATIONTIME WHOREPLY NAMREPLY ENDOFNAMES 711 WHOISUSER WHOISSERVER AWAY ENDOFWHOIS 712 ISUPPORT YOURID), 713 map({("${_}LIST", "ENDOF${_}LIST");} 714 qw(INVITE EXCEPT BAN)), 715 )) { 716 if ($name eq $_) { 717 no strict 'refs'; 718 my $funcname = "_$_"; 719 &$funcname($this, $msg); # $this->$funcname($msg) 720 last; 721 } 722 } 723 } 724 } 725 return $msg; 726} 727 728sub _KICK { 729 my ($this,$msg) = @_; 730 my @ch_names = split(/,/,$msg->param(0)); 731 my @nicks = split(/,/,$msg->param(1)); 732 my $kick = sub { 733 my ($ch,$nick_to_kick) = @_; 734 if ($nick_to_kick eq $this->{current_nick}) { 735 # KICKされたのが自分だった 736 $ch->remarks('kicked-out','1'); 737 } 738 else { 739 $ch->names($nick_to_kick,undef,'delete'); 740 } 741 }; 742 if (@ch_names == @nicks) { 743 # チャンネル名とnickが1対1で対応 744 map { 745 my ($ch_name,$nick) = ($ch_names[$_],$nicks[$_]); 746 my $ch = $this->channel($ch_name); 747 if (defined $ch) { 748 #$ch->names($nick,undef,'delete'); 749 $kick->($ch,$nick); 750 } 751 } 0 .. $#ch_names; 752 } 753 elsif (@ch_names == 1) { 754 # 一つのチャンネルから1人以上をkick 755 my $ch = $this->channel($ch_names[0]); 756 if (defined $ch) { 757 map { 758 #$ch->names($_,undef,'delete'); 759 $kick->($ch,$_); 760 } @nicks; 761 } 762 } 763} 764 765sub _MODE { 766 my ($this,$msg) = @_; 767 if ($msg->param(0) eq $this->{current_nick}) { 768 # MODEの対象が自分なのでここでは無視。 769 return; 770 } 771 772 my $ch = $this->channel($msg->param(0)); 773 if (defined $ch) { 774 my $n_params = @{$msg->params}; 775 776 my $plus = 0; # 現在評価中のモードが+なのか-なのか。 777 my $mode_char_pos = 1; # 現在評価中のmode characterの位置。 778 my $mode_param_offset = 0; # $mode_char_posから幾つの追加パラメタを拾ったか。 779 780 my $fetch_param = sub { 781 $mode_param_offset++; 782 return $msg->param($mode_char_pos + $mode_param_offset); 783 }; 784 785 for (;$mode_char_pos < $n_params;$mode_char_pos += $mode_param_offset + 1) { 786 $mode_param_offset = 0; # これは毎回リセットする。 787 foreach my $c (split //,$msg->param($mode_char_pos)) { 788 my $add_or_delete = ($plus ? 'add' : 'delete'); 789 my $undef_or_delete = ($plus ? undef : 'delete'); 790 if ($c eq '+') { 791 $plus = 1; 792 } 793 elsif ($c eq '-') { 794 $plus = 0; 795 } 796 elsif (index('aimnpqrst',$c) != -1) { 797 $ch->switches($c,1,$undef_or_delete); 798 } 799 elsif ($c eq 'b') { 800 $ch->banlist($add_or_delete,&$fetch_param); 801 } 802 elsif ($c eq 'e') { 803 $ch->exceptionlist($add_or_delete,&$fetch_param); 804 } 805 elsif ($c eq 'I') { 806 $ch->invitelist($add_or_delete,&$fetch_param); 807 } 808 elsif ($c eq 'k') { 809 $ch->parameters('k',&$fetch_param,$undef_or_delete); 810 } 811 elsif ($c eq 'l') { 812 $ch->parameters('l',($plus ? &$fetch_param : undef),$undef_or_delete); 813 } 814 elsif ($c eq 'o' || $c eq 'O') { 815 # oとOは同一視 816 eval { 817 $ch->names(&$fetch_param)->has_o($plus); 818 }; 819 } 820 elsif ($c eq 'v') { 821 eval { 822 $ch->names(&$fetch_param)->has_v($plus); 823 }; 824 } 825 } 826 } 827 } 828} 829 830sub _JOIN { 831 my ($this,$msg) = @_; 832 833 map { 834 m/^([^\x07]+)(?:\x07(.*))?/; 835 my ($ch_name,$mode) = ($1,(defined $2 ? $2 : '')); 836 837 my $ch = $this->channel($ch_name); 838 if (defined $ch) { 839 # 知っているチャンネル。もしkickedフラグが立っていたらクリア。 840 $ch->remarks('kicked-out',undef,'delete'); 841 } 842 else { 843 # 知らないチャンネル。 844 $ch = ChannelInfo->new($ch_name,$this->{network_name}); 845 $this->{channels}{Multicast::lc($ch_name)} = $ch; 846 } 847 $ch->names($msg->nick, 848 new PersonInChannel( 849 $this->person($msg->nick,$msg->name,$msg->host), 850 index($mode,"o") != -1 || index($mode,"O") != -1, # oもOも今は同一視 851 index($mode,"v") != -1)); 852 } split(/,/,$msg->param(0)); 853} 854 855sub _NJOIN { 856 my ($this,$msg) = @_; 857 my $ch_name = $msg->param(0); 858 my $ch = $this->channel($ch_name); 859 unless (defined $ch) { 860 # 知らないチャンネル。 861 $ch = ChannelInfo->new($ch_name,$this->{network_name}); 862 $this->{channels}{Multicast::lc($ch_name)} = $ch; 863 } 864 map { 865 m/^([@+]*)(.+)$/; 866 my ($mode,$nick) = ($1,$2); 867 868 $ch->names($nick, 869 new PersonInChannel( 870 $this->person($nick), 871 index($mode,"@") != -1, # 今は@と@@を同一視。 872 index($mode,"+") != -1)); 873 } split(/,/,$msg->param(1)); 874} 875 876sub _PART { 877 my ($this,$msg) = @_; 878 map { 879 my $ch_name = $_; 880 my $ch = $this->channel($ch_name); 881 if (defined $ch) { 882 if ($msg->nick eq $this->{current_nick}) { 883 # PARTしたのが自分だった 884 delete $this->{channels}->{Multicast::lc($ch_name)}; 885 } 886 else { 887 $ch->names($msg->nick,undef,'delete'); 888 } 889 } 890 } split(/,/,$msg->param(0)); 891 892 # 全チャンネルを走査し、このnickを持つ人物が一人も居なくなつてゐたらpeopleからも消す。 893 my $alive; 894 foreach my $ch (values %{$this->{channels}}) { 895 if (defined $ch->names($msg->nick)) { 896 $alive = 1; 897 } 898 } 899 if (!$alive) { 900 delete $this->{people}{$msg->nick}; 901 } 902} 903 904sub _NICK { 905 my ($this,$msg) = @_; 906 # PersonalInfoとChannelInfoがnickを持っているので書き換える。 907 my ($old,$new) = ($msg->nick,$msg->param(0)); 908 909 if (!defined $this->{people}->{$old}) { 910 return; 911 } 912 913 $this->{people}->{$old}->nick($new); 914 $this->{people}->{$new} = $this->{people}->{$old}; 915 delete $this->{people}->{$old}; 916 917 my @channels = grep { 918 defined $_->names($old); 919 } values %{$this->{channels}}; 920 921 # このNICKが影響を及ぼした全チャンネル名のリストを 922 # "affected-channels"として註釈を付ける。 923 my @affected = map { 924 my $ch = $_; 925 $ch->names($new,$ch->names($old)); 926 $ch->names($old,undef,'delete'); 927 $ch->name; 928 } @channels; 929 $msg->remark('affected-channels',\@affected); 930} 931 932sub _QUIT { 933 my ($this,$msg) = @_; 934 # people及びchannelsから削除する。 935 delete $this->{people}->{$msg->nick}; 936 937 my @channels = grep { 938 defined $_->names($msg->nick); 939 } values %{$this->{channels}}; 940 941 # このNICKが影響を及ぼした全チャンネル名のリストを 942 # "affected-channels"として註釈を付ける。 943 my @affected = map { 944 my $ch = $_; 945 $ch->names($msg->nick,undef,'delete'); 946 $ch->name; 947 } @channels; 948 $msg->remark('affected-channels',\@affected); 949} 950 951sub _TOPIC { 952 my ($this,$msg) = @_; 953 my $ch = $this->channel($msg->param(0)); 954 if (defined $ch) { 955 # 古いトピックを"old-topic"として註釈を付ける。 956 $msg->remark('old-topic', $ch->topic); 957 $ch->topic($msg->param(1)); 958 959 # topic_who と topic_time を指定する 960 $ch->topic_who($msg->prefix); 961 $ch->topic_time(time); 962 } 963} 964 965sub _RPL_NAMREPLY { 966 my ($this,$msg) = @_; 967 my $ch = $this->channel($msg->param(2)); 968 return unless defined $ch; 969 970 my $receiving_namreply = $this->{receiving_namreply}->{$msg->param(2)}; 971 unless (defined $receiving_namreply && 972 $receiving_namreply == 1) { 973 # NAMESを初期化 974 $ch->names(undef,undef,'clear'); 975 # NAMREPLY受信中フラグを立てる 976 $this->{receiving_namreply}->{$msg->param(2)} = 1; 977 } 978 979 if (defined $ch) { 980 # @なら+s,*なら+p、=ならそのどちらでもない事が確定している。 981 my $ch_property = $msg->param(1); 982 if ($ch_property eq '@') { 983 $ch->switches('s',1); 984 $ch->switches('p',undef,'delete'); 985 } 986 elsif ($ch_property eq '*') { 987 $ch->switches('s',undef,'delete'); 988 $ch->switches('p',1); 989 } 990 else { 991 $ch->switches('s',undef,'delete'); 992 $ch->switches('p',undef,'delete'); 993 } 994 995 my @people = map { 996 m/^([@\+]{0,2})(.+)$/; 997 my ($mode,$nick) = ($1,$2); 998 999 $ch->names($nick, 1000 new PersonInChannel( 1001 $this->person($nick), 1002 index($mode,"@") != -1, 1003 index($mode,"+") != -1)); 1004 } split(/ /,$msg->param(3)); 1005 } 1006} 1007 1008sub _RPL_ENDOFNAMES { 1009 my ($this,$msg) = @_; 1010 delete $this->{receiving_namreply}->{$msg->param(1)}; 1011} 1012 1013sub _RPL_WHOISUSER { 1014 my ($this,$msg) = @_; 1015 my $p = $this->{people}->{$msg->param(1)}; 1016 if (defined $p) { 1017 $p->username($msg->param(2)); 1018 $p->userhost($msg->param(3)); 1019 $p->realname($msg->param(5)); 1020 $this->_START_WHOIS_REPLY($p); 1021 } 1022} 1023 1024sub _START_WHOIS_REPLY { 1025 my ($this,$p) = @_; 1026 $p->remark('wait-rpl_away', 1); 1027} 1028 1029sub _RPL_ENDOFWHOIS { 1030 my ($this,$msg) = @_; 1031 my $p = $this->{people}->{$msg->param(1)}; 1032 if (defined $p) { 1033 if ($p->remark('wait-rpl_away')) { 1034 $p->remark('wait-rpl_away', 0); 1035 $p->away(''); 1036 } 1037 } 1038} 1039 1040sub _RPL_AWAY { 1041 my ($this,$msg) = @_; 1042 my $p = $this->{people}->{$msg->param(1)}; 1043 if (defined $p) { 1044 $p->remark('wait-rpl_away', 0); 1045 $p->away($msg->param(2)); 1046 } 1047} 1048 1049sub _RPL_WHOISSERVER { 1050 my ($this,$msg) = @_; 1051 my $p = $this->{people}->{$msg->param(1)}; 1052 if (defined $p) { 1053 $p->server($msg->param(2)); 1054 } 1055} 1056 1057sub _RPL_NOTOPIC { 1058 my ($this,$msg) = @_; 1059 my $ch = $this->channel($msg->param(1)); 1060 if (defined $ch) { 1061 $ch->topic(''); 1062 } 1063} 1064 1065sub _RPL_TOPIC { 1066 my ($this,$msg) = @_; 1067 my $ch = $this->channel($msg->param(1)); 1068 if (defined $ch) { 1069 $ch->topic($msg->param(2)); 1070 } 1071} 1072 1073sub _RPL_TOPICWHOTIME { 1074 my ($this,$msg) = @_; 1075 my $ch = $this->channel($msg->param(1)); 1076 if (defined $ch) { 1077 $ch->topic_who($msg->param(2)); 1078 $ch->topic_time($msg->param(3)); 1079 } 1080} 1081 1082sub _RPL_CREATIONTIME { 1083 my ($this,$msg) = @_; 1084 my $ch = $this->channel($msg->param(1)); 1085 if (defined $ch) { 1086 $ch->remark('creation-time', $msg->param(2)); 1087 } 1088} 1089 1090sub _RPL_INVITELIST { 1091 my ($this,$msg) = @_; 1092 my $ch = $this->channel($msg->param(1)); 1093 1094 my $receiving_invitelist = $this->{receiving_invitelist}->{$msg->param(1)}; 1095 if (defined $receiving_invitelist && 1096 $receiving_invitelist == 1) { 1097 # +Iリストを初期化 1098 $ch->invitelist(undef,undef,'clear'); 1099 # INVITELIST受信中フラグを立てる 1100 $this->{receiving_invitelist}->{$msg->param(1)} = 1; 1101 } 1102 1103 if (defined $ch) { 1104 # 重複防止のため、一旦deleteしてからadd。 1105 $ch->invitelist('delete',$msg->param(2)); 1106 $ch->invitelist('add',$msg->param(2)); 1107 } 1108} 1109 1110sub _RPL_ENDOFINVITELIST { 1111 my ($this,$msg) = @_; 1112 delete $this->{receiving_invitelist}->{$msg->param(1)}; 1113} 1114 1115sub _RPL_EXCEPTLIST { 1116 my ($this,$msg) = @_; 1117 my $ch = $this->channel($msg->param(1)); 1118 1119 my $receiving_exceptlist = $this->{receiving_exceptlist}->{$msg->param(1)}; 1120 if (defined $receiving_exceptlist && 1121 $receiving_exceptlist == 1) { 1122 # +eリストを初期化 1123 $ch->exceptionlist(undef,undef,'clear'); 1124 # EXCEPTLIST受信中フラグを立てる 1125 $this->{receiving_exceptlist}->{$msg->param(1)} = 1; 1126 } 1127 1128 if (defined $ch) { 1129 # 重複防止のため、一旦deleteしてからadd。 1130 $ch->exceptionlist('delete',$msg->param(2)); 1131 $ch->exceptionlist('add',$msg->param(2)); 1132 } 1133} 1134 1135sub _RPL_ENDOFEXCEPTLIST { 1136 my ($this,$msg) = @_; 1137 delete $this->{receiving_exceptlist}->{$msg->param(1)}; 1138} 1139 1140sub _RPL_BANLIST { 1141 my ($this,$msg) = @_; 1142 my $ch = $this->channel($msg->param(1)); 1143 1144 my $receiving_banlist = $this->{receiving_banlist}->{$msg->param(1)}; 1145 if (defined $receiving_banlist && 1146 $receiving_banlist == 1) { 1147 # +bリストを初期化 1148 $ch->banlist(undef,undef,'clear'); 1149 # BANLIST受信中フラグを立てる 1150 $this->{receiving_banlist}->{$msg->param(1)} = 1; 1151 } 1152 1153 if (defined $ch) { 1154 # 重複防止のため、一旦deleteしてからadd。 1155 $ch->banlist('delete',$msg->param(2)); 1156 $ch->banlist('add',$msg->param(2)); 1157 } 1158} 1159 1160sub _RPL_ENDOFBANLIST { 1161 my ($this,$msg) = @_; 1162 delete $this->{receiving_banlist}->{$msg->param(1)}; 1163} 1164 1165sub _RPL_WHOREPLY { 1166 my ($this,$msg) = @_; 1167 my $p = $this->{people}->{$msg->param(5)}; 1168 if (defined $p) { 1169 $p->username($msg->param(2)); 1170 $p->userhost($msg->param(3)); 1171 $p->server($msg->param(4)); 1172 $p->realname((split / /,$msg->param(7),2)[1]); 1173 if ($msg->param(6) =~ /^G/) { 1174 $p->away('Gone.'); 1175 } else { 1176 $p->away(''); 1177 } 1178 my $hops = $this->remark('server-hops') || {}; 1179 $hops->{$p->server} = (split / /,$msg->param(7),2)[0]; 1180 $this->remark('server-hops', $hops); 1181 } 1182 1183 #use Data::Dumper; 1184 #open(LOG,"> log.txt"); 1185 #print LOG "------- people --------\n"; 1186 #print LOG Dumper($this->{people}),"\n"; 1187 #print LOG "------- channels --------\n"; 1188 #print LOG Dumper($this->{channels}),"\n"; 1189 #close(LOG); 1190} 1191 1192sub _RPL_CHANNELMODEIS { 1193 my ($this,$msg) = @_; 1194 # 既知のチャンネルなら、そのチャンネルに 1195 # switches-are-known => 1という備考を付ける。 1196 my $ch = $this->channel($msg->param(1)); 1197 if (defined $ch) { 1198 $ch->remarks('switches-are-known',1); 1199 1200 # switches と parameters は必ず得られると仮定して、クリア処理を行う 1201 $ch->switches(undef, undef, 'clear'); 1202 $ch->parameters(undef, undef, 'clear'); 1203 } 1204 1205 # 鯖がMODEを実行したことにして、_MODEに処理を代行させる。 1206 my @args = @{$msg->params}; 1207 @args = @args[1 .. $#args]; 1208 1209 $this->_MODE( 1210 $this->construct_irc_message( 1211 Prefix => $msg->prefix, 1212 Command => 'MODE', 1213 Params => \@args)); 1214} 1215 1216sub _RPL_ISUPPORT { 1217 # 歴史的な理由で、 RPL_ISUPPORT(005) は 1218 # RPL_BOUNCE(005) として使われていることがある。 1219 my ($this,$msg) = @_; 1220 if ($msg->n_params >= 2 && # nick + [params] + 'are supported by this server' 1221 $msg->param($msg->n_params - 1) =~ /supported/i) { 1222 foreach my $param ((@{$msg->params})[1...($msg->n_params - 2)]) { 1223 my ($negate, $key, $value) = $param =~ /^(-)?([[:alnum:]]+)(?:=(.+))?$/; 1224 if (!defined $negate) { 1225 # empty value 1226 $value = '' unless defined $value; 1227 $this->{isupport}->{$key} = $value; 1228 } elsif (!defined $value) { 1229 # negate a previously specified parameter 1230 delete $this->{isupport}->{$key}; 1231 } else { 1232 # inconsistency param 1233 carp("inconsistency RPL_ISUPPORT param: $param"); 1234 } 1235 } 1236 } 1237} 1238 1239sub _RPL_YOURID { 1240 my ($this,$msg) = @_; 1241 1242 $this->remark('uid', $msg->param(1)); 1243} 1244 1245sub _handle_fix_nick { 1246 my ($this, $msg) = @_; 1247 # 接続時以外のnick重複を処理します。 1248 my $mode = $this->config_local_or_general('nick-fix-mode'); 1249 1250 if ($mode == 0) { 1251 # 常に Tiarra が処理します。 1252 1253 $this->_set_to_next_nick($msg->param(1)); 1254 $msg->remark('do-not-send-to-clients',1); 1255 ## 破棄せず do-not-send-to-clients をつける。 1256 return $msg; 1257 } elsif ($mode == 1) { 1258 # クライアントにそのまま投げます。 1259 # 複数のクライアントが nick 重複を処理する場合は非常に危険です。 1260 # (設定不足の IRC クライアントが複数つながっている場合も含みます) 1261 return $msg; 1262 } elsif ($mode == 2) { 1263 # 対応するエラーメッセージ付きの NOTICE に変換して、 1264 # クライアントに投げます。 1265 1266 my $new_msg = $this->construct_irc_message( 1267 Prefix => $this->_runloop->sysmsg_prefix(qw(priv nick::system)), 1268 Command => 'NOTICE', 1269 Params => [$this->_runloop->current_nick, 1270 ''], 1271 ); 1272 if ($msg->command eq ERR_NICKNAMEINUSE) { 1273 $new_msg->param(1, 'Nickname is already in use: ' . 1274 $msg->param(1)); 1275 } elsif ($msg->command eq ERR_UNAVAILRESOURCE) { 1276 $new_msg->param(1, 'Nick/channel is temporarily unavailable: ' . 1277 $msg->param(1)); 1278 } else { 1279 return $msg; 1280 } 1281 return $new_msg; 1282 } 1283} 1284 1285sub _set_to_next_nick { 1286 my ($this,$failed_nick) = @_; 1287 # failed_nickの次のnickを試します。nick重複でログインに失敗した時に使います。 1288 my $next_nick = modify_nick($failed_nick, $this->isupport->{NICKLEN}); 1289 1290 my $msg_for_user = "Nick $failed_nick was already in use in the ".$this->network_name.". Trying ".$next_nick."..."; 1291 $this->send_message( 1292 $this->construct_irc_message( 1293 Command => 'NICK', 1294 Param => $next_nick)); 1295 $this->_runloop->broadcast_to_clients( 1296 $this->construct_irc_message( 1297 Prefix => $this->_runloop->sysmsg_prefix(qw(priv nick::system)), 1298 Command => 'NOTICE', 1299 Params => [$this->_runloop->current_nick,$msg_for_user])); 1300 $this->printmsg($msg_for_user); 1301} 1302 1303sub modify_nick { 1304 my $nick = shift; 1305 my $nicklen = shift || 9; 1306 1307 if ($nick =~ /^(.*\D)?(\d+)$/) { 1308 # 最後の数文字が数字だったら、それをインクリメント 1309 my $base = $1; 1310 my $next_num = $2 + 1; 1311 if (($next_num - 1) eq $next_num) { 1312 # 桁あふれしているので数字部分を全部消す。 1313 $nick = $base; 1314 } elsif (length($base . $next_num) <= $nicklen) { 1315 # $nicklen 文字以内に収まるのでこれで試す。 1316 $nick = $base . $next_num; 1317 } 1318 else { 1319 # 収まらないので $nicklen 文字に縮める。 1320 $nick = substr($base,0,$nicklen - length($next_num)) . $next_num; 1321 } 1322 } 1323 elsif ($nick =~ /_$/ && length($nick) >= $nicklen) { 1324 # 最後の文字が_で、それ以上_を付けられない場合、それを0に。 1325 $nick =~ s/_$/0/; 1326 } 1327 else { 1328 # 最後に_を付ける。 1329 if (length($nick) >= $nicklen) { 1330 $nick =~ s/.$/_/; 1331 } 1332 else { 1333 $nick .= '_'; 1334 } 1335 } 1336 return $nick; 1337} 1338 1339sub rejoin_all_channels { 1340 my ($this) = @_; 1341 # 記憶している全てのチャンネルにJOINする。 1342 # そもそもJOINしていないチャンネルは通常IrcIO::Serverは記憶していないが、 1343 # サーバーから切断された時だけは例外である。 1344 my @ch_with_key; # パスワードを持ったチャンネルの配列。要素は["チャンネル名","パスワード"] 1345 my @ch_without_key; # パスワードを持たないチャンネルの配列。要素は"チャンネル名" 1346 1347 foreach my $ch ($this->channels_list) { 1348 my $key = $ch->parameters('k'); 1349 if (defined $key && $key ne '') { 1350 push(@ch_with_key, [$ch->name, $key]); 1351 } else { 1352 push(@ch_without_key, $ch->name); 1353 } 1354 } 1355 1356 my $interval = $this->_runloop->_conf_general->join_interval; 1357 my $channels = $this->_runloop->_conf_general->join_channels_per_command; 1358 1359 $this->{rejoin_timer} = Timer->new( 1360 Name => $this->_gen_msg('rejoin timer'), 1361 Interval => $interval, 1362 Repeat => 1, 1363 Code => sub { 1364 my $timer = shift; 1365 my $remind = $channels; 1366 if ($remind && @ch_with_key) { 1367 my (@targets) = splice(@ch_with_key, 0, $remind); 1368 $this->send_message( 1369 $this->construct_irc_message( 1370 Command => 'JOIN', 1371 Params => [join(',', map { $_->[0] } @targets), 1372 join(',', map { $_->[1] } @targets)])); 1373 $remind -= scalar(@targets); 1374 } 1375 if ($remind && @ch_without_key) { 1376 my (@targets) = splice(@ch_without_key, 0, $remind); 1377 $this->send_message( 1378 $this->construct_irc_message( 1379 Command => 'JOIN', 1380 Params => [join(',', @targets)])); 1381 $remind -= scalar(@targets); 1382 } 1383 if (!@ch_with_key && !@ch_without_key) { 1384 ## nothing found 1385 $this->{rejoin_timer} = undef; 1386 $timer->uninstall; 1387 } 1388 })->install; 1389} 1390 13911; 1392