#! /usr/local/bin/perl

##############################################################################
#									     #
#	pirc (version 3.3.5)				  	      	     #
#									     #
#					kick@kaba.or.jp			     #
#					(t90128to@sfc.keio.ac.jp)	     #
#									     #
##############################################################################

#どういうものか？
#  IRCのための一種のclientです。ただし、User Interfaceをもってないので、
#  IRC server (ircd) <-> pirc <-> IRC client (irchat.el etc.)
#  のようにして使います。pircへは、IRC clientは複数つなぐことができます。
#  また、pircは常駐するので、clientを任意につなげたり切ったりさせます。

#めりっとは？
#   ふつ〜(≠ふつう)のひとだけにとってのめりっとですので、注意を。
#   ・clientを終えたり、logoutしちゃっても、IRCに常駐できる。あやし〜
#   ・killされても、kickされても、以前の状態で、自動復活する。
#   ・irchat.elなどのとき、emacs を C-z してても死なない。
#   ・clientから serverへ直接届かなくても、connectionを中継させられる。
#   ・emacs上の clientでは、IP addressで指定できない点も解決される。
#   ・clientを自由に切り離せるので、場所を移ったり、家からモデムで
#     はいったりして clientが変わっても、そのままつかえる。
#   ・clientを複数つなげることができ、また、channelをマスクできるので、
#     複数のchannelに入っている時も独立したclientで使うこともできる。
#   ・途中で、server を変更でき、いろいろな状態は自動的に復帰する。
#   ・serverとの接続が切れた時に、自動的に復活して、元の状況にする。
#   ・/operしてるときにくる情報も、カットしたり短縮表示したりできる。
#   ・ログが自動的にとられる。立ち上げた directory上に一日分毎に作られる。
#     （ただし、ログされるのは、msg, privmsg など重要と思われるものだけ）
#   ・Ver.3.2から、IRC client-to-client communication protcol に対応。

#つかいかた
#   (irchat.elは、必ずVer.2.2以上のものをお使いください）
#   pircはperlで書かれていますから、perlがinstallされてなければなりません。
#   perlがあれば、「chmod +x」して実行するか、「perl pirc」で起動します。
#   その前に各種設定(configulation)のために、".pircrc" ファイルを用意するか
#   ver.3.1 のように環境変数を設定しなければなりません。
#   ".pircrc" ファイルは、環境変数 PIRCRC, "./.pircrc", "‾/.pircrc" の順で
#   優先されます。書式は次のように、変数とその内容を列挙します。
#      % cat .pircrc
#      NICK      foo
#      NAME      foo bar
#      CHANNEL   #Nippon:+Nippon:#Kyoto
#      SERVER    irc.kyoto-u.ac.jp
#      PORT      6667
#      PASSWD    pasuwaado
#      USERINFO  Hello!
#      OPER      operator passwd
#      AWAYNICK  foo_d
#      AWAYMSG   I'm sleeping....
#   このうち、必ず書かなければならないものは、SERVER と PASSWD だけです。
#   また、これらは環境変数によっても設定でき、次のようになります。
#      setenv PIRCNICK foo (or setenv IRCNICK foo)
#         起動時の nicknameを、fooにします。
#      setenv PIRCNAME 'foo bar' (or ... IRCNAME ... or ... NAME ...)
#         自分の名前を foo barに、設定します。
#      setenv PIRCCHANNEL #Nippon:+Nippon:#Kyoto (or ... IRCCHANNEL ...)
#         起動時のchannelを、#Nippon +Nippon #Kyotoの３つにします。
#      setenv PIRCSERVER irc.kyoto-u.ac.jp (or setenv IRCSERVER ...)
#         IRC serverを、irc.kyoto-u.ac.jpにします。IP addressでもOK。
#      setenv PIRCPORT 6667 (or setenv IRCPORT ...)
#         IRC serverの port numberを、6667にします。
#      setenv PIRCPASSWD pasuwaado
#         IRC clientを pircへつなぐときのパスワードを pasuwaadoにします。
#      setenv PIRCUSERINFO Hello!
#         IRC client-to-client communication protcol での user infomation
#      setenv AWAYNICK foo_d
#         clientが接続されていない時のnicknameをfoo_dにします。
#      setenv AWAYMSG sleeping
#         clientが接続されていない時のメッセージを sleeping にします。
#   次に、IRC clientの pircへのつなぎかたですが、pircを IRC serverだと
#   思わせて使用します。つまり、clientで指定するサーバー名は、pircが
#   動いているホスト名になります。port numberをdefaultから変えたい時は、
#         ircd (PIRCPORT) <- pirc (IRCPORT) <- client
#   となりますから、通常の clientは IRCPORTを見ますのでそれを変えて下さい。
#   （.pircrcのなかでは、server側はSPORT、client側はCPORTで設定できます。）
#         ircd (PIRCSERVER) <- pirc (IRCSERVER) <- client
#   サーバー名の関係についてもこのようになり、通常の clientは IRCSERVERを
#   みますから、それぞれの環境変数を適当に変更して下さい。
#   clientが pircに接続した後、パスワードを入れなければなりません。
#   これは、例えば irchat.elならば、/pasuwaado [ret]と、します。また、
#      (setq irchat-Startup-hook '(lambda () (irchat-send "pasuwaado")))
#   と設定しておけば、自動的にパスワードが送られて非常に便利です。

