#!/usr/bin/perl

package BNC;

use strict;
use warnings;
use OpenBSD::Pledge;
use OpenBSD::Unveil;
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 $approval = $conf{approval};
my $webpanel = $conf{webpanel};
# File containing IRC networks
my $netpath = "networks";
my @networks;

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

`doas chmod g+r /home/znc/home/znc/.znc/`;
my @users;
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 {
	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 $!";
	unveil("$netpath", "r") or die "Unable to unveil $!";
	
	@networks = readnetworks($netpath);
	
	# networks must be sorted to avoid multiple connections
	@networks = sort @networks;
}

# Return list of networks from filename
# To add multiple servers for a single network, simply create a new entry with
# the same net name; znc ignores addnetwork commands when a network already exists
sub readnetworks {
	my ($filename) = @_;
	my @lines = main::readarray($filename);
	my @networks;
	foreach my $line (@lines) {
		if ($line =~ /^#/ or $line =~ /^\s*$/) { # skip comments and whitespace
			next;
		} elsif ($line =~ /^\s*([-a-zA-Z0-9]+)\s*([-_.:a-zA-Z0-9]+)\s*(~|\+)?([0-9]+)\s*$/) {
			my ($name, $server, $port) = ($1, $2, $4);
			my $trustcerts;
			if (!defined($3)) {
				$trustcerts = 0;
			} elsif ($3 eq "~") { # Use SSL but trust all certs
				$port = "+".$port;
				$trustcerts = 1;
			} else { # Use SSL and verify certs
				$port = "+".$port;
				$trustcerts = 0;
			}
			push(@networks, {"name" => $name, "server" => $server, "port" => $port, "trustcerts" => $trustcerts });
		} else {
			die "network format invalid: $line\n";
		}
	}
	return @networks;
}

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 :$staff: Help *$nick* on network ".$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 (main::isstaff($bot, $nick) && $text =~ /^approve\s+([[:ascii:]]+)/) {
		my $username = $1;
		main::putserv($bot, "PRIVMSG *blockuser :unblock $username");
		foreach my $chan (@teamchans) {
			main::putserv($bot, "PRIVMSG $chan :$username bnc approved");
		}
		return;
	} elsif ($staff =~ /$nick/ && $text =~ /^cloneuser$/i) {
		main::putserv($bot, "PRIVMSG *controlpanel :deluser cloneuser");
		sleep 3;
		main::putserv($bot, "PRIVMSG *controlpanel :get Nick cloneuser");
	}
	### Check duplicate hostmasks ###
	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);
			if ($approval eq "true") {
				main::putserv($bot, "PRIVMSG *blockuser :block $username");
				main::putserv($bot, "PRIVMSG $nick :Your account has been created but must be manually approved by your admins ($staff) before it can be used.");
				foreach my $chan (@teamchans) {
					main::putservlocalnet($bot, "PRIVMSG $chan :$staff: $nick\'s account $username must be manually unblocked before it can be used.");
				}
			}
			foreach my $chan (@teamchans) {
				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");
			}
			#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 @userrows = SQLite::selectrows("bnc", "username", $username);
		foreach my $row (@userrows) {
			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;
			}
		}
		my @emailrows = SQLite::selectrows("bnc", "email", $email);
		foreach my $row (@userrows) {
			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;
			}
		}

#		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 :$staff: Help *$nick* on network ".$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 (@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);
			main::putserv($bot, "PRIVMSG *status :loadmod blockuser");
			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
	main::putserv($bot, "PRIVMSG *controlpanel :$msg");
	foreach my $n (@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 $approvemsg;
	if ($approval eq "true") {
		$approvemsg = <<"EOF";

*IMPORTANT*: Your account has been created but it has not yet been
approved. To get your account approved, please contact your admins
$staff on IRC and by email.

EOF
	}

my $body = <<"EOF";
Welcome to IRCNow!

You created a bouncer:

Username: $username
Password: $password
Server: $hostname
Port: $sslport for SSL (secure connection)
Port: $plainport for plaintext
Webpanel: $webpanel
$approvemsg
*IMPORTANT*: Verify your email address:

Please reply to this email to indicate you have received the email. You must
reply in order to keep your account.

IRCNow
EOF
	main::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");
#}

#`doas chown znc:daemon /home/znc/home/znc/.znc/configs/znc.conf`;

#	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.   

#my $zncconfpath = $conf{zncconfpath} || "$zncdir/.znc/configs/znc.conf";
#my $znctree = { Node => "root" };
	#znc.conf file
	#unveil("$zncconfpath", "r") or die "Unable to unveil $!";
	#dependencies for figlet
	#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");
#my @zncconf = main::readarray($zncconfpath);
#$znctree;
#foreach my $line (@zncconf) {
#	if ($line =~ /<User (.*)>/) {
#		push(@users, $1);
#	}
#}
#$znctree = parseml($znctree, @zncconf);

	## 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");
	#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);
	#	}
	#}


1; # MUST BE LAST STATEMENT IN FILE