Blob


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