X-Git-Url: http://git.osdn.net/view?a=blobdiff_plain;f=keitairc;h=fc7afd4353b87648a0ca790b0225875ffa81b938;hb=53a72c66b77a09fc9c44543f2ba59519dc80f902;hp=d2758693545abe85c9c9f2d94bc42dceae176dc8;hpb=fb2d405f694751e682e1dd2707df23247a99cc9d;p=keitairc%2Fkeitairc.git

diff --git a/keitairc b/keitairc
index d275869..fc7afd4 100755
--- a/keitairc
+++ b/keitairc
@@ -1,535 +1,503 @@
 #!/usr/bin/perl
+# -*- mode: perl; coding: utf-8 -*-
 # keitairc
-# $Id: keitairc,v 1.28 2004-09-11 16:18:24 morimoto Exp $
 #
-# Copyright (c) 2003 Jun Morimoto <morimoto@xantia.citroen.org>
+# Copyright (c) 2003-2010 Jun Morimoto <morimoto@mrmt.net>
 # This program is covered by the GNU General Public License 2
 #
-# Depends: libjcode-pm-perl, libpoe-component-irc-perl,
-#   liburi-perl, libwww-perl, libappconfig-perl
-
-my $rcsid = q$Id: keitairc,v 1.28 2004-09-11 16:18:24 morimoto Exp $;
-my ($version) = $rcsid =~ m#,v ([0-9.]+)#;
+# Depends: libpoe-component-irc-perl,
+#   liburi-perl, libwww-perl, libappconfig-perl, libproc-daemon-perl,
+#   libhtml-template-perl
+#
+# 00location_receiver plugin use XML::Simple, so if you want to use it
+#    Depends: libxml-simple-perl
 
-use strict;
-use Jcode;
+use Encode;
 use POE;
-use POE::Component::Server::TCP;
 use POE::Filter::HTTPD;
 use POE::Component::IRC;
+use POE::Component::Server::TCP;
 use URI::Escape;
+use HTML::Template;
 use HTTP::Response;
-use AppConfig qw(:argcount);
+use HTTP::Status;
+
+use FindBin;
+use lib ("$FindBin::Bin/lib", '/usr/share/keitairc/lib');
+use Keitairc::Config;
+use Keitairc::View;
+use Keitairc::IrcBuffer;
+use Keitairc::IrcCallback;
+use Keitairc::ClientInfo;
+use Keitairc::SessionManager;
+use Keitairc::Plugins;
+use Keitairc::Log;
+use strict;
+use warnings;
+
+our $cf = new Keitairc::Config({version => '2.1a1', argv => \@ARGV});
+
+# daemonize
+if($cf->daemonize()){
+	if (eval 'require Proc::Daemon') {
+		require Proc::Daemon;
+		Proc::Daemon::Init();
+		if(length $cf->pid_dir()){
+			if (open(PID, '> ' . $cf->pid_dir() . '/' . $cf->pid_file())) {
+				print PID $$, "\n";
+				close(PID);
+			}
+		}
+		$poe_kernel->has_forked if ($poe_kernel->can('has_forked'));
+	} else {
+		warn('Proc::Daemon module is not installed, could not daemonize');
+	}
+}
 
-use constant true => 1;
-use constant false => 0;
-use constant cookie_ttl => 86400*3;  # 3 days
+our $log = new Keitairc::Log({config => $cf});
+our $ib = new Keitairc::IrcBuffer({history => $cf->web_lines()});
+our $sm = new Keitairc::SessionManager({default_ttl => $cf->session_ttl()});
+our $pl = new Keitairc::Plugins({config => $cf});
+
+# create irc component
+our $irc = POE::Component::IRC->spawn(
+	Alias => 'keitairc_irc',
+	Nick => $cf->irc_nick(),
+	Username => $cf->irc_username(),
+	Ircname => $cf->irc_desc(),
+	Server => $cf->irc_server(),
+	Port => $cf->irc_port(),
+	Password => $cf->irc_password());
+
+# create POE session
+POE::Session->create(
+	heap => {
+		seen_traffic => 0,
+		disconnect_msg => 1,
+		Config => $cf,
+		Irc => $irc,
+		IrcBuffer => $ib,
+	},
+	inline_states => {
+		_start => \&Keitairc::IrcCallback::irc_start,
+		autoping => \&Keitairc::IrcCallback::irc_autoping,
+		connect => \&Keitairc::IrcCallback::irc_connect,
+		irc_registered => \&Keitairc::IrcCallback::irc_registered,
+		irc_001 => \&Keitairc::IrcCallback::irc_001,
+		irc_join => \&Keitairc::IrcCallback::irc_join,
+		irc_part => \&Keitairc::IrcCallback::irc_part,
+		irc_quit => \&Keitairc::IrcCallback::irc_quit,
+		irc_public => \&Keitairc::IrcCallback::irc_public,
+		irc_notice => \&Keitairc::IrcCallback::irc_notice,
+		irc_mode => \&Keitairc::IrcCallback::irc_mode,
+		irc_nick => \&Keitairc::IrcCallback::irc_nick,
+		irc_msg => \&Keitairc::IrcCallback::irc_msg,
+		irc_topic => \&Keitairc::IrcCallback::irc_topic,
+		irc_332 => \&Keitairc::IrcCallback::irc_topicraw,
+		irc_352 => \&Keitairc::IrcCallback::irc_whoreply,
+		irc_ctcp_action => \&Keitairc::IrcCallback::irc_ctcp_action,
+		irc_disconnected => \&Keitairc::IrcCallback::irc_reconnect,
+		irc_error => \&Keitairc::IrcCallback::irc_reconnect,
+		irc_socketerr => \&Keitairc::IrcCallback::irc_reconnect,
+	});
+
+# create web server component
+POE::Component::Server::TCP->new(
+	Alias => 'keitairc',
+	Port => $cf->web_listen_port(),
+	ClientFilter => 'POE::Filter::HTTPD',
+	ClientInput => \&http_request);
 
