]> git.donarmstrong.com Git - infobot.git/blob - src/DynaConfig.pl
- make ignoreAdd a little more verbose.
[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_state_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("DynaConfig: 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_state_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_state_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_state_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     # todo: improve this.
517     &status("ignore: Added $mask for $chan to expire $expire, by $who, for $comment");
518
519     if ($exist) {
520         $utime_userfile = time();
521         $ucount_userfile++;
522
523         return 2;
524     } else {
525         return 1;
526     }
527 }
528
529 sub ignoreDel {
530     my($mask)   = @_;
531     my @match;
532
533     ### TODO: support wildcards.
534     foreach (keys %ignore) {
535         my $chan = $_;
536
537         foreach (grep /^\Q$mask\E$/i, keys %{ $ignore{$chan} }) {
538             delete $ignore{$chan}{$mask};
539             push(@match,$chan);
540         }
541
542         &DEBUG("iD: scalar => ".scalar(keys %{ $ignore{$chan} }) );
543     }
544
545     if (scalar @match) {
546         $utime_userfile = time();
547         $ucount_userfile++;
548     }
549
550     return @match;
551 }
552
553 sub userAdd {
554     my($nick,$mask)     = @_;
555
556     if (exists $users{$nick}) {
557         return 0;
558     }
559
560     $utime_userfile = time();
561     $ucount_userfile++;
562
563     if (defined $mask and $mask !~ /^\s*$/) {
564         &DEBUG("userAdd: mask => $mask");
565         $users{$nick}{HOSTS}{$mask} = 1;
566     }
567
568     $users{$nick}{FLAGS}        ||= $users{_default}{FLAGS};
569
570     return 1;
571 }
572
573 sub userDel {
574     my($nick)   = @_;
575
576     if (!exists $users{$nick}) {
577         return 0;
578     }
579
580     $utime_userfile = time();
581     $ucount_userfile++;
582
583     delete $users{$nick};
584
585     return 1;
586 }
587
588 sub banAdd {
589     my($mask,$chan,$expire,$reason) = @_;
590
591     $chan       ||= "*";
592     $expire     ||= 0;
593
594     if ($expire > 0) {
595         $expire         = $expire*60 + time();
596     }
597
598     my $exist   = 1;
599     $exist++ if (exists $bans{$chan}{$mask} or
600                 exists $bans{'*'}{$mask});
601     $bans{$chan}{$mask} = [$expire, time(), 0, $who, $reason];
602
603     my @chans   = ($chan eq "*") ? keys %channels : $chan;
604     my $m       = $mask;
605     $m          =~ s/\?/\\./g;
606     $m          =~ s/\*/\\S*/g;
607     foreach (@chans) {
608         my $chan = $_;
609         foreach (keys %{ $channels{$chan}{''} }) {
610             next unless (exists $nuh{lc $_});
611             next unless ($nuh{lc $_} =~ /^$m$/i);
612             &FIXME("nuh{$_} =~ /$m/");
613         }
614     }
615
616     if ($exist == 1) {
617         $utime_userfile = time();
618         $ucount_userfile++;
619     }
620
621     return $exist;
622 }
623
624 sub banDel {
625     my($mask)   = @_;
626     my @match;
627
628     foreach (keys %bans) {
629         my $chan        = $_;
630
631         foreach (grep /^\Q$mask\E$/i, keys %{ $bans{$chan} }) {
632             delete $bans{$chan}{$_};
633             push(@match, $chan);
634         }
635
636         &DEBUG("bans: scalar => ".scalar(keys %{ $bans{$chan} }) );
637     }
638
639     if (scalar @match) {
640         $utime_userfile = time();
641         $ucount_userfile++;
642     }
643
644     return @match;
645 }
646
647 sub IsUser {
648     my($user) = @_;
649
650     if ( &getUser($user) ) {
651         return 1;
652     } else {
653         return 0;
654     }
655 }
656
657 sub getUser {
658     my($user) = @_;
659
660     if (!defined $user) {
661         &WARN("getUser: user == NULL.");
662         return;
663     }
664
665     if (my @retval = grep /^\Q$user\E$/i, keys %users) {
666         if ($retval[0] ne $user) {
667             &WARN("getUser: retval[0] ne user ($retval[0] ne $user)");
668         }
669         my $count = scalar keys %{ $users{$retval[0]} };
670         &DEBUG("count => $count.");
671
672         return $retval[0];
673     } else {
674         return;
675     }
676 }
677
678 sub chanSet {
679     my($cmd, $chan, $what, $val) = @_;
680
681     if ($cmd eq "+chan") {
682         if (exists $chanconf{$chan}) {
683             &pSReply("chan $chan already exists.");
684             return;
685         }
686         $chanconf{$chan}{_time_added}   = time();
687         $chanconf{$what}{autojoin}      = 1;
688
689         &pSReply("Joining $chan...");
690         &joinchan($chan);
691
692         return;
693     }
694
695     if (!exists $chanconf{$chan}) {
696         &pSReply("no such channel $chan");
697         return;
698     }
699
700     my $update  = 0;
701
702     ### ".chanset +blah"
703     ### ".chanset +blah 10"             -- error.
704     if (defined $what and $what =~ s/^([+-])(\S+)/$2/) {
705         my $state       = ($1 eq "+") ? 1 : 0;
706         my $was         = $chanconf{$chan}{$what};
707
708         if ($state) {                   # add/set.
709             if (defined $was and $was eq "1") {
710                 &pSReply("setting $what for $chan already 1.");
711                 return;
712             }
713
714             $was        = ($was) ? "; was '$was'" : "";
715             $val        = 1;
716
717         } else {                        # delete/unset.
718             if (!defined $was) {
719                 &pSReply("setting $what for $chan is not set.");
720                 return;
721             }
722
723             if ($was eq "0") {
724                 &pSReply("setting $what for $chan already 0.");
725                 return;
726             }
727
728             $was        = ($was) ? "; was '$was'" : "";
729             $val        = 0;
730         }
731
732         if ($val eq "0") {
733             &pSReply("Unsetting $what for $chan$was.");
734             delete $chanconf{$chan}{$what};
735         } else {
736             &pSReply("Setting $what for $chan to '$val'$was.");
737             $chanconf{$chan}{$what}     = $val;
738         }
739
740         $update++;
741
742     ### ".chanset blah testing"
743     } elsif (defined $val) {
744         my $was = $chanconf{$chan}{$what};
745         if (defined $was and $was eq $val) {
746             &pSReply("setting $what for $chan already '$val'.");
747             return;
748         }
749         $was    = ($was) ? "; was '$was'" : "";
750         &pSReply("Setting $what for $chan to '$val'$was.");
751
752         $chanconf{$chan}{$what} = $val;
753
754         $update++;
755
756     ### ".chanset"
757     ### ".chanset blah"
758     } else {                            # read only.
759         if (!defined $what) {
760             &WARN("chanset/DC: what == undefine.");
761             return;
762         }
763
764         if (exists $chanconf{$chan}{$what}) {
765             &pSReply("$what for $chan is '$chanconf{$chan}{$what}'");
766         } else {
767             &pSReply("$what for $chan is not set.");
768         }
769     }
770
771     if ($update) {
772         $utime_chanfile = time();
773         $ucount_chanfile++;
774     }
775
776     return;
777 }
778
779 sub rehashConfVars {
780     # this is an attempt to fix where an option is loaded but the module
781     # has not loaded. it also can be used for other things.
782
783     foreach (keys %{ $cache{confvars} }) {
784         my $i = $cache{confvars}{$_};
785         &DEBUG("rehashConfVars: _ => $_");
786
787         if (/^news$/ and $i) {
788             &loadMyModule("news");
789             delete $cache{confvars}{$_};
790         }
791
792         if (/^uptime$/ and $i) {
793             &loadMyModule("uptime");
794             delete $cache{confvars}{$_};
795         }
796
797         if (/^rootwarn$/i and $i) {
798             &loadMyModule($_);
799             delete $cache{confvars}{$_};
800         }
801     }
802
803     &DEBUG("end of rehashConfVars");
804
805     delete $cache{confvars};
806 }
807
808 my @regFlagsChan = (
809         "autojoin",
810         "freshmeat",
811         "limitcheckInterval",
812         "limitcheckPlus",
813         "allowConv",
814         "allowDNS",
815 ### TODO: finish off this list.
816 );
817
818 my @regFlagsUser = (
819         "m",            # master
820         "n",            # owner
821         "o",            # op
822 );      # todo...
823
824 1;
825
826 #####
827 # Userflags
828 #       +r      - ability to remove factoids
829 #       +t      - ability to teach factoids
830 #       +m      - ability to modify factoids
831 #       +n      - bot owner
832 #       +o      - authorised user of bot (like +m on eggdrop)
833 #####