Return to BNC.pm CVS log

Up to [local] / botnow

Security fix: fix registration validation issue that vailed to interrupt the registration process if a username was already taken.

#!/usr/bin/perl

package BNC;

use strict;
use warnings;
use OpenBSD::Pledge;
use OpenBSD::Unveil;
use MIME::Base64;
use Digest::SHA qw(sha256_hex);
use lib './';
require "SQLite.pm";
require "Hash.pm";
require "DNS.pm";
require "Mail.pm";

my %conf = %main::conf;
my $chans = $conf{chans};
my $teamchans = $conf{teamchans};
my @teamchans = split /[,\s]+/m, $teamchans;
my $staff = $conf{staff};
my $zncdir = $conf{zncdir};
my $znclog = $conf{znclog} || "$zncdir/.znc/moddata/adminlog/znc.log";
my $hostname = $conf{hostname};
my $terms = $conf{terms};
my @logs;
my $expires = $conf{expires};
my $sslport = $conf{sslport};
my $plainport = $conf{plainport};
my $mailfrom = $conf{mailfrom};
my $mailname = $conf{mailname};
my $zncconfpath = $conf{zncconfpath} || "$zncdir/.znc/configs/znc.conf";
my $znctree = { Node => "root" };

use constant {
	NONE => 0,
	ERRORS => 1,
	WARNINGS => 2,
	ALL => 3,
};

`doas chown znc:daemon /home/znc/home/znc/.znc/configs/znc.conf`;
`doas chmod g+r /home/znc/home/znc/.znc/`;
my @zncconf = main::readarray($zncconfpath);
$znctree;
my @users;
foreach my $line (@zncconf) {
	if ($line =~ /<User (.*)>/) {
		push(@users, $1);
	}
}
#$znctree = parseml($znctree, @zncconf);
main::cbind("pub", "-", "bnc", \&mbnc);
main::cbind("msg", "-", "bnc", \&mbnc);
main::cbind("msg", "-", "regex", \&mregex);
main::cbind("msg", "-", "foreach", \&mforeach);
main::cbind("msgm", "-", "*", \&mcontrolpanel);
main::cbind("msg", "-", "taillog", \&mtaillog);
main::cbind("msg", "-", "lastseen", \&mlastseen);

sub init {
	#znc.conf file
	unveil("$zncconfpath", "r") or die "Unable to unveil $!";
	#dependencies for figlet
	unveil("/usr/local/bin/figlet", "rx") or die "Unable to unveil $!";
	unveil("/usr/lib/libc.so.95.1", "r") or die "Unable to unveil $!";
	unveil("/usr/libexec/ld.so", "r") or die "Unable to unveil $!";
	unveil("/usr/bin/tail", "rx") or die "Unable to unveil $!";
	#znc.log file
	unveil("$znclog", "r") or die "Unable to unveil $!";
	#print treeget($znctree, "AnonIPLimit")."\n";
	#print treeget($znctree, "ServerThrottle")."\n";
	#print treeget($znctree, "ConnectDelay")."\n";
	#print "treeget\n";
	#print Dumper \treeget($znctree, "User", "Node");
	#print Dumper \treeget($znctree, "User", "Network", "Node");
}

# parseml($tree, @lines)
# tree is a reference to a hash
# returns hash ref of tree
sub parseml {
	my ($tree, @lines) = @_;
	#if (scalar(@lines) == 0) { return $tree; }
	while (scalar(@lines) > 0) {
		my $line = shift(@lines);
		if ($line =~ /^\s*([^=<>\s]+)\s*=\s*([^=<>]+)\s*$/) {
			my ($tag, $val) = ($1, $2); 
			$tree->{$tag} = $val;
		} elsif ($line =~ /^\/\//) { # skip comments
		} elsif ($line =~ /^\s*$/) { # skip blank lines
		} elsif ($line =~ /^\s*<([^>\s\/]+)\s*([^>\/]*)>\s*$/) {
			my ($tag, $val) = ($1, $2); 
			if (!defined($tree->{$tag})) { $tree->{$tag} = []; }
			my @newlines;
			while (scalar(@lines) > 0) {
				my $line = shift(@lines);
				if ($line =~ /^\s*<\/$tag>\s*$/) {
					my $subtree = parseml({ Node => $val }, @newlines);
					push(@{$tree->{$tag}}, $subtree);
					return parseml($tree, @lines);
				}
				push(@newlines, $line);
			}
		} else { print "ERROR: $line\n"; }
		#TODO ERRORS not defined??
#		} else { main::debug(ERRORS, "ERROR: $line"); }
	}
	return $tree;
}

