keitairc

   1 #!/usr/bin/perl
   2 # -*- mode: perl; coding: utf-8 -*-
   3 # keitairc
   4 #
   5 # Copyright (c) 2003-2010 Jun Morimoto <morimoto@mrmt.net>
   6 # This program is covered by the GNU General Public License 2
   7 #
   8 # Depends: libpoe-component-irc-perl,
   9 #   liburi-perl, libwww-perl, libappconfig-perl, libproc-daemon-perl,
  10 #   libhtml-template-perl
  11 #
  12 # 00location_receiver plugin use XML::Simple, so if you want to use it
  13 #    Depends: libxml-simple-perl
  14
  15 use Encode;
  16 use POE;
  17 use POE::Filter::HTTPD;
  18 use POE::Component::IRC;
  19 use POE::Component::Server::TCP;
  20 use URI::Escape;
  21 use HTML::Template;
  22 use HTTP::Response;
  23 use HTTP::Status;
  24
  25 use FindBin;
  26 use lib ("$FindBin::Bin/lib", '/usr/share/keitairc/lib');
  27 use Keitairc::Config;
  28 use Keitairc::View;
  29 use Keitairc::IrcBuffer;
  30 use Keitairc::IrcCallback;
  31 use Keitairc::ClientInfo;
  32 use Keitairc::SessionManager;
  33 use Keitairc::Plugins;
  34 use Keitairc::Log;
  35 use strict;
  36 use warnings;
  37
  38 our $cf = new Keitairc::Config({version => '2.1a1', argv => \@ARGV});
  39
  40 # daemonize
  41 if($cf->daemonize()){
  42         if (eval 'require Proc::Daemon') {
  43                 require Proc::Daemon;
  44                 Proc::Daemon::Init();
  45                 if(length $cf->pid_dir()){
  46                         if (open(PID, '> ' . $cf->pid_dir() . '/' . $cf->pid_file())) {
  47                                 print PID $$, "\n";
  48                                 close(PID);
  49                         }
  50                 }
  51                 $poe_kernel->has_forked if ($poe_kernel->can('has_forked'));
  52         } else {
  53                 warn('Proc::Daemon module is not installed, could not daemonize');
  54         }
  55 }
  56
  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});
  61
  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());
  71
  72 # create POE session
  73 POE::Session->create(
  74         heap => {
  75                 seen_traffic => 0,
  76                 disconnect_msg => 1,
  77                 Config => $cf,
  78                 Irc => $irc,
  79                 IrcBuffer => $ib,
  80         },
  81         inline_states => {
  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,
 102         });
 103
 104 # create web server component
 105 POE::Component::Server::TCP->new(
 106         Alias => 'keitairc',
 107         Port => $cf->web_listen_port(),
 108         ClientFilter => 'POE::Filter::HTTPD',
 109         ClientInput => \&http_request);
 110
 111 # fire up main loop
 112 $poe_kernel->run();
 113 exit 0;
 114
 115 ################################################################
 116 sub http_request{
 117         my ($kernel, $heap, $request) = @_[KERNEL, HEAP, ARG0];
 118
 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);
 129         }
 130
 131         $kernel->yield('shutdown');
 132 }
 133
 134 ################################################################
 135 sub dispatch{
 136         my $request = shift;
 137         my $uri = $request->uri();
 138         my $ci = new Keitairc::ClientInfo($request);
 139
 140         $log->log_debug("dispatch: $uri");
 141
 142         {
 143                 # chop off $cf->web_root()
 144                 my $root = $cf->web_root();
 145                 $uri =~ s|$root|/|;
 146         }
 147
 148         if($uri eq '/'){
 149                 return action_root($request);
 150         }
 151
 152         if($uri eq '/login'){
 153                 return action_login($request);
 154         }
 155
 156         if($uri eq '/login_icc'){
 157                 return action_login_icc($request);
 158         }
 159
 160         if($uri eq '/login_imodeid?guid=ON'){
 161                 return action_login_imodeid($request);
 162         }
 163
 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);
 169                         }
 170                         if ($ci->is_webkit() && $cf->webkit_newui()) {
 171                                 return action_error($request, 401);
 172                         } else {
 173                                 return action_redirect_root($request);
 174                         }
 175                 }
 176         }
 177
 178         return action_public($request, $uri) || action_error($request, 404);
 179 }
 180
 181 ################################################################
 182 # adds session id cookie to http response object
 183 sub add_cookie{
 184         my $response = shift;
 185         my $session_id = shift;
 186
 187         my ($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime(time + $cf->cookie_ttl());
 188         my $expiration =
 189                 sprintf('%.3s, %.2d-%.3s-%.4s %.2d:%.2d:%.2d',
 190                         qw(Sun Mon Tue Wed Thu Fri Sat)[$wday],
 191                         $mday,
 192                         qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)[$mon],
 193                         $year + 1900,
 194                         $hour,
 195                         $min,
 196                         $sec);
 197         my $content = sprintf("sid=%s; expires=%s; path=%s; \n", $session_id, $expiration, $cf->web_root());
 198         $response->push_header('Set-Cookie', $content);
 199         $response;
 200 }
 201
 202 ################################################################
 203 # 通常ログインのPOST先
 204 # パスワードをチェックして
 205 # 間違っていたら / へリンクして終わり
 206 # 合っていたらセッションを発行し /{SESSION}/index へ
 207 sub action_login{
 208         my $request = shift;
 209         my $ci = new Keitairc::ClientInfo($request);
 210         my $content = $request->decoded_content();
 211         my ($password) = ($content =~ /^password=(.*)/);
 212
 213         $log->log_debug("password [$password]");
 214         $log->log_debug("web_password [" . $cf->web_password() . "]");
 215
 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});
 221                 } else {
 222                         return $view->redirect("/$s->{id}/index");
 223                 }
 224         }
 225
 226         # password mismatch
 227         my $view = new Keitairc::View($cf, $ci);
 228         return $view->redirect('/');
 229 }
 230
 231 ################################################################
 232 sub action_error {
 233         my $request = shift;
 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) });
 240 }
 241
 242 ################################################################
 243 sub action_public {
 244         my $request = shift;
 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($request, $uri);
 249 }
 250
 251 ################################################################
 252 # かんたんログインのPOST先
 253 # DoCoMoだったらiccが来ているはずなので, icc + user_agent でチェック。
 254 # 合っていたらセッション復帰して /{SESSION}/index へ
 255 sub action_login_icc{
 256         my $request = shift;
 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");
 266                         }
 267
 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");
 273                         }
 274
 275                         my $view = new Keitairc::View($cf, $ci);
 276                         return $view->render('login_icc.html', { icc => $docomo_foma_icc });
 277                 }
 278         }
 279
 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(),
 284                         });
 285 }
 286
 287 ################################################################
 288 # かんたんログインのPOST先
 289 # DoCoMoだったらiモードIDが来ているはずなので, iモードID + user_agent でチェック。
 290 # 合っていたらセッション復帰して /{SESSION}/index へ
 291 sub action_login_imodeid{
 292         my $request = shift;
 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");
 302                         }
 303
 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");
 309                         }
 310
 311                         my $view = new Keitairc::View($cf, $ci);
 312                         return $view->render('login_imodeid.html', { imodeid => $docomo_imodeid });
 313                 }
 314         }
 315
 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(),
 320                         });
 321 }
 322
 323 ################################################################
 324 sub action_root{
 325         my $request = shift;
 326         my $ci = new Keitairc::ClientInfo($request);
 327
 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);
 337                                 } else {
 338                                         return $view->redirect("/$session_id/index");
 339                                 }
 340                         }
 341                 }
 342         }
 343
 344         if($ci->is_ezweb()){
 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");
 352                         }
 353
 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");
 359                         }
 360                 }
 361         }
 362
 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");
 371                         }
 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");
 377                         }
 378                 }
 379         }
 380
 381         if($ci->is_emobile()){
 382                 my $userid = $ci->emobile_userid();
 383                 if(length $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");
 389                         }
 390
 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");
 396                         }
 397                 }
 398         }
 399
 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(),
 404                         });
 405 }
 406
 407 ################################################################
 408 sub action_redirect_root{
 409         my $request = shift;
 410         my $ci = new Keitairc::ClientInfo($request);
 411         my $view = new Keitairc::View($cf, $ci);
 412         return $view->redirect('/');
 413 }
 414
 415 ################################################################
 416 sub parse_message{
 417         my $request = shift;
 418         my $ci = new Keitairc::ClientInfo($request);
 419         my $timestamp;
 420
 421         my $message = $request->content();
 422
 423         if(length($message)){
 424                 ($message, $timestamp) = split(/&/, $message);
 425
 426                 $timestamp =~ s/^stamp=//g;
 427
 428                 $message =~ s/^m=//;
 429                 $message =~ s/\+/ /g;
 430                 $message = uri_unescape($message);
 431
 432                 if($ci->is_webkit() && !$cf->webkit_newui()){
 433                         $message = fix_webkit_escape($message);
 434                 }
 435         }
 436         if ($cf->webkit_newui()) {
 437                 # ajax で投げ込んでるので utf8 できます
 438                 $message = Encode::decode('utf8', $message);
 439         } else {
 440                 $message = Encode::decode($cf->web_charset(), $message);
 441         }
 442         return ($message, $timestamp);
 443 }
 444
 445 sub send_message{
 446         my $request = shift;
 447         my $channel = shift;
 448
 449         my ($message, $timestamp) = parse_message($request);
 450
 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());
 458                 }
 459         }
 460 }
 461
 462 sub send_command{
 463         my $request = shift;
 464
 465         my ($message, $timestamp) = parse_message($request);
 466
 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]);
 476                                         return;
 477                                 }
 478                         } elsif($postcmd[0] =~ /part/i) {
 479                                 if($postcmd[1] =~ /^\w/) {
 480                                         $ib->part($ib->name2cid($postcmd[1]));
 481                                         return;
 482                                 }
 483                         }
 484                         $irc->yield(map { Encode::encode($cf->irc_charset(), $_) } @postcmd);
 485                 }
 486         }
 487 }
 488
 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()
 496         my $in = shift;
 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;
 500         return $in;
 501 }
 502
 503 __END__