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