#!/usr/bin/perl
# -*- mode: perl; coding: utf-8 -*-
# keitairc
-# $Id: keitairc,v 1.59 2008-06-29 09:20:49 morimoto Exp $
+# $Id: keitairc,v 1.73 2009-01-02 16:40:03 nyan_ Exp $
# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/keitairc,v $
#
# Copyright (c) 2003-2008 Jun Morimoto <morimoto@mrmt.net>
# 00location_receiver plugin use XML::Simple, so if you want to use it
# Depends: libxml-simple-perl
-use lib qw(lib /usr/share/keitairc/lib);
use Encode;
use POE;
use POE::Filter::HTTPD;
use URI::Escape;
use HTML::Template;
use HTTP::Response;
+
+use FindBin;
+use lib ("$FindBin::Bin/lib", '/usr/share/keitairc/lib');
use Keitairc::Config;
use Keitairc::View;
use Keitairc::IrcBuffer;
use Keitairc::ClientInfo;
use Keitairc::SessionManager;
use Keitairc::Plugins;
+use Keitairc::Log;
use strict;
use warnings;
-our $cf = new Keitairc::Config('2.0b6', @ARGV);
+our $cf = new Keitairc::Config({version => '2.0b11', argv => \@ARGV});
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 web server component
POE::Component::Server::TCP->new(
Alias => 'keitairc',
- Port => $cf->web_port(),
+ Port => $cf->web_listen_port(),
ClientFilter => 'POE::Filter::HTTPD',
ClientInput => \&http_request);
my $uri = $request->uri();
my $ci = new Keitairc::ClientInfo($request);
- ::log_debug("dispatch: $uri");
+ Keitairc::Log::log_debug("dispatch: $uri");
{
# chop off $cf->web_root()
return action_login_imodeid($request);
}
- if($uri eq '/robots.txt'){
- return action_robots_txt($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$|){
}
}
- ::log("dispatch: don't know how to dispatch uri[$uri]");
- return action_404($request);
+ return action_public($request, $uri) || action_404($request);
}
################################################################
$hour,
$min,
$sec);
- my $content = sprintf("sid=%s; expires=%s; \n", $session_id, $expiration);
+ my $content = sprintf("sid=%s; expires=%s; path=%s; \n", $session_id, $expiration, $cf->web_root());
$response->push_header('Set-Cookie', $content);
$response;
}
my $content = $request->decoded_content();
my ($password) = ($content =~ /^password=(.*)/);
- ::log_debug("password [$password]");
- ::log_debug("web_password [" . $cf->web_password() . "]");
+ Keitairc::Log::log_debug("password [$password]");
+ Keitairc::Log::log_debug("web_password [" . $cf->web_password() . "]");
if($cf->web_password() eq $password){
- my $s = $sm->add($ci->{header}->{user_agent}, $ci->serial_key());
+ my $s = $sm->add($ci->user_agent(), $ci->serial_key());
my $view = new Keitairc::View($cf, $ci, $s->{id});
return $view->redirect("/$s->{id}/index");
}
}
################################################################
-sub action_robots_txt{
+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->render('robots.txt', { content_type => 'text/plain' });
+ return $view->public($uri);
}
################################################################
if(length $docomo_foma_icc){
if(my $s = $sm->verify({serial_key => $docomo_foma_icc,
user_agent => $ci->user_agent()})){
- ::log_debug("redirect to /$s->{id}/index from docomo_foma_icc");
+ Keitairc::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_debug("redirect to /$s->{id}/index from docomo_foma_icc");
+ Keitairc::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 $request = shift;
my $ci = new Keitairc::ClientInfo($request);
if($ci->is_docomo()){
- my $docomo_imodeid = $ci->{header}->{x_dcmguid};
+ 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_debug("redirect to /$s->{id}/index from docomo_imodeid");
+ Keitairc::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_debug("redirect to /$s->{id}/index from docomo_imodeid");
+ Keitairc::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(defined($session_id) && length($session_id)){
if($sm->verify({session_id => $session_id,
user_agent => $ci->user_agent()})){
- ::log_debug("redirect to /$session_id/index from cookie");
+ Keitairc::Log::log_debug("redirect to /$session_id/index from cookie");
my $view = new Keitairc::View($cf, $ci, $session_id);
return $view->redirect("/$session_id/index");
}
}
if($ci->is_ezweb()){
- my $subscriber_id = $ci->{header}->{x_up_subno};
+ 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_debug("redirect to /$s->{id}/index from subscriber_id");
+ Keitairc::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_debug("redirect to /$s->{id}/index from au_subscriber_id");
+ Keitairc::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(length $serial_key){
if(my $s = $sm->verify({serial_key => $serial_key,
user_agent => $ci->user_agent()})){
- ::log_debug("redirect to /$s->{id}/index from softbank serial_key");
+ Keitairc::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_debug("redirect to /$s->{id}/index from softbank_serial_key");
+ Keitairc::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->{header}->{x_em_uid};
+ my $userid = $ci->emobile_userid();
if(length $userid){
if(my $s = $sm->verify({serial_key => $userid,
user_agent => $ci->user_agent()})){
- ::log_debug("redirect to /$s->{id}/index from userid");
+ Keitairc::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_debug("redirect to /$s->{id}/index from emobile_userid");
+ Keitairc::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");
}
sub send_message{
my $request = shift;
my $channel = 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(length($message)){
+ $message = uri_unescape($message);
+ if($ci->is_ipod()){
+ $message = fix_iui_escape($message);
+ }
+ }
if(length($message)){
my $jis = $message;
}
$irc->yield(@postcmd);
} elsif(length($channel)){
- $irc->yield(privmsg => $channel => $jis);
- my $cid = $ib->name2cid($channel);
- $ib->add_message($cid, $euc, $cf->irc_nick());
- $ib->message_added(1);
- }
- }
-}
-
-################################################################
-# 入力 charset は perl internal
-sub render_line{
- my ($in, $session_id, $reverse) = @_;
- my @message;
- my $buf;
- local($_);
-
- @message = (split("\n", $in))[0 .. $cf->web_lines()];
- if ($reverse) {
- @message = reverse(@message);
- }
- for (@message){
- next unless defined;
- next unless length;
-
- $_ = $ib->simple_escape($_);
- $_ = $ib->colorize($_);
-
- for my $name ($pl->list_replace_plugins()){
- last if s/$pl->{plugins}->{$name}->{message_replace_regexp}/$pl->{plugins}->{$name}->{message_replace_imprementation}($session_id, $1, $2, $3, $4, $5, $6, $7, $8, $9)/eg;
+ if($ib->update_timestamp($timestamp)){
+ $irc->yield(privmsg => $channel => $jis);
+ my $cid = $ib->name2cid($channel);
+ $ib->add_message($cid, $euc, $cf->irc_nick());
+ }
}
- s/\s+$//;
- s/\s+/ /g;
- $buf .= "$_<br />";
}
- # Encode::from_to($buf, 'euc-jp', $cf->web_charset());
- return Encode::encode($cf->web_charset(), $buf);
}
################################################################
-sub log{
- my $m = shift;
- warn "keitairc: $m\n";
-}
-
-sub log_die{
- my $m = shift;
- die "keitairc: $m\n";
-}
-
-sub log_debug{
- my $m = shift;
- if($cf->debug()){
- warn "keitairc(debug): $m\n";
- }
+# posted string from iPhone/iPod touch (with iui framework)
+# 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_iui_escape{
+ # charset: $cf->irc_charset()
+ my $in = shift;
+ $in =~ s/\\x([0-9A-F]{2})/pack('C',hex($1))/egi;
+ my $pi = Encode::decode($cf->web_charset(), $in);
+ $pi =~ s/%u([0-9A-F]{4})/pack('U',hex($1))/egi;
+ return Encode::encode($cf->web_charset(), $pi);
}
__END__