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