commit - b0ff9f00cb48f1f107ef15b2abd6ebcfe96b66e0
commit + 0ae44377fd82cf39b704f260ce33e4358bf816cb
blob - b6261c931f0996160a00ccdfabe32d8647524398
blob + 0ce4bd5a3db94af58bfa0f7f81985b8a8305c540
--- .gitignore
+++ .gitignore
.*~
+*~
blob - f488f2aab7fb9f9347d94a26ba03eb4cdcaf071c (mode 644)
blob + /dev/null
--- BNC.pm
+++ /dev/null
-#!/usr/bin/perl
-
-package BNC;
-
-use strict;
-use warnings;
-use OpenBSD::Pledge;
-use OpenBSD::Unveil;
-use Digest::SHA qw(sha256_hex);
-use IRCNOW::IO qw(readarray);
-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 $bnchostname = $conf{bnchostnome};
-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 = 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;
- if (SQLite::selectrows("bnc", "username", $username)) {
- main::putserv($bot, "PRIVMSG *blockuser :unblock $username");
- foreach my $chan (@teamchans) {
- main::putserv($bot, "PRIVMSG $chan :$username bnc approved");
- }
- } else {
- main::putserv($bot, "PRIVMSG $chan :$username hasn't requested a bnc account");
- }
- 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: $bnchostname
-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 = 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
blob - 1685f617ad80fac4399878937024c98749fea2f6 (mode 644)
blob + /dev/null
--- DNS.pm
+++ /dev/null
-#!/usr/bin/perl
-
-package DNS;
-
-use strict;
-use warnings;
-use OpenBSD::Pledge;
-use OpenBSD::Unveil;
-use IRCNOW::IO qw(readarray writefile appendfile);
-
-use File::Copy qw(copy);
-
-my %conf = %main::conf;
-my $chans = $conf{chans};
-my $staff = $conf{staff};
-my $key = $conf{key};
-my $hash = $conf{hash};
-my $hostname = $conf{hostname};
-my $verbose = $conf{verbose};
-my $ip4 = $conf{ip4};
-my $ip6 = $conf{ip6};
-my $ip6subnet = $conf{ip6subnet};
-my $zonedir = $conf{zonedir};
-my $hostnameif = $conf{hostnameif};
-if (host($hostname) =~ /(\d+\.){3,}\d+/) {
- $ip4 = $&;
-}
-main::cbind("msg", "-", "setrdns", \&msetrdns);
-main::cbind("msg", "-", "delrdns", \&mdelrdns);
-main::cbind("msg", "-", "setdns", \&msetdns);
-main::cbind("msg", "-", "deldns", \&mdeldns);
-main::cbind("msg", "-", "host", \&mhost);
-main::cbind("msg", "-", "nextdns", \&mnextdns);
-main::cbind("msg", "-", "readip6s", \&mreadip6s);
-
-sub init {
- unveil("$zonedir", "rwc") or die "Unable to unveil $!";
- unveil("/usr/bin/doas", "rx") or die "Unable to unveil $!";
- unveil("/usr/bin/host", "rx") or die "Unable to unveil $!";
- unveil("$hostnameif", "rwc") or die "Unable to unveil $!";
-}
-
-# !setrdns 2001:bd8:: username.example.com
-sub msetrdns {
- my ($bot, $nick, $host, $hand, $text) = @_;
- if (! (main::isstaff($bot, $nick))) { return; }
- if ($text =~ /^([0-9A-Fa-f:\.]{3,})\s+([-0-9A-Za-z\.]+)$/) {
- my ($ip, $hostname) = ($1, $2);
- if (setrdns($ip, $ip6subnet, $hostname)) {
- main::putserv($bot, "PRIVMSG $nick :$hostname set to $ip");
- } else {
- main::putserv($bot, "PRIVMSG $nick :ERROR: failed to set rDNS");
- }
- }
-}
-
-# !delrdns 2001:bd8::
-sub mdelrdns {
- my ($bot, $nick, $host, $hand, $text) = @_;
- if (! (main::isstaff($bot, $nick))) { return; }
- if ($text =~ /^([0-9A-Fa-f:\.]{3,})$/) {
- my ($ip) = ($1);
- if (delrdns($ip, $ip6subnet)) {
- main::putserv($bot, "PRIVMSG $nick :$ip rDNS deleted");
- } else {
- main::putserv($bot, "PRIVMSG $nick :ERROR: failed to set rDNS");
- }
- }
-}
-# !setdns username 1.2.3.4
-sub msetdns {
- my ($bot, $nick, $host, $hand, $text) = @_;
- if (! (main::isstaff($bot, $nick))) { return; }
- if ($text =~ /^([-0-9A-Za-z\.]+)\s+([0-9A-Fa-f:\.]+)/) {
- my ($name, $value) = ($1, $2);
- if ($value =~ /:/ and setdns($name, $hostname, "AAAA", $value)) {
- main::putserv($bot, "PRIVMSG $nick :$name.$hostname AAAA set to $value");
- } elsif (setdns($name, $hostname, "A", $value)) {
- main::putserv($bot, "PRIVMSG $nick :$name.$hostname A set to $value");
- } else {
- main::putserv($bot, "PRIVMSG $nick :ERROR: failed to set DNS");
- }
- }
-}
-
-# !deldns username
-sub mdeldns {
- my ($bot, $nick, $host, $hand, $text) = @_;
- if (! (main::isstaff($bot, $nick))) { return; }
- if ($text =~ /^([-0-9A-Za-z\.]+)$/) {
- my ($name) = ($1);
- if (setdns($name, $hostname)) {
- main::putserv($bot, "PRIVMSG $nick :$text deleted");
- } else {
- main::putserv($bot, "PRIVMSG $nick :ERROR: failed to delete DNS records");
- }
- }
-}
-
-# !host username
-sub mhost {
- my ($bot, $nick, $host, $hand, $text) = @_;
- if (! (main::isstaff($bot, $nick))) { return; }
- if ($text =~ /^([-0-9A-Za-z:\.]{3,})/) {
- my ($hostname) = ($1);
- main::putserv($bot, "PRIVMSG $nick :".host($hostname));
- }
-}
-
-# !nextdns username
-sub mnextdns {
- my ($bot, $nick, $host, $hand, $text) = @_;
- if (! (main::isstaff($bot, $nick))) { return; }
- if ($text =~ /^([-0-9a-zA-Z]+)/) {
- main::putserv($bot, "PRIVMSG $nick :$text set to ".nextdns($text));
- }
-}
-
-# !readip6s
-sub mreadip6s {
- my ($bot, $nick, $host, $hand, $text) = @_;
- if (! (main::isstaff($bot, $nick))) { return; }
- foreach my $line (readip6s($hostnameif)) {
- print "$line\n"
- }
-}
-
-# Return list of ipv6 addresses from filename
-sub readip6s {
- my ($filename) = @_;
- my @lines = readarray($filename);
- my @ipv6s;
- foreach my $line (@lines) {
- if ($line =~ /^\s*inet6\s+(alias\s+)?([0-9a-f:]{4,})\s+[0-9]+\s*$/i) {
- push(@ipv6s, $2);
- } elsif ($line =~ /^\s*([0-9a-f:]{4,})\s*$/i) {
- push(@ipv6s, $1);
- }
- }
- return @ipv6s;
-}
-
-# set rdns of $ip6 to $hostname given $subnet
-# return true on success; false on failure
-sub setrdns {
- my ($ip6, $subnet, $hostname) = @_;
- my $digits = ip6full($ip6);
- $digits =~ tr/://d;
- my $reversed = reverse($digits);
- my $origin = substr($reversed, 32-$subnet/4);
- $origin = join('.', split(//, $origin)).".ip6.arpa";
- my $name = substr($reversed, 0, 32-$subnet/4);
- $name = join('.', split(//, $name));
- # delete old PTR records, then set new one
- return setdns($name, $origin) && setdns($name, $origin, "PTR", $hostname.".");
-}
-# delete rdns of $ip6 given $subnet
-# return true on success; false on failure
-sub delrdns {
- my ($ip6, $subnet) = @_;
- return setrdns($ip6, $subnet);
-}
-
-# given $origin. create $name RR of $type and set to $value if provided;
-# if $value is missing, delete $domain
-# returns true upon success, false upon failure
-sub setdns {
- my ($name, $origin, $type, $value) = @_;
- my $filename = "$zonedir/$origin";
- my @lines = readarray($filename);
- foreach my $line (@lines) {
- # increment the zone's serial number
- if ($line =~ /(\d{8})(\d{2})((\s+\d+){4}\s*\))/) {
- my $date = main::date();
- my $serial = 0;
- if ($date <= $1) { $serial = $2+1; }
- $line = $`.$date.sprintf("%02d",$serial).$3.$';
- }
- }
- if (!defined($value)) { # delete records
- @lines = grep !/\b$name\s*3600\s*IN/, @lines;
- } else {
- push(@lines, "$name 3600 IN $type $value");
- }
- # trailing newline necessary
- writefile("$filename.bak", join("\n", @lines)."\n");
- copy "$filename.bak", $filename;
- if (system("doas -u _nsd nsd-control reload")) {
- return 0;
- } else {
- return 1;
- }
-}
-
-# given hostname, return IP addresses; or given IP address, return hostname
-sub host {
- my ($name) = @_;
- my @matches;
- my @lines = split /\n/m, `host $name`;
- if ($name =~ /^[0-9\.]+$/ or $name =~ /:/) { # IP address
- foreach my $line (@lines) {
- if ($line =~ /([\d\.]+).(in-addr|ip6).arpa domain name pointer (.*)/) {
- push(@matches, $3);
- }
- }
- } else { # hostname
- foreach my $line (@lines) {
- if ($line =~ /$name has (IPv6 )?address ([0-9a-fA-F\.:]+)/) {
- push(@matches, $2);
- }
- }
- }
- return join(' ', @matches);
-}
-
-# Return an ipv6 address with all zeroes filled in
-sub ip6full {
- my ($ip6) = @_;
- my $left = substr($ip6, 0, index($ip6, "::"));
- my $leftcolons = ($left =~ tr/://);
- $ip6 =~ s{::}{:};
- my @quartets = split(':', $ip6);
- my $length = scalar(@quartets);
- for (my $n = 1; $n <= 8 - $length; $n++) {
- splice(@quartets, $leftcolons+1, 0, "0000");
- }
- my @newquartets = map(sprintf('%04s', $_), @quartets);
- my $full = join(':',@newquartets);
- return $full;
-}
-# Returns the network part of the first IPv6 address (indicated by subnet)
-# with the host part of the second IPv6 address
-sub ip6mask {
- my ($ip6net, $subnet, $ip6host) = @_;
- my $netdigits = ip6full($ip6net);
- $netdigits =~ tr/://d;
- my $hostdigits = ip6full($ip6host);
- $hostdigits =~ tr/://d;
- my $digits = substr($netdigits,0,($subnet/4)).substr($hostdigits,($subnet/4));
- my $ip6;
- for (my $n = 0; $n < 32; $n++) {
- if ($n > 0 && $n % 4 == 0) {
- $ip6 .= ":";
- }
- $ip6 .= substr($digits,$n,1);
- }
- return $ip6;
-}
-sub randip6 {
- return join ':', map { sprintf '%04x', rand 0x10000 } (1 .. 8);
-}
-
-# create A and AAAA records for subdomain, set the rDNS,
-# and return the new ipv6 address
-sub nextdns {
- my ($subdomain) = @_;
- my $newip6 = $ip6;
- my @allip6s = readip6s($hostnameif);
- while (grep(/$newip6/, @allip6s)) {
- $newip6 = ip6mask($ip6, $ip6subnet,randip6());
- }
- appendfile($hostnameif, "inet6 alias $newip6 48\n");
- `doas ifconfig vio0 inet6 $newip6/48`;
- if (setdns($subdomain, $hostname, "A", $ip4) && setdns($subdomain, $hostname, "AAAA", $newip6) && setrdns($newip6, $ip6subnet, "$subdomain.$hostname")) {
- return "$newip6";
- }
- return "false";
-}
-
-1; # MUST BE LAST STATEMENT IN FILE
blob - e9bbdfa1c63860ea5068cfd1e72ee0ea957b3468 (mode 644)
blob + /dev/null
--- Hash.pm
+++ /dev/null
-#!/usr/bin/perl
-
-package Hash;
-
-use strict;
-use warnings;
-use OpenBSD::Pledge;
-use OpenBSD::Unveil;
-
-use IRCNOW::IO qw(readarray);
-
-
-use Data::Dumper;
-
-my %conf = %main::conf;
-my @words;
-my $wordspath = "words";
-my $passlength = $conf{passlength};
-# dictionary words for passwords
-@words = readarray("words");
-
-sub init {
- unveil($wordspath, "r") or die "Unable to unveil $!";
-}
-
-sub newpass {
- my $len = scalar @words;
- my $pass;
- for (my $i=0; $i < $passlength; $i++) {
- my $word = $words[int(rand($len))];
- $word =~ s/(\w+)/\u$1/g;
- $pass .= $word;
- }
- return $pass;
-}
-#dependencies for blowfish
-#unveil("./blowfish.o", "rx") or die "Unable to unveil $!";
-# } elsif ($reply =~ /^!identify\s*(.*)?\s+(.*)$/i) {
-# my $hash = getkeyval($hostmask, "password");
-# #print "result = ".`./blowfish.o $2 '$hash'`;
-# if(system("./blowfish.o $2 '$hash' > /dev/null")) {
-# print "login failed\r\n";
-# } else {
-# print "logged in\r\n";
-# }
-
-
-1; # MUST BE LAST STATEMENT IN FILE
blob - be3c6aec6cf5715734ac15fd026dfe8fedc66a00 (mode 644)
blob + /dev/null
--- Help.pm
+++ /dev/null
-#!/usr/bin/perl
-
-package Help;
-
-use strict;
-use warnings;
-use OpenBSD::Pledge;
-use OpenBSD::Unveil;
-
-my %conf = %main::conf;
-my $chans = $conf{chans};
-my $teamchans = $conf{teamchans};
-my @teamchans = split /[,\s]+/m, $teamchans;
-my $staff = $conf{staff};
-my $terms = $conf{terms};
-my $time = "600";
-main::cbind("pub", "-", "help", \&help);
-main::cbind("msg", "-", "help", \&help);
-main::cbind("pub", "-", "request", \&help);
-
-sub init {
-}
-
-sub help {
- my ($bot, $nick, $host, $hand, @args) = @_;
- my ($chan, $text);
- my $mod_msgs= {
- BNC => "To request a free bouncer, type !bnc <username> <email>. For example, !bnc john john\@example.com.",
- Shell => "To request a free shell account, type !shell <username> <email>. For example, !shell john john\@example.com.)",
- Mail => "To request a free email account, type !mail <username> <email>. For example, !mail john john\@example.com.)",
- VPN => "To request a free VPN account, type !vpn <username> <email>. For example, !vpn john john\@example.com.)"
- };
- my $msg = $terms."\n";
- for my $mod (split ' ',$conf{modules}) {
- if (exists $mod_msgs->{$mod}) {
- $msg.=$mod_msgs->{$mod}."\n";
- }
- }
-
- my $mod_admin_msgs={
- BNC => <<"EOF",
-To delete a bouncer, type !bnc delete <username>
-To verify a captcha, type !bnc captcha <username>
-To approve a bouncer, type !bnc approve <username>
-To recreate cloneuser, type !bnc cloneuser
-EOF
- Shell => <<"EOF",
-To delete a shell account, type !shell delete <username>
-To verify a captcha, type !shell captcha <username>
-EOF
- };
- if (main::isstaff($bot, $nick)) {
- for my $mod (split ' ',$conf{modules}) {
- if (exists $mod_admin_msgs->{$mod}) {
- $msg.=$mod_admin_msgs->{$mod};
- }
- }
- $msg .=<<"EOF";
-To get a list of usernames that match IPs, type !regex ips <ips>
-To get a list of IPs that match usernames, type !regex users <usernames>
-To regex search znc.log and output to the terminal, type !regex <regex>
-EOF
-#To get a list of usernames that match IPs, type !shell regex ips <ips>
-#To get a list of IPs that match usernames, type !shell regex users <usernames>
-#To regex search znc.log and output to the terminal, type !shell regex <regex>
- }
- if (@args == 2) {
- ($chan, $text) = ($args[0], $args[1]);
- if ($chans =~ $chan) {
- main::putserv($bot, "PRIVMSG $chan :$nick: Please see private message.");
- }
- } else {
- $text = $args[0];
- }
- main::putserv($bot, "PRIVMSG $nick :$msg");
- foreach my $chan (@teamchans) {
- main::putservlocalnet($bot, "PRIVMSG $chan :$staff: Help *$nick* on network ".$bot->{name}.". If you don't help the user, he will probably leave");
- }
-}
-
-1; # MUST BE LAST STATEMENT IN FILE
blob - cd15671b15777423dbfd69225ce598403d9491e7 (mode 644)
blob + /dev/null
--- Mail.pm
+++ /dev/null
-#!/usr/bin/perl
-
-package Mail;
-
-use strict;
-use warnings;
-use OpenBSD::Pledge;
-use OpenBSD::Unveil;
-use IRCNOW::IO qw(readarray writefile);
-
-use File::Copy qw(copy);
-use MIME::Base64;
-use Digest::SHA qw(sha256_hex);
-
-my %conf = %main::conf;
-my $chans = $conf{chans};
-my $staff = $conf{staff};
-my $mailhostname = $conf{mailhostname};
-my $mailfrom = $conf{mailfrom};
-my $mailname = $conf{mailname};
-my $imapport = $conf{imapport};
-my $smtpport = $conf{smtpport};
-my $teamchans = $conf{teamchans};
-my @teamchans = split /[,\s]+/m, $teamchans;
-my $webmail = $conf{webmail};
-my $approval = $conf{approval};
-my $expires = $conf{expires};
-my $passwdpath = "/etc/mail/passwd";
-my $virtualspath = "/etc/mail/virtuals";
-my $senderspath = "/etc/mail/users";
-my @users;
-
-main::cbind("msg", "-", "mail", \&mmail);
-
-sub init {
- #dependencies for encrypt
- unveil("/usr/bin/encrypt", "rx") or die "Unable to unveil $!";
- #dependencies for mail
- unveil("/usr/sbin/sendmail", "rx") or die "Unable to unveil $!";
- unveil($passwdpath, "rwc") or die "Unable to unveil $!";
- unveil($virtualspath, "rwc") or die "Unable to unveil $!";
- unveil($senderspath, "rwc") or die "Unable to unveil $!";
- unveil("$passwdpath.bak", "rwc") or die "Unable to unveil $!";
- unveil("$virtualspath.bak", "rwc") or die "Unable to unveil $!";
- unveil("$senderspath.bak", "rwc") or die "Unable to unveil $!";
- unveil("/usr/lib/libutil.so.13.1", "r") or die "Unable to unveil $!";
- unveil("/bin/sh", "rx") or die "Unable to unveil $!";
-}
-
-sub mmail {
- 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}." with mail");
- }
- return;
- } elsif (main::isstaff($bot, $nick) && $text =~ /^delete\s+([[:ascii:]]+)/) {
- my $username = $1;
- if (SQLite::deleterows("mail", "username", $username)) {
- deletemail($username);
- foreach my $chan (@teamchans) {
- main::putserv($bot, "PRIVMSG $chan :$username email deleted");
- }
- }
- return;
- } elsif (main::isstaff($bot, $nick) && $text =~ /^approve\s+([[:ascii:]]+)/) {
- my $username = $1;
- my @passwd = readarray($passwdpath);
- foreach my $line (@passwd) {
- $line =~ s/^#(${username}\@${mailhostname}.*)/$1/;
- }
- # trailing newline necessary
- `doas touch $passwdpath.bak`;
- `doas chmod g+w $passwdpath.bak`;
- writefile("$passwdpath.bak", join("\n", @passwd)."\n");
- copy "${passwdpath}.bak", $passwdpath;
-
- foreach my $chan (@teamchans) {
- main::putserv($bot, "PRIVMSG $chan :$username mail approved");
- }
- return;
- }
- ### Check duplicate hostmasks ###
- my @rows = SQLite::selectrows("irc", "hostmask", $hostmask);
- foreach my $row (@rows) {
- my $password = SQLite::get("mail", "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("mail", "ircid", $ircid, "captcha");
- if ($text ne $captcha) {
- main::putserv($bot, "PRIVMSG $nick :Wrong captcha. To get a new captcha, type !mail <username> <email>");
- return;
- }
- my $pass = Hash::newpass();
- chomp(my $encrypted = `encrypt $pass`);
- my $username = SQLite::get("mail", "ircid", $ircid, "username");
- my $email = SQLite::get("mail", "ircid", $ircid, "email");
- my $hashirc = SQLite::get("irc", "id", $ircid, "hashid");
- SQLite::set("mail", "ircid", $ircid, "password", $encrypted);
- sleep(2);
- createmail($pass, $username);
- main::putserv($bot, "PRIVMSG $nick :Check your email!");
- sleep(5);
- mailmail($username, $pass, $email);
- if ($approval) {
- my @passwd = readarray($passwdpath);
- foreach my $line (@passwd) {
- $line =~ s/^(${username}\@${mailhostname}.*)/#$1/;
- }
- # trailing newline necessary
- `doas touch $passwdpath.bak`;
- `doas chmod g+w $passwdpath.bak`;
- writefile("$passwdpath.bak", join("\n", @passwd)."\n");
- copy "${passwdpath}.bak", $passwdpath;
-
- 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 mail registration of $username\@$mailhostname on $bot->{name} was successful, but you *must* help him to connect. Most users are unable to connect. Show him https://wiki.ircnow.org/?n=Email.Email");
- }
- #www($newnick, $reply, $password, "bouncer");
- return;
- } elsif ($text =~ /^([[:alnum:]]+)\s+([[:ascii:]]+)/) {
- my ($username, $email) = ($1, $2);
- my @userrows = SQLite::selectrows("mail", "username", $username);
- foreach my $row (@userrows) {
- my $password = SQLite::get("mail", "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("mail", "email", $email);
- foreach my $row (@userrows) {
- my $password = SQLite::get("mail", "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("mail", "ircid", $ircid, "username", $username);
- SQLite::set("mail", "ircid", $ircid, "email", $email);
- SQLite::set("mail", "ircid", $ircid, "captcha", $captcha);
- SQLite::set("mail", "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 !mail captcha <text>");
- foreach my $chan (@teamchans) {
- main::putservlocalnet($bot, "PRIVMSG $chan :$nick\'s on $bot->{name} mail captcha is $captcha");
- }
- } else {
- main::putserv($bot, "PRIVMSG $nick :Invalid username or email. Type !mail <username> <email> to try again.");
- foreach my $chan (@teamchans) {
- main::putservlocalnet($bot, "PRIVMSG $chan :$staff: Help *$nick* on network ".$bot->{name}." with mail");
- }
- }
-}
-
-sub mailmail {
- my( $username, $password, $email )=@_;
- 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 an email account:
-
-Username: $username\@$mailhostname
-Password: $password
-Server: $mailhostname
-IMAP Port: $imapport (STARTTLS)
-SMTP Port: $smtpport (STARTTLS)
-Webpanel: $webmail
-$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.
-
-Connection Instructions: https://wiki.ircnow.org/?n=Email.Email
-
-IRCNow
-EOF
- main::mail($mailfrom, $email, $mailname, "Verify IRCNow Account", $body);
-}
-
-
-sub createmail {
- my ($password, $username) = @_;
- chomp(my $encrypted = `encrypt $password`);
- my $line = "${username}\@$mailhostname:${encrypted}::::::userdb_quota_rule=*:storage=1G";
- $line =~ s{\$}{\\\$}g;
- my $line2 = "${username}\@$mailhostname vmail";
- my $line3 = "${username}\@$mailhostname: ${username}\@$mailhostname";
- `doas sh -c 'echo $line >> $passwdpath'`;
- `doas sh -c 'echo $line2 >> $virtualspath'`;
- `doas sh -c 'echo $line3 >> $senderspath'`;
- `doas smtpctl update table passwd`;
- `doas smtpctl update table virtuals`;
- `doas smtpctl update table users`;
- `doas rcctl reload dovecot`;
-}
-
-sub deletemail {
- my ($username) = @_;
- my @passwd = readarray($passwdpath);
- my @virtuals = readarray($virtualspath);
- my @senders = readarray($senderspath);
- @passwd = grep !/^${username}\@${mailhostname}/, @passwd;
- @virtuals = grep !/^${username}\@${mailhostname}/, @virtuals;
- @senders = grep !/^${username}\@${mailhostname}/, @senders;
-
- # trailing newline necessary
- `doas touch $passwdpath.bak`;
- `doas touch $virtualspath.bak`;
- `doas touch $senderspath.bak`;
- `doas chmod g+w $passwdpath.bak $virtualspath.bak $senderspath.bak`;
- writefile("$passwdpath.bak", join("\n", @passwd)."\n");
- copy "${passwdpath}.bak", $passwdpath;
- writefile("$virtualspath.bak", join("\n", @virtuals)."\n");
- copy "${virtualspath}.bak", $virtualspath;
- writefile("$senderspath.bak", join("\n", @senders)."\n");
- copy "${senderspath}.bak", $senderspath;
-
- `doas smtpctl update table passwd`;
- `doas smtpctl update table virtuals`;
- `doas smtpctl update table users`;
- `doas rcctl reload dovecot`;
-}
-1; # MUST BE LAST STATEMENT IN FILE
blob - 191d2b61fbb878edf293ee222da31d43cc81504f (mode 644)
blob + /dev/null
--- SQLite.pm
+++ /dev/null
-#!/usr/bin/perl
-
-package SQLite;
-
-use strict;
-use warnings;
-use OpenBSD::Pledge;
-use OpenBSD::Unveil;
-use IRCNOW::IO qw(readstr);
-
-use Data::Dumper;
-use DBI;
-use DBD::SQLite;
-
-use constant {
- NONE => 0,
- ERRORS => 1,
- WARNINGS => 2,
- ALL => 3,
-};
-my %conf = %main::conf;
-my $staff = $conf{staff};
-my $dbh;
-my $verbose = $conf{verbose};
-my $dbpath = "/var/www/botnow/botnow.db";
-my $database = "/var/www/botnow/"; # database path
-main::cbind("msg", "-", "get", \&mget);
-main::cbind("msg", "-", "set", \&mset);
-main::cbind("msg", "-", "connectdb", \&mconnectdb);
-main::cbind("msg", "-", "insert", \&minsert);
-main::cbind("msg", "-", "update", \&mupdate);
-main::cbind("msg", "-", "delete", \&mdelete);
-main::cbind("msg", "-", "select", \&mselect);
-
-sub init {
- unveil("$dbpath", "rwc") or die "Unable to unveil $!";
- unveil("$dbpath-journal", "rwc") or die "Unable to unveil $!";
- unveil("$database", "rwxc") or die "Unable to unveil $!";
-}
-
-# !connectdb
-sub mconnectdb {
- my ($bot, $nick, $host, $hand, $text) = @_;
- if (! (main::isstaff($bot, $nick))) { return; }
- if (connectdb()) {
- main::putserv($bot, "PRIVMSG $nick :connectdb succeeded");
- } else {
- main::putserv($bot, "PRIVMSG $nick :ERROR: connectdb failed");
- }
-}
-
-# !insert <table> <keys> <vals>
-# Insert comma-separated keys and vals into table
-sub minsert {
- my ($bot, $nick, $host, $hand, $text) = @_;
- if (! (main::isstaff($bot, $nick))) { return; }
- if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_~@!,\.[:alnum:]]+)\s+([[:ascii:]]+)/) {
- my ($table, $keys, $vals) = ($1, $2, $3);
- # strings in the values must be quoted
- if ($vals =~ s{,}{","}g) { $vals = '"'.$vals.'"'; }
- if (insertrow($table, $keys, $vals)) {
- main::putserv($bot, "PRIVMSG $nick :$table ($keys) => ($vals)");
- } else {
- main::putserv($bot, "PRIVMSG $nick :$table insert failed");
- }
- } else {
- main::putserv($bot, "PRIVMSG $nick :invalid insert");
- }
-}
-
-# Set key = val where idkey = idval in table
-# !update <table> <idkey> <idval> <key> <val>
-sub mupdate {
- my ($bot, $nick, $host, $hand, $text) = @_;
- if (! (main::isstaff($bot, $nick))) { return; }
- if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_~@!,\.[:alnum:]]+)\s+(\S+)\s+([-_[:alnum:]]+)\s+(\S+)/) {
- my ($table, $idkey, $idval, $key, $val) = ($1, $2, $3, $4, $5);
- if (updaterow($table, $idkey, $idval, $key, $val)) {
- main::putserv($bot, "PRIVMSG $nick :$table $key => $val where $idkey = $idval");
- } else {
- main::putserv($bot, "PRIVMSG $nick :update failed");
- }
- } else {
- main::putserv($bot, "PRIVMSG $nick :invalid update");
- }
-}
-
-# Delete rows where key = val in table
-# !delete <table> <key> <val>
-sub mdelete {
- my ($bot, $nick, $host, $hand, $text) = @_;
- if (! (main::isstaff($bot, $nick))) { return; }
- if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_[:alnum:]]+)\s+(\S+)/) {
- my ($table, $key, $val) = ($1, $2, $3);
- if (deleterows($table, $key, $val)) {
- main::putserv($bot, "PRIVMSG $nick :$table $key = $val deleted");
- } else {
- main::putserv($bot, "PRIVMSG $nick :delete failed");
- }
- } else {
- main::putserv($bot, "PRIVMSG $nick :invalid delete");
- }
-}
-
-# Output rows where key = val in table
-# !select <table> <key> <val>
-sub mselect {
- my ($bot, $nick, $host, $hand, $text) = @_;
- if (! (main::isstaff($bot, $nick))) { return; }
- if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_[:alnum:]]+)\s+(\S+)/) {
- my ($table, $key, $val) = ($1, $2, $3);
- my @rows = selectrows($table, $key, $val);
- if (@rows) {
- foreach my $row (@rows) {
- my @pairs;
- foreach $key (keys %$row) {
- my $val = $row->{$key} || "";
- push(@pairs, "$key => $val");
- }
- main::putserv($bot, "PRIVMSG $nick :$table ".join(',', @pairs));
- }
- } else {
- main::putserv($bot, "PRIVMSG $nick :no results");
- }
- } else {
- main::putserv($bot, "PRIVMSG $nick :select invalid");
- }
-}
-
-# Get value of key where idkey = idval in table
-# !get <table> <idkey> <idval> <key>
-sub mget {
- my ($bot, $nick, $host, $hand, $text) = @_;
- if (! (main::isstaff($bot, $nick))) { return; }
- if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_~@!,\.[:alnum:]]+)\s+(\S+)\s+([-_[:alnum:]]+)/) {
- my ($table, $idkey, $idval, $key) = ($1, $2, $3, $4);
- my $val = get($table, $idkey, $idval, $key);
- if (defined($val)) {
- main::putserv($bot, "PRIVMSG $nick :$table $key => $val where $idkey = $idval");
- } else {
- main::putserv($bot, "PRIVMSG $nick :undefined");
- }
- } else {
- main::putserv($bot, "PRIVMSG $nick :invalid get");
- }
-}
-# !set <table> <idkey> <idval> <key> <val>
-sub mset {
- my ($bot, $nick, $host, $hand, $text) = @_;
- if (! (main::isstaff($bot, $nick))) { return; }
- if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_~@!,\.[:alnum:]]+)\s+(\S+)\s+([-_[:alnum:]]+)\s+(\S+)/) {
- my ($table, $idkey, $idval, $key, $val) = ($1, $2, $3, $4, $5);
- if (set($table, $idkey, $idval, $key, $val)) {
- main::putserv($bot, "PRIVMSG $nick :$table $key => $val where $idkey = $idval");
- } else {
- main::putserv($bot, "PRIVMSG $nick :failed set");
- }
- } else {
- main::putserv($bot, "PRIVMSG $nick :invalid set");
- }
-}
-
-# Connect to database, creating table if necessary
-# Returns true on success, false on failure
-sub connectdb {
- my $dsn = "dbi:SQLite:dbname=$dbpath";
- my $user = "";
- my $password = "";
- $dbh = DBI->connect($dsn, $user, $password, {
- PrintError => 1,
- RaiseError => 1,
- AutoCommit => 1,
- FetchHashKeyName => 'NAME_lc',
- }) or die "Couldn't connect to database: " . $DBI::errstr;
- if (!(-s "$dbpath")) {
- my $sql = readstr('table.sql');
- my @sql = split /;/m, $sql;
- foreach my $s (@sql) {
- $dbh->do($s);
- }
- }
- main::debug(ALL, "connected to $dbpath");
- return defined($dbh);
-}
-
-# Inserts comma-separated keys and vals into table
-# Returns number of rows successfully inserted
-sub insertrow {
- my ($table, $keys, $vals) = @_;
- if (!defined($dbh)) { connectdb(); }
- my $rows = $dbh->do("INSERT INTO $table ($keys) values ($vals)");
- if ($rows) {
- main::debug(ALL, "INSERT INTO $table ($keys) values ($vals)");
- } else {
- main::debug(ERRORS, "ERRORS: Failed INSERT INTO $table ($keys) values ($vals)");
- }
- return $rows;
-}
-
-# Update key, value pair for record where idkey equals idval in table
-# Returns number of rows successfully updated
-sub updaterow {
- my ($table, $idkey, $idval, $key, $val) = @_;
- if (!defined($dbh)) { connectdb(); }
- my $rows = $dbh->do("UPDATE $table SET $key = ? where $idkey = ?", undef, $val, $idval);
- if ($rows) {
- main::debug(ALL, "UPDATE $table SET $key = $val where $idkey = $idval");
- } else {
- main::debug(ERRORS, "ERRORS: Failed UPDATE $table SET $key = $val where $idkey = $idval");
- }
- return $rows;
-}
-
-# Delete records from $table where $key = $val
-# Returns number of rows deleted
-sub deleterows {
- my ($table, $key, $val) = @_;
- if (!defined($dbh)) { connectdb(); }
- my $rows = $dbh->do("DELETE FROM $table WHERE $key = ?", undef, $val);
- if ($rows) {
- main::debug(ALL, "DELETE FROM $table WHERE $key = $val");
- } else {
- main::debug(ERRORS, "ERRORS: Failed DELETE FROM $table WHERE $key = $val");
- }
- return $rows;
-}
-
-# Returns all records in the database
-sub selectall {
- my ($table) = @_;
- if (!defined($dbh)) { connectdb(); }
- my $sth = $dbh->prepare("SELECT * FROM $table");
- $sth->execute();
- my @results;
- while (my $row = $sth->fetchrow_hashref) {
- push(@results, $row);
- }
- return @results;
-}
-
-# Returns all records from table where key equals value
-sub selectrows {
- my ($table, $key, $val) = @_;
- if (!defined($dbh)) { connectdb(); }
- my $sth = $dbh->prepare("SELECT * FROM $table WHERE $key = ?");
- $sth->execute($val);
- my @results;
- while (my $row = $sth->fetchrow_hashref) {
- push(@results, $row);
- }
- return @results;
-}
-
-# Returns list of tables
-sub tables {
- # if (!defined($dbh)) { connectdb(); }
- # my $sth = $dbh->prepare(".tables");
- # $sth->execute($val);
- # my @results;
- # while (my $row = $sth->fetchrow_hashref) {
- # push(@results, $row);
- # }
- # return @results;
- return qw(bnc shell www irc smtp);
-}
-
-# Returns value of key in record in table where idkey = idval
-sub get {
- my ($table, $idkey, $idval, $key) = @_;
- if (!defined($dbh)) { connectdb(); }
- my $sth = $dbh->prepare("SELECT * FROM $table WHERE $idkey = ?");
- $sth->execute($idval);
- if (my $row = $sth->fetchrow_hashref) {
- my $val = $row->{$key};
- if (!defined($val)) { $val = "undefined"; }
- main::debug(ALL, "get: $table $key => $val where $idkey = $idval");
- return $row->{$key};
- } else {
- main::debug(ERRORS, "ERRORS: $table $key undefined where $idkey = $idval");
- return;
- }
-}
-
-# Sets value of key in the record in table where idkey = idval
-# Returns true on success; false on failure
-sub set {
- my ($table, $idkey, $idval, $key, $val) = @_;
- if (defined(get($table, $idkey, $idval, $idkey))) {
- main::debug(ALL, "set: update");
- return updaterow($table, $idkey, $idval, $key, $val) > 0;
- } else {
- main::debug(ALL, "set: insert");
- return insertrow($table, "$idkey,$key", "\"$idval\",\"$val\"") > 0;
- }
-}
-
-# given a key, val pair in table, return the id that falls within expires seconds
-sub id {
- my ($table, $key, $val, $expires) = @_;
- my @rows = selectrows($table, $key, $val);
- if (scalar(@rows) == 0) {
- print "table => $table, key => $key, val => $val\n\n";
- }
- my $maxrow;
- foreach my $row (@rows) {
- if (!defined($maxrow)) { $maxrow = $row; }
- if ($row->{localtime} > $maxrow->{localtime}) {
- $maxrow = $row;
- }
- }
- if (abs(time() - $maxrow->{localtime}) <= $expires) {
- main::debug(ALL, "id: $maxrow->{id} where $key = $val at $expires");
- return $maxrow->{id};
- } else {
- main::debug(ERRORS, "no id found");
- return;
- }
-}
-
-1; # MUST BE LAST STATEMENT IN FILE
blob - a4e6ce428e3a34b87fa5c61695d12630cb2f43fd (mode 644)
blob + /dev/null
--- Sh.pm
+++ /dev/null
-#!/usr/bin/perl
-
-package Shell;
-
-use strict;
-use warnings;
-use OpenBSD::Pledge;
-use OpenBSD::Unveil;
-use IRCNOW::IO qw(readarray);
-
-use Data::Dumper;
-
-my $authlog = "/var/log/authlog";
-my $etcpasswd = "/etc/master.passwd";
-my @etcpasswd = readarray($etcpasswd);
-my @users;
-foreach my $line (@etcpasswd) {
- if ($line =~ /^([^:]+):[^:]+:([^:]+)/) {
- my ($username, $uid) = ($1, $2);
- if ($uid > 1000) {
- push(@users, $username);
- }
- }
-}
-my @files = ("/var/log/authlog");
-push(@files, glob q("/var/log/authlog.?"));
-push(@files, glob q("/var/log/authlog.1?"));
-foreach my $user (@users) {
- my $lastseen;
- foreach my $file (@files) {
- my @logs = readarray($file);
- my @seen = grep(/$user/, @logs);
- if (scalar(@seen) && $seen[0] =~ /^(\w+ \d+ \d\d:\d\d:\d\d)/) {
- $lastseen = $1;
- print "$user => $lastseen\n";
- last;
- }
- }
- if (!defined($lastseen)) {
- print "$user => Never logged in\n";
- }
-}
blob - /dev/null
blob + 8a7da72f675a0775f8c52dcca9969e79ed8acd14 (mode 644)
--- /dev/null
+++ lib/BotNow/BNC.pm
+package BotNow::BNC;
+
+use strict;
+use warnings;
+use OpenBSD::Pledge;
+use OpenBSD::Unveil;
+use Digest::SHA qw(sha256_hex);
+use IRCNOW::IO qw(readarray);
+require "BotNow::SQLite";
+require "BotNow::Hash";
+require "BotNow::DNS";
+require "BotNow::Mail";
+
+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 $bnchostname = $conf{bnchostnome};
+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 = 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;
+ if (SQLite::selectrows("bnc", "username", $username)) {
+ main::putserv($bot, "PRIVMSG *blockuser :unblock $username");
+ foreach my $chan (@teamchans) {
+ main::putserv($bot, "PRIVMSG $chan :$username bnc approved");
+ }
+ } else {
+ main::putserv($bot, "PRIVMSG $chan :$username hasn't requested a bnc account");
+ }
+ 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: $bnchostname
+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 = 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
blob - /dev/null
blob + 7e28005a91c166f812f1818c857ae767f2c66fad (mode 644)
--- /dev/null
+++ lib/BotNow/DNS.pm
+package BotNow::DNS;
+
+use strict;
+use warnings;
+use OpenBSD::Pledge;
+use OpenBSD::Unveil;
+use IRCNOW::IO qw(readarray writefile appendfile);
+
+use File::Copy qw(copy);
+
+my %conf = %main::conf;
+my $chans = $conf{chans};
+my $staff = $conf{staff};
+my $key = $conf{key};
+my $hash = $conf{hash};
+my $hostname = $conf{hostname};
+my $verbose = $conf{verbose};
+my $ip4 = $conf{ip4};
+my $ip6 = $conf{ip6};
+my $ip6subnet = $conf{ip6subnet};
+my $zonedir = $conf{zonedir};
+my $hostnameif = $conf{hostnameif};
+if (host($hostname) =~ /(\d+\.){3,}\d+/) {
+ $ip4 = $&;
+}
+main::cbind("msg", "-", "setrdns", \&msetrdns);
+main::cbind("msg", "-", "delrdns", \&mdelrdns);
+main::cbind("msg", "-", "setdns", \&msetdns);
+main::cbind("msg", "-", "deldns", \&mdeldns);
+main::cbind("msg", "-", "host", \&mhost);
+main::cbind("msg", "-", "nextdns", \&mnextdns);
+main::cbind("msg", "-", "readip6s", \&mreadip6s);
+
+sub init {
+ unveil("$zonedir", "rwc") or die "Unable to unveil $!";
+ unveil("/usr/bin/doas", "rx") or die "Unable to unveil $!";
+ unveil("/usr/bin/host", "rx") or die "Unable to unveil $!";
+ unveil("$hostnameif", "rwc") or die "Unable to unveil $!";
+}
+
+# !setrdns 2001:bd8:: username.example.com
+sub msetrdns {
+ my ($bot, $nick, $host, $hand, $text) = @_;
+ if (! (main::isstaff($bot, $nick))) { return; }
+ if ($text =~ /^([0-9A-Fa-f:\.]{3,})\s+([-0-9A-Za-z\.]+)$/) {
+ my ($ip, $hostname) = ($1, $2);
+ if (setrdns($ip, $ip6subnet, $hostname)) {
+ main::putserv($bot, "PRIVMSG $nick :$hostname set to $ip");
+ } else {
+ main::putserv($bot, "PRIVMSG $nick :ERROR: failed to set rDNS");
+ }
+ }
+}
+
+# !delrdns 2001:bd8::
+sub mdelrdns {
+ my ($bot, $nick, $host, $hand, $text) = @_;
+ if (! (main::isstaff($bot, $nick))) { return; }
+ if ($text =~ /^([0-9A-Fa-f:\.]{3,})$/) {
+ my ($ip) = ($1);
+ if (delrdns($ip, $ip6subnet)) {
+ main::putserv($bot, "PRIVMSG $nick :$ip rDNS deleted");
+ } else {
+ main::putserv($bot, "PRIVMSG $nick :ERROR: failed to set rDNS");
+ }
+ }
+}
+# !setdns username 1.2.3.4
+sub msetdns {
+ my ($bot, $nick, $host, $hand, $text) = @_;
+ if (! (main::isstaff($bot, $nick))) { return; }
+ if ($text =~ /^([-0-9A-Za-z\.]+)\s+([0-9A-Fa-f:\.]+)/) {
+ my ($name, $value) = ($1, $2);
+ if ($value =~ /:/ and setdns($name, $hostname, "AAAA", $value)) {
+ main::putserv($bot, "PRIVMSG $nick :$name.$hostname AAAA set to $value");
+ } elsif (setdns($name, $hostname, "A", $value)) {
+ main::putserv($bot, "PRIVMSG $nick :$name.$hostname A set to $value");
+ } else {
+ main::putserv($bot, "PRIVMSG $nick :ERROR: failed to set DNS");
+ }
+ }
+}
+
+# !deldns username
+sub mdeldns {
+ my ($bot, $nick, $host, $hand, $text) = @_;
+ if (! (main::isstaff($bot, $nick))) { return; }
+ if ($text =~ /^([-0-9A-Za-z\.]+)$/) {
+ my ($name) = ($1);
+ if (setdns($name, $hostname)) {
+ main::putserv($bot, "PRIVMSG $nick :$text deleted");
+ } else {
+ main::putserv($bot, "PRIVMSG $nick :ERROR: failed to delete DNS records");
+ }
+ }
+}
+
+# !host username
+sub mhost {
+ my ($bot, $nick, $host, $hand, $text) = @_;
+ if (! (main::isstaff($bot, $nick))) { return; }
+ if ($text =~ /^([-0-9A-Za-z:\.]{3,})/) {
+ my ($hostname) = ($1);
+ main::putserv($bot, "PRIVMSG $nick :".host($hostname));
+ }
+}
+
+# !nextdns username
+sub mnextdns {
+ my ($bot, $nick, $host, $hand, $text) = @_;
+ if (! (main::isstaff($bot, $nick))) { return; }
+ if ($text =~ /^([-0-9a-zA-Z]+)/) {
+ main::putserv($bot, "PRIVMSG $nick :$text set to ".nextdns($text));
+ }
+}
+
+# !readip6s
+sub mreadip6s {
+ my ($bot, $nick, $host, $hand, $text) = @_;
+ if (! (main::isstaff($bot, $nick))) { return; }
+ foreach my $line (readip6s($hostnameif)) {
+ print "$line\n"
+ }
+}
+
+# Return list of ipv6 addresses from filename
+sub readip6s {
+ my ($filename) = @_;
+ my @lines = readarray($filename);
+ my @ipv6s;
+ foreach my $line (@lines) {
+ if ($line =~ /^\s*inet6\s+(alias\s+)?([0-9a-f:]{4,})\s+[0-9]+\s*$/i) {
+ push(@ipv6s, $2);
+ } elsif ($line =~ /^\s*([0-9a-f:]{4,})\s*$/i) {
+ push(@ipv6s, $1);
+ }
+ }
+ return @ipv6s;
+}
+
+# set rdns of $ip6 to $hostname given $subnet
+# return true on success; false on failure
+sub setrdns {
+ my ($ip6, $subnet, $hostname) = @_;
+ my $digits = ip6full($ip6);
+ $digits =~ tr/://d;
+ my $reversed = reverse($digits);
+ my $origin = substr($reversed, 32-$subnet/4);
+ $origin = join('.', split(//, $origin)).".ip6.arpa";
+ my $name = substr($reversed, 0, 32-$subnet/4);
+ $name = join('.', split(//, $name));
+ # delete old PTR records, then set new one
+ return setdns($name, $origin) && setdns($name, $origin, "PTR", $hostname.".");
+}
+# delete rdns of $ip6 given $subnet
+# return true on success; false on failure
+sub delrdns {
+ my ($ip6, $subnet) = @_;
+ return setrdns($ip6, $subnet);
+}
+
+# given $origin. create $name RR of $type and set to $value if provided;
+# if $value is missing, delete $domain
+# returns true upon success, false upon failure
+sub setdns {
+ my ($name, $origin, $type, $value) = @_;
+ my $filename = "$zonedir/$origin";
+ my @lines = readarray($filename);
+ foreach my $line (@lines) {
+ # increment the zone's serial number
+ if ($line =~ /(\d{8})(\d{2})((\s+\d+){4}\s*\))/) {
+ my $date = main::date();
+ my $serial = 0;
+ if ($date <= $1) { $serial = $2+1; }
+ $line = $`.$date.sprintf("%02d",$serial).$3.$';
+ }
+ }
+ if (!defined($value)) { # delete records
+ @lines = grep !/\b$name\s*3600\s*IN/, @lines;
+ } else {
+ push(@lines, "$name 3600 IN $type $value");
+ }
+ # trailing newline necessary
+ writefile("$filename.bak", join("\n", @lines)."\n");
+ copy "$filename.bak", $filename;
+ if (system("doas -u _nsd nsd-control reload")) {
+ return 0;
+ } else {
+ return 1;
+ }
+}
+
+# given hostname, return IP addresses; or given IP address, return hostname
+sub host {
+ my ($name) = @_;
+ my @matches;
+ my @lines = split /\n/m, `host $name`;
+ if ($name =~ /^[0-9\.]+$/ or $name =~ /:/) { # IP address
+ foreach my $line (@lines) {
+ if ($line =~ /([\d\.]+).(in-addr|ip6).arpa domain name pointer (.*)/) {
+ push(@matches, $3);
+ }
+ }
+ } else { # hostname
+ foreach my $line (@lines) {
+ if ($line =~ /$name has (IPv6 )?address ([0-9a-fA-F\.:]+)/) {
+ push(@matches, $2);
+ }
+ }
+ }
+ return join(' ', @matches);
+}
+
+# Return an ipv6 address with all zeroes filled in
+sub ip6full {
+ my ($ip6) = @_;
+ my $left = substr($ip6, 0, index($ip6, "::"));
+ my $leftcolons = ($left =~ tr/://);
+ $ip6 =~ s{::}{:};
+ my @quartets = split(':', $ip6);
+ my $length = scalar(@quartets);
+ for (my $n = 1; $n <= 8 - $length; $n++) {
+ splice(@quartets, $leftcolons+1, 0, "0000");
+ }
+ my @newquartets = map(sprintf('%04s', $_), @quartets);
+ my $full = join(':',@newquartets);
+ return $full;
+}
+# Returns the network part of the first IPv6 address (indicated by subnet)
+# with the host part of the second IPv6 address
+sub ip6mask {
+ my ($ip6net, $subnet, $ip6host) = @_;
+ my $netdigits = ip6full($ip6net);
+ $netdigits =~ tr/://d;
+ my $hostdigits = ip6full($ip6host);
+ $hostdigits =~ tr/://d;
+ my $digits = substr($netdigits,0,($subnet/4)).substr($hostdigits,($subnet/4));
+ my $ip6;
+ for (my $n = 0; $n < 32; $n++) {
+ if ($n > 0 && $n % 4 == 0) {
+ $ip6 .= ":";
+ }
+ $ip6 .= substr($digits,$n,1);
+ }
+ return $ip6;
+}
+sub randip6 {
+ return join ':', map { sprintf '%04x', rand 0x10000 } (1 .. 8);
+}
+
+# create A and AAAA records for subdomain, set the rDNS,
+# and return the new ipv6 address
+sub nextdns {
+ my ($subdomain) = @_;
+ my $newip6 = $ip6;
+ my @allip6s = readip6s($hostnameif);
+ while (grep(/$newip6/, @allip6s)) {
+ $newip6 = ip6mask($ip6, $ip6subnet,randip6());
+ }
+ appendfile($hostnameif, "inet6 alias $newip6 48\n");
+ `doas ifconfig vio0 inet6 $newip6/48`;
+ if (setdns($subdomain, $hostname, "A", $ip4) && setdns($subdomain, $hostname, "AAAA", $newip6) && setrdns($newip6, $ip6subnet, "$subdomain.$hostname")) {
+ return "$newip6";
+ }
+ return "false";
+}
+
+1; # MUST BE LAST STATEMENT IN FILE
blob - /dev/null
blob + 1913e71391f900d8a17b6c41ce935e611ffd3788 (mode 644)
--- /dev/null
+++ lib/BotNow/Hash.pm
+package BotNow::Hash;
+
+use strict;
+use warnings;
+use OpenBSD::Pledge;
+use OpenBSD::Unveil;
+
+use IRCNOW::IO qw(readarray);
+
+
+use Data::Dumper;
+
+my %conf = %main::conf;
+my @words;
+my $wordspath = "words";
+my $passlength = $conf{passlength};
+# dictionary words for passwords
+@words = readarray("words");
+
+sub init {
+ unveil($wordspath, "r") or die "Unable to unveil $!";
+}
+
+sub newpass {
+ my $len = scalar @words;
+ my $pass;
+ for (my $i=0; $i < $passlength; $i++) {
+ my $word = $words[int(rand($len))];
+ $word =~ s/(\w+)/\u$1/g;
+ $pass .= $word;
+ }
+ return $pass;
+}
+#dependencies for blowfish
+#unveil("./blowfish.o", "rx") or die "Unable to unveil $!";
+# } elsif ($reply =~ /^!identify\s*(.*)?\s+(.*)$/i) {
+# my $hash = getkeyval($hostmask, "password");
+# #print "result = ".`./blowfish.o $2 '$hash'`;
+# if(system("./blowfish.o $2 '$hash' > /dev/null")) {
+# print "login failed\r\n";
+# } else {
+# print "logged in\r\n";
+# }
+
+
+1; # MUST BE LAST STATEMENT IN FILE
blob - /dev/null
blob + ab06993cb605c3f017486e41fe35a5b2f9ae7639 (mode 644)
--- /dev/null
+++ lib/BotNow/Help.pm
+package BotNow::Help;
+
+use strict;
+use warnings;
+use OpenBSD::Pledge;
+use OpenBSD::Unveil;
+
+my %conf = %main::conf;
+my $chans = $conf{chans};
+my $teamchans = $conf{teamchans};
+my @teamchans = split /[,\s]+/m, $teamchans;
+my $staff = $conf{staff};
+my $terms = $conf{terms};
+my $time = "600";
+main::cbind("pub", "-", "help", \&help);
+main::cbind("msg", "-", "help", \&help);
+main::cbind("pub", "-", "request", \&help);
+
+sub init {
+}
+
+sub help {
+ my ($bot, $nick, $host, $hand, @args) = @_;
+ my ($chan, $text);
+ my $mod_msgs= {
+ BNC => "To request a free bouncer, type !bnc <username> <email>. For example, !bnc john john\@example.com.",
+ Shell => "To request a free shell account, type !shell <username> <email>. For example, !shell john john\@example.com.)",
+ Mail => "To request a free email account, type !mail <username> <email>. For example, !mail john john\@example.com.)",
+ VPN => "To request a free VPN account, type !vpn <username> <email>. For example, !vpn john john\@example.com.)"
+ };
+ my $msg = $terms."\n";
+ for my $mod (split ' ',$conf{modules}) {
+ if (exists $mod_msgs->{$mod}) {
+ $msg.=$mod_msgs->{$mod}."\n";
+ }
+ }
+
+ my $mod_admin_msgs={
+ BNC => <<"EOF",
+To delete a bouncer, type !bnc delete <username>
+To verify a captcha, type !bnc captcha <username>
+To approve a bouncer, type !bnc approve <username>
+To recreate cloneuser, type !bnc cloneuser
+EOF
+ Shell => <<"EOF",
+To delete a shell account, type !shell delete <username>
+To verify a captcha, type !shell captcha <username>
+EOF
+ };
+ if (main::isstaff($bot, $nick)) {
+ for my $mod (split ' ',$conf{modules}) {
+ if (exists $mod_admin_msgs->{$mod}) {
+ $msg.=$mod_admin_msgs->{$mod};
+ }
+ }
+ $msg .=<<"EOF";
+To get a list of usernames that match IPs, type !regex ips <ips>
+To get a list of IPs that match usernames, type !regex users <usernames>
+To regex search znc.log and output to the terminal, type !regex <regex>
+EOF
+#To get a list of usernames that match IPs, type !shell regex ips <ips>
+#To get a list of IPs that match usernames, type !shell regex users <usernames>
+#To regex search znc.log and output to the terminal, type !shell regex <regex>
+ }
+ if (@args == 2) {
+ ($chan, $text) = ($args[0], $args[1]);
+ if ($chans =~ $chan) {
+ main::putserv($bot, "PRIVMSG $chan :$nick: Please see private message.");
+ }
+ } else {
+ $text = $args[0];
+ }
+ main::putserv($bot, "PRIVMSG $nick :$msg");
+ foreach my $chan (@teamchans) {
+ main::putservlocalnet($bot, "PRIVMSG $chan :$staff: Help *$nick* on network ".$bot->{name}.". If you don't help the user, he will probably leave");
+ }
+}
+
+1; # MUST BE LAST STATEMENT IN FILE
blob - /dev/null
blob + 59651cb328848b241afbe8a637f036f3c6d33fdb (mode 644)
--- /dev/null
+++ lib/BotNow/Mail.pm
+package BotNow::Mail;
+
+use strict;
+use warnings;
+use OpenBSD::Pledge;
+use OpenBSD::Unveil;
+use IRCNOW::IO qw(readarray writefile);
+
+use File::Copy qw(copy);
+use MIME::Base64;
+use Digest::SHA qw(sha256_hex);
+
+my %conf = %main::conf;
+my $chans = $conf{chans};
+my $staff = $conf{staff};
+my $mailhostname = $conf{mailhostname};
+my $mailfrom = $conf{mailfrom};
+my $mailname = $conf{mailname};
+my $imapport = $conf{imapport};
+my $smtpport = $conf{smtpport};
+my $teamchans = $conf{teamchans};
+my @teamchans = split /[,\s]+/m, $teamchans;
+my $webmail = $conf{webmail};
+my $approval = $conf{approval};
+my $expires = $conf{expires};
+my $passwdpath = "/etc/mail/passwd";
+my $virtualspath = "/etc/mail/virtuals";
+my $senderspath = "/etc/mail/users";
+my @users;
+
+main::cbind("msg", "-", "mail", \&mmail);
+
+sub init {
+ #dependencies for encrypt
+ unveil("/usr/bin/encrypt", "rx") or die "Unable to unveil $!";
+ #dependencies for mail
+ unveil("/usr/sbin/sendmail", "rx") or die "Unable to unveil $!";
+ unveil($passwdpath, "rwc") or die "Unable to unveil $!";
+ unveil($virtualspath, "rwc") or die "Unable to unveil $!";
+ unveil($senderspath, "rwc") or die "Unable to unveil $!";
+ unveil("$passwdpath.bak", "rwc") or die "Unable to unveil $!";
+ unveil("$virtualspath.bak", "rwc") or die "Unable to unveil $!";
+ unveil("$senderspath.bak", "rwc") or die "Unable to unveil $!";
+ unveil("/usr/lib/libutil.so.13.1", "r") or die "Unable to unveil $!";
+ unveil("/bin/sh", "rx") or die "Unable to unveil $!";
+}
+
+sub mmail {
+ 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}." with mail");
+ }
+ return;
+ } elsif (main::isstaff($bot, $nick) && $text =~ /^delete\s+([[:ascii:]]+)/) {
+ my $username = $1;
+ if (SQLite::deleterows("mail", "username", $username)) {
+ deletemail($username);
+ foreach my $chan (@teamchans) {
+ main::putserv($bot, "PRIVMSG $chan :$username email deleted");
+ }
+ }
+ return;
+ } elsif (main::isstaff($bot, $nick) && $text =~ /^approve\s+([[:ascii:]]+)/) {
+ my $username = $1;
+ my @passwd = readarray($passwdpath);
+ foreach my $line (@passwd) {
+ $line =~ s/^#(${username}\@${mailhostname}.*)/$1/;
+ }
+ # trailing newline necessary
+ `doas touch $passwdpath.bak`;
+ `doas chmod g+w $passwdpath.bak`;
+ writefile("$passwdpath.bak", join("\n", @passwd)."\n");
+ copy "${passwdpath}.bak", $passwdpath;
+
+ foreach my $chan (@teamchans) {
+ main::putserv($bot, "PRIVMSG $chan :$username mail approved");
+ }
+ return;
+ }
+ ### Check duplicate hostmasks ###
+ my @rows = SQLite::selectrows("irc", "hostmask", $hostmask);
+ foreach my $row (@rows) {
+ my $password = SQLite::get("mail", "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("mail", "ircid", $ircid, "captcha");
+ if ($text ne $captcha) {
+ main::putserv($bot, "PRIVMSG $nick :Wrong captcha. To get a new captcha, type !mail <username> <email>");
+ return;
+ }
+ my $pass = Hash::newpass();
+ chomp(my $encrypted = `encrypt $pass`);
+ my $username = SQLite::get("mail", "ircid", $ircid, "username");
+ my $email = SQLite::get("mail", "ircid", $ircid, "email");
+ my $hashirc = SQLite::get("irc", "id", $ircid, "hashid");
+ SQLite::set("mail", "ircid", $ircid, "password", $encrypted);
+ sleep(2);
+ createmail($pass, $username);
+ main::putserv($bot, "PRIVMSG $nick :Check your email!");
+ sleep(5);
+ mailmail($username, $pass, $email);
+ if ($approval) {
+ my @passwd = readarray($passwdpath);
+ foreach my $line (@passwd) {
+ $line =~ s/^(${username}\@${mailhostname}.*)/#$1/;
+ }
+ # trailing newline necessary
+ `doas touch $passwdpath.bak`;
+ `doas chmod g+w $passwdpath.bak`;
+ writefile("$passwdpath.bak", join("\n", @passwd)."\n");
+ copy "${passwdpath}.bak", $passwdpath;
+
+ 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 mail registration of $username\@$mailhostname on $bot->{name} was successful, but you *must* help him to connect. Most users are unable to connect. Show him https://wiki.ircnow.org/?n=Email.Email");
+ }
+ #www($newnick, $reply, $password, "bouncer");
+ return;
+ } elsif ($text =~ /^([[:alnum:]]+)\s+([[:ascii:]]+)/) {
+ my ($username, $email) = ($1, $2);
+ my @userrows = SQLite::selectrows("mail", "username", $username);
+ foreach my $row (@userrows) {
+ my $password = SQLite::get("mail", "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("mail", "email", $email);
+ foreach my $row (@userrows) {
+ my $password = SQLite::get("mail", "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("mail", "ircid", $ircid, "username", $username);
+ SQLite::set("mail", "ircid", $ircid, "email", $email);
+ SQLite::set("mail", "ircid", $ircid, "captcha", $captcha);
+ SQLite::set("mail", "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 !mail captcha <text>");
+ foreach my $chan (@teamchans) {
+ main::putservlocalnet($bot, "PRIVMSG $chan :$nick\'s on $bot->{name} mail captcha is $captcha");
+ }
+ } else {
+ main::putserv($bot, "PRIVMSG $nick :Invalid username or email. Type !mail <username> <email> to try again.");
+ foreach my $chan (@teamchans) {
+ main::putservlocalnet($bot, "PRIVMSG $chan :$staff: Help *$nick* on network ".$bot->{name}." with mail");
+ }
+ }
+}
+
+sub mailmail {
+ my( $username, $password, $email )=@_;
+ 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 an email account:
+
+Username: $username\@$mailhostname
+Password: $password
+Server: $mailhostname
+IMAP Port: $imapport (STARTTLS)
+SMTP Port: $smtpport (STARTTLS)
+Webpanel: $webmail
+$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.
+
+Connection Instructions: https://wiki.ircnow.org/?n=Email.Email
+
+IRCNow
+EOF
+ main::mail($mailfrom, $email, $mailname, "Verify IRCNow Account", $body);
+}
+
+
+sub createmail {
+ my ($password, $username) = @_;
+ chomp(my $encrypted = `encrypt $password`);
+ my $line = "${username}\@$mailhostname:${encrypted}::::::userdb_quota_rule=*:storage=1G";
+ $line =~ s{\$}{\\\$}g;
+ my $line2 = "${username}\@$mailhostname vmail";
+ my $line3 = "${username}\@$mailhostname: ${username}\@$mailhostname";
+ `doas sh -c 'echo $line >> $passwdpath'`;
+ `doas sh -c 'echo $line2 >> $virtualspath'`;
+ `doas sh -c 'echo $line3 >> $senderspath'`;
+ `doas smtpctl update table passwd`;
+ `doas smtpctl update table virtuals`;
+ `doas smtpctl update table users`;
+ `doas rcctl reload dovecot`;
+}
+
+sub deletemail {
+ my ($username) = @_;
+ my @passwd = readarray($passwdpath);
+ my @virtuals = readarray($virtualspath);
+ my @senders = readarray($senderspath);
+ @passwd = grep !/^${username}\@${mailhostname}/, @passwd;
+ @virtuals = grep !/^${username}\@${mailhostname}/, @virtuals;
+ @senders = grep !/^${username}\@${mailhostname}/, @senders;
+
+ # trailing newline necessary
+ `doas touch $passwdpath.bak`;
+ `doas touch $virtualspath.bak`;
+ `doas touch $senderspath.bak`;
+ `doas chmod g+w $passwdpath.bak $virtualspath.bak $senderspath.bak`;
+ writefile("$passwdpath.bak", join("\n", @passwd)."\n");
+ copy "${passwdpath}.bak", $passwdpath;
+ writefile("$virtualspath.bak", join("\n", @virtuals)."\n");
+ copy "${virtualspath}.bak", $virtualspath;
+ writefile("$senderspath.bak", join("\n", @senders)."\n");
+ copy "${senderspath}.bak", $senderspath;
+
+ `doas smtpctl update table passwd`;
+ `doas smtpctl update table virtuals`;
+ `doas smtpctl update table users`;
+ `doas rcctl reload dovecot`;
+}
+1; # MUST BE LAST STATEMENT IN FILE
blob - /dev/null
blob + fc0aa6d5d798e4699f4f906915680c92c623ffc0 (mode 644)
--- /dev/null
+++ lib/BotNow/SQLite.pm
+package BotNow::SQLite;
+
+use strict;
+use warnings;
+use OpenBSD::Pledge;
+use OpenBSD::Unveil;
+use IRCNOW::IO qw(readstr);
+
+use Data::Dumper;
+use DBI;
+use DBD::SQLite;
+
+use constant {
+ NONE => 0,
+ ERRORS => 1,
+ WARNINGS => 2,
+ ALL => 3,
+};
+my %conf = %main::conf;
+my $staff = $conf{staff};
+my $dbh;
+my $verbose = $conf{verbose};
+my $dbpath = "/var/www/botnow/botnow.db";
+my $database = "/var/www/botnow/"; # database path
+main::cbind("msg", "-", "get", \&mget);
+main::cbind("msg", "-", "set", \&mset);
+main::cbind("msg", "-", "connectdb", \&mconnectdb);
+main::cbind("msg", "-", "insert", \&minsert);
+main::cbind("msg", "-", "update", \&mupdate);
+main::cbind("msg", "-", "delete", \&mdelete);
+main::cbind("msg", "-", "select", \&mselect);
+
+sub init {
+ unveil("$dbpath", "rwc") or die "Unable to unveil $!";
+ unveil("$dbpath-journal", "rwc") or die "Unable to unveil $!";
+ unveil("$database", "rwxc") or die "Unable to unveil $!";
+}
+
+# !connectdb
+sub mconnectdb {
+ my ($bot, $nick, $host, $hand, $text) = @_;
+ if (! (main::isstaff($bot, $nick))) { return; }
+ if (connectdb()) {
+ main::putserv($bot, "PRIVMSG $nick :connectdb succeeded");
+ } else {
+ main::putserv($bot, "PRIVMSG $nick :ERROR: connectdb failed");
+ }
+}
+
+# !insert <table> <keys> <vals>
+# Insert comma-separated keys and vals into table
+sub minsert {
+ my ($bot, $nick, $host, $hand, $text) = @_;
+ if (! (main::isstaff($bot, $nick))) { return; }
+ if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_~@!,\.[:alnum:]]+)\s+([[:ascii:]]+)/) {
+ my ($table, $keys, $vals) = ($1, $2, $3);
+ # strings in the values must be quoted
+ if ($vals =~ s{,}{","}g) { $vals = '"'.$vals.'"'; }
+ if (insertrow($table, $keys, $vals)) {
+ main::putserv($bot, "PRIVMSG $nick :$table ($keys) => ($vals)");
+ } else {
+ main::putserv($bot, "PRIVMSG $nick :$table insert failed");
+ }
+ } else {
+ main::putserv($bot, "PRIVMSG $nick :invalid insert");
+ }
+}
+
+# Set key = val where idkey = idval in table
+# !update <table> <idkey> <idval> <key> <val>
+sub mupdate {
+ my ($bot, $nick, $host, $hand, $text) = @_;
+ if (! (main::isstaff($bot, $nick))) { return; }
+ if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_~@!,\.[:alnum:]]+)\s+(\S+)\s+([-_[:alnum:]]+)\s+(\S+)/) {
+ my ($table, $idkey, $idval, $key, $val) = ($1, $2, $3, $4, $5);
+ if (updaterow($table, $idkey, $idval, $key, $val)) {
+ main::putserv($bot, "PRIVMSG $nick :$table $key => $val where $idkey = $idval");
+ } else {
+ main::putserv($bot, "PRIVMSG $nick :update failed");
+ }
+ } else {
+ main::putserv($bot, "PRIVMSG $nick :invalid update");
+ }
+}
+
+# Delete rows where key = val in table
+# !delete <table> <key> <val>
+sub mdelete {
+ my ($bot, $nick, $host, $hand, $text) = @_;
+ if (! (main::isstaff($bot, $nick))) { return; }
+ if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_[:alnum:]]+)\s+(\S+)/) {
+ my ($table, $key, $val) = ($1, $2, $3);
+ if (deleterows($table, $key, $val)) {
+ main::putserv($bot, "PRIVMSG $nick :$table $key = $val deleted");
+ } else {
+ main::putserv($bot, "PRIVMSG $nick :delete failed");
+ }
+ } else {
+ main::putserv($bot, "PRIVMSG $nick :invalid delete");
+ }
+}
+
+# Output rows where key = val in table
+# !select <table> <key> <val>
+sub mselect {
+ my ($bot, $nick, $host, $hand, $text) = @_;
+ if (! (main::isstaff($bot, $nick))) { return; }
+ if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_[:alnum:]]+)\s+(\S+)/) {
+ my ($table, $key, $val) = ($1, $2, $3);
+ my @rows = selectrows($table, $key, $val);
+ if (@rows) {
+ foreach my $row (@rows) {
+ my @pairs;
+ foreach $key (keys %$row) {
+ my $val = $row->{$key} || "";
+ push(@pairs, "$key => $val");
+ }
+ main::putserv($bot, "PRIVMSG $nick :$table ".join(',', @pairs));
+ }
+ } else {
+ main::putserv($bot, "PRIVMSG $nick :no results");
+ }
+ } else {
+ main::putserv($bot, "PRIVMSG $nick :select invalid");
+ }
+}
+
+# Get value of key where idkey = idval in table
+# !get <table> <idkey> <idval> <key>
+sub mget {
+ my ($bot, $nick, $host, $hand, $text) = @_;
+ if (! (main::isstaff($bot, $nick))) { return; }
+ if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_~@!,\.[:alnum:]]+)\s+(\S+)\s+([-_[:alnum:]]+)/) {
+ my ($table, $idkey, $idval, $key) = ($1, $2, $3, $4);
+ my $val = get($table, $idkey, $idval, $key);
+ if (defined($val)) {
+ main::putserv($bot, "PRIVMSG $nick :$table $key => $val where $idkey = $idval");
+ } else {
+ main::putserv($bot, "PRIVMSG $nick :undefined");
+ }
+ } else {
+ main::putserv($bot, "PRIVMSG $nick :invalid get");
+ }
+}
+# !set <table> <idkey> <idval> <key> <val>
+sub mset {
+ my ($bot, $nick, $host, $hand, $text) = @_;
+ if (! (main::isstaff($bot, $nick))) { return; }
+ if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_~@!,\.[:alnum:]]+)\s+(\S+)\s+([-_[:alnum:]]+)\s+(\S+)/) {
+ my ($table, $idkey, $idval, $key, $val) = ($1, $2, $3, $4, $5);
+ if (set($table, $idkey, $idval, $key, $val)) {
+ main::putserv($bot, "PRIVMSG $nick :$table $key => $val where $idkey = $idval");
+ } else {
+ main::putserv($bot, "PRIVMSG $nick :failed set");
+ }
+ } else {
+ main::putserv($bot, "PRIVMSG $nick :invalid set");
+ }
+}
+
+# Connect to database, creating table if necessary
+# Returns true on success, false on failure
+sub connectdb {
+ my $dsn = "dbi:SQLite:dbname=$dbpath";
+ my $user = "";
+ my $password = "";
+ $dbh = DBI->connect($dsn, $user, $password, {
+ PrintError => 1,
+ RaiseError => 1,
+ AutoCommit => 1,
+ FetchHashKeyName => 'NAME_lc',
+ }) or die "Couldn't connect to database: " . $DBI::errstr;
+ if (!(-s "$dbpath")) {
+ my $sql = readstr('table.sql');
+ my @sql = split /;/m, $sql;
+ foreach my $s (@sql) {
+ $dbh->do($s);
+ }
+ }
+ main::debug(ALL, "connected to $dbpath");
+ return defined($dbh);
+}
+
+# Inserts comma-separated keys and vals into table
+# Returns number of rows successfully inserted
+sub insertrow {
+ my ($table, $keys, $vals) = @_;
+ if (!defined($dbh)) { connectdb(); }
+ my $rows = $dbh->do("INSERT INTO $table ($keys) values ($vals)");
+ if ($rows) {
+ main::debug(ALL, "INSERT INTO $table ($keys) values ($vals)");
+ } else {
+ main::debug(ERRORS, "ERRORS: Failed INSERT INTO $table ($keys) values ($vals)");
+ }
+ return $rows;
+}
+
+# Update key, value pair for record where idkey equals idval in table
+# Returns number of rows successfully updated
+sub updaterow {
+ my ($table, $idkey, $idval, $key, $val) = @_;
+ if (!defined($dbh)) { connectdb(); }
+ my $rows = $dbh->do("UPDATE $table SET $key = ? where $idkey = ?", undef, $val, $idval);
+ if ($rows) {
+ main::debug(ALL, "UPDATE $table SET $key = $val where $idkey = $idval");
+ } else {
+ main::debug(ERRORS, "ERRORS: Failed UPDATE $table SET $key = $val where $idkey = $idval");
+ }
+ return $rows;
+}
+
+# Delete records from $table where $key = $val
+# Returns number of rows deleted
+sub deleterows {
+ my ($table, $key, $val) = @_;
+ if (!defined($dbh)) { connectdb(); }
+ my $rows = $dbh->do("DELETE FROM $table WHERE $key = ?", undef, $val);
+ if ($rows) {
+ main::debug(ALL, "DELETE FROM $table WHERE $key = $val");
+ } else {
+ main::debug(ERRORS, "ERRORS: Failed DELETE FROM $table WHERE $key = $val");
+ }
+ return $rows;
+}
+
+# Returns all records in the database
+sub selectall {
+ my ($table) = @_;
+ if (!defined($dbh)) { connectdb(); }
+ my $sth = $dbh->prepare("SELECT * FROM $table");
+ $sth->execute();
+ my @results;
+ while (my $row = $sth->fetchrow_hashref) {
+ push(@results, $row);
+ }
+ return @results;
+}
+
+# Returns all records from table where key equals value
+sub selectrows {
+ my ($table, $key, $val) = @_;
+ if (!defined($dbh)) { connectdb(); }
+ my $sth = $dbh->prepare("SELECT * FROM $table WHERE $key = ?");
+ $sth->execute($val);
+ my @results;
+ while (my $row = $sth->fetchrow_hashref) {
+ push(@results, $row);
+ }
+ return @results;
+}
+
+# Returns list of tables
+sub tables {
+ # if (!defined($dbh)) { connectdb(); }
+ # my $sth = $dbh->prepare(".tables");
+ # $sth->execute($val);
+ # my @results;
+ # while (my $row = $sth->fetchrow_hashref) {
+ # push(@results, $row);
+ # }
+ # return @results;
+ return qw(bnc shell www irc smtp);
+}
+
+# Returns value of key in record in table where idkey = idval
+sub get {
+ my ($table, $idkey, $idval, $key) = @_;
+ if (!defined($dbh)) { connectdb(); }
+ my $sth = $dbh->prepare("SELECT * FROM $table WHERE $idkey = ?");
+ $sth->execute($idval);
+ if (my $row = $sth->fetchrow_hashref) {
+ my $val = $row->{$key};
+ if (!defined($val)) { $val = "undefined"; }
+ main::debug(ALL, "get: $table $key => $val where $idkey = $idval");
+ return $row->{$key};
+ } else {
+ main::debug(ERRORS, "ERRORS: $table $key undefined where $idkey = $idval");
+ return;
+ }
+}
+
+# Sets value of key in the record in table where idkey = idval
+# Returns true on success; false on failure
+sub set {
+ my ($table, $idkey, $idval, $key, $val) = @_;
+ if (defined(get($table, $idkey, $idval, $idkey))) {
+ main::debug(ALL, "set: update");
+ return updaterow($table, $idkey, $idval, $key, $val) > 0;
+ } else {
+ main::debug(ALL, "set: insert");
+ return insertrow($table, "$idkey,$key", "\"$idval\",\"$val\"") > 0;
+ }
+}
+
+# given a key, val pair in table, return the id that falls within expires seconds
+sub id {
+ my ($table, $key, $val, $expires) = @_;
+ my @rows = selectrows($table, $key, $val);
+ if (scalar(@rows) == 0) {
+ print "table => $table, key => $key, val => $val\n\n";
+ }
+ my $maxrow;
+ foreach my $row (@rows) {
+ if (!defined($maxrow)) { $maxrow = $row; }
+ if ($row->{localtime} > $maxrow->{localtime}) {
+ $maxrow = $row;
+ }
+ }
+ if (abs(time() - $maxrow->{localtime}) <= $expires) {
+ main::debug(ALL, "id: $maxrow->{id} where $key = $val at $expires");
+ return $maxrow->{id};
+ } else {
+ main::debug(ERRORS, "no id found");
+ return;
+ }
+}
+
+1; # MUST BE LAST STATEMENT IN FILE
blob - /dev/null
blob + 89604e329d188258a594ea093765ed66fd511319 (mode 644)
--- /dev/null
+++ lib/BotNow/Sh.pm
+package BotNow::Shell;
+
+use strict;
+use warnings;
+use OpenBSD::Pledge;
+use OpenBSD::Unveil;
+use IRCNOW::IO qw(readarray);
+
+use Data::Dumper;
+
+my $authlog = "/var/log/authlog";
+my $etcpasswd = "/etc/master.passwd";
+my @etcpasswd = readarray($etcpasswd);
+my @users;
+foreach my $line (@etcpasswd) {
+ if ($line =~ /^([^:]+):[^:]+:([^:]+)/) {
+ my ($username, $uid) = ($1, $2);
+ if ($uid > 1000) {
+ push(@users, $username);
+ }
+ }
+}
+my @files = ("/var/log/authlog");
+push(@files, glob q("/var/log/authlog.?"));
+push(@files, glob q("/var/log/authlog.1?"));
+foreach my $user (@users) {
+ my $lastseen;
+ foreach my $file (@files) {
+ my @logs = readarray($file);
+ my @seen = grep(/$user/, @logs);
+ if (scalar(@seen) && $seen[0] =~ /^(\w+ \d+ \d\d:\d\d:\d\d)/) {
+ $lastseen = $1;
+ print "$user => $lastseen\n";
+ last;
+ }
+ }
+ if (!defined($lastseen)) {
+ print "$user => Never logged in\n";
+ }
+}
blob - /dev/null
blob + fa3ded11c573788eb65c0f9795e542bdae3d6399 (mode 644)
--- /dev/null
+++ lib/BotNow/Shell.pm
+package BotNow::Shell;
+
+use strict;
+use warnings;
+use OpenBSD::Pledge;
+use OpenBSD::Unveil;
+use IRCNOW::IO qw(:FILEIO);
+use MIME::Base64;
+use Data::Dumper;
+use Digest::SHA qw(sha256_hex);
+use lib './';
+require "BotNow::SQLite";
+require "BotNow::Hash";
+
+my %conf = %main::conf;
+my $chans = $conf{chans};
+my $teamchans = $conf{teamchans};
+my @teamchans = split /[,\s]+/m, $teamchans;
+my $staff = $conf{staff};
+my $captchaURL = "https://example.com/captcha.php?vhost=";
+my $hostname = $conf{hostname};
+my $terms = $conf{terms};
+my $expires = $conf{expires};
+my $mailfrom = $conf{mailfrom};
+my $mailname = $conf{mailname};
+my $approval = $conf{approval};
+my $passpath = "/etc/passwd";
+my $httpdconfpath = "/etc/httpd.conf";
+my $acmeconfpath = "/etc/acme-client.conf";
+my $pfconfpath = "/etc/pf.conf";
+my $relaydconfpath = "/etc/relayd.conf";
+my $startPort;
+my $endPort;
+
+use constant {
+ NONE => 0,
+ ERRORS => 1,
+ WARNINGS => 2,
+ ALL => 3,
+};
+
+main::cbind("pub", "-", "shell", \&mshell);
+main::cbind("msg", "-", "shell", \&mshell);
+
+sub init {
+ #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 $!";
+ #dependencies for shell account
+ unveil($passpath, "r") or die "Unable to unveil $!";
+ unveil($httpdconfpath, "rwxc") or die "Unable to unveil $!";
+ unveil($acmeconfpath, "rwxc") or die "Unable to unveil $!";
+ unveil($pfconfpath, "rwxc") or die "Unable to unveil $!";
+ unveil($relaydconfpath, "rwxc") or die "Unable to unveil $!";
+ unveil("/usr/sbin/chown", "rx") or die "Unable to unveil $!";
+ unveil("/bin/chmod", "rx") or die "Unable to unveil $!";
+ unveil("/usr/sbin/groupadd", "rx") or die "Unable to unveil $!";
+ unveil("/usr/sbin/useradd", "rx") or die "Unable to unveil $!";
+ unveil("/usr/sbin/usermod", "rx") or die "Unable to unveil $!";
+ unveil("/usr/sbin/groupdel", "rx") or die "Unable to unveil $!";
+ unveil("/usr/sbin/userdel", "rx") or die "Unable to unveil $!";
+ unveil("/bin/mkdir", "rx") or die "Unable to unveil $!";
+ unveil("/bin/ln", "rx") or die "Unable to unveil $!";
+ unveil("/usr/sbin/acme-client", "rx") or die "Unable to unveil $!";
+ unveil("/bin/rm", "rx") or die "Unable to unveil $!";
+ unveil("/bin/mv", "rx") or die "Unable to unveil $!";
+ unveil("/home/", "rwxc") or die "Unable to unveil $!";
+}
+
+# !shell <username> <email>
+# !shell captcha <captcha>
+sub mshell {
+ 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}." with shell registration");
+ }
+ return;
+ } elsif (main::isstaff($bot, $nick) && $text =~ /^delete\s+([[:ascii:]]+)/) {
+ my $username = $1;
+ if (SQLite::deleterows("shell", "username", $username)) {
+ # TODO delete shell
+ deleteshell($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;
+ system "doas usermod -U $username";
+ foreach my $chan (@teamchans) {
+ main::putserv($bot, "PRIVMSG $chan :$username approved");
+ }
+ return;
+ }
+ ### TODO: Check duplicate emails ###
+ my @rows = SQLite::selectrows("irc", "nick", $nick);
+ foreach my $row (@rows) {
+ my $password = SQLite::get("shell", "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 =~ /^lastseen\s+([[:alnum:]]+)/) {
+ }
+ if ($text =~ /^captcha\s+([[:alnum:]]+)/) {
+ my $text = $1;
+ my $ircid = SQLite::id("irc", "nick", $nick, $expires);
+ if (!defined($ircid)) { die "undefined ircid"; }
+ my $captcha = SQLite::get("shell", "ircid", $ircid, "captcha");
+ if ($text ne $captcha) {
+ main::putserv($bot, "PRIVMSG $nick :Wrong captcha. To get a new captcha, type !shell <username> <email>");
+ return;
+ }
+ my $pass = Hash::newpass();
+ chomp(my $encrypted = `encrypt $pass`);
+ my $username = SQLite::get("shell", "ircid", $ircid, "username");
+ my $email = SQLite::get("shell", "ircid", $ircid, "email");
+ my $version = SQLite::get("shell", "ircid", $ircid, "version");
+ my $bindhost = "$username.$hostname";
+ SQLite::set("shell", "ircid", $ircid, "password", $encrypted);
+ if (DNS::nextdns($username)) {
+ sleep(2);
+ createshell($username, $pass, $bindhost);
+ mailshell($username, $email, $pass, "shell", $version);
+ main::putserv($bot, "PRIVMSG $nick :Check your email!");
+ if ($approval eq "true") {
+ system "doas usermod -Z $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 shell 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=Shell.Shell");
+ }
+
+
+ #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 = col($passpath, 1, ":");
+ my @matches = grep(/^$username$/i, @users);
+ if (scalar(@matches) > 0) {
+ main::putserv($bot, "PRIVMSG $nick :Sorry, username taken. Please choose another username, or contact staff for 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(2147483647));
+ SQLite::set("irc", "id", $ircid, "localtime", time());
+ SQLite::set("irc", "id", $ircid, "date", main::date());
+ SQLite::set("irc", "id", $ircid, "hostmask", $hostmask);
+ SQLite::set("irc", "id", $ircid, "nick", $nick);
+ SQLite::set("shell", "ircid", $ircid, "username", $username);
+ SQLite::set("shell", "ircid", $ircid, "email", $email);
+ SQLite::set("shell", "ircid", $ircid, "captcha", $captcha);
+ main::whois($bot->{sock}, $nick);
+ main::ctcp($bot->{sock}, $nick);
+ main::putserv($bot, "PRIVMSG $nick :".`figlet $captcha`);
+ # main::putserv($bot, "PRIVMSG $nick :$captchaURL".encode_base64($captcha));
+ main::putserv($bot, "PRIVMSG $nick :Type !shell captcha <text>");
+ foreach my $chan (@teamchans) {
+ main::putservlocalnet($bot, "PRIVMSG $chan :$nick\'s captcha on $bot->{name} is $captcha");
+ }
+ } else {
+ main::putserv($bot, "PRIVMSG $nick :Invalid username or email. Type !shell <username> <email> to try again.");
+ foreach my $chan (@teamchans) {
+ main::putserv($bot, "PRIVMSG $chan :$staff: Help *$nick* on network ".$bot->{name}." with shell registration");
+ }
+ }
+}
+sub mailshell {
+ my( $username, $email, $password, $service, $version )=@_;
+ my $passhash = sha256_hex("$username");
+ my $versionhash = encode_base64($version);
+ 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";
+You created a shell account!
+
+Username: $username
+Password: $password
+Server: $hostname
+SSH Port: 22
+Your Ports: $startPort to $endPort
+
+To customize your vhost, connect to ask in $chans
+$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 mregex {
+# my ($bot, $nick, $host, $hand, $text) = @_;
+# if ($staff !~ /$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 loadlog {
+# open(my $fh, '<', "$authlog") or die "Could not read file 'authlog' $!";
+# 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 createshell {
+ my ($username, $password, $bindhost) = @_;
+ system "doas groupadd $username";
+ system "doas adduser -batch $username $username $username `encrypt $password`";
+ system "doas chmod 700 /home/$username /home/$username/.ssh";
+ system "doas chmod 600 /home/$username/{.Xdefaults,.cshrc,.cvsrc,.login,.mailrc,.profile}";
+ system "doas mkdir /var/www/htdocs/$username";
+ system "doas ln -s /var/www/htdocs/$username /home/$username/htdocs";
+ system "doas chown -R $username:www /var/www/htdocs/$username /home/$username/htdocs";
+ system "doas chmod -R o-rx /var/www/htdocs/$username /home/$username/htdocs";
+ system "doas chmod -R g+rwx /var/www/htdocs/$username /home/$username/htdocs";
+ system "doas chown root:wheel $httpdconfpath $pfconfpath $acmeconfpath $relaydconfpath";
+ system "doas chmod g+rw $httpdconfpath $pfconfpath $acmeconfpath $relaydconfpath";
+ my $lusername = lc $username;
+ my $block = <<"EOF";
+server "$lusername.$hostname" {
+ listen on * port 80
+ location "/.well-known/acme-challenge/*" {
+ root "/acme"
+ request strip 2
+ }
+ location "*.php" {
+ fastcgi socket "/run/php-fpm.sock"
+ }
+ root "/htdocs/$username"
+}
+EOF
+ appendfile($httpdconfpath, $block);
+ $block = <<"EOF";
+domain "$lusername.$hostname" {
+ domain key "/etc/ssl/private/$lusername.$hostname.key"
+ domain full chain certificate "/etc/ssl/$lusername.$hostname.crt"
+ sign with letsencrypt
+}
+EOF
+ appendfile($acmeconfpath, $block);
+ configurepf($username);
+ system "doas rcctl reload httpd";
+ system "doas acme-client -F $lusername.$hostname";
+ system "doas ln -s /etc/ssl/$lusername.$hostname.crt /etc/ssl/$lusername.$hostname.fullchain.pem";
+ system "doas pfctl -f /etc/pf.conf";
+ configurerelayd($username);
+ $block = <<"EOF";
+~ * * * * acme-client $lusername.$hostname && rcctl reload relayd
+EOF
+ system "echo $block | doas crontab -";
+#edquota $username
+ return 1;
+}
+
+sub deleteshell {
+ my ($username, $bindhost) = @_;
+ my $lusername = lc $username;
+ system "doas chown root:wheel $httpdconfpath $pfconfpath $acmeconfpath $relaydconfpath";
+ system "doas chmod g+rw $httpdconfpath $pfconfpath $acmeconfpath $relaydconfpath";
+ system "doas groupdel $username";
+ system "doas userdel $username";
+ system "doas rm -f /etc/ssl/$lusername.$hostname.crt /etc/ssl/$lusername.$hostname.fullchain.pem /etc/ssl/private/$lusername.$hostname.key";
+ my $httpdconf = readstr($httpdconfpath);
+ my $block = <<"EOF";
+server "$lusername.$hostname" {
+ listen on * port 80
+ location "/.well-known/acme-challenge/*" {
+ root "/acme"
+ request strip 2
+ }
+ location "*.php" {
+ fastcgi socket "/run/php-fpm.sock"
+ }
+ root "/htdocs/$username"
+}
+EOF
+ $block =~ s/{/\\{/gm;
+ $block =~ s/}/\\}/gm;
+ $block =~ s/\./\\./gm;
+ $block =~ s/\*/\\*/gm;
+ $httpdconf =~ s{$block}{}gm;
+ print $httpdconf;
+ writefile($httpdconfpath, $httpdconf);
+
+ my $acmeconf = readstr($acmeconfpath);
+ $block = <<"EOF";
+domain "$lusername.$hostname" {
+ domain key "/etc/ssl/private/$lusername.$hostname.key"
+ domain full chain certificate "/etc/ssl/$lusername.$hostname.fullchain.pem"
+ sign with letsencrypt
+}
+EOF
+ $block =~ s/{/\\{/gm;
+ $block =~ s/}/\\}/gm;
+ $block =~ s/\./\\./gm;
+ $block =~ s/\*/\\*/gm;
+ $acmeconf =~ s{$block}{}gm;
+ writefile($acmeconfpath, $acmeconf);
+ return 1;
+}
+
+#TODO Fix for $i
+# Return column $i from $filename as an array with file separator $FS
+sub col {
+ my ($filename, $i, $FS) = @_;
+ my @rows = readarray($filename);
+ my @results;
+ foreach my $row (@rows) {
+ if ($row =~ /^(.*?)$FS/) {
+ push(@results, $1);
+ }
+ }
+ return @results;
+}
+
+sub configurepf {
+ my $username = shift;
+ my @read = split('\n', readstr($pfconfpath) );
+
+ my $previousline = "";
+ my @pfcontent;
+ foreach my $line(@read)
+ {
+ my $currline = $line;
+ if( $currline ne "# end user ports") {
+ $previousline = $currline;
+ } else {
+ #pass in proto {tcp udp} to port {31361:31370} user {JL}
+ if( $previousline =~ /(\d*):(\d*)/ ) {
+ my $startport = ( $1 + 10 );
+ my $endport = ( $2 + 10 );
+ my $insert = "pass in proto {tcp udp} to port {$startport:$endport} user {$username}";
+ push(@pfcontent, $insert);
+ $startPort = $startport;
+ $endPort = $endport;
+ }
+ }
+ push(@pfcontent, $currline)
+ }
+ writefile("$pfconfpath", join("\n",@pfcontent))
+}
+
+sub configurerelayd {
+ my ($username) = @_;
+ my $block = "tls { keypair $username.$hostname }";
+ my $relaydconf = readstr($relaydconfpath);
+ my $newconf;
+ if ($relaydconf =~ /^.*tls\s+{\s+keypair\s+[.0-9a-zA-Z]+\s*}/m) {
+ $newconf = "$`$&\n\t$block$'";
+ } else {
+ $newconf = $relaydconf;
+ main::debug(ERRORS, "ERROR: regex can't match tls { keypair \$username.$hostname }");
+ }
+ writefile($relaydconfpath, $newconf);
+}
+
+#unveil("./newacct", "rx") or die "Unable to unveil $!";
+1; # MUST BE LAST STATEMENT IN FILE
blob - /dev/null
blob + 3580f76cbf6a6b5df926b6c74d00ccda1ace4e70 (mode 644)
--- /dev/null
+++ lib/BotNow/VPN.pm
+package BotNow::VPN;
+
+use strict;
+use warnings;
+use OpenBSD::Pledge;
+use OpenBSD::Unveil;
+
+sub init {
+}
+# if ($reply =~ /^!vpn (.*) ([-_0-9a-zA-Z]+)$/i) {
+# my $ircnick = $1;
+# my $newnick = $2;
+# if ($staff !~ /$sender/) {
+# return;
+# }
+# my $password = newpass();
+# createvpn($password, $newnick);
+# sendmsg($bot, $sender, "vpn created for $newnick");
+#my $msg = <<"EOF";
+#Your vpn account has been created! Username: $newnick with password: $password
+#Our official support channel is #vpn. To connect, please follow these instructions: https://ircnow.org/kb/doku.php?id=vpn:vpn .
+#EOF
+# sendmsg($bot, $ircnick, $msg);
+# }
+#sub createvpn {
+# my ($password, $username) = @_;
+# `doas sh -c 'echo "user '$username' '$password'" >> /etc/iked.conf'`;
+# `doas rcctl reload iked`;
+#}
+
+1; # MUST BE LAST STATEMENT IN FILE
blob - e893ad49cdec5dd28e79c5a90a5f7fe46ae7bd8a (mode 644)
blob + /dev/null
--- Shell.pm
+++ /dev/null
-#!/usr/bin/perl
-
-package Shell;
-
-use strict;
-use warnings;
-use OpenBSD::Pledge;
-use OpenBSD::Unveil;
-use IRCNOW::IO qw(:FILEIO);
-use MIME::Base64;
-use Data::Dumper;
-use Digest::SHA qw(sha256_hex);
-use lib './';
-require "SQLite.pm";
-require "Hash.pm";
-
-my %conf = %main::conf;
-my $chans = $conf{chans};
-my $teamchans = $conf{teamchans};
-my @teamchans = split /[,\s]+/m, $teamchans;
-my $staff = $conf{staff};
-my $captchaURL = "https://example.com/captcha.php?vhost=";
-my $hostname = $conf{hostname};
-my $terms = $conf{terms};
-my $expires = $conf{expires};
-my $mailfrom = $conf{mailfrom};
-my $mailname = $conf{mailname};
-my $approval = $conf{approval};
-my $passpath = "/etc/passwd";
-my $httpdconfpath = "/etc/httpd.conf";
-my $acmeconfpath = "/etc/acme-client.conf";
-my $pfconfpath = "/etc/pf.conf";
-my $relaydconfpath = "/etc/relayd.conf";
-my $startPort;
-my $endPort;
-
-use constant {
- NONE => 0,
- ERRORS => 1,
- WARNINGS => 2,
- ALL => 3,
-};
-
-main::cbind("pub", "-", "shell", \&mshell);
-main::cbind("msg", "-", "shell", \&mshell);
-
-sub init {
- #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 $!";
- #dependencies for shell account
- unveil($passpath, "r") or die "Unable to unveil $!";
- unveil($httpdconfpath, "rwxc") or die "Unable to unveil $!";
- unveil($acmeconfpath, "rwxc") or die "Unable to unveil $!";
- unveil($pfconfpath, "rwxc") or die "Unable to unveil $!";
- unveil($relaydconfpath, "rwxc") or die "Unable to unveil $!";
- unveil("/usr/sbin/chown", "rx") or die "Unable to unveil $!";
- unveil("/bin/chmod", "rx") or die "Unable to unveil $!";
- unveil("/usr/sbin/groupadd", "rx") or die "Unable to unveil $!";
- unveil("/usr/sbin/useradd", "rx") or die "Unable to unveil $!";
- unveil("/usr/sbin/usermod", "rx") or die "Unable to unveil $!";
- unveil("/usr/sbin/groupdel", "rx") or die "Unable to unveil $!";
- unveil("/usr/sbin/userdel", "rx") or die "Unable to unveil $!";
- unveil("/bin/mkdir", "rx") or die "Unable to unveil $!";
- unveil("/bin/ln", "rx") or die "Unable to unveil $!";
- unveil("/usr/sbin/acme-client", "rx") or die "Unable to unveil $!";
- unveil("/bin/rm", "rx") or die "Unable to unveil $!";
- unveil("/bin/mv", "rx") or die "Unable to unveil $!";
- unveil("/home/", "rwxc") or die "Unable to unveil $!";
-}
-
-# !shell <username> <email>
-# !shell captcha <captcha>
-sub mshell {
- 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}." with shell registration");
- }
- return;
- } elsif (main::isstaff($bot, $nick) && $text =~ /^delete\s+([[:ascii:]]+)/) {
- my $username = $1;
- if (SQLite::deleterows("shell", "username", $username)) {
- # TODO delete shell
- deleteshell($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;
- system "doas usermod -U $username";
- foreach my $chan (@teamchans) {
- main::putserv($bot, "PRIVMSG $chan :$username approved");
- }
- return;
- }
- ### TODO: Check duplicate emails ###
- my @rows = SQLite::selectrows("irc", "nick", $nick);
- foreach my $row (@rows) {
- my $password = SQLite::get("shell", "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 =~ /^lastseen\s+([[:alnum:]]+)/) {
- }
- if ($text =~ /^captcha\s+([[:alnum:]]+)/) {
- my $text = $1;
- my $ircid = SQLite::id("irc", "nick", $nick, $expires);
- if (!defined($ircid)) { die "undefined ircid"; }
- my $captcha = SQLite::get("shell", "ircid", $ircid, "captcha");
- if ($text ne $captcha) {
- main::putserv($bot, "PRIVMSG $nick :Wrong captcha. To get a new captcha, type !shell <username> <email>");
- return;
- }
- my $pass = Hash::newpass();
- chomp(my $encrypted = `encrypt $pass`);
- my $username = SQLite::get("shell", "ircid", $ircid, "username");
- my $email = SQLite::get("shell", "ircid", $ircid, "email");
- my $version = SQLite::get("shell", "ircid", $ircid, "version");
- my $bindhost = "$username.$hostname";
- SQLite::set("shell", "ircid", $ircid, "password", $encrypted);
- if (DNS::nextdns($username)) {
- sleep(2);
- createshell($username, $pass, $bindhost);
- mailshell($username, $email, $pass, "shell", $version);
- main::putserv($bot, "PRIVMSG $nick :Check your email!");
- if ($approval eq "true") {
- system "doas usermod -Z $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 shell 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=Shell.Shell");
- }
-
-
- #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 = col($passpath, 1, ":");
- my @matches = grep(/^$username$/i, @users);
- if (scalar(@matches) > 0) {
- main::putserv($bot, "PRIVMSG $nick :Sorry, username taken. Please choose another username, or contact staff for 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(2147483647));
- SQLite::set("irc", "id", $ircid, "localtime", time());
- SQLite::set("irc", "id", $ircid, "date", main::date());
- SQLite::set("irc", "id", $ircid, "hostmask", $hostmask);
- SQLite::set("irc", "id", $ircid, "nick", $nick);
- SQLite::set("shell", "ircid", $ircid, "username", $username);
- SQLite::set("shell", "ircid", $ircid, "email", $email);
- SQLite::set("shell", "ircid", $ircid, "captcha", $captcha);
- main::whois($bot->{sock}, $nick);
- main::ctcp($bot->{sock}, $nick);
- main::putserv($bot, "PRIVMSG $nick :".`figlet $captcha`);
- # main::putserv($bot, "PRIVMSG $nick :$captchaURL".encode_base64($captcha));
- main::putserv($bot, "PRIVMSG $nick :Type !shell captcha <text>");
- foreach my $chan (@teamchans) {
- main::putservlocalnet($bot, "PRIVMSG $chan :$nick\'s captcha on $bot->{name} is $captcha");
- }
- } else {
- main::putserv($bot, "PRIVMSG $nick :Invalid username or email. Type !shell <username> <email> to try again.");
- foreach my $chan (@teamchans) {
- main::putserv($bot, "PRIVMSG $chan :$staff: Help *$nick* on network ".$bot->{name}." with shell registration");
- }
- }
-}
-sub mailshell {
- my( $username, $email, $password, $service, $version )=@_;
- my $passhash = sha256_hex("$username");
- my $versionhash = encode_base64($version);
- 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";
-You created a shell account!
-
-Username: $username
-Password: $password
-Server: $hostname
-SSH Port: 22
-Your Ports: $startPort to $endPort
-
-To customize your vhost, connect to ask in $chans
-$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 mregex {
-# my ($bot, $nick, $host, $hand, $text) = @_;
-# if ($staff !~ /$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 loadlog {
-# open(my $fh, '<', "$authlog") or die "Could not read file 'authlog' $!";
-# 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 createshell {
- my ($username, $password, $bindhost) = @_;
- system "doas groupadd $username";
- system "doas adduser -batch $username $username $username `encrypt $password`";
- system "doas chmod 700 /home/$username /home/$username/.ssh";
- system "doas chmod 600 /home/$username/{.Xdefaults,.cshrc,.cvsrc,.login,.mailrc,.profile}";
- system "doas mkdir /var/www/htdocs/$username";
- system "doas ln -s /var/www/htdocs/$username /home/$username/htdocs";
- system "doas chown -R $username:www /var/www/htdocs/$username /home/$username/htdocs";
- system "doas chmod -R o-rx /var/www/htdocs/$username /home/$username/htdocs";
- system "doas chmod -R g+rwx /var/www/htdocs/$username /home/$username/htdocs";
- system "doas chown root:wheel $httpdconfpath $pfconfpath $acmeconfpath $relaydconfpath";
- system "doas chmod g+rw $httpdconfpath $pfconfpath $acmeconfpath $relaydconfpath";
- my $lusername = lc $username;
- my $block = <<"EOF";
-server "$lusername.$hostname" {
- listen on * port 80
- location "/.well-known/acme-challenge/*" {
- root "/acme"
- request strip 2
- }
- location "*.php" {
- fastcgi socket "/run/php-fpm.sock"
- }
- root "/htdocs/$username"
-}
-EOF
- appendfile($httpdconfpath, $block);
- $block = <<"EOF";
-domain "$lusername.$hostname" {
- domain key "/etc/ssl/private/$lusername.$hostname.key"
- domain full chain certificate "/etc/ssl/$lusername.$hostname.crt"
- sign with letsencrypt
-}
-EOF
- appendfile($acmeconfpath, $block);
- configurepf($username);
- system "doas rcctl reload httpd";
- system "doas acme-client -F $lusername.$hostname";
- system "doas ln -s /etc/ssl/$lusername.$hostname.crt /etc/ssl/$lusername.$hostname.fullchain.pem";
- system "doas pfctl -f /etc/pf.conf";
- configurerelayd($username);
- $block = <<"EOF";
-~ * * * * acme-client $lusername.$hostname && rcctl reload relayd
-EOF
- system "echo $block | doas crontab -";
-#edquota $username
- return 1;
-}
-
-sub deleteshell {
- my ($username, $bindhost) = @_;
- my $lusername = lc $username;
- system "doas chown root:wheel $httpdconfpath $pfconfpath $acmeconfpath $relaydconfpath";
- system "doas chmod g+rw $httpdconfpath $pfconfpath $acmeconfpath $relaydconfpath";
- system "doas groupdel $username";
- system "doas userdel $username";
- system "doas rm -f /etc/ssl/$lusername.$hostname.crt /etc/ssl/$lusername.$hostname.fullchain.pem /etc/ssl/private/$lusername.$hostname.key";
- my $httpdconf = readstr($httpdconfpath);
- my $block = <<"EOF";
-server "$lusername.$hostname" {
- listen on * port 80
- location "/.well-known/acme-challenge/*" {
- root "/acme"
- request strip 2
- }
- location "*.php" {
- fastcgi socket "/run/php-fpm.sock"
- }
- root "/htdocs/$username"
-}
-EOF
- $block =~ s/{/\\{/gm;
- $block =~ s/}/\\}/gm;
- $block =~ s/\./\\./gm;
- $block =~ s/\*/\\*/gm;
- $httpdconf =~ s{$block}{}gm;
- print $httpdconf;
- writefile($httpdconfpath, $httpdconf);
-
- my $acmeconf = readstr($acmeconfpath);
- $block = <<"EOF";
-domain "$lusername.$hostname" {
- domain key "/etc/ssl/private/$lusername.$hostname.key"
- domain full chain certificate "/etc/ssl/$lusername.$hostname.fullchain.pem"
- sign with letsencrypt
-}
-EOF
- $block =~ s/{/\\{/gm;
- $block =~ s/}/\\}/gm;
- $block =~ s/\./\\./gm;
- $block =~ s/\*/\\*/gm;
- $acmeconf =~ s{$block}{}gm;
- writefile($acmeconfpath, $acmeconf);
- return 1;
-}
-
-#TODO Fix for $i
-# Return column $i from $filename as an array with file separator $FS
-sub col {
- my ($filename, $i, $FS) = @_;
- my @rows = readarray($filename);
- my @results;
- foreach my $row (@rows) {
- if ($row =~ /^(.*?)$FS/) {
- push(@results, $1);
- }
- }
- return @results;
-}
-
-sub configurepf {
- my $username = shift;
- my @read = split('\n', readstr($pfconfpath) );
-
- my $previousline = "";
- my @pfcontent;
- foreach my $line(@read)
- {
- my $currline = $line;
- if( $currline ne "# end user ports") {
- $previousline = $currline;
- } else {
- #pass in proto {tcp udp} to port {31361:31370} user {JL}
- if( $previousline =~ /(\d*):(\d*)/ ) {
- my $startport = ( $1 + 10 );
- my $endport = ( $2 + 10 );
- my $insert = "pass in proto {tcp udp} to port {$startport:$endport} user {$username}";
- push(@pfcontent, $insert);
- $startPort = $startport;
- $endPort = $endport;
- }
- }
- push(@pfcontent, $currline)
- }
- writefile("$pfconfpath", join("\n",@pfcontent))
-}
-
-sub configurerelayd {
- my ($username) = @_;
- my $block = "tls { keypair $username.$hostname }";
- my $relaydconf = readstr($relaydconfpath);
- my $newconf;
- if ($relaydconf =~ /^.*tls\s+{\s+keypair\s+[.0-9a-zA-Z]+\s*}/m) {
- $newconf = "$`$&\n\t$block$'";
- } else {
- $newconf = $relaydconf;
- main::debug(ERRORS, "ERROR: regex can't match tls { keypair \$username.$hostname }");
- }
- writefile($relaydconfpath, $newconf);
-}
-
-#unveil("./newacct", "rx") or die "Unable to unveil $!";
-1; # MUST BE LAST STATEMENT IN FILE
blob - 1d5af6d5879fc9494712adb399e02c47fe2dcd9c (mode 644)
blob + /dev/null
--- VPN.pm
+++ /dev/null
-#!/usr/bin/perl
-
-package VPN;
-
-use strict;
-use warnings;
-use OpenBSD::Pledge;
-use OpenBSD::Unveil;
-
-sub init {
-}
-# if ($reply =~ /^!vpn (.*) ([-_0-9a-zA-Z]+)$/i) {
-# my $ircnick = $1;
-# my $newnick = $2;
-# if ($staff !~ /$sender/) {
-# return;
-# }
-# my $password = newpass();
-# createvpn($password, $newnick);
-# sendmsg($bot, $sender, "vpn created for $newnick");
-#my $msg = <<"EOF";
-#Your vpn account has been created! Username: $newnick with password: $password
-#Our official support channel is #vpn. To connect, please follow these instructions: https://ircnow.org/kb/doku.php?id=vpn:vpn .
-#EOF
-# sendmsg($bot, $ircnick, $msg);
-# }
-#sub createvpn {
-# my ($password, $username) = @_;
-# `doas sh -c 'echo "user '$username' '$password'" >> /etc/iked.conf'`;
-# `doas rcctl reload iked`;
-#}
-
-1; # MUST BE LAST STATEMENT IN FILE
blob - 2507d2f20186a48c5a30430971fc10f51c0c5e3d
blob + 3fbd20a8d09035d8cdf8d805e184dbb5f16123e2
--- botnow
+++ botnow
if (defined($conf{modules})) {
@modules = split(/\s+/, $conf{modules});
}
-use lib './';
+use lib './lib';
foreach my $mod (@modules) {
- require "$mod.pm";
+ require "BotNow::$mod";
}
foreach my $mod (@modules) {
- my $init = "${mod}::init";
+ my $init = "BotNow::${mod}::init";
$init->();
}
