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