2 # -*- mode: perl; coding: utf-8 -*-
5 # Copyright (c) 2003-2010 Jun Morimoto <morimoto@mrmt.net>
6 # This program is covered by the GNU General Public License 2
8 # Depends: libpoe-component-irc-perl,
9 # liburi-perl, libwww-perl, libappconfig-perl, libproc-daemon-perl,
10 # libhtml-template-perl
12 # 00location_receiver plugin use XML::Simple, so if you want to use it
13 # Depends: libxml-simple-perl
17 use POE::Filter::HTTPD;
18 use POE::Component::IRC;
19 use POE::Component::Server::TCP;
26 use lib ("$FindBin::Bin/lib", '/usr/share/keitairc/lib');
29 use Keitairc::IrcBuffer;
30 use Keitairc::IrcCallback;
31 use Keitairc::ClientInfo;
32 use Keitairc::SessionManager;
33 use Keitairc::Plugins;
38 our $cf = new Keitairc::Config({version => '2.1a1', argv => \@ARGV});
42 if (eval 'require Proc::Daemon') {
45 if(length $cf->pid_dir()){
46 if (open(PID, '> ' . $cf->pid_dir() . '/' . $cf->pid_file())) {
51 $poe_kernel->has_forked if ($poe_kernel->can('has_forked'));
53 warn('Proc::Daemon module is not installed, could not daemonize');
57 our $log = new Keitairc::Log({config => $cf});
58 our $ib = new Keitairc::IrcBuffer({history => $cf->web_lines()});
59 our $sm = new Keitairc::SessionManager({default_ttl => $cf->session_ttl()});
60 our $pl = new Keitairc::Plugins({config => $cf});
62 # create irc component
63 our $irc = POE::Component::IRC->spawn(
64 Alias => 'keitairc_irc',
65 Nick => $cf->irc_nick(),
66 Username => $cf->irc_username(),
67 Ircname => $cf->irc_desc(),
68 Server => $cf->irc_server(),
69 Port => $cf->irc_port(),
70 Password => $cf->irc_password());
82 _start => \&Keitairc::IrcCallback::irc_start,
83 autoping => \&Keitairc::IrcCallback::irc_autoping,
84 connect => \&Keitairc::IrcCallback::irc_connect,
85 irc_registered => \&Keitairc::IrcCallback::irc_registered,
86 irc_001 => \&Keitairc::IrcCallback::irc_001,
87 irc_join => \&Keitairc::IrcCallback::irc_join,
88 irc_part => \&Keitairc::IrcCallback::irc_part,
89 irc_quit => \&Keitairc::IrcCallback::irc_quit,
90 irc_public => \&Keitairc::IrcCallback::irc_public,
91 irc_notice => \&Keitairc::IrcCallback::irc_notice,
92 irc_mode => \&Keitairc::IrcCallback::irc_mode,
93 irc_nick => \&Keitairc::IrcCallback::irc_nick,
94 irc_msg => \&Keitairc::IrcCallback::irc_msg,
95 irc_topic => \&Keitairc::IrcCallback::irc_topic,
96 irc_332 => \&Keitairc::IrcCallback::irc_topicraw,
97 irc_352 => \&Keitairc::IrcCallback::irc_whoreply,
98 irc_ctcp_action => \&Keitairc::IrcCallback::irc_ctcp_action,
99 irc_disconnected => \&Keitairc::IrcCallback::irc_reconnect,
100 irc_error => \&Keitairc::IrcCallback::irc_reconnect,
101 irc_socketerr => \&Keitairc::IrcCallback::irc_reconnect,
104 # create web server component
105 POE::Component::Server::TCP->new(
107 Port => $cf->web_listen_port(),
108 ClientFilter => 'POE::Filter::HTTPD',
109 ClientInput => \&http_request);
115 ################################################################
117 my ($kernel, $heap, $request) = @_[KERNEL, HEAP, ARG0];
119 # Filter::HTTPD sometimes generates HTTP::Response objects.
120 # They indicate (and contain the response for) errors that occur
121 # while parsing the client's HTTP request. It's easiest to send
122 # the responses as they are and finish up.
123 if($request->isa('HTTP::Response')){
124 $heap->{client}->put($request);
125 $log->log_error($request->as_string());
126 }elsif(my $response = dispatch($request)){
127 $heap->{client}->put($response);
128 $log->log_access($heap->{'remote_ip'}, $request, $response);
131 $kernel->yield('shutdown');
134 ################################################################
137 my $uri = $request->uri();
138 my $ci = new Keitairc::ClientInfo($request);
140 $log->log_debug("dispatch: $uri");
143 # chop off $cf->web_root()
144 my $root = $cf->web_root();
149 return action_root($request);
152 if($uri eq '/login'){
153 return action_login($request);
156 if($uri eq '/login_icc'){
157 return action_login_icc($request);
160 if($uri eq '/login_imodeid?guid=ON'){
161 return action_login_imodeid($request);
164 for my $name ($pl->list_action_plugins()){
165 if($uri =~ m|^/(S[a-zA-Z]{10})/$name/(.*)| ||
166 $uri =~ m|^/(S[a-zA-Z]{10})/$name$|){
167 if($sm->verify({session_id => $1, user_agent => $ci->user_agent()})){
168 return add_cookie($pl->{plugins}->{$name}->{action_imprementation}($request, $name, $1, $2), $1);
170 if ($ci->is_webkit() && $cf->webkit_newui()) {
171 return action_error($request, 401);
173 return action_redirect_root($request);
178 return action_public($request, $uri) || action_error($request, 404);
181 ################################################################
182 # adds session id cookie to http response object
184 my $response = shift;
185 my $session_id = shift;
187 my ($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime(time + $cf->cookie_ttl());
189 sprintf('%.3s, %.2d-%.3s-%.4s %.2d:%.2d:%.2d',
190 qw(Sun Mon Tue Wed Thu Fri Sat)[$wday],
192 qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)[$mon],
197 my $content = sprintf("sid=%s; expires=%s; path=%s; \n", $session_id, $expiration, $cf->web_root());
198 $response->push_header('Set-Cookie', $content);
202 ################################################################
205 # 間違っていたら / へリンクして終わり
206 # 合っていたらセッションを発行し /{SESSION}/index へ
209 my $ci = new Keitairc::ClientInfo($request);
210 my $content = $request->decoded_content();
211 my ($password) = ($content =~ /^password=(.*)/);
213 $log->log_debug("password [$password]");
214 $log->log_debug("web_password [" . $cf->web_password() . "]");
216 if($cf->web_password() eq $password){
217 my $s = $sm->add($ci->user_agent(), $ci->serial_key());
218 my $view = new Keitairc::View($cf, $ci, $s->{id});
219 if ($ci->is_webkit() && $cf->webkit_newui()) {
220 return add_cookie($view->redirect('/'), $s->{id});
222 return $view->redirect("/$s->{id}/index");
227 my $view = new Keitairc::View($cf, $ci);
228 return $view->redirect('/');
231 ################################################################
234 my $error_code = shift;
235 my $ci = new Keitairc::ClientInfo($request);
236 my $view = new Keitairc::View($cf, $ci);
237 return $view->render('error.html', { action => $request->uri(),
238 _http_status_code => $error_code,
239 _http_status_message => status_message($error_code) });
242 ################################################################
245 my $uri = shift; # such as '/favicon.ico'
246 my $ci = new Keitairc::ClientInfo($request);
247 my $view = new Keitairc::View($cf, $ci);
248 return $view->public($uri);
251 ################################################################
253 # DoCoMoだったらiccが来ているはずなので, icc + user_agent でチェック。
254 # 合っていたらセッション復帰して /{SESSION}/index へ
255 sub action_login_icc{
257 my $ci = new Keitairc::ClientInfo($request);
258 if($ci->is_docomo()){
259 my $docomo_foma_icc = $ci->docomo_foma_icc();
260 if(length $docomo_foma_icc){
261 if(my $s = $sm->verify({serial_key => $docomo_foma_icc,
262 user_agent => $ci->user_agent()})){
263 $log->log_debug("redirect to /$s->{id}/index from docomo_foma_icc");
264 my $view = new Keitairc::View($cf, $ci, $s->{id});
265 return $view->redirect("/$s->{id}/index");
268 if($docomo_foma_icc eq $cf->docomo_foma_icc()){
269 my $s = $sm->add($ci->user_agent(), $docomo_foma_icc);
270 $log->log_debug("redirect to /$s->{id}/index from docomo_foma_icc");
271 my $view = new Keitairc::View($cf, $ci, $s->{id});
272 return $view->redirect("/$s->{id}/index");
275 my $view = new Keitairc::View($cf, $ci);
276 return $view->render('login_icc.html', { icc => $docomo_foma_icc });
280 my $view = new Keitairc::View($cf, $ci);
281 return $view->render('root.html', {
282 docomo_foma_icc => $cf->docomo_foma_icc(),
283 docomo_imodeid => $cf->docomo_imodeid(),
287 ################################################################
289 # DoCoMoだったらiモードIDが来ているはずなので, iモードID + user_agent でチェック。
290 # 合っていたらセッション復帰して /{SESSION}/index へ
291 sub action_login_imodeid{
293 my $ci = new Keitairc::ClientInfo($request);
294 if($ci->is_docomo()){
295 my $docomo_imodeid = $ci->docomo_imodeid();
296 if(length $docomo_imodeid){
297 if(my $s = $sm->verify({serial_key => $docomo_imodeid,
298 user_agent => $ci->user_agent()})){
299 $log->log_debug("redirect to /$s->{id}/index from docomo_imodeid");
300 my $view = new Keitairc::View($cf, $ci, $s->{id});
301 return $view->redirect("/$s->{id}/index");
304 if($docomo_imodeid eq $cf->docomo_imodeid()){
305 my $s = $sm->add($ci->user_agent(), $docomo_imodeid);
306 $log->log_debug("redirect to /$s->{id}/index from docomo_imodeid");
307 my $view = new Keitairc::View($cf, $ci, $s->{id});
308 return $view->redirect("/$s->{id}/index");
311 my $view = new Keitairc::View($cf, $ci);
312 return $view->render('login_imodeid.html', { imodeid => $docomo_imodeid });
316 my $view = new Keitairc::View($cf, $ci);
317 return $view->render('root.html', {
318 docomo_foma_icc => $cf->docomo_foma_icc(),
319 docomo_imodeid => $cf->docomo_imodeid(),
323 ################################################################
326 my $ci = new Keitairc::ClientInfo($request);
328 if($ci->cookie_available()){
329 my $session_id = $ci->{cookie}->{sid};
330 if(defined($session_id) && length($session_id)){
331 if($sm->verify({session_id => $session_id,
332 user_agent => $ci->user_agent()})){
333 $log->log_debug("redirect to /$session_id/index from cookie");
334 my $view = new Keitairc::View($cf, $ci, $session_id);
335 if ($ci->is_webkit() && $cf->webkit_newui()) {
336 return add_cookie($view->render('root_home.html', {sid => $session_id}), $session_id);
338 return $view->redirect("/$session_id/index");
345 my $subscriber_id = $ci->au_subscriber_id();
346 if(length $subscriber_id){
347 if(my $s = $sm->verify({serial_key => $subscriber_id,
348 user_agent => $ci->user_agent()})){
349 $log->log_debug("redirect to /$s->{id}/index from subscriber_id");
350 my $view = new Keitairc::View($cf, $ci, $s->{id});
351 return $view->redirect("/$s->{id}/index");
354 if($subscriber_id eq $cf->au_subscriber_id()){
355 my $s = $sm->add($ci->user_agent(), $subscriber_id);
356 $log->log_debug("redirect to /$s->{id}/index from au_subscriber_id");
357 my $view = new Keitairc::View($cf, $ci, $s->{id});
358 return $view->redirect("/$s->{id}/index");
363 if($ci->is_softbank()){
364 my $serial_key = $ci->softbank_serial();
365 if(length $serial_key){
366 if(my $s = $sm->verify({serial_key => $serial_key,
367 user_agent => $ci->user_agent()})){
368 $log->log_debug("redirect to /$s->{id}/index from softbank serial_key");
369 my $view = new Keitairc::View($cf, $ci, $s->{id});
370 return $view->redirect("/$s->{id}/index");
372 if($serial_key eq $cf->softbank_serial_key()){
373 my $s = $sm->add($ci->user_agent(), $serial_key);
374 $log->log_debug("redirect to /$s->{id}/index from softbank_serial_key");
375 my $view = new Keitairc::View($cf, $ci, $s->{id});
376 return $view->redirect("/$s->{id}/index");
381 if($ci->is_emobile()){
382 my $userid = $ci->emobile_userid();
384 if(my $s = $sm->verify({serial_key => $userid,
385 user_agent => $ci->user_agent()})){
386 $log->log_debug("redirect to /$s->{id}/index from userid");
387 my $view = new Keitairc::View($cf, $ci, $s->{id});
388 return $view->redirect("/$s->{id}/index");
391 if($userid eq $cf->emobile_userid()){
392 my $s = $sm->add($ci->user_agent(), $userid);
393 $log->log_debug("redirect to /$s->{id}/index from emobile_userid");
394 my $view = new Keitairc::View($cf, $ci, $s->{id});
395 return $view->redirect("/$s->{id}/index");
400 my $view = new Keitairc::View($cf, $ci);
401 return $view->render('root.html', {
402 docomo_foma_icc => $cf->docomo_foma_icc(),
403 docomo_imodeid => $cf->docomo_imodeid(),
407 ################################################################
408 sub action_redirect_root{
410 my $ci = new Keitairc::ClientInfo($request);
411 my $view = new Keitairc::View($cf, $ci);
412 return $view->redirect('/');
415 ################################################################
418 my $ci = new Keitairc::ClientInfo($request);
421 my $message = $request->content();
423 if(length($message)){
424 ($message, $timestamp) = split(/&/, $message);
426 $timestamp =~ s/^stamp=//g;
429 $message =~ s/\+/ /g;
430 $message = uri_unescape($message);
432 if($ci->is_webkit() && !$cf->webkit_newui()){
433 $message = fix_webkit_escape($message);
436 if ($cf->webkit_newui()) {
437 # ajax で投げ込んでるので utf8 できます
438 $message = Encode::decode('utf8', $message);
440 $message = Encode::decode($cf->web_charset(), $message);
442 return ($message, $timestamp);
449 my ($message, $timestamp) = parse_message($request);
451 if(length($message) && length($channel)){
452 if($ib->update_timestamp($timestamp)){
453 my $enc_message = Encode::encode($cf->irc_charset(), $message);
454 my $enc_channel = Encode::encode($cf->irc_charset(), $channel);
455 $irc->yield(privmsg => $enc_channel => $enc_message);
456 my $cid = $ib->name2cid($channel);
457 $ib->add_message($cid, $message, $cf->irc_nick());
465 my ($message, $timestamp) = parse_message($request);
467 if(length($message)){
468 if($message =~ s|^/||) {
469 my ($params, $trailing) = split(/ :/, $message, 2);
470 my @postcmd = split(/ /, $params);
471 push @postcmd, $trailing if defined $trailing;
472 # This parser may be incomplete.
473 if($postcmd[0] =~ /join/i) {
474 if($postcmd[1] =~ /^\w/) {
475 $ib->join($postcmd[1]);
478 } elsif($postcmd[0] =~ /part/i) {
479 if($postcmd[1] =~ /^\w/) {
480 $ib->part($ib->name2cid($postcmd[1]));
484 $irc->yield(map { Encode::encode($cf->irc_charset(), $_) } @postcmd);
489 ################################################################
490 # posted string from Webkit browser
491 # contains escaped utf-8 in the form %uXXXX
492 # and may contains escaped Shift-JIS (web_charset) in the form \xXX
493 # when operated from Safari/Mac OS X
494 sub fix_webkit_escape{
495 # charset: $cf->irc_charset()
497 $in =~ s/\\x([0-9A-F]{2})/pack('C',hex($1))/egi;
498 #my $pi = Encode::decode('utf8', $in);
499 $in =~ s/%u([0-9A-F]{4})/pack('U',hex($1))/egi;