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