Blame


1 84c190b6 2021-12-17 jrmu #!/usr/bin/perl
2 84c190b6 2021-12-17 jrmu
3 84c190b6 2021-12-17 jrmu package BNC;
4 84c190b6 2021-12-17 jrmu
5 84c190b6 2021-12-17 jrmu use strict;
6 84c190b6 2021-12-17 jrmu use warnings;
7 84c190b6 2021-12-17 jrmu use OpenBSD::Pledge;
8 84c190b6 2021-12-17 jrmu use OpenBSD::Unveil;
9 eea90820 2023-02-26 jrmu use Digest::SHA qw(sha256_hex);
10 84c190b6 2021-12-17 jrmu use lib './';
11 84c190b6 2021-12-17 jrmu require "SQLite.pm";
12 84c190b6 2021-12-17 jrmu require "Hash.pm";
13 84c190b6 2021-12-17 jrmu require "DNS.pm";
14 84c190b6 2021-12-17 jrmu require "Mail.pm";
15 84c190b6 2021-12-17 jrmu
16 84c190b6 2021-12-17 jrmu my %conf = %main::conf;
17 84c190b6 2021-12-17 jrmu my $chans = $conf{chans};
18 84c190b6 2021-12-17 jrmu my $teamchans = $conf{teamchans};
19 84c190b6 2021-12-17 jrmu my @teamchans = split /[,\s]+/m, $teamchans;
20 84c190b6 2021-12-17 jrmu my $staff = $conf{staff};
21 84c190b6 2021-12-17 jrmu my $zncdir = $conf{zncdir};
22 84c190b6 2021-12-17 jrmu my $znclog = $conf{znclog} || "$zncdir/.znc/moddata/adminlog/znc.log";
23 84c190b6 2021-12-17 jrmu my $hostname = $conf{hostname};
24 8c245946 2023-06-11 jrmu my $bnchostname = $conf{bnchostname};
25 84c190b6 2021-12-17 jrmu my $terms = $conf{terms};
26 84c190b6 2021-12-17 jrmu my @logs;
27 84c190b6 2021-12-17 jrmu my $expires = $conf{expires};
28 84c190b6 2021-12-17 jrmu my $sslport = $conf{sslport};
29 84c190b6 2021-12-17 jrmu my $plainport = $conf{plainport};
30 84c190b6 2021-12-17 jrmu my $mailfrom = $conf{mailfrom};
31 84c190b6 2021-12-17 jrmu my $mailname = $conf{mailname};
32 62fb7e83 2023-03-05 jrmu my $approval = $conf{approval};
33 c023ac0c 2023-03-06 jrmu my $webpanel = $conf{webpanel};
34 b2b6fd90 2023-02-17 jrmu # File containing IRC networks
35 b2b6fd90 2023-02-17 jrmu my $netpath = "networks";
36 b2b6fd90 2023-02-17 jrmu my @networks;
37 84c190b6 2021-12-17 jrmu
38 84c190b6 2021-12-17 jrmu use constant {
39 84c190b6 2021-12-17 jrmu NONE => 0,
40 84c190b6 2021-12-17 jrmu ERRORS => 1,
41 84c190b6 2021-12-17 jrmu WARNINGS => 2,
42 84c190b6 2021-12-17 jrmu ALL => 3,
43 84c190b6 2021-12-17 jrmu };
44 84c190b6 2021-12-17 jrmu
45 84c190b6 2021-12-17 jrmu `doas chmod g+r /home/znc/home/znc/.znc/`;
46 84c190b6 2021-12-17 jrmu my @users;
47 84c190b6 2021-12-17 jrmu main::cbind("pub", "-", "bnc", \&mbnc);
48 84c190b6 2021-12-17 jrmu main::cbind("msg", "-", "bnc", \&mbnc);
49 84c190b6 2021-12-17 jrmu main::cbind("msg", "-", "regex", \&mregex);
50 84c190b6 2021-12-17 jrmu main::cbind("msg", "-", "foreach", \&mforeach);
51 84c190b6 2021-12-17 jrmu main::cbind("msgm", "-", "*", \&mcontrolpanel);
52 84c190b6 2021-12-17 jrmu main::cbind("msg", "-", "taillog", \&mtaillog);
53 84c190b6 2021-12-17 jrmu main::cbind("msg", "-", "lastseen", \&mlastseen);
54 84c190b6 2021-12-17 jrmu
55 81c6ff6c 2023-02-23 jrmu sub init {
56 81c6ff6c 2023-02-23 jrmu unveil("/usr/local/bin/figlet", "rx") or die "Unable to unveil $!";
57 81c6ff6c 2023-02-23 jrmu unveil("/usr/lib/libc.so.95.1", "r") or die "Unable to unveil $!";
58 81c6ff6c 2023-02-23 jrmu unveil("/usr/libexec/ld.so", "r") or die "Unable to unveil $!";
59 81c6ff6c 2023-02-23 jrmu unveil("/usr/bin/tail", "rx") or die "Unable to unveil $!";
60 81c6ff6c 2023-02-23 jrmu unveil("$netpath", "r") or die "Unable to unveil $!";
61 81c6ff6c 2023-02-23 jrmu
62 81c6ff6c 2023-02-23 jrmu @networks = readnetworks($netpath);
63 81c6ff6c 2023-02-23 jrmu
64 81c6ff6c 2023-02-23 jrmu # networks must be sorted to avoid multiple connections
65 81c6ff6c 2023-02-23 jrmu @networks = sort @networks;
66 81c6ff6c 2023-02-23 jrmu }
67 81c6ff6c 2023-02-23 jrmu
68 b2b6fd90 2023-02-17 jrmu # Return list of networks from filename
69 b2b6fd90 2023-02-17 jrmu # To add multiple servers for a single network, simply create a new entry with
70 b2b6fd90 2023-02-17 jrmu # the same net name; znc ignores addnetwork commands when a network already exists
71 b2b6fd90 2023-02-17 jrmu sub readnetworks {
72 b2b6fd90 2023-02-17 jrmu my ($filename) = @_;
73 b2b6fd90 2023-02-17 jrmu my @lines = main::readarray($filename);
74 b2b6fd90 2023-02-17 jrmu my @networks;
75 b2b6fd90 2023-02-17 jrmu foreach my $line (@lines) {
76 b2b6fd90 2023-02-17 jrmu if ($line =~ /^#/ or $line =~ /^\s*$/) { # skip comments and whitespace
77 b2b6fd90 2023-02-17 jrmu next;
78 b2b6fd90 2023-02-17 jrmu } elsif ($line =~ /^\s*([-a-zA-Z0-9]+)\s*([-_.:a-zA-Z0-9]+)\s*(~|\+)?([0-9]+)\s*$/) {
79 b2b6fd90 2023-02-17 jrmu my ($name, $server, $port) = ($1, $2, $4);
80 b2b6fd90 2023-02-17 jrmu my $trustcerts;
81 b2b6fd90 2023-02-17 jrmu if (!defined($3)) {
82 b2b6fd90 2023-02-17 jrmu $trustcerts = 0;
83 b2b6fd90 2023-02-17 jrmu } elsif ($3 eq "~") { # Use SSL but trust all certs
84 b2b6fd90 2023-02-17 jrmu $port = "+".$port;
85 b2b6fd90 2023-02-17 jrmu $trustcerts = 1;
86 b2b6fd90 2023-02-17 jrmu } else { # Use SSL and verify certs
87 b2b6fd90 2023-02-17 jrmu $port = "+".$port;
88 b2b6fd90 2023-02-17 jrmu $trustcerts = 0;
89 b2b6fd90 2023-02-17 jrmu }
90 b2b6fd90 2023-02-17 jrmu push(@networks, {"name" => $name, "server" => $server, "port" => $port, "trustcerts" => $trustcerts });
91 b2b6fd90 2023-02-17 jrmu } else {
92 b2b6fd90 2023-02-17 jrmu die "network format invalid: $line\n";
93 b2b6fd90 2023-02-17 jrmu }
94 b2b6fd90 2023-02-17 jrmu }
95 b2b6fd90 2023-02-17 jrmu return @networks;
96 84c190b6 2021-12-17 jrmu }
97 84c190b6 2021-12-17 jrmu
98 84c190b6 2021-12-17 jrmu sub mbnc {
99 84c190b6 2021-12-17 jrmu my ($bot, $nick, $host, $hand, @args) = @_;
100 84c190b6 2021-12-17 jrmu my ($chan, $text);
101 84c190b6 2021-12-17 jrmu if (@args == 2) {
102 84c190b6 2021-12-17 jrmu ($chan, $text) = ($args[0], $args[1]);
103 84c190b6 2021-12-17 jrmu } else { $text = $args[0]; }
104 84c190b6 2021-12-17 jrmu my $hostmask = "$nick!$host";
105 84c190b6 2021-12-17 jrmu if (defined($chan) && $chans =~ /$chan/) {
106 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG $chan :$nick: Please check private message");
107 84c190b6 2021-12-17 jrmu }
108 84c190b6 2021-12-17 jrmu if ($text =~ /^$/) {
109 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG $nick :Type !help for new instructions");
110 84c190b6 2021-12-17 jrmu foreach my $chan (@teamchans) {
111 5f3272f3 2023-03-01 jrmu main::putservlocalnet($bot, "PRIVMSG $chan :$staff: Help *$nick* on network ".$bot->{name});
112 84c190b6 2021-12-17 jrmu }
113 84c190b6 2021-12-17 jrmu return;
114 84c190b6 2021-12-17 jrmu } elsif (main::isstaff($bot, $nick) && $text =~ /^delete\s+([[:ascii:]]+)/) {
115 84c190b6 2021-12-17 jrmu my $username = $1;
116 84c190b6 2021-12-17 jrmu if (SQLite::deleterows("bnc", "username", $username)) {
117 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG *controlpanel :deluser $username");
118 84c190b6 2021-12-17 jrmu foreach my $chan (@teamchans) {
119 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG $chan :$username deleted");
120 84c190b6 2021-12-17 jrmu }
121 84c190b6 2021-12-17 jrmu }
122 84c190b6 2021-12-17 jrmu return;
123 ccc446d9 2023-03-05 jrmu } elsif (main::isstaff($bot, $nick) && $text =~ /^approve\s+([[:ascii:]]+)/) {
124 717afa50 2023-03-05 jrmu my $username = $1;
125 edcb1b2b 2023-05-06 jrmu if (SQLite::selectrows("bnc", "username", $username)) {
126 4bac7b57 2023-06-30 jrmu my $email = SQLite::get("bnc", "username", $username, "email");
127 4bac7b57 2023-06-30 jrmu my $password = Hash::newpass();
128 4bac7b57 2023-06-30 jrmu main::putserv($bot,"privmsg *controlpanel :set Password $username $password");
129 4bac7b57 2023-06-30 jrmu main::putserv($bot, "PRIVMSG *blockuser :unblock $username");
130 4bac7b57 2023-06-30 jrmu mailbncApproved($username,$email,$password);
131 edcb1b2b 2023-05-06 jrmu foreach my $chan (@teamchans) {
132 ccc446d9 2023-03-05 jrmu main::putserv($bot, "PRIVMSG $chan :$username bnc approved");
133 edcb1b2b 2023-05-06 jrmu }
134 edcb1b2b 2023-05-06 jrmu } else {
135 edcb1b2b 2023-05-06 jrmu main::putserv($bot, "PRIVMSG $chan :$username hasn't requested a bnc account");
136 717afa50 2023-03-05 jrmu }
137 73a53a9f 2023-03-05 jrmu return;
138 84c190b6 2021-12-17 jrmu } elsif ($staff =~ /$nick/ && $text =~ /^cloneuser$/i) {
139 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG *controlpanel :deluser cloneuser");
140 84c190b6 2021-12-17 jrmu sleep 3;
141 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG *controlpanel :get Nick cloneuser");
142 84c190b6 2021-12-17 jrmu }
143 81c6ff6c 2023-02-23 jrmu ### Check duplicate hostmasks ###
144 84c190b6 2021-12-17 jrmu my @rows = SQLite::selectrows("irc", "hostmask", $hostmask);
145 84c190b6 2021-12-17 jrmu foreach my $row (@rows) {
146 84c190b6 2021-12-17 jrmu my $password = SQLite::get("bnc", "ircid", $row->{id}, "password");
147 84c190b6 2021-12-17 jrmu if (defined($password)) {
148 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG $nick :Sorry, only one account per person. Please contact staff if you need help.");
149 84c190b6 2021-12-17 jrmu return;
150 84c190b6 2021-12-17 jrmu }
151 84c190b6 2021-12-17 jrmu }
152 81c6ff6c 2023-02-23 jrmu
153 84c190b6 2021-12-17 jrmu if ($text =~ /^captcha\s+([[:alnum:]]+)/) {
154 84c190b6 2021-12-17 jrmu my $text = $1;
155 84c190b6 2021-12-17 jrmu # TODO avoid using host mask because cloaking can cause problems
156 84c190b6 2021-12-17 jrmu my $ircid = SQLite::id("irc", "nick", $nick, $expires);
157 84c190b6 2021-12-17 jrmu my $captcha = SQLite::get("bnc", "ircid", $ircid, "captcha");
158 84c190b6 2021-12-17 jrmu if ($text ne $captcha) {
159 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG $nick :Wrong captcha. To get a new captcha, type !bnc <username> <email>");
160 84c190b6 2021-12-17 jrmu return;
161 84c190b6 2021-12-17 jrmu }
162 84c190b6 2021-12-17 jrmu my $pass = Hash::newpass();
163 84c190b6 2021-12-17 jrmu chomp(my $encrypted = `encrypt $pass`);
164 84c190b6 2021-12-17 jrmu my $username = SQLite::get("bnc", "ircid", $ircid, "username");
165 84c190b6 2021-12-17 jrmu my $email = SQLite::get("bnc", "ircid", $ircid, "email");
166 84c190b6 2021-12-17 jrmu my $hashirc = SQLite::get("irc", "id", $ircid, "hashid");
167 84c190b6 2021-12-17 jrmu my $bindhost = "$username.$hostname";
168 84c190b6 2021-12-17 jrmu SQLite::set("bnc", "ircid", $ircid, "password", $encrypted);
169 84c190b6 2021-12-17 jrmu if (DNS::nextdns($username)) {
170 84c190b6 2021-12-17 jrmu sleep(2);
171 84c190b6 2021-12-17 jrmu createbnc($bot, $username, $pass, $bindhost);
172 62fb7e83 2023-03-05 jrmu if ($approval eq "true") {
173 62fb7e83 2023-03-05 jrmu main::putserv($bot, "PRIVMSG *blockuser :block $username");
174 4bac7b57 2023-06-30 jrmu main::putserv($bot, "PRIVMSG $nick :Your account has been created but must be approved by your admins ($staff) before it can be used. Please reply to the email and contact staff over IRC.");
175 4bac7b57 2023-06-30 jrmu mailbncPending($username, $email);
176 4bac7b57 2023-06-30 jrmu foreach my $chan (@teamchans) {
177 4bac7b57 2023-06-30 jrmu main::putservlocalnet($bot, "PRIVMSG $chan :$staff: To approve $nick, you must type !bnc approve $username");
178 62fb7e83 2023-03-05 jrmu }
179 4bac7b57 2023-06-30 jrmu } else {
180 4bac7b57 2023-06-30 jrmu main::putserv($bot, "PRIVMSG $nick :Check your email! Please reply to the email and contact staff over IRC.");
181 4bac7b57 2023-06-30 jrmu mailbncApproved($username,$email,$pass);
182 62fb7e83 2023-03-05 jrmu }
183 5f3272f3 2023-03-01 jrmu foreach my $chan (@teamchans) {
184 8f114ba7 2023-03-06 jrmu 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");
185 5f3272f3 2023-03-01 jrmu }
186 84c190b6 2021-12-17 jrmu #www($newnick, $reply, $password, "bouncer");
187 84c190b6 2021-12-17 jrmu } else {
188 84c190b6 2021-12-17 jrmu foreach my $chan (@teamchans) {
189 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG $chan :Assigning bindhost $bindhost failed");
190 84c190b6 2021-12-17 jrmu }
191 84c190b6 2021-12-17 jrmu }
192 84c190b6 2021-12-17 jrmu return;
193 84c190b6 2021-12-17 jrmu } elsif ($text =~ /^([[:alnum:]]+)\s+([[:ascii:]]+)/) {
194 84c190b6 2021-12-17 jrmu my ($username, $email) = ($1, $2);
195 87c2ee73 2023-10-08 izzyb #XXX Check if this user is staff - hotfix for bug
196 d90e80ee 2023-10-08 izzyb if (bncExists($bot,$username)) {
197 87c2ee73 2023-10-08 izzyb main::putserv($bot, "PRIVMSG $nick :Sorry, that account already exists");
198 87c2ee73 2023-10-08 izzyb return;
199 87c2ee73 2023-10-08 izzyb }
200 81c6ff6c 2023-02-23 jrmu my @userrows = SQLite::selectrows("bnc", "username", $username);
201 8054114a 2023-02-26 jrmu foreach my $row (@userrows) {
202 8054114a 2023-02-26 jrmu my $password = SQLite::get("bnc", "ircid", $row->{id}, "password");
203 8054114a 2023-02-26 jrmu if (defined($password)) {
204 8054114a 2023-02-26 jrmu main::putserv($bot, "PRIVMSG $nick :Sorry, only one account per person. Please contact staff if you need help.");
205 8054114a 2023-02-26 jrmu return;
206 8054114a 2023-02-26 jrmu }
207 8054114a 2023-02-26 jrmu }
208 81c6ff6c 2023-02-23 jrmu my @emailrows = SQLite::selectrows("bnc", "email", $email);
209 8054114a 2023-02-26 jrmu foreach my $row (@userrows) {
210 63a16544 2023-02-25 jrmu my $password = SQLite::get("bnc", "ircid", $row->{id}, "password");
211 81c6ff6c 2023-02-23 jrmu if (defined($password)) {
212 81c6ff6c 2023-02-23 jrmu main::putserv($bot, "PRIVMSG $nick :Sorry, only one account per person. Please contact staff if you need help.");
213 81c6ff6c 2023-02-23 jrmu return;
214 81c6ff6c 2023-02-23 jrmu }
215 81c6ff6c 2023-02-23 jrmu }
216 81c6ff6c 2023-02-23 jrmu
217 84c190b6 2021-12-17 jrmu # my @users = treeget($znctree, "User", "Node");
218 84c190b6 2021-12-17 jrmu foreach my $user (@users) {
219 84c190b6 2021-12-17 jrmu if ($user eq $username) {
220 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG $nick :Sorry, username taken. Please contact staff if you need help.");
221 84c190b6 2021-12-17 jrmu return;
222 84c190b6 2021-12-17 jrmu }
223 84c190b6 2021-12-17 jrmu }
224 81c6ff6c 2023-02-23 jrmu
225 84c190b6 2021-12-17 jrmu #my $captcha = join'', map +(0..9,'a'..'z','A'..'Z')[rand(10+26*2)], 1..4;
226 84c190b6 2021-12-17 jrmu my $captcha = int(rand(999));
227 84c190b6 2021-12-17 jrmu my $ircid = int(rand(9223372036854775807));
228 84c190b6 2021-12-17 jrmu my $hashid = sha256_hex("$ircid");
229 84c190b6 2021-12-17 jrmu SQLite::set("irc", "id", $ircid, "localtime", time());
230 84c190b6 2021-12-17 jrmu SQLite::set("irc", "id", $ircid, "hashid", sha256_hex($ircid));
231 84c190b6 2021-12-17 jrmu SQLite::set("irc", "id", $ircid, "date", main::date());
232 84c190b6 2021-12-17 jrmu SQLite::set("irc", "id", $ircid, "hostmask", $hostmask);
233 84c190b6 2021-12-17 jrmu SQLite::set("irc", "id", $ircid, "nick", $nick);
234 84c190b6 2021-12-17 jrmu SQLite::set("bnc", "ircid", $ircid, "username", $username);
235 84c190b6 2021-12-17 jrmu SQLite::set("bnc", "ircid", $ircid, "email", $email);
236 84c190b6 2021-12-17 jrmu SQLite::set("bnc", "ircid", $ircid, "captcha", $captcha);
237 84c190b6 2021-12-17 jrmu SQLite::set("bnc", "ircid", $ircid, "hashid", $hashid);
238 bcee9bd5 2023-08-01 jrmu main::whois($bot, $nick);
239 bcee9bd5 2023-08-01 jrmu main::ctcp($bot, $nick);
240 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG $nick :".`figlet $captcha`);
241 7aeaeb38 2023-02-23 jrmu #main::putserv($bot, "PRIVMSG $nick :https://$hostname/$hashid/captcha.png");
242 7aeaeb38 2023-02-23 jrmu #main::putserv($bot, "PRIVMSG $nick :https://$hostname/register.php?hashirc=$hashid");
243 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG $nick :Type !bnc captcha <text>");
244 84c190b6 2021-12-17 jrmu foreach my $chan (@teamchans) {
245 84c190b6 2021-12-17 jrmu main::putservlocalnet($bot, "PRIVMSG $chan :$nick\'s on $bot->{name} bnc captcha is $captcha");
246 84c190b6 2021-12-17 jrmu }
247 84c190b6 2021-12-17 jrmu } else {
248 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG $nick :Invalid username or email. Type !bnc <username> <email> to try again.");
249 84c190b6 2021-12-17 jrmu foreach my $chan (@teamchans) {
250 12a821c6 2023-03-06 jrmu main::putservlocalnet($bot, "PRIVMSG $chan :$staff: Help *$nick* on network ".$bot->{name});
251 84c190b6 2021-12-17 jrmu }
252 84c190b6 2021-12-17 jrmu }
253 84c190b6 2021-12-17 jrmu }
254 84c190b6 2021-12-17 jrmu
255 84c190b6 2021-12-17 jrmu sub mregex {
256 84c190b6 2021-12-17 jrmu my ($bot, $nick, $host, $hand, $text) = @_;
257 84c190b6 2021-12-17 jrmu if (!main::isstaff($bot, $nick)) { return; }
258 84c190b6 2021-12-17 jrmu if ($text =~ /^ips?\s+([-_()|0-9A-Za-z:\.?*\s]{3,})$/) {
259 84c190b6 2021-12-17 jrmu my $ips = $1; # space-separated list of IPs
260 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG $nick :".regexlist($ips));
261 84c190b6 2021-12-17 jrmu } elsif ($text =~ /^users?\s+([-_()|0-9A-Za-z:\.?*\s]{3,})$/) {
262 84c190b6 2021-12-17 jrmu my $users = $1; # space-separated list of usernames
263 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG $nick :".regexlist($users));
264 84c190b6 2021-12-17 jrmu } elsif ($text =~ /^[-_()|0-9A-Za-z:,\.?*\s]{3,}$/) {
265 84c190b6 2021-12-17 jrmu my @lines = regex($text);
266 84c190b6 2021-12-17 jrmu foreach my $l (@lines) { print "$l\n"; }
267 84c190b6 2021-12-17 jrmu }
268 84c190b6 2021-12-17 jrmu }
269 84c190b6 2021-12-17 jrmu sub mforeach {
270 84c190b6 2021-12-17 jrmu my ($bot, $nick, $host, $hand, $text) = @_;
271 84c190b6 2021-12-17 jrmu if ($staff !~ /$nick/) { return; }
272 84c190b6 2021-12-17 jrmu if ($text =~ /^network\s+del\s+([[:graph:]]+)\s+(#[[:graph:]]+)$/) {
273 84c190b6 2021-12-17 jrmu my ($user, $chan) = ($1, $2);
274 b2b6fd90 2023-02-17 jrmu foreach my $n (@networks) {
275 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG *controlpanel :delchan $user $n->{name} $chan");
276 84c190b6 2021-12-17 jrmu }
277 84c190b6 2021-12-17 jrmu }
278 84c190b6 2021-12-17 jrmu }
279 84c190b6 2021-12-17 jrmu
280 84c190b6 2021-12-17 jrmu sub mcontrolpanel {
281 84c190b6 2021-12-17 jrmu my ($bot, $nick, $host, $hand, @args) = @_;
282 84c190b6 2021-12-17 jrmu my ($chan, $text);
283 84c190b6 2021-12-17 jrmu if (@args == 2) {
284 84c190b6 2021-12-17 jrmu ($chan, $text) = ($args[0], $args[1]);
285 84c190b6 2021-12-17 jrmu } else { $text = $args[0]; }
286 84c190b6 2021-12-17 jrmu my $hostmask = "$nick!$host";
287 84c190b6 2021-12-17 jrmu if($hostmask eq '*controlpanel!znc@znc.in') {
288 84c190b6 2021-12-17 jrmu if ($text =~ /^Error: User \[cloneuser\] does not exist/) {
289 84c190b6 2021-12-17 jrmu createclone($bot);
290 8de79cd0 2023-03-06 jrmu main::putserv($bot, "PRIVMSG *status :loadmod blockuser");
291 84c190b6 2021-12-17 jrmu foreach my $chan (@teamchans) {
292 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG $chan :Cloneuser created");
293 84c190b6 2021-12-17 jrmu }
294 84c190b6 2021-12-17 jrmu } elsif ($text =~ /^User (.*) added!$/) {
295 84c190b6 2021-12-17 jrmu main::debug(ALL, "User $1 created");
296 84c190b6 2021-12-17 jrmu } elsif ($text =~ /^Password has been changed!$/) {
297 84c190b6 2021-12-17 jrmu main::debug(ALL, "Password changed");
298 84c190b6 2021-12-17 jrmu } elsif ($text =~ /^Queued network (.*) of user (.*) for a reconnect.$/) {
299 84c190b6 2021-12-17 jrmu main::debug(ALL, "$2 now connecting to $1...");
300 84c190b6 2021-12-17 jrmu } elsif ($text =~ /^Admin = false/) {
301 84c190b6 2021-12-17 jrmu foreach my $chan (@teamchans) {
302 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG $chan :ERROR: $nick is not admin");
303 84c190b6 2021-12-17 jrmu }
304 84c190b6 2021-12-17 jrmu die "ERROR: $nick is not admin";
305 84c190b6 2021-12-17 jrmu } elsif ($text =~ /^Admin = true/) {
306 84c190b6 2021-12-17 jrmu main::debug(ALL, "$nick is ZNC admin");
307 84c190b6 2021-12-17 jrmu } elsif ($text =~ /(.*) = (.*)/) {
308 84c190b6 2021-12-17 jrmu my ($key, $val) = ($1, $2);
309 84c190b6 2021-12-17 jrmu main::debug(ALL, "ZNC: $key => $val");
310 84c190b6 2021-12-17 jrmu } else {
311 84c190b6 2021-12-17 jrmu main::debug(ERRORS, "Unexpected 290 BNC.pm: $hostmask $text");
312 84c190b6 2021-12-17 jrmu }
313 84c190b6 2021-12-17 jrmu }
314 84c190b6 2021-12-17 jrmu }
315 84c190b6 2021-12-17 jrmu sub loadlog {
316 84c190b6 2021-12-17 jrmu open(my $fh, '<', "$znclog") or die "Could not read file 'znc.log' $!";
317 84c190b6 2021-12-17 jrmu chomp(@logs = <$fh>);
318 84c190b6 2021-12-17 jrmu close $fh;
319 84c190b6 2021-12-17 jrmu }
320 84c190b6 2021-12-17 jrmu
321 84c190b6 2021-12-17 jrmu # return all lines matching a pattern
322 84c190b6 2021-12-17 jrmu sub regex {
323 84c190b6 2021-12-17 jrmu my ($pattern) = @_;
324 84c190b6 2021-12-17 jrmu if (!@logs) { loadlog(); }
325 84c190b6 2021-12-17 jrmu return grep(/$pattern/, @logs);
326 84c190b6 2021-12-17 jrmu }
327 84c190b6 2021-12-17 jrmu
328 84c190b6 2021-12-17 jrmu # given a list of IPs, return matching users
329 84c190b6 2021-12-17 jrmu # or given a list of users, return matching IPs
330 84c190b6 2021-12-17 jrmu sub regexlist {
331 84c190b6 2021-12-17 jrmu my ($items) = @_;
332 84c190b6 2021-12-17 jrmu my @items = split /[,\s]+/m, $items;
333 84c190b6 2021-12-17 jrmu my $pattern = "(".join('|', @items).")";
334 84c190b6 2021-12-17 jrmu if (!@logs) { loadlog(); }
335 84c190b6 2021-12-17 jrmu my @matches = grep(/$pattern/, @logs);
336 84c190b6 2021-12-17 jrmu my @results;
337 84c190b6 2021-12-17 jrmu foreach my $match (@matches) {
338 84c190b6 2021-12-17 jrmu if ($match =~ /^\[\d{4}-\d\d-\d\d \d\d:\d\d:\d\d\] \[([^]\/]+)(\/[^]]+)?\] connected to ZNC from (.*)/) {
339 84c190b6 2021-12-17 jrmu my ($user, $ip) = ($1, $3);
340 84c190b6 2021-12-17 jrmu if ($items =~ /[.:]/) { # items are IP addresses
341 84c190b6 2021-12-17 jrmu push(@results, $user);
342 84c190b6 2021-12-17 jrmu } else { # items are users
343 84c190b6 2021-12-17 jrmu push(@results, $ip);
344 84c190b6 2021-12-17 jrmu }
345 84c190b6 2021-12-17 jrmu }
346 84c190b6 2021-12-17 jrmu }
347 84c190b6 2021-12-17 jrmu my @sorted = sort @results;
348 84c190b6 2021-12-17 jrmu @results = do { my %seen; grep { !$seen{$_}++ } @sorted }; # uniq
349 84c190b6 2021-12-17 jrmu return join(' ', @results);
350 84c190b6 2021-12-17 jrmu }
351 84c190b6 2021-12-17 jrmu
352 84c190b6 2021-12-17 jrmu sub createclone {
353 84c190b6 2021-12-17 jrmu my ($bot) = @_;
354 84c190b6 2021-12-17 jrmu my $socket = $bot->{sock};
355 84c190b6 2021-12-17 jrmu my $password = Hash::newpass();
356 84c190b6 2021-12-17 jrmu my $msg = <<"EOF";
357 84c190b6 2021-12-17 jrmu adduser cloneuser $password
358 84c190b6 2021-12-17 jrmu set Nick cloneuser cloneuser
359 84c190b6 2021-12-17 jrmu set Altnick cloneuser cloneuser_
360 84c190b6 2021-12-17 jrmu set Ident cloneuser cloneuser
361 84c190b6 2021-12-17 jrmu set RealName cloneuser cloneuser
362 84c190b6 2021-12-17 jrmu set MaxNetworks cloneuser 1000
363 84c190b6 2021-12-17 jrmu set ChanBufferSize cloneuser 1000
364 84c190b6 2021-12-17 jrmu set MaxQueryBuffers cloneuser 1000
365 84c190b6 2021-12-17 jrmu set QueryBufferSize cloneuser 1000
366 84c190b6 2021-12-17 jrmu set NoTrafficTimeout cloneuser 600
367 84c190b6 2021-12-17 jrmu set QuitMsg cloneuser IRCNow and Forever!
368 84c190b6 2021-12-17 jrmu set RealName cloneuser cloneuser
369 84c190b6 2021-12-17 jrmu set DenySetBindHost cloneuser true
370 84c190b6 2021-12-17 jrmu set Timezone cloneuser US/Pacific
371 84c190b6 2021-12-17 jrmu LoadModule cloneuser controlpanel
372 84c190b6 2021-12-17 jrmu LoadModule cloneuser chansaver
373 84c190b6 2021-12-17 jrmu EOF
374 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG *controlpanel :$msg");
375 b2b6fd90 2023-02-17 jrmu foreach my $n (@networks) {
376 84c190b6 2021-12-17 jrmu my $net = $n->{name};
377 84c190b6 2021-12-17 jrmu my $server = $n->{server};
378 84c190b6 2021-12-17 jrmu my $port = $n->{port};
379 84c190b6 2021-12-17 jrmu my $trustcerts = $n->{trustcerts};
380 84c190b6 2021-12-17 jrmu $msg = <<"EOF";
381 84c190b6 2021-12-17 jrmu addnetwork cloneuser $net
382 84c190b6 2021-12-17 jrmu addserver cloneuser $net $server $port
383 84c190b6 2021-12-17 jrmu disconnect cloneuser $net
384 84c190b6 2021-12-17 jrmu EOF
385 84c190b6 2021-12-17 jrmu if ($trustcerts) {
386 84c190b6 2021-12-17 jrmu $msg .= "SetNetwork TrustAllCerts cloneuser $net True\r\n";
387 84c190b6 2021-12-17 jrmu }
388 84c190b6 2021-12-17 jrmu my @chans = split /[,\s]+/m, $chans;
389 84c190b6 2021-12-17 jrmu foreach my $chan (@chans) {
390 84c190b6 2021-12-17 jrmu $msg .= "addchan cloneuser $net $chan\r\n";
391 84c190b6 2021-12-17 jrmu }
392 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG *controlpanel :$msg");
393 84c190b6 2021-12-17 jrmu }
394 84c190b6 2021-12-17 jrmu }
395 84c190b6 2021-12-17 jrmu
396 d90e80ee 2023-10-08 izzyb sub bncExists {
397 d90e80ee 2023-10-08 izzyb my ($bot, $username) = @_;
398 d90e80ee 2023-10-08 izzyb return 1 if (main::isstaff($bot, $username));
399 d90e80ee 2023-10-08 izzyb if (!defined($SQLite::dbh)) { SQLite::connectdb() || die "Can't open database"; }
400 d90e80ee 2023-10-08 izzyb my $dbh = $SQLite::dbh;
401 d90e80ee 2023-10-08 izzyb my $exists = $dbh->selectrow_array(
402 d90e80ee 2023-10-08 izzyb "SELECT count(*) FROM BNC WHERE username = ? and password is not null",
403 d90e80ee 2023-10-08 izzyb undef,$username
404 d90e80ee 2023-10-08 izzyb ); #count will be only element in array
405 d90e80ee 2023-10-08 izzyb return $exists; #should be 0 if it doesnt exist
406 d90e80ee 2023-10-08 izzyb #XXX Need to add signaling to query znc directly.
407 d90e80ee 2023-10-08 izzyb }
408 d90e80ee 2023-10-08 izzyb
409 d90e80ee 2023-10-08 izzyb
410 d90e80ee 2023-10-08 izzyb
411 84c190b6 2021-12-17 jrmu sub createbnc {
412 84c190b6 2021-12-17 jrmu my ($bot, $username, $password, $bindhost) = @_;
413 84c190b6 2021-12-17 jrmu my $netname = $bot->{name};
414 84c190b6 2021-12-17 jrmu my $msg = <<"EOF";
415 84c190b6 2021-12-17 jrmu cloneuser cloneuser $username
416 84c190b6 2021-12-17 jrmu set Nick $username $username
417 84c190b6 2021-12-17 jrmu set Altnick $username ${username}_
418 84c190b6 2021-12-17 jrmu set Ident $username $username
419 84c190b6 2021-12-17 jrmu set RealName $username $username
420 84c190b6 2021-12-17 jrmu set Password $username $password
421 84c190b6 2021-12-17 jrmu set MaxNetworks $username 1000
422 84c190b6 2021-12-17 jrmu set ChanBufferSize $username 1000
423 84c190b6 2021-12-17 jrmu set MaxQueryBuffers $username 1000
424 84c190b6 2021-12-17 jrmu set QueryBufferSize $username 1000
425 84c190b6 2021-12-17 jrmu set NoTrafficTimeout $username 600
426 84c190b6 2021-12-17 jrmu set QuitMsg $username IRCNow and Forever!
427 84c190b6 2021-12-17 jrmu set BindHost $username $bindhost
428 84c190b6 2021-12-17 jrmu set DCCBindHost $username $bindhost
429 84c190b6 2021-12-17 jrmu set DenySetBindHost $username true
430 84c190b6 2021-12-17 jrmu reconnect $username $netname
431 84c190b6 2021-12-17 jrmu EOF
432 84c190b6 2021-12-17 jrmu #set Language $username en-US
433 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG *controlpanel :$msg");
434 84c190b6 2021-12-17 jrmu return 1;
435 84c190b6 2021-12-17 jrmu }
436 4bac7b57 2023-06-30 jrmu sub mailbncApproved {
437 4bac7b57 2023-06-30 jrmu my( $username, $email, $password)=@_;
438 4bac7b57 2023-06-30 jrmu my $body = <<"EOF";
439 4bac7b57 2023-06-30 jrmu Welcome to $conf{localnet}!
440 c54830ad 2023-03-05 jrmu
441 c54830ad 2023-03-05 jrmu You created a bouncer:
442 c54830ad 2023-03-05 jrmu
443 84c190b6 2021-12-17 jrmu Username: $username
444 84c190b6 2021-12-17 jrmu Password: $password
445 75f89aeb 2023-05-06 jrmu Server: $bnchostname
446 84c190b6 2021-12-17 jrmu Port: $sslport for SSL (secure connection)
447 84c190b6 2021-12-17 jrmu Port: $plainport for plaintext
448 c54830ad 2023-03-05 jrmu Webpanel: $webpanel
449 84c190b6 2021-12-17 jrmu
450 4bac7b57 2023-06-30 jrmu Connection Instructions: https://wiki.ircnow.org/?n=Bouncer.Bouncer
451 84c190b6 2021-12-17 jrmu
452 4bac7b57 2023-06-30 jrmu Enjoy!
453 4bac7b57 2023-06-30 jrmu
454 4bac7b57 2023-06-30 jrmu $conf{localnet}
455 4bac7b57 2023-06-30 jrmu IRCNow Federation
456 84c190b6 2021-12-17 jrmu EOF
457 4bac7b57 2023-06-30 jrmu main::mail($mailfrom, $email, $mailname, "Your $conf{localnet} Bouncer", $body);
458 84c190b6 2021-12-17 jrmu }
459 84c190b6 2021-12-17 jrmu
460 4bac7b57 2023-06-30 jrmu sub mailbncPending {
461 4bac7b57 2023-06-30 jrmu my( $username, $email)=@_;
462 4bac7b57 2023-06-30 jrmu my $body = <<"EOF";
463 4bac7b57 2023-06-30 jrmu Welcome to $conf{localnet}!
464 4bac7b57 2023-06-30 jrmu
465 4bac7b57 2023-06-30 jrmu Your bouncer needs to be approved by staff ($staff).
466 4bac7b57 2023-06-30 jrmu Please reply to this email and contact them over IRC.
467 4bac7b57 2023-06-30 jrmu
468 4bac7b57 2023-06-30 jrmu Once $staff have been contacted, they will send you login
469 4bac7b57 2023-06-30 jrmu instructions. This may take up to 48 hours.
470 4bac7b57 2023-06-30 jrmu
471 4bac7b57 2023-06-30 jrmu $conf{localnet}
472 4bac7b57 2023-06-30 jrmu IRCNow Federation
473 4bac7b57 2023-06-30 jrmu EOF
474 4bac7b57 2023-06-30 jrmu main::mail($mailfrom, $email, $mailname, "Confirm $conf{localnet} Bouncer", $body);
475 4bac7b57 2023-06-30 jrmu }
476 4bac7b57 2023-06-30 jrmu
477 84c190b6 2021-12-17 jrmu sub mtaillog {
478 4bac7b57 2023-06-30 jrmu my ($bot, $nick, $host, $hand, @args) = @_;
479 84c190b6 2021-12-17 jrmu my ($chan, $text);
480 84c190b6 2021-12-17 jrmu if (@args == 2) {
481 84c190b6 2021-12-17 jrmu ($chan, $text) = ($args[0], $args[1]);
482 84c190b6 2021-12-17 jrmu } else { $text = $args[0]; }
483 84c190b6 2021-12-17 jrmu my $hostmask = "$nick!$host";
484 84c190b6 2021-12-17 jrmu open(my $fh, "-|", "/usr/bin/tail", "-f", $znclog) or die "could not start tail: $!";
485 84c190b6 2021-12-17 jrmu while (my $line = <$fh>) {
486 84c190b6 2021-12-17 jrmu foreach my $chan (@teamchans) {
487 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG $chan :$line");
488 84c190b6 2021-12-17 jrmu }
489 84c190b6 2021-12-17 jrmu }
490 84c190b6 2021-12-17 jrmu }
491 84c190b6 2021-12-17 jrmu
492 84c190b6 2021-12-17 jrmu sub mlastseen {
493 84c190b6 2021-12-17 jrmu my ($bot, $nick, $host, $hand, @args) = @_;
494 84c190b6 2021-12-17 jrmu my ($chan, $text);
495 84c190b6 2021-12-17 jrmu if (@args == 2) {
496 84c190b6 2021-12-17 jrmu ($chan, $text) = ($args[0], $args[1]);
497 84c190b6 2021-12-17 jrmu } else { $text = $args[0]; }
498 84c190b6 2021-12-17 jrmu my $hostmask = "$nick!$host";
499 84c190b6 2021-12-17 jrmu if (!@logs) { loadlog(); }
500 12807ebe 2023-02-10 jrmu #my @users = treeget($znctree, "User", "Node");
501 84c190b6 2021-12-17 jrmu foreach my $user (@users) {
502 84c190b6 2021-12-17 jrmu my @lines = grep(/^\[\d{4}-\d\d-\d\d \d\d:\d\d:\d\d\] \[$user\] connected to ZNC from [.0-9a-fA-F:]+/, @logs);
503 84c190b6 2021-12-17 jrmu if (scalar(@lines) == 0) {
504 84c190b6 2021-12-17 jrmu foreach my $chan (@teamchans) {
505 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG $chan :$user never logged in");
506 84c190b6 2021-12-17 jrmu }
507 84c190b6 2021-12-17 jrmu next;
508 84c190b6 2021-12-17 jrmu }
509 84c190b6 2021-12-17 jrmu my $recent = pop(@lines);
510 84c190b6 2021-12-17 jrmu if ($recent =~ /^\[(\d{4}-\d\d-\d\d) \d\d:\d\d:\d\d\] \[$user\] connected to ZNC from [.0-9a-fA-F:]+/) {
511 84c190b6 2021-12-17 jrmu my $date = $1;
512 84c190b6 2021-12-17 jrmu foreach my $chan (@teamchans) {
513 84c190b6 2021-12-17 jrmu main::putserv($bot, "PRIVMSG $chan :$user $date");
514 84c190b6 2021-12-17 jrmu }
515 84c190b6 2021-12-17 jrmu }
516 84c190b6 2021-12-17 jrmu }
517 84c190b6 2021-12-17 jrmu }
518 84c190b6 2021-12-17 jrmu #sub resend {
519 84c190b6 2021-12-17 jrmu # my ($bot, $newnick, $email) = @_;
520 84c190b6 2021-12-17 jrmu # my $password = newpass();
521 84c190b6 2021-12-17 jrmu # sendmsg($bot, "*controlpanel", "set Password $newnick $password");
522 84c190b6 2021-12-17 jrmu # mailverify($newnick, $email, $password, "bouncer");
523 84c190b6 2021-12-17 jrmu # sendmsg($bot, "$newnick", "Email sent");
524 84c190b6 2021-12-17 jrmu #}
525 84c190b6 2021-12-17 jrmu
526 731127fc 2023-02-22 jrmu #`doas chown znc:daemon /home/znc/home/znc/.znc/configs/znc.conf`;
527 731127fc 2023-02-22 jrmu
528 84c190b6 2021-12-17 jrmu # if ($reply =~ /^!resend ([-_0-9a-zA-Z]+) ([-_0-9a-zA-Z]+@[-_0-9a-zA-Z]+\.[-_0-9a-zA-Z]+)$/i) {
529 84c190b6 2021-12-17 jrmu # my ($newnick, $email) = ($1, $2);
530 84c190b6 2021-12-17 jrmu # my $password = newpass();
531 84c190b6 2021-12-17 jrmu # resend($bot, $newnick, $email);
532 84c190b6 2021-12-17 jrmu # }
533 84c190b6 2021-12-17 jrmu
534 84c190b6 2021-12-17 jrmu #sub resetznc {
535 84c190b6 2021-12-17 jrmu #
536 84c190b6 2021-12-17 jrmu #AnonIPLimit 10000
537 84c190b6 2021-12-17 jrmu #AuthOnlyViaModule false
538 84c190b6 2021-12-17 jrmu #ConnectDelay 0
539 84c190b6 2021-12-17 jrmu #HideVersion true
540 84c190b6 2021-12-17 jrmu #LoadModule
541 84c190b6 2021-12-17 jrmu #ServerThrottle
542 84c190b6 2021-12-17 jrmu #1337 209.141.38.137
543 84c190b6 2021-12-17 jrmu #31337 209.141.38.137
544 84c190b6 2021-12-17 jrmu #1337 2605:6400:20:5cc::
545 84c190b6 2021-12-17 jrmu #31337 2605:6400:20:5cc::
546 84c190b6 2021-12-17 jrmu #1337 127.0.0.1
547 84c190b6 2021-12-17 jrmu #1338 127.0.0.1
548 84c190b6 2021-12-17 jrmu #}
549 84c190b6 2021-12-17 jrmu #
550 84c190b6 2021-12-17 jrmu #alias Provides bouncer-side command alias support.
551 84c190b6 2021-12-17 jrmu #autoreply Reply to queries when you are away
552 84c190b6 2021-12-17 jrmu #block_motd Block the MOTD from IRC so it's not sent to your client(s).
553 84c190b6 2021-12-17 jrmu #bouncedcc Bounces DCC transfers through ZNC instead of sending them directly to the user.
554 84c190b6 2021-12-17 jrmu #clientnotify Notifies you when another IRC client logs into or out of your account. Configurable.
555 84c190b6 2021-12-17 jrmu #ctcpflood Don't forward CTCP floods to clients
556 84c190b6 2021-12-17 jrmu #dcc This module allows you to transfer files to and from ZNC
557 84c190b6 2021-12-17 jrmu #perform Keeps a list of commands to be executed when ZNC connects to IRC.
558 84c190b6 2021-12-17 jrmu #webadmin Web based administration module.
559 84c190b6 2021-12-17 jrmu
560 731127fc 2023-02-22 jrmu #my $zncconfpath = $conf{zncconfpath} || "$zncdir/.znc/configs/znc.conf";
561 731127fc 2023-02-22 jrmu #my $znctree = { Node => "root" };
562 731127fc 2023-02-22 jrmu #znc.conf file
563 731127fc 2023-02-22 jrmu #unveil("$zncconfpath", "r") or die "Unable to unveil $!";
564 731127fc 2023-02-22 jrmu #dependencies for figlet
565 731127fc 2023-02-22 jrmu #znc.log file
566 731127fc 2023-02-22 jrmu #unveil("$znclog", "r") or die "Unable to unveil $!";
567 731127fc 2023-02-22 jrmu #print treeget($znctree, "AnonIPLimit")."\n";
568 731127fc 2023-02-22 jrmu #print treeget($znctree, "ServerThrottle")."\n";
569 731127fc 2023-02-22 jrmu #print treeget($znctree, "ConnectDelay")."\n";
570 731127fc 2023-02-22 jrmu #print "treeget\n";
571 731127fc 2023-02-22 jrmu #print Dumper \treeget($znctree, "User", "Node");
572 731127fc 2023-02-22 jrmu #print Dumper \treeget($znctree, "User", "Network", "Node");
573 731127fc 2023-02-22 jrmu #my @zncconf = main::readarray($zncconfpath);
574 731127fc 2023-02-22 jrmu #$znctree;
575 731127fc 2023-02-22 jrmu #foreach my $line (@zncconf) {
576 731127fc 2023-02-22 jrmu # if ($line =~ /<User (.*)>/) {
577 731127fc 2023-02-22 jrmu # push(@users, $1);
578 731127fc 2023-02-22 jrmu # }
579 731127fc 2023-02-22 jrmu #}
580 731127fc 2023-02-22 jrmu #$znctree = parseml($znctree, @zncconf);
581 84c190b6 2021-12-17 jrmu
582 731127fc 2023-02-22 jrmu ## parseml($tree, @lines)
583 731127fc 2023-02-22 jrmu ## tree is a reference to a hash
584 731127fc 2023-02-22 jrmu ## returns hash ref of tree
585 731127fc 2023-02-22 jrmu #sub parseml {
586 731127fc 2023-02-22 jrmu # my ($tree, @lines) = @_;
587 731127fc 2023-02-22 jrmu # #if (scalar(@lines) == 0) { return $tree; }
588 731127fc 2023-02-22 jrmu # while (scalar(@lines) > 0) {
589 731127fc 2023-02-22 jrmu # my $line = shift(@lines);
590 731127fc 2023-02-22 jrmu # if ($line =~ /^\s*([^=<>\s]+)\s*=\s*([^=<>]+)\s*$/) {
591 731127fc 2023-02-22 jrmu # my ($tag, $val) = ($1, $2);
592 731127fc 2023-02-22 jrmu # $tree->{$tag} = $val;
593 731127fc 2023-02-22 jrmu # } elsif ($line =~ /^\/\//) { # skip comments
594 731127fc 2023-02-22 jrmu # } elsif ($line =~ /^\s*$/) { # skip blank lines
595 731127fc 2023-02-22 jrmu # } elsif ($line =~ /^\s*<([^>\s\/]+)\s*([^>\/]*)>\s*$/) {
596 731127fc 2023-02-22 jrmu # my ($tag, $val) = ($1, $2);
597 731127fc 2023-02-22 jrmu # if (!defined($tree->{$tag})) { $tree->{$tag} = []; }
598 731127fc 2023-02-22 jrmu # my @newlines;
599 731127fc 2023-02-22 jrmu # while (scalar(@lines) > 0) {
600 731127fc 2023-02-22 jrmu # my $line = shift(@lines);
601 731127fc 2023-02-22 jrmu # if ($line =~ /^\s*<\/$tag>\s*$/) {
602 731127fc 2023-02-22 jrmu # my $subtree = parseml({ Node => $val }, @newlines);
603 731127fc 2023-02-22 jrmu # push(@{$tree->{$tag}}, $subtree);
604 731127fc 2023-02-22 jrmu # return parseml($tree, @lines);
605 731127fc 2023-02-22 jrmu # }
606 731127fc 2023-02-22 jrmu # push(@newlines, $line);
607 731127fc 2023-02-22 jrmu # }
608 731127fc 2023-02-22 jrmu # } else { print "ERROR: $line\n"; }
609 731127fc 2023-02-22 jrmu # #TODO ERRORS not defined??
610 731127fc 2023-02-22 jrmu ## } else { main::debug(ERRORS, "ERROR: $line"); }
611 731127fc 2023-02-22 jrmu # }
612 731127fc 2023-02-22 jrmu # return $tree;
613 731127fc 2023-02-22 jrmu #}
614 731127fc 2023-02-22 jrmu #
615 731127fc 2023-02-22 jrmu ##Returns array of all values
616 731127fc 2023-02-22 jrmu ##treeget($tree, "User");
617 731127fc 2023-02-22 jrmu #sub treeget {
618 731127fc 2023-02-22 jrmu # my ($tree, @keys) = @_;
619 731127fc 2023-02-22 jrmu # my $subtree;
620 731127fc 2023-02-22 jrmu # my @rest = @keys;
621 731127fc 2023-02-22 jrmu # my $key = shift(@rest);
622 731127fc 2023-02-22 jrmu # $subtree = $tree->{$key};
623 731127fc 2023-02-22 jrmu # if (!defined($subtree)) {
624 731127fc 2023-02-22 jrmu # return ("Undefined");
625 731127fc 2023-02-22 jrmu # } elsif (ref($subtree) eq 'HASH') {
626 731127fc 2023-02-22 jrmu # return treeget($subtree, @rest);
627 731127fc 2023-02-22 jrmu # } elsif (ref($subtree) eq 'ARRAY') {
628 731127fc 2023-02-22 jrmu # my @array = @{$subtree};
629 731127fc 2023-02-22 jrmu # my @ret;
630 731127fc 2023-02-22 jrmu # foreach my $hashref (@array) {
631 731127fc 2023-02-22 jrmu # push(@ret, treeget($hashref, @rest));
632 731127fc 2023-02-22 jrmu # }
633 731127fc 2023-02-22 jrmu # return @ret;
634 731127fc 2023-02-22 jrmu # #my @array = @{$subtree};
635 731127fc 2023-02-22 jrmu # #print Dumper treeget($hashref, @rest);
636 731127fc 2023-02-22 jrmu # #print Dumper treeget({$key => $subtree}, @rest);
637 731127fc 2023-02-22 jrmu # #return (treeget($hashref, @rest), treeget({$key => $subtree}, @rest));
638 731127fc 2023-02-22 jrmu # } else {
639 731127fc 2023-02-22 jrmu # return ($subtree);
640 731127fc 2023-02-22 jrmu # }
641 731127fc 2023-02-22 jrmu #}
642 731127fc 2023-02-22 jrmu
643 731127fc 2023-02-22 jrmu
644 84c190b6 2021-12-17 jrmu 1; # MUST BE LAST STATEMENT IN FILE