11 use Digest::SHA qw(sha256_hex);
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 $loginclass = $conf{loginclass} || "freeshell";
29 my $passpath = "/etc/passwd";
30 my $httpdconfpath = "/etc/httpd.conf";
31 my $acmeconfpath = "/etc/acme-client.conf";
32 my $pfconfpath = "/etc/pf.conf";
33 my $relaydconfpath = "/etc/relayd.conf";
44 main::cbind("pub", "-", "shell", \&mshell);
45 main::cbind("msg", "-", "shell", \&mshell);
48 #dependencies for figlet
49 unveil("/usr/local/bin/figlet", "rx") or die "Unable to unveil $!";
50 unveil("/usr/lib/libc.so.95.1", "r") or die "Unable to unveil $!";
51 unveil("/usr/libexec/ld.so", "r") or die "Unable to unveil $!";
52 #dependencies for shell account
53 unveil($passpath, "r") or die "Unable to unveil $!";
54 unveil($httpdconfpath, "rwxc") or die "Unable to unveil $!";
55 unveil($acmeconfpath, "rwxc") or die "Unable to unveil $!";
56 unveil($pfconfpath, "rwxc") or die "Unable to unveil $!";
57 unveil($relaydconfpath, "rwxc") or die "Unable to unveil $!";
58 unveil("/usr/sbin/chown", "rx") or die "Unable to unveil $!";
59 unveil("/bin/chmod", "rx") or die "Unable to unveil $!";
60 unveil("/usr/sbin/groupadd", "rx") or die "Unable to unveil $!";
61 unveil("/usr/sbin/useradd", "rx") or die "Unable to unveil $!";
62 unveil("/usr/sbin/usermod", "rx") or die "Unable to unveil $!";
63 unveil("/usr/sbin/groupdel", "rx") or die "Unable to unveil $!";
64 unveil("/usr/sbin/userdel", "rx") or die "Unable to unveil $!";
65 unveil("/bin/mkdir", "rx") or die "Unable to unveil $!";
66 unveil("/bin/ln", "rx") or die "Unable to unveil $!";
67 unveil("/usr/sbin/acme-client", "rx") or die "Unable to unveil $!";
68 unveil("/bin/rm", "rx") or die "Unable to unveil $!";
69 unveil("/bin/mv", "rx") or die "Unable to unveil $!";
70 unveil("/home/", "rwxc") or die "Unable to unveil $!";
73 # !shell <username> <email>
74 # !shell captcha <captcha>
76 my ($bot, $nick, $host, $hand, @args) = @_;
79 ($chan, $text) = ($args[0], $args[1]);
80 } else { $text = $args[0]; }
81 my $hostmask = "$nick!$host";
82 if (defined($chan) && $chans =~ /$chan/) {
83 main::putserv($bot, "PRIVMSG $chan :$nick: Please check private message");
86 main::putserv($bot, "PRIVMSG $nick :Type !help for new instructions");
87 foreach my $chan (@teamchans) {
88 main::putservlocalnet($bot, "PRIVMSG $chan :$staff: Help *$nick* on network ".$bot->{name}." with shell registration");
91 } elsif (main::isstaff($bot, $nick) && $text =~ /^delete\s+([[:ascii:]]+)/) {
93 if (SQLite::deleterows("shell", "username", $username)) {
95 deleteshell($username);
96 foreach my $chan (@teamchans) {
97 main::putserv($bot, "PRIVMSG $chan :$username deleted");
101 } elsif (main::isstaff($bot, $nick) && $text =~ /^approve\s+([[:ascii:]]+)/) {
103 system "doas usermod -U $username";
104 foreach my $chan (@teamchans) {
105 main::putserv($bot, "PRIVMSG $chan :$username approved");
109 ### TODO: Check duplicate emails ###
110 my @rows = SQLite::selectrows("irc", "nick", $nick);
111 foreach my $row (@rows) {
112 my $password = SQLite::get("shell", "ircid", $row->{id}, "password");
113 if (defined($password)) {
114 main::putserv($bot, "PRIVMSG $nick :Sorry, only one account per person. Please contact staff if you need help.");
118 if ($text =~ /^lastseen\s+([[:alnum:]]+)/) {
120 if ($text =~ /^captcha\s+([[:alnum:]]+)/) {
122 my $ircid = SQLite::id("irc", "nick", $nick, $expires);
123 if (!defined($ircid)) { die "undefined ircid"; }
124 my $captcha = SQLite::get("shell", "ircid", $ircid, "captcha");
125 if ($text ne $captcha) {
126 main::putserv($bot, "PRIVMSG $nick :Wrong captcha. To get a new captcha, type !shell <username> <email>");
129 my $pass = Hash::newpass();
130 chomp(my $encrypted = `encrypt $pass`);
131 my $username = SQLite::get("shell", "ircid", $ircid, "username");
132 my $email = SQLite::get("shell", "ircid", $ircid, "email");
133 my $version = SQLite::get("shell", "ircid", $ircid, "version");
134 my $bindhost = "$username.$hostname";
135 SQLite::set("shell", "ircid", $ircid, "password", $encrypted);
136 if (DNS::nextdns($username)) {
138 createshell($username, $pass, $bindhost);
139 mailshell($username, $email, $pass, "shell", $version);
140 main::putserv($bot, "PRIVMSG $nick :Check your email!");
141 if ($approval eq "true") {
142 system "doas usermod -Z $username";
143 main::putserv($bot, "PRIVMSG $nick :Your account has been created but must be manually approved by your admins ($staff) before it can be used.");
144 foreach my $chan (@teamchans) {
145 main::putservlocalnet($bot, "PRIVMSG $chan :$staff: $nick\'s account $username must be manually unblocked before it can be used.");
148 foreach my $chan (@teamchans) {
149 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");
153 #www($newnick, $reply, $password, "bouncer");
155 foreach my $chan (@teamchans) {
156 main::putserv($bot, "PRIVMSG $chan :Assigning bindhost $bindhost failed");
160 } elsif ($text =~ /^([[:alnum:]]+)\s+([[:ascii:]]+)/) {
161 my ($username, $email) = ($1, $2);
162 my @users = col($passpath, 1, ":");
163 my @matches = grep(/^$username$/i, @users);
164 if (scalar(@matches) > 0) {
165 main::putserv($bot, "PRIVMSG $nick :Sorry, username taken. Please choose another username, or contact staff for help.");
168 # my $captcha = join'', map +(0..9,'a'..'z','A'..'Z')[rand(10+26*2)], 1..4;
169 my $captcha = int(rand(999));
170 my $ircid = int(rand(2147483647));
171 SQLite::set("irc", "id", $ircid, "localtime", time());
172 SQLite::set("irc", "id", $ircid, "date", main::date());
173 SQLite::set("irc", "id", $ircid, "hostmask", $hostmask);
174 SQLite::set("irc", "id", $ircid, "nick", $nick);
175 SQLite::set("shell", "ircid", $ircid, "username", $username);
176 SQLite::set("shell", "ircid", $ircid, "email", $email);
177 SQLite::set("shell", "ircid", $ircid, "captcha", $captcha);
178 main::whois($bot->{sock}, $nick);
179 main::ctcp($bot->{sock}, $nick);
180 main::putserv($bot, "PRIVMSG $nick :".`figlet $captcha`);
181 # main::putserv($bot, "PRIVMSG $nick :$captchaURL".encode_base64($captcha));
182 main::putserv($bot, "PRIVMSG $nick :Type !shell captcha <text>");
183 foreach my $chan (@teamchans) {
184 main::putservlocalnet($bot, "PRIVMSG $chan :$nick\'s captcha on $bot->{name} is $captcha");
187 main::putserv($bot, "PRIVMSG $nick :Invalid username or email. Type !shell <username> <email> to try again.");
188 foreach my $chan (@teamchans) {
189 main::putserv($bot, "PRIVMSG $chan :$staff: Help *$nick* on network ".$bot->{name}." with shell registration");
194 my( $username, $email, $password, $service, $version )=@_;
195 my $passhash = sha256_hex("$username");
196 my $versionhash = encode_base64($version);
198 if ($approval eq "true") {
199 $approvemsg = <<"EOF";
201 *IMPORTANT*: Your account has been created but it has not yet been
202 approved. To get your account approved, please contact your admins
203 $staff on IRC and by email.
209 You created a shell account!
215 Your Ports: $startPort to $endPort
217 To customize your vhost, connect to ask in $chans
219 *IMPORTANT*: Verify your email address:
221 Please reply to this email to indicate you have received the email. You must
222 reply in order to keep your account.
226 main::mail($mailfrom, $email, $mailname, "Verify IRCNow Account", $body);
231 # my ($bot, $nick, $host, $hand, $text) = @_;
232 # if ($staff !~ /$nick/) { return; }
233 # if ($text =~ /^ips?\s+([-_()|0-9A-Za-z:\.?*\s]{3,})$/) {
234 # my $ips = $1; # space-separated list of IPs
235 # main::putserv($bot, "PRIVMSG $nick :".regexlist($ips));
236 # } elsif ($text =~ /^users?\s+([-_()|0-9A-Za-z:\.?*\s]{3,})$/) {
237 # my $users = $1; # space-separated list of usernames
238 # main::putserv($bot, "PRIVMSG $nick :".regexlist($users));
239 # } elsif ($text =~ /^[-_()|0-9A-Za-z:,\.?*\s]{3,}$/) {
240 # my @lines = regex($text);
241 # foreach my $l (@lines) { print "$l\n"; }
245 # my ($bot, $nick, $host, $hand, $text) = @_;
246 # if ($staff !~ /$nick/) { return; }
247 # if ($text =~ /^network\s+del\s+([[:graph:]]+)\s+(#[[:graph:]]+)$/) {
248 # my ($user, $chan) = ($1, $2);
249 # foreach my $n (@main::networks) {
250 # main::putserv($bot, "PRIVMSG *controlpanel :delchan $user $n->{name} $chan");
256 # open(my $fh, '<', "$authlog") or die "Could not read file 'authlog' $!";
257 # chomp(@logs = <$fh>);
261 # return all lines matching a pattern
263 # my ($pattern) = @_;
264 # if (!@logs) { loadlog(); }
265 # return grep(/$pattern/, @logs);
268 # given a list of IPs, return matching users
269 # or given a list of users, return matching IPs
272 # my @items = split /[,\s]+/m, $items;
273 # my $pattern = "(".join('|', @items).")";
274 # if (!@logs) { loadlog(); }
275 # my @matches = grep(/$pattern/, @logs);
277 # foreach my $match (@matches) {
278 # if ($match =~ /^\[\d{4}-\d\d-\d\d \d\d:\d\d:\d\d\] \[([^]\/]+)(\/[^]]+)?\] connected to ZNC from (.*)/) {
279 # my ($user, $ip) = ($1, $3);
280 # if ($items =~ /[.:]/) { # items are IP addresses
281 # push(@results, $user);
282 # } else { # items are users
283 # push(@results, $ip);
287 # my @sorted = sort @results;
288 # @results = do { my %seen; grep { !$seen{$_}++ } @sorted }; # uniq
289 # return join(' ', @results);
293 my ($username, $password, $bindhost) = @_;
294 system "doas groupadd $username";
295 system "doas adduser -batch $username $username $username `encrypt $password`";
296 system "doas chmod 700 /home/$username /home/$username/.ssh";
297 system "doas chmod 600 /home/$username/{.Xdefaults,.cshrc,.cvsrc,.login,.mailrc,.profile}";
298 system "doas mkdir /var/www/htdocs/$username";
299 system "doas ln -s /var/www/htdocs/$username /home/$username/htdocs";
300 system "doas chown -R $username:www /var/www/htdocs/$username /home/$username/htdocs";
301 system "doas chmod -R o-rx /var/www/htdocs/$username /home/$username/htdocs";
302 system "doas chmod -R g+rwx /var/www/htdocs/$username /home/$username/htdocs";
303 system "doas chown root:wheel $httpdconfpath $pfconfpath $acmeconfpath $relaydconfpath";
304 system "doas chmod g+rw $httpdconfpath $pfconfpath $acmeconfpath $relaydconfpath";
305 my $lusername = lc $username;
307 server "$lusername.$hostname" {
309 location "/.well-known/acme-challenge/*" {
314 fastcgi socket "/run/php-fpm.sock"
316 root "/htdocs/$username"
319 main::appendfile($httpdconfpath, $block);
321 domain "$lusername.$hostname" {
322 domain key "/etc/ssl/private/$lusername.$hostname.key"
323 domain full chain certificate "/etc/ssl/$lusername.$hostname.crt"
324 sign with letsencrypt
327 main::appendfile($acmeconfpath, $block);
328 configurepf($username);
329 system "doas rcctl reload httpd";
330 system "doas acme-client -F $lusername.$hostname";
331 system "doas ln -s /etc/ssl/$lusername.$hostname.crt /etc/ssl/$lusername.$hostname.fullchain.pem";
332 system "doas pfctl -f /etc/pf.conf";
333 configurerelayd($username);
335 ~ * * * * acme-client $lusername.$hostname && rcctl reload relayd
337 system "echo $block | doas crontab -";
338 system "doas usermod -L $loginclass $username";
344 my ($username, $bindhost) = @_;
345 my $lusername = lc $username;
346 system "doas chown root:wheel $httpdconfpath $pfconfpath $acmeconfpath $relaydconfpath";
347 system "doas chmod g+rw $httpdconfpath $pfconfpath $acmeconfpath $relaydconfpath";
348 system "doas groupdel $username";
349 system "doas userdel $username";
350 system "doas rm -f /etc/ssl/$lusername.$hostname.crt /etc/ssl/$lusername.$hostname.fullchain.pem /etc/ssl/private/$lusername.$hostname.key";
351 my $httpdconf = main::readstr($httpdconfpath);
353 server "$lusername.$hostname" {
355 location "/.well-known/acme-challenge/*" {
360 fastcgi socket "/run/php-fpm.sock"
362 root "/htdocs/$username"
365 $block =~ s/{/\\{/gm;
366 $block =~ s/}/\\}/gm;
367 $block =~ s/\./\\./gm;
368 $block =~ s/\*/\\*/gm;
369 $httpdconf =~ s{$block}{}gm;
371 main::writefile($httpdconfpath, $httpdconf);
373 my $acmeconf = main::readstr($acmeconfpath);
375 domain "$lusername.$hostname" {
376 domain key "/etc/ssl/private/$lusername.$hostname.key"
377 domain full chain certificate "/etc/ssl/$lusername.$hostname.fullchain.pem"
378 sign with letsencrypt
381 $block =~ s/{/\\{/gm;
382 $block =~ s/}/\\}/gm;
383 $block =~ s/\./\\./gm;
384 $block =~ s/\*/\\*/gm;
385 $acmeconf =~ s{$block}{}gm;
386 main::writefile($acmeconfpath, $acmeconf);
391 # Return column $i from $filename as an array with file separator $FS
393 my ($filename, $i, $FS) = @_;
394 my @rows = main::readarray($filename);
396 foreach my $row (@rows) {
397 if ($row =~ /^(.*?)$FS/) {
405 my $username = shift;
406 my @read = split('\n', main::readstr($pfconfpath) );
408 my $previousline = "";
410 foreach my $line(@read)
412 my $currline = $line;
413 if( $currline ne "# end user ports") {
414 $previousline = $currline;
416 #pass in proto {tcp udp} to port {31361:31370} user {JL}
417 if( $previousline =~ /(\d*):(\d*)/ ) {
418 my $startport = ( $1 + 10 );
419 my $endport = ( $2 + 10 );
420 my $insert = "pass in proto {tcp udp} to port {$startport:$endport} user {$username}";
421 push(@pfcontent, $insert);
422 $startPort = $startport;
426 push(@pfcontent, $currline)
428 main::writefile("$pfconfpath", join("\n",@pfcontent))
431 sub configurerelayd {
433 my $block = "tls { keypair $username.$hostname }";
434 my $relaydconf = main::readstr($relaydconfpath);
436 if ($relaydconf =~ /^.*tls\s+{\s+keypair\s+[.0-9a-zA-Z]+\s*}/m) {
437 $newconf = "$`$&\n\t$block$'";
439 $newconf = $relaydconf;
440 main::debug(ERRORS, "ERROR: regex can't match tls { keypair \$username.$hostname }");
442 main::writefile($relaydconfpath, $newconf);
445 #unveil("./newacct", "rx") or die "Unable to unveil $!";
446 1; # MUST BE LAST STATEMENT IN FILE