Gotweb

Blob

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