src/IRC/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         &readUserFile();
 506         &readChanFile();
 507         &reloadAllModules();
 508         &performStrictReply("reloaded.");
 509
 510         return;
 511     }
 512
 513     # reset.
 514     if ( $message =~ /^reset$/i ) {
 515         return unless ( &hasFlag('n') );
 516
 517         &msg( $who, "resetting..." );
 518         my @done;
 519         foreach ( keys %channels, keys %chanconf ) {
 520             my $c = $_;
 521             next if ( grep /^\Q$c\E$/i, @done );
 522
 523             &part($_);
 524
 525             push( @done, $_ );
 526             sleep 1;
 527         }
 528         &DEBUG('before clearircvars');
 529         &clearIRCVars();
 530         &DEBUG('before joinnextchan');
 531         &joinNextChan();
 532         &DEBUG('after joinnextchan');
 533
 534         &status("USER reset $who");
 535         &msg( $who, 'reset complete' );
 536
 537         return;
 538     }
 539
 540     # rehash.
 541     if ( $message =~ /^rehash$/ ) {
 542         return unless ( &hasFlag('n') );
 543
 544         &msg( $who, "rehashing..." );
 545         &restart('REHASH');
 546         &status("USER rehash $who");
 547         &msg( $who, 'rehashed' );
 548
 549         return;
 550     }
 551
 552     #####
 553     ##### USER//CHAN SPECIFIC CONFIGURATION COMMANDS
 554     #####
 555
 556     if ( $message =~ /^chaninfo(\s+(.*))?$/ ) {
 557         my @args = split /[\s\t]+/, $2;    # hrm.
 558
 559         if ( scalar @args != 1 ) {
 560             &help('chaninfo');
 561             return;
 562         }
 563
 564         if ( !exists $chanconf{ $args[0] } ) {
 565             &performStrictReply("no such channel $args[0]");
 566             return;
 567         }
 568
 569         &performStrictReply("showing channel conf.");
 570         foreach ( sort keys %{ $chanconf{ $args[0] } } ) {
 571             &performStrictReply("$chan: $_ => $chanconf{$args[0]}{$_}");
 572         }
 573         &performStrictReply("End of chaninfo.");
 574
 575         return;
 576     }
 577
 578     # chanadd.
 579     if ( $message =~ /^(chanset|chanadd)(\s+(.*?))?$/ ) {
 580         my $cmd     = $1;
 581         my $args    = $3;
 582         my $no_chan = 0;
 583
 584         if ( !defined $args ) {
 585             &help($cmd);
 586             return;
 587         }
 588
 589         my @chans;
 590         while ( $args =~ s/^($mask{chan})\s*// ) {
 591             push( @chans, lc($1) );
 592         }
 593
 594         if ( !scalar @chans ) {
 595             push( @chans, '_default' );
 596             $no_chan = 1;
 597         }
 598
 599         my ( $what, $val ) = split /[\s\t]+/, $args, 2;
 600
 601         ### TODO: "cannot set values without +m".
 602         return unless ( &hasFlag('n') );
 603
 604         # READ ONLY.
 605         if ( defined $what and $what !~ /^[-+]/ and !defined $val and $no_chan )
 606         {
 607             &performStrictReply("Showing $what values on all channels...");
 608
 609             my %vals;
 610             foreach ( keys %chanconf ) {
 611                 my $val;
 612                 if ( defined $chanconf{$_}{$what} ) {
 613                     $val = $chanconf{$_}{$what};
 614                 }
 615                 else {
 616                     $val = "NOT-SET";
 617                 }
 618                 $vals{$val}{$_} = 1;
 619             }
 620
 621             foreach ( keys %vals ) {
 622                 &performStrictReply( "  $what = $_("
 623                       . scalar( keys %{ $vals{$_} } ) . "): "
 624                       . join( ' ', sort keys %{ $vals{$_} } ) );
 625             }
 626
 627             &performStrictReply("End of list.");
 628
 629             return;
 630         }
 631
 632         ### TODO: move to UserDCC again.
 633         if ( $cmd eq 'chanset' and !defined $what ) {
 634             &DEBUG("showing channel conf.");
 635
 636             foreach $chan (@chans) {
 637                 if ( $chan eq '_default' ) {
 638                     &performStrictReply('Default channel settings');
 639                 }
 640                 else {
 641                     &performStrictReply("chan: $chan (see _default also)");
 642                 }
 643                 my @items;
 644                 my $str = '';
 645                 foreach ( sort keys %{ $chanconf{$chan} } ) {
 646                     my $newstr = join( ', ', @items );
 647                     ### TODO: make length use channel line limit?
 648                     if ( length $newstr > 370 ) {
 649                         &performStrictReply(" $str");
 650                         @items = ();
 651                     }
 652                     $str = $newstr;
 653                     push( @items, "$_ => $chanconf{$chan}{$_}" );
 654                 }
 655                 if (@items) {
 656                     my $str = join( ', ', @items );
 657                     &performStrictReply(" $str");
 658                 }
 659             }
 660             return;
 661         }
 662
 663         $cache{confvars}{$what} = $val;
 664         &rehashConfVars();
 665
 666         foreach (@chans) {
 667             &chanSet( $cmd, $_, $what, $val );
 668         }
 669
 670         return;
 671     }
 672
 673     if ( $message =~ /^(chanunset|chandel)(\s+(.*))?$/ ) {
 674         return unless ( &hasFlag('n') );
 675         my $cmd     = $1;
 676         my $args    = $3;
 677         my $no_chan = 0;
 678
 679         if ( !defined $args ) {
 680             &help($cmd);
 681             return;
 682         }
 683
 684         my ($chan);
 685         my $delete = 0;
 686         if ( $args =~ s/^(\-)?($mask{chan})\s*// ) {
 687             $chan = $2;
 688             $delete = ($1) ? 1 : 0;
 689         }
 690         else {
 691             &VERB( "no chan arg; setting to default.", 2 );
 692             $chan    = '_default';
 693             $no_chan = 1;
 694         }
 695
 696         if ( !exists $chanconf{$chan} ) {
 697             &performStrictReply("no such channel $chan");
 698             return;
 699         }
 700
 701         if ( $args ne '' ) {
 702
 703             if ( !&getChanConf( $args, $chan ) ) {
 704                 &performStrictReply("$args does not exist for $chan");
 705                 return;
 706             }
 707
 708             my @chans = &ChanConfList($args);
 709             &DEBUG( "scalar chans => " . scalar(@chans) );
 710             if ( scalar @chans == 1 and $chans[0] eq '_default' and !$no_chan )
 711             {
 712                 &performStrictReply(
 713 "ok, $args was set only for _default; unsetting for _defaul but setting for other chans."
 714                 );
 715
 716                 my $val = $chanconf{$_}{_default};
 717                 foreach ( keys %chanconf ) {
 718                     $chanconf{$_}{$args} = $val;
 719                 }
 720                 delete $chanconf{_default}{$args};
 721                 $cache{confvars}{$args} = 0;
 722                 &rehashConfVars();
 723
 724                 return;
 725             }
 726
 727             if ( $no_chan and !exists( $chanconf{_default}{$args} ) ) {
 728                 &performStrictReply(
 729 "ok, $args for _default does not exist, removing from all chans."
 730                 );
 731
 732                 foreach ( keys %chanconf ) {
 733                     next unless ( exists $chanconf{$_}{$args} );
 734                     &DEBUG("delete chanconf{$_}{$args};");
 735                     delete $chanconf{$_}{$args};
 736                 }
 737                 $cache{confvars}{$args} = 0;
 738                 &rehashConfVars();
 739
 740                 return;
 741             }
 742
 743             &performStrictReply(
 744 "Unsetting channel ($chan) option $args. (was $chanconf{$chan}{$args})"
 745             );
 746             delete $chanconf{$chan}{$args};
 747
 748             return;
 749         }
 750
 751         if ($delete) {
 752             &performStrictReply("Deleting channel $chan for sure!");
 753             $utime_chanfile = time();
 754             $ucount_chanfile++;
 755
 756             &part($chan);
 757             &performStrictReply("Leaving $chan...");
 758
 759             delete $chanconf{$chan};
 760         }
 761         else {
 762             &performStrictReply("Prefix channel with '-' to delete for sure.");
 763         }
 764
 765         return;
 766     }
 767
 768     if ( $message =~ /^newpass(\s+(.*))?$/ ) {
 769         my (@args) = split /[\s\t]+/, $2 || '';
 770
 771         if ( scalar @args != 1 ) {
 772             &help('newpass');
 773             return;
 774         }
 775
 776         my $u     = &getUser($who);
 777         my $crypt = &mkcrypt( $args[0] );
 778
 779         &performStrictReply("Set your passwd to '$crypt'");
 780         $users{$u}{PASS} = $crypt;
 781
 782         $utime_userfile = time();
 783         $ucount_userfile++;
 784
 785         return;
 786     }
 787
 788     if ( $message =~ /^chpass(\s+(.*))?$/ ) {
 789         my (@args) = split /[\s\t]+/, $2 || '';
 790
 791         if ( !scalar @args ) {
 792             &help('chpass');
 793             return;
 794         }
 795
 796         if ( !&IsUser( $args[0] ) ) {
 797             &performStrictReply("user $args[0] is not valid.");
 798             return;
 799         }
 800
 801         my $u = &getUser( $args[0] );
 802         if ( !defined $u ) {
 803             &performStrictReply("Internal error, u = NULL.");
 804             return;
 805         }
 806
 807         if ( scalar @args == 1 ) {
 808
 809             # del pass.
 810             if ( !&IsFlag('n') and $who !~ /^\Q$verifyUser\E$/i ) {
 811                 &performStrictReply("cannot remove passwd of others.");
 812                 return;
 813             }
 814
 815             if ( !exists $users{$u}{PASS} ) {
 816                 &performStrictReply("$u does not have pass set anyway.");
 817                 return;
 818             }
 819
 820             &performStrictReply("Deleted pass from $u.");
 821
 822             $utime_userfile = time();
 823             $ucount_userfile++;
 824
 825             delete $users{$u}{PASS};
 826
 827             return;
 828         }
 829
 830         my $crypt = &mkcrypt( $args[1] );
 831         &performStrictReply("Set $u's passwd to '$crypt'");
 832         $users{$u}{PASS} = $crypt;
 833
 834         $utime_userfile = time();
 835         $ucount_userfile++;
 836
 837         return;
 838     }
 839
 840     if ( $message =~ /^chattr(\s+(.*))?$/ ) {
 841         my (@args) = split /[\s\t]+/, $2 || '';
 842
 843         if ( !scalar @args ) {
 844             &help('chattr');
 845             return;
 846         }
 847
 848         my $chflag;
 849         my $user;
 850         if ( $args[0] =~ /^$mask{nick}$/i ) {
 851
 852             # <nick>
 853             $user   = &getUser( $args[0] );
 854             $chflag = $args[1];
 855         }
 856         else {
 857
 858             # <flags>
 859             $user = &getUser($who);
 860             &DEBUG("user $who... nope.") unless ( defined $user );
 861             $user   = &getUser($verifyUser);
 862             $chflag = $args[0];
 863         }
 864
 865         if ( !defined $user ) {
 866             &performStrictReply("user does not exist.");
 867             return;
 868         }
 869
 870         my $flags = $users{$user}{FLAGS};
 871         if ( !defined $chflag ) {
 872             &performStrictReply("Flags for $user: $flags");
 873             return;
 874         }
 875
 876         &DEBUG("who => $who");
 877         &DEBUG("verifyUser => $verifyUser");
 878         if ( !&IsFlag('n') and $who !~ /^\Q$verifyUser\E$/i ) {
 879             &performStrictReply("cannto change attributes of others.");
 880             return 'REPLY';
 881         }
 882
 883         my $state;
 884         my $change = 0;
 885         foreach ( split //, $chflag ) {
 886             if ( $_ eq "+" ) { $state = 1; next; }
 887             if ( $_ eq "-" ) { $state = 0; next; }
 888
 889             if ( !defined $state ) {
 890                 &performStrictReply("no initial + or - was found in attr.");
 891                 return;
 892             }
 893
 894             if ($state) {
 895                 next if ( $flags =~ /\Q$_\E/ );
 896                 $flags .= $_;
 897             }
 898             else {
 899                 if (    &IsParam('owner')
 900                     and $param{owner} =~ /^\Q$user\E$/i
 901                     and $flags        =~ /[nmo]/ )
 902                 {
 903                     &performStrictReply("not removing flag $_ for $user.");
 904                     next;
 905                 }
 906                 next unless ( $flags =~ s/\Q$_\E// );
 907             }
 908
 909             $change++;
 910         }
 911
 912         if ($change) {
 913             $utime_userfile = time();
 914             $ucount_userfile++;
 915
 916             #$flags.*FLAGS sort
 917             $flags = join( '', sort split( '', $flags ) );
 918             &performStrictReply("Current flags: $flags");
 919             $users{$user}{FLAGS} = $flags;
 920         }
 921         else {
 922             &performStrictReply("No flags changed: $flags");
 923         }
 924
 925         return;
 926     }
 927
 928     if ( $message =~ /^chnick(\s+(.*))?$/ ) {
 929         my (@args) = split /[\s\t]+/, $2 || '';
 930
 931         if ( $who eq '_default' ) {
 932             &WARN("$who or verifyuser tried to run chnick.");
 933             return 'REPLY';
 934         }
 935
 936         if ( !scalar @args or scalar @args > 2 ) {
 937             &help('chnick');
 938             return;
 939         }
 940
 941         if ( scalar @args == 1 ) {    # 1
 942             $user = &getUser($who);
 943             &DEBUG("nope, not $who.") unless ( defined $user );
 944             $user ||= &getUser($verifyUser);
 945             $chnick = $args[0];
 946         }
 947         else {                        # 2
 948             $user   = &getUser( $args[0] );
 949             $chnick = $args[1];
 950         }
 951
 952         if ( !defined $user ) {
 953             &performStrictReply("user $who or $args[0] does not exist.");
 954             return;
 955         }
 956
 957         if ( $user =~ /^\Q$chnick\E$/i ) {
 958             &performStrictReply("user == chnick. why should I do that?");
 959             return;
 960         }
 961
 962         if ( &getUser($chnick) ) {
 963             &performStrictReply("user $chnick is already used!");
 964             return;
 965         }
 966
 967         if ( !&IsFlag('n') and $who !~ /^\Q$verifyUser\E$/i ) {
 968             &performStrictReply("cannto change nick of others.");
 969             return 'REPLY' if ( $who eq '_default' );
 970             return;
 971         }
 972
 973         foreach ( keys %{ $users{$user} } ) {
 974             $users{$chnick}{$_} = $users{$user}{$_};
 975             delete $users{$user}{$_};
 976         }
 977         undef $users{$user};    # ???
 978
 979         $utime_userfile = time();
 980         $ucount_userfile++;
 981
 982         &performStrictReply("Changed '$user' to '$chnick' successfully.");
 983
 984         return;
 985     }
 986
 987     if ( $message =~ /^(hostadd|hostdel)(\s+(.*))?$/ ) {
 988         my $cmd = $1;
 989         my (@args) = split /[\s\t]+/, $3 || '';
 990         my $state = ( $1 eq "hostadd" ) ? 1 : 0;
 991
 992         if ( !scalar @args ) {
 993             &help($cmd);
 994             return;
 995         }
 996
 997         if ( $who eq '_default' ) {
 998             &WARN("$who or verifyuser tried to run $cmd.");
 999             return 'REPLY';
1000         }
1001
1002         my ( $user, $mask );
1003         if ( $args[0] =~ /^$mask{nick}$/i ) {    # <nick>
1004             return unless ( &hasFlag('n') );
1005             $user = &getUser( $args[0] );
1006             $mask = $args[1];
1007         }
1008         else {                                   # <mask>
1009                 # FIXME: who or verifyUser. (don't remember why)
1010             $user = &getUser($who);
1011             $mask = $args[0];
1012         }
1013
1014         if ( !defined $user ) {
1015             &performStrictReply("user $user does not exist.");
1016             return;
1017         }
1018
1019         if ( !defined $mask ) {
1020             &performStrictReply( "Hostmasks for $user: "
1021                   . join( ' ', keys %{ $users{$user}{HOSTS} } ) );
1022             return;
1023         }
1024
1025         if ( !&IsFlag('n') and $who !~ /^\Q$verifyUser\E$/i ) {
1026             &performStrictReply("cannto change masks of others.");
1027             return;
1028         }
1029
1030         my $count = scalar keys %{ $users{$user}{HOSTS} };
1031
1032         if ($state) {    # add.
1033             if ( $mask !~ /^$mask{nuh}$/ ) {
1034                 &performStrictReply(
1035                     "error: mask ($mask) is not a real hostmask.");
1036                 return;
1037             }
1038
1039             if ( exists $users{$user}{HOSTS}{$mask} ) {
1040                 &performStrictReply("mask $mask already exists.");
1041                 return;
1042             }
1043
1044             ### TODO: override support.
1045             $users{$user}{HOSTS}{$mask} = 1;
1046
1047             &performStrictReply("Added $mask to list of masks.");
1048
1049         }
1050         else {    # delete.
1051
1052             if ( !exists $users{$user}{HOSTS}{$mask} ) {
1053                 &performStrictReply("mask $mask does not exist.");
1054                 return;
1055             }
1056
1057             ### TODO: wildcard support. ?
1058             delete $users{$user}{HOSTS}{$mask};
1059
1060             if ( scalar keys %{ $users{$user}{HOSTS} } != $count ) {
1061                 &performStrictReply("Removed $mask from list of masks.");
1062             }
1063             else {
1064                 &performStrictReply(
1065                     "error: could not find $mask in list of masks.");
1066                 return;
1067             }
1068         }
1069
1070         $utime_userfile = time();
1071         $ucount_userfile++;
1072
1073         return;
1074     }
1075
1076     if ( $message =~ /^(banadd|bandel)(\s+(.*))?$/ ) {
1077         my $cmd     = $1;
1078         my $flatarg = $3;
1079         my (@args) = split /[\s\t]+/, $3 || '';
1080         my $state = ( $1 eq "banadd" ) ? 1 : 0;
1081
1082         if ( !scalar @args ) {
1083             &help($cmd);
1084             return;
1085         }
1086
1087         my ( $mask, $chan, $time, $reason );
1088
1089         if ( $flatarg =~ s/^($mask{nuh})\s*// ) {
1090             $mask = $1;
1091         }
1092         else {
1093             &DEBUG("arg does not contain nuh mask?");
1094         }
1095
1096         if ( $flatarg =~ s/^($mask{chan})\s*// ) {
1097             $chan = $1;
1098         }
1099         else {
1100             $chan = '*';    # _default instead?
1101         }
1102
1103         if ( $state == 0 ) {    # delete.
1104             my @c = &banDel($mask);
1105
1106             foreach (@c) {
1107                 &unban( $mask, $_ );
1108             }
1109
1110             if (@c) {
1111                 &performStrictReply("Removed $mask from chans: @c");
1112             }
1113             else {
1114                 &performStrictReply("$mask was not found in ban list.");
1115             }
1116
1117             return;
1118         }
1119
1120         ###
1121         # add ban.
1122         ###
1123
1124         # time.
1125         if ( $flatarg =~ s/^(\d+)\s*// ) {
1126             $time = $1;
1127             &DEBUG("time = $time.");
1128             if ( $time < 0 ) {
1129                 &performStrictReply("error: time cannot be negatime?");
1130                 return;
1131             }
1132         }
1133         else {
1134             $time = 0;
1135         }
1136
1137         if ( $flatarg =~ s/^(.*)$// ) {    # need length?
1138             $reason = $1;
1139         }
1140
1141         if ( !&IsFlag('n') and $who !~ /^\Q$verifyUser\E$/i ) {
1142             &performStrictReply("cannto change masks of others.");
1143             return;
1144         }
1145
1146         if ( $mask !~ /^$mask{nuh}$/ ) {
1147             &performStrictReply("error: mask ($mask) is not a real hostmask.");
1148             return;
1149         }
1150
1151         if ( &banAdd( $mask, $chan, $time, $reason ) == 2 ) {
1152             &performStrictReply("ban already exists; overwriting.");
1153         }
1154         &performStrictReply(
1155             "Added $mask for $chan (time => $time, reason => $reason)");
1156
1157         return;
1158     }
1159
1160     if ( $message =~ /^whois(\s+(.*))?$/ ) {
1161         my $arg = $2;
1162
1163         if ( !defined $arg ) {
1164             &help('whois');
1165             return;
1166         }
1167
1168         my $user = &getUser($arg);
1169         if ( !defined $user ) {
1170             &performStrictReply("whois: user '$arg' does not exist.");
1171             return;
1172         }
1173
1174         ### TODO: better (eggdrop-like) output.
1175         &performStrictReply("user: $user");
1176         foreach ( keys %{ $users{$user} } ) {
1177             my $ref = ref $users{$user}{$_};
1178
1179             if ( $ref eq 'HASH' ) {
1180                 my $type = $_;
1181                 ### DOES NOT WORK???
1182                 foreach ( keys %{ $users{$user}{$type} } ) {
1183                     &performStrictReply("    $type => $_");
1184                 }
1185                 next;
1186             }
1187
1188             &performStrictReply("    $_ => $users{$user}{$_}");
1189         }
1190         &performStrictReply("End of USER whois.");
1191
1192         return;
1193     }
1194
1195     if ( $message =~ /^bans(\s+(.*))?$/ ) {
1196         my $arg = $2;
1197
1198         if ( defined $arg ) {
1199             if ( $arg ne '_default' and !&validChan($arg) ) {
1200                 &performStrictReply("error: chan $chan is invalid.");
1201                 return;
1202             }
1203         }
1204
1205         if ( !scalar keys %bans ) {
1206             &performStrictReply("Ban list is empty.");
1207             return;
1208         }
1209
1210         my $c;
1211         &performStrictReply(
1212             "     mask: expire, time-added, count, who-by, reason");
1213         foreach $c ( keys %bans ) {
1214             next unless ( !defined $arg or $arg =~ /^\Q$c\E$/i );
1215             &performStrictReply("  $c:");
1216
1217             foreach ( keys %{ $bans{$c} } ) {
1218                 my $val = $bans{$c}{$_};
1219
1220                 if ( ref $val eq 'ARRAY' ) {
1221                     my @array = @{$val};
1222                     &performStrictReply("    $_: @array");
1223                 }
1224                 else {
1225                     &DEBUG("unknown ban: $val");
1226                 }
1227             }
1228         }
1229         &performStrictReply("END of bans.");
1230
1231         return;
1232     }
1233
1234     if ( $message =~ /^banlist(\s+(.*))?$/ ) {
1235         my $arg = $2;
1236
1237         if ( defined $arg and $arg !~ /^$mask{chan}$/ ) {
1238             &performStrictReply("error: chan $chan is invalid.");
1239             return;
1240         }
1241
1242         &DEBUG("bans for global or arg => $arg.");
1243         foreach ( keys %bans ) {    #CHANGE!!!
1244             &DEBUG("  $_ => $bans{$_}.");
1245         }
1246
1247         &DEBUG("End of bans.");
1248         &performStrictReply("END of bans.");
1249
1250         return;
1251     }
1252
1253     if ( $message =~ /^save$/ ) {
1254         return unless ( &hasFlag('o') );
1255
1256         &writeUserFile();
1257         &writeChanFile();
1258         &performStrictReply('saved user and chan files');
1259
1260         return;
1261     }
1262
1263     ### ALIASES.
1264     $message =~ s/^addignore/+ignore/;
1265     $message =~ s/^(del|un)ignore/-ignore/;
1266
1267     # ignore.
1268     if ( $message =~ /^(\+|\-)ignore(\s+(.*))?$/i ) {
1269         return unless ( &hasFlag('o') );
1270         my $state = ( $1 eq "+" ) ? 1 : 0;
1271         my $str   = $1 . 'ignore';
1272         my $args  = $3;
1273
1274         if ( !$args ) {
1275             &help($str);
1276             return;
1277         }
1278
1279         my ( $mask, $chan, $time, $comment );
1280
1281         # mask.
1282         if ( $args =~ s/^($mask{nuh})\s*// ) {
1283             $mask = $1;
1284         }
1285         else {
1286             &ERROR("no NUH mask?");
1287             return;
1288         }
1289
1290         if ( !$state ) {    # delignore.
1291             if ( &ignoreDel($mask) ) {
1292                 &performStrictReply("ok, deleted ignores for $mask.");
1293             }
1294             else {
1295                 &performStrictReply("could not find $mask in ignore list.");
1296             }
1297             return;
1298         }
1299
1300         ###
1301         # addignore.
1302         ###
1303
1304         # chan.
1305         if ( $args =~ s/^($mask{chan}|\*)\s*// ) {
1306             $chan = $1;
1307         }
1308         else {
1309             $chan = '*';
1310         }
1311
1312         # time.
1313         if ( $args =~ s/^(\d+)\s*// ) {
1314             $time = $1;    # time is in minutes
1315         }
1316         else {
1317             $time = 0;
1318         }
1319
1320         # time.
1321         if ($args) {
1322             $comment = $args;
1323         }
1324         else {
1325             $comment = "added by $who";
1326         }
1327
1328         if ( &ignoreAdd( $mask, $chan, $time, $comment ) > 1 ) {
1329             &performStrictReply(
1330                 "FIXME: $mask already in ignore list; written over anyway.");
1331         }
1332         else {
1333             &performStrictReply("added $mask to ignore list.");
1334         }
1335
1336         return;
1337     }
1338
1339     if ( $message =~ /^ignore(\s+(.*))?$/ ) {
1340         my $arg = $2;
1341
1342         if ( defined $arg ) {
1343             if ( $arg !~ /^$mask{chan}$/ ) {
1344                 &performStrictReply("error: chan $chan is invalid.");
1345                 return;
1346             }
1347
1348             if ( !&validChan($arg) ) {
1349                 &performStrictReply("error: chan $arg is invalid.");
1350                 return;
1351             }
1352
1353             &performStrictReply("Showing bans for $arg only.");
1354         }
1355
1356         if ( !scalar keys %ignore ) {
1357             &performStrictReply("Ignore list is empty.");
1358             return;
1359         }
1360
1361         ### TODO: proper (eggdrop-like) formatting.
1362         my $c;
1363         &performStrictReply("    mask: expire, time-added, who, comment");
1364         foreach $c ( keys %ignore ) {
1365             next unless ( !defined $arg or $arg =~ /^\Q$c\E$/i );
1366             &performStrictReply("  $c:");
1367
1368             foreach ( keys %{ $ignore{$c} } ) {
1369                 my $ref = ref $ignore{$c}{$_};
1370                 if ( $ref eq 'ARRAY' ) {
1371                     my @array = @{ $ignore{$c}{$_} };
1372                     &performStrictReply("      $_: @array");
1373                 }
1374                 else {
1375                     &DEBUG("unknown ignore line?");
1376                 }
1377             }
1378         }
1379         &performStrictReply("END of ignore.");
1380
1381         return;
1382     }
1383
1384     # useradd/userdel.
1385     if ( $message =~ /^(useradd|userdel)(\s+(.*))?$/i ) {
1386         my $cmd    = $1;
1387         my @args   = split /\s+/, $3 || '';
1388         my $args   = $3;
1389         my $state  = ( $cmd eq "useradd" ) ? 1 : 0;
1390
1391         if ( !scalar @args ) {
1392             &help($cmd);
1393             return;
1394         }
1395
1396         if ( $cmd eq 'useradd' ) {
1397             if ( scalar @args != 2 ) {
1398                 &performStrictReply('useradd requires hostmask argument.');
1399                 return;
1400             }
1401         }
1402         elsif ( scalar @args != 1 ) {
1403             &performStrictReply('too many arguments.');
1404             return;
1405         }
1406
1407         if ($state) {
1408
1409             # adduser.
1410             if ( scalar @args == 1 ) {
1411                 $args[1] = &getHostMask( $args[0] );
1412                 &performStrictReply(
1413                     "Attemping to guess $args[0]'s hostmask...");
1414
1415                 # crude hack... crappy Net::IRC
1416                 $conn->schedule(
1417                     5,
1418                     sub {
1419
1420                         # hopefully this is right.
1421                         my $nick = ( keys %{ $cache{nuhInfo} } )[0];
1422                         if ( !defined $nick ) {
1423                             &performStrictReply(
1424 "couldn't get nuhinfo... adding user without a hostmask."
1425                             );
1426                             &userAdd($nick);
1427                             return;
1428                         }
1429                         my $mask = &makeHostMask( $cache{nuhInfo}{$nick}{NUH} );
1430
1431                         if ( &userAdd( $nick, $mask ) ) {
1432
1433                             # success.
1434                             &performStrictReply(
1435                                 "Added $nick with flags $users{$nick}{FLAGS}");
1436                             my @hosts = keys %{ $users{$nick}{HOSTS} };
1437                             &performStrictReply("hosts: @hosts");
1438                         }
1439                     }
1440                 );
1441                 return;
1442             }
1443
1444             &DEBUG("args => @args");
1445             if ( &userAdd(@args) ) {    # success.
1446                 &performStrictReply(
1447                     "Added $args[0] with flags $users{$args[0]}{FLAGS}");
1448                 my @hosts = keys %{ $users{ $args[0] }{HOSTS} };
1449                 &performStrictReply("hosts: @hosts");
1450
1451             }
1452             else {                      # failure.
1453                 &performStrictReply("User $args[0] already exists");
1454             }
1455
1456         }
1457         else {                          # deluser.
1458
1459             if ( &userDel( $args[0] ) ) {    # success.
1460                 &performStrictReply("Deleted $args[0] successfully.");
1461
1462             }
1463             else {                           # failure.
1464                 &performStrictReply("User $args[0] does not exist.");
1465             }
1466
1467         }
1468         return;
1469     }
1470
1471     if ( $message =~ /^sched$/ ) {
1472         my @list;
1473         my @run;
1474
1475         my %time;
1476         foreach ( keys %sched ) {
1477             next unless ( exists $sched{$_}{TIME} );
1478             $time{ $sched{$_}{TIME} - time() }{$_} = 1;
1479             push( @list, $_ );
1480
1481             next unless ( exists $sched{$_}{RUNNING} );
1482             push( @run, $_ );
1483         }
1484
1485         my @time;
1486         foreach ( sort { $a <=> $b } keys %time ) {
1487             my $str = join( ', ', sort keys %{ $time{$_} } );
1488             &DEBUG("time => $_, str => $str");
1489             push( @time, "$str (" . &Time2String($_) . ")" );
1490         }
1491
1492         &performStrictReply( &formListReply( 0, "Schedulers: ", @time ) );
1493         &performStrictReply(
1494             &formListReply( 0, "Scheds to run: ", sort @list ) );
1495         &performStrictReply(
1496             &formListReply(
1497                 0, "Scheds running(should not happen?) ",
1498                 sort @run
1499             )
1500         );
1501
1502         return;
1503     }
1504
1505     # quite a cool hack: reply in DCC CHAT.
1506     $msgType = 'chat' if ( exists $dcc{'CHAT'}{$who} );
1507
1508     my $done = 0;
1509     $done++ if &parseCmdHook($message);
1510     $done++ unless ( &Modules() );
1511
1512     if ($done) {
1513         &DEBUG("running non DCC CHAT command inside DCC CHAT!");
1514         return;
1515     }
1516
1517     return 'REPLY';
1518 }
1519
1520 1;
1521
1522 # vim:ts=4:sw=4:expandtab:tw=80