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