#Returns array of all values
#treeget($tree, "User");
#treeget($tree, "MaFFia Network");
sub treeget {
	my ($tree, @keys) = @_;
	my $subtree;
	my @rest = @keys;
	my $key = shift(@rest);
	$subtree = $tree->{$key};
	if (!defined($subtree)) {
		return ("Undefined");
	} elsif (ref($subtree) eq 'HASH') {
		return treeget($subtree, @rest);
	} elsif (ref($subtree) eq 'ARRAY') {
		my @array = @{$subtree};
		my @ret;
		foreach my $hashref (@array) {
			push(@ret, treeget($hashref, @rest));
		}
		return @ret;
		#my @array = @{$subtree};
		#print Dumper treeget($hashref, @rest);
		#print Dumper treeget({$key => $subtree}, @rest);
		#return (treeget($hashref, @rest), treeget({$key => $subtree}, @rest));
	} else {
		return ($subtree);
	}
}

sub mbnc {
	my ($bot, $nick, $host, $hand, @args) = @_;
	my ($chan, $text);
	if (@args == 2) {
		($chan, $text) = ($args[0], $args[1]);
	} else { $text = $args[0]; }
	my $hostmask = "$nick!$host";
	if (defined($chan) && $chans =~ /$chan/) {
		main::putserv($bot, "PRIVMSG $chan :$nick: Please check private message");
	}
	if ($text =~ /^$/) {
		main::putserv($bot, "PRIVMSG $nick :Type !help for new instructions");
		foreach my $chan (@teamchans) {
			main::putservlocalnet($bot, "PRIVMSG $chan :Help *$nick* on ".$bot->{name});
		}
		return;
	} elsif (main::isstaff($bot, $nick) && $text =~ /^delete\s+([[:ascii:]]+)/) {
		my $username = $1;
		if (SQLite::deleterows("bnc", "username", $username)) {
			main::putserv($bot, "PRIVMSG *controlpanel :deluser $username");
			foreach my $chan (@teamchans) {
				main::putserv($bot, "PRIVMSG $chan :$username deleted");
			}
		}
		return;
	} elsif ($staff =~ /$nick/ && $text =~ /^cloneuser$/i) {
		main::putserv($bot, "PRIVMSG *controlpanel :deluser cloneuser");
		sleep 3;
		main::putserv($bot, "PRIVMSG *controlpanel :get Nick cloneuser");
	}
	### TODO: Check duplicate emails ###
	my @rows = SQLite::selectrows("irc", "hostmask", $hostmask);
	foreach my $row (@rows) {
		my $password = SQLite::get("bnc", "ircid", $row->{id}, "password");
		if (defined($password)) {
			main::putserv($bot, "PRIVMSG $nick :Sorry, only one account per person. Please contact staff if you need help.");
			return;
		}
	}
	if ($text =~ /^captcha\s+([[:alnum:]]+)/) {
		my $text = $1;
		# TODO avoid using host mask because cloaking can cause problems
		my $ircid = SQLite::id("irc", "nick", $nick, $expires);
		my $captcha = SQLite::get("bnc", "ircid", $ircid, "captcha");
		if ($text ne $captcha) {
			main::putserv($bot, "PRIVMSG $nick :Wrong captcha. To get a new captcha, type !bnc <username> <email>");
			return;
		}
		my $pass = Hash::newpass();
		chomp(my $encrypted = `encrypt $pass`);
		my $username = SQLite::get("bnc", "ircid", $ircid, "username");
		my $email = SQLite::get("bnc", "ircid", $ircid, "email");
		my $hashirc = SQLite::get("irc", "id", $ircid, "hashid");
		my $bindhost = "$username.$hostname";
		SQLite::set("bnc", "ircid", $ircid, "password", $encrypted);
		if (DNS::nextdns($username)) {
			sleep(2);
			createbnc($bot, $username, $pass, $bindhost);
			main::putserv($bot, "PRIVMSG $nick :Check your email!");
			mailbnc($username, $email, $pass, "bouncer", $hashirc);
			#www($newnick, $reply, $password, "bouncer");
		} else {
			foreach my $chan (@teamchans) {
				main::putserv($bot, "PRIVMSG $chan :Assigning bindhost $bindhost failed");
			}
		}
		return;
	} elsif ($text =~ /^([[:alnum:]]+)\s+([[:ascii:]]+)/) {
		my ($username, $email) = ($1, $2);
#		my @users = treeget($znctree, "User", "Node");
		foreach my $user (@users) {
			if ($user eq $username) {
				main::putserv($bot, "PRIVMSG $nick :Sorry, username taken. Please contact staff if you need help.");
				return;
			}
		}
		#my $captcha = join'', map +(0..9,'a'..'z','A'..'Z')[rand(10+26*2)], 1..4;
		my $captcha = int(rand(999));
		my $ircid = int(rand(9223372036854775807));
		my $hashid = sha256_hex("$ircid");
		SQLite::set("irc", "id", $ircid, "localtime", time());
		SQLite::set("irc", "id", $ircid, "hashid", sha256_hex($ircid));
		SQLite::set("irc", "id", $ircid, "date", main::date());
		SQLite::set("irc", "id", $ircid, "hostmask", $hostmask);
		SQLite::set("irc", "id", $ircid, "nick", $nick);
		SQLite::set("bnc", "ircid", $ircid, "username", $username);
		SQLite::set("bnc", "ircid", $ircid, "email", $email);
		SQLite::set("bnc", "ircid", $ircid, "captcha", $captcha);
		SQLite::set("bnc", "ircid", $ircid, "hashid", $hashid);
		main::whois($bot->{sock}, $nick);
		main::ctcp($bot->{sock}, $nick);
		main::putserv($bot, "PRIVMSG $nick :".`figlet $captcha`);
		main::putserv($bot, "PRIVMSG $nick :https://$hostname/$hashid/captcha.png");
		main::putserv($bot, "PRIVMSG $nick :https://$hostname/register.php?hashirc=$hashid");
		main::putserv($bot, "PRIVMSG $nick :Type !bnc captcha <text>");
		foreach my $chan (@teamchans) {
			main::putservlocalnet($bot, "PRIVMSG $chan :$nick\'s on $bot->{name} bnc captcha is $captcha");
		}
	} else {
		main::putserv($bot, "PRIVMSG $nick :Invalid username or email. Type !bnc <username> <email> to try again.");
		foreach my $chan (@teamchans) {
			main::putservlocalnet($bot, "PRIVMSG $chan :Help *$nick* on ".$bot->{name});
		}
	}
}

