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