9 use Digest::SHA qw(sha256_hex);
16 my %conf = %main::conf;
17 my $chans = $conf{chans};
18 my $teamchans = $conf{teamchans};
19 my @teamchans = split /[,\s]+/m, $teamchans;
20 my $staff = $conf{staff};
21 my $zncdir = $conf{zncdir};
22 my $znclog = $conf{znclog} || "$zncdir/.znc/moddata/adminlog/znc.log";
23 my $hostname = $conf{hostname};
24 my $bnchostname = $conf{bnchostname};
25 my $terms = $conf{terms};
27 my $expires = $conf{expires};
28 my $sslport = $conf{sslport};
29 my $plainport = $conf{plainport};
30 my $mailfrom = $conf{mailfrom};
31 my $mailname = $conf{mailname};
32 my $approval = $conf{approval};
33 my $webpanel = $conf{webpanel};
34 # File containing IRC networks
35 my $netpath = "networks";
45 `doas chmod g+r /home/znc/home/znc/.znc/`;
47 main::cbind("pub", "-", "bnc", \&mbnc);
48 main::cbind("msg", "-", "bnc", \&mbnc);
49 main::cbind("msg", "-", "regex", \&mregex);
50 main::cbind("msg", "-", "foreach", \&mforeach);
51 main::cbind("msgm", "-", "*", \&mcontrolpanel);
52 main::cbind("msg", "-", "taillog", \&mtaillog);
53 main::cbind("msg", "-", "lastseen", \&mlastseen);
56 unveil("/usr/local/bin/figlet", "rx") or die "Unable to unveil $!";
57 unveil("/usr/lib/libc.so.95.1", "r") or die "Unable to unveil $!";
58 unveil("/usr/libexec/ld.so", "r") or die "Unable to unveil $!";
59 unveil("/usr/bin/tail", "rx") or die "Unable to unveil $!";
60 unveil("$netpath", "r") or die "Unable to unveil $!";
62 @networks = readnetworks($netpath);
64 # networks must be sorted to avoid multiple connections
65 @networks = sort @networks;
68 # Return list of networks from filename
69 # To add multiple servers for a single network, simply create a new entry with
70 # the same net name; znc ignores addnetwork commands when a network already exists
73 my @lines = main::readarray($filename);
75 foreach my $line (@lines) {
76 if ($line =~ /^#/ or $line =~ /^\s*$/) { # skip comments and whitespace
78 } elsif ($line =~ /^\s*([-a-zA-Z0-9]+)\s*([-_.:a-zA-Z0-9]+)\s*(~|\+)?([0-9]+)\s*$/) {
79 my ($name, $server, $port) = ($1, $2, $4);
83 } elsif ($3 eq "~") { # Use SSL but trust all certs
86 } else { # Use SSL and verify certs
90 push(@networks, {"name" => $name, "server" => $server, "port" => $port, "trustcerts" => $trustcerts });
92 die "network format invalid: $line\n";
99 my ($bot, $nick, $host, $hand, @args) = @_;
102 ($chan, $text) = ($args[0], $args[1]);
103 } else { $text = $args[0]; }
104 my $hostmask = "$nick!$host";
105 if (defined($chan) && $chans =~ /$chan/) {
106 main::putserv($bot, "PRIVMSG $chan :$nick: Please check private message");
109 main::putserv($bot, "PRIVMSG $nick :Type !help for new instructions");
110 foreach my $chan (@teamchans) {
111 main::putservlocalnet($bot, "PRIVMSG $chan :$staff: Help *$nick* on network ".$bot->{name});
114 } elsif (main::isstaff($bot, $nick) && $text =~ /^delete\s+([[:ascii:]]+)/) {
116 if (SQLite::deleterows("bnc", "username", $username)) {
117 main::putserv($bot, "PRIVMSG *controlpanel :deluser $username");
118 foreach my $chan (@teamchans) {
119 main::putserv($bot, "PRIVMSG $chan :$username deleted");
123 } elsif (main::isstaff($bot, $nick) && $text =~ /^approve\s+([[:ascii:]]+)/) {
125 if (SQLite::selectrows("bnc", "username", $username)) {
126 my $email = SQLite::get("bnc", "username", $username, "email");
127 my $password = Hash::newpass();
128 main::putserv($bot,"privmsg *controlpanel :set Password $username $password");
129 main::putserv($bot, "PRIVMSG *blockuser :unblock $username");
130 mailbncApproved($username,$email,$password);
131 foreach my $chan (@teamchans) {
132 main::putserv($bot, "PRIVMSG $chan :$username bnc approved");
135 main::putserv($bot, "PRIVMSG $chan :$username hasn't requested a bnc account");
138 } elsif ($staff =~ /$nick/ && $text =~ /^cloneuser$/i) {
139 main::putserv($bot, "PRIVMSG *controlpanel :deluser cloneuser");
141 main::putserv($bot, "PRIVMSG *controlpanel :get Nick cloneuser");
143 ### Check duplicate hostmasks ###
144 my @rows = SQLite::selectrows("irc", "hostmask", $hostmask);
145 foreach my $row (@rows) {
146 my $password = SQLite::get("bnc", "ircid", $row->{id}, "password");
147 if (defined($password)) {
148 main::putserv($bot, "PRIVMSG $nick :Sorry, only one account per person. Please contact staff if you need help.");
153 if ($text =~ /^captcha\s+([[:alnum:]]+)/) {
155 # TODO avoid using host mask because cloaking can cause problems
156 my $ircid = SQLite::id("irc", "nick", $nick, $expires);
157 my $captcha = SQLite::get("bnc", "ircid", $ircid, "captcha");
158 if ($text ne $captcha) {
159 main::putserv($bot, "PRIVMSG $nick :Wrong captcha. To get a new captcha, type !bnc <username> <email>");
162 my $pass = Hash::newpass();
163 chomp(my $encrypted = `encrypt $pass`);
164 my $username = SQLite::get("bnc", "ircid", $ircid, "username");
165 my $email = SQLite::get("bnc", "ircid", $ircid, "email");
166 my $hashirc = SQLite::get("irc", "id", $ircid, "hashid");
167 my $bindhost = "$username.$hostname";
168 SQLite::set("bnc", "ircid", $ircid, "password", $encrypted);
169 if (DNS::nextdns($username)) {
171 createbnc($bot, $username, $pass, $bindhost);
172 if ($approval eq "true") {
173 main::putserv($bot, "PRIVMSG *blockuser :block $username");
174 main::putserv($bot, "PRIVMSG $nick :Your account has been created but must be approved by your admins ($staff) before it can be used. Please reply to the email and contact staff over IRC.");
175 mailbncPending($username, $email);
176 foreach my $chan (@teamchans) {
177 main::putservlocalnet($bot, "PRIVMSG $chan :$staff: To approve $nick, you must type !bnc approve $username");
180 main::putserv($bot, "PRIVMSG $nick :Check your email! Please reply to the email and contact staff over IRC.");
181 mailbncApproved($username,$email,$pass);
183 foreach my $chan (@teamchans) {
184 main::putservlocalnet($bot, "PRIVMSG $chan :$staff: $nick\'s bnc registration of $username on $bot->{name} was successful, *but* you *must* help him connect. Most users are unable to connect. Show him https://wiki.ircnow.org/?n=Bouncer.Bouncer and give him connection instructions");
186 #www($newnick, $reply, $password, "bouncer");
188 foreach my $chan (@teamchans) {
189 main::putserv($bot, "PRIVMSG $chan :Assigning bindhost $bindhost failed");
193 } elsif ($text =~ /^([[:alnum:]]+)\s+([[:ascii:]]+)/) {
194 my ($username, $email) = ($1, $2);
195 #XXX Check if this user is staff - hotfix for bug
196 if (bncExists($bot,$username)) {
197 main::putserv($bot, "PRIVMSG $nick :Sorry, that account already exists");
200 my @userrows = SQLite::selectrows("bnc", "username", $username);
201 foreach my $row (@userrows) {
202 my $password = SQLite::get("bnc", "ircid", $row->{id}, "password");
203 if (defined($password)) {
204 main::putserv($bot, "PRIVMSG $nick :Sorry, only one account per person. Please contact staff if you need help.");
208 my @emailrows = SQLite::selectrows("bnc", "email", $email);
209 foreach my $row (@userrows) {
210 my $password = SQLite::get("bnc", "ircid", $row->{id}, "password");
211 if (defined($password)) {
212 main::putserv($bot, "PRIVMSG $nick :Sorry, only one account per person. Please contact staff if you need help.");
217 # my @users = treeget($znctree, "User", "Node");
218 foreach my $user (@users) {
219 if ($user eq $username) {
220 main::putserv($bot, "PRIVMSG $nick :Sorry, username taken. Please contact staff if you need help.");
225 #my $captcha = join'', map +(0..9,'a'..'z','A'..'Z')[rand(10+26*2)], 1..4;
226 my $captcha = int(rand(999));
227 my $ircid = int(rand(9223372036854775807));
228 my $hashid = sha256_hex("$ircid");
229 SQLite::set("irc", "id", $ircid, "localtime", time());
230 SQLite::set("irc", "id", $ircid, "hashid", sha256_hex($ircid));
231 SQLite::set("irc", "id", $ircid, "date", main::date());
232 SQLite::set("irc", "id", $ircid, "hostmask", $hostmask);
233 SQLite::set("irc", "id", $ircid, "nick", $nick);
234 SQLite::set("bnc", "ircid", $ircid, "username", $username);
235 SQLite::set("bnc", "ircid", $ircid, "email", $email);
236 SQLite::set("bnc", "ircid", $ircid, "captcha", $captcha);
237 SQLite::set("bnc", "ircid", $ircid, "hashid", $hashid);
238 main::whois($bot, $nick);
239 main::ctcp($bot, $nick);
240 main::putserv($bot, "PRIVMSG $nick :".`figlet $captcha`);
241 #main::putserv($bot, "PRIVMSG $nick :https://$hostname/$hashid/captcha.png");
242 #main::putserv($bot, "PRIVMSG $nick :https://$hostname/register.php?hashirc=$hashid");
243 main::putserv($bot, "PRIVMSG $nick :Type !bnc captcha <text>");
244 foreach my $chan (@teamchans) {
245 main::putservlocalnet($bot, "PRIVMSG $chan :$nick\'s on $bot->{name} bnc captcha is $captcha");
248 main::putserv($bot, "PRIVMSG $nick :Invalid username or email. Type !bnc <username> <email> to try again.");
249 foreach my $chan (@teamchans) {
250 main::putservlocalnet($bot, "PRIVMSG $chan :$staff: Help *$nick* on network ".$bot->{name});
256 my ($bot, $nick, $host, $hand, $text) = @_;
257 if (!main::isstaff($bot, $nick)) { return; }
258 if ($text =~ /^ips?\s+([-_()|0-9A-Za-z:\.?*\s]{3,})$/) {
259 my $ips = $1; # space-separated list of IPs
260 main::putserv($bot, "PRIVMSG $nick :".regexlist($ips));
261 } elsif ($text =~ /^users?\s+([-_()|0-9A-Za-z:\.?*\s]{3,})$/) {
262 my $users = $1; # space-separated list of usernames
263 main::putserv($bot, "PRIVMSG $nick :".regexlist($users));
264 } elsif ($text =~ /^[-_()|0-9A-Za-z:,\.?*\s]{3,}$/) {
265 my @lines = regex($text);
266 foreach my $l (@lines) { print "$l\n"; }
270 my ($bot, $nick, $host, $hand, $text) = @_;
271 if ($staff !~ /$nick/) { return; }
272 if ($text =~ /^network\s+del\s+([[:graph:]]+)\s+(#[[:graph:]]+)$/) {
273 my ($user, $chan) = ($1, $2);
274 foreach my $n (@networks) {
275 main::putserv($bot, "PRIVMSG *controlpanel :delchan $user $n->{name} $chan");
281 my ($bot, $nick, $host, $hand, @args) = @_;
284 ($chan, $text) = ($args[0], $args[1]);
285 } else { $text = $args[0]; }
286 my $hostmask = "$nick!$host";
287 if($hostmask eq '*controlpanel!znc@znc.in') {
288 if ($text =~ /^Error: User \[cloneuser\] does not exist/) {
290 main::putserv($bot, "PRIVMSG *status :loadmod blockuser");
291 foreach my $chan (@teamchans) {
292 main::putserv($bot, "PRIVMSG $chan :Cloneuser created");
294 } elsif ($text =~ /^User (.*) added!$/) {
295 main::debug(ALL, "User $1 created");
296 } elsif ($text =~ /^Password has been changed!$/) {
297 main::debug(ALL, "Password changed");
298 } elsif ($text =~ /^Queued network (.*) of user (.*) for a reconnect.$/) {
299 main::debug(ALL, "$2 now connecting to $1...");
300 } elsif ($text =~ /^Admin = false/) {
301 foreach my $chan (@teamchans) {
302 main::putserv($bot, "PRIVMSG $chan :ERROR: $nick is not admin");
304 die "ERROR: $nick is not admin";
305 } elsif ($text =~ /^Admin = true/) {
306 main::debug(ALL, "$nick is ZNC admin");
307 } elsif ($text =~ /(.*) = (.*)/) {
308 my ($key, $val) = ($1, $2);
309 main::debug(ALL, "ZNC: $key => $val");
311 main::debug(ERRORS, "Unexpected 290 BNC.pm: $hostmask $text");
316 open(my $fh, '<', "$znclog") or die "Could not read file 'znc.log' $!";
317 chomp(@logs = <$fh>);
321 # return all lines matching a pattern
324 if (!@logs) { loadlog(); }
325 return grep(/$pattern/, @logs);
328 # given a list of IPs, return matching users
329 # or given a list of users, return matching IPs
332 my @items = split /[,\s]+/m, $items;
333 my $pattern = "(".join('|', @items).")";
334 if (!@logs) { loadlog(); }
335 my @matches = grep(/$pattern/, @logs);
337 foreach my $match (@matches) {
338 if ($match =~ /^\[\d{4}-\d\d-\d\d \d\d:\d\d:\d\d\] \[([^]\/]+)(\/[^]]+)?\] connected to ZNC from (.*)/) {
339 my ($user, $ip) = ($1, $3);
340 if ($items =~ /[.:]/) { # items are IP addresses
341 push(@results, $user);
342 } else { # items are users
347 my @sorted = sort @results;
348 @results = do { my %seen; grep { !$seen{$_}++ } @sorted }; # uniq
349 return join(' ', @results);
354 my $socket = $bot->{sock};
355 my $password = Hash::newpass();
357 adduser cloneuser $password
358 set Nick cloneuser cloneuser
359 set Altnick cloneuser cloneuser_
360 set Ident cloneuser cloneuser
361 set RealName cloneuser cloneuser
362 set MaxNetworks cloneuser 1000
363 set ChanBufferSize cloneuser 1000
364 set MaxQueryBuffers cloneuser 1000
365 set QueryBufferSize cloneuser 1000
366 set NoTrafficTimeout cloneuser 600
367 set QuitMsg cloneuser IRCNow and Forever!
368 set RealName cloneuser cloneuser
369 set DenySetBindHost cloneuser true
370 set Timezone cloneuser US/Pacific
371 LoadModule cloneuser controlpanel
372 LoadModule cloneuser chansaver
374 main::putserv($bot, "PRIVMSG *controlpanel :$msg");
375 foreach my $n (@networks) {
376 my $net = $n->{name};
377 my $server = $n->{server};
378 my $port = $n->{port};
379 my $trustcerts = $n->{trustcerts};
381 addnetwork cloneuser $net
382 addserver cloneuser $net $server $port
383 disconnect cloneuser $net
386 $msg .= "SetNetwork TrustAllCerts cloneuser $net True\r\n";
388 my @chans = split /[,\s]+/m, $chans;
389 foreach my $chan (@chans) {
390 $msg .= "addchan cloneuser $net $chan\r\n";
392 main::putserv($bot, "PRIVMSG *controlpanel :$msg");
397 my ($bot, $username) = @_;
398 return 1 if (main::isstaff($bot, $username));
399 if (!defined($SQLite::dbh)) { SQLite::connectdb() || die "Can't open database"; }
400 my $dbh = $SQLite::dbh;
401 my $exists = $dbh->selectrow_array(
402 "SELECT count(*) FROM BNC WHERE username = ? and password is not null",
404 ); #count will be only element in array
405 return $exists; #should be 0 if it doesnt exist
406 #XXX Need to add signaling to query znc directly.
412 my ($bot, $username, $password, $bindhost) = @_;
413 my $netname = $bot->{name};
415 cloneuser cloneuser $username
416 set Nick $username $username
417 set Altnick $username ${username}_
418 set Ident $username $username
419 set RealName $username $username
420 set Password $username $password
421 set MaxNetworks $username 1000
422 set ChanBufferSize $username 1000
423 set MaxQueryBuffers $username 1000
424 set QueryBufferSize $username 1000
425 set NoTrafficTimeout $username 600
426 set QuitMsg $username IRCNow and Forever!
427 set BindHost $username $bindhost
428 set DCCBindHost $username $bindhost
429 set DenySetBindHost $username true
430 reconnect $username $netname
432 #set Language $username en-US
433 main::putserv($bot, "PRIVMSG *controlpanel :$msg");
436 sub mailbncApproved {
437 my( $username, $email, $password)=@_;
439 Welcome to $conf{localnet}!
441 You created a bouncer:
446 Port: $sslport for SSL (secure connection)
447 Port: $plainport for plaintext
450 Connection Instructions: https://wiki.ircnow.org/?n=Bouncer.Bouncer
457 main::mail($mailfrom, $email, $mailname, "Your $conf{localnet} Bouncer", $body);
461 my( $username, $email)=@_;
463 Welcome to $conf{localnet}!
465 Your bouncer needs to be approved by staff ($staff).
466 Please reply to this email and contact them over IRC.
468 Once $staff have been contacted, they will send you login
469 instructions. This may take up to 48 hours.
474 main::mail($mailfrom, $email, $mailname, "Confirm $conf{localnet} Bouncer", $body);
478 my ($bot, $nick, $host, $hand, @args) = @_;
481 ($chan, $text) = ($args[0], $args[1]);
482 } else { $text = $args[0]; }
483 my $hostmask = "$nick!$host";
484 open(my $fh, "-|", "/usr/bin/tail", "-f", $znclog) or die "could not start tail: $!";
485 while (my $line = <$fh>) {
486 foreach my $chan (@teamchans) {
487 main::putserv($bot, "PRIVMSG $chan :$line");
493 my ($bot, $nick, $host, $hand, @args) = @_;
496 ($chan, $text) = ($args[0], $args[1]);
497 } else { $text = $args[0]; }
498 my $hostmask = "$nick!$host";
499 if (!@logs) { loadlog(); }
500 #my @users = treeget($znctree, "User", "Node");
501 foreach my $user (@users) {
502 my @lines = grep(/^\[\d{4}-\d\d-\d\d \d\d:\d\d:\d\d\] \[$user\] connected to ZNC from [.0-9a-fA-F:]+/, @logs);
503 if (scalar(@lines) == 0) {
504 foreach my $chan (@teamchans) {
505 main::putserv($bot, "PRIVMSG $chan :$user never logged in");
509 my $recent = pop(@lines);
510 if ($recent =~ /^\[(\d{4}-\d\d-\d\d) \d\d:\d\d:\d\d\] \[$user\] connected to ZNC from [.0-9a-fA-F:]+/) {
512 foreach my $chan (@teamchans) {
513 main::putserv($bot, "PRIVMSG $chan :$user $date");
519 # my ($bot, $newnick, $email) = @_;
520 # my $password = newpass();
521 # sendmsg($bot, "*controlpanel", "set Password $newnick $password");
522 # mailverify($newnick, $email, $password, "bouncer");
523 # sendmsg($bot, "$newnick", "Email sent");
526 #`doas chown znc:daemon /home/znc/home/znc/.znc/configs/znc.conf`;
528 # if ($reply =~ /^!resend ([-_0-9a-zA-Z]+) ([-_0-9a-zA-Z]+@[-_0-9a-zA-Z]+\.[-_0-9a-zA-Z]+)$/i) {
529 # my ($newnick, $email) = ($1, $2);
530 # my $password = newpass();
531 # resend($bot, $newnick, $email);
537 #AuthOnlyViaModule false
543 #31337 209.141.38.137
544 #1337 2605:6400:20:5cc::
545 #31337 2605:6400:20:5cc::
550 #alias Provides bouncer-side command alias support.
551 #autoreply Reply to queries when you are away
552 #block_motd Block the MOTD from IRC so it's not sent to your client(s).
553 #bouncedcc Bounces DCC transfers through ZNC instead of sending them directly to the user.
554 #clientnotify Notifies you when another IRC client logs into or out of your account. Configurable.
555 #ctcpflood Don't forward CTCP floods to clients
556 #dcc This module allows you to transfer files to and from ZNC
557 #perform Keeps a list of commands to be executed when ZNC connects to IRC.
558 #webadmin Web based administration module.
560 #my $zncconfpath = $conf{zncconfpath} || "$zncdir/.znc/configs/znc.conf";
561 #my $znctree = { Node => "root" };
563 #unveil("$zncconfpath", "r") or die "Unable to unveil $!";
564 #dependencies for figlet
566 #unveil("$znclog", "r") or die "Unable to unveil $!";
567 #print treeget($znctree, "AnonIPLimit")."\n";
568 #print treeget($znctree, "ServerThrottle")."\n";
569 #print treeget($znctree, "ConnectDelay")."\n";
571 #print Dumper \treeget($znctree, "User", "Node");
572 #print Dumper \treeget($znctree, "User", "Network", "Node");
573 #my @zncconf = main::readarray($zncconfpath);
575 #foreach my $line (@zncconf) {
576 # if ($line =~ /<User (.*)>/) {
580 #$znctree = parseml($znctree, @zncconf);
582 ## parseml($tree, @lines)
583 ## tree is a reference to a hash
584 ## returns hash ref of tree
586 # my ($tree, @lines) = @_;
587 # #if (scalar(@lines) == 0) { return $tree; }
588 # while (scalar(@lines) > 0) {
589 # my $line = shift(@lines);
590 # if ($line =~ /^\s*([^=<>\s]+)\s*=\s*([^=<>]+)\s*$/) {
591 # my ($tag, $val) = ($1, $2);
592 # $tree->{$tag} = $val;
593 # } elsif ($line =~ /^\/\//) { # skip comments
594 # } elsif ($line =~ /^\s*$/) { # skip blank lines
595 # } elsif ($line =~ /^\s*<([^>\s\/]+)\s*([^>\/]*)>\s*$/) {
596 # my ($tag, $val) = ($1, $2);
597 # if (!defined($tree->{$tag})) { $tree->{$tag} = []; }
599 # while (scalar(@lines) > 0) {
600 # my $line = shift(@lines);
601 # if ($line =~ /^\s*<\/$tag>\s*$/) {
602 # my $subtree = parseml({ Node => $val }, @newlines);
603 # push(@{$tree->{$tag}}, $subtree);
604 # return parseml($tree, @lines);
606 # push(@newlines, $line);
608 # } else { print "ERROR: $line\n"; }
609 # #TODO ERRORS not defined??
610 ## } else { main::debug(ERRORS, "ERROR: $line"); }
615 ##Returns array of all values
616 ##treeget($tree, "User");
618 # my ($tree, @keys) = @_;
621 # my $key = shift(@rest);
622 # $subtree = $tree->{$key};
623 # if (!defined($subtree)) {
624 # return ("Undefined");
625 # } elsif (ref($subtree) eq 'HASH') {
626 # return treeget($subtree, @rest);
627 # } elsif (ref($subtree) eq 'ARRAY') {
628 # my @array = @{$subtree};
630 # foreach my $hashref (@array) {
631 # push(@ret, treeget($hashref, @rest));
634 # #my @array = @{$subtree};
635 # #print Dumper treeget($hashref, @rest);
636 # #print Dumper treeget({$key => $subtree}, @rest);
637 # #return (treeget($hashref, @rest), treeget({$key => $subtree}, @rest));
644 1; # MUST BE LAST STATEMENT IN FILE