sub mregex {
	my ($bot, $nick, $host, $hand, $text) = @_;
	if (!main::isstaff($bot, $nick)) { return; }
	if ($text =~ /^ips?\s+([-_()|0-9A-Za-z:\.?*\s]{3,})$/) {
		my $ips = $1; # space-separated list of IPs
		main::putserv($bot, "PRIVMSG $nick :".regexlist($ips));
	} elsif ($text =~ /^users?\s+([-_()|0-9A-Za-z:\.?*\s]{3,})$/) {
		my $users = $1; # space-separated list of usernames
		main::putserv($bot, "PRIVMSG $nick :".regexlist($users));
	} elsif ($text =~ /^[-_()|0-9A-Za-z:,\.?*\s]{3,}$/) {
		my @lines = regex($text);
		foreach my $l (@lines) { print "$l\n"; }
	}
}
sub mforeach {
	my ($bot, $nick, $host, $hand, $text) = @_;
	if ($staff !~ /$nick/) { return; }
	if ($text =~ /^network\s+del\s+([[:graph:]]+)\s+(#[[:graph:]]+)$/) {
		my ($user, $chan) = ($1, $2);
		foreach my $n (@main::networks) {
			main::putserv($bot, "PRIVMSG *controlpanel :delchan $user $n->{name} $chan");
		}
	}
}

sub mcontrolpanel {
	my ($bot, $nick, $host, $hand, @args) = @_;
	my ($chan, $text);
	if (@args == 2) {
		($chan, $text) = ($args[0], $args[1]);
	} else { $text = $args[0]; }
	my $hostmask = "$nick!$host";
	if($hostmask eq '*controlpanel!znc@znc.in') {
		if ($text =~ /^Error: User \[cloneuser\] does not exist/) {
			createclone($bot);
			foreach my $chan (@teamchans) {
				main::putserv($bot, "PRIVMSG $chan :Cloneuser created");
			}
		} elsif ($text =~ /^User (.*) added!$/) {
			main::debug(ALL, "User $1 created");
		} elsif ($text =~ /^Password has been changed!$/) {
			main::debug(ALL, "Password changed");
		} elsif ($text =~ /^Queued network (.*) of user (.*) for a reconnect.$/) {
			main::debug(ALL, "$2 now connecting to $1...");
		} elsif ($text =~ /^Admin = false/) {
			foreach my $chan (@teamchans) {
				main::putserv($bot, "PRIVMSG $chan :ERROR: $nick is not admin");
			}
			die "ERROR: $nick is not admin";
		} elsif ($text =~ /^Admin = true/) {
			main::debug(ALL, "$nick is ZNC admin");
		} elsif ($text =~ /(.*) = (.*)/) {
			my ($key, $val) = ($1, $2);
			main::debug(ALL, "ZNC: $key => $val");
		} else {
			main::debug(ERRORS, "Unexpected 290 BNC.pm: $hostmask $text");
		}
	}
}
sub loadlog {
	open(my $fh, '<', "$znclog") or die "Could not read file 'znc.log' $!";
	chomp(@logs = <$fh>);
	close $fh;
}

# return all lines matching a pattern
sub regex {
	my ($pattern) = @_;
	if (!@logs) { loadlog(); }
	return grep(/$pattern/, @logs);
}

# given a list of IPs, return matching users
# or given a list of users, return matching IPs
sub regexlist {
	my ($items) = @_;
	my @items = split /[,\s]+/m, $items;
	my $pattern = "(".join('|', @items).")";
	if (!@logs) { loadlog(); }
	my @matches = grep(/$pattern/, @logs);
	my @results;
	foreach my $match (@matches) {
		if ($match =~ /^\[\d{4}-\d\d-\d\d \d\d:\d\d:\d\d\] \[([^]\/]+)(\/[^]]+)?\] connected to ZNC from (.*)/) {
			my ($user, $ip) = ($1, $3);
			if ($items =~ /[.:]/) { # items are IP addresses
				push(@results, $user);
			} else { # items are users
				push(@results, $ip);
			}
		}
	}
	my @sorted = sort @results;
	@results = do { my %seen; grep { !$seen{$_}++ } @sorted }; # uniq
	return join(' ', @results);
}