-my $config = AppConfig->new(
-			    {
-				CASE => 1,
-				GLOBAL => {
-				    ARGCOUNT => ARGCOUNT_ONE,
-				}
-			    },
-			    qw(irc_nick irc_username irc_desc
-			       irc_server irc_port irc_password
-			       au_subscriber_id use_cookie
-			       web_port web_title web_lines web_root
-			       web_username web_password show_newmsgonly)
-			    );
-
-$config->file('/etc/keitairc');
-$config->file($ENV{'HOME'} . '/.keitairc');
-$config->args;
-
-my $docroot = '/';
-if(defined $config->web_root){
-    $docroot = $config->web_root;
-}
+# fire up main loop
+$poe_kernel->run();
+exit 0;
 
-# join $B$7$F$$$k%A%c%M%k$NL>>N$r5-O?$9$k%O%C%7%e(B
-my %channel_name;
+################################################################
+sub http_request{
+	my ($kernel, $heap, $request) = @_[KERNEL, HEAP, ARG0];
+
+	# Filter::HTTPD sometimes generates HTTP::Response objects.
+	# They indicate (and contain the response for) errors that occur
+	# while parsing the client's HTTP request.  It's easiest to send
+	# the responses as they are and finish up.
+	if($request->isa('HTTP::Response')){
+		$heap->{client}->put($request);
+		$log->log_error($request->as_string());
+	}elsif(my $response = dispatch($request)){
+		$heap->{client}->put($response);
+		$log->log_access($heap->{'remote_ip'}, $request, $response);
+	}
 
-# $B%A%c%M%k$N2qOCFbMF$r5-O?$9$k%O%C%7%e(B
-my (%channel_buffer, %channel_recent);
+	$kernel->yield('shutdown');
+}
 
