keitairc

   1 #!/usr/bin/perl
   2 # -*- mode: perl; coding: utf-8 -*-
   3 # keitairc
   4 # $Id: keitairc,v 1.82 2010-05-19 00:36:18 ishikawa Exp $
   5 # $Source: /home/ishikawa/work/keitairc/tmp/keitairc/keitairc,v $
   6 #
   7 # Copyright (c) 2003-2008 Jun Morimoto <morimoto@mrmt.net>
   8 # This program is covered by the GNU General Public License 2
   9 #
  10 # Depends: libpoe-component-irc-perl,
  11 #   liburi-perl, libwww-perl, libappconfig-perl, libproc-daemon-perl,
  12 #   libhtml-template-perl
  13 #
  14 # 00location_receiver plugin use XML::Simple, so if you want to use it
  15 #    Depends: libxml-simple-perl
  16
  17 use Encode;
  18 use POE;
  19 use POE::Filter::HTTPD;
  20 use POE::Component::IRC;
  21 use POE::Component::Server::TCP;
  22 use URI::Escape;
  23 use HTML::Template;
  24 use HTTP::Response;
  25 use HTTP::Status;
  26
  27 use FindBin;
  28 use lib ("$FindBin::Bin/lib", '/usr/share/keitairc/lib');
  29 use Keitairc::Config;
  30 use Keitairc::View;
  31 use Keitairc::IrcBuffer;
  32 use Keitairc::IrcCallback;
  33 use Keitairc::ClientInfo;
  34 use Keitairc::SessionManager;
  35 use Keitairc::Plugins;
  36 use Keitairc::Log;
  37 use strict;
  38 use warnings;
  39
  40 our $cf = new Keitairc::Config({version => '2.0', argv => \@ARGV});
  41 our $ib = new Keitairc::IrcBuffer({history => $cf->web_lines()});
  42 our $sm = new Keitairc::SessionManager({default_ttl => $cf->session_ttl()});
  43 our $pl = new Keitairc::Plugins({config => $cf});
  44
  45 # daemonize
  46 if($cf->daemonize()){
  47         use Proc::Daemon;
  48
  49         Proc::Daemon::Init;
  50         if(length $cf->pid_dir()){
  51                 if (open(PID, '> ' . $cf->pid_dir() . '/' . $cf->pid_file())) {
  52                         print PID $$, "\n";
  53                         close(PID);
  54                 }
  55         }
  56         $poe_kernel->has_forked if ($poe_kernel->can('has_forked'));
  57 }
  58
  59 # create irc component
  60 our $irc = POE::Component::IRC->spawn(
  61         Alias => 'keitairc_irc',
  62         Nick => $cf->irc_nick(),
  63         Username => $cf->irc_username(),
  64         Ircname => $cf->irc_desc(),
  65         Server => $cf->irc_server(),
  66         Port => $cf->irc_port(),
  67         Password => $cf->irc_password());
  68
  69 # create POE session
  70 POE::Session->create(
  71         heap => {
  72                 seen_traffic => 0,
  73                 disconnect_msg => 1,
  74                 Config => $cf,
  75                 Irc => $irc,
  76                 IrcBuffer => $ib,
  77         },
  78         inline_states => {
  79                 _start => \&Keitairc::IrcCallback::irc_start,
  80                 autoping => \&Keitairc::IrcCallback::irc_autoping,
  81                 connect => \&Keitairc::IrcCallback::irc_connect,
  82                 irc_registered => \&Keitairc::IrcCallback::irc_registered,
  83                 irc_001 => \&Keitairc::IrcCallback::irc_001,
  84                 irc_join => \&Keitairc::IrcCallback::irc_join,
  85                 irc_part => \&Keitairc::IrcCallback::irc_part,
  86                 irc_quit => \&Keitairc::IrcCallback::irc_quit,
  87                 irc_public => \&Keitairc::IrcCallback::irc_public,
  88                 irc_notice => \&Keitairc::IrcCallback::irc_notice,
  89                 irc_mode => \&Keitairc::IrcCallback::irc_mode,
  90                 irc_nick => \&Keitairc::IrcCallback::irc_nick,
  91                 irc_msg => \&Keitairc::IrcCallback::irc_msg,
  92                 irc_topic => \&Keitairc::IrcCallback::irc_topic,
  93                 irc_332 => \&Keitairc::IrcCallback::irc_topicraw,
  94                 irc_352 => \&Keitairc::IrcCallback::irc_whoreply,
  95                 irc_ctcp_action => \&Keitairc::IrcCallback::irc_ctcp_action,
  96                 irc_disconnected => \&Keitairc::IrcCallback::irc_reconnect,
  97                 irc_error => \&Keitairc::IrcCallback::irc_reconnect,
  98                 irc_socketerr => \&Keitairc::IrcCallback::irc_reconnect,
  99         });
 100
 101 # create web server component
 102 POE::Component::Server::TCP->new(
 103         Alias => 'keitairc',
 104         Port => $cf->web_listen_port(),
 105         ClientFilter => 'POE::Filter::HTTPD',
 106         ClientInput => \&http_request);
 107
 108 # fire up main loop
 109 $poe_kernel->run();
 110 exit 0;
 111
 112 ################################################################
 113 sub http_request{
 114         my ($kernel, $heap, $request) = @_[KERNEL, HEAP, ARG0];
 115
 116         # Filter::HTTPD sometimes generates HTTP::Response objects.
 117         # They indicate (and contain the response for) errors that occur
 118         # while parsing the client's HTTP request.  It's easiest to send
 119         # the responses as they are and finish up.
 120         if($request->isa('HTTP::Response')){
 121                 $heap->{client}->put($request);
 122         }elsif(my $response = dispatch($request)){
 123                 $heap->{client}->put($response);
 124         }
 125
 126         $kernel->yield('shutdown');
 127 }
 128
 129 ################################################################
 130 sub dispatch{
 131         my $request = shift;
 132         my $uri = $request->uri();
 133         my $ci = new Keitairc::ClientInfo($request);
 134
 135         Keitairc::Log::log_debug("dispatch: $uri");
 136
 137         {
 138                 # chop off $cf->web_root()
 139                 my $root = $cf->web_root();
 140                 $uri =~ s|$root|/|;
 141         }
 142
 143         if($uri eq '/'){
 144                 return action_root($request);
 145         }
 146
 147         if($uri eq '/login'){
 148                 return action_login($request);
 149         }
 150
 151         if($uri eq '/login_icc'){
 152                 return action_login_icc($request);
 153         }
 154
 155         if($uri eq '/login_imodeid?guid=ON'){
 156                 return action_login_imodeid($request);
 157         }
 158
 159         for my $name ($pl->list_action_plugins()){
 160                 if($uri =~ m|^/(S[a-zA-Z]{10})/$name/(.*)| ||
 161                    $uri =~ m|^/(S[a-zA-Z]{10})/$name$|){
 162                         if($sm->verify({session_id => $1, user_agent => $ci->user_agent()})){
 163                                 return add_cookie($pl->{plugins}->{$name}->{action_imprementation}($request, $name, $1, $2), $1);
 164                         }
 165                         if ($ci->is_webkit() && $cf->webkit_newui()) {
 166                                 return action_error($request, 401);
 167                         } else {
 168                                 return action_redirect_root($request);
 169                         }
 170                 }
 171         }
 172
 173         return action_public($request, $uri) || action_error($request, 404);
 174 }
 175
 176 ################################################################
 177 # adds session id cookie to http response object
 178 sub add_cookie{
 179         my $response = shift;
 180         my $session_id = shift;
 181
 182         my ($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime(time + $cf->cookie_ttl());
 183         my $expiration =
 184                 sprintf('%.3s, %.2d-%.3s-%.4s %.2d:%.2d:%.2d',
 185                         qw(Sun Mon Tue Wed Thu Fri Sat)[$wday],
 186                         $mday,
 187                         qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)[$mon],
 188                         $year + 1900,
 189                         $hour,
 190                         $min,
 191                         $sec);
 192         my $content = sprintf("sid=%s; expires=%s; path=%s; \n", $session_id, $expiration, $cf->web_root());
 193         $response->push_header('Set-Cookie', $content);
 194         $response;
 195 }
 196
 197 ################################################################
 198 # 通常ログインのPOST先
 199 # パスワードをチェックして
 200 # 間違っていたら / へリンクして終わり
 201 # 合っていたらセッションを発行し /{SESSION}/index へ
 202 sub action_login{
 203         my $request = shift;
 204         my $ci = new Keitairc::ClientInfo($request);
 205         my $content = $request->decoded_content();
 206         my ($password) = ($content =~ /^password=(.*)/);
 207
 208         Keitairc::Log::log_debug("password [$password]");
 209         Keitairc::Log::log_debug("web_password [" . $cf->web_password() . "]");
 210
 211         if($cf->web_password() eq $password){
 212                 my $s = $sm->add($ci->user_agent(), $ci->serial_key());
 213                 my $view = new Keitairc::View($cf, $ci, $s->{id});
 214                 if ($ci->is_webkit() && $cf->webkit_newui()) {
 215                         return add_cookie($view->redirect('/'), $s->{id});
 216                 } else {
 217                         return $view->redirect("/$s->{id}/index");
 218                 }
 219         }
 220
 221         # password mismatch
 222         my $view = new Keitairc::View($cf, $ci);
 223         return $view->redirect('/');
 224 }
 225
 226 ################################################################
 227 sub action_error {
 228         my $request = shift;
 229         my $error_code = shift;
 230         my $ci = new Keitairc::ClientInfo($request);
 231         my $view = new Keitairc::View($cf, $ci);
 232         return $view->render('error.html', { action => $request->uri(),
 233                                              _http_status_code => $error_code,
 234                                              _http_status_message => status_message($error_code) });
 235 }
 236
 237 ################################################################
 238 sub action_public{
 239         my $request = shift;
 240         my $uri = shift;        # such as '/favicon.ico'
 241         my $ci = new Keitairc::ClientInfo($request);
 242         my $view = new Keitairc::View($cf, $ci);
 243         return $view->public($uri);
 244 }
 245
 246 ################################################################
 247 # かんたんログインのPOST先
 248 # DoCoMoだったらiccが来ているはずなので, icc + user_agent でチェック。
 249 # 合っていたらセッション復帰して /{SESSION}/index へ
 250 sub action_login_icc{
 251         my $request = shift;
 252         my $ci = new Keitairc::ClientInfo($request);
 253         if($ci->is_docomo()){
 254                 my $docomo_foma_icc = $ci->docomo_foma_icc();
 255                 if(length $docomo_foma_icc){
 256                         if(my $s = $sm->verify({serial_key => $docomo_foma_icc,
 257                                                 user_agent => $ci->user_agent()})){
 258                                 Keitairc::Log::log_debug("redirect to /$s->{id}/index from docomo_foma_icc");
 259                                 my $view = new Keitairc::View($cf, $ci, $s->{id});
 260                                 return $view->redirect("/$s->{id}/index");
 261                         }
 262
 263                         if($docomo_foma_icc eq $cf->docomo_foma_icc()){
 264                                 my $s = $sm->add($ci->user_agent(), $docomo_foma_icc);
 265                                 Keitairc::Log::log_debug("redirect to /$s->{id}/index from docomo_foma_icc");
 266                                 my $view = new Keitairc::View($cf, $ci, $s->{id});
 267                                 return $view->redirect("/$s->{id}/index");
 268                         }
 269
 270                         my $view = new Keitairc::View($cf, $ci);
 271                         return $view->render('login_icc.html', { icc => $docomo_foma_icc });
 272                 }
 273         }
 274
 275         my $view = new Keitairc::View($cf, $ci);
 276         return $view->render('root.html', {
 277                 docomo_foma_icc => $cf->docomo_foma_icc(),
 278                 docomo_imodeid => $cf->docomo_imodeid(),
 279                         });
 280 }
 281
 282 ################################################################
 283 # かんたんログインのPOST先
 284 # DoCoMoだったらiモードIDが来ているはずなので, iモードID + user_agent でチェック。
 285 # 合っていたらセッション復帰して /{SESSION}/index へ
 286 sub action_login_imodeid{
 287         my $request = shift;
 288         my $ci = new Keitairc::ClientInfo($request);
 289         if($ci->is_docomo()){
 290                 my $docomo_imodeid = $ci->docomo_imodeid();
 291                 if(length $docomo_imodeid){
 292                         if(my $s = $sm->verify({serial_key => $docomo_imodeid,
 293                                                 user_agent => $ci->user_agent()})){
 294                                 Keitairc::Log::log_debug("redirect to /$s->{id}/index from docomo_imodeid");
 295                                 my $view = new Keitairc::View($cf, $ci, $s->{id});
 296                                 return $view->redirect("/$s->{id}/index");
 297                         }
 298
 299                         if($docomo_imodeid eq $cf->docomo_imodeid()){
 300                                 my $s = $sm->add($ci->user_agent(), $docomo_imodeid);
 301                                 Keitairc::Log::log_debug("redirect to /$s->{id}/index from docomo_imodeid");
 302                                 my $view = new Keitairc::View($cf, $ci, $s->{id});
 303                                 return $view->redirect("/$s->{id}/index");
 304                         }
 305
 306                         my $view = new Keitairc::View($cf, $ci);
 307                         return $view->render('login_imodeid.html', { imodeid => $docomo_imodeid });
 308                 }
 309         }
 310
 311         my $view = new Keitairc::View($cf, $ci);
 312         return $view->render('root.html', {
 313                 docomo_foma_icc => $cf->docomo_foma_icc(),
 314                 docomo_imodeid => $cf->docomo_imodeid(),
 315                         });
 316 }
 317
 318 ################################################################
 319 sub action_root{
 320         my $request = shift;
 321         my $ci = new Keitairc::ClientInfo($request);
 322
 323         if($ci->cookie_available()){
 324                 my $session_id = $ci->{cookie}->{sid};
 325                 if(defined($session_id) && length($session_id)){
 326                         if($sm->verify({session_id => $session_id,
 327                                         user_agent => $ci->user_agent()})){
 328                                 Keitairc::Log::log_debug("redirect to /$session_id/index from cookie");
 329                                 my $view = new Keitairc::View($cf, $ci, $session_id);
 330                                 if ($ci->is_webkit() && $cf->webkit_newui()) {
 331                                         return add_cookie($view->render('root_home.html', {sid => $session_id}), $session_id);
 332                                 } else {
 333                                         return $view->redirect("/$session_id/index");
 334                                 }
 335                         }
 336                 }
 337         }
 338
 339         if($ci->is_ezweb()){
 340                 my $subscriber_id = $ci->au_subscriber_id();
 341                 if(length $subscriber_id){
 342                         if(my $s = $sm->verify({serial_key => $subscriber_id,
 343                                                 user_agent => $ci->user_agent()})){
 344                                 Keitairc::Log::log_debug("redirect to /$s->{id}/index from subscriber_id");
 345                                 my $view = new Keitairc::View($cf, $ci, $s->{id});
 346                                 return $view->redirect("/$s->{id}/index");
 347                         }
 348
 349                         if($subscriber_id eq $cf->au_subscriber_id()){
 350                                 my $s = $sm->add($ci->user_agent(), $subscriber_id);
 351                                 Keitairc::Log::log_debug("redirect to /$s->{id}/index from au_subscriber_id");
 352                                 my $view = new Keitairc::View($cf, $ci, $s->{id});
 353                                 return $view->redirect("/$s->{id}/index");
 354                         }
 355                 }
 356         }
 357
 358         if($ci->is_softbank()){
 359                 my $serial_key = $ci->softbank_serial();
 360                 if(length $serial_key){
 361                         if(my $s = $sm->verify({serial_key => $serial_key,
 362                                                 user_agent => $ci->user_agent()})){
 363                                 Keitairc::Log::log_debug("redirect to /$s->{id}/index from softbank serial_key");
 364                                 my $view = new Keitairc::View($cf, $ci, $s->{id});
 365                                 return $view->redirect("/$s->{id}/index");
 366                         }
 367                         if($serial_key eq $cf->softbank_serial_key()){
 368                                 my $s = $sm->add($ci->user_agent(), $serial_key);
 369                                 Keitairc::Log::log_debug("redirect to /$s->{id}/index from softbank_serial_key");
 370                                 my $view = new Keitairc::View($cf, $ci, $s->{id});
 371                                 return $view->redirect("/$s->{id}/index");
 372                         }
 373                 }
 374         }
 375
 376         if($ci->is_emobile()){
 377                 my $userid = $ci->emobile_userid();
 378                 if(length $userid){
 379                         if(my $s = $sm->verify({serial_key => $userid,
 380                                                 user_agent => $ci->user_agent()})){
 381                                 Keitairc::Log::log_debug("redirect to /$s->{id}/index from userid");
 382                                 my $view = new Keitairc::View($cf, $ci, $s->{id});
 383                                 return $view->redirect("/$s->{id}/index");
 384                         }
 385
 386                         if($userid eq $cf->emobile_userid()){
 387                                 my $s = $sm->add($ci->user_agent(), $userid);
 388                                 Keitairc::Log::log_debug("redirect to /$s->{id}/index from emobile_userid");
 389                                 my $view = new Keitairc::View($cf, $ci, $s->{id});
 390                                 return $view->redirect("/$s->{id}/index");
 391                         }
 392                 }
 393         }
 394
 395         my $view = new Keitairc::View($cf, $ci);
 396         return $view->render('root.html', {
 397                 docomo_foma_icc => $cf->docomo_foma_icc(),
 398                 docomo_imodeid => $cf->docomo_imodeid(),
 399                         });
 400 }
 401
 402 ################################################################
 403 sub action_redirect_root{
 404         my $request = shift;
 405         my $ci = new Keitairc::ClientInfo($request);
 406         my $view = new Keitairc::View($cf, $ci);
 407         return $view->redirect('/');
 408 }
 409
 410 ################################################################
 411 sub parse_message{
 412         my $request = shift;
 413         my $ci = new Keitairc::ClientInfo($request);
 414         my $timestamp;
 415
 416         my $message = $request->content();
 417
 418         if(length($message)){
 419                 ($message, $timestamp) = split(/&/, $message);
 420                 $timestamp =~ s/^stamp=//g;
 421
 422                 $message =~ s/^m=//;
 423                 $message =~ s/\+/ /g;
 424                 $message = uri_unescape($message);
 425                 if($ci->is_webkit()){
 426                         $message = fix_iui_escape($message);
 427                 }
 428         }
 429
 430         return ($message, $timestamp);
 431 }
 432
 433 sub send_message{
 434         my $request = shift;
 435         my $channel = shift;
 436
 437         my ($message, $timestamp) = parse_message($request);
 438
 439         if(length($message) && length($channel)){
 440                 my $jis = $message;
 441                 Encode::from_to($jis, $cf->web_charset(), $cf->irc_charset());
 442                 my $euc = Encode::decode($cf->web_charset(), $message);
 443                 if($ib->update_timestamp($timestamp)){
 444                         $irc->yield(privmsg => $channel => $jis);
 445                         my $cid = $ib->name2cid($channel);
 446                         $ib->add_message($cid, $euc, $cf->irc_nick());
 447                 }
 448         }
 449 }
 450
 451 sub send_command{
 452         my $request = shift;
 453
 454         my ($message, $timestamp) = parse_message($request);
 455
 456         if(length($message)){
 457                 Encode::from_to($message, $cf->web_charset(), $cf->irc_charset());
 458                 if($message =~ s|^/||) {
 459                         my ($params, $trailing) = split(/ :/, $message, 2);
 460                         my @postcmd = split(/ /, $params);
 461                         push @postcmd, $trailing if defined $trailing;
 462                         # This parser may be incomplete.
 463                         if($postcmd[0] =~ /join/i) {
 464                                 if($postcmd[1] =~ /^\w/) {
 465                                         $ib->join($postcmd[1]);
 466                                         return;
 467                                 }
 468                         } elsif($postcmd[0] =~ /part/i) {
 469                                 if($postcmd[1] =~ /^\w/) {
 470                                         $ib->part($ib->name2cid($postcmd[1]));
 471                                         return;
 472                                 }
 473                         }
 474                         $irc->yield(@postcmd);
 475                 }
 476         }
 477 }
 478
 479 ################################################################
 480 # posted string from iPhone/iPod touch (with iui framework)
 481 # contains escaped utf-8 in the form %uXXXX
 482 # and may contains escaped Shift-JIS (web_charset) in the form \xXX
 483 # when operated from Safari/Mac OS X
 484 sub fix_iui_escape{
 485         # charset: $cf->irc_charset()
 486         my $in = shift;
 487         $in =~ s/\\x([0-9A-F]{2})/pack('C',hex($1))/egi;
 488         my $pi = Encode::decode($cf->web_charset(), $in);
 489         $pi =~ s/%u([0-9A-F]{4})/pack('U',hex($1))/egi;
 490         return Encode::encode($cf->web_charset(), $pi);
 491 }
 492
 493 __END__