Gotweb

Blob

Date:: Sun Mar 12 02:35:23 2023 UTC
Message:: Fixed regex bug that would cause relayd.conf to get wiped out
Actions:: History | Blame | Raw File
1 #!/usr/bin/perl
2 
3 package Shell;
4 
5 use strict;
6 use warnings;
7 use OpenBSD::Pledge;
8 use OpenBSD::Unveil;
9 use MIME::Base64;
10 use Data::Dumper;
11 use Digest::SHA qw(sha256_hex);
12 use lib './';
13 require "SQLite.pm";
14 require "Hash.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 $captchaURL = "https://example.com/captcha.php?vhost=";
22 my $hostname = $conf{hostname};
23 my $terms = $conf{terms};
24 my $expires = $conf{expires};
25 my $mailfrom = $conf{mailfrom};
26 my $mailname = $conf{mailname};
27 my $approval = $conf{approval};
28 my $passpath = "/etc/passwd";
29 my $httpdconfpath = "/etc/httpd.conf";
30 my $acmeconfpath = "/etc/acme-client.conf";
31 my $pfconfpath = "/etc/pf.conf";
32 my $relaydconfpath = "/etc/relayd.conf";
33 my $startPort;
34 my $endPort;
35 
36 use constant {
37 	NONE => 0,
38 	ERRORS => 1,
39 	WARNINGS => 2,
40 	ALL => 3,
41 };
42 
43 main::cbind("pub", "-", "shell", \&mshell);
44 main::cbind("msg", "-", "shell", \&mshell);
45 
46 # Returns yesterday's date in mmmDDYYYY format
47 sub yesterday {
48 	my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
49 	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
50 	my $localtime = sprintf("%s%02d%04d", $months[$mon], $mday-1, $year+1900);
51 	return $localtime;
52 }
53 sub init {
54 	#dependencies for figlet
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 	#dependencies for shell account
59 	unveil($passpath, "r") or die "Unable to unveil $!";
60 	unveil($httpdconfpath, "rwxc") or die "Unable to unveil $!";
61 	unveil($acmeconfpath, "rwxc") or die "Unable to unveil $!";
62 	unveil($pfconfpath, "rwxc") or die "Unable to unveil $!";       
63 	unveil($relaydconfpath, "rwxc") or die "Unable to unveil $!";       
64 	unveil("/usr/sbin/chown", "rx") or die "Unable to unveil $!";
65 	unveil("/bin/chmod", "rx") or die "Unable to unveil $!";
66 	unveil("/usr/sbin/groupadd", "rx") or die "Unable to unveil $!";
67 	unveil("/usr/sbin/useradd", "rx") or die "Unable to unveil $!";
68 	unveil("/usr/sbin/usermod", "rx") or die "Unable to unveil $!";
69 	unveil("/usr/sbin/groupdel", "rx") or die "Unable to unveil $!";
70 	unveil("/usr/sbin/userdel", "rx") or die "Unable to unveil $!";
71 	unveil("/bin/mkdir", "rx") or die "Unable to unveil $!";
72 	unveil("/bin/ln", "rx") or die "Unable to unveil $!";
73 	unveil("/usr/sbin/acme-client", "rx") or die "Unable to unveil $!";
74 	unveil("/bin/rm", "rx") or die "Unable to unveil $!";
75 	unveil("/bin/mv", "rx") or die "Unable to unveil $!";
76 	unveil("/home/", "rwxc") or die "Unable to unveil $!";
77 }
78 
79 # !shell <username> <email>
80 # !shell captcha <captcha>
81 sub mshell {
82 	my ($bot, $nick, $host, $hand, @args) = @_;
83 	my ($chan, $text);
84 	if (@args == 2) {
85 		($chan, $text) = ($args[0], $args[1]);
86 	} else { $text = $args[0]; }
87 	my $hostmask = "$nick!$host";
88 	if (defined($chan) && $chans =~ /$chan/) {
89 		main::putserv($bot, "PRIVMSG $chan :$nick: Please check private message");
90 	}
91 	if ($text =~ /^$/) {
92 		main::putserv($bot, "PRIVMSG $nick :Type !help for new instructions");
93 		foreach my $chan (@teamchans) {
94 			main::putservlocalnet($bot, "PRIVMSG $chan :$staff: Help *$nick* on network ".$bot->{name}." with shell registration");
95 		}
96 		return;
97 	} elsif (main::isstaff($bot, $nick) && $text =~ /^delete\s+([[:ascii:]]+)/) {
98 		my $username = $1;
99 		if (SQLite::deleterows("shell", "username", $username)) {
100 			# TODO delete shell
101 			deleteshell($username);
102 			foreach my $chan (@teamchans) {
103 				main::putserv($bot, "PRIVMSG $chan :$username deleted");
104 			}
105 		}
106 		return;
107 	} elsif (main::isstaff($bot, $nick) && $text =~ /^approve\s+([[:ascii:]]+)/) {
108 		my $username = $1;
109 		system "doas usermod -e 0 -s /bin/ksh $username";
110 		foreach my $chan (@teamchans) {
111 			main::putserv($bot, "PRIVMSG $chan :$username approved");
112 		}
113 		return;
114 	}
115 	### TODO: Check duplicate emails ###
116 	my @rows = SQLite::selectrows("irc", "nick", $nick);
117 	foreach my $row (@rows) {
118 		my $password = SQLite::get("shell", "ircid", $row->{id}, "password");
119 		if (defined($password)) {
120 			main::putserv($bot, "PRIVMSG $nick :Sorry, only one account per person. Please contact staff if you need help.");
121 			return;
122 		}
123 	}
124 	if ($text =~ /^lastseen\s+([[:alnum:]]+)/) {
125 	}
126 	if ($text =~ /^captcha\s+([[:alnum:]]+)/) {
127 		my $text = $1;
128 		my $ircid = SQLite::id("irc", "nick", $nick, $expires);
129 		if (!defined($ircid)) { die "undefined ircid"; }
130 		my $captcha = SQLite::get("shell", "ircid", $ircid, "captcha");
131 		if ($text ne $captcha) {
132 			main::putserv($bot, "PRIVMSG $nick :Wrong captcha. To get a new captcha, type !shell <username> <email>");
133 			return;
134 		}
135 		my $pass = Hash::newpass();
136 		chomp(my $encrypted = `encrypt $pass`);
137 		my $username = SQLite::get("shell", "ircid", $ircid, "username");
138 		my $email = SQLite::get("shell", "ircid", $ircid, "email");
139 		my $version = SQLite::get("shell", "ircid", $ircid, "version");
140 		my $bindhost = "$username.$hostname";
141 		SQLite::set("shell", "ircid", $ircid, "password", $encrypted);
142 		if (DNS::nextdns($username)) {
143 			sleep(2);
144 			createshell($username, $pass, $bindhost);
145 			mailshell($username, $email, $pass, "shell", $version);
146 			main::putserv($bot, "PRIVMSG $nick :Check your email!");
147 			if ($approval eq "true") {
148 				my $yesterday = yesterday();
149 				system "doas usermod -e $yesterday -s /sbin/nologin $username";
150 				main::putserv($bot, "PRIVMSG $nick :Your account has been created but must be manually approved by your admins ($staff) before it can be used.");
151 				foreach my $chan (@teamchans) {
152 					main::putservlocalnet($bot, "PRIVMSG $chan :$staff: $nick\'s account $username must be manually unblocked before it can be used.");
153 				}
154 			}
155 			foreach my $chan (@teamchans) {
156 				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");
157 			}
158 
159 
160 			#www($newnick, $reply, $password, "bouncer");
161 		} else {
162 			foreach my $chan (@teamchans) {
163 				main::putserv($bot, "PRIVMSG $chan :Assigning bindhost $bindhost failed");
164 			}
165 		}
166 		return;
167 	} elsif ($text =~ /^([[:alnum:]]+)\s+([[:ascii:]]+)/) {
168 		my ($username, $email) = ($1, $2);
169 		my @users = col($passpath, 1, ":");
170 		my @matches = grep(/^$username$/i, @users);
171 		if (scalar(@matches) > 0) {
172 			main::putserv($bot, "PRIVMSG $nick :Sorry, username taken. Please choose another username, or contact staff for help.");
173 			return;
174 		}
175 		#		my $captcha = join'', map +(0..9,'a'..'z','A'..'Z')[rand(10+26*2)], 1..4;
176 		my $captcha = int(rand(999));
177 		my $ircid = int(rand(2147483647));
178 		SQLite::set("irc", "id", $ircid, "localtime", time());
179 		SQLite::set("irc", "id", $ircid, "date", main::date());
180 		SQLite::set("irc", "id", $ircid, "hostmask", $hostmask);
181 		SQLite::set("irc", "id", $ircid, "nick", $nick);
182 		SQLite::set("shell", "ircid", $ircid, "username", $username);
183 		SQLite::set("shell", "ircid", $ircid, "email", $email);
184 		SQLite::set("shell", "ircid", $ircid, "captcha", $captcha);
185 		main::whois($bot->{sock}, $nick);
186 		main::ctcp($bot->{sock}, $nick);
187 		main::putserv($bot, "PRIVMSG $nick :".`figlet $captcha`);
188 		#		main::putserv($bot, "PRIVMSG $nick :$captchaURL".encode_base64($captcha));
189 		main::putserv($bot, "PRIVMSG $nick :Type !shell captcha <text>");
190 		foreach my $chan (@teamchans) {
191 			main::putservlocalnet($bot, "PRIVMSG $chan :$nick\'s captcha on $bot->{name} is $captcha");
192 		}
193 	} else {
194 		main::putserv($bot, "PRIVMSG $nick :Invalid username or email. Type !shell <username> <email> to try again.");
195 		foreach my $chan (@teamchans) {
196 			main::putserv($bot, "PRIVMSG $chan :$staff: Help *$nick* on network ".$bot->{name}." with shell registration");
197 		}
198 	}
199 }
200 sub mailshell {
201 	my( $username, $email, $password, $service, $version )=@_;
202 	my $passhash = sha256_hex("$username");
203 	my $versionhash = encode_base64($version);
204 	my $approvemsg;
205 	if ($approval eq "true") {
206 		$approvemsg = <<"EOF";
207 
208 *IMPORTANT*: Your account has been created but it has not yet been
209 approved. To get your account approved, please contact your admins
210 $staff on IRC and by email.
211 
212 EOF
213 	}
214 
215 	my $body = <<"EOF";
216 You created a shell account!
217 
218 Username: $username
219 Password: $password
220 Server: $hostname
221 SSH Port: 22
222 Your Ports: $startPort to $endPort
223 
224 To customize your vhost, connect to ask in $chans
225 $approvemsg
226 *IMPORTANT*: Verify your email address:
227 
228 Please reply to this email to indicate you have received the email. You must
229 reply in order to keep your account.
230 
231 IRCNow
232 EOF
233 	main::mail($mailfrom, $email, $mailname, "Verify IRCNow Account", $body);
234 }
235 
236 
237 #sub mregex {
238 #	my ($bot, $nick, $host, $hand, $text) = @_;
239 #	if ($staff !~ /$nick/) { return; }
240 #	if ($text =~ /^ips?\s+([-_()|0-9A-Za-z:\.?*\s]{3,})$/) {
241 #		my $ips = $1; # space-separated list of IPs
242 #		main::putserv($bot, "PRIVMSG $nick :".regexlist($ips));
243 #	} elsif ($text =~ /^users?\s+([-_()|0-9A-Za-z:\.?*\s]{3,})$/) {
244 #		my $users = $1; # space-separated list of usernames
245 #		main::putserv($bot, "PRIVMSG $nick :".regexlist($users));
246 #	} elsif ($text =~ /^[-_()|0-9A-Za-z:,\.?*\s]{3,}$/) {
247 #		my @lines = regex($text);
248 #		foreach my $l (@lines) { print "$l\n"; }
249 #	}
250 #}
251 #sub mforeach {
252 #	my ($bot, $nick, $host, $hand, $text) = @_;
253 #	if ($staff !~ /$nick/) { return; }
254 #	if ($text =~ /^network\s+del\s+([[:graph:]]+)\s+(#[[:graph:]]+)$/) {
255 #		my ($user, $chan) = ($1, $2);
256 #		foreach my $n (@main::networks) {
257 #			main::putserv($bot, "PRIVMSG *controlpanel :delchan $user $n->{name} $chan");
258 #		}
259 #	}
260 #}
261 
262 #sub loadlog {
263 #	open(my $fh, '<', "$authlog") or die "Could not read file 'authlog' $!";
264 #	chomp(@logs = <$fh>);
265 #	close $fh;
266 #}
267 
268 # return all lines matching a pattern
269 #sub regex {
270 #	my ($pattern) = @_;
271 #	if (!@logs) { loadlog(); }
272 #	return grep(/$pattern/, @logs);
273 #}
274 
275 # given a list of IPs, return matching users
276 # or given a list of users, return matching IPs
277 #sub regexlist {
278 #	my ($items) = @_;
279 #	my @items = split /[,\s]+/m, $items;
280 #	my $pattern = "(".join('|', @items).")";
281 #	if (!@logs) { loadlog(); }
282 #	my @matches = grep(/$pattern/, @logs);
283 #	my @results;
284 #	foreach my $match (@matches) {
285 #		if ($match =~ /^\[\d{4}-\d\d-\d\d \d\d:\d\d:\d\d\] \[([^]\/]+)(\/[^]]+)?\] connected to ZNC from (.*)/) {
286 #			my ($user, $ip) = ($1, $3);
287 #			if ($items =~ /[.:]/) { # items are IP addresses
288 #				push(@results, $user);
289 #			} else { # items are users
290 #				push(@results, $ip);
291 #			}
292 #		}
293 #	}
294 #	my @sorted = sort @results;
295 #	@results = do { my %seen; grep { !$seen{$_}++ } @sorted }; # uniq
296 #	return join(' ', @results);
297 #}
298 
299 sub createshell {
300 	my ($username, $password, $bindhost) = @_;
301 	system "doas groupadd $username";
302 	system "doas adduser -batch $username $username $username `encrypt $password`";
303 	system "doas chmod 700 /home/$username /home/$username/.ssh";
304 	system "doas chmod 600 /home/$username/{.Xdefaults,.cshrc,.cvsrc,.login,.mailrc,.profile}";
305 	system "doas mkdir /var/www/htdocs/$username";
306 	system "doas ln -s /var/www/htdocs/$username /home/$username/htdocs";
307 	system "doas chown -R $username:www /var/www/htdocs/$username /home/$username/htdocs";
308 	system "doas chmod -R o-rx /var/www/htdocs/$username /home/$username/htdocs";
309 	system "doas chmod -R g+rwx /var/www/htdocs/$username /home/$username/htdocs";
310 	system "doas chown root:wheel $httpdconfpath $pfconfpath $acmeconfpath $relaydconfpath";
311 	system "doas chmod g+rw $httpdconfpath $pfconfpath $acmeconfpath $relaydconfpath";
312 	my $lusername = lc $username;
313 	my $block = <<"EOF";
314 server "$lusername.$hostname" {
315 	listen on * port 80
316 	location "/.well-known/acme-challenge/*" {
317 		root "/acme"
318 		request strip 2
319 	}
320 	location "*.php" {
321 		fastcgi socket "/run/php-fpm.sock"
322 	}
323 	root "/htdocs/$username"
324 }
325 EOF
326 	main::appendfile($httpdconfpath, $block);
327 	$block = <<"EOF";
328 domain "$lusername.$hostname" {
329 	domain key "/etc/ssl/private/$lusername.$hostname.key"
330 	domain full chain certificate "/etc/ssl/$lusername.$hostname.crt"
331 	sign with letsencrypt
332 }
333 EOF
334 	main::appendfile($acmeconfpath, $block);
335 	configurepf($username);
336 	system "doas rcctl reload httpd";
337         system "doas acme-client -F $lusername.$hostname";
338 	system "doas ln -s /etc/ssl/$lusername.$hostname.crt /etc/ssl/$lusername.$hostname.fullchain.pem";
339 	system "doas pfctl -f /etc/pf.conf";
340 	configurerelayd($username);
341 	$block = <<"EOF";
342 ~       *       *       *       *       acme-client $lusername.$hostname && rcctl reload relayd
343 EOF
344 	system "echo $block | doas crontab -";
345 #edquota $username
346 	return 1;
347 }
348 
349 sub deleteshell {
350 	my ($username, $bindhost) = @_;
351 	my $lusername = lc $username;
352 	system "doas chown root:wheel $httpdconfpath $pfconfpath $acmeconfpath $relaydconfpath";
353 	system "doas chmod g+rw $httpdconfpath $pfconfpath $acmeconfpath $relaydconfpath";
354 	system "doas groupdel $username";
355 	system "doas userdel $username";
356 	system "doas rm -f /etc/ssl/$lusername.$hostname.crt /etc/ssl/$lusername.$hostname.fullchain.pem /etc/ssl/private/$lusername.$hostname.key";
357 	my $httpdconf = main::readstr($httpdconfpath);
358 	my $block = <<"EOF";
359 server "$lusername.$hostname" {
360 	listen on * port 80
361 	location "/.well-known/acme-challenge/*" {
362 		root "/acme"
363 		request strip 2
364 	}
365 	location "*.php" {
366 		fastcgi socket "/run/php-fpm.sock"
367 	}
368 	root "/htdocs/$username"
369 }
370 EOF
371 	$block =~ s/{/\\{/gm;
372 	$block =~ s/}/\\}/gm;
373 	$block =~ s/\./\\./gm;
374 	$block =~ s/\*/\\*/gm;
375 	$httpdconf =~ s{$block}{}gm;
376 	print $httpdconf;
377 	main::writefile($httpdconfpath, $httpdconf);
378 	
379 	my $acmeconf = main::readstr($acmeconfpath);
380 	$block = <<"EOF";
381 domain "$lusername.$hostname" {
382 	domain key "/etc/ssl/private/$lusername.$hostname.key"
383 	domain full chain certificate "/etc/ssl/$lusername.$hostname.fullchain.pem"
384 	sign with letsencrypt
385 }
386 EOF
387 	$block =~ s/{/\\{/gm;
388 	$block =~ s/}/\\}/gm;
389 	$block =~ s/\./\\./gm;
390 	$block =~ s/\*/\\*/gm;
391 	$acmeconf =~ s{$block}{}gm;
392 	main::writefile($acmeconfpath, $acmeconf);
393 	return 1;
394 }
395 
396 #TODO Fix for $i
397 # Return column $i from $filename as an array with file separator $FS
398 sub col {
399 	my ($filename, $i, $FS) = @_;
400 	my @rows = main::readarray($filename);
401 	my @results;
402 	foreach my $row (@rows) {
403 		if ($row =~ /^(.*?)$FS/) {
404 			push(@results, $1);
405 		}
406 	}
407 	return @results;
408 }
409 
410 sub configurepf {
411     my $username = shift;
412     my @read = split('\n', main::readstr($pfconfpath) );
413     
414     my $previousline = "";
415     my @pfcontent;
416     foreach my $line(@read)
417     {
418         my $currline = $line;    
419         if( $currline ne "# end user ports") {
420             $previousline = $currline;        
421         } else {
422             #pass in proto {tcp udp} to port {31361:31370} user {JL}
423             if( $previousline =~ /(\d*):(\d*)/ ) {            
424                 my $startport = ( $1 + 10 );
425                 my $endport = ( $2 + 10 );
426                 my $insert = "pass in proto {tcp udp} to port {$startport:$endport} user {$username}";
427                 push(@pfcontent, $insert);
428 		$startPort = $startport;
429 		$endPort = $endport;
430             }
431         }
432         push(@pfcontent, $currline)
433     }
434     main::writefile("$pfconfpath", join("\n",@pfcontent))
435 }
436 
437 sub configurerelayd {  
438         my ($username) = @_;                 
439 	my $block = "tls { keypair $username.$hostname }";
440 	my $relaydconf = main::readstr($relaydconfpath);
441 	my $newconf;
442 	if ($relaydconf =~ /^.*tls\s+{\s+keypair\s+[.0-9a-zA-Z]+\s*}/m) {
443 		$newconf = "$`$&\n\t$block$'";
444 	} else {
445 		$newconf = $relaydconf;
446 		main::debug(ERRORS, "ERROR: regex can't match tls { keypair \$username.$hostname }");
447 	}
448 	main::writefile($relaydconfpath, $newconf);
449 }
450 
451 #unveil("./newacct", "rx") or die "Unable to unveil $!";
452 1; # MUST BE LAST STATEMENT IN FILE