#こまんど
#   現在、pircには、以下のような内部コマンドがあります。
#   /myinfo
#       各種情報を返します。
#   /mynames
#       自分の属しているチャネルについての /namesの結果を返します。
#   /mychan
#       自分の属してるチャネルのリストを返します。
#   /chanall
#       属しているすべてのチャネルの会話を見るようにします。(default)
#   /chan <channel>
#       <channel> での会話だけを見るように設定します。
#   /chan+ <channel>
#       <channel> の会話を見るようにします。
#   /chan- <channel>
#       <channel> の会話を見ないようにします。
#   /operon
#       /operしてるときに、すべてのメッセージを伝えます。(default)
#   /operhalf
#       /operしてるときに、短縮してメッセージを伝えます。
#   /operoff
#       /operしてるときに、全くしてない時と同じようにします。
#   /passwd <password>
#       パスワードを変更します。
#   /userinfo <info>
#       user informationを変更します。
#   /anick <away nick>
#       clientが接続されていない時のnickを設定/変更します。
#   /amsg <message>
#       clientが接続されていない時のmessageを設定/変更します。
#   /server <server> [<port>]
#       接続する IRC serverを変更します。再接続時にも状態を保持します。
#   /bye
#       pircを終了します。

$version = '3.3.5';
&init_pirc;
@_ = getpwuid($<);
$_[6] =‾ s/,.*$//;
$my_user = $_[0];
$my_nick = $ENV{'PIRCNICK'} || $ENV{'IRCNICK'} || $_[0];
$my_name = $ENV{'PIRCNAME'} || $ENV{'IRCNAME'} || $ENV{'NAME'} || $_[6];
$server = $ENV{'PIRCSERVER'} || $ENV{'IRCSERVER'};
$sport = $ENV{'PIRCPORT'} || $ENV{'IRCPORT'} || '6667';
$cport = $ENV{'IRCPORT'} || '6667';
$passwd = $ENV{'PIRCPASSWD'} || (-f '.pircpasswd' && `cat .pircpasswd`);
$my_oper = $ENV{'PIRCOPER'} || (-f '.pircoper' && `cat .pircoper`);
$userinfo = $ENV{'PIRCUSERINFO'} || "Nothing";
$chanlist = $ENV{'PIRCCHANNEL'} || $ENV{'IRCCHANNEL'} || '0';
$auto_away_message = $ENV{'AWAYMSG'} || '';
$my_away_nick = $ENV{'AWAYNICK'} || '';
$pircrc = $ENV{'PIRCRC'} || '.pircrc';
$pircrc = $ENV{'HOME'} . '/.pircrc' unless -f $pircrc;
if (open(PIRCRC, "$pircrc")) {
  while(<PIRCRC>) {
    next if $_ =‾ /^#/;
    chop;
    ($var, $arg) = split(/¥s+/, $_, 2);
    $my_nick = $arg if $var eq 'NICK';
    $my_name = $arg if $var eq 'NAME';
    $server = $arg if $var eq 'SERVER';
    $sport = $arg if $var eq 'SPORT';
    $cport = $arg if $var eq 'CPORT';
    $cport = $sport = $arg if $var eq 'PORT';
    $passwd = $arg if $var eq 'PASSWD';
    $userinfo = $arg if $var eq 'USERINFO';
    $chanlist = $arg if $var eq 'CHANNEL';
    $chanlist = $arg if $var eq 'CHANLIST';
    $my_oper = $arg if $var eq 'OPER';
    $auto_away_message = $arg if $var eq 'AWAYMSG';
    $my_away_nick = $arg if $var eq 'AWAYNICK';
    $no_compress_log = $arg if $var eq 'NOCOMPRESSLOG';
  }
  close(PIRCRC);  
}

$chanlist = ":$chanlist:";
$chanlist =‾ s/:/$;/g;
if ($auto_away_message) {
  $auto_away = 1;
  $_my_away_message = '';
  $my_away_message = $auto_away_message;
} else {
  $auto_away = 0;
  $my_away_message = '';
}
$my_old_nick = $my_nick;
if ($my_away_nick) {
  $auto_nick = 1;
  $my_nick = $my_away_nick;
} else {
  $auto_nick = 0;
}  
$server || die "Please write SERVER in .pircrc or 'setenv PIRCSERVER ...'¥n";
$passwd || die "Please write PASSWD in .pircrc or 'setenv PIRCPASSWD ...'¥n";
&listen_client || die "Cannot listen to client.¥n";
&connect_server || die "Cannot connect to $server($sport).¥n";
&daemon_pirc;

