home *** CD-ROM | disk | FTP | other *** search
/ ftp.madoka.org / 2014.12.ftp.madoka.org.tar / ftp.madoka.org / pub / madoka / 4.2 / madoka4.2.6.tar.gz / madoka4.2.6.tar / madoka4.2 / madoka.pl next >
Perl Script  |  2002-02-02  |  28KB  |  1,006 lines
  1. #!/bin/perl
  2. #
  3. #  madoka-chan  ver 4.2
  4. #
  5. #      Copyright(c)1998- cookie (cookie@madoka.org)
  6. #                        The madoka project
  7. #      This is free software.
  8.  
  9. require 5.003;
  10.  
  11. &init;
  12. exit;
  13.  
  14. sub mainloop {
  15.   local($cl, $cl_no);
  16.   my($nf, $rout, $errno, $reason);
  17.   for (;;) {
  18.     $nf = select($rout=$rin, undef, undef, $interval);
  19.     if ($csec != $sec) {
  20.       foreach (split(/$;/, $per_sec)) {
  21.     next unless $_;
  22.     &$_ if defined(&$_);
  23.       }
  24.       $csec = $sec;
  25.     }
  26.     if ($nf < 0) {
  27.       if ($! == 4) {
  28.         $nf = 0;
  29.       } else {
  30.         $errno = sprintf("%d", $!);
  31.         &down("[ERROR] $errno ($!) in select.\n");
  32.       }
  33.     }
  34.     ¤t_time;
  35.     if ($cmin != $min) {
  36.       if ($chour != $hour) {
  37.         if ($cday != $mday) {
  38.           foreach (split(/$;/, $per_day)) {
  39.             next unless $_;
  40.             &$_ if defined(&$_);
  41.           }
  42.           $cday = $mday;
  43.         }
  44.         foreach (split(/$;/, $per_hour)) {
  45.           next unless $_;
  46.           &$_ if defined(&$_);
  47.         }
  48.         $chour = $hour;
  49.       }
  50.       foreach (split(/$;/, $per_min)) {
  51.         next unless $_;
  52.         &$_ if defined(&$_);
  53.       }
  54.       $cmin = $min;
  55.     }
  56.     if (vec($sv_state, 0, 1)) {
  57.       if (time - $sv_tm > $sv_tmout) {
  58.         $sv_tm = time;
  59.         &close_server($sv_no, 'dead conection');
  60.       }
  61.     } else {
  62.       if (time - $sv_tm_cn > $sv_tmout_cn) {
  63.         $sv_tm_cn = $sv_tm = time;
  64.         &connect_server;
  65.       }
  66.     }
  67.     next unless $nf;
  68.     &init_client(vec($rout, $ln_no4, 1), vec($rout, $ln_no6, 1))
  69.     if vec($rout, $ln_no4, 1) || vec($rout, $ln_no6, 1);
  70.     for ($cl_no = 0; $cl_no <= $cl_max; $cl_no++) {
  71.       next unless (vec($rout, $cl_no, 1) && vec($cl_cn, $cl_no, 1));
  72.       $cl = $cl[$cl_no];
  73.       unless (sysread($cl, $mes, 4096)) {
  74.         $reason = $! ? "$!" : 'closed';
  75.         &close_client($cl_no, $reason);
  76.       } else {
  77.         $cl_buf[$cl_no] .= $mes;
  78.         while ((@cl_bufl = split(/\r*\n/, $cl_buf[$cl_no], 2)) == 2) {
  79.           $cl_buf[$cl_no] = $cl_bufl[1];
  80.           &client($cl_no, $cl_bufl[0]);
  81.         }
  82.         $cl_buf[$cl_no] = $cl_bufl[0];
  83.       }
  84.     }
  85.     if (vec($rout, $sv_no, 1)) {
  86.       unless (sysread(SERVER, $mes, 4096)) {
  87.         $reason = $! ? "$!" : 'closed by server';
  88.     &send('ccn', "NOTICE $us_nick :" .
  89.           &mio('MADOKA_CLOSE', "[CLOSE] $sv[0] ($reason)") . "\n");
  90.         &close_server($sv_no, $reason);
  91.       } else {
  92.         $sv_buf .= $mes;
  93.         $sv_tm = time;
  94.         while ((@sv_bufl = split(/\r*\n/, $sv_buf, 2)) == 2) {
  95.           $sv_buf = $sv_bufl[1] || '';
  96.           &server($sv_no, $sv_bufl[0]);
  97.         }
  98.         $sv_buf = $sv_bufl[0];
  99.       }
  100.     }
  101.   }
  102. }
  103. sub init {
  104.   use Config;
  105.   use Socket;
  106.   eval 'use Socket6';
  107.   unshift(@INC, ($0 =~ /^(.*)\/[^\/]+$/ ? "$1/plugin" : './plugin'));
  108.   require "version.mpi";
  109.   $MDK = $0;
  110.   @ARG = @ARGV;
  111.   $AF_INET4 = &AF_INET || 2;
  112.   $PF_INET4 = &PF_INET || $AF_INET4;
  113.   if ($INC{'Socket6.pm'}) {
  114.     $AF_INET6 = &AF_INET6 || 24;
  115.     $PF_INET6 = &PF_INET6 || $AF_INET6;
  116.   } else {
  117.     $PF_INET6 = $AF_INET6 = 24;
  118.   }
  119.   $SOCK_STREAM = &SOCK_STREAM || 1;
  120.   $SOL_SOCKET = &SOL_SOCKET;
  121.   $SO_REUSEADDR = &SO_REUSEADDR;
  122.   $SO_KEEPALIVE = &SO_KEEPALIVE;
  123.   $INADDR_ANY4 = &INADDR_ANY || inet_aton('0.0.0.0');
  124.   $INADDR_ANY6 = pack('C16', 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0);
  125.   $PROT = getprotobyname('tcp') || 6;
  126.  
  127.   $ENV{'LANG'} = 'C';
  128.   $ENV{'LC_TIME'} = 'C';
  129.  
  130.   &init_madoka;
  131.   unless (vec($us_state, 3, 1)) {
  132.     exit if eval { fork };
  133.     vec($us_state, 3, 1) = 1 if $@;
  134.   }
  135.   &read_rc;
  136.   open(STDIN, "/dev/null");
  137.   &mes("[!] Start: $mdk_label $mdk_version with perl $perl_version\n");
  138.   $0 = "$mdk_label($us_nick/$mdk_version)";
  139.   &mainloop;
  140. }
  141. sub init_madoka {
  142.   if ($^V) {
  143.     $perl_version = sprintf("%vd", $^V);
  144.   } else {
  145.     $perl_version = sprintf("%1.5f", $]);
  146.   }
  147.   srand(time+$$);
  148.   $interval = 1;
  149.   $sv_tmout_cn = 90;
  150.   $sv_tmout = 900;
  151.   $sv_tm = time;
  152.   $sv_no = 0;
  153.   $cl_max = 256;
  154.   $homedir = $ENV{'HOME'};
  155.   $rin = '';
  156.   $chl_header = '\#\&\+\!\%';
  157.   while ($_ = shift(@ARGV)) {
  158.     if ($_ eq '-rc') {
  159.       $mdk_rc = shift(@ARGV);
  160.       $mdk_rc =~ s/^~\//$homedir\//;
  161.       &down("[ERROR] Cannot find: $mdk_rc\n") unless -f $mdk_rc;
  162.     } elsif ($_ eq '-modes') {
  163.       $mdk_modes = shift(@ARGV);
  164.       $mdk_modes =~ s/^~\//$homedir\//;
  165.       &down("[ERROR] Cannot find: $mdk_modes\n") unless -f $mdk_modes;
  166.     } elsif ($_ eq '-nofork') {
  167.       vec($us_state, 3, 1) = 1;
  168.     }
  169.   }
  170. }
  171. sub read_rc {
  172.   $mdk_rc = &search_file('madoka.rc') unless $mdk_rc;
  173.   return unless &_redo($mdk_rc, 1);
  174.   &list_init($per_min) unless $per_min;
  175.   &list_add($per_min, 'read_rc');
  176.   my $file;
  177.   if (open(RC, $mdk_rc)) {
  178.     while (<RC>) {
  179.       s/\n$//;
  180.       next if /^\s*$/ || /^\#/;
  181.       if (/^\[([^\]]+)\]$/) {
  182.     $rc_section = $1;
  183.     next;
  184.       } elsif (/^[^=]+=.*/) {
  185.     $rc_line = $_;
  186.       }
  187.       $file = &search_file("rc/$rc_section.mpi");
  188.       do $file || print STDERR "[!] $file: [$rc_section] $rc_line\n";
  189.     }
  190.     close(RC);
  191.   } else {
  192.     &down("[ERROR] cannot open rc: $mdk_rc\n");
  193.   }
  194.   $file = &search_file("rc/default.mpi");
  195.   do $file;
  196. }
  197. sub init_client {
  198.   my @ln = @_;
  199.   $cl_seq++;
  200.   my $cl = 'C' . $cl_seq;
  201.   if ($ln[1] == 1) {
  202.     &mes("[init_client] accept: IPv6", 'D');
  203.     $ac = accept($cl, LISTEN6);
  204.   } elsif ($ln[0] == 1) {
  205.     &mes("[init_client] accept: IPv4", 'D');
  206.     $ac = accept($cl, LISTEN4);
  207.   } else {
  208.     &mes("[init_client] accept: strange connection", 'D');
  209.     return;
  210.   }
  211.   select($cl); $| = 1; select(L0);
  212.   my $cl_no = fileno($cl);
  213.   $cl_max = $cl_no if $cl_no > $cl_max;
  214.   $cl[$cl_no] = $cl;
  215.   $cl_seq[$cl_no] = $cl_seq;
  216.   undef $cl_pass[$cl_no];
  217.   vec($rin, $cl_no, 1) = 1;
  218.   vec($cl_cn, $cl_no, 1) = 1;
  219.   vec($cl_ok, $cl_no, 1) = 0;
  220.   foreach (split(/$;/, $chl)) {
  221.     next unless $_;
  222.     vec($cl_chan{$_}, $cl_no, 1) = 0;
  223.   }
  224.   my($u, @i, $addr, $ac, $aci);
  225.   $ac = getpeername($cl);
  226.   &mes("[init_client] aclen: " . length($ac), 'D');
  227.   if (length($ac) == 28 || length($ac) == 24) {
  228.     ($port[$cl_no], $addr) = sockaddr_in6($ac);
  229.     $cl_ip[$cl_no] = unpack('N', $addr);
  230.     $host[$cl_no] = join(':', unpack('H4 H4 H4 H4 H4 H4 H4 H4', $addr));
  231.     $aci = getsockname($cl);
  232.     ($u, $addr) = sockaddr_in6($aci);
  233.     $cl_ifip[$cl_no] = join(':', unpack('H4 H4 H4 H4 H4 H4 H4 H4', $addr));
  234.     &mes("[init_client] ifip6: $cl_ifip[$cl_no]\n", 'D');
  235.   } else {
  236.     ($port[$cl_no], $addr) = sockaddr_in($ac);
  237.     $cl_ip[$cl_no] = unpack('N', $addr);
  238.     $host[$cl_no] = join('.', unpack('C4', $addr));
  239.     $aci = getsockname($cl);
  240.     ($u, $addr) = sockaddr_in($aci);
  241.     $cl_ifip[$cl_no] = join('.', unpack('C4', $addr));
  242.     &mes("[init_client] ifip: $cl_ifip[$cl_no]\n", 'D');
  243.   }
  244.   if ($#cl_hosts >= 0 && !&check_host($cl_no, @cl_hosts)) {
  245.     &close_client($cl_no, "Denied: $host[$cl_no]($port[$cl_no])");
  246.     &plugin('event', 'refuse_client', $host[$cl_no], '');
  247.     return;
  248.   }
  249.   &mes("[!] Connect: $host[$cl_no]($port[$cl_no])/$cl_seq[$cl_no]\n");
  250.   &plugin('event', 'connect_client', $host[$cl_no], '');
  251. }
  252. sub connect_server {
  253.   local $sv_port = $sv_port[0];
  254.   my($that, $l, @l);
  255.   if ($sv_port =~ /,/) {
  256.     @l = split(/,/, $sv_port[0]);
  257.     $sv_port = $l[int(rand($#l+1))];
  258.   }
  259.   &send('ccn', "NOTICE $us_nick :" .
  260.     &mio('MADOKA_CONNECTTRY', "[!] try: connect to $sv[0]($sv_port)") .
  261.     "\n");
  262.   if ($sv[0] =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
  263.     $AF_INET = $AF_INET4;
  264.     $PF_INET = $PF_INET4;
  265.     $INADDR_ANY = $INADDR_ANY4;
  266.     vec($sv_state, 3, 1) = 0;
  267.     $that = &getaddrinfo6($sv[0], $sv_port);
  268.   } elsif ($sv[0] =~ /^[\da-f:]+$/i) {
  269.     if ($sv[0] =~ /::.*::/) {
  270.       &down("[ERROR] wrong server address in IPv6 format: $sv[0]\n");
  271.     } elsif ($sv[0] =~ /::/) {
  272.       my $l = $sv[0];
  273.       $n = 7 - ($l =~ s/://g);
  274.       $l = ':0:';
  275.       for ($i = 0; $i < $n; $i++) {
  276.     $l .= '0:';
  277.       }
  278.       $sv[0] =~ s/::/$l/;
  279.     }
  280.     if ($sv[0] =~ /^([\da-f]*):([\da-f]*):([\da-f]*):([\da-f]*):([\da-f]*):([\da-f]*):([\da-f]*):([\da-f]*)$/i) {
  281.       $AF_INET = $AF_INET6;
  282.       $PF_INET = $PF_INET6;
  283.       $INADDR_ANY = $INADDR_ANY6;
  284.       vec($sv_state, 3, 1) = 1;
  285.       $that = &getaddrinfo6($sv[0], $sv_port);
  286.     } else {
  287.       &down("[ERROR] wrong server address in IPv6 format: $sv[0]\n");
  288.     }
  289.   } else {
  290.     $that = &getaddrinfo6($sv[0], $sv_port);
  291.     if (length($that) == 28) {
  292.       $AF_INET = $AF_INET6;
  293.       $PF_INET = $PF_INET6;
  294.       vec($sv_state, 3, 1) = 1;
  295.       $INADDR_ANY = $INADDR_ANY6;
  296.     } else {
  297.       $AF_INET = $AF_INET4;
  298.       $PF_INET = $PF_INET4;
  299.       vec($sv_state, 3, 1) = 0;
  300.       $INADDR_ANY = $INADDR_ANY4;
  301.     }
  302.   }
  303.   unless (socket(SERVER, $PF_INET, $SOCK_STREAM, $PROT)) {
  304.     &mes("[ERROR] sv/socket: $!\n");
  305.     return 0;
  306.   }
  307.   $sv_no = fileno(SERVER);
  308.   select(SERVER); $| = 1; select(L0);
  309.   if ($ENV{'OSTYPE'} !~ m/linux/i) {
  310.     if (vec($sv_state, 3, 1)) {
  311.       $l = pack_sockaddr_in6(0, $INADDR_ANY6);
  312.     } else {
  313.       $l = pack_sockaddr_in(0, $INADDR_ANY4);
  314.     }
  315.     unless (bind(SERVER, $l)) {
  316.       &mes("[ERROR] sv/bind: $!\n");
  317.       return 0;
  318.     }
  319.   }
  320.   $sv_tm_cn = time;
  321.   unless (connect(SERVER, $that)) {
  322.     &send('ccn', "NOTICE $us_nick :" .
  323.       &mio('MADOKA_CONNECTERR', "[!] cannot connect, try again after.") .
  324.       "\n");
  325.     &send('ccn', "NOTICE $us_nick :" .
  326.       &mio('MADOKA_CONNECTERR2',
  327.            "[!] if need, type: /server <host> [<port>]") . "\n");
  328.     &mes("[!] cannot connect: $sv[0]($sv_port)\n");
  329.     &plugin('event', 'refuse_server', $sv[0], $sv_port);
  330.     vec($rin, $sv_no, 1) = 0;
  331.     $sv_buf = $sv_state = '';
  332.     $nickuse = 0;
  333.     $nick_try = $us_nick;
  334.     push(@sv, shift(@sv));
  335.     push(@sv_port, shift(@sv_port));
  336.     push(@sv_pass, shift(@sv_pass));
  337.     return 0;
  338.   }
  339.   &mes("[!] server: $sv[0]($sv_port)\n");
  340.   &plugin('event', 'connect_server', $sv[0], $sv_port);
  341.   vec($rin, $sv_no, 1) = 1;
  342.   vec($sv_state, 0, 1) = 1;
  343.   ®ist_server;
  344. }
  345. sub regist_server {
  346.   $nickuse = 0;
  347.   @ctcp_queue = ();
  348.   $nick_try = $us_nick unless $nick_try;
  349.   &send('sv', "PASS $sv_pass[0]\n") if $sv_pass[0];
  350.   &send('sv', "USER $us_id * * :$us_name\n");
  351.   &send('sv', "NICK $nick_try \n");
  352.   &send('sv', "AWAY :$mes_away\n") if $mes_away;
  353.   $us_mes_away = $mes_away;
  354. }
  355. sub join_server { 
  356.   my($joinchannels, $joinchannelskey, $autokeys);
  357.   foreach (split(/$;/, $chl_autojoin)) {
  358.     next unless $_;
  359.     if (&check_chan($_)) {
  360.       if ($at_key{$_}) {
  361.     $joinchannelskey .= ",$_";
  362.     $autokeys .= ",$at_key{$_}";
  363.       } else {
  364.     $joinchannels .= ",$_";
  365.       }
  366.     } else {
  367.       &send('cch', "NOTICE $us_nick :" .
  368.         &mio('MADOKA_JOINERR', "[ERROR] channel name($_)") . "\n");
  369.       &mes("[ERROR] channel name($_)\n", 'L');
  370.     }
  371.   }
  372.   $joinchannels =~ s/^,//;
  373.   $joinchannelskey =~ s/^,//;
  374.   $autokeys =~ s/^,//;
  375.   &send('sv', "JOIN $joinchannels \n") if $joinchannels;
  376.   &send('sv', "JOIN $joinchannelskey $autokeys \n") if $joinchannelskey;
  377. }
  378. sub close_server {
  379.   my($sv_no, $reason) = @_;
  380.   close(SERVER);
  381.   &mes("[!] close server: $sv[0]($reason)/$sv_no\n");
  382.   &plugin('event', 'close_server', $sv[0], $reason);
  383.   vec($rin, $sv_no, 1) = 0;
  384.   foreach (split(/$;/, $chl)) {
  385.     next unless $_;
  386.     &send('ccn', ":$us_nick!$machine{$us_nick} PART :$_\n");
  387.   }
  388.   push(@sv, shift(@sv));
  389.   push(@sv_port, shift(@sv_port));
  390.   push(@sv_pass, shift(@sv_pass));
  391.   &list_init($chl);
  392.   vec($rin, $sv_no, 1) = 0;
  393.   $sv_buf = '';
  394.   $sv_state = '';
  395.   $nickuse = 0;
  396.   $nick_try = $us_nick;
  397. }
  398. sub close_client {
  399.   my($cl_no, $reason) = @_;
  400.   &mes("[!] close: $cl_seq[$cl_no] ($reason)\n");
  401.   &plugin('event', 'close_client', $host[$cl_no], $reason);
  402.   close($cl[$cl_no]);
  403.   vec($rin, $cl_no, 1) = 0;
  404.   vec($cl_cn, $cl_no, 1) = 0;
  405.   vec($cl_ok, $cl_no, 1) = 0;
  406.   undef $cl_nick[$cl_no];
  407.   undef $cl_user[$cl_no];
  408.   undef $cl_code[$cl_no];
  409.   my $l = $cl_max;
  410.   for ($i = 0, $no_client = 1; $i <= $l; $i++) {
  411.     next unless vec($cl_cn, $i, 1);
  412.     $cl_max = $i;
  413.     $no_client = 0;
  414.   }
  415.   if ($no_client == 1) {
  416.     if ($us_mes_away ne $mes_away) {
  417.       &mes("[!] Autoaway: $mes_away\n");
  418.       &send('sv', "AWAY :$mes_away\n");
  419.       $us_mes_away = $mes_away;
  420.     }
  421.     vec($at_state, 6, 1) = 1 if vec($dcc_state, 3, 1) && !vec($at_state, 6, 1);
  422.     foreach (split(/$;/, $chl_cljoin)) {
  423.       next unless $_;
  424.       next unless &list_exist($chl, $_);
  425.       if ($mes_part) {
  426.     &send('sv', "PART $_ :$mes_part\n");
  427.       } else {
  428.     &send('sv', "PART $_ \n");
  429.       }
  430.       &mes("[close_client] client PART: $_", 'D');
  431.     }
  432.   }
  433. }
  434. sub server {
  435.   my($sv_no, $line) = @_;
  436.   ($from, $where, $command, $pr) =
  437.       ($line =~ /^(:[^! ]*)?(![^ ]*)? *([^ ]+) *:?(.*)$/);
  438.   $from =~ s/^:// if $from;
  439.   $where =~ s/^!// if $where;
  440.   $machine{$from} = $where if $where;
  441.   my $com = $command;
  442.   $com =~ tr/A-Z/a-z/;
  443.   my $sv_cmd = "sv_$com";
  444.   &mes("[server] $line /\n", 'D');
  445.   if (defined(&$sv_cmd)) {
  446.     &$sv_cmd($from, $pr);
  447.   } else {
  448.     &send('ccn', "$line\n");
  449.   }
  450. }
  451. sub client {
  452.   my($cl_no, $line) = @_;
  453.   my($u, $command, $pr) = ($line =~ /^(:[^ ]*)? *([^ ]+) *:?(.*)$/);
  454.   return unless $command;
  455.   my $com = $command;
  456.   $com =~ tr/A-Z/a-z/;
  457.   if ($line =~ /^PASS /i) {
  458.     &mes("[client] PASS ******** / seq = $cl_seq[$cl_no]\n", 'D');
  459.   } else {
  460.     &mes("[client] $line / seq = $cl_seq[$cl_no]\n", 'D');
  461.   }
  462.   unless (vec($cl_ok, $cl_no, 1)) {
  463.     &check_pass($cl_no) if &no_pass($cl_no, $line);
  464.     return;
  465.   }
  466.   $ctcp_cmd_p = '';
  467.   $cl_code[$cl_no] = $kanji_lock_code || &kanji_code($pr)
  468.       if &list_exist($plugin_list, 'kanji');
  469.   my $cl_cmd = "cl_$com";
  470.   &mes("[client] cl_cmd = $cl_cmd\n", 'D');
  471.   if (defined(&$cl_cmd)) {
  472.     &$cl_cmd($pr, $cl_no);
  473.   } else {
  474.     &send('sv', "$line\n");
  475.   }
  476. }
  477. sub no_pass {
  478.   my($cl_no, $line) = @_;
  479.   my($where, $com, $arg) = ($line =~ /^(:[^ ]*)? *([^ ]+) *:?(.*)$/);
  480.   if ($line =~ /^pass/i) {
  481.     &mes("[no_pass] $& ********\n", 'D');
  482.   } else {
  483.     &mes("[no_pass] $line\n", 'D');
  484.   }
  485.   if ($com =~ /^pass$/i) {
  486.     $cl_pass[$cl_no] = $arg;
  487.     return 0;
  488.   } elsif ($com =~ /^user$/i) {
  489.     $cl_user[$cl_no] = $arg;
  490.     return 1 if $cl_nick[$cl_no];
  491.     return 0;
  492.   } elsif ($com =~ /^nick$/i) {
  493.     ($cl_nick[$cl_no]) = ($arg =~ /^([^\s]+)\s*/);
  494.     return 1 if $cl_user[$cl_no];
  495.     return 0;
  496.   } elsif ($com =~ /^quit$/i) {
  497.     &close_client($cl_no, 'I Quit');
  498.     return 0;
  499.   }
  500.   &send('cl', ":$sv[0] 451 * :" .
  501.     &mio('MADOKA_REGIST', 'You have not registered.') . "\n", $cl_no);
  502.   return 0;
  503. }
  504. sub check_pass {
  505.   local $cl_no = $_[0];
  506.   if ($cl_pass[$cl_no] ne $us_pass &&
  507.       $us_pass ne crypt($cl_pass[$cl_no], substr($us_pass, 0, 2))) {
  508.     &send('cl', ":$sv[0] 464 $cl_nick[$cl_no] :" .
  509.       &mio('MADOKA_PASSWDERR', 'Password Incorrect.') . "\n");
  510.     &send('cl', 'ERROR :' .
  511.       &mio('MADOKA_PASSWDCLOSE',
  512.            "Closing Link: $cl_nick[$cl_no] (Bad Password)") . "\n");
  513.     &close_client($cl_no, 'wrong password');
  514.     return;
  515.   }
  516.   vec($cl_ok, $cl_no, 1) = 1;
  517.   &mes("[!] password/$cl_seq[$cl_no]\n");
  518.   &plugin('event', 'check_pass', $host[$cl_no], '');
  519.   foreach (split(/$;/, $chl_cljoin)) {
  520.     next unless $_;
  521.     next if &list_exist($chl, $_);
  522.     if ($at_key{$_}) {
  523.       &send('sv', "JOIN $_ $at_key{$_} \n");
  524.     } else {
  525.       &send('sv', "JOIN $_ \n");
  526.     }
  527.     &mes("[check_pass] client JOIN: $_", 'D');
  528.   }
  529.   my $cl_nick = $cl_nick[$cl_no];
  530.   &send('cl', ":$sv[0] 001 $cl_nick :" .
  531.     "Welcome to the Internet Relay Network $cl_nick!$machine{$us_nick}\n");
  532.   &send('cl', ":$sv[0] 002 $cl_nick :$sv_mes[2]\n") if $sv_mes[2];
  533.   &send('cl', ":$sv[0] 003 $cl_nick :$sv_mes[3]\n") if $sv_mes[3];
  534.   &send('cl', ":$sv[0] 004 $cl_nick $sv_mes[4]\n") if $sv_mes[4];
  535.   &send('cl', ":$sv[0] 375 $cl_nick :- $sv[0] Message of the Day -\n");
  536.   &send('cl', ":$sv[0] 376 $cl_nick :End of /MOTD command.\n");
  537.   if ($cl_nick ne $us_nick) {
  538.     if (defined($machine{$us_nick})) {
  539.       &send('cl', ":$cl_nick[$cl_no]!$machine{$us_nick} NICK :$us_nick\n");
  540.     } else {
  541.       &send('cl', ":$cl_nick[$cl_no] NICK :$us_nick\n");
  542.     }
  543.   }
  544.   if (vec($sv_state, 0, 1)) {
  545.     &taillog;
  546.     my($l, $ll);
  547.     foreach (split(/$;/, $chl)) {
  548.       next unless $_;
  549.       $ll = '';
  550.       &send('cl', ":$us_nick!$machine{$us_nick} JOIN :$_\n");
  551.       &send('cl', ":$sv[0] 332 $us_nick $_ :$topic{$_}\n") if $topic{$_};
  552.       $l = length(":$sv[0] 353 $us_nick = $_ :");
  553.       foreach $name (split(/$;/, $ls_mem{$_})) {
  554.     next unless $name;
  555.     if ($l + length($name) + 1 > 510) {
  556.       &send('cl', ":$sv[0] 353 $us_nick = $_ :$ll\n");
  557.       $l = length(":$sv[0] 353 $us_nick = $_ :");
  558.       $ll = '';
  559.     }
  560.     $l += length($name) + 1;
  561.     $ll .= "$name ";
  562.       }
  563.       &send('cl', ":$sv[0] 353 $us_nick = $_ :$ll\n") if $ll;
  564.       &send('cl', ":$sv[0] 366 $us_nick $_ :End of /NAMES list.\n");
  565.     }
  566.   } else {
  567.     &send('cl', "NOTICE $us_nick :" .
  568.       &mio('MADOKA_NOSERVER', '[!] Now, no server connection.') . "\n");
  569.   }
  570.   &send('cl', ":$sv[0] 301 $us_nick $us_nick :$us_mes_away\n")
  571.       if $us_mes_away;
  572.   if ($us_mes_away ne '') {
  573.     &mes("[!] Autoaway off\n", 'ALL');
  574.     $us_mes_away = '';
  575.     &send('sv', "AWAY :\n");
  576.   }
  577.   vec($at_state, 6, 1) = 0 if vec($dcc_state, 3, 1) && vec($at_state, 6, 1);
  578. }
  579. sub getaddrinfo6 {
  580.   my($l, $port) = @_;
  581.   if ($INC{'Socket6.pm'}) {
  582.     my @l = getaddrinfo($l, $port, 0, $SOCK_STREAM);
  583.     return $l[8] || $l[3];
  584.   } else {
  585.     $l = (gethostbyname($l))[4];
  586.     return pack_sockaddr_in($port, $l);
  587.   }
  588. }
  589. sub plugin {
  590.   foreach (split(/$;/, $plugin_do)) {
  591.     next unless $_;
  592.     do $_;
  593.   }
  594.   foreach (split(/$;/, $plugin_sub)) {
  595.     next unless $_;
  596.     &$_ if defined(&$_);
  597.   }
  598. }
  599. sub redo {
  600.   local $file = &search_file($_[0]);
  601.   &down("[ERROR] Not Found: $file\n") unless -f $file;
  602.   local $l = q! do $file;
  603.     &mes("plugin new: $file\n") if defined(&listen_client); !;
  604.   &_redo($file, $l);
  605. }
  606. sub _redo {
  607.   local($file, $l) = @_;
  608.   if ($plugin_change{$file}) {
  609.     $plugin_change_old{$file} = $plugin_change{$file};
  610.   } else {
  611.     $plugin_change_old{$file} = 0;
  612.   }
  613.   $plugin_change{$file} = -M $file;
  614.   if ($plugin_change_old{$file} > $plugin_change{$file} ||
  615.       $plugin_change_old{$file} == 0) {
  616.     eval($l);
  617.     &mes("[ERROR] _redo: $@") if $@;
  618.     return 1;
  619.   }
  620.   return 0;
  621. }
  622. sub search_file {
  623.   my $file = $_[0];
  624.   foreach (@plugindir, './', './plugin/', @INC) {
  625.     $_ .= '/' if $_ !~ /\/$/;
  626.     if (-r "$_$file") {
  627.       $file = "$_$file";
  628.       last;
  629.     }
  630.   }
  631.   return $file;
  632. }
  633. sub ctcp {
  634.   my($chan, $mes) = @_;
  635.   my $com;
  636.   ($com, $mes) = split(/\s/, $mes, 2);
  637.   my($cmd, $ff) = ($com, 0);
  638.   my $ctcp_cmd = "ctcp_$com";
  639.   $ctcp_cmd =~ tr/A-Z/a-z/;
  640.   my($chanr, $chanv) = &alias_chan($chan);
  641.   &mes("[ctcp] chan: $chanv\n", 'D') if $chanv;
  642.   if ($chanr eq $us_nick) {
  643.     &mes("[!] ctcp from $from: $com $mes\n", 'P') if $com;
  644.   } else {
  645.     &mes("[!] ctcp from $from($chanv): $com $mes\n", 'P') if $com;
  646.   }
  647.   push(@ctcp_queue, "$ctcp_cmd:$from:$mes") if $ctcp_cmd ne 'ctcp_';
  648.   ($ctcp_cmd, $from, $mes) = split(/:/, shift(@ctcp_queue), 3);
  649.   if (defined(&$ctcp_cmd)) {
  650.     &$ctcp_cmd($mes);
  651.     if ($t_count < 1) {
  652.       $ff = 1 if vec($dcc_state, 3, 1) || $com !~ /^dcc$/i;
  653.     } else {
  654.       unshift(@ctcp_queue, "$ctcp_cmd:$from:$mes");
  655.     }
  656.   } else {
  657.     &send('cch', "NOTICE $us_nick :$com\@$from: $mes\n") if $com;
  658.     $ff = 0;
  659.   }
  660.   return $ff;
  661. }
  662. sub mes {
  663.   my($mes, $chan) = @_;
  664.   $mes =~ s/\r*\n$//;
  665.   if ($yr_cache && $chan ne 'D') {
  666.     push(@cache_mes, $mes);
  667.     shift(@cache_mes) if $#cache_mes > $yr_cache;
  668.   }
  669.   &Log("$mes\n", $chan || 'ALL') if &list_exist($plugin_list, 'log');
  670. }
  671. sub send {
  672.   local($com, $mes, $cl_no) = @_;
  673.   my $sn_cmd = "sn_$com";
  674.   if (defined(&$sn_cmd)) {
  675.     &kanji_jis(*mes) if &list_exist($plugin_list, 'kanji');
  676.     $mes =~ s/\r*\n$/\r\n/;
  677.     &$sn_cmd($mes, $cl_no);
  678.     &mes("[send/$com] $mes", 'D');
  679.   }
  680. }
  681. sub sn_sv {
  682.   return unless vec($sv_state, 0, 1);
  683.   local $mes = $_[0];
  684.   if ($mes =~ /^[^\001]*\001[^\001]*\001/) {
  685.     unshift(@mes_buf, $mes);
  686.   } elsif ($mes && $mes ne ' ') {
  687.     push(@mes_buf, $mes);
  688.   }
  689.   $mes = shift(@mes_buf);
  690.   if (&list_exist($per_sec, 'flood')) {
  691.     &flood_send($mes);
  692.   } else {
  693.     print SERVER $mes;
  694.     my($chan, $pr) = ($mes =~ /^PRIVMSG ([^ ]+) :(.*)/);
  695.     my($chanr, $chanv) = &alias_chan($chan);
  696.     &mes(">$chanv:$us_nick< $pr\n", $chanr) if $pr;
  697.   }
  698. }
  699. sub sn_cl {
  700.   return unless $cl;
  701.   local($mes, $cl_no) = @_;
  702.   my($cl_code, $kanji);
  703.   if (&list_exist($plugin_list, 'kanji') && $cl_code[$i]) {
  704.     $cl_code = $cl_code[$i];
  705.     $kanji = "kanji_$cl_code";
  706.     &$kanji(*mes);
  707.   }
  708.   print $cl $mes;
  709. }
  710. sub sn_ccn {
  711.   local($mes, $cl_no) = @_;
  712.   my($cc, $cl_code, $kanji);
  713.   for ($i = 0; $i <= $cl_max; $i++) {
  714.     $cc = $cl[$i];
  715.     next unless $cc;
  716.     if (vec($cl_ok, $i, 1)) {
  717.       if (&list_exist($plugin_list, 'kanji') && $cl_code[$i]) {
  718.     $cl_code = $cl_code[$i];
  719.     $kanji = "kanji_$cl_code";
  720.     &$kanji(*mes);
  721.       }
  722.       print $cc $mes;
  723.     }
  724.   }
  725. }
  726. sub sn_cch {
  727.   local($mes, $cl_no) = @_;
  728.   my($cc, $cl_code, $kanji);
  729.   for ($i = 0; $i <= $cl_max; $i++) {
  730.     $cc = $cl[$i];
  731.     next unless $cc;
  732.     if (vec($cl_ok, $i, 1) && !vec($cl_chan, $i, 1)) {
  733.       if (&list_exist($plugin_list, 'kanji') && $cl_code[$i]) {
  734.     $cl_code = $cl_code[$i];
  735.     $kanji = "kanji_$cl_code";
  736.     &$kanji(*mes);
  737.       }
  738.       print $cc $mes;
  739.     }
  740.   }
  741. }
  742. sub sn_cco {
  743.   local($mes, $cl_no) = @_;
  744.   my($cc, $cl_code, $kanji);
  745.   for ($i = 0; $i <= $cl_max; $i++) {
  746.     $cc = $cl[$i];
  747.     next unless $cc;
  748.     if (vec($cl_ok, $i, 1) && !vec($cl_chan, $i, 1) && $cl_no != $i) {
  749.       if (&list_exist($plugin_list, 'kanji') && $cl_code[$i]) {
  750.     $cl_code = $cl_code[$i];
  751.     $kanji = "kanji_$cl_code";
  752.     &$kanji(*mes);
  753.       }
  754.       print $cc $mes;
  755.     }
  756.   }
  757. }
  758. sub sendSCL {
  759.   local($mes, $chan, $code, $w) = @_;
  760.   local($chanr, $chanv) = &alias_chan($chan);
  761.   my $cl_code = $cl_code[$cl_no] || 'jis';
  762.   my $kanji = "kanji_$cl_code";
  763.   &kanji_jis(*mes, $code) if &list_exist($plugin_list, 'kanji');
  764.   $mes =~ s/\r*\n$//;
  765.   if ($w) {
  766.     push(@mes_buf2, "$w $chanr $mes");
  767.   } else {
  768.     &send('sv', "PRIVMSG $chanr :$mes\r\n");
  769.     &$kanji(*mes) if &list_exist($plugin_list, 'kanji');
  770.     &send('cch', ":$us_nick!$machine{$us_nick} PRIVMSG $chanr :$mes\r\n");
  771.   }
  772. }
  773. sub sendSCL_sec {
  774.   return if scalar(@mes_buf2) == 0;
  775.   my($i, $w, $chan);
  776.   local $mes;
  777.   my $cl_code = $cl_code[$cl_no] || 'jis';
  778.   my $kanji = "kanji_$cl_code";
  779.   for ($i = 0; $i <= scalar(@mes_buf2); $i++) {
  780.     ($w, $chan, $mes) = split(/ /, shift(@mes_buf2), 3);
  781.     if ($w < time) {
  782.       &send('sv', "PRIVMSG $chan :$mes\r\n");
  783.       &$kanji(*mes) if &list_exist($plugin_list, 'kanji');
  784.       &send('cch', ":$us_nick!$machine{$us_nick} PRIVMSG $chan :$mes\r\n");
  785.     } else {
  786.       push(@mes_buf2, "$w $chan $mes");
  787.     }
  788.   }
  789. }
  790. sub cached {
  791.   my($mes, $chan, $code, $w) = @_;
  792.   my($chanr, $chanv) = &alias_chan($chan);
  793.   foreach (@cache_mes) {
  794.     return if $_ eq ">$chanv:$us_nick< $mes";
  795.   }
  796.   &sendSCL($mes, $chan, $code, $w);
  797. }
  798. sub list_init {
  799.   $_[0] = "$;";
  800. }
  801. sub list_add {
  802.   &list_init($_[0]) unless $_[0];
  803.   unless (&list_exist(@_)) {
  804.     $_[0] .= "$_[1]$;";
  805.     return 1;
  806.   }
  807.   return 0;
  808. }
  809. sub list_del {
  810.   local($u, @pr) = @_;
  811.   my($f, $l) = (0, '');
  812.   foreach (@pr) {
  813.     $l = "\Q$_\E";
  814.     if ($_[0] =~ /$;$l$;/i) {
  815.       substr($_[0], index($_[0], "$;$_$;"), length("$;$_$;")) = "$;";
  816.       $f = 1;
  817.     }
  818.   }
  819.   return $f;
  820. }
  821. sub list_exist {
  822.   local($u, @pr) = @_;
  823.   my $f = 0;
  824.   foreach (@pr) {
  825.     next unless $_;
  826.     $f = 1 if $_[0] =~ /$;(\Q$_\E)$;/i;
  827.   }
  828.   return $f;
  829. }
  830. sub list_change {
  831.   my $pr = "\Q$_[1]\E";
  832.   if ($_[0] =~ /$;$pr$;/i) {
  833.     substr($_[0], index($_[0], "$;$_[1]$;"), length("$;$_[1]$;")) = "$;$_[2]$;";
  834.     return 1;
  835.   }
  836.   return 0;
  837. }
  838. sub current_time {
  839.   ($sec, $min, $hour, $mday, $mon, $year) = localtime(time);
  840.   $mon++;
  841.   $year += 1900;
  842. }
  843. sub alias_chan {
  844.   my $chan = my $chanr = my $chanv = &check_chl($_[0]);
  845.   return unless $_[0];
  846.   if ($chl_mask ne '') {
  847.     my $l = "\Q$chl_mask\E";
  848.     if ($chan =~ /^\#(.*):$l$/i) {
  849.       $chanv = '%' . $1;
  850.     }
  851.     if ($chan =~ /^%/) {
  852.       $chan =~ s/^%/\#/;
  853.       $chanr = "$chan:$chl_mask";
  854.     }
  855.   }
  856.   foreach (keys(%chl_alias)) {
  857.     if ($_ eq $chanr) {
  858.       $chanv = $chl_alias{$_};
  859.       last;
  860.     } elsif ($chl_alias{$_} eq $chanv) {
  861.       $chanr = $_;
  862.       last;
  863.     }
  864.   }
  865.   return($chanr, $chanv);
  866. }
  867. sub taillog {
  868.   if ($taillog) {
  869.     foreach (@tail) {
  870.       next unless $_;
  871.       &send('cl', "NOTICE $us_nick :$_");
  872.     }
  873.     &send('cl', "NOTICE $us_nick :" .
  874.       &mio('MADOKA_TAILLOG', '[!] end of taillog') . "\n");
  875.   }
  876. }
  877. sub check_chan {
  878.   $_[0] =~ s/\033\$\@/\033\$B/g;
  879.   $_[0] =~ s/\033\(J/\033\(B/g;
  880.   return 0 if $_[0] =~ / / || $_[0] =~ /\007/ || $_[0] =~ /^[^$chl_header]/ ||
  881.       ($_[0] =~ /,/ && scalar(&chl_split($_[0])) > 1);
  882.   return 1;
  883. }
  884. sub check_chl {
  885.   my $l = my $chan = $_[0];
  886.   $l = "\Q$l\E";
  887.   if ($chl =~ /$;($l)$;/i || $chl_autojoin =~ /$;($l)$;/i) {
  888.     $chan = $1;
  889.   }
  890.   return $chan;
  891. }
  892. sub chl_split {
  893.   my $l = $_[0];
  894.   my(@ch, $i, $j, $jis);
  895.   $j = $jis = 0;
  896.   for ($i = 0; $i < length($l); $i++) {
  897.     if (substr($l, $i, 1) eq ',' && $jis == 0) {
  898.       $j++;
  899.       $i++;
  900.     }
  901.     $ch[$j] .= substr($l, $i, 1);
  902.     if ($jis == 0 && substr($l, $i+1, 3) =~ /^\e\$[\@B]/i) {
  903.       $jis = 1;
  904.       $ch[$j] .= substr($l, $i+1, 3);
  905.       $i += 3;
  906.     } elsif ($jis == 1 && substr($l, $i+1, 3) =~ /^\e\([BHJ]/i) {
  907.       $jis = 0;
  908.       $ch[$j] .= substr($l, $i+1, 3);
  909.       $i += 3;
  910.     }
  911.   }
  912.   return @ch;
  913. }
  914. sub check_host {
  915.   my($cl_no, @ip) = @_;
  916.   my($cl_addr, $netmask, $l);
  917.   if ($host[$cl_no] =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
  918.     $cl_addr = 2 ** 24 * $1 + 2 ** 16 * $2 + 2 ** 8 * $3 + $4;
  919.     &mes("[check_host] host: $host[$cl_no] via IPv4", 'D');
  920.   } elsif ($host[$cl_no] =~ /^0000:0000:0000:0000:0000:ffff:([\da-f]{4}:[\da-f]{4})$/i) {
  921.     ($cl_addr = $1) =~ s/://;
  922.     $cl_addr = hex('0x'.$cl_addr);
  923.     &mes("[check_host] host: $host[$cl_no] via IPv6 on IPv4 mapped", 'D');
  924.   } else {
  925.     $cl_addr = "\L$host[$cl_no]\E";
  926.     &mes("[check_host] host: $host[$cl_no] via IPv6", 'D');
  927.   }
  928.   &mes("[check_host] cl_addr: $cl_addr", 'D');
  929.   foreach (@ip) {
  930.     next unless $_;
  931.     &mes("[check_host] iploop: $_", 'D');
  932.     if (/^(?:0{0,4}:){1,4}:ffff:([\da-f]{1,4}):([\da-f]{1,4})(?:\/(\d+))?$/i) {
  933.       $_ = hex('0x'.sprintf("%04s%04s", $1, $2));
  934.       $_ .= sprintf("/%d", $3 - 96) if $3;
  935.     }
  936.     if ($cl_addr =~ /:/) { # IPv6
  937.       my $k = $cl_addr;
  938.       if (/^\./) {
  939.     my $i = (getaddrinfo($k, 0, $AF_INET6, $SOCK_STREAM))[3];
  940.     my $host = (getnameinfo($i, 0))[0];
  941.     &mes("[check_host] hostname6: $host", 'D');
  942.     return 1 if $host =~ /\Q$_\E$/;
  943.     return 0;
  944.       } elsif (/^(.+)\/(\d+)$/) {
  945.     $l = "\L$1\E";
  946.     $netmask = $2/4;
  947.     next if $netmask * 4 % 4 > 0; # ignore
  948.       } else {
  949.     $l = "\L$_\E";
  950.     $netmask = 32;
  951.       }
  952.       my $i = (getaddrinfo($l, 0, $AF_INET6, $SOCK_STREAM))[3];
  953.       my($u, $j) = sockaddr_in6($i);
  954.       $l = join(':', unpack('H4 H4 H4 H4 H4 H4 H4 H4', $j));
  955.       $l =~ s/://g;
  956.       $i = (getaddrinfo($k, 0, $AF_INET6, $SOCK_STREAM))[3];
  957.       $i = (getnameinfo($i, 0))[0];
  958.       $i = (getaddrinfo($i, 0, $AF_INET6, $SOCK_STREAM))[3];
  959.       ($u, $j) = sockaddr_in6($i);
  960.       $k = join(':', unpack('H4 H4 H4 H4 H4 H4 H4 H4', $j));
  961.       $k =~ s/://g;
  962.       &mes("[check_host] addr: $l / $k / $netmask", 'D');
  963.       return 1 if substr($l, 0, $netmask) eq substr($k, 0, $netmask);
  964.     } else { # IPv4
  965.       if (/^(.+)\/(.+)$/) {
  966.     $l = $1;
  967.     $netmask = $2;
  968.       } else {
  969.     $l = $_;
  970.     $netmask = 32;
  971.       }
  972.       if ($l =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
  973.     $l = 2 ** 24 * $1 + 2 ** 16 * $2 + 2 ** 8 * $3 + $4;
  974.       } else {
  975.     $l = unpack('N1', (gethostbyname($l))[4]);
  976.       }
  977.       if ($netmask =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
  978.     $netmask = 2 ** 24 * $1 + 2 ** 16 * $2 + 2 ** 8 * $3 + $4;
  979.       } else {
  980.     $netmask = int((2 ** $netmask - 1) << (32 - $netmask));
  981.       }
  982.       return 1 if ($cl_addr & $netmask) == ($l & $netmask);
  983.       if (/^\./) {
  984.     my($port, $addr) = sockaddr_in(getpeername($cl[$cl_no]));
  985.     my $host = gethostbyaddr($addr, $AF_INET4);
  986.     &mes("[check_host] hostname: $host", 'D');
  987.     return 1 if $host =~ /\Q$_\E$/;
  988.       }
  989.     }
  990.   }
  991.   return 0;
  992. }
  993. sub mio {
  994.   my($_tag, $_mes) = @_;
  995.   $mes =~ s/\r*\n$//;
  996.   return &Mio($_tag, $_mes) if &list_exist($plugin_list, 'mio');
  997.   return $_mes;
  998. }
  999. sub down {
  1000.   my $mes = $_[0];
  1001.   $mes .= "\n" if $mes !~ /\n$/;
  1002.   print STDERR $mes;
  1003.   exit 0;
  1004. }
  1005. __END__
  1006.