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         &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     # chanadd.
 577     if ( $message =~ /^(chanset|chanadd)(\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|chandel)(\s+(.*))?$/ ) {
 672         return unless ( &hasFlag('n') );
 673         my $cmd     = $1;
 674         my $args    = $3;
 675         my $no_chan = 0;
 676
 677         if ( !defined $args ) {
 678             &help($cmd);
 679             return;
 680         }
 681
 682         my ($chan);
 683         my $delete = 0;
 684         if ( $args =~ s/^(\-)?($mask{chan})\s*// ) {
 685             $chan = $2;
 686             $delete = ($1) ? 1 : 0;
 687         }
 688         else {
 689             &VERB( "no chan arg; setting to default.", 2 );
 690             $chan    = '_default';
 691             $no_chan = 1;
 692         }
 693
 694         if ( !exists $chanconf{$chan} ) {
 695             &performStrictReply("no such channel $chan");
 696             return;
 697         }
 698
 699         if ( $args ne '' ) {
 700
 701             if ( !&getChanConf( $args, $chan ) ) {
 702                 &performStrictReply("$args does not exist for $chan");
 703                 return;
 704             }
 705
 706             my @chans = &ChanConfList($args);
 707             &DEBUG( "scalar chans => " . scalar(@chans) );
 708             if ( scalar @chans == 1 and $chans[0] eq '_default' and !$no_chan )
 709             {
 710                 &performStrictReply(
 711 "ok, $args was set only for _default; unsetting for _defaul but setting for other chans."
 712                 );
 713
 714                 my $val = $chanconf{$_}{_default};
 715                 foreach ( keys %chanconf ) {
 716                     $chanconf{$_}{$args} = $val;
 717                 }
 718                 delete $chanconf{_default}{$args};
 719                 $cache{confvars}{$args} = 0;
 720                 &rehashConfVars();
 721
 722                 return;
 723             }
 724
 725             if ( $no_chan and !exists( $chanconf{_default}{$args} ) ) {
 726                 &performStrictReply(
 727 "ok, $args for _default does not exist, removing from all chans."
 728                 );
 729
 730                 foreach ( keys %chanconf ) {
 731                     next unless ( exists $chanconf{$_}{$args} );
 732                     &DEBUG("delete chanconf{$_}{$args};");
 733                     delete $chanconf{$_}{$args};
 734                 }
 735                 $cache{confvars}{$args} = 0;
 736                 &rehashConfVars();
 737
 738                 return;
 739             }
 740
 741             &performStrictReply(
 742 "Unsetting channel ($chan) option $args. (was $chanconf{$chan}{$args})"
 743             );
 744             delete $chanconf{$chan}{$args};
 745
 746             return;
 747         }
 748
 749         if ($delete) {
 750             &performStrictReply("Deleting channel $chan for sure!");
 751             $utime_chanfile = time();
 752             $ucount_chanfile++;
 753
 754             &part($chan);
 755             &performStrictReply("Leaving $chan...");
 756
 757             delete $chanconf{$chan};
 758         }
 759         else {
 760             &performStrictReply("Prefix channel with '-' to delete for sure.");
 761         }
 762
 763         return;
 764     }
 765
 766     if ( $message =~ /^newpass(\s+(.*))?$/ ) {
 767         my (@args) = split /[\s\t]+/, $2 || '';
 768
 769         if ( scalar @args != 1 ) {
 770             &help('newpass');
 771             return;
 772         }
 773
 774         my $u     = &getUser($who);
 775         my $crypt = &mkcrypt( $args[0] );
 776
 777         &performStrictReply("Set your passwd to '$crypt'");
 778         $users{$u}{PASS} = $crypt;
 779
 780         $utime_userfile = time();
 781         $ucount_userfile++;
 782
 783         return;
 784     }
 785
 786     if ( $message =~ /^chpass(\s+(.*))?$/ ) {
 787         my (@args) = split /[\s\t]+/, $2 || '';
 788
 789         if ( !scalar @args ) {
 790             &help('chpass');
 791             return;
 792         }
 793
 794         if ( !&IsUser( $args[0] ) ) {
 795             &performStrictReply("user $args[0] is not valid.");
 796             return;
 797         }
 798
 799         my $u = &getUser( $args[0] );
 800         if ( !defined $u ) {
 801             &performStrictReply("Internal error, u = NULL.");
 802             return;
 803         }
 804
 805         if ( scalar @args == 1 ) {
 806
 807             # del pass.
 808             if ( !&IsFlag('n') and $who !~ /^\Q$verifyUser\E$/i ) {
 809                 &performStrictReply("cannot remove passwd of others.");
 810                 return;
 811             }
 812
 813             if ( !exists $users{$u}{PASS} ) {
 814                 &performStrictReply("$u does not have pass set anyway.");
 815                 return;
 816             }
 817
 818             &performStrictReply("Deleted pass from $u.");
 819
 820             $utime_userfile = time();
 821             $ucount_userfile++;
 822
 823             delete $users{$u}{PASS};
 824
 825             return;
 826         }
 827
 828         my $crypt = &mkcrypt( $args[1] );
 829         &performStrictReply("Set $u's passwd to '$crypt'");
 830         $users{$u}{PASS} = $crypt;
 831
 832         $utime_userfile = time();
 833         $ucount_userfile++;
 834
 835         return;
 836     }
 837
 838     if ( $message =~ /^chattr(\s+(.*))?$/ ) {
 839         my (@args) = split /[\s\t]+/, $2 || '';
 840
 841         if ( !scalar @args ) {
 842             &help('chattr');
 843             return;
 844         }
 845
 846         my $chflag;
 847         my $user;
 848         if ( $args[0] =~ /^$mask{nick}$/i ) {
 849
 850             # <nick>
 851             $user   = &getUser( $args[0] );
 852             $chflag = $args[1];
 853         }
 854         else {
 855
 856             # <flags>
 857             $user = &getUser($who);
 858             &DEBUG("user $who... nope.") unless ( defined $user );
 859             $user   = &getUser($verifyUser);
 860             $chflag = $args[0];
 861         }
 862
 863         if ( !defined $user ) {
 864             &performStrictReply("user does not exist.");
 865             return;
 866         }
 867
 868         my $flags = $users{$user}{FLAGS};
 869         if ( !defined $chflag ) {
 870             &performStrictReply("Flags for $user: $flags");
 871             return;
 872         }
 873
 874         &DEBUG("who => $who");
 875         &DEBUG("verifyUser => $verifyUser");
 876         if ( !&IsFlag('n') and $who !~ /^\Q$verifyUser\E$/i ) {
 877             &performStrictReply("cannto change attributes of others.");
 878             return 'REPLY';
 879         }
 880
 881         my $state;
 882         my $change = 0;
 883         foreach ( split //, $chflag ) {
 884             if ( $_ eq "+" ) { $state = 1; next; }
 885             if ( $_ eq "-" ) { $state = 0; next; }
 886
 887             if ( !defined $state ) {
 888                 &performStrictReply("no initial + or - was found in attr.");
 889                 return;
 890             }
 891
 892             if ($state) {
 893                 next if ( $flags =~ /\Q$_\E/ );
 894                 $flags .= $_;
 895             }
 896             else {
 897                 if (    &IsParam('owner')
 898                     and $param{owner} =~ /^\Q$user\E$/i
 899                     and $flags        =~ /[nmo]/ )
 900                 {
 901                     &performStrictReply("not removing flag $_ for $user.");
 902                     next;
 903                 }
 904                 next unless ( $flags =~ s/\Q$_\E// );
 905             }
 906
 907             $change++;
 908         }
 909
 910         if ($change) {
 911             $utime_userfile = time();
 912             $ucount_userfile++;
 913
 914             #$flags.*FLAGS sort
 915             $flags = join( '', sort split( '', $flags ) );
 916             &performStrictReply("Current flags: $flags");
 917             $users{$user}{FLAGS} = $flags;
 918         }
 919         else {
 920             &performStrictReply("No flags changed: $flags");
 921         }
 922
 923         return;
 924     }
 925
 926     if ( $message =~ /^chnick(\s+(.*))?$/ ) {
 927         my (@args) = split /[\s\t]+/, $2 || '';
 928
 929         if ( $who eq '_default' ) {
 930             &WARN("$who or verifyuser tried to run chnick.");
 931             return 'REPLY';
 932         }
 933
 934         if ( !scalar @args or scalar @args > 2 ) {
 935             &help('chnick');
 936             return;
 937         }
 938
 939         if ( scalar @args == 1 ) {    # 1
 940             $user = &getUser($who);
 941             &DEBUG("nope, not $who.") unless ( defined $user );
 942             $user ||= &getUser($verifyUser);
 943             $chnick = $args[0];
 944         }
 945         else {                        # 2
 946             $user   = &getUser( $args[0] );
 947             $chnick = $args[1];
 948         }
 949
 950         if ( !defined $user ) {
 951             &performStrictReply("user $who or $args[0] does not exist.");
 952             return;
 953         }
 954
 955         if ( $user =~ /^\Q$chnick\E$/i ) {
 956             &performStrictReply("user == chnick. why should I do that?");
 957             return;
 958         }
 959
 960         if ( &getUser($chnick) ) {
 961             &performStrictReply("user $chnick is already used!");
 962             return;
 963         }
 964
 965         if ( !&IsFlag('n') and $who !~ /^\Q$verifyUser\E$/i ) {
 966             &performStrictReply("cannto change nick of others.");
 967             return 'REPLY' if ( $who eq '_default' );
 968             return;
 969         }
 970
 971         foreach ( keys %{ $users{$user} } ) {
 972             $users{$chnick}{$_} = $users{$user}{$_};
 973             delete $users{$user}{$_};
 974         }
 975         undef $users{$user};    # ???
 976
 977         $utime_userfile = time();
 978         $ucount_userfile++;
 979
 980         &performStrictReply("Changed '$user' to '$chnick' successfully.");
 981
 982         return;
 983     }
 984
 985     if ( $message =~ /^(hostadd|hostdel)(\s+(.*))?$/ ) {
 986         my $cmd = $1;
 987         my (@args) = split /[\s\t]+/, $3 || '';
 988         my $state = ( $1 eq "hostadd" ) ? 1 : 0;
 989
 990         if ( !scalar @args ) {
 991             &help($cmd);
 992             return;
 993         }
 994
 995         if ( $who eq '_default' ) {
 996             &WARN("$who or verifyuser tried to run $cmd.");
 997             return 'REPLY';
 998         }
 999
1000         my ( $user, $mask );
1001         if ( $args[0] =~ /^$mask{nick}$/i ) {    # <nick>
1002             return unless ( &hasFlag('n') );
1003             $user = &getUser( $args[0] );
1004             $mask = $args[1];
1005         }
1006         else {                                   # <mask>
1007                 # FIXME: who or verifyUser. (don't remember why)
1008             $user = &getUser($who);
1009             $mask = $args[0];
1010         }
1011
1012         if ( !defined $user ) {
1013             &performStrictReply("user $user does not exist.");
1014             return;
1015         }
1016
1017         if ( !defined $mask ) {
1018             &performStrictReply( "Hostmasks for $user: "
1019                   . join( ' ', keys %{ $users{$user}{HOSTS} } ) );
1020             return;
1021         }
1022
1023         if ( !&IsFlag('n') and $who !~ /^\Q$verifyUser\E$/i ) {
1024             &performStrictReply("cannto change masks of others.");
1025             return;
1026         }
1027
1028         my $count = scalar keys %{ $users{$user}{HOSTS} };
1029
1030         if ($state) {    # add.
1031             if ( $mask !~ /^$mask{nuh}$/ ) {
1032                 &performStrictReply(
1033                     "error: mask ($mask) is not a real hostmask.");
1034                 return;
1035             }
1036
1037             if ( exists $users{$user}{HOSTS}{$mask} ) {
1038                 &performStrictReply("mask $mask already exists.");
1039                 return;
1040             }
1041
1042             ### TODO: override support.
1043             $users{$user}{HOSTS}{$mask} = 1;
1044
1045             &performStrictReply("Added $mask to list of masks.");
1046
1047         }
1048         else {    # delete.
1049
1050             if ( !exists $users{$user}{HOSTS}{$mask} ) {
1051                 &performStrictReply("mask $mask does not exist.");
1052                 return;
1053             }
1054
1055             ### TODO: wildcard support. ?
1056             delete $users{$user}{HOSTS}{$mask};
1057
1058             if ( scalar keys %{ $users{$user}{HOSTS} } != $count ) {
1059                 &performStrictReply("Removed $mask from list of masks.");
1060             }
1061             else {
1062                 &performStrictReply(
1063                     "error: could not find $mask in list of masks.");
1064                 return;
1065             }
1066         }
1067
1068         $utime_userfile = time();
1069         $ucount_userfile++;
1070
1071         return;
1072     }
1073
1074     if ( $message =~ /^(banadd|bandel)(\s+(.*))?$/ ) {
1075         my $cmd     = $1;
1076         my $flatarg = $3;
1077         my (@args) = split /[\s\t]+/, $3 || '';
1078         my $state = ( $1 eq "banadd" ) ? 1 : 0;
1079
1080         if ( !scalar @args ) {
1081             &help($cmd);
1082             return;
1083         }
1084
1085         my ( $mask, $chan, $time, $reason );
1086
1087         if ( $flatarg =~ s/^($mask{nuh})\s*// ) {
1088             $mask = $1;
1089         }
1090         else {
1091             &DEBUG("arg does not contain nuh mask?");
1092         }
1093
1094         if ( $flatarg =~ s/^($mask{chan})\s*// ) {
1095             $chan = $1;
1096         }
1097         else {
1098             $chan = '*';    # _default instead?
1099         }
1100
1101         if ( $state == 0 ) {    # delete.
1102             my @c = &banDel($mask);
1103
1104             foreach (@c) {
1105                 &unban( $mask, $_ );
1106             }
1107
1108             if (@c) {
1109                 &performStrictReply("Removed $mask from chans: @c");
1110             }
1111             else {
1112                 &performStrictReply("$mask was not found in ban list.");
1113             }
1114
1115             return;
1116         }
1117
1118         ###
1119         # add ban.
1120         ###
1121
1122         # time.
1123         if ( $flatarg =~ s/^(\d+)\s*// ) {
1124             $time = $1;
1125             &DEBUG("time = $time.");
1126             if ( $time < 0 ) {
1127                 &performStrictReply("error: time cannot be negatime?");
1128                 return;
1129             }
1130         }
1131         else {
1132             $time = 0;
1133         }
1134
1135         if ( $flatarg =~ s/^(.*)$// ) {    # need length?
1136             $reason = $1;
1137         }
1138
1139         if ( !&IsFlag('n') and $who !~ /^\Q$verifyUser\E$/i ) {
1140             &performStrictReply("cannto change masks of others.");
1141             return;
1142         }
1143
1144         if ( $mask !~ /^$mask{nuh}$/ ) {
1145             &performStrictReply("error: mask ($mask) is not a real hostmask.");
1146             return;
1147         }
1148
1149         if ( &banAdd( $mask, $chan, $time, $reason ) == 2 ) {
1150             &performStrictReply("ban already exists; overwriting.");
1151         }
1152         &performStrictReply(
1153             "Added $mask for $chan (time => $time, reason => $reason)");
1154
1155         return;
1156     }
1157
1158     if ( $message =~ /^whois(\s+(.*))?$/ ) {
1159         my $arg = $2;
1160
1161         if ( !defined $arg ) {
1162             &help('whois');
1163             return;
1164         }
1165
1166         my $user = &getUser($arg);
1167         if ( !defined $user ) {
1168             &performStrictReply("whois: user '$arg' does not exist.");
1169             return;
1170         }
1171
1172         ### TODO: better (eggdrop-like) output.
1173         &performStrictReply("user: $user");
1174         foreach ( keys %{ $users{$user} } ) {
1175             my $ref = ref $users{$user}{$_};
1176
1177             if ( $ref eq 'HASH' ) {
1178                 my $type = $_;
1179                 ### DOES NOT WORK???
1180                 foreach ( keys %{ $users{$user}{$type} } ) {
1181                     &performStrictReply("    $type => $_");
1182                 }
1183                 next;
1184             }
1185
1186             &performStrictReply("    $_ => $users{$user}{$_}");
1187         }
1188         &performStrictReply("End of USER whois.");
1189
1190         return;
1191     }
1192
1193     if ( $message =~ /^bans(\s+(.*))?$/ ) {
1194         my $arg = $2;
1195
1196         if ( defined $arg ) {
1197             if ( $arg ne '_default' and !&validChan($arg) ) {
1198                 &performStrictReply("error: chan $chan is invalid.");
1199                 return;
1200             }
1201         }
1202
1203         if ( !scalar keys %bans ) {
1204             &performStrictReply("Ban list is empty.");
1205             return;
1206         }
1207
1208         my $c;
1209         &performStrictReply(
1210             "     mask: expire, time-added, count, who-by, reason");
1211         foreach $c ( keys %bans ) {
1212             next unless ( !defined $arg or $arg =~ /^\Q$c\E$/i );
1213             &performStrictReply("  $c:");
1214
1215             foreach ( keys %{ $bans{$c} } ) {
1216                 my $val = $bans{$c}{$_};
1217
1218                 if ( ref $val eq 'ARRAY' ) {
1219                     my @array = @{$val};
1220                     &performStrictReply("    $_: @array");
1221                 }
1222                 else {
1223                     &DEBUG("unknown ban: $val");
1224                 }
1225             }
1226         }
1227         &performStrictReply("END of bans.");
1228
1229         return;
1230     }
1231
1232     if ( $message =~ /^banlist(\s+(.*))?$/ ) {
1233         my $arg = $2;
1234
1235         if ( defined $arg and $arg !~ /^$mask{chan}$/ ) {
1236             &performStrictReply("error: chan $chan is invalid.");
1237             return;
1238         }
1239
1240         &DEBUG("bans for global or arg => $arg.");
1241         foreach ( keys %bans ) {    #CHANGE!!!
1242             &DEBUG("  $_ => $bans{$_}.");
1243         }
1244
1245         &DEBUG("End of bans.");
1246         &performStrictReply("END of bans.");
1247
1248         return;
1249     }
1250
1251     if ( $message =~ /^save$/ ) {
1252         return unless ( &hasFlag('o') );
1253
1254         &writeUserFile();
1255         &writeChanFile();
1256         &performStrictReply('saved user and chan files');
1257
1258         return;
1259     }
1260
1261     ### ALIASES.
1262     $message =~ s/^addignore/+ignore/;
1263     $message =~ s/^(del|un)ignore/-ignore/;
1264
1265     # ignore.
1266     if ( $message =~ /^(\+|\-)ignore(\s+(.*))?$/i ) {
1267         return unless ( &hasFlag('o') );
1268         my $state = ( $1 eq "+" ) ? 1 : 0;
1269         my $str   = $1 . 'ignore';
1270         my $args  = $3;
1271
1272         if ( !$args ) {
1273             &help($str);
1274             return;
1275         }
1276
1277         my ( $mask, $chan, $time, $comment );
1278
1279         # mask.
1280         if ( $args =~ s/^($mask{nuh})\s*// ) {
1281             $mask = $1;
1282         }
1283         else {
1284             &ERROR("no NUH mask?");
1285             return;
1286         }
1287
1288         if ( !$state ) {    # delignore.
1289             if ( &ignoreDel($mask) ) {
1290                 &performStrictReply("ok, deleted ignores for $mask.");
1291             }
1292             else {
1293                 &performStrictReply("could not find $mask in ignore list.");
1294             }
1295             return;
1296         }
1297
1298         ###
1299         # addignore.
1300         ###
1301
1302         # chan.
1303         if ( $args =~ s/^($mask{chan}|\*)\s*// ) {
1304             $chan = $1;
1305         }
1306         else {
1307             $chan = '*';
1308         }
1309
1310         # time.
1311         if ( $args =~ s/^(\d+)\s*// ) {
1312             $time = $1;    # time is in minutes
1313         }
1314         else {
1315             $time = 0;
1316         }
1317
1318         # time.
1319         if ($args) {
1320             $comment = $args;
1321         }
1322         else {
1323             $comment = "added by $who";
1324         }
1325
1326         if ( &ignoreAdd( $mask, $chan, $time, $comment ) > 1 ) {
1327             &performStrictReply(
1328                 "FIXME: $mask already in ignore list; written over anyway.");
1329         }
1330         else {
1331             &performStrictReply("added $mask to ignore list.");
1332         }
1333
1334         return;
1335     }
1336
1337     if ( $message =~ /^ignore(\s+(.*))?$/ ) {
1338         my $arg = $2;
1339
1340         if ( defined $arg ) {
1341             if ( $arg !~ /^$mask{chan}$/ ) {
1342                 &performStrictReply("error: chan $chan is invalid.");
1343                 return;
1344             }
1345
1346             if ( !&validChan($arg) ) {
1347                 &performStrictReply("error: chan $arg is invalid.");
1348                 return;
1349             }
1350
1351             &performStrictReply("Showing bans for $arg only.");
1352         }
1353
1354         if ( !scalar keys %ignore ) {
1355             &performStrictReply("Ignore list is empty.");
1356             return;
1357         }
1358
1359         ### TODO: proper (eggdrop-like) formatting.
1360         my $c;
1361         &performStrictReply("    mask: expire, time-added, who, comment");
1362         foreach $c ( keys %ignore ) {
1363             next unless ( !defined $arg or $arg =~ /^\Q$c\E$/i );
1364             &performStrictReply("  $c:");
1365
1366             foreach ( keys %{ $ignore{$c} } ) {
1367                 my $ref = ref $ignore{$c}{$_};
1368                 if ( $ref eq 'ARRAY' ) {
1369                     my @array = @{ $ignore{$c}{$_} };
1370                     &performStrictReply("      $_: @array");
1371                 }
1372                 else {
1373                     &DEBUG("unknown ignore line?");
1374                 }
1375             }
1376         }
1377         &performStrictReply("END of ignore.");
1378
1379         return;
1380     }
1381
1382     # useradd/userdel.
1383     if ( $message =~ /^(useradd|userdel)(\s+(.*))?$/i ) {
1384         my $cmd    = $1;
1385         my @args   = split /\s+/, $3 || '';
1386         my $args   = $3;
1387         my $state  = ( $cmd eq "useradd" ) ? 1 : 0;
1388
1389         if ( !scalar @args ) {
1390             &help($cmd);
1391             return;
1392         }
1393
1394         if ( $cmd eq 'useradd' ) {
1395             if ( scalar @args != 2 ) {
1396                 &performStrictReply('useradd 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