## main loop
for (;;) {
  $nfound = select($rout=$rin, $wout=$win, $eout=$ein, $interval);
  if ($nfound == 0) {
    if (time - $Fprinttime > $Fprinttimeout) {
      $Fprinttime = time;
      &print_time;
    }
    if ($Sconnect) {
      if (time - $Stime > $Stimeout) {
        $Stime = time;
        &sendS("PING PIRC¥n"); ## for dead connection
      }
    } else {
      if (time - $Sconnecttime > $Sconnecttimeout) {
        $Sconnecttime = time;
        &connect_server;
      }
    }
    next;
  }
  if ($nfound < 0) {
    &logF("fatal error in select. exit...¥n");
    exit(1);
  }
  if (vec($rout, $Ln, 1)) {
    &init_client;
  }
  for ($Cn = 0; $Cn < 256; $Cn++) {
    next if !vec($rout, $Cn, 1);
    next if !vec($Call, $Cn, 1);
    $C = $C[$Cn];
    if (!read($C, $tmp, 1024)) {
      &logF("*** close $host[$Cn]($port[$Cn]) ***¥n");
      &close_client;
    } else {
      $tmp =‾ tr/¥015/¥012/;
      $Cbuf[$Cn] .= $tmp;
      while (split(/¥n/, $Cbuf[$Cn], 2) == 2) {
        $line = $_[0];
        $Cbuf[$Cn] = $_[1];
        &client;
      }
      $Cbuf[$Cn] = $_[0];
    }
  }
  if (vec($rout, $Sn, 1)) {
    if (!read(SERVER, $tmp, 1024)) {
      &logF("*** server close!! ***¥n");
      &sendCok("NOTICE * :*** closed by server $server ***¥n");
      &close_server;
    } else {
      $Stime = time;
      $Sbuf .= $tmp;
      while (split(/¥n/, $Sbuf, 2) == 2) {
        $line = $_[0];
        $Sbuf = $_[1];
        &server;
      }
      $Sbuf = $_[0];
    }
  }
}
## never reachable!!

sub client {
  if ($line =‾ /^quit/i) {
    &logF("*** quit $host[$Cn]($port[$Cn]) ***¥n");
    &close_client;
    return;
  }
  ($command, $rest) = ($line =‾ /^ *([^ ]+) *:?(.*)$/);
  $command =‾ tr/A-Z/a-z/;
  if ($command eq 'ping') {
    if ($rest =‾ /^PIRC-FIRST$/) {
      &logF("*** error $host[$Cn]($port[$Cn]) ***¥n");
      &sendC("NOTICE * :Recursive Call??¥n");
      &close_client;
      return;
    }
    &sendS("PING PIRC-$Cn-$command-$rest¥n");
    return;
  }
  if ($command eq 'pong') {
    return;
  }
  if (!vec($Cok, $Cn, 1)) {
    &nopasswd;
    return;
  }
  if ($command eq 'privmsg') {
    ($to, $message) = ($rest =‾ /^([^ ]+) *:?(.*)$/);
    $last_to = $to;
    $message =‾ s/¥001COMMENT[^¥001]*¥001//;
    &logF(">$to< $message¥n");
    $Cchan = $Cchan{$to};
    &sendCchan2("NOTICE * :>$to< $message¥n");
  }
  if ($command eq 'msg') {
    &logF("> $rest¥n");
    $Cchan = $Cchan{$my_channel};
    &sendCchan2("NOTICE * :> $rest¥n");
  }
  if ($command eq 'nick') {
    $my_old_nick = $my_nick;
    $my_nick = $rest;
    $my_nick =‾ s/^ *//g;
    $my_nick =‾ s/ *$//g;
  }
  if ($command eq 'away') {
    if ($rest =‾ /^ *$/) {
      &logF("Away off¥n");
      $my_away_message = '';
    } else {
      &logF("Away: $rest¥n");
      $my_away_message = $rest;
    }
  }
  if ($command eq 'who' || $command eq 'links'
	|| $command eq 'names' || $command eq 'list') {
    &sendS("PING PIRC-$Cn-$command-¥n");
    &sendS($line . "¥n");
    return;
  }
  if ($command eq 'oper') {
    $oper = 'on';
    $my_oper = $rest;
  }
  ## pirc commands
  if ($command eq 'operon') {
    $oper = 'on';
    return;
  }
  if ($command eq 'operhalf') {
    $oper = 'half';
    return;
  }
  if ($command eq 'operoff') {
    $oper = 'off';
    return;
  }
  if ($command eq 'bye') {
    &logF("*** Bye¥n");
    &sendS("quit¥n");
    exit;
  }
  if ($command eq 'passwd') {
    $passwd = $rest;
    return;
  }
  if ($command eq 'userinfo') {
    $userinfo = $rest;
    return;
  }
  if ($command eq 'ircname') {
    $my_name = $rest;
    return;
  }
  if ($command eq 'chanall') {
    &chanall;
    &mychan;
    return;
  }
  if ($command eq 'chan+') {
    if (defined($Cchan{$rest})) {
      vec($Cchan{$rest}, $Cn, 1) = 0;
      &mychan;
    } else {
      &sendC("NOTICE * :You're not in $rest.¥n");
    }
    return;
  }
  if ($command eq 'chan-') {
    if (defined($Cchan{$rest})) {
      vec($Cchan{$rest}, $Cn, 1) = 1;
      &mychan;
    } else {
      &sendC("NOTICE * :You're not in $rest.¥n");
    }
    return;
  }
  if ($command eq 'chan') {
    if (defined($Cchan{$rest})) {
      vec($Cchan{$my_channel}, $Cn, 1) = 1;
      for ($i = 0; $i <= $#my_channels; $i++) {
        vec($Cchan{$my_channels[$i]}, $Cn, 1) = 1;
      }
      vec($Cchan{$rest}, $Cn, 1) = 0;
      &mychan;
    } else {
      &sendC("NOTICE * :You're not in $rest.¥n");
    }
    return;
  }
  if ($command eq 'mychan') {
    &mychan;
    return;
  }
  if ($command eq 'mynames') {
    &mynames;
    return;
  }
  if ($command eq 'mynames2') {
    &mynames2;
    return;
  }
  if ($command eq 'myinfo') {
    &sendC("NOTICE * :nick: $my_nick¥n");
    &sendC("NOTICE * :user: $my_user¥n");
    &sendC("NOTICE * :name: $my_name¥n");
    &sendC("NOTICE * :away: $my_away_message¥n") if $my_away_message;
    &sendC("NOTICE * :oper: $oper¥n") if $oper ne '';
    &sendC("NOTICE * :server: $Sn $server($sport)¥n") if $Sconnect;
    for ($CCn = 0; $CCn < 256; $CCn++) {
      next if !vec($Call, $CCn, 1);
      &sendC("NOTICE * :client: $CCn $host[$CCn]($port[$CCn])¥n");
    }
    &sendC("NOTICE * :nick(away): $my_away_nick¥n") if $my_away_nick;
    &sendC("NOTICE * :message(away): $auto_away_message¥n")
                                               if $auto_away_message;
    &mychan;
    return;
  }
  if ($command eq 'server') {
    ($server, $port) = ($rest =‾ /^([^ ]+) *([^ ]*)$/);
    $sport = $port if $port ne '';
    &sendC("NOTICE * :*** old server has been closed ***¥n");
    $Snopong = 0;  ## umm...
    &close_server;
    return;
  }
  if ($command eq 'amsg') {
    if ($rest =‾ /^ *$/) {
      $auto_away_message = '';
    } else {
      $auto_away_message = $rest;
    }
    return;
  }
  if ($command eq 'anick') {
    if ($rest =‾ /^ *$/) {
      $my_away_nick = '';
    } else {
      $my_away_nick = $rest;
      $my_away_nick =‾ s/^ *//g;
      $my_away_nick =‾ s/ *$//g;
    }
    return;
  }
  &sendS($line . "¥n");
}