sub createclone {
	my ($bot) = @_;
	my $socket = $bot->{sock};
	my $password = Hash::newpass();
	my $msg = <<"EOF";
adduser cloneuser $password
set Nick cloneuser cloneuser
set Altnick cloneuser cloneuser_
set Ident cloneuser cloneuser
set RealName cloneuser cloneuser
set MaxNetworks cloneuser 1000
set ChanBufferSize cloneuser 1000
set MaxQueryBuffers cloneuser 1000
set QueryBufferSize cloneuser 1000
set NoTrafficTimeout cloneuser 600
set QuitMsg cloneuser IRCNow and Forever!
set RealName cloneuser cloneuser
set DenySetBindHost cloneuser true
set Timezone cloneuser US/Pacific
LoadModule cloneuser controlpanel
LoadModule cloneuser chansaver
EOF
#LoadModule cloneuser buffextras
	main::putserv($bot, "PRIVMSG *controlpanel :$msg");
	foreach my $n (@main::networks) {
		my $net = $n->{name};
		my $server = $n->{server};
		my $port = $n->{port};
		my $trustcerts = $n->{trustcerts};
		$msg = <<"EOF";
addnetwork cloneuser $net
addserver cloneuser $net $server $port
disconnect cloneuser $net
EOF
		if ($trustcerts) {
			$msg .= "SetNetwork TrustAllCerts cloneuser $net True\r\n";
		}
		my @chans = split /[,\s]+/m, $chans;
		foreach my $chan (@chans) {
			$msg .= "addchan cloneuser $net $chan\r\n";
		}
		main::putserv($bot, "PRIVMSG *controlpanel :$msg");
	}
}