-# $B3F%A%c%M%k$N:G=*%"%/%;%9;~9o!":G?7H/8@;~9o(B
-my %mtime;
+################################################################
+sub dispatch{
+	my $request = shift;
+	my $uri = $request->uri();
+	my $ci = new Keitairc::ClientInfo($request);
 
-# unread lines
-my %unread_lines;
+	$log->log_debug("dispatch: $uri");
 
-# chk
-my ($message_added);
+	{
+		# chop off $cf->web_root()
+		my $root = $cf->web_root();
+		$uri =~ s|$root|/|;
+	}
 
-my $user_agent;
+	if($uri eq '/'){
+		return action_root($request);
+	}
 
-# irc component
-POE::Component::IRC->new('keitairc');
-POE::Session->new(
-		  _start => \&on_irc_start,
-		  irc_join => \&on_irc_join,
-		  irc_part => \&on_irc_part,
-		  irc_public => \&on_irc_public,
-		  irc_notice => \&on_irc_notice,
-		  irc_ctcp_action => \&on_irc_ctcp_action,
-		  );
+	if($uri eq '/login'){
+		return action_login($request);
+	}
 
-# web server component
-POE::Component::Server::TCP->new(
-				 Alias => 'keitairc',
-				 Port => $config->web_port,
-				 ClientFilter => 'POE::Filter::HTTPD',
-				 ClientInput => \&on_web_request
-				 );
+	if($uri eq '/login_icc'){
+		return action_login_icc($request);
+	}
 
-$poe_kernel->run();
-exit 0;
+	if($uri eq '/login_imodeid?guid=ON'){
+		return action_login_imodeid($request);
+	}
 
-################################################################
-sub on_irc_start{
-    my $kernel = $_[KERNEL];
-    $kernel->post('keitairc' => 'register' => 'all');
-    $kernel->post('keitairc' => 'connect' => {
-	Nick => $config->irc_nick,
-	Username => $config->irc_username,
-	Ircname => $config->irc_desc,
-	Server => $config->irc_server,
-	Port => $config->irc_port,
-	Password => $config->irc_password
-    });
-}
+	for my $name ($pl->list_action_plugins()){
+		if($uri =~ m|^/(S[a-zA-Z]{10})/$name/(.*)| ||
+		   $uri =~ m|^/(S[a-zA-Z]{10})/$name$|){
+			if($sm->verify({session_id => $1, user_agent => $ci->user_agent()})){
+				return add_cookie($pl->{plugins}->{$name}->{action_imprementation}($request, $name, $1, $2), $1);
+			}
+			if ($ci->is_webkit() && $cf->webkit_newui()) {
+				return action_error($request, 401);
+			} else {
+				return action_redirect_root($request);
+			}
+		}
+	}
 
-################################################################
-sub on_irc_join{
-    my ($kernel, $who, $channel) = @_[KERNEL, ARG0, ARG1];
-    $who =~ s/!.*//;
-
-    # chop off after the gap (bug workaround of madoka)
-    $channel =~ s/ .*//;
-    my $canon_channel = &canon_name($channel);
-
-    $channel_name{$canon_channel} = $channel;
-    unless ($who eq $config->irc_nick) {
-      &add_message($channel, undef, "$who joined");
-    }
+	return action_public($request, $uri) || action_error($request, 404);
 }
 
 ################################################################
-sub on_irc_part{
-    my ($kernel, $who, $channel) = @_[KERNEL, ARG0, ARG1];
-    $who =~ s/!.*//;
-
-    # chop off after the gap (bug workaround of POE::Filter::IRC)
-    $channel =~ s/ .*//;
-    my $canon_channel = &canon_name($channel);
-
-    if ($who eq $config->irc_nick) {
-       delete $channel_name{$canon_channel};
-    } else {
-       &add_message($channel, undef, "$who leaves");
-    }
+# adds session id cookie to http response object
+sub add_cookie{
+	my $response = shift;
+	my $session_id = shift;
+
+	my ($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime(time + $cf->cookie_ttl());
+	my $expiration =
+		sprintf('%.3s, %.2d-%.3s-%.4s %.2d:%.2d:%.2d',
+			qw(Sun Mon Tue Wed Thu Fri Sat)[$wday],
+			$mday,
+			qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)[$mon],
+			$year + 1900,
+			$hour,
+			$min,
+			$sec);
+	my $content = sprintf("sid=%s; expires=%s; path=%s; \n", $session_id, $expiration, $cf->web_root());
+	$response->push_header('Set-Cookie', $content);
+	$response;
 }
 
 ################################################################
-sub on_irc_public{
-    my ($kernel, $who, $channel, $msg) = @_[KERNEL, ARG0 .. ARG2];
-    $who =~ s/!.*//;
-    $channel = $channel->[0];
-    $msg = Jcode->new($msg, 'jis')->euc;
-    &add_message($channel, $who, $msg);
-}
+# 通常ログインのPOST先
+# パスワードをチェックして
+# 間違っていたら / へリンクして終わり
+# 合っていたらセッションを発行し /{SESSION}/index へ
+sub action_login{
+	my $request = shift;
+	my $ci = new Keitairc::ClientInfo($request);
+	my $content = $request->decoded_content();
+	my ($password) = ($content =~ /^password=(.*)/);
+
+	$log->log_debug("password [$password]");
+	$log->log_debug("web_password [" . $cf->web_password() . "]");
+
+	if($cf->web_password() eq $password){
+		my $s = $sm->add($ci->user_agent(), $ci->serial_key());
+		my $view = new Keitairc::View($cf, $ci, $s->{id});
+		if ($ci->is_webkit() && $cf->webkit_newui()) {
+			return add_cookie($view->redirect('/'), $s->{id});
+		} else {
+			return $view->redirect("/$s->{id}/index");
+		}
+	}
 
-################################################################
-sub on_irc_notice{
-    my ($kernel, $who, $channel, $msg) = @_[KERNEL, ARG0 .. ARG2];
-    $who =~ s/!.*//;
-    $channel = $channel->[0];
-    $msg = Jcode->new($msg, 'jis')->euc;
-    &add_message($channel, $who, $msg);
+	# password mismatch
+	my $view = new Keitairc::View($cf, $ci);
+	return $view->redirect('/');
 }
 
 ################################################################
-sub on_irc_ctcp_action{
-    my ($kernel, $who, $channel, $msg) = @_[KERNEL, ARG0 .. ARG2];
-    $who =~ s/!.*//;
-    $channel = $channel->[0];
-    $msg = sprintf('* %s %s', $who, Jcode->new($msg, 'jis')->euc);
-    &add_message($channel, '', $msg);
+sub action_error {
+	my $request = shift;
+	my $error_code = shift;
+	my $ci = new Keitairc::ClientInfo($request);
+	my $view = new Keitairc::View($cf, $ci);
+	return $view->render('error.html', { action => $request->uri(),
+					     _http_status_code => $error_code,
+					     _http_status_message => status_message($error_code) });
 }
 
 ################################################################
-# $msg $B$O(B EUC $B$K$J$C$F$$$k$O$:(B
-# $channel $B$O(B jis $B$G$-$F$k$>(B
-sub add_message{
-    my($channel, $who, $msg) = @_;
-
-    my $message;
-    if(length $who){
-      $message = sprintf('%s %s> %s', &now, $who, $msg);
-    }else{
-      $message = sprintf('%s %s', &now, $msg);
-    }
-
-    my $canon_channel = &canon_name($channel);
-    my @tmp = split("\n", $channel_buffer{$canon_channel});
-    push @tmp, $message;
-
-    my @tmp2 = split("\n", $channel_recent{$canon_channel});
-    push @tmp2, $message;
-
-    if(@tmp > $config->web_lines){
-	$channel_buffer{$canon_channel} =
-		join("\n", splice(@tmp, -$config->web_lines));
-    }else{
-	$channel_buffer{$canon_channel} = join("\n", @tmp);
-    }
-
-    if(@tmp2 > $config->web_lines){
-	$channel_recent{$canon_channel} =
-		join("\n", @tmp2[1 .. $config->web_lines]);
-    }else{
-	$channel_recent{$canon_channel} = join("\n", @tmp2);
-    }
-
-    $mtime{$canon_channel} = time;
-
-    # unread lines
-    $unread_lines{$canon_channel} = scalar(@tmp2);
-
-    if($unread_lines{$canon_channel} > $config->web_lines){
-        $unread_lines{$canon_channel} = $config->web_lines;
-    }
+sub action_public {
+	my $request = shift;
+	my $uri = shift;	# such as '/favicon.ico'
+	my $ci = new Keitairc::ClientInfo($request);
+	my $view = new Keitairc::View($cf, $ci);
+	return $view->public($request, $uri);
 }
 
 ################################################################
-sub now{
-    my ($sec,$min,$hour) = localtime(time);
-    sprintf('%02d:%02d', $hour, $min);
-}
+# かんたんログインのPOST先
+# DoCoMoだったらiccが来ているはずなので, icc + user_agent でチェック。
+# 合っていたらセッション復帰して /{SESSION}/index へ
+sub action_login_icc{
+	my $request = shift;
+	my $ci = new Keitairc::ClientInfo($request);
+	if($ci->is_docomo()){
+		my $docomo_foma_icc = $ci->docomo_foma_icc();
+		if(length $docomo_foma_icc){
+			if(my $s = $sm->verify({serial_key => $docomo_foma_icc,
+						user_agent => $ci->user_agent()})){
+				$log->log_debug("redirect to /$s->{id}/index from docomo_foma_icc");
+				my $view = new Keitairc::View($cf, $ci, $s->{id});
+				return $view->redirect("/$s->{id}/index");
+			}
+
+			if($docomo_foma_icc eq $cf->docomo_foma_icc()){
+				my $s = $sm->add($ci->user_agent(), $docomo_foma_icc);
+				$log->log_debug("redirect to /$s->{id}/index from docomo_foma_icc");
+				my $view = new Keitairc::View($cf, $ci, $s->{id});
+				return $view->redirect("/$s->{id}/index");
+			}
+
+			my $view = new Keitairc::View($cf, $ci);
+			return $view->render('login_icc.html', { icc => $docomo_foma_icc });
+		}
+	}
 
-################################################################
-sub escape{
-    local($_) = shift;
-    s/&/&amp;/g;
-    s/>/&gt;/g;
-    s/</&lt;/g;
-    $_;
+	my $view = new Keitairc::View($cf, $ci);
+	return $view->render('root.html', {
+		docomo_foma_icc => $cf->docomo_foma_icc(),
+		docomo_imodeid => $cf->docomo_imodeid(),
+			});
 }
 
 ################################################################
-sub label{
-    my $accesskey = shift;
-
-    if($accesskey < 10){
-	sprintf('%d ', $accesskey);
-    }else{
-	'  ';
-    }
+# かんたんログインのPOST先
+# DoCoMoだったらiモードIDが来ているはずなので, iモードID + user_agent でチェック。
+# 合っていたらセッション復帰して /{SESSION}/index へ
+sub action_login_imodeid{
+	my $request = shift;
+	my $ci = new Keitairc::ClientInfo($request);
+	if($ci->is_docomo()){
+		my $docomo_imodeid = $ci->docomo_imodeid();
+		if(length $docomo_imodeid){
+			if(my $s = $sm->verify({serial_key => $docomo_imodeid,
+						user_agent => $ci->user_agent()})){
+				$log->log_debug("redirect to /$s->{id}/index from docomo_imodeid");
+				my $view = new Keitairc::View($cf, $ci, $s->{id});
+				return $view->redirect("/$s->{id}/index");
+			}
+
+			if($docomo_imodeid eq $cf->docomo_imodeid()){
+				my $s = $sm->add($ci->user_agent(), $docomo_imodeid);
+				$log->log_debug("redirect to /$s->{id}/index from docomo_imodeid");
+				my $view = new Keitairc::View($cf, $ci, $s->{id});
+				return $view->redirect("/$s->{id}/index");
+			}
+
+			my $view = new Keitairc::View($cf, $ci);
+			return $view->render('login_imodeid.html', { imodeid => $docomo_imodeid });
+		}
+	}
+
+	my $view = new Keitairc::View($cf, $ci);
+	return $view->render('root.html', {
+		docomo_foma_icc => $cf->docomo_foma_icc(),
+		docomo_imodeid => $cf->docomo_imodeid(),
+			});
 }
 
 ################################################################
-sub index_page{
-    my $buf;
-    my $accesskey = 1;
-    my $channel;
-
-    for my $canon_channel (sort {
-	$mtime{$b} <=> $mtime{$a};
-    }(keys(%channel_name))){
-	$channel = $channel_name{$canon_channel};
-
-	$buf .= &label($accesskey);
-
-	if($accesskey < 10){
-		$buf .= sprintf('<a accesskey="%1d" href="%s%s">%s</a>',
-	 			$accesskey,
-				$docroot,
-				uri_escape($channel),
-				&compact_channel_name($channel));
-	}else{
-		$buf .= sprintf('<a href="%s%s">%s</a>',
-				$docroot,
-				uri_escape($channel),
-				&compact_channel_name($channel));
+sub action_root{
+	my $request = shift;
+	my $ci = new Keitairc::ClientInfo($request);
+
+	if($ci->cookie_available()){
+		my $session_id = $ci->{cookie}->{sid};
+		if(defined($session_id) && length($session_id)){
+			if($sm->verify({session_id => $session_id,
+					user_agent => $ci->user_agent()})){
+				$log->log_debug("redirect to /$session_id/index from cookie");
+				my $view = new Keitairc::View($cf, $ci, $session_id);
+				if ($ci->is_webkit() && $cf->webkit_newui()) {
+					return add_cookie($view->render('root_home.html', {sid => $session_id}), $session_id);
+				} else {
+					return $view->redirect("/$session_id/index");
+				}
+			}
+		}
 	}
 
-	$accesskey++;
-
-	# $BL$FI9T?t(B
-	if($unread_lines{$canon_channel}){
-		$buf .= sprintf(' <a href="%s%s,recent">%s</a>',
-				$docroot,
-				uri_escape($channel),
-				$unread_lines{$canon_channel});
+	if($ci->is_ezweb()){
+		my $subscriber_id = $ci->au_subscriber_id();
+		if(length $subscriber_id){
+			if(my $s = $sm->verify({serial_key => $subscriber_id,
+						user_agent => $ci->user_agent()})){
+				$log->log_debug("redirect to /$s->{id}/index from subscriber_id");
+				my $view = new Keitairc::View($cf, $ci, $s->{id});
+				return $view->redirect("/$s->{id}/index");
+			}
+
+			if($subscriber_id eq $cf->au_subscriber_id()){
+				my $s = $sm->add($ci->user_agent(), $subscriber_id);
+				$log->log_debug("redirect to /$s->{id}/index from au_subscriber_id");
+				my $view = new Keitairc::View($cf, $ci, $s->{id});
+				return $view->redirect("/$s->{id}/index");
+			}
+		}
 	}
-	$buf .= '<br>';
-    }
 
-    $buf .= qq(0 <a href="$docroot" accesskey="0">refresh list</a><br>);
+	if($ci->is_softbank()){
+		my $serial_key = $ci->softbank_serial();
+		if(length $serial_key){
+			if(my $s = $sm->verify({serial_key => $serial_key,
+						user_agent => $ci->user_agent()})){
+				$log->log_debug("redirect to /$s->{id}/index from softbank serial_key");
+				my $view = new Keitairc::View($cf, $ci, $s->{id});
+				return $view->redirect("/$s->{id}/index");
+			}
+			if($serial_key eq $cf->softbank_serial_key()){
+				my $s = $sm->add($ci->user_agent(), $serial_key);
+				$log->log_debug("redirect to /$s->{id}/index from softbank_serial_key");
+				my $view = new Keitairc::View($cf, $ci, $s->{id});
+				return $view->redirect("/$s->{id}/index");
+			}
+		}
+	}
 
-    if(grep($unread_lines{$_}, keys %unread_lines)){
-      $buf .= qq(* <a href="$docroot,recent" accesskey="*">recent</a><br>);
-    }
+	if($ci->is_emobile()){
+		my $userid = $ci->emobile_userid();
+		if(length $userid){
+			if(my $s = $sm->verify({serial_key => $userid,
+						user_agent => $ci->user_agent()})){
+				$log->log_debug("redirect to /$s->{id}/index from userid");
+				my $view = new Keitairc::View($cf, $ci, $s->{id});
+				return $view->redirect("/$s->{id}/index");
+			}
+
+			if($userid eq $cf->emobile_userid()){
+				my $s = $sm->add($ci->user_agent(), $userid);
+				$log->log_debug("redirect to /$s->{id}/index from emobile_userid");
+				my $view = new Keitairc::View($cf, $ci, $s->{id});
+				return $view->redirect("/$s->{id}/index");
+			}
+		}
+	}
 
-    $buf .= qq( - keitairc $version);
-    $buf;
+	my $view = new Keitairc::View($cf, $ci);
+	return $view->render('root.html', {
+		docomo_foma_icc => $cf->docomo_foma_icc(),
+		docomo_imodeid => $cf->docomo_imodeid(),
+			});
 }
 
 ################################################################
-# $B%A%c%M%kL>>N$rC;$+$/$9$k(B
-sub compact_channel_name{
-    local($_) = shift;
-
-    # #name:*.jp $B$r(B %name $B$K(B
-    if(s/:\*\.jp$//){
-	s/^#/%/;
-    }
-
-    # $BKvHx$NC1FH$N(B @ $B$O<h$k(B (for multicast.plm)
-    s/\@$//;
-
-    $_;
+sub action_redirect_root{
+	my $request = shift;
+	my $ci = new Keitairc::ClientInfo($request);
+	my $view = new Keitairc::View($cf, $ci);
+	return $view->redirect('/');
 }
 
 ################################################################
-sub canon_name{
-    local($_) = shift;
+sub parse_message{
+	my $request = shift;
+	my $ci = new Keitairc::ClientInfo($request);
+	my $timestamp;
 
-    tr/A-Z[\\]^/a-z{|}~/;
+	my $message = $request->content();
 
-    $_;
-}
-
-################################################################
-sub render{
-    local($_);
-    my @buf;
-
-    my @src = (reverse(split("\n", shift)))[0 .. $config->web_lines];
+	if(length($message)){
+		($message, $timestamp) = split(/&/, $message);
 
-    for (@src){
-	next unless defined;
-	next unless length;
+		$timestamp =~ s/^stamp=//g;
 
-	$_ = &escape($_);
+		$message =~ s/^m=//;
+		$message =~ s/\+/ /g;
+		$message = uri_unescape($message);
 
-	unless(s,\b(https?://[!-;=-\177]+)\b,<a href="$1">$1</a>,g){
-	    unless(s|\b(www\.[!-\177]+)\b|<a href="http://$1">$1</a>|g){
-		# phone to
-		unless(s|\b(0\d{1,3})([-(]?)(\d{2,4})([-)]?)(\d{4})\b|<a href="tel:$1$3$5">$1$2$3$4$5</a>|g){
-		    s|\b(\w[\w.+=-]+\@[\w.-]+[\w]\.[\w]{2,4})\b|<a href="mailto:$1">$1</a>|g;
+		if($ci->is_webkit() && !$cf->webkit_newui()){
+			$message = fix_webkit_escape($message);
 		}
-	    }
 	}
+	if ($cf->webkit_newui()) {
+		# ajax で投げ込んでるので utf8 できます
+		$message = Encode::decode('utf8', $message);
+	} else {
+		$message = Encode::decode($cf->web_charset(), $message);
+	}
+	return ($message, $timestamp);
+}
 
-	s/\s+$//;
-	s/\s+/ /g;
-	push @buf, $_;
-    }
+sub send_message{
+	my $request = shift;
+	my $channel = shift;
 
-    '<pre>' . join("\n", @buf) . '</pre>';
-}
+	my ($message, $timestamp) = parse_message($request);
 
-################################################################
-sub on_web_request{
-    my ($kernel, $heap, $request) = @_[KERNEL, HEAP, ARG0];
-
-    # Filter::HTTPD sometimes generates HTTP::Response objects.
-    # They indicate (and contain the response for) errors that occur
-    # while parsing the client's HTTP request.  It's easiest to send
-    # the responses as they are and finish up.
-    if($request->isa('HTTP::Response')){
-	$heap->{client}->put($request);
-	$kernel->yield('shutdown');
-	return;
-    }
-
-    # cookie
-    my $cookie_authorized;
-    if($config->use_cookie){
-      my %cookie;
-      for(split(/; */, $request->header('Cookie'))){
-	my ($name, $value) = split(/=/);
-	$value =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('C', hex($1))/eg;
-        $cookie{$name} = $value;
-      }
-
-      if($cookie{username} eq $config->web_username &&
-	 $cookie{passwd} eq $config->web_password){
-	$cookie_authorized = true;
-      }
-    }
-
-    # authorization
-    unless($cookie_authorized){
-      unless(defined($config->au_subscriber_id) &&
-	     $request->header('x-up-subno') eq $config->au_subscriber_id){
-	if(defined($config->web_username)){
-	  unless($request->headers->authorization_basic eq
-		 $config->web_username . ':' . $config->web_password){
-	    my $response = HTTP::Response->new(401);
-	    $response->push_header(WWW_Authenticate =>
-				   qq(Basic Realm="keitairc"));
-	    $heap->{client}->put($response);
-	    $kernel->yield('shutdown');
-	    return;
-	  }
+	if(length($message) && length($channel)){
+		if($ib->update_timestamp($timestamp)){
+			my $enc_message = Encode::encode($cf->irc_charset(), $message);
+			my $enc_channel = Encode::encode($cf->irc_charset(), $channel);
+			$irc->yield(privmsg => $enc_channel => $enc_message);
+			my $cid = $ib->name2cid($channel);
+			$ib->add_message($cid, $message, $cf->irc_nick());
+		}
 	}
-      }
-    }
+}
 
-    my $uri = $request->uri;
-    my $content = '<html><head>';
-    $content .= '<meta http-equiv="Cache-Control" content="max-age=0" />';
+sub send_command{
+	my $request = shift;
 
-    # POST $B$5$l$F$-$?$b$N$OH/8@(B
-    if($request->method =~ /POST/i){
-	my $message = $request->content;
-	$message =~ s/^m=//;
-	$message =~ s/\+/ /g;
-	$message = uri_unescape($message);
+	my ($message, $timestamp) = parse_message($request);
 
 	if(length($message)){
-	    $uri =~ s|^/||;
-	    my $channel = uri_unescape($uri);
-	    $poe_kernel->post('keitairc',
-			      'privmsg',
-			      Jcode->new($channel)->jis,
-			      Jcode->new($message)->jis);
-	    &add_message($channel, $config->irc_nick,
-			 Jcode->new($message)->euc);
-	    $message_added = true;
-	}
-    }
-
-    # store and remove attached options from uri
-    my %option;
-    {
-      my @opts = split(',', $uri);
-      shift @opts;
-      grep($option{$_} = $_, @opts);
-      $uri =~ s/,.*//;
-    }
-
-    if($uri eq '/'){
-      $content .= '<title>' . $config->web_title . '</title>';
-      $content .= '</head>';
-      $content .= '<body>';
-
-      if($option{recent}){
-        # recent messages on every channel
-	for my $canon_channel (sort keys %channel_name){
-	  my $channel = $channel_name{$canon_channel};
-	  if(length($channel) &&
-	     length($channel_recent{$canon_channel})){
-	    $content .= '<b>' . Jcode->new($channel_name{$canon_channel})->euc . '</b>';
-	    $content .= sprintf(' <a href="%s%s">more..</a><br>',
-				$docroot, uri_escape($channel));
-	    $content .= &render($channel_recent{$canon_channel});
-	    $unread_lines{$canon_channel} = 0;
-	    $channel_recent{$canon_channel} = '';
-	    $content .= '<hr>';
-	  }
-	}
-        $content .= qq(<a accesskey="8" href="$docroot">ch list[8]</a>);
-      }else{
-        # channel list
-	$content .= &index_page;
-      }
-    }else{
-        # channel conversation
-	$uri =~ s|^/||;
-
-	# RFC 2811:
-	# Apart from the the requirement that the first character
-	# being either '&', '#', '+' or '!' (hereafter called "channel
-	# prefix"). The only restriction on a channel name is that it
-	# SHALL NOT contain any spaces (' '), a control G (^G or ASCII
-	# 7), a comma (',' which is used as a list item separator by
-	# the protocol).  Also, a colon (':') is used as a delimiter
-	# for the channel mask.  The exact syntax of a channel name is
-	# defined in "IRC Server Protocol" [IRC-SERVER].
-	#
-	# so we use white space as separator character of channel name
-	# and command argument.
-
-	my $channel = uri_unescape($uri);
-
-	$content .= '<title>' . $config->web_title . ": $channel</title>";
-	$content .= '</head>';
-	$content .= '<body>';
-
-	$content .= '<a name="1"></a>';
-	$content .= '<a accesskey="7" href="#1"></a>';
-
-	$content .= sprintf('<form action="%s%s" method="post">',
-			    $docroot, uri_escape($channel));
-	$content .= '<input type="text" name="m" size="10">';
-	$content .= '<input type="submit" accesskey="1" value="OK[1]">';
-        $content .= qq(<a accesskey="8" href="$docroot">ch list[8]</a><br>);
-	$content .= '</form>';
-
-	my $canon_channel = &canon_name($channel);
-	if(defined($channel_name{$canon_channel})){
-	    if(defined($channel_buffer{$canon_channel}) &&
-	       length($channel_buffer{$canon_channel})){
-		$content .= '<a accesskey="9" href="#2"></a>';
-		if($option{recent} ||
-		   (defined($config->show_newmsgonly) && $message_added)){
-		  $content .= &render($channel_recent{$canon_channel});
-		  $content .= sprintf('<a accesskey="5" href="%s%s">more[5]</a>',
-				      $docroot, uri_escape($channel));
-		} else {
-		  $content .= &render($channel_buffer{$canon_channel});
+		if($message =~ s|^/||) {
+			my ($params, $trailing) = split(/ :/, $message, 2);
+			my @postcmd = split(/ /, $params);
+			push @postcmd, $trailing if defined $trailing;
+			# This parser may be incomplete.
+			if($postcmd[0] =~ /join/i) {
+				if($postcmd[1] =~ /^\w/) {
+					$ib->join($postcmd[1]);
+					return;
+				}
+			} elsif($postcmd[0] =~ /part/i) {
+				if($postcmd[1] =~ /^\w/) {
+					$ib->part($ib->name2cid($postcmd[1]));
+					return;
+				}
+			}
+			$irc->yield(map { Encode::encode($cf->irc_charset(), $_) } @postcmd);
 		}
-		$content .= '<a name="2"></a>';
-	    }else{
-		$content .= 'no message here yet';
-	    }
-	}else{
-	    $content .= 'no such channel';
 	}
+}
 
-	# clear check flags
-	$message_added = false;
-
-	# clear unread counter
-        $unread_lines{$canon_channel} = 0;
-
-	# clear recent messages buffer
-	$channel_recent{$canon_channel} = '';
-    }
-
-    $content .= '</body></html>';
-
-    my $response = HTTP::Response->new(200);
-
-    if($config->use_cookie){
-      my ($sec, $min, $hour, $mday, $mon, $year, $wday) =
-	localtime(time + cookie_ttl);
-      my $expiration =
-	sprintf('%.3s, %.2d-%.3s-%.4s %.2d:%.2d:%.2d',
-		qw(Sun Mon Tue Wed Thu Fri Sat)[$wday],
-		$mday,
-		qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)[$mon],
-		$year + 1900,
-		$hour,
-		$min,
-		$sec);
-      $response->push_header('Set-Cookie',
-			     sprintf("username=%s; expires=%s; \n",
-				     $config->web_username, $expiration));
-      $response->push_header('Set-Cookie',
-			     sprintf("passwd=%s; expires=%s; \n",
-				     $config->web_password, $expiration));
-    }
-
-    $response->push_header('Content-type', 'text/html; charset=Shift_JIS');
-    $response->content(Jcode->new($content)->sjis);
-    $heap->{client}->put($response);
-    $kernel->yield('shutdown');
+################################################################
+# posted string from Webkit browser
+# contains escaped utf-8 in the form %uXXXX
+# and may contains escaped Shift-JIS (web_charset) in the form \xXX
+# when operated from Safari/Mac OS X
+sub fix_webkit_escape{
+	# charset: $cf->irc_charset()
+	my $in = shift;
+	$in =~ s/\\x([0-9A-F]{2})/pack('C',hex($1))/egi;
+	#my $pi = Encode::decode('utf8', $in);
+	$in =~ s/%u([0-9A-F]{4})/pack('U',hex($1))/egi;
+	return $in;
 }
 
 __END__