sub mynames {
  if ($my_channel ne '0') {
    &sendS("PING PIRC-$Cn-names-¥n");
    &sendS("NAMES $my_channel¥n");
  }
  for ($i = 0; $i <= $#my_channels; $i++) {
    &sendS("PING PIRC-$Cn-names-¥n");
    &sendS("NAMES $my_channels[$i]¥n");
  }
}

sub mynames2 {
  @chan = split(/$;/, $chanlist);
  for ($i = 1; $i <= $#chan ; $i++) {
    ($tmp = $nameslist{$chan[$i]}) =‾ s/$;/ /g;
     $tmp =‾ s/^ //;
    &sendC(":PIRC 353 $my_nick = $chan[$i] :$tmp¥n");
  }
  &sendC(":PIRC 366 $my_nick :* End of /NAMES list.¥n");
}

sub mynames3 {
  @chan = split(/$;/, $chanlist);
  &sendC(":PIRC 366 $my_nick :* End of /NAMES list.¥n");
  for ($i = 1; $i <= $#chan ; $i++) {
    &sendC(":$my_nick!$machinename JOIN $chan[$i]¥n");
    ($tmp = $nameslist{$chan[$i]}) =‾ s/$;/ /g;
     $tmp =‾ s/^ //;
    &sendC(":PIRC 353 $my_nick = $chan[$i] :$tmp¥n");
    &sendC(":PIRC 366 $my_nick :* End of /NAMES list.¥n");
  }
}

sub mychan {
  &sendC("NOTICE * :*** You are in");
  if ($my_channel ne '0') {
    if (vec($Cchan{$my_channel}, $Cn, 1)) {
      &sendC(" ($my_channel)");
    } else {
      &sendC(" $my_channel");
    }
  }
  for ($i = 0; $i <= $#my_channels; $i++) {
    if (vec($Cchan{$my_channels[$i]}, $Cn, 1)) {
      &sendC(" ($my_channels[$i])");
    } else {
      &sendC(" $my_channels[$i]");
    }
  }
  &sendC(".¥n");
}

sub chanall {
  vec($Cchan{$my_channel}, $Cn, 1) = 0;
  for ($i = 0; $i <= $#my_channels; $i++) {
    vec($Cchan{$my_channels[$i]}, $Cn, 1) = 0;
  }
}

sub nopasswd {
  if ($line =‾ /^ping/i) {
    &sendC("PONG PIRC¥n");
  }
  if ($line =‾ /^user/i) {
    &sendC("NOTICE * :Please input your password.¥n");
  }
  if ($line =‾ /^nick/i) {
    ($command, $client_nick) = ($line =‾ /^ *([^ ]+) *:?(.*)$/);
  }
  if ($line =‾ /^oper/i) {
    if (!$oper) {
      $oper = 'on';
      ($tmp, $my_oper) = split(/ /, $rest, 2);
      &sendS($line . "¥n");
    }
  }
  if ($line =‾ /^$passwd/) {
    vec($Cok, $Cn, 1) = 1;
    &logF("*** password $host[$Cn]($port[$Cn]) ***¥n");
    #&sendC("NOTICE $my_nick :*** Welcome to the IRC world!! ***¥n");
    &sendC("NOTICE $client_nick :*** Welcome to the IRC world!! ***¥n");
    &sendC(":$client_nick NICK $my_nick¥n");
    if ($Sconnect) {
      &mynames3;
      #&sendS("PING PIRC-TAILLOG¥n");
      &taillog;
    } else {
      &sendC("NOTICE * :*** Now, no server connection. ***¥n");
    }
    &sendC(":PIRC 301 $my_nick $my_nick :$my_away_message¥n")
                                           if $my_away_message;
  }
  return;
}