sub createbnc {
	my ($bot, $username, $password, $bindhost) = @_;
	my $netname = $bot->{name};
	my $msg = <<"EOF";
cloneuser cloneuser $username
set Nick $username $username
set Altnick $username ${username}_
set Ident $username $username
set RealName $username $username
set Password $username $password
set MaxNetworks $username 1000
set ChanBufferSize $username 1000
set MaxQueryBuffers $username 1000
set QueryBufferSize $username 1000
set NoTrafficTimeout $username 600
set QuitMsg $username IRCNow and Forever!
set BindHost $username $bindhost
set DCCBindHost $username $bindhost
set DenySetBindHost $username true
reconnect $username $netname
EOF
#set Language $username en-US
	main::putserv($bot, "PRIVMSG *controlpanel :$msg");
	return 1;
}
sub mailbnc {
	my( $username, $email, $password, $service, $hashirc )=@_;
	my $passhash = sha256_hex("$username");

my $body = <<"EOF";
You created a bouncer!

Username: $username
Password: $password
Server: $hostname
Port: $sslport for SSL (secure connection)
Port: $plainport for plaintext

*IMPORTANT*: Verify your email address:

https://$hostname/register.php?hashirc=$hashirc

You *MUST* click on the link or your account will be deleted.

IRCNow
EOF
	Mail::mail($mailfrom, $email, $mailname, "Verify IRCNow Account", $body);
}

sub mtaillog {
	my ($bot, $nick, $host, $hand, @args) = @_;
	my ($chan, $text);
	if (@args == 2) {
		($chan, $text) = ($args[0], $args[1]);
	} else { $text = $args[0]; }
	my $hostmask = "$nick!$host";
	open(my $fh, "-|", "/usr/bin/tail", "-f", $znclog) or die "could not start tail: $!";
	while (my $line = <$fh>) {
		foreach my $chan (@teamchans) {
			main::putserv($bot, "PRIVMSG $chan :$line");
		}
	}
}

sub mlastseen {
	my ($bot, $nick, $host, $hand, @args) = @_;
	my ($chan, $text);
	if (@args == 2) {
		($chan, $text) = ($args[0], $args[1]);
	} else { $text = $args[0]; }
	my $hostmask = "$nick!$host";
	if (!@logs) { loadlog(); }
	my @users = treeget($znctree, "User", "Node");
	foreach my $user (@users) {
		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);
		if (scalar(@lines) == 0) {
			foreach my $chan (@teamchans) {
				main::putserv($bot, "PRIVMSG $chan :$user never logged in");
			}
			next;
		}
		my $recent = pop(@lines);
		if ($recent =~ /^\[(\d{4}-\d\d-\d\d) \d\d:\d\d:\d\d\] \[$user\] connected to ZNC from [.0-9a-fA-F:]+/) {
			my $date = $1;
			foreach my $chan (@teamchans) {
				main::putserv($bot, "PRIVMSG $chan :$user $date");
			}
		}
	}
}
#sub resend {
#	my ($bot, $newnick, $email) = @_;
#	my $password = newpass();
#	sendmsg($bot, "*controlpanel", "set Password $newnick $password");
#	mailverify($newnick, $email, $password, "bouncer");
#	sendmsg($bot, "$newnick", "Email sent");
#}

#	if ($reply =~ /^!resend ([-_0-9a-zA-Z]+) ([-_0-9a-zA-Z]+@[-_0-9a-zA-Z]+\.[-_0-9a-zA-Z]+)$/i) {
#		my ($newnick, $email) = ($1, $2);
#		my $password = newpass();
#		resend($bot, $newnick, $email);
#	}

#sub resetznc {
#
#AnonIPLimit 10000
#AuthOnlyViaModule false
#ConnectDelay 0
#HideVersion true
#LoadModule
#ServerThrottle
#1337  209.141.38.137  
#31337  209.141.38.137  
#1337  2605:6400:20:5cc::  
#31337  2605:6400:20:5cc::  
#1337  127.0.0.1  
#1338  127.0.0.1  
#}
#
#alias   Provides bouncer-side command alias support.   
#autoreply   Reply to queries when you are away   
#block_motd   Block the MOTD from IRC so it's not sent to your client(s).   
#bouncedcc   Bounces DCC transfers through ZNC instead of sending them directly to the user.   
#clientnotify   Notifies you when another IRC client logs into or out of your account. Configurable.   
#ctcpflood   Don't forward CTCP floods to clients   
#dcc   This module allows you to transfer files to and from ZNC   
#perform   Keeps a list of commands to be executed when ZNC connects to IRC.   
#webadmin   Web based administration module.   


1; # MUST BE LAST STATEMENT IN FILE