#!/usr/bin/perl
# -*- mode: perl; coding: utf-8 -*-
# keitairc
#
# Copyright (c) 2003-2010 Jun Morimoto <morimoto@mrmt.net>
# This program is covered by the GNU General Public License 2
#
# 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 Encode;
use POE;
use POE::Filter::HTTPD;
use POE::Component::IRC;
use POE::Component::Server::TCP;
use URI::Escape;
use HTML::Template;
use HTTP::Response;
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');
	}
}

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);

# fire up main loop
$poe_kernel->run();
exit 0;

################################################################
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);
	}

	$kernel->yield('shutdown');
}

################################################################
sub dispatch{
	my $request = shift;
	my $uri = $request->uri();
	my $ci = new Keitairc::ClientInfo($request);

	$log->log_debug("dispatch: $uri");

	{
		# chop off $cf->web_root()
		my $root = $cf->web_root();
		$uri =~ s|$root|/|;
	}

	if($uri eq '/'){
		return action_root($request);
	}

	if($uri eq '/login'){
		return action_login($request);
	}

	if($uri eq '/login_icc'){
		return action_login_icc($request);
	}

	if($uri eq '/login_imodeid?guid=ON'){
		return action_login_imodeid($request);
	}

	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);
			}
		}
	}

	return action_public($request, $uri) || action_error($request, 404);
}

################################################################
# 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;
}

################################################################
# 通常ログインの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");
		}
	}

	# password mismatch
	my $view = new Keitairc::View($cf, $ci);
	return $view->redirect('/');
}

################################################################
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) });
}

################################################################
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);
}

################################################################
# かんたんログインの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 });
		}
	}

	my $view = new Keitairc::View($cf, $ci);
	return $view->render('root.html', {
		docomo_foma_icc => $cf->docomo_foma_icc(),
		docomo_imodeid => $cf->docomo_imodeid(),
			});
}

################################################################
# かんたんログインの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 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");
				}
			}
		}
	}

	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");
			}
		}
	}

	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($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");
			}
		}
	}

	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 action_redirect_root{
	my $request = shift;
	my $ci = new Keitairc::ClientInfo($request);
	my $view = new Keitairc::View($cf, $ci);
	return $view->redirect('/');
}

################################################################
sub parse_message{
	my $request = shift;
	my $ci = new Keitairc::ClientInfo($request);
	my $timestamp;

	my $message = $request->content();

	if(length($message)){
		($message, $timestamp) = split(/&/, $message);

		$timestamp =~ s/^stamp=//g;

		$message =~ s/^m=//;
		$message =~ s/\+/ /g;
		$message = uri_unescape($message);

		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);
}

sub send_message{
	my $request = shift;
	my $channel = shift;

	my ($message, $timestamp) = parse_message($request);

	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());
		}
	}
}

sub send_command{
	my $request = shift;

	my ($message, $timestamp) = parse_message($request);

	if(length($message)){
		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);
		}
	}
}

################################################################
# 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__