#!/usr/bin/perl
# keitairc
-# $Id: keitairc,v 1.10 2004-03-21 11:03:38 morimoto Exp $
+# $Id: keitairc,v 1.22 2004-07-30 09:39:21 ishikawa Exp $
#
# Copyright (c) 2003 Jun Morimoto <morimoto@xantia.citroen.org>
# 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.10 2004-03-21 11:03:38 morimoto Exp $;
+my $rcsid = q$Id: keitairc,v 1.22 2004-07-30 09:39:21 ishikawa Exp $;
my ($version) = $rcsid =~ m#,v ([0-9.]+)#;
use strict;
},
qw(irc_nick irc_username irc_desc
irc_server irc_port irc_password
+ au_subscriber_id
web_port web_title web_lines web_root
- web_username web_password)
+ web_username web_password show_newmsgonly)
);
$config->file('/etc/keitairc');
# unread lines
my %unread;
+# chk
+my ($send_chk, $update_chk);
+
# irc component
POE::Component::IRC->new('keitairc');
POE::Session->new(
irc_part => \&on_irc_part,
irc_public => \&on_irc_public,
irc_notice => \&on_irc_notice,
+ irc_ctcp_action => \&on_irc_ctcp_action,
);
# web server component
################################################################
sub on_irc_join{
my ($kernel, $who, $channel) = @_[KERNEL, ARG0, ARG1];
+ $who =~ s/!.*//;
+
+ # chop off after the gap (bug workaround of madoka)
+ $channel =~ s/ .*//;
+
$channel_name{$channel}++;
+ unless ($who eq $config->irc_nick) {
+ &add_message($channel, undef, "$who joined");
+ }
}
################################################################
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/ .*//;
- delete $channel_name{$channel};
+ if ($who eq $config->irc_nick) {
+ delete $channel_name{$channel};
+ } else {
+ &add_message($channel, undef, "$who leaves");
+ }
}
################################################################
}
################################################################
+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);
+}
+
+################################################################
# $msg \e$B$O\e(B EUC \e$B$K$J$C$F$$$k$O$:\e(B
# $channel \e$B$O\e(B jis \e$B$G$-$F$k$>\e(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 @tmp = split("\n", $channel_buffer{$channel});
- push @tmp, sprintf('%s %s> %s', &now, $who, $msg);
+ push @tmp, $message;
my @tmp2 = split("\n", $channel_recent{$channel});
- push @tmp2, sprintf('%s %s> %s', &now, $who, $msg);
+ push @tmp2, $message;
if(@tmp > $config->web_lines){
- $channel_buffer{$channel} = join("\n", splice(@tmp, -$config->web_lines));
- $channel_recent{$channel} = join("\n", splice(@tmp2, -$config->web_lines));
+ $channel_buffer{$channel} =
+ join("\n", splice(@tmp, -$config->web_lines));
}else{
$channel_buffer{$channel} = join("\n", @tmp);
+ }
+
+ if(@tmp2 > $config->web_lines){
+ $channel_recent{$channel} =
+ join("\n", splice(@tmp2, -$config->web_lines));
+ }else{
$channel_recent{$channel} = join("\n", @tmp2);
}
$mtime{$channel} = time;
- $unread{$channel}++;
+
+ # unread lines
+ $unread{$channel} = scalar(@tmp2);
+
if ($unread{$channel} > $config->web_lines) {
$unread{$channel} = $config->web_lines;
}
################################################################
sub escape{
local($_) = shift;
- s/&/&/;
- s/>/>/;
- s/</</;
+ s/&/&/g;
+ s/>/>/g;
+ s/</</g;
$_;
}
$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{
+ 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));
- }
+ $docroot,
+ uri_escape($channel),
+ &compact_channel_name($channel));
+ }
$accesskey++;
+ # \e$BL$FI9T?t\e(B
if($unread{$channel} > 0){
- $buf .= sprintf(' <a href="%s%s.update">(%d)</a>',
+ $buf .= sprintf(' <a href="%s%s.update">%d</a>',
$docroot,
uri_escape($channel),
- $unread{$channel});
+ $unread{$channel});
}
-
$buf .= '<br>';
}
- $buf .= qq(<a href="$docroot" accesskey="0"></a>);
- $buf .= qq( - keitairc $version +++);
-
+ $buf .= qq(0 <a href="$docroot" accesskey="0">refresh list</a><br>);
+ $buf .= qq( - keitairc $version);
$buf;
}
$_ = &escape($_);
- unless(s,
(http://[!-;=-\177]+),<a href="$1">$1</a>,g){
- unless(s|(www\.[!-\177]+)|<A HREF="http://$1">$1</A>|g){
+ 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|(0\d{1,3}[-(]?\d{2,4}[-)]?\d{4})|<a href="tel:$1">$1</a>|g){
- s|
(\w[\w.+=-]+\@[\w.-]+[\w])|<a href="mailto:$1">$1</a>|g;
+ 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;
}
}
}
################################################################
sub on_web_request{
- local($_);
my ($kernel, $heap, $request) = @_[KERNEL, HEAP, ARG0];
# Filter::HTTPD sometimes generates HTTP::Response objects.
return;
}
- 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;
+ 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;
+ }
}
}
-
my $uri = $request->uri;
my $content = '<html><head>';
+ $content .= '<meta http-equiv="Cache-Control" content="max-age=0" />';
# POST \e$B$5$l$F$-$?$b$N$OH/8@\e(B
if($request->method =~ /POST/i){
&add_message($channel, $config->irc_nick,
Jcode->new($message)->euc);
+ # set flag for "send message"
+ $send_chk = 1;
}
}
}else{
$uri =~ s|^/||;
- my $update_chk = ($uri =~ /.*.update/);
+ $update_chk = ($uri =~ /.*.update/);
if ($update_chk eq 1) {
$uri =~ s/.update//;
}
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 .= '<a accesskey="8" href="../"></a>';
$content .= sprintf('<form action="%s%s" method="post">',
- $docroot, $uri);
+ $docroot, uri_escape($channel));
$content .= '<input type="text" name="m" size="10">';
- $content .= '<input type="submit" accesskey="1" value="OK">';
+ $content .= '<input type="submit" accesskey="1" value="OK[1]">';
+ $content .= qq(<a accesskey="8" href="$docroot">back[8]</a><br>);
# $content .= '<input type="submit" accesskey="1" value="聆">';
$content .= '</form>';
- $content .= '<a href="../">..back (push 8)</a><BR>';
if(defined($channel_name{$channel})){
if(defined($channel_buffer{$channel}) &&
length($channel_buffer{$channel})){
- $content .= qq(<a accesskey="8" href="$docroot"></a>);
$content .= '<a accesskey="9" href="#2"></a>';
- if ($update_chk eq 1) {
+ if ((($update_chk eq 1)||((defined $config->show_newmsgonly) && ($send_chk eq 1)))) {
$content .= &render($channel_recent{$channel});
$content .= sprintf('<a accesskey="5" href="%s%s">
- ..more(push 5)</a>', "../", uri_escape($channel));
+ ..more[5]</a>', $docroot, uri_escape($channel));
} else {
$content .= &render($channel_buffer{$channel});
}
$content .= "no such channel";
}
+ # clear check flags
+ $send_chk = 0;
+
+ # clear unread counter
$unread{$channel} = 0;
- $channel_recent{$channel} = "";
+
+ # clear recent messages buffer
+ $channel_recent{$channel} = '';
}
$content .= '</body></html>';
OSDN Git Service
