src/DynaConfig.pl

   1 #
   2 # DynaConfig.pl: Read/Write configuration files dynamically.
   3 #        Author: dms
   4 #       Version: v0.1 (20010120)
   5 #       Created: 20010119
   6 #          NOTE: Merged from User.pl
   7 #
   8
   9 if (&IsParam("useStrict")) { use strict; }
  10
  11 #####
  12 ##### USERFILE CONFIGURATION READER/WRITER
  13 #####
  14
  15 sub readUserFile {
  16     if (!open IN,"$bot_misc_dir/blootbot.users") {
  17         &ERROR("cannot read userfile.");
  18         &closeLog();
  19         exit 1;
  20     }
  21
  22     undef %users;       # clear on reload.
  23     undef %bans;        # reset.
  24     undef %ingore;      # reset.
  25
  26     my $ver = <IN>;
  27     if ($ver !~ /^#v1/) {
  28         &ERROR("old or invalid user file found.");
  29         &closeLog();
  30         exit 1; # correct?
  31     }
  32
  33     my $nick;
  34     my $type;
  35     while (<IN>) {
  36         chop;
  37
  38         next if /^$/;
  39         next if /^#/;
  40
  41         if (/^--(\S+)[\s\t]+(.*)$/) {           # user: middle entry.
  42             my ($what,$val) = ($1,$2);
  43
  44             if (!defined $val or $val eq "") {
  45                 &WARN("$what: val == NULL.");
  46                 next;
  47             }
  48
  49             # nice little hack.
  50             if ($what eq "HOSTS") {
  51                 $users{$nick}{$what}{$val} = 1;
  52             } else {
  53                 $users{$nick}{$what} = $val;
  54             }
  55
  56         } elsif (/^(\S+)$/) {                   # user: start entry.
  57             $nick       = $1;
  58
  59         } elsif (/^::(\S+) ignore$/) {          # ignore: start entry.
  60             $chan       = $1;
  61             $type       = "ignore";
  62
  63         } elsif (/^- (\S+):\+(\d+):\+(\d+):(\S+):(.*)$/ and $type eq "ignore") {
  64             ### ignore: middle entry.
  65             my $mask = $1;
  66             my(@array) = ($2,$3,$4,$5);
  67             ### DEBUG purposes only!
  68             if ($mask !~ /^$mask{nuh}$/) {
  69                 &WARN("ignore: mask $mask is invalid.");
  70                 next;
  71             }
  72             $ignore{$chan}{$mask} = \@array;
  73
  74         } elsif (/^::(\S+) bans$/) {            # bans: start entry.
  75             $chan       = $1;
  76             $type       = "bans";
  77
  78         } elsif (/^- (\S+):\+(\d+):\+(\d+):(\d+):(\S+):(.*)$/ and $type eq "bans") {
  79             ### bans: middle entry.
  80             # $btime, $atime, $count, $whoby, $reason.
  81             my(@array) = ($2,$3,$4,$5,$6);
  82             $bans{$chan}{$1} = \@array;
  83
  84         } else {                                # unknown.
  85             &WARN("unknown line: $_");
  86         }
  87     }
  88     close IN;
  89
  90     &status( sprintf("USERFILE: Loaded: %d users, %d bans, %d ignore",
  91                 scalar(keys %users)-1,
  92                 scalar(keys %bans),             # ??
  93                 scalar(keys %ignore),           # ??
  94         )
  95     );
  96 }
  97
  98 sub writeUserFile {
  99     if (!open OUT,">$bot_misc_dir/blootbot.users") {
 100         &ERROR("cannot write to userfile.");
 101         return;
 102     }
 103
 104     my $time            = scalar(localtime);
 105
 106     print OUT "#v1: blootbot -- $ident -- written $time\n\n";
 107
 108     ### USER LIST.
 109     my $cusers  = 0;
 110     foreach (sort keys %users) {
 111         my $user = $_;
 112         $cusers++;
 113         my $count = scalar keys %{ $users{$user} };
 114         if (!$count) {
 115             &WARN("user $user has no other attributes; skipping.");
 116             next;
 117         }
 118
 119         print OUT "$user\n";
 120
 121         foreach (sort keys %{ $users{$user} }) {
 122             my $what    = $_;
 123             my $val     = $users{$user}{$_};
 124
 125             if (ref($val) eq "HASH") {
 126                 foreach (sort keys %{ $users{$user}{$_} }) {
 127                     print OUT "--$what\t\t$_\n";
 128                 }
 129
 130             } else {
 131                 print OUT "--$_\t\t$val\n";
 132             }
 133         }
 134         print OUT "\n";
 135     }
 136
 137     ### BAN LIST.
 138     my $cbans   = 0;
 139     foreach (keys %bans) {
 140         my $chan = $_;
 141         $cbans++;
 142
 143         my $count = scalar keys %{ $bans{$chan} };
 144         if (!$count) {
 145             &WARN("bans: chan $chan has no other attributes; skipping.");
 146             next;
 147         }
 148
 149         print OUT "::$chan bans\n";
 150         foreach (keys %{ $bans{$chan} }) {
 151 # format: bans: mask expire time-added count who-added reason
 152             my @array = @{ $bans{$chan}{$_} };
 153             if (scalar @array != 5) {
 154                 &WARN("bans: $chan/$_ is corrupted.");
 155                 next;
 156             }
 157
 158             printf OUT "- %s:+%d:+%d:%d:%s:%s\n", $_, @array;
 159         }
 160     }
 161     print OUT "\n" if ($cbans);
 162
 163     ### IGNORE LIST.
 164     my $cignore = 0;
 165     foreach (keys %ignore) {
 166         my $chan = $_;
 167         $cignore++;
 168
 169         my $count = scalar keys %{ $ignore{$chan} };
 170         if (!$count) {
 171             &WARN("ignore: chan $chan has no other attributes; skipping.");
 172             next;
 173         }
 174
 175         ### TODO: use hash instead of array for flexibility?
 176         print OUT "::$chan ignore\n";
 177         foreach (keys %{ $ignore{$chan} }) {
 178 # format: ignore: mask expire time-added who-added reason
 179             my @array = @{ $ignore{$chan}{$_} };
 180             if (scalar @array != 4) {
 181                 &WARN("ignore: $chan/$_ is corrupted.");
 182                 next;
 183             }
 184
 185             printf OUT "- %s:+%d:+%d:%s:%s\n", $_, @array;
 186         }
 187     }
 188
 189     close OUT;
 190
 191     $wtime_userfile = time();
 192     &status("--- Saved USERFILE ($cusers users; $cbans bans; $cignore ignore) at $time");
 193     if (defined $msgType and $msgType =~ /^chat$/) {
 194         &performStrictReply("--- Writing user file...");
 195     }
 196 }
 197
 198 #####
 199 ##### CHANNEL CONFIGURATION READER/WRITER
 200 #####
 201
 202 sub readChanFile {
 203     if (!open IN,"$bot_misc_dir/blootbot.chan") {
 204         &ERROR("cannot erad chanfile.");
 205         return;
 206     }
 207
 208     undef %chanconf;    # reset.
 209
 210     $_ = <IN>;          # version string.
 211
 212     my $chan;
 213     while (<IN>) {
 214         chop;
 215
 216         next if /^$/;
 217
 218         if (/^(\S+)\s*$/) {
 219             $chan       = $1;
 220             next;
 221         }
 222         next unless (defined $chan);
 223
 224         if (/^[\s\t]+\+(\S+)$/) {               # bool, true.
 225             $chanconf{$chan}{$1} = 1;
 226
 227         } elsif (/^[\s\t]+\-(\S+)$/) {          # bool, false.
 228             &DEBUG("deprecated support of negative options.") unless ($cache{negative});
 229             # although this is supported in run-time configuration.
 230             $cache{negative} = 1;
 231 #           $chanconf{$chan}{$1} = 0;
 232
 233         } elsif (/^[\s\t]+(\S+)[\ss\t]+(.*)$/) {# what = val.
 234             $chanconf{$chan}{$1} = $2;
 235
 236         } else {
 237             &WARN("unknown line: $_") unless (/^#/);
 238         }
 239     }
 240     close IN;
 241
 242     # verify configuration
 243     ### TODO: check against valid params.
 244     foreach $chan (keys %chanconf) {
 245         foreach (keys %{ $chanconf{$chan} }) {
 246             next unless (/^[+-]/);
 247             &WARN("invalid param: chanconf{$chan}{$_}; removing.");
 248             delete $chanconf{$chan}{$_};
 249             undef $chanconf{$chan}{$_};
 250         }
 251     }
 252
 253     delete $cache{negative};
 254
 255     &status("CHANFILE: Loaded: ".(scalar(keys %chanconf)-1)." chans");
 256 }
 257
 258 sub writeChanFile {
 259     if (!open OUT,">$bot_misc_dir/blootbot.chan") {
 260         &ERROR("cannot write chanfile.");
 261         return;
 262     }
 263
 264     my $time            = scalar(localtime);
 265     print OUT "#v1: blootbot -- $ident -- written $time\n\n";
 266
 267     if ($flag_quit) {
 268
 269         ### Process 1: if defined in _default, remove same definition
 270         ###             from non-default channels.
 271         foreach (keys %{ $chanconf{_default} }) {
 272             my $opt     = $_;
 273             my $val     = $chanconf{_default}{$opt};
 274             my @chans;
 275
 276             foreach (keys %chanconf) {
 277                 $chan = $_;
 278
 279                 next if ($chan eq "_default");
 280                 next unless (exists $chanconf{$chan}{$opt});
 281                 next unless ($val eq $chanconf{$chan}{$opt});
 282                 push(@chans,$chan);
 283                 delete $chanconf{$chan}{$opt};
 284             }
 285
 286             if (scalar @chans) {
 287                 &DEBUG("Removed config $opt to @chans since it's defiend in '_default'");
 288             }
 289         }
 290
 291         ### Process 2: if defined in all chans but _default, set in
 292         ###             _default and remove all others.
 293         my (%optsval, %opts);
 294         foreach (keys %chanconf) {
 295             $chan = $_;
 296             next if ($chan eq "_default");
 297             my $opt;
 298
 299             foreach (keys %{ $chanconf{$chan} }) {
 300                 $opt = $_;
 301                 if (exists $optsval{$opt} and $optsval{$opt} eq $chanconf{$chan}{$opt}) {
 302                     $opts{$opt}++;
 303                     next;
 304                 }
 305                 $optsval{$opt}  = $chanconf{$chan}{$opt};
 306                 $opts{$opt}     = 1;
 307             }
 308         }
 309
 310         foreach (keys %opts) {
 311             next unless ($opts{$_} > 1);
 312             &DEBUG("  opts{$_} => $opts{$_}");
 313         }
 314
 315         ### other optimizations are in UserDCC.pl
 316     }
 317
 318     ### lets do it...
 319     foreach (sort keys %chanconf) {
 320         $chan   = $_;
 321
 322         print OUT "$chan\n";
 323
 324         foreach (sort keys %{ $chanconf{$chan} }) {
 325             my $val = $chanconf{$chan}{$_};
 326
 327             if ($val =~ /^0$/) {                # bool, false.
 328                 print OUT "    -$_\n";
 329
 330             } elsif ($val =~ /^1$/) {           # bool, true.
 331                 print OUT "    +$_\n";
 332
 333             } else {                            # what = val.
 334                 print OUT "    $_ $val\n";
 335
 336             }
 337
 338         }
 339         print OUT "\n";
 340     }
 341
 342     close OUT;
 343
 344     $wtime_chanfile = time();
 345     &status("--- Saved CHANFILE (".scalar(keys %chanconf).
 346                 " chans) at $time");
 347
 348     if (defined $msgType and $msgType =~ /^chat$/) {
 349         &performStrictReply("--- Writing chan file...");
 350     }
 351 }
 352
 353 #####
 354 ##### USER COMMANDS.
 355 #####
 356
 357 sub IsFlag {
 358     my $flags = shift;
 359     my ($ret, $f, $o) = "";
 360
 361     &verifyUser($who, $nuh);
 362
 363     foreach $f (split //, $users{$userHandle}{FLAGS}) {
 364         foreach $o ( split //, $flags ) {
 365             next unless ($f eq $o);
 366
 367             $ret = $f;
 368             last;
 369         }
 370     }
 371
 372     $ret;
 373 }
 374
 375 sub verifyUser {
 376     my ($nick, $lnuh) = @_;
 377     my ($user,$m);
 378
 379     if ($userHandle = $dcc{'CHATvrfy'}{$who}) {
 380         &VERB("vUser: cached auth for $who.",2);
 381         return $userHandle;
 382     }
 383
 384     $userHandle = "";
 385
 386     foreach $user (keys %users) {
 387         next if ($user eq "_default");
 388
 389         foreach $m (keys %{$users{$user}{HOSTS}}) {
 390             $m =~ s/\?/./g;
 391             $m =~ s/\*/.*?/g;
 392             $m =~ s/([\@\(\)\[\]])/\\$1/g;
 393
 394             next unless ($lnuh =~ /^$m$/i);
 395
 396             if ($user !~ /^\Q$nick\E$/i and !exists $cache{VUSERWARN}{$user}) {
 397                 &status("vU: host matched but diff nick ($nick != $user).");
 398                 $cache{VUSERWARN}{$user} = 1;
 399             }
 400
 401             $userHandle = $user;
 402             last;
 403         }
 404
 405         last if ($userHandle ne "");
 406
 407         if ($user =~ /^\Q$nick\E$/i and !exists $cache{VUSERWARN}{$user}) {
 408             &status("vU: nick matched but host is not in list ($lnuh).");
 409             $cache{VUSERWARN}{$user} = 1;
 410         }
 411     }
 412
 413     $userHandle ||= "_default";
 414     # what's talkchannel for?
 415     $talkWho{$talkchannel} = $who if (defined $talkchannel);
 416     $talkWho = $who;
 417
 418     return $userHandle;
 419 }
 420
 421 sub ckpasswd {
 422     # returns true if arg1 encrypts to arg2
 423     my ($plain, $encrypted) = @_;
 424     if ($encrypted eq "") {
 425         ($plain, $encrypted) = split(/\s+/, $plain, 2);
 426     }
 427     return 0 unless ($plain ne "" and $encrypted ne "");
 428
 429     # MD5 // DES. Bobby Billingsley++.
 430     my $salt;
 431     if ($encrypted =~ /^(\S{2})/ and length $encrypted == 13) {
 432         $salt = $1;
 433     } elsif ($encrypted =~ /^\$\d\$(\w\w)\$/) {
 434         $salt = $1;
 435     } else {
 436         &DEBUG("unknown salt from $encrypted.");
 437         return 0;
 438     }
 439
 440     return ($encrypted eq crypt($plain, $salt));
 441 }
 442
 443 # mainly for dcc chat... hrm.
 444 sub hasFlag {
 445     my ($flag) = @_;
 446
 447     if (&IsFlag($flag) eq $flag) {
 448         return 1;
 449     } else {
 450         &status("DCC CHAT: <$who> $message -- not enough flags.");
 451         &performStrictReply("error: you do not have enough flags for that. ($flag required)");
 452         return 0;
 453     }
 454 }
 455
 456 sub ignoreAdd {
 457     my($mask,$chan,$expire,$comment) = @_;
 458
 459     $chan       ||= "*";        # global if undefined.
 460     $comment    ||= "";         # optional.
 461     $expire     ||= 0;          # permament.
 462     my $count   ||= 0;
 463
 464     if ($expire > 0) {
 465         $expire         = $expire*60 + time();
 466     } else {
 467         $expire         = 0;
 468     }
 469
 470     my $exist   = 0;
 471     $exist++ if (exists $ignore{$chan}{$mask});
 472
 473     $ignore{$chan}{$mask} = [$expire, time(), $who, $comment];
 474
 475     if ($exist) {
 476         $utime_userfile = time();
 477         $ucount_userfile++;
 478
 479         return 2;
 480     } else {
 481         return 1;
 482     }
 483 }
 484
 485 sub ignoreDel {
 486     my($mask)   = @_;
 487     my @match;
 488
 489     ### TODO: support wildcards.
 490     foreach (keys %ignore) {
 491         my $chan = $_;
 492
 493         foreach (grep /^\Q$mask\E$/i, keys %{ $ignore{$chan} }) {
 494             delete $ignore{$chan}{$mask};
 495             push(@match,$chan);
 496         }
 497
 498         &DEBUG("iD: scalar => ".scalar(keys %{ $ignore{$chan} }) );
 499     }
 500
 501     if (scalar @match) {
 502         $utime_userfile = time();
 503         $ucount_userfile++;
 504     }
 505
 506     return @match;
 507 }
 508
 509 sub userAdd {
 510     my($nick,$mask)     = @_;
 511
 512     if (exists $users{$nick}) {
 513         return 0;
 514     }
 515
 516     $utime_userfile = time();
 517     $ucount_userfile++;
 518
 519     $users{$nick}{HOSTS}{$mask} = 1;
 520     $users{$nick}{FLAGS}        ||= $users{_default}{FLAGS};
 521
 522     return 1;
 523 }
 524
 525 sub userDel {
 526     my($nick)   = @_;
 527
 528     if (!exists $users{$nick}) {
 529         return 0;
 530     }
 531
 532     $utime_userfile = time();
 533     $ucount_userfile++;
 534
 535     delete $users{$nick};
 536
 537     return 1;
 538 }
 539
 540 sub banAdd {
 541     my($mask,$chan,$expire,$reason) = @_;
 542
 543     $chan       ||= "*";
 544     $expire     ||= 0;
 545
 546     if ($expire > 0) {
 547         $expire         = $expire*60 + time();
 548     }
 549
 550     my $exist   = 1;
 551     $exist++ if (exists $bans{$chan}{$mask} or
 552                 exists $bans{'*'}{$mask});
 553     $bans{$chan}{$mask} = [$expire, time(), 0, $who, $reason];
 554
 555     my @chans   = ($chan eq "*") ? keys %channels : $chan;
 556     my $m       = $mask;
 557     $m          =~ s/\?/\\./g;
 558     $m          =~ s/\*/\\S*/g;
 559     foreach (@chans) {
 560         my $chan = $_;
 561         foreach (keys %{ $channels{$chan}{''} }) {
 562             next unless (exists $nuh{lc $_});
 563             next unless ($nuh{lc $_} =~ /^$m$/i);
 564             &FIXME("nuh{$_} =~ /$m/");
 565         }
 566     }
 567
 568     if ($exist == 1) {
 569         $utime_userfile = time();
 570         $ucount_userfile++;
 571     }
 572
 573     return $exist;
 574 }
 575
 576 sub banDel {
 577     my($mask)   = @_;
 578     my @match;
 579
 580     foreach (keys %bans) {
 581         my $chan        = $_;
 582
 583         foreach (grep /^\Q$mask\E$/i, keys %{ $bans{$chan} }) {
 584             delete $bans{$chan}{$_};
 585             push(@match, $chan);
 586         }
 587
 588         &DEBUG("bans: scalar => ".scalar(keys %{ $bans{$chan} }) );
 589     }
 590
 591     if (scalar @match) {
 592         $utime_userfile = time();
 593         $ucount_userfile++;
 594     }
 595
 596     return @match;
 597 }
 598
 599 sub IsUser {
 600     my($user) = @_;
 601
 602     if ( &getUser($user) ) {
 603         return 1;
 604     } else {
 605         return 0;
 606     }
 607 }
 608
 609 sub getUser {
 610     my($user) = @_;
 611
 612     if (!defined $user) {
 613         &WARN("getUser: user == NULL.");
 614         return;
 615     }
 616
 617     if (my @retval = grep /^\Q$user\E$/i, keys %users) {
 618         if ($retval[0] ne $user) {
 619             &WARN("getUser: retval[0] ne user ($retval[0] ne $user)");
 620         }
 621         my $count = scalar keys %{ $users{$retval[0]} };
 622         &DEBUG("count => $count.");
 623
 624         return $retval[0];
 625     } else {
 626         return;
 627     }
 628 }
 629
 630 sub chanSet {
 631     my($cmd, $chan, $what, $val) = @_;
 632
 633     if ($cmd eq "+chan") {
 634         if (exists $chanconf{$chan}) {
 635             &pSReply("chan $chan already exists.");
 636             return;
 637         }
 638         $chanconf{$chan}{_time_added}   = time();
 639         $chanconf{$what}{autojoin}      = 1;
 640
 641         &pSReply("Joining $chan...");
 642         &joinchan($chan);
 643
 644         return;
 645     }
 646
 647     if (!exists $chanconf{$chan}) {
 648         &pSReply("no such channel $chan");
 649         return;
 650     }
 651
 652     my $update  = 0;
 653
 654     ### ".chanset +blah"
 655     ### ".chanset +blah 10"             -- error.
 656     if (defined $what and $what =~ s/^([+-])(\S+)/$2/) {
 657         my $state       = ($1 eq "+") ? 1 : 0;
 658         my $was         = $chanconf{$chan}{$what};
 659
 660         if ($state) {                   # add/set.
 661             if (defined $was and $was eq "1") {
 662                 &pSReply("setting $what for $chan already 1.");
 663                 return;
 664             }
 665
 666             $was        = ($was) ? "; was '$was'" : "";
 667             $val        = 1;
 668
 669         } else {                        # delete/unset.
 670             if (!defined $was) {
 671                 &pSReply("setting $what for $chan is not set.");
 672                 return;
 673             }
 674
 675             if ($was eq "0") {
 676                 &pSReply("setting $what for $chan already 0.");
 677                 return;
 678             }
 679
 680             $was        = ($was) ? "; was '$was'" : "";
 681             $val        = 0;
 682         }
 683
 684         $chanconf{$chan}{$what} = $val;
 685         &pSReply("Setting $what for $chan to '$val'$was.");
 686         $update++;
 687
 688     ### ".chanset blah testing"
 689     } elsif (defined $val) {
 690         my $was = $chanconf{$chan}{$what};
 691         if (defined $was and $was eq $val) {
 692             &pSReply("setting $what for $chan already '$val'.");
 693             return;
 694         }
 695         $was    = ($was) ? "; was '$was'" : "";
 696         &pSReply("Setting $what for $chan to '$val'$was.");
 697
 698         $chanconf{$chan}{$what} = $val;
 699
 700         $update++;
 701
 702     ### ".chanset"
 703     ### ".chanset blah"
 704     } else {                            # read only.
 705         if (!defined $what) {
 706             &WARN("chanset/DC: what == undefine.");
 707             return;
 708         }
 709
 710         if (exists $chanconf{$chan}{$what}) {
 711             &pSReply("$what for $chan is '$chanconf{$chan}{$what}'");
 712         } else {
 713             &pSReply("$what for $chan is not set.");
 714         }
 715     }
 716
 717     if ($update) {
 718         $utime_chanfile = time();
 719         $ucount_chanfile++;
 720     }
 721
 722     return;
 723 }
 724
 725 my @regFlagsChan = (
 726         "autojoin",
 727         "freshmeat",
 728         "limitcheckInterval",
 729         "limitcheckPlus",
 730         "allowConv",
 731         "allowDNS",
 732 ### TODO: finish off this list.
 733 );
 734
 735 my @regFlagsUser = (
 736         "m",            # master
 737         "n",            # owner
 738         "o",            # op
 739 );      # todo...
 740
 741 1;