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