src/Modules/UserDCC.pl

   1 #
   2 #  UserDCC.pl: User Commands, DCC CHAT.
   3 #      Author: dms
   4 #     Version: v0.2 (20010119)
   5 #     Created: 20000707 (from UserExtra.pl)
   6 #
   7
   8 use strict;
   9
  10 use vars qw(%users %ignore %sched %bans %mask %cache %channels %param
  11         %chanconf %dcc);
  12 use vars qw($who $chan $message $msgType $user $chnick $conn $ident
  13         $verifyUser $ucount_userfile $utime_userfile $lobotomized
  14         $utime_chanfile $ucount_chanfile);
  15 use vars qw(@backlog);
  16
  17 sub userDCC {
  18     # hrm...
  19     $message =~ s/\s+$//;
  20
  21     ### for all users.
  22     # quit.
  23     if ($message =~ /^(exit|quit)$/i) {
  24         # do ircII clients support remote close? if so, cool!
  25         &FIXME("userDCC: quit called.");
  26         &dcc_close($who);
  27         &status("userDCC: after dcc_close!");
  28
  29         return;
  30     }
  31
  32     # who.
  33     if ($message =~ /^who$/) {
  34         my $count = scalar(keys %{ $dcc{'CHAT'} });
  35         my $dccCHAT = $message;
  36
  37         &pSReply("Start of who ($count users).");
  38         foreach (keys %{ $dcc{'CHAT'} }) {
  39             &pSReply("=> $_");
  40         }
  41         &pSReply("End of who.");
  42
  43         return;
  44     }
  45
  46     ### for those users with enough flags.
  47
  48     if ($message =~ /^tellme(\s+(.*))?$/i) {
  49         my $args = $2;
  50         if ($args =~ /^\s*$/) {
  51             &help("tellme");
  52             return;
  53         }
  54
  55         my $result = &doQuestion($args);
  56         &pSReply($result);
  57
  58         return;
  59     }
  60
  61     # 4op.
  62     if ($message =~ /^4op(\s+($mask{chan}))?$/i) {
  63         return unless (&hasFlag("o"));
  64
  65         my $chan = $2;
  66
  67         if ($chan eq "") {
  68             &help("4op");
  69             return;
  70         }
  71
  72         if (!$channels{$chan}{'o'}{$ident}) {
  73             &msg($who, "i don't have ops on $chan to do that.");
  74             return;
  75         }
  76
  77         # on non-4mode(<4) servers, this may be exploited.
  78         if ($channels{$chan}{'o'}{$who}) {
  79             rawout("MODE $chan -o+o-o+o". (" $who" x 4));
  80         } else {
  81             rawout("MODE $chan +o-o+o-o". (" $who" x 4));
  82         }
  83
  84         return;
  85     }
  86
  87     # backlog.
  88     if ($message =~ /^backlog(\s+(.*))?$/i) {
  89         return unless (&hasFlag("o"));
  90         return unless (&hasParam("backlog"));
  91         my $num = $2;
  92         my $max = $param{'backlog'};
  93
  94         if (!defined $num) {
  95             &help("backlog");
  96             return;
  97         } elsif ($num !~ /^\d+/) {
  98             &msg($who, "error: argument is not positive integer.");
  99             return;
 100         } elsif ($num > $max or $num < 0) {
 101             &msg($who, "error: argument is out of range (max $max).");
 102             return;
 103         }
 104
 105         &msg($who, "Start of backlog...");
 106         for (0..$num-1) {
 107             sleep 1 if ($_ % 4 == 0 and $_ != 0);
 108             $conn->privmsg($who, "[".($_+1)."]: $backlog[$max-$num+$_]");
 109         }
 110         &msg($who, "End of backlog.");
 111
 112         return;
 113     }
 114
 115     # dump variables.
 116     if ($message =~ /^dumpvars$/i) {
 117         return unless (&hasFlag("o"));
 118         return unless (&IsParam("DumpVars"));
 119
 120         &status("Dumping all variables...");
 121         &dumpallvars();
 122
 123         return;
 124     }
 125
 126     # dump variables ][.
 127     if ($message =~ /^symdump$/i) {
 128         return unless (&hasFlag('o'));
 129         return unless (&IsParam('DumpVars2'));
 130
 131         &status("Dumping all variables...");
 132         &symdumpAllFile();
 133
 134         return;
 135     }
 136
 137     # kick.
 138     if ($message =~ /^kick(\s+(.*?))$/) {
 139         return unless (&hasFlag("o"));
 140
 141         my $arg = $2;
 142
 143         if ($arg eq "") {
 144             &help("kick");
 145             return;
 146         }
 147         my @args = split(/\s+/, $arg);
 148         my ($nick,$chan,$reason) = @args;
 149
 150         if (&validChan($chan) == 0) {
 151             &msg($who,"error: invalid channel \002$chan\002");
 152             return;
 153         }
 154
 155         if (&IsNickInChan($nick,$chan) == 0) {
 156             &msg($who,"$nick is not in $chan.");
 157             return;
 158         }
 159
 160         &kick($nick,$chan,$reason);
 161
 162         return;
 163     }
 164
 165     # mode.
 166     if ($message =~ /^mode(\s+(.*))?$/) {
 167         return unless (&hasFlag("n"));
 168         my ($chan,$mode) = split /\s+/,$2,2;
 169
 170         if ($chan eq "") {
 171             &help("mode");
 172             return;
 173         }
 174
 175         if (&validChan($chan) == 0) {
 176             &msg($who,"error: invalid channel \002$chan\002");
 177             return;
 178         }
 179
 180         if (!$channels{$chan}{o}{$ident}) {
 181             &msg($who,"error: don't have ops on \002$chan\002");
 182             return;
 183         }
 184
 185         &mode($chan, $mode);
 186
 187         return;
 188     }
 189
 190     # part.
 191     if ($message =~ /^part(\s+(\S+))?$/i) {
 192         return unless (&hasFlag("o"));
 193         my $jchan = $2;
 194
 195         if ($jchan !~ /^$mask{chan}$/) {
 196             &msg($who, "error, invalid chan.");
 197             &help("part");
 198             return;
 199         }
 200
 201         if (!&validChan($jchan)) {
 202             &msg($who, "error, I'm not on that chan.");
 203             return;
 204         }
 205
 206         &msg($jchan, "Leaving. (courtesy of $who).");
 207         &part($jchan);
 208         return;
 209     }
 210
 211     # lobotomy. sometimes we want the bot to be _QUIET_.
 212     if ($message =~ /^(lobotomy|bequiet)$/i) {
 213         return unless (&hasFlag("o"));
 214
 215         if ($lobotomized) {
 216             &performReply("i'm already lobotomized");
 217         } else {
 218             &performReply("i have been lobotomized");
 219             $lobotomized = 1;
 220         }
 221
 222         return;
 223     }
 224
 225     # unlobotomy.
 226     if ($message =~ /^(unlobotomy|benoisy)$/i) {
 227         return unless (&hasFlag("o"));
 228
 229         if ($lobotomized) {
 230             &performReply("i have been unlobotomized, woohoo");
 231             $lobotomized = 0;
 232             delete $cache{lobotomy};
 233 #           undef $cache{lobotomy};     # ??
 234         } else {
 235             &performReply("i'm not lobotomized");
 236         }
 237
 238         return;
 239     }
 240
 241     # op.
 242     if ($message =~ /^op(\s+(.*))?$/i) {
 243         return unless (&hasFlag("o"));
 244         my ($opee) = lc $2;
 245         my @chans;
 246
 247         if ($opee =~ / /) {
 248             if ($opee =~ /^(\S+)\s+(\S+)$/) {
 249                 $opee  = $1;
 250                 @chans = ($2);
 251                 if (!&validChan($2)) {
 252                     &msg($who,"error: invalid chan ($2).");
 253                     return;
 254                 }
 255             } else {
 256                 &msg($who,"error: invalid params.");
 257                 return;
 258             }
 259         } else {
 260             @chans = keys %channels;
 261         }
 262
 263         my $found = 0;
 264         my $op = 0;
 265         foreach (@chans) {
 266             next unless (&IsNickInChan($opee,$_));
 267             $found++;
 268             if ($channels{$_}{'o'}{$opee}) {
 269                 &pSReply("op: $opee already has ops on $_");
 270                 next;
 271             }
 272             $op++;
 273
 274             &pSReply("opping $opee on $_");
 275             &op($_, $opee);
 276         }
 277
 278         if ($found != $op) {
 279             &pSReply("op: opped on all possible channels.");
 280         } else {
 281             &DEBUG("op: found => '$found'.");
 282             &DEBUG("op:    op => '$op'.");
 283         }
 284
 285         return;
 286     }
 287
 288     # deop.
 289     if ($message =~ /^deop(\s+(.*))?$/i) {
 290         return unless (&hasFlag("o"));
 291         my ($opee) = lc $2;
 292         my @chans;
 293
 294         if ($opee =~ / /) {
 295             if ($opee =~ /^(\S+)\s+(\S+)$/) {
 296                 $opee  = $1;
 297                 @chans = ($2);
 298                 if (!&validChan($2)) {
 299                     &msg($who,"error: invalid chan ($2).");
 300                     return;
 301                 }
 302             } else {
 303                 &msg($who,"error: invalid params.");
 304                 return;
 305             }
 306         } else {
 307             @chans = keys %channels;
 308         }
 309
 310         my $found = 0;
 311         my $op = 0;
 312         foreach (@chans) {
 313             next unless (&IsNickInChan($opee,$_));
 314             $found++;
 315             if (!exists $channels{$_}{'o'}{$opee}) {
 316                 &status("deop: $opee already has no ops on $_");
 317                 next;
 318             }
 319             $op++;
 320
 321             &status("deopping $opee on $_ at ${who}'s request");
 322             &deop($_, $opee);
 323         }
 324
 325         if ($found != $op) {
 326             &status("deop: deopped on all possible channels.");
 327         } else {
 328             &DEBUG("deop: found => '$found'.");
 329             &DEBUG("deop: op => '$op'.");
 330         }
 331
 332         return;
 333     }
 334
 335     # say.
 336     if ($message =~ s/^say\s+(\S+)\s+(.*)//) {
 337         return unless (&hasFlag("o"));
 338         my ($chan,$msg) = (lc $1, $2);
 339
 340         &DEBUG("chan => '$1', msg => '$msg'.");
 341
 342         # TODO: add nick destination.
 343         if (&validChan($chan)) {
 344             &msg($chan, $msg);
 345         } else {
 346             &msg($who,"i'm not on \002$chan\002, sorry.");
 347         }
 348
 349         return;
 350     }
 351
 352     # do.
 353     if ($message =~ s/^do\s+(\S+)\s+(.*)//) {
 354         return unless (&hasFlag("o"));
 355         my ($chan,$msg) = (lc $1, $2);
 356
 357         &DEBUG("chan => '$1', msg => '$msg'.");
 358
 359         # TODO: add nick destination.
 360         if (&validChan($chan)) {
 361             &action($chan, $msg);
 362         } else {
 363             &msg($who,"i'm not on \002$chan\002, sorry.");
 364         }
 365
 366         return;
 367     }
 368
 369     # die.
 370     if ($message =~ /^die$/) {
 371         return unless (&hasFlag("n"));
 372
 373         &doExit();
 374
 375         &status("Dying by $who\'s request");
 376         exit 0;
 377     }
 378
 379     # global factoid substitution.
 380     if ($message =~ m|^s([/,#])(.+?)\1(.*?)\1;?\s*$|) {
 381         my ($delim,$op,$np) = ($1, $2, $3);
 382         return unless (&hasFlag("n"));
 383         ### TODO: support flags to do full-on global.
 384
 385         # incorrect format.
 386         if ($np =~ /$delim/) {
 387             &performReply("looks like you used the delimiter too many times. You may want to use a different delimiter, like ':' or '#'.");
 388             return;
 389         }
 390
 391         ### TODO: fix up $op to support mysql/sqlite/pgsql
 392         ### TODO: => add db/sql specific function to fix this.
 393         my @list = &searchTable("factoids", "factoid_key",
 394                         "factoid_value", $op);
 395
 396         if (!scalar @list) {
 397             &performReply("Expression didn't match anything.");
 398             return;
 399         }
 400
 401         if (scalar @list > 100) {
 402             &performReply("regex found more than 100 matches... not doing.");
 403             return;
 404         }
 405
 406         &status("gsubst: going to alter ".scalar(@list)." factoids.");
 407         &performReply("going to alter ".scalar(@list)." factoids.");
 408
 409         my $error = 0;
 410         foreach (@list) {
 411             my $faqtoid = $_;
 412
 413             next if (&IsLocked($faqtoid) == 1);
 414             my $result = &getFactoid($faqtoid);
 415             my $was = $result;
 416             &DEBUG("was($faqtoid) => '$was'.");
 417
 418             # global global
 419             # we could support global local (once off).
 420             if ($result =~ s/\Q$op/$np/gi) {
 421                 if (length $result > $param{'maxDataSize'}) {
 422                     &performReply("that's too long (or was long)");
 423                     return;
 424                 }
 425                 &setFactInfo($faqtoid, "factoid_value", $result);
 426                 &status("update: '$faqtoid' =is=> '$result'; was '$was'");
 427             } else {
 428                 &WARN("subst: that's weird... thought we found the string ($op) in '$faqtoid'.");
 429                 $error++;
 430             }
 431         }
 432
 433         if ($error) {
 434             &ERROR("Some warnings/errors?");
 435         }
 436
 437         &performReply("Ok... did s/$op/$np/ for ".
 438                                 (scalar(@list) - $error)." factoids");
 439
 440         return;
 441     }
 442
 443     # jump.
 444     if ($message =~ /^jump(\s+(\S+))?$/i) {
 445         return unless (&hasFlag("n"));
 446
 447         if ($2 eq "") {
 448             &help("jump");
 449             return;
 450         }
 451
 452         my ($server,$port);
 453         if ($2 =~ /^(\S+)(:(\d+))?$/) {
 454             $server = $1;
 455             $port   = $3 || 6667;
 456         } else {
 457             &msg($who,"invalid format.");
 458             return;
 459         }
 460
 461         &status("jumping servers... $server...");
 462         $conn->quit("jumping to $server");
 463
 464         if (&irc($server,$port) == 0) {
 465             &ircloop();
 466         }
 467     }
 468
 469     # reload.
 470     if ($message =~ /^reload$/i) {
 471         return unless (&hasFlag("n"));
 472
 473         &status("USER reload $who");
 474         &pSReply("reloading...");
 475         &reloadAllModules();
 476         &pSReply("reloaded.");
 477
 478         return;
 479     }
 480
 481     # reset.
 482     if ($message =~ /^reset$/i) {
 483         return unless (&hasFlag("n"));
 484
 485         &msg($who,"resetting...");
 486         my @done;
 487         foreach ( keys %channels, keys %chanconf ) {
 488             my $c = $_;
 489             next if (grep /^\Q$c\E$/i, @done);
 490
 491             &part($_);
 492
 493             push(@done, $_);
 494             sleep 1;
 495         }
 496         &DEBUG("before clearircvars");
 497         &clearIRCVars();
 498         &DEBUG("before joinnextchan");
 499         &joinNextChan();
 500         &DEBUG("after joinnextchan");
 501
 502         &status("USER reset $who");
 503         &msg($who,"reset complete");
 504
 505         return;
 506     }
 507
 508     # rehash.
 509     if ($message =~ /^rehash$/) {
 510         return unless (&hasFlag("n"));
 511
 512         &msg($who,"rehashing...");
 513         &restart("REHASH");
 514         &status("USER rehash $who");
 515         &msg($who,"rehashed");
 516
 517         return;
 518     }
 519
 520     #####
 521     ##### USER//CHAN SPECIFIC CONFIGURATION COMMANDS
 522     #####
 523
 524     if ($message =~ /^chaninfo(\s+(.*))?$/) {
 525         my @args = split /[\s\t]+/, $2; # hrm.
 526
 527         if (scalar @args != 1) {
 528             &help("chaninfo");
 529             return;
 530         }
 531
 532         if (!exists $chanconf{$args[0]}) {
 533             &pSReply("no such channel $args[0]");
 534             return;
 535         }
 536
 537         &pSReply("showing channel conf.");
 538         foreach (sort keys %{ $chanconf{$args[0]} }) {
 539             &pSReply("$chan: $_ => $chanconf{$args[0]}{$_}");
 540         }
 541         &pSReply("End of chaninfo.");
 542
 543         return;
 544     }
 545
 546     # +chan.
 547     if ($message =~ /^(chanset|\+chan)(\s+(.*?))?$/) {
 548         my $cmd         = $1;
 549         my $args        = $3;
 550         my $no_chan     = 0;
 551
 552         if (!defined $args) {
 553             &help($cmd);
 554             return;
 555         }
 556
 557         my @chans;
 558         while ($args =~ s/^($mask{chan})\s*//) {
 559             push(@chans, lc($1));
 560         }
 561
 562         if (!scalar @chans) {
 563             push(@chans, "_default");
 564             $no_chan    = 1;
 565         }
 566
 567         my($what,$val) = split /[\s\t]+/, $args, 2;
 568
 569         ### TODO: "cannot set values without +m".
 570         return unless (&hasFlag("n"));
 571
 572         # READ ONLY.
 573         if (defined $what and $what !~ /^[-+]/ and !defined $val and $no_chan) {
 574             &pSReply("Showing $what values on all channels...");
 575
 576             my %vals;
 577             foreach (keys %chanconf) {
 578                 my $val;
 579                 if (defined $chanconf{$_}{$what}) {
 580                     $val = $chanconf{$_}{$what};
 581                 } else {
 582                     $val = "NOT-SET";
 583                 }
 584                 $vals{$val}{$_} = 1;
 585             }
 586
 587             foreach (keys %vals) {
 588                 &pSReply("  $what = $_(" . scalar(keys %{$vals{$_}}) . "): ".join(' ', sort keys %{ $vals{$_} } ) );
 589             }
 590
 591             &pSReply("End of list.");
 592
 593             return;
 594         }
 595
 596         ### TODO: move to UserDCC again.
 597         if ($cmd eq "chanset" and !defined $what) {
 598             &DEBUG("showing channel conf.");
 599
 600             foreach $chan (@chans) {
 601                 if ($chan eq '_default') {
 602                     &pSReply("Default channel settings");
 603                 } else {
 604                     &pSReply("chan: $chan (see _default also)");
 605                 }
 606                 my @items;
 607                 my $str = "";
 608                 foreach (sort keys %{ $chanconf{$chan} }) {
 609                     my $newstr = join(', ', @items);
 610                     ### TODO: make length use channel line limit?
 611                     if (length $newstr > 370) {
 612                         &pSReply(" $str");
 613                         @items = ();
 614                     }
 615                     $str = $newstr;
 616                     push(@items, "$_ => $chanconf{$chan}{$_}");
 617                 }
 618                 &pSReply(" $str") if (@items);
 619             }
 620             return;
 621         }
 622
 623         $cache{confvars}{$what} = $val;
 624         &rehashConfVars();
 625
 626         foreach (@chans) {
 627             &chanSet($cmd, $_, $what, $val);
 628         }
 629
 630         return;
 631     }
 632
 633     if ($message =~ /^(chanunset|\-chan)(\s+(.*))?$/) {
 634         return unless (&hasFlag("n"));
 635         my $args        = $3;
 636         my $no_chan     = 0;
 637
 638         if (!defined $args) {
 639             &help("chanunset");
 640             return;
 641         }
 642
 643         my ($chan);
 644         my $delete      = 0;
 645         if ($args =~ s/^(\-)?($mask{chan})\s*//) {
 646             $chan       = $2;
 647             $delete     = ($1) ? 1 : 0;
 648         } else {
 649             &VERB("no chan arg; setting to default.",2);
 650             $chan       = "_default";
 651             $no_chan    = 1;
 652         }
 653
 654         if (!exists $chanconf{$chan}) {
 655             &pSReply("no such channel $chan");
 656             return;
 657         }
 658
 659         if ($args ne "") {
 660
 661             if (!&getChanConf($args,$chan)) {
 662                 &pSReply("$args does not exist for $chan");
 663                 return;
 664             }
 665
 666             my @chans = &ChanConfList($args);
 667             &DEBUG("scalar chans => ".scalar(@chans) );
 668             if (scalar @chans == 1 and $chans[0] eq "_default" and !$no_chan) {
 669                 &psReply("ok, $args was set only for _default; unsetting for _defaul but setting for other chans.");
 670
 671                 my $val = $chanconf{$_}{_default};
 672                 foreach (keys %chanconf) {
 673                     $chanconf{$_}{$args} = $val;
 674                 }
 675                 delete $chanconf{_default}{$args};
 676                 $cache{confvars}{$args} = 0;
 677                 &rehashConfVars();
 678
 679                 return;
 680             }
 681
 682             if ($no_chan and !exists($chanconf{_default}{$args})) {
 683                 &pSReply("ok, $args for _default does not exist, removing from all chans.");
 684
 685                 foreach (keys %chanconf) {
 686                     next unless (exists $chanconf{$_}{$args});
 687                     &DEBUG("delete chanconf{$_}{$args};");
 688                     delete $chanconf{$_}{$args};
 689                 }
 690                 $cache{confvars}{$args} = 0;
 691                 &rehashConfVars();
 692
 693                 return;
 694             }
 695
 696             &pSReply("Unsetting channel ($chan) option $args. (was $chanconf{$chan}{$args})");
 697             delete $chanconf{$chan}{$args};
 698
 699             return;
 700         }
 701
 702         if ($delete) {
 703             &pSReply("Deleting channel $chan for sure!");
 704             $utime_chanfile = time();
 705             $ucount_chanfile++;
 706
 707             &part($chan);
 708             &pSReply("Leaving $chan...");
 709
 710             delete $chanconf{$chan};
 711         } else {
 712             &pSReply("Prefix channel with '-' to delete for sure.");
 713         }
 714
 715         return;
 716     }
 717
 718     if ($message =~ /^newpass(\s+(.*))?$/) {
 719         my(@args) = split /[\s\t]+/, $2 || '';
 720
 721         if (scalar @args != 1) {
 722             &help("newpass");
 723             return;
 724         }
 725
 726         my $u = &getUser($who);
 727         my $crypt = &mkcrypt($args[0]);
 728
 729         &pSReply("Set your passwd to '$crypt'");
 730         $users{$u}{PASS} = $crypt;
 731
 732         $utime_userfile = time();
 733         $ucount_userfile++;
 734
 735         return;
 736     }
 737
 738     if ($message =~ /^chpass(\s+(.*))?$/) {
 739         my(@args) = split /[\s\t]+/, $2 || '';
 740
 741         if (!scalar @args) {
 742             &help("chpass");
 743             return;
 744         }
 745
 746         if (!&IsUser($args[0])) {
 747             &pSReply("user $args[0] is not valid.");
 748             return;
 749         }
 750
 751         my $u = &getUser($args[0]);
 752         if (!defined $u) {
 753             &pSReply("Internal error, u = NULL.");
 754             return;
 755         }
 756
 757         if (scalar @args == 1) {
 758             # del pass.
 759             if (!&IsFlag("n") and $who !~ /^\Q$verifyUser\E$/i) {
 760                 &pSReply("cannot remove passwd of others.");
 761                 return;
 762             }
 763
 764             if (!exists $users{$u}{PASS}) {
 765                 &pSReply("$u does not have pass set anyway.");
 766                 return;
 767             }
 768
 769             &pSReply("Deleted pass from $u.");
 770
 771             $utime_userfile = time();
 772             $ucount_userfile++;
 773
 774             delete $users{$u}{PASS};
 775
 776             return;
 777         }
 778
 779         my $crypt       = &mkcrypt($args[1]);
 780         &pSReply("Set $u's passwd to '$crypt'");
 781         $users{$u}{PASS} = $crypt;
 782
 783         $utime_userfile = time();
 784         $ucount_userfile++;
 785
 786         return;
 787     }
 788
 789     if ($message =~ /^chattr(\s+(.*))?$/) {
 790         my(@args) = split /[\s\t]+/, $2 || '';
 791
 792         if (!scalar @args) {
 793             &help("chattr");
 794             return;
 795         }
 796
 797         my $chflag;
 798         my $user;
 799         if ($args[0] =~ /^$mask{nick}$/i) {
 800             # <nick>
 801             $user       = &getUser($args[0]);
 802             $chflag     = $args[1];
 803         } else {
 804             # <flags>
 805             $user       = &getUser($who);
 806             &DEBUG("user $who... nope.") unless (defined $user);
 807             $user       = &getUser($verifyUser);
 808             $chflag     = $args[0];
 809         }
 810
 811         if (!defined $user) {
 812             &pSReply("user does not exist.");
 813             return;
 814         }
 815
 816         my $flags = $users{$user}{FLAGS};
 817         if (!defined $chflag) {
 818             &pSReply("Flags for $user: $flags");
 819             return;
 820         }
 821
 822         &DEBUG("who => $who");
 823         &DEBUG("verifyUser => $verifyUser");
 824         if (!&IsFlag("n") and $who !~ /^\Q$verifyUser\E$/i) {
 825             &pSReply("cannto change attributes of others.");
 826             return "REPLY";
 827         }
 828
 829         my $state;
 830         my $change      = 0;
 831         foreach (split //, $chflag) {
 832             if ($_ eq "+") { $state = 1; next; }
 833             if ($_ eq "-") { $state = 0; next; }
 834
 835             if (!defined $state) {
 836                 &pSReply("no initial + or - was found in attr.");
 837                 return;
 838             }
 839
 840             if ($state) {
 841                 next if ($flags =~ /\Q$_\E/);
 842                 $flags .= $_;
 843             } else {
 844                 if (&IsParam("owner")
 845                         and $param{owner} =~ /^\Q$user\E$/i
 846                         and $flags =~ /[nmo]/
 847                 ) {
 848                     &pSReply("not removing flag $_ for $user.");
 849                     next;
 850                 }
 851                 next unless ($flags =~ s/\Q$_\E//);
 852             }
 853
 854             $change++;
 855         }
 856
 857         if ($change) {
 858             $utime_userfile = time();
 859             $ucount_userfile++;
 860             &pSReply("Current flags: $flags");
 861             $users{$user}{FLAGS} = $flags;
 862         } else {
 863             &pSReply("No flags changed: $flags");
 864         }
 865
 866         return;
 867     }
 868
 869     if ($message =~ /^chnick(\s+(.*))?$/) {
 870         my(@args) = split /[\s\t]+/, $2 || '';
 871
 872         if ($who eq "_default") {
 873             &WARN("$who or verifyuser tried to run chnick.");
 874             return "REPLY";
 875         }
 876
 877         if (!scalar @args or scalar @args > 2) {
 878             &help("chnick");
 879             return;
 880         }
 881
 882         if (scalar @args == 1) {        # 1
 883             $user       = &getUser($who);
 884             &DEBUG("nope, not $who.") unless (defined $user);
 885             $user       ||= &getUser($verifyUser);
 886             $chnick     = $args[0];
 887         } else {                        # 2
 888             $user       = &getUser($args[0]);
 889             $chnick     = $args[1];
 890         }
 891
 892         if (!defined $user) {
 893             &pSReply("user $who or $args[0] does not exist.");
 894             return;
 895         }
 896
 897         if ($user =~ /^\Q$chnick\E$/i) {
 898             &pSReply("user == chnick. why should I do that?");
 899             return;
 900         }
 901
 902         if (&getUser($chnick)) {
 903             &pSReply("user $chnick is already used!");
 904             return;
 905         }
 906
 907         if (!&IsFlag("n") and $who !~ /^\Q$verifyUser\E$/i) {
 908             &pSReply("cannto change nick of others.");
 909             return "REPLY" if ($who eq "_default");
 910             return;
 911         }
 912
 913         foreach (keys %{ $users{$user} }) {
 914             $users{$chnick}{$_} = $users{$user}{$_};
 915             delete $users{$user}{$_};
 916         }
 917         undef $users{$user};    # ???
 918
 919         $utime_userfile = time();
 920         $ucount_userfile++;
 921
 922         &pSReply("Changed '$user' to '$chnick' successfully.");
 923
 924         return;
 925     }
 926
 927     if ($message =~ /^([-+])host(\s+(.*))?$/) {
 928         my $cmd         = $1."host";
 929         my(@args)       = split /[\s\t]+/, $3 || '';
 930         my $state       = ($1 eq "+") ? 1 : 0;
 931
 932         if (!scalar @args) {
 933             &help($cmd);
 934             return;
 935         }
 936
 937         if ($who eq "_default") {
 938             &WARN("$who or verifyuser tried to run $cmd.");
 939             return "REPLY";
 940         }
 941
 942         my ($user,$mask);
 943         if ($args[0] =~ /^$mask{nick}$/i) {     # <nick>
 944             return unless (&hasFlag("n"));
 945             $user       = &getUser($args[0]);
 946             $mask       = $args[1];
 947         } else {                                # <mask>
 948             # FIXME: who or verifyUser. (don't remember why)
 949             $user       = &getUser($who);
 950             $mask       = $args[0];
 951         }
 952
 953         if (!defined $user) {
 954             &pSReply("user $user does not exist.");
 955             return;
 956         }
 957
 958         if (!defined $mask) {
 959             &pSReply("Hostmasks for $user: " . join(" ", keys %{$users{$user}{HOSTS}}));
 960             return;
 961         }
 962
 963         if (!&IsFlag("n") and $who !~ /^\Q$verifyUser\E$/i) {
 964             &pSReply("cannto change masks of others.");
 965             return;
 966         }
 967
 968         my $count = scalar keys %{ $users{$user}{HOSTS} };
 969
 970         if ($state) {                           # add.
 971             if ($mask !~ /^$mask{nuh}$/) {
 972                 &pSReply("error: mask ($mask) is not a real hostmask.");
 973                 return;
 974             }
 975
 976             if (exists $users{$user}{HOSTS}{$mask}) {
 977                 &pSReply("mask $mask already exists.");
 978                 return;
 979             }
 980
 981             ### TODO: override support.
 982             $users{$user}{HOSTS}{$mask} = 1;
 983
 984             &pSReply("Added $mask to list of masks.");
 985
 986         } else {                                # delete.
 987
 988             if (!exists $users{$user}{HOSTS}{$mask}) {
 989                 &pSReply("mask $mask does not exist.");
 990                 return;
 991             }
 992
 993             ### TODO: wildcard support. ?
 994             delete $users{$user}{HOSTS}{$mask};
 995
 996             if (scalar keys %{ $users{$user}{HOSTS} } != $count) {
 997                 &pSReply("Removed $mask from list of masks.");
 998             } else {
 999                 &pSReply("error: could not find $mask in list of masks.");
1000                 return;
1001             }
1002         }
1003
1004         $utime_userfile = time();
1005         $ucount_userfile++;
1006
1007         return;
1008     }
1009
1010     if ($message =~ /^([-+])ban(\s+(.*))?$/) {
1011         my $cmd         = $1."ban";
1012         my $flatarg     = $3;
1013         my(@args)       = split /[\s\t]+/, $3 || '';
1014         my $state       = ($1 eq "+") ? 1 : 0;
1015
1016         if (!scalar @args) {
1017             &help($cmd);
1018             return;
1019         }
1020
1021         my($mask,$chan,$time,$reason);
1022
1023         if ($flatarg =~ s/^($mask{nuh})\s*//) {
1024             $mask = $1;
1025         } else {
1026             &DEBUG("arg does not contain nuh mask?");
1027         }
1028
1029         if ($flatarg =~ s/^($mask{chan})\s*//) {
1030             $chan = $1;
1031         } else {
1032             $chan = "*";        # _default instead?
1033         }
1034
1035         if ($state == 0) {              # delete.
1036             my @c = &banDel($mask);
1037
1038             foreach (@c) {
1039                 &unban($mask, $_);
1040             }
1041
1042             if (@c) {
1043                 &pSReply("Removed $mask from chans: @c");
1044             } else {
1045                 &pSReply("$mask was not found in ban list.");
1046             }
1047
1048             return;
1049         }
1050
1051         ###
1052         # add ban.
1053         ###
1054
1055         # time.
1056         if ($flatarg =~ s/^(\d+)\s*//) {
1057             $time = $1;
1058             &DEBUG("time = $time.");
1059             if ($time < 0) {
1060                 &pSReply("error: time cannot be negatime?");
1061                 return;
1062             }
1063         } else {
1064             $time = 0;
1065         }
1066
1067         if ($flatarg =~ s/^(.*)$//) {   # need length?
1068             $reason     = $1;
1069         }
1070
1071         if (!&IsFlag("n") and $who !~ /^\Q$verifyUser\E$/i) {
1072             &pSReply("cannto change masks of others.");
1073             return;
1074         }
1075
1076         if ($mask !~ /^$mask{nuh}$/) {
1077             &pSReply("error: mask ($mask) is not a real hostmask.");
1078             return;
1079         }
1080
1081         if ( &banAdd($mask,$chan,$time,$reason) == 2) {
1082             &pSReply("ban already exists; overwriting.");
1083         }
1084         &pSReply("Added $mask for $chan (time => $time, reason => $reason)");
1085
1086         return;
1087     }
1088
1089     if ($message =~ /^whois(\s+(.*))?$/) {
1090         my $arg = $2;
1091
1092         if (!defined $arg) {
1093             &help("whois");
1094             return;
1095         }
1096
1097         my $user = &getUser($arg);
1098         if (!defined $user) {
1099             &pSReply("whois: user $user does not exist.");
1100             return;
1101         }
1102
1103         ### TODO: better (eggdrop-like) output.
1104         &pSReply("user: $user");
1105         foreach (keys %{ $users{$user} }) {
1106             my $ref = ref $users{$user}{$_};
1107
1108             if ($ref eq "HASH") {
1109                 my $type = $_;
1110                 ### DOES NOT WORK???
1111                 foreach (keys %{ $users{$user}{$type} }) {
1112                     &pSReply("    $type => $_");
1113                 }
1114                 next;
1115             }
1116
1117             &pSReply("    $_ => $users{$user}{$_}");
1118         }
1119         &pSReply("End of USER whois.");
1120
1121         return;
1122     }
1123
1124     if ($message =~ /^bans(\s+(.*))?$/) {
1125         my $arg = $2;
1126
1127         if (defined $arg) {
1128             if ($arg ne "_default" and !&validChan($arg) ) {
1129                 &pSReply("error: chan $chan is invalid.");
1130                 return;
1131             }
1132         }
1133
1134         if (!scalar keys %bans) {
1135             &pSReply("Ban list is empty.");
1136             return;
1137         }
1138
1139         my $c;
1140         &pSReply("     mask: expire, time-added, count, who-by, reason");
1141         foreach $c (keys %bans) {
1142             next unless (!defined $arg or $arg =~ /^\Q$c\E$/i);
1143             &pSReply("  $c:");
1144
1145             foreach (keys %{ $bans{$c} }) {
1146                 my $val = $bans{$c}{$_};
1147
1148                 if (ref $val eq "ARRAY") {
1149                     my @array = @{ $val };
1150                     &pSReply("    $_: @array");
1151                 } else {
1152                     &DEBUG("unknown ban: $val");
1153                 }
1154             }
1155         }
1156         &pSReply("END of bans.");
1157
1158         return;
1159     }
1160
1161     if ($message =~ /^banlist(\s+(.*))?$/) {
1162         my $arg = $2;
1163
1164         if (defined $arg and $arg !~ /^$mask{chan}$/) {
1165             &pSReply("error: chan $chan is invalid.");
1166             return;
1167         }
1168
1169         &DEBUG("bans for global or arg => $arg.");
1170         foreach (keys %bans) {                  #CHANGE!!!
1171             &DEBUG("  $_ => $bans{$_}.");
1172         }
1173
1174         &DEBUG("End of bans.");
1175         &pSReply("END of bans.");
1176
1177         return;
1178     }
1179
1180     if ($message =~ /^save$/) {
1181         return unless (&hasFlag("o"));
1182
1183         &writeUserFile();
1184         &writeChanFile();
1185         &pSReply("saved user and chan files");
1186
1187         return;
1188     }
1189
1190     ### ALIASES.
1191     $message =~ s/^addignore/+ignore/;
1192     $message =~ s/^(del|un)ignore/-ignore/;
1193
1194     # ignore.
1195     if ($message =~ /^(\+|\-)ignore(\s+(.*))?$/i) {
1196         return unless (&hasFlag("o"));
1197         my $state       = ($1 eq "+") ? 1 : 0;
1198         my $str         = $1."ignore";
1199         my $args        = $3;
1200
1201         if (!$args) {
1202             &help($str);
1203             return;
1204         }
1205
1206         my($mask,$chan,$time,$comment);
1207
1208         # mask.
1209         if ($args =~ s/^($mask{nuh})\s*//) {
1210             $mask = $1;
1211         } else {
1212             &ERROR("no NUH mask?");
1213             return;
1214         }
1215
1216         if (!$state) {                  # delignore.
1217             if ( &ignoreDel($mask) ) {
1218                 &pSReply("ok, deleted ignores for $mask.");
1219             } else {
1220                 &pSReply("could not find $mask in ignore list.");
1221             }
1222             return;
1223         }
1224
1225         ###
1226         # addignore.
1227         ###
1228
1229         # chan.
1230         if ($args =~ s/^($mask{chan}|\*)\s*//) {
1231             $chan = $1;
1232         } else {
1233             $chan = "*";
1234         }
1235
1236         # time.
1237         if ($args =~ s/^(\d+)\s*//) {
1238             $time = $1; # time is in minutes
1239         } else {
1240             $time = 0;
1241         }
1242
1243         # time.
1244         if ($args) {
1245             $comment = $args;
1246         } else {
1247             $comment = "added by $who";
1248         }
1249
1250         if ( &ignoreAdd($mask, $chan, $time, $comment) > 1) {
1251             &pSReply("FIXME: $mask already in ignore list; written over anyway.");
1252         } else {
1253             &pSReply("added $mask to ignore list.");
1254         }
1255
1256         return;
1257     }
1258
1259     if ($message =~ /^ignore(\s+(.*))?$/) {
1260         my $arg = $2;
1261
1262         if (defined $arg) {
1263             if ($arg !~ /^$mask{chan}$/) {
1264                 &pSReply("error: chan $chan is invalid.");
1265                 return;
1266             }
1267
1268             if (!&validChan($arg)) {
1269                 &pSReply("error: chan $arg is invalid.");
1270                 return;
1271             }
1272
1273             &pSReply("Showing bans for $arg only.");
1274         }
1275
1276         if (!scalar keys %ignore) {
1277             &pSReply("Ignore list is empty.");
1278             return;
1279         }
1280
1281         ### TODO: proper (eggdrop-like) formatting.
1282         my $c;
1283         &pSReply("    mask: expire, time-added, who, comment");
1284         foreach $c (keys %ignore) {
1285             next unless (!defined $arg or $arg =~ /^\Q$c\E$/i);
1286             &pSReply("  $c:");
1287
1288             foreach (keys %{ $ignore{$c} }) {
1289                 my $ref = ref $ignore{$c}{$_};
1290                 if ($ref eq "ARRAY") {
1291                     my @array = @{ $ignore{$c}{$_} };
1292                     &pSReply("      $_: @array");
1293                 } else {
1294                     &DEBUG("unknown ignore line?");
1295                 }
1296             }
1297         }
1298         &pSReply("END of ignore.");
1299
1300         return;
1301     }
1302
1303     # adduser/deluser.
1304     if ($message =~ /^(\+|\-|add|del)user(\s+(.*))?$/i) {
1305         my $str         = $1;
1306         my $strstr      = $1."user";
1307         my @args        = split /\s+/, $3 || '';
1308         my $args        = $3;
1309         my $state       = ($str =~ /^(\+|add)$/) ? 1 : 0;
1310
1311         if (!scalar @args) {
1312             &help($strstr);
1313             return;
1314         }
1315
1316         if ($str eq "+") {
1317             if (scalar @args != 2) {
1318                 &pSReply("+user requires hostmask argument.");
1319                 return;
1320             }
1321         } elsif (scalar @args != 1) {
1322             &pSReply("too many arguments.");
1323             return;
1324         }
1325
1326         if ($state) {
1327             # adduser.
1328             if (scalar @args == 1) {
1329                 $args[1]        = &getHostMask($args[0]);
1330                 &pSReply("Attemping to guess $args[0]'s hostmask...");
1331
1332                 # crude hack... crappy Net::IRC
1333                 $conn->schedule(5, sub {
1334                     # hopefully this is right.
1335                     my $nick = (keys %{ $cache{nuhInfo} })[0];
1336                     if (!defined $nick) {
1337                         &pSReply("couldn't get nuhinfo... adding user without a hostmask.");
1338                         &userAdd($nick);
1339                         return;
1340                     }
1341                     my $mask = &makeHostMask( $cache{nuhInfo}{$nick}{NUH} );
1342
1343                     if ( &userAdd($nick, $mask) ) {
1344                         # success.
1345                         &pSReply("Added $nick with flags $users{$nick}{FLAGS}");
1346                         my @hosts = keys %{ $users{$nick}{HOSTS} };
1347                         &pSReply("hosts: @hosts");
1348                     }
1349                 });
1350                 return;
1351             }
1352
1353             &DEBUG("args => @args");
1354             if ( &userAdd(@args) ) {    # success.
1355                 &pSReply("Added $args[0] with flags $users{$args[0]}{FLAGS}");
1356                 my @hosts = keys %{ $users{$args[0]}{HOSTS} };
1357                 &pSReply("hosts: @hosts");
1358
1359             } else {                    # failure.
1360                 &pSReply("User $args[0] already exists");
1361             }
1362
1363         } else {                        # deluser.
1364
1365             if ( &userDel($args[0]) ) { # success.
1366                 &pSReply("Deleted $args[0] successfully.");
1367
1368             } else {                    # failure.
1369                 &pSReply("User $args[0] does not exist.");
1370             }
1371
1372         }
1373         return;
1374     }
1375
1376     if ($message =~ /^sched$/) {
1377         my @list;
1378         my @run;
1379
1380         my %time;
1381         foreach (keys %sched) {
1382             next unless (exists $sched{$_}{TIME});
1383             $time{ $sched{$_}{TIME}-time() }{$_} = 1;
1384             push(@list,$_);
1385
1386             next unless (exists $sched{$_}{RUNNING});
1387             push(@run,$_);
1388         }
1389
1390         my @time;
1391         foreach (sort { $a <=> $b } keys %time) {
1392             my $str = join(", ", sort keys %{ $time{$_} });
1393             &DEBUG("time => $_, str => $str");
1394             push(@time, "$str (".&Time2String($_).")");
1395         }
1396
1397         &pSReply( &formListReply(0, "Schedulers: ", @time ) );
1398         &pSReply( &formListReply(0, "Scheds to run: ", sort @list ) );
1399         &pSReply( &formListReply(0, "Scheds running(should not happen?) ", sort @run ) );
1400
1401         return;
1402     }
1403
1404     # quite a cool hack: reply in DCC CHAT.
1405     $msgType = "chat" if (exists $dcc{'CHAT'}{$who});
1406
1407     my $done = 0;
1408     $done++ if &parseCmdHook("main", $message);
1409     $done++ if &parseCmdHook("extra", $message);
1410     $done++ unless (&Modules());
1411
1412     if ($done) {
1413         &DEBUG("running non DCC CHAT command inside DCC CHAT!");
1414         return;
1415     }
1416
1417     return "REPLY";
1418 }
1419
1420 1;