home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.madoka.org
/
2014.12.ftp.madoka.org.tar
/
ftp.madoka.org
/
pub
/
plum
/
2.x
/
plum2_15_4.lzh
/
plum
next >
Wrap
Text File
|
1998-01-13
|
51KB
|
1,810 lines
#!/bin/perl -w
# $Id: plum,v 2.27 1998/01/14 00:05:10 hasegawa Exp $
# copyright (c)1997 pupu_j <hasegawa@agusa.nuie.nagoya-u.ac.jp>
package plum;
$NAME = 'plum';
$VERSION = '2.15';
$ALIAS = '*.jp';
$NOTRAILING = &'list('004', '215', '221', '324', '341', '367', 'mode');
$IRCPORT = 6667;
$READSIZE = 1024;
$TIMEOUT = 120;
$SOCKADDR = 'S n a4 x8';
$PROTO = getprotobyname('tcp');
if ($] < 5) {
foreach $inc (@INC) {
if (-r "$inc/sys/socket.ph") {
eval { require 'sys/socket.ph' };
$SOCKET = "$inc/sys/socket.ph" unless $@;
last;
}
if (-r "$inc/socket.ph") {
eval { require 'socket.ph' };
$SOCKET = "$inc/socket.ph" unless $@;
last;
}
}
} else {
eval 'use Socket';
$SOCKET = 'Socket.pm' unless $@;
}
$AF_INET = eval { &AF_INET } || 2;
$PF_INET = eval { &PF_INET } || 2;
$SOCK_STREAM = eval { &SOCK_STREAM } || 1;
$SOMAXCONN = eval { &SOMAXCONN } || 16;
$INADDR_ANY = eval { &INADDR_ANY } || "\0\0\0\0";
$SOL_SOCKET = eval { &SOL_SOCKET};
$SO_REUSEADDR = eval { &SO_REUSEADDR };
$SO_KEEPALIVE = eval { &SO_KEEPALIVE };
$'rin = '';
$'win = '';
$'rout = '';
$'wout = '';
$handle = 0;
srand();
select((select(STDOUT), $| = 1)[0]);
select((select(STDERR), $| = 1)[0]);
if ($0 =~ /^(.*)[\\\/][^\\\/]*$/) {
unshift(@INC, "$1/module");
} else {
unshift(@INC, './module');
}
&'load('', "$NAME.conf") if -r "$NAME.conf";
foreach $user (@ARGV) {
&'load($user, "$NAME-$user.conf") if -r "$NAME-$user.conf";
}
exit unless scalar(@'username);
print "$NAME $VERSION\n";
&main;
sub main {
local($nfound, $timeleft, $sub, $label, $i);
for (;;) {
for ($i = 0; $i < scalar(@'username); $i++) {
foreach $module (&'array($'modulelist[$i])) {
$sub = "${module}\'main_loop";
next unless defined(&$sub);
if ($'labellist{$module}) {
foreach $label (&'array($'labellist{$module})) {
&$sub($i);
}
} else {
&$sub($i);
}
}
}
foreach $cno (&'array($'clientlist)) {
&c_read($cno) if vec($'rout, $cno, 1);
&c_write($cno) if vec($'wout, $cno, 1);
}
foreach $sno (&'array($'serverlist)) {
&s_read($sno) if vec($'rout, $sno, 1);
&s_write($sno) if vec($'wout, $sno, 1);
}
foreach $lno (&'array($'listenlist)) {
&c_accept($lno) if vec($'rout, $lno, 1);
}
($nfound, $timeleft) = select($'rout = $'rin, $'wout = $'win, undef, $TIMEOUT);
}
}
sub c_read {
local($clientno) = @_;
local($next, $rest, $tmp, $sub, $label);
$tmp = '';
if (sysread($'socket[$clientno], $tmp, $READSIZE)) {
$rbuf[$clientno] .= $tmp;
while ((($next, $rest) = split(/[\r\n]+/, $rbuf[$clientno], 2)) == 2) {
$rbuf[$clientno] = $rest;
next unless $next;
if ($'avail[$clientno]) {
foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
$sub = "${module}\'client_read";
next unless defined(&$sub);
if ($'labellist{$module}) {
foreach $label (&'array($'labellist{$module})) {
$next = &$sub($clientno, $next);
last unless $next;
}
} else {
$next = &$sub($clientno, $next);
last unless $next;
}
}
}
next unless $next;
&c_scan($clientno, $next);
}
$rbuf[$clientno] = $next || '';
} else {
&'c_close($clientno);
}
}
sub c_scan {
local($clientno, $line) = @_;
local($prefix, $cmd, @params, $sub, $label);
($prefix, $cmd, @params) = &'parse($line);
return unless $cmd;
if ($'avail[$clientno]) {
foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
$sub = "${module}\'cs_\L$cmd\E";
next unless defined(&$sub);
if ($'labellist{$module}) {
foreach $label (&'array($'labellist{$module})) {
($prefix, $cmd, @params) = &$sub($clientno, $prefix, $cmd, @params);
last unless $cmd;
}
} else {
($prefix, $cmd, @params) = &$sub($clientno, $prefix, $cmd, @params);
}
last unless $cmd;
}
return unless $cmd;
return unless $'server[$'userno[$clientno]];
return unless $'avail[$'server[$'userno[$clientno]]];
&'s_print($'server[$'userno[$clientno]], $prefix, $cmd, @params);
} else {
$sub = "cn_\L$cmd\E";
&$sub($clientno, $prefix, $cmd, @params) if defined(&$sub);
}
}
sub c_write {
local($clientno) = @_;
local($socket, $next, $rest, $sub, $label);
$socket = $'socket[$clientno];
while ((($next, $rest) = split(/[\r\n]+/, $wbuf[$clientno], 2)) == 2) {
$wbuf[$clientno] = $rest;
next unless $next;
if ($'avail[$clientno]) {
foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
$sub = "${module}\'client_write";
next unless defined(&$sub);
if ($'labellist{$module}) {
foreach $label (&'array($'labellist{$module})) {
$next = &$sub($clientno, $next);
last unless $next;
}
} else {
$next = &$sub($clientno, $next);
}
last unless $next;
}
}
next unless $next;
print $socket $next, "\r\n" if fileno($socket);
}
$wbuf[$clientno] = $next || '';
vec($'win, $clientno, 1) = 0;
}
sub 'c_print {
local($clientno, $prefix, $cmd, @params) = @_;
local($sub, $label);
return unless $cmd;
return unless $clientno;
if ($'avail[$clientno]) {
foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
$sub = "${module}\'cp_\L$cmd\E";
next unless defined(&$sub);
if ($'labellist{$module}) {
foreach $label (&'array($'labellist{$module})) {
($prefix, $cmd, @params) = &$sub($clientno, $prefix, $cmd, @params);
last unless $cmd;
}
} else {
($prefix, $cmd, @params) = &$sub($clientno, $prefix, $cmd, @params);
}
last unless $cmd;
}
return unless $cmd;
}
$wbuf[$clientno] .= &'build($prefix, $cmd, @params);
vec($'win, $clientno, 1) = 1;
}
sub 'c_flush {
local($clientno) = @_;
while (vec($'win, $clientno, 1)) {
&c_write($clientno);
}
}
sub s_read {
local($serverno) = @_;
local($userno, $next, $rest, $tmp, $sub, $label);
$userno = $'userno[$serverno];
$tmp = '';
if (sysread($'socket[$serverno], $tmp, $READSIZE)) {
$rbuf[$serverno] .= $tmp;
while ((($next, $rest) = split(/[\r\n]+/, $rbuf[$serverno], 2)) == 2) {
$rbuf[$serverno] = $rest;
next unless $next;
if ($'avail[$serverno]) {
foreach $module (&'array($'modulelist[$userno])) {
$sub = "${module}\'server_read";
next unless defined(&$sub);
if ($'labellist{$module}) {
foreach $label (&'array($'labellist{$module})) {
$next = &$sub($serverno, $next);
last unless $next;
}
} else {
$next = &$sub($serverno, $next);
}
last unless $next;
}
}
next unless $next;
&s_scan($serverno, $next);
}
$rbuf[$serverno] = $next || '';
} else {
&'s_close($userno);
&'s_connect($userno);
}
}
sub s_scan {
local($serverno, $line) = @_;
local($prefix, $cmd, @params, $sub, $label);
($prefix, $cmd, @params) = &'parse($line);
return unless $cmd;
if ($'avail[$serverno]) {
foreach $module (&'array($'modulelist[$'userno[$serverno]])) {
$sub = "${module}\'ss_\L$cmd\E";
next unless defined(&$sub);
if ($'labellist{$module}) {
foreach $label (&'array($'labellist{$module})) {
($prefix, $cmd, @params) = &$sub($serverno, $prefix, $cmd, @params);
last unless $cmd;
}
} else {
($prefix, $cmd, @params) = &$sub($serverno, $prefix, $cmd, @params);
}
last unless $cmd;
}
return unless $cmd;
foreach $cno (&'array($'clientlist)) {
next unless $'avail[$cno];
next unless $'userno[$cno] == $'userno[$serverno];
&'c_print($cno, $prefix, $cmd, @params);
}
} else {
$sub = "sn_\L$cmd\E";
&$sub($serverno, $prefix, $cmd, @params) if defined(&$sub);
}
}
sub s_write {
local($serverno) = @_;
local($socket, $next, $rest, $sub, $label, $time);
$socket = $'socket[$serverno];
$time = time();
$timer[$serverno] = $time if ($timer[$serverno] || 0) < $time;
while ((($next, $rest) = split(/[\r\n]+/, $wbuf[$serverno], 2)) == 2) {
return if $timer[$serverno] > $time + 10;
$wbuf[$serverno] = $rest;
next unless $next;
if ($'avail[$serverno]) {
foreach $module (&'array($'modulelist[$'userno[$serverno]])) {
$sub = "${module}\'server_write";
next unless defined(&$sub);
if ($'labellist{$module}) {
foreach $label (&'array($'labellist{$module})) {
$next = &$sub($serverno, $next);
last unless $next;
}
} else {
$next = &$sub($serverno, $next);
}
last unless $next;
}
}
next unless $next;
print $socket $next, "\r\n" if fileno($socket);
$timer[$serverno] += 2;
}
$wbuf[$serverno] = $next || '';
vec($'win, $serverno, 1) = 0;
}
sub 's_print {
local($serverno, $prefix, $cmd, @params) = @_;
local($sub, $label);
return unless $cmd;
return unless $serverno;
foreach $module (&'array($'modulelist[$'userno[$serverno]])) {
$sub = "${module}\'sp_\L$cmd\E";
next unless defined(&$sub);
if ($'labellist{$module}) {
foreach $label (&'array($'labellist{$module})) {
($prefix, $cmd, @params) = &$sub($serverno, $prefix, $cmd, @params);
last unless $cmd;
}
} else {
($prefix, $cmd, @params) = &$sub($serverno, $prefix, $cmd, @params);
}
last unless $cmd;
}
return unless $cmd;
$wbuf[$serverno] .= &'build($prefix, $cmd, @params);
vec($'win, $serverno, 1) = 1;
}
sub 's_flush {
local($serverno) = @_;
while (vec($'win, $serverno, 1)) {
&s_write($serverno);
}
}
sub 'parse {
local($line) = @_;
local($arg, $rest, @params);
@params = ();
$line =~ s/^\s*//;
if ($line =~ /^\:(.*)$/) {
($arg, $rest) = split(/\s+/, $1, 2);
} else {
($arg, $rest) = ('', $line);
}
while ($line) {
push(@params, $arg);
if ($rest =~ /^\:(.*)$/) {
push(@params, $1);
last;
}
$line = $rest;
($arg, $rest) = (split(/\s+/, $line, 2), '');
}
return @params;
}
sub 'build {
local($prefix, $cmd, @params) = @_;
local($trailing);
return '' unless $cmd;
if (@params) {
$trailing = pop(@params) || '';
if (&'exist($NOTRAILING, "\L$cmd\E")) {
push(@params, "$trailing ");
} else {
push(@params, ":$trailing");
}
} else {
@params = ();
}
unshift(@params, $cmd);
unshift(@params, ":$prefix") if $prefix;
return join(' ', @params) . "\r\n";
}
sub 'user {
local($no) = @_;
local($addr, $host);
if (fileno($'socket[$no])) {
$addr = (unpack($SOCKADDR, getsockname($'socket[$no])))[2];
$host = (gethostbyaddr($addr, $AF_INET))[0] || join('.', unpack('C4', $addr));
} else {
$host = 'unknown';
}
return "$'nick[$no]!$'user[$no]\@$host";
}
sub 'prefix {
local($prefix) = @_;
$prefix =~ /([^\!\@]*)(\!([^\!\@]*))?(\@([^\!\@]*))?$/;
if (wantarray) {
return ($1 || '', $3 || '', $5 || '');
} else {
return $1;
}
}
sub 'regex {
local($mask) = @_;
$mask =~ s/(\W)/\\$1/g;
$mask =~ s/\\\?/\./g;
$mask =~ s/\\\*/\.\*/g;
$mask =~ s/\\[\[\{]/\[\\\[\\\{\]/g;
$mask =~ s/\\[\]\}]/\[\\\]\\\}\]/g;
$mask =~ s/\\[\|\\]/\[\\\|\\\\\]/g;
return "\^$mask\$";
}
sub 'load {
local($user, $file) = @_;
local($userno, @key, $no, $var, $line, $arg, $name, $label);
@'username = () unless @'username;
open(FILE, $file) || return;
if (!&'exist(&'list(@'username), $user)) {
push(@'username, $user);
}
for ($userno = 0; $userno < scalar(@'username); $userno++) {
last if $user eq $'username[$userno];
}
foreach $key (keys(%property)) {
($no, $var) = split(/$;/, $key, 2);
next unless $no == $userno;
delete $property{$key};
}
$'filename{$user} = $file;
$'modulelist[$userno] = &'list('plum');
while (defined($line = <FILE>)) {
$line =~ s/^\s+//;
next if $line =~ /^[\#\;]/;
$line =~ s/[\r\n]+//;
next unless $line;
foreach $kanji (&'property($userno, 'kanji')) {
foreach $code (split(/\,/, $kanji)) {
if ("\L$code\E" eq 'euc') {
$line = &'euc_jis($line);
} elsif ("\L$code\E" eq 'jis') {
$line = &'jis_jis($line);
} elsif ("\L$code\E" eq 'sjis') {
$line = &'sjis_jis($line);
}
}
}
if ($line =~ /^\+\s*(\S+)\s+(\S+)/) {
$name = $1;
$label = $2;
&'import($name);
$'modulelist[$userno] = &'add($'modulelist[$userno], $'package{$name});
$'labellist{$'package{$name}} = &'list(split(/\,/, $label));
} elsif ($line =~ /^\+\s*(\S+)/) {
$name = $1;
&'import($name);
$'modulelist[$userno] = &'add($'modulelist[$userno], $'package{$name});
$'labellist{$'package{$name}} = '';
} elsif ($line =~ /^\-\s*(\S+)/) {
$name = $1;
if ($'package{$name}) {
$'modulelist[$userno] = &'remove($'modulelist[$userno], $'package{$name});
$'labellist{$'package{$name}} = '';
}
} elsif ($line =~ /^\=\s*(\S+)/) {
$name = $1;
&'import($name);
} elsif ((($var, $arg) = split(/\s*\:\s*/, $line, 2)) == 2) {
@key = split(/\./, $var);
$property{$userno, @key} = &'add($property{$userno, @key}, $arg);
}
}
close(FILE);
}
sub 'import {
local($name) = @_;
$_ = $'package{$name} || 'main';
require $name;
$'package{$name} = $_;
$'filename{$'package{$name}} = $name;
}
sub 'property {
local($userno, $name) = @_;
local(@pkg, $list);
@pkg = split(/\_/, (caller())[0]);
if ($label) {
$list = $property{$userno, @pkg, $label, $name} || $property{$userno, @pkg, $name};
} else {
$list = $property{$userno, @pkg, $name};
}
if (defined($list)) {
if (wantarray) {
return &'array($list);
} else {
return (&'array($list))[0];
}
} else {
if (wantarray) {
return ();
} else {
return undef;
}
}
}
sub 'expand {
local($name) = @_;
local($user, $rest, $home);
if ($name =~ /^\~([^\/]*)\/(.*)$/) {
($user, $rest) = ($1, $2);
if ($user) {
$home = eval { (getpwnam($user))[7] } || '.';
} else {
$home = $ENV{'HOME'} || eval { (getpwuid($<))[7] } || '.';
}
return "$home/$rest";
} else {
return $name;
}
}
sub 'date {
local($format) = @_;
local(@time, $char, $str, $i);
@time = localtime(time());
$str = '';
for ($i = 0; $i < length($format); $i++) {
$char = substr($format, $i, 1);
if ($char eq '%') {
$i++;
if ($i < length($format)) {
$char = substr($format, $i, 1);
if ($char eq '%') {
$str .= $char;
} elsif ($char eq 'd') {
$str .= sprintf('%02d', $time[3]);
} elsif ($char eq 'H') {
$str .= sprintf('%02d', $time[2]);
} elsif ($char eq 'I') {
$str .= sprintf('%02d', $time[2] % 12 + 1);
} elsif ($char eq 'j') {
$str .= sprintf('%3d', $time[7]);
} elsif ($char eq 'k') {
$str .= sprintf('%2d', $time[2]);
} elsif ($char eq 'l') {
$str .= sprintf('%2d', $time[2] % 12 + 1);
} elsif ($char eq 'M') {
$str .= sprintf('%02d', $time[1]);
} elsif ($char eq 'm') {
$str .= sprintf('%02d', $time[4] + 1);
} elsif ($char eq 'S') {
$str .= sprintf('%02d', $time[0]);
} elsif ($char eq 'w') {
$str .= sprintf('%d', $time[6]);
} elsif ($char eq 'Y') {
$str .= sprintf('%d', $time[5] + 1900);
} elsif ($char eq 'y') {
$str .= sprintf('%02d', $time[5]);
}
} else {
$str .= $char;
}
} else {
$str .= $char;
}
}
return $str;
}
sub 'real {
local($name) = @_;
if ($name =~ /^\%(.*)$/) {
return "\#$1\:$ALIAS";
} else {
return $name;
}
}
sub 'alias {
local($name) = @_;
if ($name =~ /^\#(.*)\:(.*)$/ && "\L$2\E" eq "\L$ALIAS\E") {
return "\%$1";
} else {
return $name;
}
}
sub 'add {
local($list, @items) = @_;
$list = $; unless $list;
foreach $item (@items) {
next if &'exist($list, $item);
$list = "${list}${item}$;";
}
return $list;
}
sub 'remove {
local($list, @items) = @_;
local($idx);
$list = $; unless $list;
foreach $item (@items) {
$idx = index("\L$list\E", "\L$;$item$;\E");
next if $idx == -1;
substr($list, $idx, length("$;$item$;")) = $;;
}
return $list;
}
sub 'change {
local($list, @items) = @_;
local($old, $new, $idx, $i);
$list = $; unless $list;
for ($i = 0; $i < scalar(@items) / 2; $i++) {
($old, $new) = @items[$i * 2, $i * 2 + 1];
next if ($idx = index("\L$list\E", "\L$;$old$;\E")) == -1;
substr($list, $idx, length("$;$old$;")) = "$;$new$;";
}
return $list;
}
sub 'exist {
local($list, @items) = @_;
return 0 unless $list;
foreach $item (@items) {
return 1 if index("\L$list\E", "\L$;$item$;\E") != -1;
}
return 0;
}
sub 'list {
local(@array) = @_;
local($list);
if (@array) {
$list = $; . join($;, @array) . $;;
} else {
$list = $;
}
return $list;
}
sub 'array {
local($list) = @_;
$list = $; unless $list;
return () if $list eq $;;
$list = substr($list, 1, length($list) - 2);
return split(/$;/, $list);
}
sub 'euc_jis {
local($euc) = @_;
local($jis, $kanji, $c, $n, $i);
$kanji = 0;
$jis = '';
for ($i = 0; $i < length($euc); $i++) {
$c = substr($euc, $i, 1);
$n = unpack('C', $c);
if ($n >= 0xa1) {
if ($kanji != 1) {
$jis .= "\e\$B";
$kanji = 1;
}
$jis .= pack('C', $n & 0x7f);
$i++;
$jis .= pack('C', unpack('C', substr($euc, $i, 1)) & 0x7f);
} elsif ($n == 0x8e) {
if ($kanji != 2) {
$jis .= "\e(I";
$kanji = 2;
}
$i++;
$jis .= pack('C', unpack('C', substr($euc, $i, 1)) & 0x7f);
} else {
if ($kanji != 0) {
$jis .= "\e\(B";
$kanji = 0;
}
$jis .= $c;
}
}
$jis .= "\e\(B" if $kanji != 0;
return $jis;
}
sub 'euc_sjis {
local($euc) = @_;
local($sjis, $c, $n1, $n2, $i);
$sjis = '';
for ($i = 0; $i < length($euc); $i++) {
$c = substr($euc, $i, 1);
$n1 = unpack('C', $c);
if ($n1 >= 0xa1) {
$i++;
$n2 = unpack('C', substr($euc, $i, 1));
if (($n1 & 0x01) == 0) {
$n2 -= 0x03;
} else {
$n2 -= 0x61;
}
$n2++ if $n2 >= 0x7f;
$n1 = ($n1 - 0xa1 >> 1) + 0x81;
$sjis .= pack('CC', $n1, $n2);
} elsif ($n1 == 0x8e) {
$i++;
$sjis .= substr($euc, $i, 1);
} else {
$sjis .= $c;
}
}
return $sjis;
}
sub 'jis_euc {
local($jis) = @_;
local($euc, $kanji, $i);
$jis = &'jis_jis($jis);
$kanji = 0;
$euc = '';
for ($i = 0; $i < length($jis); $i++) {
if (substr($jis, $i, 3) eq "\e\(B") {
$kanji = 0;
$i += 2;
next;
} elsif (substr($jis, $i, 3) eq "\e\$B") {
$kanji = 1;
$i += 2;
next;
} elsif (substr($jis, $i, 3) eq "\e\(I") {
$kanji = 2;
$i += 2;
next;
}
if ($kanji == 0) {
$euc .= substr($jis, $i, 1);
} elsif ($kanji == 1) {
$euc .= pack('C', unpack('C', substr($jis, $i, 1)) | 0x80);
$i++;
$euc .= pack('C', unpack('C', substr($jis, $i, 1)) | 0x80);
} else {
$euc .= "\x8e" . pack('C', unpack('C', substr($jis, $i, 1)) | 0x80);
}
}
return $euc;
}
sub 'jis_jis {
local($jis) = @_;
$jis =~ s/\e\$\@/\e\$B/g;
$jis =~ s/\e\(J/\e\(B/g;
$jis =~ s/\cN/\e\(I/g;
$jis =~ s/\cO/\e\(B/g;
return $jis;
}
sub 'jis_sjis {
local($jis) = @_;
local($sjis, $kanji, $n1, $n2, $i);
$jis = &'jis_jis($jis);
$kanji = 0;
$sjis = '';
for ($i = 0; $i < length($jis); $i++) {
if (substr($jis, $i, 3) eq "\e\(B") {
$kanji = 0;
$i += 2;
next;
} elsif (substr($jis, $i, 3) eq "\e\$B") {
$kanji = 1;
$i += 2;
next;
} elsif (substr($jis, $i, 3) eq "\e\(I") {
$kanji = 2;
$i += 2;
next;
}
if ($kanji == 0) {
$sjis .= substr($jis, $i, 1);
} elsif ($kanji == 1) {
$n1 = unpack('C', substr($jis, $i, 1));
$i++;
$n2 = unpack('C', substr($jis, $i, 1));
if (($n1 & 0x01) == 0) {
$n2 += 0x7d;
} else {
$n2 += 0x1f;
}
$n2++ if $n2 >= 0x7f;
$n1 = ($n1 - 0x21 >> 1) + 0x81;
$sjis .= pack('CC', $n1, $n2);
} else {
$sjis .= pack('C', unpack('C', substr($jis, $i, 1)) | 0x80);
}
}
return $sjis;
}
sub 'sjis_euc {
local($sjis) = @_;
local($euc, $c, $n1, $n2, $i);
$euc = '';
for ($i = 0; $i < length($sjis); $i++) {
$c = substr($sjis, $i, 1);
$n1 = unpack('C', $c);
if ($n1 >= 0xa0 && $n1 <= 0xdf) {
$euc .= "\x8e$c";
} elsif ($n1 >= 0x81) {
$i++;
$n2 = unpack('C', substr($sjis, $i, 1));
$n2-- if $n2 > 0x7f;
if ($n2 >= 0x9e) {
$n1 = (($n1 - 0x81) << 1) + 0xa2;
$n2 += 0x03;
} else {
$n1 = (($n1 - 0x81) << 1) + 0xa1;
$n2 += 0x61
}
$euc .= pack('CC', $n1, $n2);
} else {
$euc .= $c;
}
}
return $euc;
}
sub 'sjis_jis {
local($sjis) = @_;
local($jis, $kanji, $c, $n1, $n2, $i);
$kanji = 0;
$jis = '';
for ($i = 0; $i < length($sjis); $i++) {
$c = substr($sjis, $i, 1);
$n1 = unpack('C', $c);
if ($n1 >= 0xa0 && $n1 <= 0xdf) {
if ($kanji != 2) {
$jis .= "\e(I";
$kanji = 2;
}
$jis .= pack('C', $n1 & 0x7f);
} elsif ($n1 >= 0x81) {
if ($kanji != 1) {
$jis .= "\e\$B";
$kanji = 1;
}
$i++;
$n2 = unpack('C', substr($sjis, $i, 1));
$n2-- if $n2 > 0x7f;
if ($n2 >= 0x9e) {
$n1 = (($n1 - 0x81) << 1) + 0x22;
$n2 -= 0x7d;
} else {
$n1 = (($n1 - 0x81) << 1) + 0x21;
$n2 -= 0x1f;
}
$jis .= pack('CC', $n1, $n2);
} else {
if ($kanji != 0) {
$jis .= "\e\(B";
$kanji = 0;
}
$jis .= $c;
}
}
$jis .= "\e\(B" if $kanji != 0;
return $jis;
}
sub 'connect {
local($host, $port) = @_;
local($serverno, $socket, $addr);
if ($host =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/) {
$addr = pack('C4', $1, $2, $3, $4);
} elsif ($host =~ /^\d+$/) {
$addr = pack('N', $host);
} else {
$addr = (gethostbyname($host))[4];
}
return 0 unless defined($addr);
$socket = '\'S' . ++$handle;
socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
connect($socket, pack($SOCKADDR, $AF_INET, $port, $addr)) || return 0;
$serverno = fileno($socket);
vec($'rin, $serverno, 1) = 1;
$'socket[$serverno] = $socket;
select((select($socket), $| = 1)[0]);
$rbuf[$serverno] = '';
$wbuf[$serverno] = '';
return $serverno;
}
sub 'listen {
local($port, $count) = @_;
local($listenno, $socket);
$socket = '\'L' . ++$handle;
socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
if (defined($SOL_SOCKET)) {
setsockopt($socket, $SOL_SOCKET, $SO_REUSEADDR, pack('l', 1)) if defined($SO_REUSEADDR);
setsockopt($socket, $SOL_SOCKET, $SO_KEEPALIVE, pack('l', 1)) if defined($SO_KEEPALIVE);
}
bind($socket, pack($SOCKADDR, $AF_INET, $port, $INADDR_ANY)) || return 0;
listen($socket, $count || $SOMAXCONN) || return 0;
$listenno = fileno($socket);
vec($'rin, $listenno, 1) = 1;
$'socket[$listenno] = $socket;
select((select($socket), $| = 1)[0]);
return $listenno;
}
sub 'accept {
local($listenno) = @_;
local($clientno, $socket);
$socket = '\'C' . ++$handle;
accept($socket, $'socket[$listenno]) || return 0;
$clientno = fileno($socket);
vec($'rin, $clientno, 1) = 1;
$'socket[$clientno] = $socket;
select((select($socket), $| = 1)[0]);
$rbuf[$clientno] = '';
$wbuf[$clientno] = '';
return $clientno;
}
sub 'close {
local($no) = @_;
close($'socket[$no]);
vec($'rin, $no, 1) = 0;
}
sub 's_connect {
local($userno) = @_;
local($server, $host, $name, $port, $pass, $serverno);
return if $'server[$userno];
foreach $server (&'property($userno, 'server')) {
next if &'exist($errorlist[$userno], $server);
($host, $pass) = (split(/\s+/, $server), '');
($name, $port) = (split(/\:/, $host), '');
$serverno = &'connect($name, $port || $IRCPORT);
next unless $serverno;
$'serverlist = &'add($'serverlist, $serverno);
$'avail[$serverno] = 0;
$'userno[$serverno] = $userno;
$'server[$userno] = $serverno;
$pass[$serverno] = $pass;
$serverhost[$serverno] = $server;
&s_init($serverno);
last;
}
$'servername[$userno] = $NAME;
$errorlist[$userno] = $; unless $host;
}
sub 's_close {
local($userno) = @_;
local($serverno, $sub, $label);
$serverno = $'server[$userno];
&'s_flush($serverno);
&'close($serverno);
foreach $module (reverse(&'array($'modulelist[$userno]))) {
$sub = "${module}\'server_close";
next unless defined(&$sub);
if ($'labellist{$module}) {
foreach $label (&'array($'labellist{$module})) {
&$sub($serverno);
}
} else {
&$sub($serverno);
}
}
$'serverlist = &'remove($'serverlist, $serverno);
$'avail[$serverno] = 0;
$'userno[$serverno] = undef;
$'server[$userno] = undef;
$'servername[$userno] = $NAME;
}
sub c_listen {
local($userno) = @_;
local($listenno, $host, $pass, $name, $port, $i, $uselist);
foreach $client (&'property($userno, 'client')) {
($host, $pass) = (split(/\s+/, $client), '');
($name, $port) = split(/\:/, $host);
$port = $IRCPORT unless $port;
next if &'exist($portlist, $port);
$listenno = &'listen($port, $SOMAXCONN);
next unless $listenno;
$'listenlist = &'add($'listenlist, $listenno);
$portlist = &'add($portlist, $port);
}
$uselist = '';
for ($i = 0; $i < scalar(@'username); $i++) {
foreach $client (&'property($i, 'client')) {
$host = (split(/\s+/, $client))[0];
$port = (split(/\:/, $host))[1];
$uselist = &'add($uselist, $port || $IRCPORT);
}
}
foreach $lno (&'array($'listenlist)) {
$port = (unpack($SOCKADDR, getsockname($'socket[$lno])))[1];
next if &'exist($uselist, $port);
&'close($lno);
$'listenlist = &'remove($'listenlist, $lno);
$portlist = &'remove($portlist, $port);
}
}
sub c_accept {
local($listenno) = @_;
local($clientno, $addr, $name, $port, $host, $pass, $regex, $i);
$clientno = &'accept($listenno);
return unless $clientno;
$port = (unpack($SOCKADDR, getsockname($'socket[$clientno])))[1];
$addr = (unpack($SOCKADDR, getpeername($'socket[$clientno])))[2];
$name = (gethostbyaddr($addr, $AF_INET))[0];
for ($i = 0; $i < scalar(@'username); $i++) {
foreach $client (&'property($i, 'client')) {
($host, $pass) = (split(/\s+/, $client), '');
next unless $port == ((split(/\:/, $host))[1] || $IRCPORT);
$regex = &'regex((split(/\:/, $host))[0]);
next unless $name =~ /$regex/i;
$'clientlist = &'add($'clientlist, $clientno);
$'avail[$clientno] = 0;
$'nick[$clientno] = '';
$'user[$clientno] = '';
$pass[$clientno] = '';
return;
}
}
&'close($clientno);
}
sub 'c_close {
local($clientno) = @_;
local($sub, $label);
&'c_flush($clientno);
&'close($clientno);
$'clientlist = &'remove($'clientlist, $clientno);
if ($'avail[$clientno]) {
foreach $module (reverse(&'array($'modulelist[$'userno[$clientno]]))) {
$sub = "${module}\'client_close";
next unless defined(&$sub);
if ($'labellist{$module}) {
foreach $label (&'array($'labellist{$module})) {
&$sub($clientno);
}
} else {
&$sub($clientno);
}
}
$'avail[$clientno] = 0;
}
$'userno[$clientno] = undef;
}
sub s_init {
local($serverno) = @_;
local($userno, $nick, $user, $name);
$userno = $'userno[$serverno];
&'s_print($serverno, '', 'PASS', $pass[$serverno]) if $pass[$serverno];
$nick = $'nickname[$userno] || &'property($userno, 'nick') || getlogin() || eval { (getpwuid($<))[0] } || "$NAME-user";
&'s_print($serverno, '', 'NICK', (split(/\,/, $nick))[0]);
$user = &'property($userno, 'user') || getlogin() || eval { (getpwuid($<))[0] } || "$NAME-user";
$name = &'property($userno, 'name');
$name = eval { ((split(/\,/, (getpwuid($<))[6]))[0]) } || $user unless defined($name);
&'s_print($serverno, '', 'USER', $user, '*', '*', $name);
}
sub c_init {
local($clientno) = @_;
local($addr, $name, $port, $host, $pass, $regex, $sub, $label, $i);
$port = (unpack($SOCKADDR, getsockname($'socket[$clientno])))[1];
$addr = (unpack($SOCKADDR, getpeername($'socket[$clientno])))[2];
$name = (gethostbyaddr($addr, $AF_INET))[0];
for ($i = 0; $i < scalar(@'username); $i++) {
foreach $client (&'property($i, 'client')) {
($host, $pass) = (split(/\s+/, $client), '');
next unless $port == ((split(/\:/, $host))[1] || $IRCPORT);
$regex = &'regex((split(/\:/, $host))[0]);
next unless $name =~ /$regex/i;
next if $pass && $pass ne $pass[$clientno];
$'userno[$clientno] = $i;
$'avail[$clientno] = 1;
&'c_print($clientno, $'servername[$'userno[$clientno]], '001', $'nick[$clientno], 'Welcome to the Internet Relay Network ' . &'user($clientno));
foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
$sub = "${module}\'client_open";
next unless defined(&$sub);
if ($'labellist{$module}) {
foreach $label (&'array($'labellist{$module})) {
&$sub($clientno);
}
} else {
&$sub($clientno);
}
}
return;
}
}
&'c_print($clientno, $NAME, '464', $'nick[$clientno], 'Password incorrect');
&'c_print($clientno, '', 'ERROR', 'Closing Link: ' . &'user($clientno) . ' (Bad Password)');
&'c_close($clientno);
}
sub cn_nick {
local($clientno, $prefix, $cmd, $nick) = @_;
$'nick[$clientno] = $nick;
&c_init($clientno) if $'user[$clientno];
}
sub cn_pass {
local($clientno, $prefix, $cmd, $pass) = @_;
$pass[$clientno] = $pass;
}
sub cn_ping {
local($clientno, $prefix, $cmd, @params) = @_;
&'c_print($clientno, &'user($clientno), '451', 'PING', 'You have not registered');
}
sub cn_quit {
local($clientno, $prefix, $cmd, $msg) = @_;
$msg = 'I Quit' unless $msg;
&'c_print($clientno, '', 'ERROR', 'Closing Link: ' . &'user($clientno) . " ($msg)");
&'c_close($clientno);
}
sub cn_user {
local($clientno, $prefix, $cmd, @params) = @_;
if (defined(@params) && scalar(@params) >= 4) {
$'user[$clientno] = $params[0];
&c_init($clientno) if $'nick[$clientno];
} else {
&'c_print($clientno, $NAME, '461', 'Not enough parameters');
}
}
sub sn_error {
local($serverno, $prefix, $cmd, @params) = @_;
$errorlist[$'userno[$serverno]] = &'add($errorlist[$'userno[$serverno]], $serverhost[$serverno]);
}
sub sn_ping {
local($serverno, $prefix, $cmd, @params) = @_;
&'s_print($serverno, '', 'PONG', @params);
}
sub sn_001 {
local($serverno, $prefix, $cmd, $nick, $msg) = @_;
local($userno, $sub, $label);
$userno = $'userno[$serverno];
$'avail[$serverno] = 1;
$'nick[$serverno] = $nick;
$'nickname[$userno] = $nick;
$'servername[$userno] = $prefix;
$errorlist[$userno] = $;;
foreach $module (&'array($'modulelist[$userno])) {
$sub = "${module}\'server_open";
next unless defined(&$sub);
if ($'labellist{$module}) {
foreach $label (&'array($'labellist{$module})) {
&$sub($serverno);
}
} else {
&$sub($serverno);
}
}
}
sub sn_433 {
local($serverno, $prefix, $cmd, $nick, $newnick, $msg) = @_;
&anothernick($serverno, $newnick);
}
sub sn_437 {
local($serverno, $prefix, $cmd, $nick, $newnick, $msg) = @_;
&anothernick($serverno, $newnick);
}
sub sn_451 {
local($serverno, $prefix, $cmd, @params) = @_;
}
sub anothernick {
local($serverno, $newnick) = @_;
local(@nickentry, $list, $user);
foreach $nick (&'property($'userno[$serverno], 'nick')) {
$list = &'add($list, split(/\,/, $nick));
}
$list = &'add($list, getlogin() || eval { (getpwuid($<))[0] });
$user = substr(getlogin() || eval { (getpwuid($<))[0] } || "$NAME-user", 0, 8);
$list = &'add($list, "${user}_", "_${user}", "${user}-", "-${user}");
if (&'exist($list, $newnick)) {
@nickentry = &'array($list);
while ($nickentry[0] ne $newnick) {
push(@nickentry, shift(@nickentry));
}
push(@nickentry, shift(@nickentry));
}
&'s_print($serverno, '', 'NICK', $nickentry[0]);
}
sub main_loop {
local($userno) = @_;
&'s_connect($userno);
&c_listen($userno);
}
sub client_open {
local($clientno) = @_;
local($userno, $serverno);
$userno = $'userno[$clientno];
$serverno = $'server[$userno];
&'c_print($clientno, &'user($clientno), 'NICK', $'nick[$serverno]) if ($serverno && $'avail[$serverno] && $'nick[$clientno] ne $'nick[$serverno]);
&'c_print($clientno, $'servername[$userno], '002', $'nick[$clientno], &'array($msg002[$userno])) if $msg002[$userno];
&'c_print($clientno, $'servername[$userno], '003', $'nick[$clientno], &'array($msg003[$userno])) if $msg003[$userno];
&'c_print($clientno, $'servername[$userno], '004', $'nick[$clientno], &'array($msg004[$userno])) if $msg004[$userno];
foreach $chan (&'array($'channellist[$userno])) {
&'c_print($clientno, &'user($clientno), 'JOIN', $chan);
&'c_print($clientno, $'servername[$userno], '332', $'nick[$clientno], $chan, $'topic{$userno, $chan}) if $'topic{$userno, $chan};
&'c_print($clientno, $'servername[$userno], '353', $'nick[$clientno], '=', $chan, join(' ', reverse(&'array($'nameslist{$userno, $chan}))));
&'c_print($clientno, $'servername[$userno], '366', $'nick[$clientno], $chan, 'End of /NAMES list.');
}
}
sub server_open {
local($serverno) = @_;
$'channellist[$'userno[$serverno]] = $;;
foreach $cno (&'array($'clientlist)) {
next unless $'avail[$cno];
next unless $'userno[$cno] == $'userno[$serverno];
next unless $'nick[$cno] ne $'nick[$serverno];
&'c_print($cno, &'user($cno), 'NICK', $'nick[$serverno]);
}
}
sub server_close {
local($serverno) = @_;
local($userno);
$userno = $'userno[$serverno];
foreach $cno (&'array($'clientlist)) {
next unless $'avail[$cno];
next unless $'userno[$cno] == $userno;
&'c_print($cno, $'servername[$userno], 'ERROR', "Closing Link: $'servername[$userno]");
}
$msg002[$userno] = '';
$msg003[$userno] = '';
$msg004[$userno] = '';
}
sub cs_exit {
local($clientno, $prefix, $cmd, $msg) = @_;
foreach $sno (&'array($'serverlist)) {
&'s_print($sno, '', 'QUIT', $msg || $NAME);
&'s_close($'userno[$sno]);
}
$msg = 'I Quit' unless $msg;
foreach $cno (&'array($'clientlist)) {
&'c_print($cno, '', 'ERROR', 'Closing Link: ' . &'user($cno) . " ($msg)");
&'c_close($cno);
}
foreach $lno (&'array($'listenlist)) {
&'close($lno);
}
exit(0);
}
sub cs_quit {
local($clientno, $prefix, $cmd, $msg) = @_;
$msg = 'I Quit' unless $msg;
&'c_print($clientno, '', 'ERROR', 'Closing Link: ' . &'user($clientno) . " ($msg)");
&'c_close($clientno);
return ();
}
sub cp_nick {
local($clientno, $prefix, $cmd, $newnick) = @_;
$'nick[$clientno] = $newnick if &'prefix($prefix) eq $'nick[$clientno];
return ($prefix, $cmd, $newnick);
}
sub ss_join {
local($serverno, $prefix, $cmd, $chan) = @_;
local($userno, $nick, $name, $mode);
$userno = $'userno[$serverno];
$nick = &'prefix($prefix);
($name, $mode) = (split(/\cG/, $chan), '');
if ($nick eq $'nick[$serverno]) {
$'channellist[$userno] = &'add($'channellist[$userno], $name);
$'nameslist{$userno, $name} = $;
} else {
if (index($mode, 'o') != -1) {
$'nameslist{$userno, $name} = &'add($'nameslist{$userno, $name}, "\@$nick");
} elsif (index($mode, 'v') != -1) {
$'nameslist{$userno, $name} = &'add($'nameslist{$userno, $name}, "\+$nick");
} else {
$'nameslist{$userno, $name} = &'add($'nameslist{$userno, $name}, $nick);
}
}
return ($prefix, $cmd, $chan);
}
sub ss_kick {
local($serverno, $prefix, $cmd, $chan, $who, $msg) = @_;
local($userno);
$userno = $'userno[$serverno];
if ($who eq $'nick[$serverno]) {
$'channellist[$userno] = &'remove($'channellist[$userno], $chan);
delete $'nameslist{$userno, $chan};
} else {
$'nameslist{$userno, $chan} = &'remove($'nameslist{$userno, $chan}, $who, "+$who", "\@$who");
}
return ($prefix, $cmd, $chan, $who, $msg);
}
sub ss_mode {
local($serverno, $prefix, $cmd, @params) = @_;
local($chan, $mode, @modes, $userno, $char, $flag, $name, $i);
($chan, $mode, @modes) = @params;
$userno = $'userno[$serverno];
for ($i = 0; $i < length($mode); $i++) {
$char = substr($mode, $i, 1);
if ($char eq '+' || $char eq '-') {
$flag = $char;
} elsif ($char eq 'b') {
shift(@modes);
} elsif ($char eq 'k') {
if ($flag eq '+') {
$'channelmode{$userno, $chan, $char} = shift(@modes);
} else {
shift(@modes);
delete $'channelmode{$userno, $chan, $char};
}
} elsif ($char eq 'l') {
if ($flag eq '+') {
$'channelmode{$userno, $chan, $char} = shift(@modes);
} else {
delete $'channelmode{$userno, $chan, $char};
}
} elsif ($char eq 'o') {
$name = shift(@modes);
if ($flag eq '+') {
$'nameslist{$userno, $chan} = &'change($'nameslist{$userno, $chan}, $name, "\@$name", "+$name", "\@$name");
} elsif ($flag eq '-') {
$'nameslist{$userno, $chan} = &'change($'nameslist{$userno, $chan}, "\@$name", $name);
}
} elsif ($char eq 'v') {
$name = shift(@modes);
if ($flag eq '+') {
$'nameslist{$userno, $chan} = &'change($'nameslist{$userno, $chan}, $name, "+$name");
} elsif ($flag eq '-') {
$'nameslist{$userno, $chan} = &'change($'nameslist{$userno, $chan}, "+$name", $name);
}
} else {
if ($flag eq '+') {
$'channelmode{$userno, $chan, $char} = 1;
} else {
delete $'channelmode{$userno, $chan, $char};
}
}
}
return ($prefix, $cmd, @params);
}
sub ss_nick {
local($serverno, $prefix, $cmd, $newnick) = @_;
local($userno, $nick);
$userno = $'userno[$serverno];
$nick = &'prefix($prefix);
if ($nick eq $'nick[$serverno]) {
$'nick[$serverno] = $newnick;
$'nickname[$userno] = $newnick;
}
foreach $chan (&'array($'channellist[$userno])) {
$'nameslist{$userno, $chan} = &'change($'nameslist{$userno, $chan}, $nick, $newnick, "+$nick", "+$newnick", "\@$nick", "\@$newnick");
}
return ($prefix, $cmd, $newnick);
}
sub ss_part {
local($serverno, $prefix, $cmd, $chan, $msg) = @_;
local($userno, $nick);
$userno = $'userno[$serverno];
$nick = &'prefix($prefix);
if ($nick eq $'nick[$serverno]) {
$'channellist[$userno] = &'remove($'channellist[$userno], $chan);
delete $'nameslist{$userno, $chan};
} else {
$'nameslist{$userno, $chan} = &'remove($'nameslist{$userno, $chan}, $nick, "+$nick", "\@$nick");
}
return ($prefix, $cmd, $chan, $msg);
}
sub ss_ping {
local($serverno, $prefix, $cmd, @params) = @_;
&'s_print($serverno, '', 'PONG', @params);
return ($prefix, $cmd, @params);
}
sub ss_quit {
local($serverno, $prefix, $cmd, $msg) = @_;
local($userno, $nick);
$userno = $'userno[$serverno];
$nick = &'prefix($prefix);
foreach $chan (&'array($'channellist[$userno])) {
$'nameslist{$userno, $chan} = &'remove($'nameslist{$userno, $chan}, $nick, "+$nick", "\@$nick");
}
return ($prefix, $cmd, $msg);
}
sub ss_topic {
local($serverno, $prefix, $cmd, $chan, $topic) = @_;
$'topic{$'userno[$serverno], $chan} = $topic;
return ($prefix, $cmd, $chan, $topic);
}
sub ss_002 {
local($serverno, $prefix, $cmd, $nick, @params) = @_;
$msg002[$'userno[$serverno]] = &'list(@params);
return ($prefix, $cmd, $nick, @params);
}
sub ss_003 {
local($serverno, $prefix, $cmd, $nick, @params) = @_;
$msg003[$'userno[$serverno]] = &'list(@params);
return ($prefix, $cmd, $nick, @params);
}
sub ss_004 {
local($serverno, $prefix, $cmd, $nick, @params) = @_;
$msg004[$'userno[$serverno]] = &'list(@params);
return ($prefix, $cmd, $nick, @params);
}
sub ss_332 {
local($serverno, $prefix, $cmd, $nick, $chan, $topic) = @_;
$'topic{$'userno[$serverno], $chan} = $topic;
return ($prefix, $cmd, $nick, $chan, $topic);
}
sub ss_353 {
local($serverno, $prefix, $cmd, @params) = @_;
local($userno);
$userno = $'userno[$serverno];
$'nameslist{$userno, $params[2]} = &'add($'nameslist{$userno, $params[2]}, reverse(split(/\s+/, $params[3])));
return ($prefix, $cmd, @params);
}
sub cs_privmsg {
local($clientno, $prefix, $cmd, $chan, $msg) = @_;
local($tmp, $ctmp, $rest, $ctcp, $list);
return () unless $msg;
$tmp = $ctmp = '';
$rest = $msg;
while ($rest =~ /^(.*)\cA([^\cA]*)\cA(.*)$/) {
$tmp .= $1;
$ctmp .= $1;
$ctcp = $2;
$rest = $3;
$tmp .= &cpc_scan($clientno, $prefix, $ctcp) unless &'exist($list, $ctcp);
$list = &'add($list, $ctcp);
}
$tmp .= $rest || '';
$ctmp .= $rest || '';
return () unless $tmp;
foreach $cno (&'array($'clientlist)) {
next unless $clientno != $cno;
next unless $'avail[$cno];
next unless $'userno[$clientno] == $'userno[$cno];
&'c_print($cno, &'user($cno), $cmd, $chan, $ctmp);
}
return ($prefix, $cmd, $chan, $tmp);
}
sub cp_privmsg {
local($clientno, $prefix, $cmd, $chan, $msg) = @_;
local($tmp, $rest, $ctcp, $list);
return () unless $msg;
$tmp = '';
$rest = $msg;
while ($rest =~ /^(.*)\cA([^\cA]*)\cA(.*)$/) {
$tmp .= $1;
$ctcp = $2;
$rest = $3;
$tmp .= &cpc_print($clientno, $prefix, $ctcp) unless &'exist($list, $ctcp);
$list = &'add($list, $ctcp);
}
$tmp .= $rest || '';
return () unless $tmp;
return ($prefix, $cmd, $chan, $tmp);
}
sub ss_privmsg {
local($serverno, $prefix, $cmd, $chan, $msg) = @_;
local($tmp, $rest, $ctcp, $list);
return () unless $msg;
$tmp = '';
$rest = $msg;
while ($rest =~ /^(.*)\cA([^\cA]*)\cA(.*)$/) {
$tmp .= $1;
$ctcp = $2;
$rest = $3;
$tmp .= &cps_scan($serverno, $prefix, $ctcp) unless &'exist($list, $ctcp);
$list = &'add($list, $ctcp);
}
$tmp .= $rest || '';
return () unless $tmp;
return ($prefix, $cmd, $chan, $tmp);
}
sub sp_privmsg {
local($serverno, $prefix, $cmd, $chan, $msg) = @_;
local($tmp, $rest, $ctcp, $list);
return () unless $msg;
$tmp = '';
$rest = $msg;
while ($rest =~ /^(.*)\cA([^\cA]*)\cA(.*)$/) {
$tmp .= $1;
$ctcp = $2;
$rest = $3;
$tmp .= &cps_print($serverno, $prefix, $ctcp) unless &'exist($list, $ctcp);
$list = &'add($list, $ctcp);
}
$tmp .= $rest || '';
return () unless $tmp;
return ($prefix, $cmd, $chan, $tmp);
}
sub cpc_scan {
local($clientno, $prefix, $ctcp) = @_;
local($cmd, $msg, $sub, $label);
($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
return '' unless $cmd;
foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
$sub = "${module}\'cpcs_\L$cmd\E";
next unless defined(&$sub);
if ($'labellist{$module}) {
foreach $label (&'array($'labellist{$module})) {
($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
last unless $cmd;
}
} else {
($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
}
last unless $cmd;
}
return '' unless $cmd;
return "\cA$cmd $msg\cA";
}
sub cpc_print {
local($clientno, $prefix, $ctcp) = @_;
local($cmd, $msg, $sub, $label);
($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
return '' unless $cmd;
foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
$sub = "${module}\'cpcp_\L$cmd\E";
next unless defined(&$sub);
if ($'labellist{$module}) {
foreach $label (&'array($'labellist{$module})) {
($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
last unless $cmd;
}
} else {
($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
}
last unless $cmd;
}
return '' unless $cmd;
return "\cA$cmd $msg\cA";
}
sub cps_scan {
local($serverno, $prefix, $ctcp) = @_;
local($cmd, $msg, $sub, $label);
($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
return '' unless $cmd;
foreach $module (&'array($'modulelist[$'userno[$serverno]])) {
$sub = "${module}\'cpss_\L$cmd\E";
next unless defined(&$sub);
if ($'labellist{$module}) {
foreach $label (&'array($'labellist{$module})) {
($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
last unless $cmd;
}
} else {
($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
}
last unless $cmd;
}
return '' unless $cmd;
return "\cA$cmd $msg\cA";
}
sub cps_print {
local($serverno, $prefix, $ctcp) = @_;
local($cmd, $msg, $sub, $label);
($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
return '' unless $cmd;
foreach $module (&'array($'modulelist[$'userno[$serverno]])) {
$sub = "${module}\'cpsp_\L$cmd\E";
next unless defined(&$sub);
if ($'labellist{$module}) {
foreach $label (&'array($'labellist{$module})) {
($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
last unless $cmd;
}
} else {
($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
}
last unless $cmd;
}
return '' unless $cmd;
return "\cA$cmd $msg\cA";
}
sub cs_notice {
local($clientno, $prefix, $cmd, $chan, $msg) = @_;
local($tmp, $ctmp, $rest, $ctcp, $list);
return () unless $msg;
$tmp = $ctmp = '';
$rest = $msg;
while ($rest =~ /^(.*)\cA([^\cA]*)\cA(.*)$/) {
$tmp .= $1;
$ctmp .= $1;
$ctcp = $2;
$rest = $3;
$tmp .= &cnc_scan($clientno, $prefix, $ctcp) unless &'exist($list, $ctcp);
$list = &'add($list, $ctcp);
}
$tmp .= $rest || '';
$ctmp .= $rest || '';
return () unless $tmp;
foreach $cno (&'array($'clientlist)) {
next unless $clientno != $cno;
next unless $'avail[$cno];
next unless $'userno[$clientno] == $'userno[$cno];
&'c_print($cno, &'user($cno), $cmd, $chan, $ctmp);
}
return ($prefix, $cmd, $chan, $tmp);
}
sub cp_notice {
local($clientno, $prefix, $cmd, $chan, $msg) = @_;
local($tmp, $rest, $ctcp, $list);
return () unless $msg;
$tmp = '';
$rest = $msg;
while ($rest =~ /^(.*)\cA([^\cA]*)\cA(.*)$/) {
$tmp .= $1;
$ctcp = $2;
$rest = $3;
$tmp .= &cnc_print($clientno, $prefix, $ctcp) unless &'exist($list, $ctcp);
$list = &'add($list, $ctcp);
}
$tmp .= $rest || '';
return () unless $tmp;
return ($prefix, $cmd, $chan, $tmp);
}
sub ss_notice {
local($serverno, $prefix, $cmd, $chan, $msg) = @_;
local($tmp, $rest, $ctcp, $list);
return () unless $msg;
$tmp = '';
$rest = $msg;
while ($rest =~ /^(.*)\cA([^\cA]*)\cA(.*)$/) {
$tmp .= $1;
$ctcp = $2;
$rest = $3;
$tmp .= &cns_scan($serverno, $prefix, $ctcp) unless &'exist($list, $ctcp);
$list = &'add($list, $ctcp);
}
$tmp .= $rest || '';
return () unless $tmp;
return ($prefix, $cmd, $chan, $tmp);
}
sub sp_notice {
local($serverno, $prefix, $cmd, $chan, $msg) = @_;
local($tmp, $rest, $ctcp, $list);
return () unless $msg;
$tmp = '';
$rest = $msg;
while ($rest =~ /^(.*)\cA([^\cA]*)\cA(.*)$/) {
$tmp .= $1;
$ctcp = $2;
$rest = $3;
$tmp .= &cns_print($serverno, $prefix, $ctcp) unless &'exist($list, $ctcp);
$list = &'add($list, $ctcp);
}
$tmp .= $rest || '';
return () unless $tmp;
return ($prefix, $cmd, $chan, $tmp);
}
sub cnc_scan {
local($clientno, $prefix, $ctcp) = @_;
local($cmd, $msg, $sub, $label);
($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
return '' unless $cmd;
foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
$sub = "${module}\'cncs_\L$cmd\E";
next unless defined(&$sub);
if ($'labellist{$module}) {
foreach $label (&'array($'labellist{$module})) {
($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
last unless $cmd;
}
} else {
($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
}
last unless $cmd;
}
return '' unless $cmd;
return "\cA$cmd $msg\cA";
}
sub cnc_print {
local($clientno, $prefix, $ctcp) = @_;
local($cmd, $msg, $sub, $label);
($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
return '' unless $cmd;
foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
$sub = "${module}\'cncp_\L$cmd\E";
next unless defined(&$sub);
if ($'labellist{$module}) {
foreach $label (&'array($'labellist{$module})) {
($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
last unless $cmd;
}
} else {
($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
}
last unless $cmd;
}
return '' unless $cmd;
return "\cA$cmd $msg\cA";
}
sub cns_scan {
local($serverno, $prefix, $ctcp) = @_;
local($cmd, $msg, $sub, $label);
($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
return '' unless $cmd;
foreach $module (&'array($'modulelist[$'userno[$serverno]])) {
$sub = "${module}\'cnss_\L$cmd\E";
next unless defined(&$sub);
if ($'labellist{$module}) {
foreach $label (&'array($'labellist{$module})) {
($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
last unless $cmd;
}
} else {
($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
}
last unless $cmd;
}
return '' unless $cmd;
return "\cA$cmd $msg\cA";
}
sub cns_print {
local($serverno, $prefix, $ctcp) = @_;
local($cmd, $msg, $sub, $label);
($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
return '' unless $cmd;
foreach $module (&'array($'modulelist[$'userno[$serverno]])) {
$sub = "${module}\'cnsp_\L$cmd\E";
next unless defined(&$sub);
if ($'labellist{$module}) {
foreach $label (&'array($'labellist{$module})) {
($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
last unless $cmd;
}
} else {
($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
}
last unless $cmd;
}
return '' unless $cmd;
return "\cA$cmd $msg\cA";
}
__END__
<DL>
<DT> plum.kanji* ({euc|jis|sjis})
<DT> plum.nick* ($B%K%C%/%M!<%`(B)
<DT> plum.user $B%f!<%6%M!<%`(B
<DT> plum.name $B<BL>(B
<DT> plum.server* $B%5!<%PL>(B[:$B%]!<%HHV9f(B] [$B%Q%9%o!<%I(B]
<DT> plum.client* $B%/%i%$%"%s%H%^%9%/(B[:$B%]!<%HHV9f(B] [$B%Q%9%o!<%I(B]
</DL>