keitairc

   1 #!/usr/bin/perl
   2 # keitairc
   3 # $Id: keitairc,v 1.34 2008-01-08 05:52:14 morimoto Exp $
   4 # $Source: /home/ishikawa/work/keitairc/tmp/keitairc/keitairc,v $
   5 #
   6 # Copyright (c) 2003-2008 Jun Morimoto <morimoto@mrmt.net>
   7 # This program is covered by the GNU General Public License 2
   8 #
   9 # Depends: libpoe-component-irc-perl,
  10 #   liburi-perl, libwww-perl, libappconfig-perl, libproc-daemon-perl,
  11 #   libhtml-template-perl
  12
  13 use lib qw(lib /usr/share/keitairc/lib);
  14 use strict;
  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 Proc::Daemon;
  24 use Keitairc::Config;
  25 use Keitairc::View;
  26 use Keitairc::ClientInfo;
  27 use Keitairc::IrcBuffer;
  28 use Keitairc::IrcCallback;
  29 use Keitairc::SessionManager;
  30
  31 our $cf = new Keitairc::Config('2.0b1', @ARGV);
  32 our $ib = new Keitairc::IrcBuffer({history => $cf->web_lines()});
  33 our $sm = new Keitairc::SessionManager({default_ttl => $cf->session_ttl()});
  34
  35 # daemonize
  36 if($cf->daemonize()){
  37         Proc::Daemon::Init;
  38         if(length $cf->pid_dir()){
  39                 if (open(PID, '> ' . $cf->pid_dir() . '/keitairc.pid')) {
  40                         print PID $$, "\n";
  41                         close(PID);
  42                 }
  43         }
  44 }
  45
  46 # create irc component
  47 our $irc = POE::Component::IRC->spawn(
  48         Alias => 'keitairc_irc',
  49         Nick => $cf->irc_nick(),
  50         Username => $cf->irc_username(),
  51         Ircname => $cf->irc_desc(),
  52         Server => $cf->irc_server(),
  53         Port => $cf->irc_port(),
  54         Password => $cf->irc_password());
  55
  56 # create POE session
  57 POE::Session->create(
  58         heap => {
  59                 seen_traffic => 0,
  60                 disconnect_msg => 1,
  61                 Config => $cf,
  62                 Irc => $irc,
  63                 IrcBuffer => $ib,
  64         },
  65         inline_states => {
  66                 _start => \&Keitairc::IrcCallback::irc_start,
  67                 autoping => \&Keitairc::IrcCallback::irc_autoping,
  68                 connect => \&Keitairc::IrcCallback::irc_connect,
  69                 irc_001 => \&Keitairc::IrcCallback::irc_001,
  70                 irc_join => \&Keitairc::IrcCallback::irc_join,
  71                 irc_part => \&Keitairc::IrcCallback::irc_part,
  72                 irc_public => \&Keitairc::IrcCallback::irc_public,
  73                 irc_notice => \&Keitairc::IrcCallback::irc_notice,
  74                 irc_topic => \&Keitairc::IrcCallback::irc_topic,
  75                 irc_332 => \&Keitairc::IrcCallback::irc_topicraw,
  76                 irc_ctcp_action => \&Keitairc::IrcCallback::irc_ctcp_action,
  77                 irc_disconnected => \&Keitairc::IrcCallback::irc_reconnect,
  78                 irc_error => \&Keitairc::IrcCallback::irc_reconnect,
  79                 irc_socketerr => \&Keitairc::IrcCallback::irc_reconnect,
  80         });
  81
  82 # create web server component
  83 POE::Component::Server::TCP->new(
  84         Alias => 'keitairc',
  85         Port => $cf->web_port(),
  86         ClientFilter => 'POE::Filter::HTTPD',
  87         ClientInput => \&http_request);
  88
  89 # fire up main loop
  90 $poe_kernel->run();
  91 exit 0;
  92
  93 ################################################################
  94 sub http_request{
  95         my ($kernel, $heap, $request) = @_[KERNEL, HEAP, ARG0];
  96
  97         # Filter::HTTPD sometimes generates HTTP::Response objects.
  98         # They indicate (and contain the response for) errors that occur
  99         # while parsing the client's HTTP request.  It's easiest to send
 100         # the responses as they are and finish up.
 101         if($request->isa('HTTP::Response')){
 102                 $heap->{client}->put($request);
 103         }elsif(my $response = dispatch($request)){
 104                 $heap->{client}->put($response);
 105         }
 106
 107         $kernel->yield('shutdown');
 108 }
 109
 110 ################################################################
 111 sub dispatch{
 112         my $request = shift;
 113         my $uri = $request->uri();
 114         my $ci = new Keitairc::ClientInfo($request);
 115
 116         ::log_debug("dispatch: $uri");
 117
 118         if($uri eq '/'){
 119                 return action_root($request);
 120         }
 121
 122         if($uri eq '/login'){
 123                 return action_login($request);
 124         }
 125
 126         if($uri eq '/quicklogin'){
 127                 return action_quicklogin($request);
 128         }
 129
 130         if($uri =~ m|^/(S[a-zA-Z]{10})/index|){
 131                 if($sm->verify({session_id => $1, user_agent => $ci->user_agent()})){
 132                         return add_cookie(action_index($request), $1);
 133                 }
 134                 return action_redirect_root($request);
 135         }
 136
 137         if($uri =~ m|^/(S[a-zA-Z]{10})/topic|){
 138                 if($sm->verify({session_id => $1, user_agent => $ci->user_agent()})){
 139                         return add_cookie(action_topic($request), $1);
 140                 }
 141                 return action_redirect_root($request);
 142         }
 143
 144         if($uri =~ m|^/(S[a-zA-Z]{10})/recent|){
 145                 if($sm->verify({session_id => $1, user_agent => $ci->user_agent()})){
 146                         return add_cookie(action_recent($request), $1);
 147                 }
 148                 return action_redirect_root($request);
 149         }
 150
 151         if($uri =~ m|^/(S[a-zA-Z]{10})/all/(.*)|){
 152                 if($sm->verify({session_id => $1, user_agent => $ci->user_agent()})){
 153                         return add_cookie(action_all($request, $2), $1);
 154                 }
 155                 return action_redirect_root($request);
 156         }
 157
 158         if($uri =~ m|^/(S[a-zA-Z]{10})/unread/(.*)|){
 159                 if($sm->verify({session_id => $1, user_agent => $ci->user_agent()})){
 160                         return add_cookie(action_unread($request, $2), $1);
 161                 }
 162                 return action_redirect_root($request);
 163         }
 164
 165         if($uri =~ m|^/(S[a-zA-Z]{10})/phone/(\d+)|){
 166                 if($sm->verify({session_id => $1, user_agent => $ci->user_agent()})){
 167                         return add_cookie(action_phone($request, $2), $1);
 168                 }
 169                 return action_redirect_root($request);
 170         }
 171
 172         if($uri =~ m|^/(S[a-zA-Z]{10})/mail/(.*)|){
 173                 if($sm->verify({session_id => $1, user_agent => $ci->user_agent()})){
 174                         return add_cookie(action_mail($request, $2), $1);
 175                 }
 176                 return action_redirect_root($request);
 177         }
 178
 179         if($uri =~ m|^/(S[a-zA-Z]{10})/url/(.*)|){
 180                 if($sm->verify({session_id => $1, user_agent => $ci->user_agent()})){
 181                         return add_cookie(action_url($request, $2, $1), $1);
 182                 }
 183                 return action_redirect_root($request);
 184         }
 185
 186         ::log("dispatch: don't know how to dispatch uri[$uri]");
 187         return action_404($request);
 188 }
 189
 190 ################################################################
 191 # adds session id cookie to http response object
 192 sub add_cookie{
 193         my $response = shift;
 194         my $session_id = shift;
 195
 196         my ($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime(time + $cf->cookie_ttl());
 197         my $expiration =
 198                 sprintf('%.3s, %.2d-%.3s-%.4s %.2d:%.2d:%.2d',
 199                         qw(Sun Mon Tue Wed Thu Fri Sat)[$wday],
 200                         $mday,
 201                         qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)[$mon],
 202                         $year + 1900,
 203                         $hour,
 204                         $min,
 205                         $sec);
 206         my $content = sprintf("sid=%s; expires=%s; \n", $session_id, $expiration);
 207         $response->push_header('Set-Cookie', $content);
 208         $response;
 209 }
 210
 211 ################################################################
 212 # /{SESSION}/all/{CHANNEL}
 213 # \83`\83\83\83l\83\8b\82Ì\83\81\83b\83Z\81[\83W\89{\97\97
 214 #
 215 # RFC 2811:
 216 # Apart from the the requirement that the first character being either
 217 # '&', '#', '+' or '!' (hereafter called "channel prefix"). The only
 218 # restriction on a channel name is that it SHALL NOT contain any
 219 # spaces (' '), a control G (^G or ASCII 7), a comma (',' which is
 220 # used as a list item separator by the protocol).  Also, a colon (':')
 221 # is used as a delimiter for the channel mask.  The exact syntax of a
 222 # channel name is defined in "IRC Server Protocol" [IRC-SERVER].  so
 223 # we use white space as separator character of channel name and
 224 # command argument.
 225 sub action_all{
 226         my $request = shift;
 227         my $channel = shift;
 228         $channel = uri_unescape($channel);
 229
 230         send_message($request, $channel);
 231
 232         my $buf;
 233         my $no_message_here_yet;
 234         if(defined($ib->name($channel))){
 235                 if(length($ib->buffer($channel))){
 236                         if($cf->show_newmsgonly() && $ib->message_added()){
 237                                 $buf = render_line($ib->unread($channel)) ||
 238                                         '(\96¢\93Ç\94\8c¾\82Í\82 \82è\82Ü\82¹\82ñ)';
 239                                 $buf .= sprintf('<br /><a accesskey="5" href="../all/%s">[5] \91S\94\8c¾\82Ö</a>',
 240                                                 uri_escape($channel));
 241                         } else {
 242                                 $buf = render_line($ib->buffer($channel));
 243                         }
 244                 }else{
 245                         $no_message_here_yet = 1;
 246                 }
 247         }else{
 248                 $buf = '\8ew\92è\82ÌÁ¬ÈÙ\82Í\91¶\8dÝ\82µ\82Ü\82¹\82ñ';
 249         }
 250
 251         $ib->message_added(0); # clear check flags
 252         $ib->clear_unread($channel);
 253
 254         my $ci = new Keitairc::ClientInfo($request);
 255         my $view = new Keitairc::View($cf, $ci);
 256         return $view->render('all.html', {
 257                 buf => $buf,
 258                 channel_compact => $ib->compact_channel_name($ib->name($channel)),
 259                 channel => uri_escape($channel),
 260                 no_message_here_yet => $no_message_here_yet,
 261                 ipod => $ci->is_ipod(),
 262                      });
 263 }
 264
 265 ################################################################
 266 # /{SESSION}/unread/{CHANNEL}
 267 # \83`\83\83\83l\83\8b\82Ì\83\81\83b\83Z\81[\83W\89{\97\97
 268 sub action_unread{
 269         my $request = shift;
 270         my $channel = shift;
 271         $channel = uri_unescape($channel);
 272
 273         send_message($request, $channel);
 274
 275         my $buf;
 276         my $no_message_here_yet;
 277         if(defined($ib->name($channel))){
 278                 if(length($ib->buffer($channel))){
 279                         $buf = render_line($ib->unread($channel)) ||
 280                                 '(\96¢\93Ç\94\8c¾\82Í\82 \82è\82Ü\82¹\82ñ)';
 281                         $buf .= sprintf('<hr /><a accesskey="5" href="../all/%s">[5] \91S\94\8c¾\82Ö</a><br />',
 282                                         uri_escape($channel));
 283                 }else{
 284                         $no_message_here_yet = 1;
 285                 }
 286         }else{
 287                 $buf = '\8ew\92è\82ÌÁ¬ÈÙ\82Í\91¶\8dÝ\82µ\82Ü\82¹\82ñ';
 288         }
 289
 290         $ib->message_added(0); # clear check flags
 291         $ib->clear_unread($channel);
 292
 293         my $ci = new Keitairc::ClientInfo($request);
 294         my $view = new Keitairc::View($cf, $ci);
 295         return $view->render('unread.html', {
 296                 buf => $buf,
 297                 channel_compact => $ib->compact_channel_name($ib->name($channel)),
 298                 channel => uri_escape($channel),
 299                 no_message_here_yet => $no_message_here_yet,
 300                 ipod => $ci->is_ipod(),
 301                      });
 302 }
 303
 304 ################################################################
 305 # /{SESSION}/topic
 306 # \83g\83s\83b\83N\88ê\97\97
 307 sub action_topic{
 308         my $request = shift;
 309         my $buf;
 310
 311         for my $channel ($ib->channels()){
 312                 my $topic;
 313                 $buf .= sprintf(' <a href="all/%s">%s</a><br />',
 314                                 uri_escape($channel),
 315                                 $ib->compact_channel_name($ib->name($channel)));
 316
 317                 if($topic = $ib->topic($channel)){
 318                         Encode::from_to($topic, 'jis', 'shiftjis');
 319                 }else{
 320                         $topic = '(ÄËß¯¸\96¢\90Ý\92è)';
 321                 }
 322                 $buf .= $topic;
 323                 $buf .= "<br />\n";
 324         }
 325
 326         my $ci = new Keitairc::ClientInfo($request);
 327         my $view = new Keitairc::View($cf, $ci);
 328         return $view->render('topic.html', { buf => $buf });
 329 }
 330
 331 ################################################################
 332 # /{SESSION}/phone/{PARAM}
 333 # \93d\98b
 334 sub action_phone{
 335         my $request = shift;
 336         my $phone = shift;
 337
 338         my $ci = new Keitairc::ClientInfo($request);
 339         my $view = new Keitairc::View($cf, $ci);
 340         return $view->render('phone.html', {
 341                 phone => $phone,
 342                 docomo => $ci->is_docomo(),
 343                      });
 344 }
 345
 346 ################################################################
 347 # /{SESSION}/mail/{PARAM}
 348 # \83\81\81[\83\8b
 349 sub action_mail{
 350         my $request = shift;
 351         my $mail = shift;
 352
 353         my $ci = new Keitairc::ClientInfo($request);
 354         my $view = new Keitairc::View($cf, $ci);
 355         return $view->render('mail.html', {
 356                 mail => $mail,
 357                      });
 358 }
 359
 360 ################################################################
 361 # /{SESSION}/url/{PARAM}
 362 # URL
 363 sub action_url{
 364         my $request = shift;
 365         my $url = shift;
 366         my $session_id = shift;
 367
 368         my $ci = new Keitairc::ClientInfo($request);
 369         my $view = new Keitairc::View($cf, $ci);
 370         return $view->render('url.html', {
 371                 url => $url,
 372                 escaped_url => uri_escape($url),
 373                 ezweb => $ci->is_ezweb(),
 374                 sid => $session_id,
 375                      });
 376 }
 377
 378 ################################################################
 379 # /{SESSION}/recent
 380 # recent messages on every channel
 381 sub action_recent{
 382         my $request = shift;
 383         my $buf;
 384
 385         for my $channel ($ib->channels()){
 386                 if($ib->unread_lines($channel)){
 387                         my $name = $ib->name($channel);
 388                         Encode::from_to($name, 'jis', 'shiftjis');
 389                         $buf .= $name;
 390                         $buf .= sprintf(' <a href="all/%s">\91S\94\8c¾\82Ö</a><br />', uri_escape($channel));
 391                         $buf .= render_line($ib->unread($channel), '.');
 392                         $buf .= "<hr />\n";
 393                         $ib->clear_unread($channel);
 394                 }
 395         }
 396
 397         my $ci = new Keitairc::ClientInfo($request);
 398         my $view = new Keitairc::View($cf, $ci);
 399         return $view->render('recent.html', { buf => $buf });
 400 }
 401
 402 ################################################################
 403 # /{SESSION}/index
 404 # \83`\83\83\83l\83\8b\88ê\97\97
 405 sub action_index{
 406         my $request = shift;
 407         my $unread_channels = 0;
 408         my $accesskey = 1;
 409         my $buf;
 410
 411         for my $channel ($ib->channels()){
 412                 if($accesskey < 10){
 413                         $buf .= sprintf('<a accesskey="%1d" href="all/%s">[%1d] %s</a>',
 414                                         $accesskey,
 415                                         uri_escape($channel),
 416                                         $accesskey,
 417                                         $ib->compact_channel_name($ib->name($channel)));
 418                 }else{
 419                         $buf .= sprintf('<a href="all/%s">    %s</a>',
 420                                         uri_escape($channel),
 421                                         $ib->compact_channel_name($ib->name($channel)));
 422                 }
 423                 $accesskey++;
 424
 425                 # \96¢\93Ç\8ds\90\94
 426                 if($ib->unread_lines($channel)){
 427                         $buf .= sprintf(' <a href="unread/%s">%s</a>',
 428                                         uri_escape($channel),
 429                                         $ib->unread_lines($channel));
 430                         $unread_channels++;
 431                 }
 432                 $buf .= "<br />\n";
 433         }
 434
 435         my $ci = new Keitairc::ClientInfo($request);
 436         my $view = new Keitairc::View($cf, $ci);
 437         return $view->render('index.html',
 438                 {
 439                         buf => $buf,
 440                         unread => $unread_channels,
 441                 });
 442 }
 443
 444 ################################################################
 445 # \92Ê\8fí\83\8d\83O\83C\83\93\82ÌPOST\90æ
 446 # \83p\83X\83\8f\81[\83h\82ð\83`\83F\83b\83N\82µ\82Ä
 447 # \8aÔ\88á\82Á\82Ä\82¢\82½\82ç / \82Ö\83\8a\83\93\83N\82µ\82Ä\8fI\82í\82è
 448 # \8d\87\82Á\82Ä\82¢\82½\82ç\83Z\83b\83V\83\87\83\93\82ð\94\8ds\82µ /{SESSION}/index \82Ö
 449 sub action_login{
 450         my $request = shift;
 451         my $ci = new Keitairc::ClientInfo($request);
 452         my $content = $request->decoded_content();
 453         my ($password) = ($content =~ /^password=(.*)/);
 454
 455         ::log_debug("password [$password]");
 456         ::log_debug("web_password [" . $cf->web_password() . "]");
 457
 458         if($cf->web_password() eq $password){
 459                 my $s = $sm->add($ci->{header}->{user_agent}, $ci->serial_key());
 460                 my $view = new Keitairc::View($cf, $ci, $s->{id});
 461                 return $view->redirect("/$s->{id}/index");
 462         }
 463
 464         # password mismatch
 465         my $view = new Keitairc::View($cf, $ci);
 466         return $view->redirect("/");
 467 }
 468
 469 ################################################################
 470 sub action_404{
 471         my $request = shift;
 472         my $ci = new Keitairc::ClientInfo($request);
 473         my $view = new Keitairc::View($cf, $ci);
 474         return $view->render('404.html', { action => $request->uri() });
 475 }
 476
 477 ################################################################
 478 # \82©\82ñ\82½\82ñ\83\8d\83O\83C\83\93\82ÌPOST\90æ
 479 # DoCoMo\82¾\82Á\82½\82çicc\82ª\97\88\82Ä\82¢\82é\82Í\82¸\82È\82Ì\82Å, icc + user_agent \82Å\83`\83F\83b\83N\81B
 480 # \8d\87\82Á\82Ä\82¢\82½\82ç\83Z\83b\83V\83\87\83\93\95\9c\8bA\82µ\82Ä /{SESSION}/index \82Ö
 481 sub action_quicklogin{
 482         my $request = shift;
 483         my $ci = new Keitairc::ClientInfo($request);
 484         if($ci->is_docomo()){
 485                 my $docomo_foma_icc = $ci->docomo_foma_icc();
 486                 if(length $docomo_foma_icc){
 487                         if(my $s = $sm->verify({serial_key => $docomo_foma_icc,
 488                                                 user_agent => $ci->user_agent()})){
 489                                 ::log_debug("redirect to /$s->{id}/index from docomo_foma_icc");
 490                                 my $view = new Keitairc::View($cf, $ci, $s->{id});
 491                                 return $view->redirect("/$s->{id}/index");
 492                         }
 493
 494                         if($docomo_foma_icc eq $cf->docomo_foma_icc()){
 495                                 my $s = $sm->add($ci->user_agent(), $docomo_foma_icc);
 496                                 ::log_debug("redirect to /$s->{id}/index from docomo_foma_icc");
 497                                 my $view = new Keitairc::View($cf, $ci, $s->{id});
 498                                 return $view->redirect("/$s->{id}/index");
 499                         }
 500                 }
 501         }
 502
 503         my $view = new Keitairc::View($cf, $ci);
 504         return $view->render('root.html', { docomo => $ci->is_docomo() });
 505 }
 506
 507 ################################################################
 508 sub action_root{
 509         my $request = shift;
 510         my $ci = new Keitairc::ClientInfo($request);
 511
 512         if($ci->cookie_available()){
 513                 my $session_id = $ci->{cookie}->{sid};
 514                 if(length $session_id){
 515                         if($sm->verify({session_id => $session_id,
 516                                         user_agent => $ci->user_agent()})){
 517                                 ::log_debug("redirect to /$session_id/index from cookie");
 518                                 my $view = new Keitairc::View($cf, $ci, $session_id);
 519                                 return $view->redirect("/$session_id/index");
 520                         }
 521                 }
 522         }
 523
 524         if($ci->is_ezweb()){
 525                 my $subscriber_id = $ci->{header}->{x_up_subno};
 526                 if(length $subscriber_id){
 527                         if(my $s = $sm->verify({serial_key => $subscriber_id,
 528                                                 user_agent => $ci->user_agent()})){
 529                                 ::log_debug("redirect to /$s->{id}/index from subscriber_id");
 530                                 my $view = new Keitairc::View($cf, $ci, $s->{id});
 531                                 return $view->redirect("/$s->{id}/index");
 532                         }
 533
 534                         if($subscriber_id eq $cf->au_subscriber_id()){
 535                                 my $s = $sm->add($ci->user_agent(), $subscriber_id);
 536                                 ::log_debug("redirect to /$s->{id}/index from au_subscriber_id");
 537                                 my $view = new Keitairc::View($cf, $ci, $s->{id});
 538                                 return $view->redirect("/$s->{id}/index");
 539                         }
 540                 }
 541         }
 542
 543         if($ci->is_softbank()){
 544                 my $serial_key = $ci->softbank_serial();
 545                 if(length $serial_key){
 546                         if(my $s = $sm->verify({serial_key => $serial_key,
 547                                                 user_agent => $ci->user_agent()})){
 548                                 ::log_debug("redirect to /$s->{id}/index from softbank serial_key");
 549                                 my $view = new Keitairc::View($cf, $ci, $s->{id});
 550                                 return $view->redirect("/$s->{id}/index");
 551                         }
 552                 }
 553         }
 554
 555         my $view = new Keitairc::View($cf, $ci);
 556         return $view->render('root.html', { docomo => $ci->is_docomo() });
 557 }
 558
 559 ################################################################
 560 sub action_redirect_root{
 561         my $request = shift;
 562         my $ci = new Keitairc::ClientInfo($request);
 563         my $view = new Keitairc::View($cf, $ci);
 564         return $view->redirect("/");
 565 }
 566
 567 ################################################################
 568 sub send_message{
 569         my $request = shift;
 570         my $channel = shift;
 571
 572         my $message = $request->content();
 573         $message =~ s/^m=//;
 574         $message =~ s/\+/ /g;
 575         $message = uri_unescape($message);
 576
 577         if(length($message)){
 578                 my $jis = $message;
 579                 my $euc = $message;
 580                 Encode::from_to($jis, 'shiftjis', 'jis');
 581                 Encode::from_to($euc, 'shiftjis', 'euc-jp');
 582                 $irc->yield(privmsg => $channel => $jis);
 583                 $ib->add_message($channel, $euc, $cf->irc_nick());
 584                 $ib->message_added(1);
 585         }
 586 }
 587
 588 ################################################################
 589 # \93ü\97Í\82Í euc-jp
 590 sub render_line{
 591         local($_);
 592         my $in = shift;
 593         my $depth = shift;
 594         my $buf;
 595
 596         unless(defined $depth){
 597                 $depth = '..';
 598         }
 599
 600         for ((reverse(split("\n", $in)))[0 .. $cf->web_lines()]){
 601                 next unless defined;
 602                 next unless length;
 603
 604                 $_ = $ib->simple_escape($_);
 605
 606                 unless(s|\b(https?://[/!-;=-\177]+)|link_url($1, $depth)|eg){
 607                         unless(s|\b(www\.[/!-\177]+)|link_url($1, $depth)|eg){
 608                                 # phone to
 609                                 unless(s|\b(0\d{1,3})([-(]?)(\d{2,4})([-)]?)(\d{4})\b|<a href="$depth/phone/$1$3$5">$1$2$3$4$5</a>|g){
 610                                         s|\b(\w[\w.+=-]*\@[\w.-]+[\w]\.[\w]{2,4})\b|<a href="$depth/mail/$1">$1</a>|g;
 611                                 }
 612                         }
 613                 }
 614
 615                 s/\s+$//;
 616                 s/\s+/ /g;
 617                 $buf .= "$_<br />";
 618         }
 619
 620         Encode::from_to($buf, 'euc-jp', 'shiftjis');
 621         $buf;
 622 }
 623
 624 ################################################################
 625 sub link_url{
 626         my $url = shift;
 627         my $depth = shift;
 628         sprintf('<a href="%s/url/%s">%s</a>', $depth, $url, $url);
 629 }
 630
 631 ################################################################
 632 sub log{
 633         my $m = shift;
 634         warn "keitairc: $m\n";
 635         # TODO
 636 }
 637
 638 sub log_die{
 639         my $m = shift;
 640         die "keitairc: $m\n";
 641         # TODO
 642 }
 643
 644 sub log_debug{
 645         my $m = shift;
 646         warn "keitairc: $m\n";
 647         # TODO
 648 }
 649
 650 __END__