1# -----------------------------------------------------------------------------
2# $Id: Client.pm 28573 2009-01-17 18:01:46Z topia $
3# -----------------------------------------------------------------------------
4# IrcIO::Clientはクライアントからの接続を受け、
5# IRCメッセージをやり取りするクラスです。
6# -----------------------------------------------------------------------------
7package IrcIO::Client;
8use strict;
9use warnings;
10use Carp;
11use base qw(IrcIO);
12use Crypt;
13use Multicast;
14use Mask;
15use LocalChannelManager;
16use NumericReply;
17use Tiarra::Resolver;
18use Tiarra::Socket;
19use Tiarra::Utils;
20utils->define_attr_getter(0, qw(logging_in username),
21			  qw(client_host client_addr client_host_repr));
22
23
24# 複数のパッケージを混在させてるとSelfLoaderが使えない…？
25#use SelfLoader;
26#SelfLoader->load_stubs; # このクラスには親クラスがあるから。(SelfLoaderのpodを参照)
27#1;
28#__DATA__
29
30sub new {
31    my ($class,$runloop,$sock) = @_;
32    my $this = $class->SUPER::new($runloop);
33    $this->attach($sock);
34    $this->{pass_received} = ''; # クライアントから受け取ったパスワード
35    $this->{nick} = ''; # ログイン時にクライアントから受け取ったnick。変更されない。
36    $this->{username} = ''; # 同username
37    $this->{logging_in} = 1; # ログイン中なら1
38    $this->{options} = {}; # クライアントが接続時に$key=value$で指定したオプション。
39    my $addr = $sock->peerhost;
40    $this->{client_host} = $this->{client_addr} = $addr;
41    ::printmsg("One client at ".$this->{client_addr}." connected to me. " .
42		   "Please wait to get hostname of this address.");
43    Tiarra::Resolver->paranoid_check($addr, sub {
44					 $this->accept(@_);
45				     });
46    $this;
47}
48
49sub accept {
50    my ($this, $paranoid_ok, $host, $entry) = @_;
51
52    $this->{client_host} = $paranoid_ok ? $host : $this->{client_addr};
53    $this->{client_host_repr} = Tiarra::Socket->repr_destination(
54	host => $this->{client_host},
55	addr => $this->{client_addr});
56
57    # このホストからの接続は許可されているか？
58    my $allowed_host = $this->_conf_general->client_allowed;
59    if (defined $allowed_host) {
60	unless (Mask::match($allowed_host,$this->{client_host}) ||
61		Mask::match($allowed_host,$this->{client_addr})) {
62	    # マッチしないのでdie。
63	    die "Disconnect the client at ".$this->{client_host_repr}.". The host is not allowed.\n";
64	}
65    }
66    ::printmsg("Accepted connection of the client at ".$this->{client_host_repr}.".");
67    $this->install;
68    $this;
69}
70
71sub disconnect {
72    my ($this, $genre, $errno, @params) = @_;
73
74    $this->SUPER::disconnect($genre, $errno, @params);
75    if (defined $errno) {
76	::printmsg($this->sock_errno_to_msg(
77	    $errno,
78	    "Disconnected Client from ".$this->{client_host_repr}.": $genre error"));
79    } else {
80	::printmsg("Disconnected Client from ".$this->{client_host_repr}.".");
81    }
82}
83
84sub fullname {
85    # このクライアントをtiarraから見たnick!username@userhostの形式で表現する。
86    my ($this,$type) = @_;
87    if (defined $type && $type eq 'error') {
88	$this->_runloop->current_nick.'['.$this->{username}.'@'.$this->{client_host}.']';
89    }
90    else {
91	$this->_runloop->current_nick.'!'.$this->{username}.'@'.$this->{client_host};
92    }
93}
94
95sub fullname_from_client {
96    # このクライアントをクライアントから見たnick!username@userhostの形式で表現する。
97    # この関数が返すnickは初めに受け取ったものである点に注意。
98    my $this = shift;
99    $this->{nick}.'!'.$this->{username}.'@'.$this->{client_host};
100}
101
102sub parse_realname {
103    my ($this,$realname) = @_;
104    return if !defined $realname;
105    # $key=value;key=value;...$
106    #
107    # 以下は全て有効で、同じ意味である。
108    # $ foo = bar; key=  value$
109    # $ foo=bar;key=value $
110    # $foo    =bar;key=  value    $
111
112    my $key = qr{[^=:]+?}; # キーとして許されるパターン
113    my $value = qr{[^;]*?}; # 値として許されるパターン
114    my $sep = qr{[:=]};
115    my $lastpair = qr{$key\s*$sep\s*$value};
116    my $pair = qr{$lastpair\s*;};
117
118    my $line = qr{^\$(?:\s*($pair)\s*)*\s*($lastpair)\s*\$$};
119    if (my @pairs = ($realname =~ m/$line/g)) {
120	%{$this->{options}} = map {
121	    m/^\s*($key)\s*$sep\s*($value)\s*;?$/;
122	} grep {
123	    defined;
124	} @pairs;
125    }
126}
127
128sub option {
129    # ログイン時に$key=value$で指定されたオプションを取得する。
130    # 指定されたキーに対する値が存在しなかった場合はundefを返す。
131    my ($this,$key) = @_;
132    if (defined $key) {
133	$this->{options}->{$key};
134    }
135    else {
136	croak "IrcIO::Client->option, Arg[1] was undef.";
137    }
138}
139
140sub option_or_default {
141    my ($this, $base, $config_prefix, $option_prefix, $default) = @_;
142    my $value;
143
144    utils->get_first_defined(
145	$this->option(utils->to_str($option_prefix).$base),
146	$this->_conf_general->get(utils->to_str($option_prefix).$base),
147	$default);
148}
149
150sub option_or_default_multiple {
151    my ($this, $base, $types, $config_prefix) = @_;
152
153    return utils->get_first_defined(
154	(map {
155	    $this->option(join('',utils->to_str($_, $base)));
156	} @$types),
157	(map {
158	    $this->_conf_general->get(
159		join('',utils->to_str($config_prefix, $_, $base)));
160	} @$types));
161}
162
163sub send_message {
164    my ($this,$msg) = @_;
165
166    # 各モジュールに通知
167    #$this->_runloop->notify_modules('notification_of_message_io',$msg,$this,'out');
168
169    $this->SUPER::send_message(
170	$msg,
171	$this->option_or_default_multiple('encoding', ['out-', ''], 'client-'));
172}
173
174sub read {
175    my ($this) = shift;
176    $this->SUPER::read(
177	$this->option_or_default_multiple('encoding', ['in-', ''], 'client-'));
178
179    # 接続が切れたら、各モジュールへ通知
180    if (!$this->connected) {
181	$this->_runloop->notify_modules('client_detached',$this);
182    }
183}
184
185sub pop_queue {
186    my $this = shift;
187    my $msg = $this->SUPER::pop_queue;
188
189    # クライアントがログイン中なら、ログインを受け付ける。
190    if (defined $msg) {
191	# 各モジュールに通知
192	#$this->_runloop->notify_modules('notification_of_message_io',$msg,$this,'in');
193
194	# ログイン作業中か？
195	if ($this->{logging_in}) {
196	    return $this->_receive_while_logging_in($msg);
197	}
198	else {
199	    return $this->_receive_after_logged_in($msg);
200	}
201    }
202    return $msg;
203}
204
205sub _receive_while_logging_in {
206    my ($this,$msg) = @_;
207
208    # NICK及びUSERを受け取った時点でそのログインの正当性を確認し、作業を終了する。
209    my $command = $msg->command;
210    if ($command eq 'PASS') {
211	$this->{pass_received} = $msg->params->[0];
212    }
213    elsif ($command eq 'NICK') {
214	$this->{nick} = $msg->params->[0];
215    }
216    elsif ($command eq 'USER') {
217	$this->{username} = $msg->param(0);
218	$this->parse_realname($msg->param(3));
219    }
220    elsif ($command eq 'PING') {
221	$this->send_message(
222	    $this->construct_irc_message(
223		Command => 'PONG',
224		Param => $msg->param(0)));
225    }
226    elsif ($command eq 'QUIT') {
227	$this->send_message(
228	    $this->construct_irc_message(
229		Command => 'ERROR',
230		Param => 'Closing Link: ['.$this->fullname_from_client.'] ()'));
231	$this->disconnect_after_writing;
232    }
233
234    if ($this->{nick} ne '' && $this->{username} ne '') {
235	# general/tiarra-passwordを取得
236	my $valid_password = $this->_conf_general->tiarra_password;
237	my $prefix = $this->_runloop->sysmsg_prefix('system');
238	if (defined $valid_password && $valid_password ne '' &&
239	    ! Crypt::check($this->{pass_received},$valid_password)) {
240	    # パスワードが正しくない。
241	    ::printmsg("Refused login of ".$this->fullname_from_client." because of bad password.");
242
243	    $this->send_message(
244		$this->construct_irc_message(Prefix => $prefix,
245			       Command => ERR_PASSWDMISMATCH,
246			       Params => [$this->{nick},'Password incorrect']));
247	    $this->send_message(
248		$this->construct_irc_message(Command => 'ERROR',
249			       Param => 'Closing Link: ['.$this->fullname_from_client.'] (Bad Password)'));
250		$this->disconnect_after_writing;
251	}
252	else {
253	    # パスワードが正しいか、指定されていない。
254	    ::printmsg('Accepted login of '.$this->fullname_from_client.
255			   ', from '.$this->{client_host_repr}.'.');
256	    if ((my $n_options = keys %{$this->{options}}) > 0) {
257		# オプションが指定されていたら表示する。
258		my $options = join ' ; ',map {
259		    "$_ = $this->{options}->{$_}";
260		} keys %{$this->{options}};
261		::printmsg('Given option'.($n_options == 1 ? '' : 's').': '.$options);
262	    }
263	    $this->{logging_in} = 0;
264
265	    # 実際にはループではない。
266	    while (1) {
267		$this->send_message(
268		    $this->construct_irc_message(Prefix => $prefix,
269						 Command => RPL_WELCOME,
270						 Params => [$this->{nick},'Welcome to the Internet Relay Network '.$this->fullname_from_client]));
271
272		my $current_nick = $this->_runloop->current_nick;
273		if ($this->{nick} ne $current_nick) {
274		    # クライアントが送ってきたnickとローカルのnickが食い違っているので正しいnickを教える。
275		    $this->send_message(
276			$this->construct_irc_message(Prefix => $this->fullname_from_client,
277						     Command => 'NICK',
278						     Param => $current_nick));
279		}
280
281		my $send_message = sub {
282		    my ($command, @params) = @_;
283		    $this->send_message(
284			$this->construct_irc_message(
285			    Prefix => $prefix,
286			    Command => $command,
287			    Params => [$current_nick,
288				       @params],
289			   ));
290		};
291
292		map {
293		    # ローカルnickとグローバルnickが食い違っていたらその旨を伝える。
294		    my $network_name = $_->network_name;
295		    my $global_nick = $_->current_nick;
296		    if ($global_nick ne $current_nick) {
297			$this->send_message(
298			    $this->construct_irc_message(
299				Prefix => $this->_runloop->sysmsg_prefix(qw(priv system)),
300				Command => 'NOTICE',
301				Params => [$current_nick,
302					   "*** Your global nick in $network_name is currently '$global_nick'."]));
303		    }
304		} values %{$this->_runloop->networks};
305
306		$send_message->(RPL_YOURHOST, "Your host is $prefix, running version ".::version());
307		if (!$this->_runloop->multi_server_mode_p) {
308		    # single server mode
309		    my $network = ($this->_runloop->networks_list)[0];
310
311		    if (defined $network) {
312			# send isupport
313			my $msg_tmpl = $this->construct_irc_message(
314			    Prefix => $prefix,
315			    Command => RPL_ISUPPORT,
316			    Params => [$current_nick],
317			   );
318			# last param is reserved for 'are supported...'
319			# and first param for nick
320			my $max_params = $this->irc_message_class->MAX_PARAMS - 2;
321			my @params = ();
322			my $length = 0;
323			my $flush_msg = sub {
324			    if (@params) {
325				my $msg = $msg_tmpl->clone;
326				$msg->push(@params);
327				$msg->push('are supported by this server');
328				$this->send_message($msg);
329			    }
330			    @params = ();
331			    $length = 0;
332			};
333			foreach my $key (keys %{$network->isupport}) {
334			    my $value = $network->isupport->{$key};
335			    my $str = length($value) ? ($key.'='.$value) : $key;
336			    $length += length($str) + 1; # $str and space
337			    # 余裕を見て400バイトを越えたら行を分ける。
338			    if ($length >= 400 || scalar(@params) >= $max_params) {
339				$flush_msg->();
340				$length = length($str);
341			    }
342			    push(@params, $str);
343			}
344			$flush_msg->();
345		    }
346		}
347		$send_message->(RPL_MOTDSTART, "- $prefix Message of the Day -");
348		foreach my $line (main::get_credit()) {
349		    $send_message->(RPL_MOTD, "- ".$line);
350		}
351		$send_message->(RPL_ENDOFMOTD, "End of MOTD command.");
352
353		# クライアントに出力。
354		# その結果切断されたらループを抜ける。
355		$this->flush;
356		last unless $this->connected;
357
358		# joinしている全てのチャンネルの情報をクライアント送る。
359		$this->inform_joinning_channels;
360
361		# 切断されていたらループを抜ける。
362		last unless $this->connected;
363
364		# 各モジュールにクライアント追加の通知を出す。
365		$this->_runloop->notify_modules('client_attached',$this);
366
367		# 必ずループを抜ける。
368		last;
369	    }
370	}
371    }
372    # ログイン作業中にクライアントから受け取ったいかなるメッセージもサーバーには送らない。
373    return undef;
374}
375
376sub _receive_after_logged_in {
377    my ($this,$msg) = @_;
378
379    # ログイン中でない。
380    my $command = $msg->command;
381
382    if ($command eq 'NICK') {
383	if (defined $msg->params) {
384	    # 形式が正しい限りNICKには常に成功して、RunLoopのカレントnickが変更になる。
385	    # ただしネットワーク名が明示されていた場合はカレントを変更しない。
386	    my $rawnick = $msg->params->[0];
387	    my ($nick,undef,$specified) = Multicast::detach($rawnick);
388	    if (Multicast::nick_p($nick)) {
389		unless ($specified) {
390		    if ($this->_runloop->multi_server_mode_p &&
391			    $this->_runloop->current_nick ne $rawnick) {
392			$this->_runloop->broadcast_to_clients(
393			    $this->construct_irc_message(
394				Command => 'NICK',
395				Param => $rawnick,
396				Remarks => {'fill-prefix-when-sending-to-client' => 1}));
397
398			$this->_runloop->set_current_nick($rawnick);
399		    }
400		}
401	    } else {
402		$this->send_message(
403		    $this->construct_irc_message(
404			Prefix => $this->_runloop->sysmsg_prefix('system'),
405			Command => ERR_ERRONEOUSNICKNAME,
406			Params => [$this->_runloop->current_nick,
407				   $rawnick,
408				   'Erroneous nickname']));
409		# これは鯖に送らない。
410		$msg = undef;
411	    }
412	} else {
413	    $this->send_message(
414		$this->construct_irc_message(
415		    Prefix => $this->_runloop->sysmsg_prefix('system'),
416		    Command => ERR_NONICKNAMEGIVEN,
417		    Params => [$this->_runloop->current_nick,
418			       'No nickname given']));
419	    # これは鯖に送らない。
420	    $msg = undef;
421	}
422    }
423    elsif ($command eq 'QUIT') {
424	my $quit_message = $msg->param(0);
425	$quit_message = '' unless defined $quit_message;
426
427	$this->send_message(
428	    $this->construct_irc_message(Command => 'ERROR',
429			   Param => 'Closing Link: '.$this->fullname('error').' ('.$quit_message.')'));
430	$this->disconnect_after_writing;
431
432	# 接続が切れた事にする。
433	$this->_runloop->notify_modules('client_detached',$this);
434
435	# これは鯖に送らない。
436	$msg = undef;
437    }
438    else {
439	$msg = LocalChannelManager->shared
440	    ->message_arrived($msg, $this);
441    }
442    return $msg;
443}
444
445sub do_namreply {
446    my ($this, $ch, $network, $max_length, $flush_func) = @_;
447
448    $max_length = 400 if !defined $max_length;
449    croak('$ch is not specified') if !defined $ch;
450    croak('$network is not specified') if !defined $network;
451    croak('$flush_func is not specified') if !defined $flush_func;
452    my $global_to_local = sub {
453	Multicast::global_to_local(shift, $network);
454    };
455    my $ch_property_char = do {
456	if ($ch->switches('s')) {
457	    '@';
458	}
459	elsif ($ch->switches('p')) {
460	    '*';
461	}
462	else {
463	    '=';
464	}
465    };
466    # 余裕を見てnickの列挙部が $max_length(デフォルト:400) バイトを越えたら行を分ける。
467    my $nick_enumeration = '';
468    my $flush_enum_buffer = sub {
469	if ($nick_enumeration ne '') {
470	    $flush_func->(
471		$this->construct_irc_message(
472		    Prefix => $this->_runloop->sysmsg_prefix('system'),
473		    Command => RPL_NAMREPLY,
474		    Params => [$this->_runloop->current_nick,
475			       $ch_property_char,
476			       Multicast::attach_for_client($ch->name, $network->network_name),
477			       $nick_enumeration]));
478	    $nick_enumeration = '';
479	}
480    };
481    my $append_to_enum_buffer = sub {
482	my $nick_to_append = shift;
483	if ($nick_enumeration eq '') {
484	    $nick_enumeration = $nick_to_append;
485	}
486	else {
487	    $nick_enumeration .= ' '.$nick_to_append;
488	}
489    };
490    map {
491	my $person = $_;
492	my $mode_char = do {
493	    if ($person->has_o) {
494		'@';
495	    }
496	    elsif ($person->has_v) {
497		'+';
498	    }
499	    else {
500		'';
501	    }
502	};
503	$append_to_enum_buffer->($mode_char . $global_to_local->($person->person->nick));
504	if (length($nick_enumeration) > $max_length) {
505	    $flush_enum_buffer->();
506	}
507    } values %{$ch->names};
508    $flush_enum_buffer->();
509
510    undef;
511}
512
513sub inform_joinning_channels {
514    my $this = shift;
515    my $local_nick = $this->_runloop->current_nick;
516
517    my $send_channelinfo = sub {
518	my ($network, $ch) = @_;
519	my $ch_name = Multicast::attach_for_client($ch->name, $network->network_name);
520
521	# まずJOIN
522	$this->send_message(
523	    $this->construct_irc_message(
524		Prefix => $this->fullname,
525		Command => 'JOIN',
526		Param => $ch_name));
527	# 次にRPL_TOPIC(あれば)
528	if ($ch->topic ne '') {
529	    $this->send_message(
530		$this->construct_irc_message(
531		    Prefix => $this->_runloop->sysmsg_prefix('system'),
532		    Command => RPL_TOPIC,
533		    Params => [$local_nick,$ch_name,$ch->topic]));
534	}
535	# 次にRPL_TOPICWHOTIME(あれば)
536	if (defined($ch->topic_who)) {
537	    $this->send_message(
538		$this->construct_irc_message(
539		    Prefix => $this->_runloop->sysmsg_prefix('system'),
540		    Command => RPL_TOPICWHOTIME,
541		    Params => [$local_nick,$ch_name,$ch->topic_who,$ch->topic_time]));
542	}
543	# 次にRPL_NAMREPLY
544	my $flush_namreply = sub {
545	    my $msg = shift;
546	    $this->send_message($msg);
547	};
548	$this->do_namreply($ch, $network, undef, $flush_namreply);
549	# 最後にRPL_ENDOFNAMES
550	$this->send_message(
551	    $this->construct_irc_message(
552		Prefix => $this->_runloop->sysmsg_prefix('system'),
553		Command => RPL_ENDOFNAMES,
554		Params => [$local_nick,$ch_name,'End of NAMES list']));
555
556	# channel-infoフックの引数は (IrcIO::Client, 送信用チャンネル名, ネットワーク, ChannelInfo)
557	eval {
558	    IrcIO::Client::HookTarget->shared->call(
559		'channel-info', $this, $ch_name, $network, $ch);
560	}; if ($@) {
561	    # エラーメッセージは表示するが、送信処理は続ける
562	    $this->_runloop->notify_error(__PACKAGE__." hook call error: $@");
563	}
564
565	# クライアントに出力。
566	$this->flush;
567    };
568
569    my %channels = map {
570	my $network = $_;
571	map {
572	    my $ch = $_;
573	    (Multicast::attach($ch->name, $network->network_name) =>
574		    [$network, $ch]);
575	} values %{$network->channels};
576    } values %{$this->_runloop->networks};
577
578    while (1) {
579	# Mask を使って、マッチしたものを出力
580	foreach ($this->_conf_networks->
581		     fixed_channels('block')->channel('all')) {
582	    my $mask = $_;
583	    foreach (keys %channels) {
584		my $ch_name = $_;
585		if (Mask::match($mask, $ch_name)) {
586		    $send_channelinfo->(@{$channels{$ch_name}});
587		    last unless $this->connected;
588		    delete $channels{$ch_name};
589		}
590	    }
591	}
592
593	# のこりを出力
594	foreach (values %channels) {
595	    $send_channelinfo->(@$_);
596	    last unless $this->connected;
597	}
598
599	last;
600    }
601}
602
603# -----------------------------------------------------------------------------
604# クライアントにチャンネル情報(JOIN,TOPIC,NAMES等)を渡した直後に呼ばれるフック。
605# チャンネル名(multi server modeならネットワーク名付き)を引数として、
606# チャンネル一つにつき一度ずつ呼ばれる。
607#
608# my $hook = IrcIO::Client::Hook->new(sub {
609#     my $hook_itself = shift;
610#     # 何らかの処理を行なう。
611# })->install('channel-info'); # チャンネル情報転送時にこのフックを呼ぶ。
612# -----------------------------------------------------------------------------
613package IrcIO::Client::Hook;
614use FunctionalVariable;
615use base 'Hook';
616
617our $HOOK_TARGET_NAME = 'IrcIO::Client::HookTarget';
618our @HOOK_NAME_CANDIDATES = qw/channel-info/;
619our $HOOK_NAME_DEFAULT = 'channel-info';
620our $HOOK_TARGET_DEFAULT;
621FunctionalVariable::tie(
622    \$HOOK_TARGET_DEFAULT,
623    FETCH => sub {
624	IrcIO::Client::HookTarget->shared;
625    },
626   ) unless defined $HOOK_TARGET_DEFAULT;
627
628# -----------------------------------------------------------------------------
629package IrcIO::Client::HookTarget;
630use Hook;
631our @ISA = 'HookTarget';
632use Tiarra::SharedMixin;
633
634sub _new {
635    return bless {} => shift;
636}
637
638sub call {
639    my ($this, $name, @args) = @_;
640    $this->call_hooks($name, @args);
641}
642
6431;
644