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             $chanconf{$chan}{$1} = 0;
 229
 230         } elsif (/^[\s\t]+(\S+)[\ss\t]+(.*)$/) {# what = val.
 231             $chanconf{$chan}{$1} = $2;
 232
 233         } else {
 234             &WARN("unknown line: $_") unless (/^#/);
 235         }
 236     }
 237     close IN;
 238
 239     # verify configuration
 240     ### TODO: check against valid params.
 241     foreach $chan (keys %chanconf) {
 242         foreach (keys %{ $chanconf{$chan} }) {
 243             next unless (/^[+-]/);
 244             &WARN("invalid param: chanconf{$chan}{$_}; removing.");
 245             delete $chanconf{$chan}{$_};
 246             undef $chanconf{$chan}{$_};
 247         }
 248     }
 249
 250     &status("CHANFILE: Loaded: ".(scalar(keys %chanconf)-1)." chans");
 251 }
 252
 253 sub writeChanFile {
 254     if (!open OUT,">$bot_misc_dir/blootbot.chan") {
 255         &ERROR("cannot write chanfile.");
 256         return;
 257     }
 258
 259     my $time            = scalar(localtime);
 260     print OUT "#v1: blootbot -- $ident -- written $time\n\n";
 261
 262     if ($flag_quit) {
 263
 264         ### Process 1: if defined in _default, remove same definition
 265         ###             from non-default channels.
 266         foreach (keys %{ $chanconf{_default} }) {
 267             my $opt     = $_;
 268             my $val     = $chanconf{_default}{$opt};
 269             my @chans;
 270
 271             foreach (keys %chanconf) {
 272                 $chan = $_;
 273
 274                 next if ($chan eq "_default");
 275                 next unless (exists $chanconf{$chan}{$opt});
 276                 next unless ($val eq $chanconf{$chan}{$opt});
 277                 push(@chans,$chan);
 278                 delete $chanconf{$chan}{$opt};
 279             }
 280
 281             if (scalar @chans) {
 282                 &DEBUG("Removed config $opt to @chans since it's defiend in '_default'");
 283             }
 284         }
 285
 286         ### Process 2: if defined in all chans but _default, set in
 287         ###             _default and remove all others.
 288         my (%optsval, %opts);
 289         foreach (keys %chanconf) {
 290             $chan = $_;
 291             next if ($chan eq "_default");
 292             my $opt;
 293
 294             foreach (keys %{ $chanconf{$chan} }) {
 295                 $opt = $_;
 296                 if (exists $optsval{$opt} and $optsval{$opt} eq $chanconf{$chan}{$opt}) {
 297                     $opts{$opt}++;
 298                     next;
 299                 }
 300                 $optsval{$opt}  = $chanconf{$chan}{$opt};
 301                 $opts{$opt}     = 1;
 302             }
 303         }
 304
 305         &DEBUG("chans => ".scalar(keys %chanconf)." - 1");
 306         foreach (keys %opts) {
 307             &DEBUG("  opts{$_} => $opts{$_}");
 308         }
 309
 310         ### other optimizations are in UserDCC.pl
 311     }
 312
 313     ### lets do it...
 314     foreach (sort keys %chanconf) {
 315         $chan   = $_;
 316
 317         print OUT "$chan\n";
 318
 319         foreach (sort keys %{ $chanconf{$chan} }) {
 320             my $val = $chanconf{$chan}{$_};
 321
 322             if ($val =~ /^0$/) {                # bool, false.
 323                 print OUT "    -$_\n";
 324
 325             } elsif ($val =~ /^1$/) {           # bool, true.
 326                 print OUT "    +$_\n";
 327
 328             } else {                            # what = val.
 329                 print OUT "    $_ $val\n";
 330
 331             }
 332
 333         }
 334         print OUT "\n";
 335     }
 336
 337     close OUT;
 338
 339     $wtime_chanfile = time();
 340     &status("--- Saved CHANFILE (".scalar(keys %chanconf).
 341                 " chans) at $time");
 342
 343     if (defined $msgType and $msgType =~ /^chat$/) {
 344         &performStrictReply("--- Writing chan file...");
 345     }
 346 }
 347
 348 #####
 349 ##### USER COMMANDS.
 350 #####
 351
 352 sub IsFlag {
 353     my $flags = shift;
 354     my ($ret, $f, $o) = "";
 355
 356     &verifyUser($who, $nuh);
 357
 358     foreach $f (split //, $users{$userHandle}{FLAGS}) {
 359         foreach $o ( split //, $flags ) {
 360             next unless ($f eq $o);
 361
 362             $ret = $f;
 363             last;
 364         }
 365     }
 366
 367     $ret;
 368 }
 369
 370 sub verifyUser {
 371     my ($nick, $lnuh) = @_;
 372     my ($user,$m);
 373
 374     if ($userHandle = $dcc{'CHATvrfy'}{$who}) {
 375         &VERB("vUser: cached auth for $who.",2);
 376         return $userHandle;
 377     }
 378
 379     $userHandle = "";
 380
 381     foreach $user (keys %users) {
 382         next if ($user eq "_default");
 383
 384         foreach $m (keys %{$users{$user}{HOSTS}}) {
 385             $m =~ s/\?/./g;
 386             $m =~ s/\*/.*?/g;
 387             $m =~ s/([\@\(\)\[\]])/\\$1/g;
 388
 389             next unless ($lnuh =~ /^$m$/i);
 390
 391             if ($user !~ /^\Q$nick\E$/i and !exists $cache{VUSERWARN}{$user}) {
 392                 &status("vU: host matched but diff nick ($nick != $user).");
 393                 $cache{VUSERWARN}{$user} = 1;
 394             }
 395
 396             $userHandle = $user;
 397             last;
 398         }
 399
 400         last if ($userHandle ne "");
 401
 402         if ($user =~ /^\Q$nick\E$/i and !exists $cache{VUSERWARN}{$user}) {
 403             &status("vU: nick matched but host is not in list ($lnuh).");
 404             $cache{VUSERWARN}{$user} = 1;
 405         }
 406     }
 407
 408     $userHandle ||= "_default";
 409     # what's talkchannel for?
 410     $talkWho{$talkchannel} = $who if (defined $talkchannel);
 411     $talkWho = $who;
 412
 413     return $userHandle;
 414 }
 415
 416 sub ckpasswd {
 417     # returns true if arg1 encrypts to arg2
 418     my ($plain, $encrypted) = @_;
 419     if ($encrypted eq "") {
 420         ($plain, $encrypted) = split(/\s+/, $plain, 2);
 421     }
 422     return 0 unless ($plain ne "" and $encrypted ne "");
 423
 424     # MD5 // DES. Bobby Billingsley++.
 425     my $salt = substr($encrypted, 0, 2);
 426     if ($encrypted =~ /^\$\d\$(\w\w)\$/) {
 427         $salt = $1;
 428     }
 429
 430     return ($encrypted eq crypt($plain, $salt));
 431 }
 432
 433 # mainly for dcc chat... hrm.
 434 sub hasFlag {
 435     my ($flag) = @_;
 436
 437     if (&IsFlag($flag) eq $flag) {
 438         return 1;
 439     } else {
 440         &status("DCC CHAT: <$who> $message -- not enough flags.");
 441         &performStrictReply("error: you do not have enough flags for that. ($flag required)");
 442         return 0;
 443     }
 444 }
 445
 446 sub ignoreAdd {
 447     my($mask,$chan,$expire,$comment) = @_;
 448
 449     $chan       ||= "*";        # global if undefined.
 450     $comment    ||= "";         # optional.
 451     $expire     ||= 0;          # permament.
 452     my $count   ||= 0;
 453
 454     if ($expire > 0) {
 455         $expire         = $expire*60 + time();
 456     } else {
 457         $expire         = 0;
 458     }
 459
 460     my $exist   = 0;
 461     $exist++ if (exists $ignore{$chan}{$mask});
 462
 463     $ignore{$chan}{$mask} = [$expire, time(), $who, $comment];
 464
 465     if ($exist) {
 466         $utime_userfile = time();
 467         $ucount_userfile++;
 468
 469         return 2;
 470     } else {
 471         return 1;
 472     }
 473 }
 474
 475 sub ignoreDel {
 476     my($mask)   = @_;
 477     my @match;
 478
 479     ### TODO: support wildcards.
 480     foreach (keys %ignore) {
 481         my $chan = $_;
 482
 483         foreach (grep /^\Q$mask\E$/i, keys %{ $ignore{$chan} }) {
 484             delete $ignore{$chan}{$mask};
 485             push(@match,$chan);
 486         }
 487
 488         &DEBUG("iD: scalar => ".scalar(keys %{ $ignore{$chan} }) );
 489     }
 490
 491     if (scalar @match) {
 492         $utime_userfile = time();
 493         $ucount_userfile++;
 494     }
 495
 496     return @match;
 497 }
 498
 499 sub userAdd {
 500     my($nick,$mask)     = @_;
 501
 502     if (exists $users{$nick}) {
 503         return 0;
 504     }
 505
 506     $utime_userfile = time();
 507     $ucount_userfile++;
 508
 509     $users{$nick}{HOSTS}{$mask} = 1;
 510     $users{$nick}{FLAGS}        ||= $users{_default}{FLAGS};
 511
 512     return 1;
 513 }
 514
 515 sub userDel {
 516     my($nick)   = @_;
 517
 518     if (!exists $users{$nick}) {
 519         return 0;
 520     }
 521
 522     $utime_userfile = time();
 523     $ucount_userfile++;
 524
 525     delete $users{$nick};
 526
 527     return 1;
 528 }
 529
 530 sub banAdd {
 531     my($mask,$chan,$expire,$reason) = @_;
 532
 533     $chan       ||= "*";
 534     $expire     ||= 0;
 535
 536     if ($expire > 0) {
 537         $expire         = $expire*60 + time();
 538     }
 539
 540     my $exist   = 1;
 541     $exist++ if (exists $bans{$chan}{$mask} or
 542                 exists $bans{'*'}{$mask});
 543     $bans{$chan}{$mask} = [$expire, time(), 0, $who, $reason];
 544
 545     if ($exist == 1) {
 546         $utime_userfile = time();
 547         $ucount_userfile++;
 548     }
 549
 550     return $exist;
 551 }
 552
 553 sub banDel {
 554     my($mask)   = @_;
 555     my @match;
 556
 557     foreach (keys %bans) {
 558         my $chan        = $_;
 559
 560         foreach (grep /^\Q$mask\E$/i, keys %{ $bans{$chan} }) {
 561             delete $bans{$chan}{$_};
 562             push(@match, $chan);
 563         }
 564
 565         &DEBUG("bans: scalar => ".scalar(keys %{ $bans{$chan} }) );
 566     }
 567
 568     if (scalar @match) {
 569         $utime_userfile = time();
 570         $ucount_userfile++;
 571     }
 572
 573     return @match;
 574 }
 575
 576 sub IsUser {
 577     my($user) = @_;
 578
 579     if ( &getUser($user) ) {
 580         return 1;
 581     } else {
 582         return 0;
 583     }
 584 }
 585
 586 sub getUser {
 587     my($user) = @_;
 588
 589     if (!defined $user) {
 590         &WARN("getUser: user == NULL.");
 591         return;
 592     }
 593
 594     if (my @retval = grep /^\Q$user\E$/i, keys %users) {
 595         if ($retval[0] ne $user) {
 596             &WARN("getUser: retval[0] ne user ($retval[0] ne $user)");
 597         }
 598         my $count = scalar keys %{ $users{$retval[0]} };
 599         &DEBUG("count => $count.");
 600
 601         return $retval[0];
 602     } else {
 603         return;
 604     }
 605 }
 606
 607 sub chanSet {
 608     my($cmd, $chan, $what, $val) = @_;
 609
 610     if ($cmd eq "+chan") {
 611         if (exists $chanconf{$chan}) {
 612             &pSReply("chan $chan already exists.");
 613             return;
 614         }
 615         $chanconf{$chan}{_time_added}   = time();
 616         $chanconf{$what}{autojoin}      = 1;
 617
 618         &pSReply("Joining $chan...");
 619         &joinchan($chan);
 620
 621         return;
 622     }
 623
 624     if (!exists $chanconf{$chan}) {
 625         &pSReply("no such channel $chan");
 626         return;
 627     }
 628
 629     my $update  = 0;
 630
 631     if (defined $what and $what =~ s/^\+(\S+)/$1/) {
 632         my $was = $chanconf{$chan}{$1};
 633         if (defined $was and $was eq "1") {
 634             &pSReply("setting $what for $chan already 1.");
 635             return;
 636         }
 637
 638         $was    = ($was) ? "; was '$was'" : "";
 639         &pSReply("Setting $what for $chan to '1'$was.");
 640
 641         $chanconf{$chan}{$what} = 1;
 642
 643         $update++;
 644     } elsif (defined $what and $what =~ s/^\-(\S+)/$1/) {
 645         my $was = $chanconf{$chan}{$1};
 646         # hrm...
 647         if (!defined $was) {
 648             &pSReply("setting $what for $chan is not set.");
 649             return;
 650         }
 651
 652         if ($was eq "0") {
 653             &pSReply("setting $what for $chan already 0.");
 654             return;
 655         }
 656
 657         $was    = ($was) ? "; was '$was'" : "";
 658         &pSReply("Setting $what for $chan to '0'$was.");
 659
 660         $chanconf{$chan}{$what} = 0;
 661
 662         $update++;
 663     } elsif (defined $val) {
 664         my $was = $chanconf{$chan}{$what};
 665         if (defined $was and $was eq $val) {
 666             &pSReply("setting $what for $chan already '$val'.");
 667             return;
 668         }
 669         $was    = ($was) ? "; was '$was'" : "";
 670         &pSReply("Setting $what for $chan to '$val'$was.");
 671
 672         $chanconf{$chan}{$what} = $val;
 673
 674         $update++;
 675     } else {                            # read only.
 676         if (exists $chanconf{$chan}{$what}) {
 677             &pSReply("$what for $chan is '$chanconf{$chan}{$what}'");
 678         } else {
 679             &pSReply("$what for $chan is not set.");
 680         }
 681     }
 682
 683     if ($update) {
 684         $utime_chanfile = time();
 685         $ucount_chanfile++;
 686         return;
 687     }
 688
 689     ### TODO: move to UserDCC again.
 690     if ($cmd eq "chanset" and !defined $what) {
 691         &DEBUG("showing channel conf.");
 692
 693         foreach $chan ($chan, "_default") {
 694             &pSReply("chan: $chan");
 695             ### TODO: merge 2 or 3 per line.
 696             my @items;
 697             my $str = "";
 698             foreach (sort keys %{ $chanconf{$chan} }) {
 699                 my $newstr = join(', ', @items);
 700                 if (length $newstr > 60) {
 701                     &pSReply("    $str");
 702                     @items = ();
 703                 }
 704                 $str = $newstr;
 705                 push(@items, "$_ => $chanconf{$chan}{$_}");
 706             }
 707
 708             &pSReply("    $str") if (@items);
 709         }
 710
 711         return;
 712     }
 713
 714     return;
 715 }
 716
 717 my @regFlagsChan = (
 718         "autojoin",
 719         "freshmeat",
 720         "limitcheckInterval",
 721         "limitcheckPlus",
 722         "allowConv",
 723         "allowDNS",
 724 ### TODO: finish off this list.
 725 );
 726
 727 my @regFlagsUser = ("mno");     # todo...
 728
 729 1;