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