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     foreach $f (split //, $users{$userHandle}{FLAGS}) {
 320         foreach $o ( split //, $flags ) {
 321             next unless ($f eq $o);
 322
 323             $ret = $f;
 324             last;
 325         }
 326     }
 327
 328     $ret;
 329 }
 330
 331 sub verifyUser {
 332     my ($nick, $lnuh) = @_;
 333     my ($user,$m);
 334
 335     $userHandle = "";
 336
 337     foreach $user (keys %users) {
 338         next if ($user eq "_default");
 339
 340         foreach $m (keys %{$users{$user}{HOSTS}}) {
 341             $m =~ s/\?/./g;
 342             $m =~ s/\*/.*?/g;
 343             $m =~ s/([\@\(\)\[\]])/\\$1/g;
 344
 345             next unless ($lnuh =~ /^$m$/i);
 346
 347             if ($user !~ /^\Q$nick\E$/i) {
 348                 &status("vU: host matched but diff nick ($nick != $user).");
 349             }
 350
 351             $userHandle = $user;
 352             last;
 353         }
 354
 355         last if ($userHandle ne "");
 356
 357         if ($user =~ /^\Q$nick\E$/i) {
 358             &status("vU: nick matched but host is not in list ($lnuh).");
 359         }
 360     }
 361
 362     $userHandle ||= "_default";
 363     $talkWho{$talkchannel} = $who if (defined $talkchannel);
 364     $talkWho = $who;
 365
 366     return $userHandle;
 367 }
 368
 369 sub ckpasswd {
 370     # returns true if arg1 encrypts to arg2
 371     my ($plain, $encrypted) = @_;
 372     if ($encrypted eq "") {
 373         ($plain, $encrypted) = split(/\s+/, $plain, 2);
 374     }
 375     return 0 unless ($plain ne "" and $encrypted ne "");
 376
 377     # MD5 // DES. Bobby Billingsley++.
 378     my $salt = substr($encrypted, 0, 2);
 379     if ($encrypted =~ /^\$\d\$(\w\w)\$/) {
 380         $salt = $1;
 381     }
 382
 383     return ($encrypted eq crypt($plain, $salt));
 384 }
 385
 386 # mainly for dcc chat... hrm.
 387 sub hasFlag {
 388     my ($flag) = @_;
 389
 390     if (&IsFlag($flag) eq $flag) {
 391         return 1;
 392     } else {
 393         &status("DCC CHAT: <$who> $message -- not enough flags.");
 394         &performStrictReply("error: you do not have enough flags for that. ($flag required)");
 395         return 0;
 396     }
 397 }
 398
 399 sub ignoreAdd {
 400     my($mask,$chan,$expire,$comment) = @_;
 401
 402     $chan       ||= "*";        # global if undefined.
 403     $comment    ||= "";         # optional.
 404     $expire     ||= 0;          # permament.
 405     my $count   ||= 0;
 406
 407     if ($expire > 0) {
 408         $expire         = $expire*60 + time();
 409     } else {
 410         $expire         = 0;
 411     }
 412
 413     $ignore{$chan}{$mask} = [$expire, $count, $who, time(), $comment];
 414
 415     if (exists $ignore{$chan}{$mask}) {
 416         return 0;
 417     } else {
 418         $utime_userfile = time();
 419         $ucount_userfile++;
 420
 421         return 1;
 422     }
 423 }
 424
 425 sub ignoreDel {
 426     my($mask)   = @_;
 427     my @match;
 428
 429     ### TODO: support wildcards.
 430     foreach (keys %ignore) {
 431         my $chan = $_;
 432
 433         foreach (grep /^\Q$mask\E$/i, keys %{ $ignore{$chan} }) {
 434             delete $ignore{$chan}{$mask};
 435             push(@match,$chan);
 436         }
 437
 438         &DEBUG("iD: scalar => ".scalar(keys %{ $ignore{$chan} }) );
 439     }
 440
 441     if (scalar @match) {
 442         $utime_userfile = time();
 443         $ucount_userfile++;
 444     }
 445
 446     return @match;
 447 }
 448
 449 sub userAdd {
 450     my($nick,$mask)     = @_;
 451
 452     if (exists $users{$nick}) {
 453         return 0;
 454     }
 455
 456     $utime_userfile = time();
 457     $ucount_userfile++;
 458
 459     $users{$nick}{HOSTS}{$mask} = 1;
 460     $users{$nick}{FLAGS}        = $users{_default}{FLAGS};
 461
 462     return 1;
 463 }
 464
 465 sub userDel {
 466     my($nick)   = @_;
 467
 468     if (!exists $users{$nick}) {
 469         return 0;
 470     }
 471
 472     $utime_userfile = time();
 473     $ucount_userfile++;
 474
 475     delete $users{$nick};
 476
 477     return 1;
 478 }
 479
 480 sub banAdd {
 481     my($mask,$chan,$expire,$reason) = @_;
 482
 483     $chan       ||= "*";
 484     $expire     ||= 0;
 485
 486     if ($expire > 0) {
 487         $expire         = $expire*60 + time();
 488     }
 489
 490     my $exist   = 1;
 491     $exist++ if (exists $bans{$chan}{$mask} or
 492                 exists $bans{_default}{$mask});
 493     $bans{$chan}{$mask} = [$expire, 0, $who, time(), $reason];
 494
 495     if ($exist == 1) {
 496         $utime_userfile = time();
 497         $ucount_userfile++;
 498     }
 499
 500     return $exist;
 501 }
 502
 503 sub banDel {
 504     my($mask)   = @_;
 505     my @match;
 506
 507     foreach (keys %bans) {
 508         my $chan        = $_;
 509
 510         foreach (grep /^\Q$mask\E$/i, keys %{ $bans{$chan} }) {
 511             delete $bans{$chan}{$_};
 512             push(@match, $chan);
 513         }
 514
 515         &DEBUG("bans: scalar => ".scalar(keys %{ $bans{$chan} }) );
 516     }
 517
 518     if (scalar @match) {
 519         $utime_userfile = time();
 520         $ucount_userfile++;
 521     }
 522
 523     return @match;
 524 }
 525
 526 sub IsUser {
 527     my($user) = @_;
 528
 529     if ( &getUser($user) ) {
 530         return 1;
 531     } else {
 532         return 0;
 533     }
 534 }
 535
 536 sub getUser {
 537     my($user) = @_;
 538
 539     if (!defined $user) {
 540         &WARN("getUser: user == NULL.");
 541         return;
 542     }
 543
 544     if (my @retval = grep /^\Q$user\E$/i, keys %users) {
 545         if ($retval[0] ne $user) {
 546             &WARN("getUser: retval[0] ne user ($retval[0] ne $user)");
 547         }
 548         my $count = scalar keys %{ $users{$retval[0]} };
 549         &DEBUG("count => $count.");
 550
 551         return $retval[0];
 552     } else {
 553         return;
 554     }
 555 }
 556
 557 my @regFlagsChan = (
 558         "autojoin",
 559         "freshmeat",
 560         "limitcheckInterval",
 561         "limitcheckPlus",
 562         "allowConv",
 563         "allowDNS",
 564 ### TODO: finish off this list.
 565 );
 566
 567 my @regFlagsUser = ("mno");     # todo...
 568
 569 1;