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         &status("userDCC: quit called. FIXME");
  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("symdump"));
 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         &DEBUG("chan => '$1', msg => '$msg'.");
 340
 341         if (&validChan($chan)) {
 342             &msg($chan, $2);
 343         } else {
 344             &msg($who,"i'm not on \002$1\002, sorry.");
 345         }
 346         return;
 347     }
 348
 349     # die.
 350     if ($message =~ /^die$/) {
 351         return unless (&hasFlag("n"));
 352
 353         &doExit();
 354
 355         &status("Dying by $who\'s request");
 356         exit 0;
 357     }
 358
 359     # global factoid substitution.
 360     if ($message =~ m|^s([/,#])(.+?)\1(.*?)\1;?\s*$|) {
 361         my ($delim,$op,$np) = ($1, $2, $3);
 362         return unless (&hasFlag("n"));
 363         ### TODO: support flags to do full-on global.
 364
 365         # incorrect format.
 366         if ($np =~ /$delim/) {
 367             &performReply("looks like you used the delimiter too many times. You may want to use a different delimiter, like ':' or '#'.");
 368             return;
 369         }
 370
 371         ### TODO: fix up $op to support mysql/sqlite/pgsql
 372         ### TODO: => add db/sql specific function to fix this.
 373         my @list = &searchTable("factoids", "factoid_key",
 374                         "factoid_value", $op);
 375
 376         if (!scalar @list) {
 377             &performReply("Expression didn't match anything.");
 378             return;
 379         }
 380
 381         if (scalar @list > 100) {
 382             &performReply("regex found more than 100 matches... not doing.");
 383             return;
 384         }
 385
 386         &status("gsubst: going to alter ".scalar(@list)." factoids.");
 387         &performReply("going to alter ".scalar(@list)." factoids.");
 388
 389         my $error = 0;
 390         foreach (@list) {
 391             my $faqtoid = $_;
 392
 393             next if (&IsLocked($faqtoid) == 1);
 394             my $result = &getFactoid($faqtoid);
 395             my $was = $result;
 396             &DEBUG("was($faqtoid) => '$was'.");
 397
 398             # global global
 399             # we could support global local (once off).
 400             if ($result =~ s/\Q$op/$np/gi) {
 401                 if (length $result > $param{'maxDataSize'}) {
 402                     &performReply("that's too long (or was long)");
 403                     return;
 404                 }
 405                 &setFactInfo($faqtoid, "factoid_value", $result);
 406                 &status("update: '$faqtoid' =is=> '$result'; was '$was'");
 407             } else {
 408                 &WARN("subst: that's weird... thought we found the string ($op) in '$faqtoid'.");
 409                 $error++;
 410             }
 411         }
 412
 413         if ($error) {
 414             &ERROR("Some warnings/errors?");
 415         }
 416
 417         &performReply("Ok... did s/$op/$np/ for ".
 418                                 (scalar(@list) - $error)." factoids");
 419
 420         return;
 421     }
 422
 423     # jump.
 424     if ($message =~ /^jump(\s+(\S+))?$/i) {
 425         return unless (&hasFlag("n"));
 426
 427         if ($2 eq "") {
 428             &help("jump");
 429             return;
 430         }
 431
 432         my ($server,$port);
 433         if ($2 =~ /^(\S+)(:(\d+))?$/) {
 434             $server = $1;
 435             $port   = $3 || 6667;
 436         } else {
 437             &msg($who,"invalid format.");
 438             return;
 439         }
 440
 441         &status("jumping servers... $server...");
 442         $conn->quit("jumping to $server");
 443
 444         if (&irc($server,$port) == 0) {
 445             &ircloop();
 446         }
 447     }
 448
 449     # reload.
 450     if ($message =~ /^reload$/i) {
 451         return unless (&hasFlag("n"));
 452
 453         &status("USER reload $who");
 454         &pSReply("reloading...");
 455         &reloadAllModules();
 456         &pSReply("reloaded.");
 457
 458         return;
 459     }
 460
 461     # reset.
 462     if ($message =~ /^reset$/i) {
 463         return unless (&hasFlag("n"));
 464
 465         &msg($who,"resetting...");
 466         my @done;
 467         foreach ( keys %channels, keys %chanconf ) {
 468             my $c = $_;
 469             next if (grep /^\Q$c\E$/i, @done);
 470
 471             &part($_);
 472
 473             push(@done, $_);
 474             sleep 1;
 475         }
 476         &DEBUG("before clearircvars");
 477         &clearIRCVars();
 478         &DEBUG("before joinnextchan");
 479         &joinNextChan();
 480         &DEBUG("after joinnextchan");
 481
 482         &status("USER reset $who");
 483         &msg($who,"resetted");
 484
 485         return;
 486     }
 487
 488     # rehash.
 489     if ($message =~ /^rehash$/) {
 490         return unless (&hasFlag("n"));
 491
 492         &msg($who,"rehashing...");
 493         &restart("REHASH");
 494         &status("USER rehash $who");
 495         &msg($who,"rehashed");
 496
 497         return;
 498     }
 499
 500     #####
 501     ##### USER//CHAN SPECIFIC CONFIGURATION COMMANDS
 502     #####
 503
 504     if ($message =~ /^chaninfo(\s+(.*))?$/) {
 505         my @args = split /[\s\t]+/, $2; # hrm.
 506
 507         if (scalar @args != 1) {
 508             &help("chaninfo");
 509             return;
 510         }
 511
 512         if (!exists $chanconf{$args[0]}) {
 513             &pSReply("no such channel $args[0]");
 514             return;
 515         }
 516
 517         &pSReply("showing channel conf.");
 518         foreach (sort keys %{ $chanconf{$args[0]} }) {
 519             &pSReply("$chan: $_ => $chanconf{$args[0]}{$_}");
 520         }
 521         &pSReply("End of chaninfo.");
 522
 523         return;
 524     }
 525
 526     # +chan.
 527     if ($message =~ /^(chanset|\+chan)(\s+(.*?))?$/) {
 528         my $cmd         = $1;
 529         my $args        = $3;
 530         my $no_chan     = 0;
 531
 532         if (!defined $args) {
 533             &help($cmd);
 534             return;
 535         }
 536
 537         my @chans;
 538         while ($args =~ s/^($mask{chan})\s*//) {
 539             push(@chans, $1);
 540         }
 541
 542         if (!scalar @chans) {
 543             push(@chans, "_default");
 544             $no_chan    = 1;
 545         }
 546
 547         my($what,$val) = split /[\s\t]+/, $args, 2;
 548
 549         ### TODO: "cannot set values without +m".
 550         return unless (&hasFlag("n"));
 551
 552         # READ ONLY.
 553         if (defined $what and $what !~ /^[-+]/ and !defined $val and $no_chan) {
 554             &pSReply("Showing $what values on all channels...");
 555
 556             my %vals;
 557             foreach (keys %chanconf) {
 558                 my $val = $chanconf{$_}{$what} || "NOT-SET";
 559                 $vals{$val}{$_} = 1;
 560             }
 561
 562             foreach (keys %vals) {
 563                 &pSReply("  $what = $_: ".join(' ', keys %{ $vals{$_} } ) );
 564             }
 565
 566             &pSReply("End of list.");
 567
 568             return;
 569         }
 570
 571         ### TODO: move to UserDCC again.
 572         if ($cmd eq "chanset" and !defined $what) {
 573             &DEBUG("showing channel conf.");
 574
 575             foreach $chan ($chan, "_default") {
 576                 &pSReply("chan: $chan");
 577                 ### TODO: merge 2 or 3 per line.
 578                 my @items;
 579                 my $str = "";
 580                 foreach (sort keys %{ $chanconf{$chan} }) {
 581                     my $newstr = join(', ', @items);
 582                     if (length $newstr > 63) {
 583                         &pSReply(" $str");
 584                         @items = ();
 585                     }
 586                     $str = $newstr;
 587                     push(@items, "$_ => $chanconf{$chan}{$_}");
 588                 }
 589                 &pSReply(" $str") if (@items);
 590             }
 591             return;
 592         }
 593
 594         $cache{confvars}{$what} = $val;
 595         &rehashConfVars();
 596
 597         foreach (@chans) {
 598             &chanSet($cmd, $_, $what, $val);
 599         }
 600
 601         return;
 602     }
 603
 604     if ($message =~ /^(chanunset|\-chan)(\s+(.*))?$/) {
 605         return unless (&hasFlag("n"));
 606         my $args        = $3;
 607         my $no_chan     = 0;
 608
 609         if (!defined $args) {
 610             &help("chanunset");
 611             return;
 612         }
 613
 614         my ($chan);
 615         my $delete      = 0;
 616         if ($args =~ s/^(\-)?($mask{chan})\s*//) {
 617             $chan       = $2;
 618             $delete     = ($1) ? 1 : 0;
 619             &DEBUG("chan => $chan.");
 620         } else {
 621             &VERB("no chan arg; setting to default.",2);
 622             $chan       = "_default";
 623             $no_chan    = 1;
 624         }
 625
 626         if (!exists $chanconf{$chan}) {
 627             &pSReply("no such channel $chan");
 628             return;
 629         }
 630
 631         if ($args ne "") {
 632
 633             if (!&getChanConf($args,$chan)) {
 634                 &pSReply("$args does not exist for $chan");
 635                 return;
 636             }
 637
 638             my @chans = &ChanConfList($args);
 639             &DEBUG("scalar chans => ".scalar(@chans) );
 640             if (scalar @chans == 1 and $chans[0] eq "_default" and !$no_chan) {
 641                 &psReply("ok, $args was set only for _default; unsetting for _defaul but setting for other chans.");
 642
 643                 my $val = $chanconf{$_}{_default};
 644                 foreach (keys %chanconf) {
 645                     $chanconf{$_}{$args} = $val;
 646                 }
 647                 delete $chanconf{_default}{$args};
 648                 $cache{confvars}{$args} = 0;
 649                 &rehashConfVars();
 650
 651                 return;
 652             }
 653
 654             if ($no_chan and !exists($chanconf{_default}{$args})) {
 655                 &pSReply("ok, $args for _default does not exist, removing from all chans.");
 656
 657                 foreach (keys %chanconf) {
 658                     next unless (exists $chanconf{$_}{$args});
 659                     &DEBUG("delete chanconf{$_}{$args};");
 660                     delete $chanconf{$_}{$args};
 661                 }
 662                 $cache{confvars}{$args} = 0;
 663                 &rehashConfVars();
 664
 665                 return;
 666             }
 667
 668             &pSReply("Unsetting channel ($chan) option $args. (was $chanconf{$chan}{$args})");
 669             delete $chanconf{$chan}{$args};
 670
 671             return;
 672         }
 673
 674         if ($delete) {
 675             &pSReply("Deleting channel $chan for sure!");
 676             $utime_chanfile = time();
 677             $ucount_chanfile++;
 678
 679             &part($chan);
 680             &pSReply("Leaving $chan...");
 681
 682             delete $chanconf{$chan};
 683         } else {
 684             &pSReply("Prefix channel with '-' to delete for sure.");
 685         }
 686
 687         return;
 688     }
 689
 690     if ($message =~ /^newpass(\s+(.*))?$/) {
 691         my(@args) = split /[\s\t]+/, $2 || '';
 692
 693         if (scalar @args != 1) {
 694             &help("newpass");
 695             return;
 696         }
 697
 698         my $u           = &getUser($who);
 699         my $crypt       = &mkcrypt($args[0]);
 700
 701         &pSReply("Set your passwd to '$crypt'");
 702         $users{$u}{PASS} = $crypt;
 703
 704         $utime_userfile = time();
 705         $ucount_userfile++;
 706
 707         return;
 708     }
 709
 710     if ($message =~ /^chpass(\s+(.*))?$/) {
 711         my(@args) = split /[\s\t]+/, $2 || '';
 712
 713         if (!scalar @args) {
 714             &help("chpass");
 715             return;
 716         }
 717
 718         if (!&IsUser($args[0])) {
 719             &pSReply("user $args[0] is not valid.");
 720             return;
 721         }
 722
 723         my $u = &getUser($args[0]);
 724         if (!defined $u) {
 725             &pSReply("Internal error, u = NULL.");
 726             return;
 727         }
 728
 729         if (scalar @args == 1) {        # del pass.
 730             if (!&IsFlag("n") and $who !~ /^\Q$verifyUser\E$/i) {
 731                 &pSReply("cannot remove passwd of others.");
 732                 return;
 733             }
 734
 735             if (!exists $users{$u}{PASS}) {
 736                 &pSReply("$u does not have pass set anyway.");
 737                 return;
 738             }
 739
 740             &pSReply("Deleted pass from $u.");
 741
 742             $utime_userfile = time();
 743             $ucount_userfile++;
 744
 745             delete $users{$u}{PASS};
 746
 747             return;
 748         }
 749
 750         my $crypt       = &mkcrypt($args[1]);
 751         &pSReply("Set $u's passwd to '$crypt'");
 752         $users{$u}{PASS} = $crypt;
 753
 754         $utime_userfile = time();
 755         $ucount_userfile++;
 756
 757         return;
 758     }
 759
 760     if ($message =~ /^chattr(\s+(.*))?$/) {
 761         my(@args) = split /[\s\t]+/, $2 || '';
 762
 763         if (!scalar @args) {
 764             &help("chattr");
 765             return;
 766         }
 767
 768         my $chflag;
 769         my $user;
 770         if ($args[0] =~ /^$mask{nick}$/i) {     # <nick>
 771             $user       = &getUser($args[0]);
 772             $chflag     = $args[1];
 773         } else {                                # <flags>
 774             $user       = &getUser($who);
 775             &DEBUG("user $who... nope.") unless (defined $user);
 776             $user       = &getUser($verifyUser);
 777             $chflag     = $args[0];
 778         }
 779
 780         if (!defined $user) {
 781             &pSReply("user does not exist.");
 782             return;
 783         }
 784
 785         my $flags = $users{$user}{FLAGS};
 786         if (!defined $chflag) {
 787             &pSReply("Flags for $user: $flags");
 788             return;
 789         }
 790
 791         &DEBUG("who => $who");
 792         &DEBUG("verifyUser => $verifyUser");
 793         if (!&IsFlag("n") and $who !~ /^\Q$verifyUser\E$/i) {
 794             &pSReply("cannto change attributes of others.");
 795             return "REPLY";
 796         }
 797
 798         my $state;
 799         my $change      = 0;
 800         foreach (split //, $chflag) {
 801             if ($_ eq "+") { $state = 1; next; }
 802             if ($_ eq "-") { $state = 0; next; }
 803
 804             if (!defined $state) {
 805                 &pSReply("no initial + or - was found in attr.");
 806                 return;
 807             }
 808
 809             if ($state) {
 810                 next if ($flags =~ /\Q$_\E/);
 811                 $flags .= $_;
 812             } else {
 813                 if (&IsParam("owner")
 814                         and $param{owner} =~ /^\Q$user\E$/i
 815                         and $flags =~ /[nmo]/
 816                 ) {
 817                     &pSReply("not removing flag $_ for $user.");
 818                     next;
 819                 }
 820                 next unless ($flags =~ s/\Q$_\E//);
 821             }
 822
 823             $change++;
 824         }
 825
 826         if ($change) {
 827             $utime_userfile = time();
 828             $ucount_userfile++;
 829             &pSReply("Current flags: $flags");
 830             $users{$user}{FLAGS} = $flags;
 831         } else {
 832             &pSReply("No flags changed: $flags");
 833         }
 834
 835         return;
 836     }
 837
 838     if ($message =~ /^chnick(\s+(.*))?$/) {
 839         my(@args) = split /[\s\t]+/, $2 || '';
 840
 841         if ($who eq "_default") {
 842             &WARN("$who or verifyuser tried to run chnick.");
 843             return "REPLY";
 844         }
 845
 846         if (!scalar @args or scalar @args > 2) {
 847             &help("chnick");
 848             return;
 849         }
 850
 851         if (scalar @args == 1) {        # 1
 852             $user       = &getUser($who);
 853             &DEBUG("nope, not $who.") unless (defined $user);
 854             $user       ||= &getUser($verifyUser);
 855             $chnick     = $args[0];
 856         } else {                        # 2
 857             $user       = &getUser($args[0]);
 858             $chnick     = $args[1];
 859         }
 860
 861         if (!defined $user) {
 862             &pSReply("user $who or $args[0] does not exist.");
 863             return;
 864         }
 865
 866         if ($user =~ /^\Q$chnick\E$/i) {
 867             &pSReply("user == chnick. why should I do that?");
 868             return;
 869         }
 870
 871         if (&getUser($chnick)) {
 872             &pSReply("user $chnick is already used!");
 873             return;
 874         }
 875
 876         if (!&IsFlag("n") and $who !~ /^\Q$verifyUser\E$/i) {
 877             &pSReply("cannto change nick of others.");
 878             return "REPLY" if ($who eq "_default");
 879             return;
 880         }
 881
 882         foreach (keys %{ $users{$user} }) {
 883             $users{$chnick}{$_} = $users{$user}{$_};
 884             delete $users{$user}{$_};
 885         }
 886         undef $users{$user};    # ???
 887
 888         $utime_userfile = time();
 889         $ucount_userfile++;
 890
 891         &pSReply("Changed '$user' to '$chnick' successfully.");
 892
 893         return;
 894     }
 895
 896     if ($message =~ /^([-+])host(\s+(.*))?$/) {
 897         my $cmd         = $1."host";
 898         my(@args)       = split /[\s\t]+/, $3 || '';
 899         my $state       = ($1 eq "+") ? 1 : 0;
 900
 901         if (!scalar @args) {
 902             &help($cmd);
 903             return;
 904         }
 905
 906         if ($who eq "_default") {
 907             &WARN("$who or verifyuser tried to run $cmd.");
 908             return "REPLY";
 909         }
 910
 911         my ($user,$mask);
 912         if ($args[0] =~ /^$mask{nick}$/i) {     # <nick>
 913             return unless (&hasFlag("n"));
 914             $user       = &getUser($args[0]);
 915             $mask       = $args[1];
 916         } else {                                # <mask>
 917             # who or verifyUser. FIXME (don't remember why)
 918             $user       = &getUser($who);
 919             $mask       = $args[0];
 920         }
 921
 922         if (!defined $user) {
 923             &pSReply("user $user does not exist.");
 924             return;
 925         }
 926
 927         if (!defined $mask) {
 928             ### FIXME.
 929             &pSReply("Hostmasks for $user: $users{$user}{HOSTS}");
 930
 931             return;
 932         }
 933
 934         if (!&IsFlag("n") and $who !~ /^\Q$verifyUser\E$/i) {
 935             &pSReply("cannto change masks of others.");
 936             return;
 937         }
 938
 939         if ($mask !~ /^$mask{nuh}$/) {
 940             &pSReply("error: mask ($mask) is not a real hostmask.");
 941             return;
 942         }
 943
 944         my $count = scalar keys %{ $users{$user}{HOSTS} };
 945
 946         if ($state) {                           # add.
 947             if (exists $users{$user}{HOSTS}{$mask}) {
 948                 &pSReply("mask $mask already exists.");
 949                 return;
 950             }
 951
 952             ### TODO: override support.
 953             $users{$user}{HOSTS}{$mask} = 1;
 954
 955             &pSReply("Added $mask to list of masks.");
 956
 957         } else {                                # delete.
 958
 959             if (!exists $users{$user}{HOSTS}{$mask}) {
 960                 &pSReply("mask $mask does not exist.");
 961                 return;
 962             }
 963
 964             ### TODO: wildcard support. ?
 965             delete $users{$user}{HOSTS}{$mask};
 966
 967             if (scalar keys %{ $users{$user}{HOSTS} } != $count) {
 968                 &pSReply("Removed $mask from list of masks.");
 969             } else {
 970                 &pSReply("error: could not find $mask in list of masks.");
 971                 return;
 972             }
 973         }
 974
 975         $utime_userfile = time();
 976         $ucount_userfile++;
 977
 978         return;
 979     }
 980
 981     if ($message =~ /^([-+])ban(\s+(.*))?$/) {
 982         my $cmd         = $1."ban";
 983         my $flatarg     = $3;
 984         my(@args)       = split /[\s\t]+/, $3 || '';
 985         my $state       = ($1 eq "+") ? 1 : 0;
 986
 987         if (!scalar @args) {
 988             &help($cmd);
 989             return;
 990         }
 991
 992         my($mask,$chan,$time,$reason);
 993
 994         if ($flatarg =~ s/^($mask{nuh})\s*//) {
 995             $mask = $1;
 996         } else {
 997             &DEBUG("arg does not contain nuh mask?");
 998         }
 999
1000         if ($flatarg =~ s/^($mask{chan})\s*//) {
1001             $chan = $1;
1002         } else {
1003             $chan = "*";        # _default instead?
1004         }
1005
1006         if ($state == 0) {              # delete.
1007             my @c = &banDel($mask);
1008
1009             foreach (@c) {
1010                 &unban($mask, $_);
1011             }
1012
1013             if (@c) {
1014                 &pSReply("Removed $mask from chans: @c");
1015             } else {
1016                 &pSReply("$mask was not found in ban list.");
1017             }
1018
1019             return;
1020         }
1021
1022         ###
1023         # add ban.
1024         ###
1025
1026         # time.
1027         if ($flatarg =~ s/^(\d+)\s*//) {
1028             $time = $1;
1029             &DEBUG("time = $time.");
1030             if ($time < 0) {
1031                 &pSReply("error: time cannot be negatime?");
1032                 return;
1033             }
1034         } else {
1035             $time = 0;
1036         }
1037
1038         if ($flatarg =~ s/^(.*)$//) {   # need length?
1039             $reason     = $1;
1040         }
1041
1042         if (!&IsFlag("n") and $who !~ /^\Q$verifyUser\E$/i) {
1043             &pSReply("cannto change masks of others.");
1044             return;
1045         }
1046
1047         if ($mask !~ /^$mask{nuh}$/) {
1048             &pSReply("error: mask ($mask) is not a real hostmask.");
1049             return;
1050         }
1051
1052         if ( &banAdd($mask,$chan,$time,$reason) == 2) {
1053             &pSReply("ban already exists; overwriting.");
1054         }
1055         &pSReply("Added $mask for $chan (time => $time, reason => $reason)");
1056
1057         return;
1058     }
1059
1060     if ($message =~ /^whois(\s+(.*))?$/) {
1061         my $arg = $2;
1062
1063         if (!defined $arg) {
1064             &help("whois");
1065             return;
1066         }
1067
1068         my $user = &getUser($arg);
1069         if (!defined $user) {
1070             &pSReply("whois: user $user does not exist.");
1071             return;
1072         }
1073
1074         ### TODO: better (eggdrop-like) output.
1075         &pSReply("user: $user");
1076         foreach (keys %{ $users{$user} }) {
1077             my $ref = ref $users{$user}{$_};
1078
1079             if ($ref eq "HASH") {
1080                 my $type = $_;
1081                 ### DOES NOT WORK???
1082                 foreach (keys %{ $users{$user}{$type} }) {
1083                     &pSReply("    $type => $_");
1084                 }
1085                 next;
1086             }
1087
1088             &pSReply("    $_ => $users{$user}{$_}");
1089         }
1090         &pSReply("End of USER whois.");
1091
1092         return;
1093     }
1094
1095     if ($message =~ /^bans(\s+(.*))?$/) {
1096         my $arg = $2;
1097
1098         if (defined $arg) {
1099             if ($arg ne "_default" and !&validChan($arg) ) {
1100                 &pSReply("error: chan $chan is invalid.");
1101                 return;
1102             }
1103         }
1104
1105         if (!scalar keys %bans) {
1106             &pSReply("Ban list is empty.");
1107             return;
1108         }
1109
1110         my $c;
1111         &pSReply("     mask: expire, time-added, count, who-by, reason");
1112         foreach $c (keys %bans) {
1113             next unless (!defined $arg or $arg =~ /^\Q$c\E$/i);
1114             &pSReply("  $c:");
1115
1116             foreach (keys %{ $bans{$c} }) {
1117                 my $val = $bans{$c}{$_};
1118
1119                 if (ref $val eq "ARRAY") {
1120                     my @array = @{ $val };
1121                     &pSReply("    $_: @array");
1122                 } else {
1123                     &DEBUG("unknown ban: $val");
1124                 }
1125             }
1126         }
1127         &pSReply("END of bans.");
1128
1129         return;
1130     }
1131
1132     if ($message =~ /^banlist(\s+(.*))?$/) {
1133         my $arg = $2;
1134
1135         if (defined $arg and $arg !~ /^$mask{chan}$/) {
1136             &pSReply("error: chan $chan is invalid.");
1137             return;
1138         }
1139
1140         &DEBUG("bans for global or arg => $arg.");
1141         foreach (keys %bans) {                  #CHANGE!!!
1142             &DEBUG("  $_ => $bans{$_}.");
1143         }
1144
1145         &DEBUG("End of bans.");
1146         &pSReply("END of bans.");
1147
1148         return;
1149     }
1150
1151     if ($message =~ /^save$/) {
1152         return unless (&hasFlag("o"));
1153
1154         &writeUserFile();
1155         &writeChanFile();
1156
1157         return;
1158     }
1159
1160     ### ALIASES.
1161     $message =~ s/^addignore/+ignore/;
1162     $message =~ s/^(del|un)ignore/-ignore/;
1163
1164     # ignore.
1165     if ($message =~ /^(\+|\-)ignore(\s+(.*))?$/i) {
1166         return unless (&hasFlag("o"));
1167         my $state       = ($1 eq "+") ? 1 : 0;
1168         my $str         = $1."ignore";
1169         my $args        = $3;
1170
1171         if (!$args) {
1172             &help($str);
1173             return;
1174         }
1175
1176         my($mask,$chan,$time,$comment);
1177
1178         # mask.
1179         if ($args =~ s/^($mask{nuh})\s*//) {
1180             $mask = $1;
1181         } else {
1182             &ERROR("no NUH mask?");
1183             return;
1184         }
1185
1186         if (!$state) {                  # delignore.
1187             if ( &ignoreDel($mask) ) {
1188                 &pSReply("ok, deleted X ignores.");
1189             } else {
1190                 &pSReply("could not find $mask in ignore list.");
1191             }
1192             return;
1193         }
1194
1195         ###
1196         # addignore.
1197         ###
1198
1199         # chan.
1200         if ($args =~ s/^($mask{chan}|\*)\s*//) {
1201             $chan = $1;
1202         } else {
1203             $chan = "*";
1204         }
1205
1206         # time.
1207         if ($args =~ s/^(\d+)\s*//) {
1208             $time = $1*60;      # ??
1209         } else {
1210             $time = 0;
1211         }
1212
1213         # time.
1214         if ($args) {
1215             $comment = $args;
1216         } else {
1217             $comment = "added by $who";
1218         }
1219
1220         if ( &ignoreAdd($mask, $chan, $time, $comment) > 1) {
1221             &pSReply("warn: $mask already in ignore list; written over anyway. FIXME");
1222         } else {
1223             &pSReply("added $mask to ignore list.");
1224         }
1225
1226         return;
1227     }
1228
1229     if ($message =~ /^ignore(\s+(.*))?$/) {
1230         my $arg = $2;
1231
1232         if (defined $arg) {
1233             if ($arg !~ /^$mask{chan}$/) {
1234                 &pSReply("error: chan $chan is invalid.");
1235                 return;
1236             }
1237
1238             if (!&validChan($arg)) {
1239                 &pSReply("error: chan $arg is invalid.");
1240                 return;
1241             }
1242
1243             &pSReply("Showing bans for $arg only.");
1244         }
1245
1246         if (!scalar keys %ignore) {
1247             &pSReply("Ignore list is empty.");
1248             return;
1249         }
1250
1251         ### TODO: proper (eggdrop-like) formatting.
1252         my $c;
1253         &pSReply("    mask: expire, time-added, who, comment");
1254         foreach $c (keys %ignore) {
1255             next unless (!defined $arg or $arg =~ /^\Q$c\E$/i);
1256             &pSReply("  $c:");
1257
1258             foreach (keys %{ $ignore{$c} }) {
1259                 my $ref = ref $ignore{$c}{$_};
1260                 if ($ref eq "ARRAY") {
1261                     my @array = @{ $ignore{$c}{$_} };
1262                     &pSReply("      $_: @array");
1263                 } else {
1264                     &DEBUG("unknown ignore line?");
1265                 }
1266             }
1267         }
1268         &pSReply("END of ignore.");
1269
1270         return;
1271     }
1272
1273     # adduser/deluser.
1274     if ($message =~ /^(\+|\-|add|del)user(\s+(.*))?$/i) {
1275         my $str         = $1;
1276         my $strstr      = $1."user";
1277         my @args        = split /\s+/, $3 || '';
1278         my $args        = $3;
1279         my $state       = ($str =~ /^(\+|add)$/) ? 1 : 0;
1280
1281         if (!scalar @args) {
1282             &help($strstr);
1283             return;
1284         }
1285
1286         if ($str eq "+") {
1287             if (scalar @args != 2) {
1288                 &pSReply(".+host requires hostmask argument.");
1289                 return;
1290             }
1291         } elsif (scalar @args != 1) {
1292             &pSReply("too many arguments.");
1293             return;
1294         }
1295
1296         if ($state) {                   # adduser.
1297             if (scalar @args == 1) {
1298                 $args[1]        = &getHostMask($args[0]);
1299                 &pSReply("Attemping to guess $args[0]'s hostmask...");
1300
1301                 # crude hack... crappy Net::IRC
1302                 $conn->schedule(5, sub {
1303         # hopefully this is right.
1304         my $nick = (keys %{ $cache{nuhInfo} })[0];
1305         if (!defined $nick) {
1306             &pSReply("couldn't get nuhinfo... adding user without a hostmask.");
1307             &userAdd($nick);
1308             return;
1309         }
1310
1311         my $mask = &makeHostMask( $cache{nuhInfo}{$nick}{NUH} );
1312
1313         if ( &userAdd($nick, $mask) ) { # success.
1314                 &pSReply("Added $nick with flags $users{$nick}{FLAGS}");
1315                 my @hosts = keys %{ $users{$nick}{HOSTS} };
1316                 &pSReply("hosts: @hosts");
1317         }
1318 });
1319                 return;
1320             }
1321
1322             &DEBUG("args => @args");
1323             if ( &userAdd(@args) ) {    # success.
1324                 &pSReply("Added $args[0] with flags $users{$args[0]}{FLAGS}");
1325                 my @hosts = keys %{ $users{$args[0]}{HOSTS} };
1326                 &pSReply("hosts: @hosts");
1327
1328             } else {                    # failure.
1329                 &pSReply("User $args[0] already exists");
1330             }
1331
1332         } else {                        # deluser.
1333
1334             if ( &userDel($args[0]) ) { # success.
1335                 &pSReply("Deleted $args[0] successfully.");
1336
1337             } else {                    # failure.
1338                 &pSReply("User $args[0] does not exist.");
1339             }
1340
1341         }
1342         return;
1343     }
1344
1345     if ($message =~ /^sched$/) {
1346         my @list;
1347         my @run;
1348
1349         my %time;
1350         foreach (keys %sched) {
1351             next unless (exists $sched{$_}{TIME});
1352             $time{ $sched{$_}{TIME}-time() }{$_} = 1;
1353             push(@list,$_);
1354
1355             next unless (exists $sched{$_}{RUNNING});
1356             push(@run,$_);
1357         }
1358
1359         my @time;
1360         foreach (sort { $a <=> $b } keys %time) {
1361             my $str = join(", ", sort keys %{ $time{$_} });
1362             &DEBUG("time => $_, str => $str");
1363             push(@time, "$str (".&Time2String($_).")");
1364         }
1365
1366         &pSReply( &formListReply(0, "Schedulers: ", @time ) );
1367         &pSReply( &formListReply(0, "Scheds to run: ", sort @list ) );
1368         &pSReply( &formListReply(0, "Scheds running(should not happen?) ", sort @run ) );
1369
1370         return;
1371     }
1372
1373     # quite a cool hack: reply in DCC CHAT.
1374     $msgType = "chat" if (exists $dcc{'CHAT'}{$who});
1375
1376     my $done = 0;
1377     $done++ if &parseCmdHook("main", $message);
1378     $done++ if &parseCmdHook("extra", $message);
1379     $done++ unless (&Modules());
1380
1381     if ($done) {
1382         &DEBUG("running non DCC CHAT command inside DCC CHAT!");
1383         return;
1384     }
1385
1386     return "REPLY";
1387 }
1388
1389 1;