sub taillog {
  if($taillog) {
    if (open(TAIL, "tail -15 $logfile|")) {
      while(<TAIL>) {
        next if (/^¥*¥*¥*/);
        #next if (/^[¥!¥+¥-]/);
        &sendC("NOTICE * :$_");
      }
      close(TAIL);
    }
  }
}

sub server {
  ($from, $where, $command, $rest) = 
                    ($line =‾ /^(:[^! ]*)?(![^ ]*)? *([^ ]+) :?(.*)$/);
  $from =‾ s/^://;
  $where =‾ s/^!//;
  $command =‾ tr/A-Z/a-z/;
  if ($command eq 'topic') {
    ($channel, $topic) = split(/ /, $rest, 2);
    $topic =‾ s/^://;
    &logF("Topic of channel $channel by $from: $topic¥n");
    $Cchan = $Cchan{$my_channel};
    &sendCchan("$line¥n");
    return;
  }
  if ($command eq 'join') {
    &logF("+ $from to $rest¥n");
    if ($from eq $my_nick) {
      $Cchan{$rest} = '';
      &logF('');
      if ($rest =‾ /^#/) {
        $my_channels[$#my_channels + 1] = $rest;
      } else {
        $my_channel = $rest;
      }
      &AddList($chanlist, $rest);
      &InitList($nameslist{$rest});
    }
    &AddList($nameslist{$rest}, $from);
    $Cchan = $Cchan{$rest};
    &sendCchan("$line¥n");
    return;
  }
  if ($command eq 'part') {
    &logF("- $from from $rest¥n");
    if ($from eq $my_nick) {
      undef($Cchan{$rest});
      if ($rest =‾ /^#/) {
        for ($i = 0; $i <= $#my_channels; $i++) {
          if ($my_channels[$i] eq $rest) {
            $my_channels[$i] = pop @my_channels;
          }
        }
      } else {
        $my_channel = '0';
      }
      &DelList($chanlist, $rest);
      undef($nameslist{$rest});
    } else {
      &DelList($nameslist{$rest}, $from);
    }
    $Cchan = $Cchan{$rest};
    &sendCchan("$line¥n");
    return;
  }
  if ($command eq 'quit') {
    &logF("! $from¥n");
    @chan = split(/$;/, $chanlist);
    for ($Cchan = ‾0, $i = 1; $i <= $#chan; $i++) {
      if (&DelList($nameslist{$chan[$i]}, $from)) {
        $Cchan &= $Cchan{$chan[$i]};        
      }
    }
    &sendCchan("$line¥n");
    return;
  }
  if ($command eq 'kick') {
    ($channel, $whom) = split(/ /, $rest, 2);
    &logF("- $whom by $from¥n");
    if ($whom eq $my_nick) {
      undef($Cchan{$channel});
      if ($channel =‾ /^#/) {
        for ($i = 0; $i <= $#my_channels; $i++) {
          if ($my_channels[$i] eq $channel) {
            $my_channels[$i] = pop @my_channels;
          }
        }
        &sendS("JOIN $channel¥n");
      } else {
        $my_channel = '0';
        &sendS("CHANNEL $channel¥n");
      }
      &DelList($chanlist, $channel);
      undef($nameslist{$channel});
    } else {
      &DelList($nameslist{$channel}, $whom);
    }
    $Cchan = $Cchan{$channel};
    &sendCchan("$line¥n");
    return;
  }
  if ($command eq 'mode') {
    ($channel, $mode) = split(/ /, $rest, 2);
    &logF("Mode by $from: $channel $mode¥n");
    $Cchan = $Cchan{$channel};
    &sendCchan("$line¥n");
    return;
  }
  if ($command eq 'nick') {
    if ($from eq $my_old_nick && $rest eq $my_nick) {
      &logF("My nick is changed.¥n");
    }
    &logF("$from -> $rest¥n");
    @chan = split(/$;/, $chanlist);
    for ($Cchan = ‾0, $i = 1; $i <= $#chan; $i++) {
      if (&DelList($nameslist{$chan[$i]}, $from)) {
        &AddList($nameslist{$chan[$i]}, $rest);
        $Cchan &= $Cchan{$chan[$i]};        
      }
    }
    &sendCchan("$line¥n");
    return;
  }
  if ($command eq '431' || $command eq '432' || $command eq '433') {
    $my_nick = $my_old_nick;
  }
  if ($command eq 'invite') {
    ($me, $channel) = split(/ /, $rest, 2);
    &logF("Invited by $from: $channel¥n");
  }
  if ($command eq 'privmsg') {
    ($to, $tmp) = ($rest =‾ /^([^ ]+) *:?(.*)$/);
    $message = '';
    while ($tmp =‾ /^([^¥001]*)¥001([^¥001]*)¥001(.*)/) {
      $message .= $1;
      $tmp = $3;
      &ctrl_a_msg($to, $2);
    }
    $message .= $tmp;
    if ($message) {
      if ($to =‾ /^[-+0-9]/) {
        if (&ExistList($nameslist{$to}, $from)) {
  	&logF("<$from> $message¥n");
        } else {
          &logF("($from) $message¥n");
        }
      } elsif ($to =‾ /^[A-{}_]/) {
        &logF("=$from= $message¥n");
      } else {
        if (&ExistList($nameslist{$to}, $from)) {
          &logF("<$to:$from> $message¥n");
        } else {
          &logF("($to:$from) $message¥n");
        }
      }
    }
    $Cchan = $Cchan{$to};
    &sendCchan("$line¥n");
    return;
  }
  if ($command eq 'msg') {
    &logF("<$from> $rest¥n");
    $Cchan = $Cchan{$my_channel};
    &sendCchan("$line¥n");
    return;
  }
  if ($command eq 'notice') {
    if ($rest =‾ /Received KILL message/) {
      if ($oper eq 'off') {
        return;
      }
      if ($oper eq 'half') {
        $rest =‾ /for ([^ ]+)¥. .*!([^!]+)!([^!]+)$/;
        $whom = $3;
        $whom = $2 . '!' . $3 if $3 !‾ /^[^ ¥.]+¥./;
        &sendCok("NOTICE * :Kill message: $1 by $3¥n");
        return;
      }
    }
    if ($rest =‾ /^¥*¥*¥* Notice -- (.*)$/) {
      $arg = $1;
      return if $oper eq 'off';
      if ($oper eq 'half') {
        ##return if  $arg =‾ /^Connection .* activated.$/;
        ##return if  $arg =‾ /^Failed in connecting/;
      }
    }
    if ($my_oper) {
      if ($rest =‾ /==>/ || $rest =‾ /:¥d¥d ¥d¥d¥d¥d$/ || $rest =‾ /Entries/) {
        &sendCok("NOTICE $rest¥n");	## with nick ("nick :message")
        return;
      }
      if ($rest =‾ /Link[ ]+SendQ/) {
        $from = "local" if !$from;
        &sendCok("NOTICE * :(" . $from . "'s link statistics)¥n");
        &sendCok("NOTICE $rest¥n");    ## with nick  ("nick :message")
        return;
      }
    }
  }
  if ($command eq 'wallops') {
    if ($wallopslog) {
      if (open(WALLOPS, '>>' . $wallopslog)) {
        print WALLOPS "$from: $rest¥n";
        close(WALLOPS);
      }
    }
    if ($oper eq 'off') {
      return;
    }
  }
  if ($command eq 'ping') {
    &sendS("PONG PIRC¥n");
  }
  if ($command eq 'pong') {
    if ($rest =‾ /^¥S+ PIRC-(¥w+)-(¥w+)-(.*)$/) {
      $Cxn = $1;
      $Cx = $C[$Cxn];
      if ($2 eq 'ping') {
        &sendCx("PONG PIRC $3¥n");
        $Cxn = 0;
      }
    }
    if ($rest =‾ /^¥S+ PIRC-FIRST$/ && $Snopong) {
      $Snopong = 0;
      &InitList($chanlist);
      $my_channel = '0';
      $#my_channels = -1;
    }
    if ($rest =‾ /^¥S+ PIRC-TAILLOG$/) {
      &taillog;
    }
    return;
  }
  if ($command eq 'namreply') {
    ($1, $channel, $list) = split(/ /, $rest, 3);
    if (&ExistList($chanlist, $channel)) {
      $list =‾ s/@//g;
      $list =‾ s/ /$;/g;
      if ($lastnameschannel eq $channel) {
        $nameslist{$channel} .= "$list";
      } else {
        $nameslist{$channel} = "$;$list";
      }
    }
    $lastnameschannel = $channel;
  }
  if ($command == 353) {
    ($1, $2, $channel, $list) = split(/ /, $rest, 4);
    $list =‾ s/^://;
    if (&ExistList($chanlist, $channel)) {
      $list =‾ s/@//g;
      $list =‾ s/ /$;/g;
      if ($lastnameschannel eq $channel) {
        $nameslist{$channel} .= "$list";
      } else {
        $nameslist{$channel} = "$;$list";
      }
    }
    $lastnameschannel = $channel;
  }
  if ($command == 366) {
    $lastnameschannel = '';
  }
  if ($command =‾ /^...reply$/ || $command == 353
         || $command == 321 || $command == 322) {
    if ($Cxn) {
      &sendCx("$line¥n");
      return;
    }
  }
  if ($command == 315 || $command == 365
	 || $command == 366 || $command == 323) {
    if ($Cxn) {
      &sendCx("$line¥n");
      $Cxn = 0;
      return;
    }
  }
  if ($command eq 'kill') {
    ($to, $message) = ($rest =‾ /^([^ ]+) *:?(.*)$/);
    &logF("Killed by $from: $message¥n");
  }
  &sendCok("$line¥n");
}

sub init_pirc {
  $interval = 10;		# interval(sec.) for timeout of select
  $Fprinttimeout = 3600;	# interval(sec.) for log time stamp
  $Sconnecttimeout = 600;	# interval(sec.) to retry to connect
  $taillog = 1;               	# if TRUE, automatic tail log when connect...
  $wallopslog = 'wallops';	# logfile for wallops
  $Stimeout = 120;
  &print_time;
  $Fprinttime = time;
  $Sconnect = 0;  		# no server connection
  $rin = $win = $ein = '';
  &InitList($chanlist);
  $daemon = 0;
}

sub daemon_pirc {
  exit if fork;
  open(STDIN, "/dev/null");
  open(STDOUT, ">&F");
  open(STDERR, ">&F");
  if (open(TTY, '+/dev/tty')) {
    ioctl(TTY, 0x20007471, 0);
    close(TTY);
  }
  $daemon = 1;
  &logF("*** pirc start...¥n");
}

sub ctrl_a_msg {
  local($to, $msg) = @_;
  ($cmd, $rest) = split(/ /, $msg, 2);
  $msg =‾ tr/a-z/A-Z/;
  if ($msg =‾ /^VERSION/) {
    &sendS("NOTICE $from :¥001VERSION Pirc $version in Perl :" .
           "pirc$version in perl3.0 " .
           "--- mail to pirc-request@irc.astem.or.jp¥001¥n");
  } elsif ($msg =‾ /^USERINFO/) {
    &sendS("NOTICE $from :¥001USERINFO :$userinfo¥001¥n");
  } elsif ($msg =‾ /^HELP/) {
    &sendS("NOTICE $from :¥001HELP :" .
           'HELP このメッセージを返す' . "¥001¥n");
    &sendS("NOTICE $from :¥001HELP :" .
           'VERSION このクライアントのヴァージョンを返す' . "¥001¥n");
    &sendS("NOTICE $from :¥001HELP :" .
           'CLIENTINFO このクライアントが知ってるコマンドを返す' . "¥001¥n");
    &sendS("NOTICE $from :¥001HELP :" .
           'USERINFO ユーザ情報を返す' . "¥001¥n");
    &sendS("NOTICE $from :¥001HELP :" .
           'COMMENT コメント…無視される' . "¥001¥n");
  } elsif ($msg =‾ /^CLIENTINFO/) {
    &sendS("NOTICE $from :¥001CLIENTINFO :" .
           "HELP VERSION CLIENTINFO USERINFO COMMENT¥001¥n");
  } elsif ($msg =‾ /^COMMENT/) {
    ;
  }

  if ($msg !‾ /^COMMENT/) {
    if ($to eq $my_nick) {
      &logF("Query from $from: $cmd¥n");
    } else {
      &logF("Query from $from($to): $cmd¥n");
    }
  }
}

sub ExistList {
  return index($_[0], "$;$_[1]$;") != -1;
}

sub DelList {
  if (($p = index($_[0], "$;$_[1]$;")) != -1) {
    substr($_[0], $p, length("$;$_[1]$;")) = "$;";
    return 1;
  }
  return 0;
}

sub AddList {
  $_[0] .= "$_[1]$;";
}

sub InitList {
  $_[0] = "$;";
}

sub sendCok {
  for ($CCn = 0; $CCn < 256; $CCn++) {
    $CC = $C[$CCn];
    print $CC @_ if vec($Cok, $CCn, 1);
  }
}  

sub sendCchan {
  for ($CCn = 0; $CCn < 256; $CCn++) {
    $CC = $C[$CCn];
    print $CC @_ if vec($Cok, $CCn, 1) && !vec($Cchan, $CCn, 1);
  }
}  

sub sendCchan2 {
  for ($CCn = 0; $CCn < 256; $CCn++) {
    $CC = $C[$CCn];
    print $CC @_ if vec($Cok, $CCn, 1) && !vec($Cchan, $CCn, 1) && $Cn != $CCn;
  }
}  

sub sendCx {
  print $Cx @_; 
}  

sub sendC {
  print $C @_; 
}  

sub sendS {
  for ($h = 0; $h <= $#_; $h++) {
  $_[h] =‾ s/¥033¥$¥@/¥033¥$B/g;
  $_[h] =‾ s/¥033¥(J/¥033¥(B/g;
  }
  print SERVER @_; 
}  

sub logF {
  &logFflush;
  print F @_;
}

sub logFflush {
  
}

sub logFnick {
#  local(old, new) = @_;
  
}

sub logFjoin {

}

sub print_time {
  ($sec,$min,$hour,$mday,$mon,$year) = localtime(time);
  $tmp = sprintf("log%02d%02d", $mon + 1, $mday);
  if ($tmp ne $logfile) {
     $logfile = $tmp;
     close(F);
     if (!open(F, ">>$logfile")) {
       open(F, '>>log');
     }
     if ($daemon) {
       open(STDOUT, ">&F");
       open(STDERR, ">&F");
     }
     select(F); $| = 1;
  }
  printf F "%02d/%02d %02d:%02d¥n", $mon + 1, $mday, $hour, $min;
}

sub init_client {
  if ($auto_away) {
     $auto_away = 0;
     &sendS("AWAY $_my_away_message¥n") if $Sconnect;
     &logF("Autoaway off¥n");
     &logF("Away: $_my_away_message¥n") if $_my_away_message;
     $my_away_message = $_my_away_message;
  }
  if ($auto_nick) {
     $auto_nick = 0;
     &sendS("NICK $my_old_nick¥n") if $my_nick ne $my_old_nick && $Sconnect;
     $_my_nick = $my_old_nick;
     $my_old_nick = $my_nick;
     $my_nick = $_my_nick;
  }
  $seqC++;
  $C = 'C' . $seqC;
  accept($C, LISTEN);
  select($C); $| = 1; select(F);
  $Cn = fileno($C);
  $C[$Cn] = $C;
  vec($rin, $Cn, 1) = 1;
  vec($Call, $Cn, 1) = 1;
  vec($Cok, $Cn, 1) = 0;
  ($tmp, $port, $1, $2, $3, $4) = unpack('S n C C C C x8', getpeername($C));
  $host[$Cn] = "$1.$2.$3.$4";
  $port[$Cn] = $port;
  &logF("*** accept $host[$Cn]($port[$Cn]) ***¥n");
  &chanall;
}

sub close_client {
  close($C);
  vec($rin, $Cn, 1) = 0;
  vec($Call, $Cn, 1) = 0;
  vec($Cok, $Cn, 1) = 0;
  if ($last_to =‾ /^[-+#0-9]/) {
    if (&DelList($chanlist, $last_to)) {
      &AddList($chanlist, $last_to);
    }
  }
  for ($CCn = 0, $no_client = 1; $CCn < 256 && $no_client; $CCn++) {
    next if !vec($Call, $CCn, 1);
    $no_client = 0;
  }
  if ($no_client) {
    if ($auto_away_message && !$auto_away) {
      $auto_away = 1;
      &sendS("AWAY $auto_away_message¥n");
      &logF("Autoaway: $auto_away_message¥n");
      $_my_away_message = $my_away_message;
      $my_away_message = $auto_away_message;
    }
    if ($my_away_nick && !$auto_nick) {
      $auto_nick = 1;
      &sendS("NICK $my_away_nick¥n") if $my_nick ne $my_away_nick;
      $my_old_nick = $my_nick;
      $my_nick = $my_away_nick;
    }
  }
}

sub close_server {
  close(SERVER);
  vec($rin, $Sn, 1) = 0;
  $Sconnect = 0;  # no server
  &connect_server if !$Snopong;
}

sub connect_server {
  &sendCok("NOTICE * :trying to connect to $server($sport) ***¥n");
  sub AF_INET {2;}
  sub PF_INET {&AF_INET;}
  sub SOCK_STREAM {1;}
  $sockaddr = 'S n a4 x8';
  ($name, $aliases, $prot) = getprotobyname('tcp');
  ($name, $aliases, $sport) = getservbyname($sport, 'tcp')
  	unless $sport =‾ /^¥d+$/;
  chop($hostname = `hostname`);
  ($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname);
  $machinename = $name;
  if ($server =‾ /^(¥d+)¥.(¥d+)¥.(¥d+)¥.(¥d+)$/) {
    $thataddr = sprintf("%c%c%c%c", $1, $2, $3, $4);
  } else {
    ($name, $aliases, $type, $len, $thataddr) = gethostbyname($server);
  }
  $this = pack($sockaddr, &AF_INET, 0, $thisaddr);
  $that = pack($sockaddr, &AF_INET, $sport, $thataddr);
  socket(SERVER, &PF_INET, &SOCK_STREAM, $prot) || return 0;
  select(SERVER); $| = 1; select(F);
  bind(SERVER, $this) || return 0;
  $Sconnecttime = time;
  if (!connect(SERVER, $that)) {
    &sendCok("NOTICE * :cannot connect..... I'll sleep and try again.  ***¥n");
    &sendCok("NOTICE * :If need, type /server <host> [<port>] ***¥n");
    &logF("*** Cannot connect to $server($sport) ***¥n") if $daemon;
    return 0;
  }
#  open(STDIN, "+>&SERVER");
#  close(SERVER);
#  open(STDOUT, "+>&STDIN");
#  select(STDOUT); $| = 1; select(F);
  &logF("*** server $server($sport) ***¥n");
  $Sn = fileno(SERVER);
  vec($rin, $Sn, 1) = 1;
  $Sconnect = 1;  # server ok
  $Snopong = 1;   # waiting for pong
  &sendS("PING PIRC-FIRST¥n");
  &sendS("USER $my_user * * $my_name¥n");
  &sendS("NICK $my_nick¥n");
  @chan = split(/$;/, $chanlist);
  for ($i = 1; $i <= $#chan; $i++) {
    &sendS("JOIN $chan[$i]¥n");
  }
  &sendS("AWAY :$my_away_message¥n") if $my_away_message;
  &sendS("OPER $my_oper¥n") if $my_oper;
  return 1;
}

sub listen_client {
  sub AF_INET {2;}
  sub PF_INET {&AF_INET;}
  sub SOCK_STREAM {1;}
  $sockaddr = 'S n a4 x8';
  ($name, $aliases, $prot) = getprotobyname('tcp');
  $this = pack($sockaddr, &AF_INET, $cport, "¥0¥0¥0¥0");
  socket(LISTEN, &PF_INET, &SOCK_STREAM, $prot) || return 0;
  if (!bind(LISTEN, $this)) {
    print STDERR "Cannot bind tcp socket $cport.¥n";
    return 0;
  }
  listen(LISTEN, 5) || return 0;
  select(LISTEN); $| = 1; select(F);
  $Ln = fileno(LISTEN);
  vec($rin, $Ln, 1) = 1;
  return 1;
}