diff --git a/makedist.pl b/makedist.pl
index feee94745..9d5571bb6 100755
--- a/makedist.pl
+++ b/makedist.pl
@@ -27,7 +27,8 @@ $vers || usage();
 
 @files = ("config.cgi", "config-*-linux",
 	  "config-solaris", "images", "index.cgi", "mime.types",
-	  "miniserv.pl", "os_list.txt", "perlpath.pl", "setup.sh", "setup.pl", "setup.bat",
+	  "miniserv.pl", "miniserv-lib.pl", "os_list.txt", "perlpath.pl",
+	  "setup.sh", "setup.pl", "setup.bat",
 	  "setup-repos.sh", "version", "web-lib.pl", "web-lib-funcs.pl",
 	  "config_save.cgi", "chooser.cgi", "miniserv.pem",
 	  "config-aix", "update-from-repo.sh", "README.md",
diff --git a/miniserv-lib.pl b/miniserv-lib.pl
new file mode 100644
index 000000000..b2b5f9f8a
--- /dev/null
+++ b/miniserv-lib.pl
@@ -0,0 +1,6563 @@
+# Common functions and globals for miniserv.pl. miniserv.pl requires this
+# file in a BEGIN block so Socket constants are imported before the daemon
+# startup code is compiled.
+package miniserv;
+use Socket;
+use POSIX;
+use Time::Local;
+eval "use Time::HiRes;";
+
+@itoa64 = split(//, "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz");
+@miniserv_argv = @ARGV;
+
+# init days and months for http_date
+@weekday = ( "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" );
+@month = ( "Jan", "Feb", "Mar", "Apr", "May", "Jun",
+	   "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" );
+
+# handle_request(remoteaddress, localaddress, ipv6-flag)
+# Where the real work is done
+sub handle_request
+{
+local ($acptip, $localip, $ipv6) = @_;
+seek(DEBUG, 0, 2);
+print DEBUG "handle_request: from $acptip to $localip ipv6=$ipv6\n";
+if ($config{'loghost'}) {
+	$acpthost = &to_hostname($acptip);
+	$acpthost = $acptip if (!$acpthost);
+	}
+else {
+	$acpthost = $acptip;
+	}
+$loghost = $acpthost;
+$datestr = &http_date(time());
+$ok_code = 200;
+$ok_message = "Document follows";
+$logged_code = undef;
+$reqline = $request_uri = $page = undef;
+$authuser = undef;
+$validated = undef;
+
+# Reset all per-request state. Keep-alive lets one child handle many
+# requests on one TCP connection; behind a proxy that pools backend
+# connections, those requests can be from different clients. Anything
+# left set from the prior request would leak across that boundary -
+# most dangerously $baseauthuser, which feeds BASE_REMOTE_USER and the
+# Webmin ACL layer.
+$baseauthuser = undef;
+$authpass = undef;
+$session_id = undef;
+$already_session_id = undef;
+$already_authuser = undef;
+$miniserv_internal = undef;
+$querystring = undef;
+$queryargs = undef;
+$pathinfo = undef;
+$peername = undef;
+$uinfo = undef;
+$scriptname = undef;
+$cgi_pwd = undef;
+$full = undef;
+$realroot = undef;
+$foundroot = undef;
+$is_directory = undef;
+$nph_script = undef;
+$logout = undef;
+$failed_user = undef;
+$failed_save = undef;
+$twofactor_msg = undef;
+$timed_out = undef;
+$error_handler_recurse = undef;
+%cgiheader = ();
+@cgiheader = ();
+$doneheaders = undef;
+$headers = undef;
+@stfull = ();
+# Reset logout-triggered auth suppression and any partial POST body
+# count before handling the next request on this connection.
+$deny_authentication = undef;
+$clen_read = 0;
+# Restore $host/$port to socket defaults; the Host: header overwrite
+# below should not persist if the next request omits Host.
+local $host = $host;
+local $port = $port;
+# Scope per-request mutation of %config so it cannot leak to later
+# requests on this connection (see $config{'session'} = 0 below).
+local $config{'session'} = $config{'session'};
+
+# check address against access list
+if (@deny && &ip_match($acptip, $localip, @deny) ||
+    @allow && !&ip_match($acptip, $localip, @allow)) {
+	&http_error(403, "Access denied for ".&html_strip($acptip));
+	return 0;
+	}
+
+if ($use_libwrap) {
+	# Check address with TCP-wrappers
+	if (!hosts_ctl($config{'pam'}, STRING_UNKNOWN,
+		       $acptip, STRING_UNKNOWN)) {
+		&http_error(403, "Access denied for ".&html_strip($acptip).
+				 " by TCP wrappers");
+		return 0;
+		}
+	}
+print DEBUG "handle_request: passed IP checks\n";
+
+# Compute a timeout for the start of headers, based on the number of
+# child processes. As this increases, we use a shorter timeout to avoid
+# an attacker overloading the system.
+local $header_timeout = 60 + ($config{'maxconns'} - @childpids) * 10;
+if ($header_timeout > 10*60) {
+	$header_timeout = 10*60;
+	}
+
+local $rmask;
+vec($rmask, fileno(SOCK), 1) = 1;
+local $to = $checked_timeout ? 10*60 : $header_timeout;
+print DEBUG "handle_request: waiting for $to seconds\n";
+local $sel = select($rmask, undef, undef, $to);
+if (!$sel) {
+	if ($checked_timeout) {
+		print DEBUG "handle_request: exiting due to timeout of $to\n";
+		exit;
+		}
+	else {
+		&http_error(400, "Timeout",
+			    "Waited for $to seconds for start of headers");
+		}
+	}
+$checked_timeout++;
+print DEBUG "handle_request: passed timeout check\n";
+
+# Read the HTTP request line
+alarm(10);
+$SIG{'ALRM'} = sub { die "timeout" };
+local $origreqline = &read_line();
+($reqline = $origreqline) =~ s/\r|\n//g;
+$method = $page = $request_uri = undef;
+print DEBUG "handle_request reqline=$reqline\n";
+alarm(0);
+if (!$use_ssl && $config{'ssl'} && $config{'ssl_enforce'}) {
+	# This is an HTTP request when HTTPS should be enforced
+	my $musthost = $config{'musthost'};
+	my $hostheader;
+	if (!$musthost) {
+		# Read host HTTP header because we want one earlier
+		alarm(10);
+		local $SIG{'ALRM'} = sub { die "timeout" };
+		while (defined(my $line = &read_line())) {
+			$line =~ s/\r|\n//g;
+			last if $line eq '';
+			if ($line =~ /^host:\s*(.*)$/i) {
+				$hostheader = "https://$1";
+				last;
+				}
+			}
+		alarm(0);
+		}
+	# Host header must already contain full URL
+	my $url = $hostheader;
+	if (!$url) {
+		# No host header
+		local $urlhost = $musthost || $host;
+		$urlhost = "[".$urlhost."]" if (&check_ip6address($urlhost));
+		local $wantport = $port;
+		if ($wantport == 80 &&
+		&indexof(443, @listening_on_ports) >= 0) {
+			# Connection was to port 80, but since we are also
+			# accepting on port 443, redirect to that
+			$wantport = 443;
+			}
+		$url = $wantport == 443
+			? "https://$urlhost/"
+			: "https://$urlhost:$wantport/";
+		}
+	# Enforce HTTPS
+	&write_data("HTTP/1.0 302 Moved Temporarily\r\n");
+	&write_data("Date: $datestr\r\n");
+	&write_data("Server: @{[&server_info()]}\r\n");
+	&write_data("Location: $url\r\n");
+	&write_keep_alive(0);
+	&write_data("\r\n");
+	&log_error("Redirecting HTTP request to $url");
+	&log_request($loghost, $authuser, $reqline, 302, 0);
+	return 0;
+	}
+elsif (!$reqline && $checked_timeout > 1) {
+	# An empty request .. just close the connection
+	print DEBUG "handle_request: rejecting empty request\n";
+	return 0;
+	}
+elsif ($reqline && $reqline !~ /^(\S+)\s+(.*)\s+HTTP\/1\..$/) {
+	&http_error(400, "Bad Request");
+	return 0;
+	}
+$method = $1;
+$request_uri = $page = $2;
+%header = ();
+
+# Read HTTP headers
+alarm(60);
+$SIG{'ALRM'} = sub { die "timeout" };
+local $lastheader;
+while(1) {
+	($headline = &read_line()) =~ s/\r|\n//g;
+	last if ($headline eq "");
+	print DEBUG "handle_request: got headline $headline\n";
+	if ($headline =~ /^(\S+):\s*(.*)$/) {
+		$header{$lastheader = lc($1)} = $2;
+		}
+	elsif ($headline =~ /^\s+(.*)$/) {
+		$header{$lastheader} .= $headline;
+		}
+	else {
+		alarm(0);
+		&http_error(400, "Bad Header ".&html_strip($headline));
+		}
+	if (&is_bad_header($header{$lastheader}, $lastheader)) {
+		alarm(0);
+		delete($header{$lastheader});
+		&http_error(400, "Bad Header Contents ".
+				 &html_strip($lastheader));
+		}
+	}
+alarm(0);
+my $websocket_upgrade_request = lc($header{'connection'}) =~ /upgrade/ &&
+				lc($header{'upgrade'}) eq 'websocket';
+my $websocket_configured_request;
+my $websocket_basic_auth_ok;
+if ($websocket_upgrade_request) {
+	# Check the configured websocket paths before auth, so Basic auth can
+	# remain disabled for normal session-mode requests.
+	my $wsbogus;
+	my $ws_simple = &simplify_path($page, $wsbogus);
+	$websocket_configured_request = !$wsbogus &&
+					&find_websocket_config($ws_simple);
+	if ($websocket_configured_request) {
+		# Session-mode Basic auth stays disabled unless the websocket
+		# route explicitly allows a no-cookie Basic-auth hop.
+		$websocket_basic_auth_ok =
+			$websocket_configured_request->{'allow_basic_ws'};
+		}
+	}
+
+# If a remote IP is given in a header (such as via a proxy), only use it
+# for logging unless trust_real_ip is set
+local $headerhost = $header{'x-forwarded-for'} ||
+		    $header{'x-real-ip'} ||
+		    $header{'true-client-ip'} ||
+		    $header{'cf-connecting-ip'} ||
+		    $header{'cf-connecting-ip6'};
+if ($headerhost) {
+	# Only real IPs are allowed
+	$headerhost = undef if (!&check_ipaddress($headerhost) &&
+				!&check_ip6address($headerhost));
+	}
+# If trusted_proxies is configured, header-supplied client IP and SSL
+# client info are only honored when the direct TCP peer is in that list.
+# Otherwise drop them so an attacker reaching miniserv directly cannot
+# spoof X-Forwarded-For or X-SSL-Client-* to bypass auth.
+if ($config{'trust_real_ip'} && $config{'trusted_proxies'} ne '' &&
+    !&ip_match($acptip, $localip,
+	       split(/\s+/, $config{'trusted_proxies'}))) {
+	print DEBUG "handle_request: peer $acptip not in trusted_proxies; ".
+		    "ignoring forwarding and SSL client headers\n";
+	$headerhost = undef;
+	delete $header{'x-ssl-client-dn'};
+	delete $header{'x-ssl-client-verify'};
+	}
+if ($config{'trust_real_ip'}) {
+	$acpthost = $headerhost || $acpthost;
+	if (&check_ipaddress($headerhost) || &check_ip6address($headerhost)) {
+		# If a remote IP was given, use it for all access control checks
+		# from now on.
+		$acptip = $headerhost;
+
+		# re-check remote address against access list
+		if (@deny && &ip_match($acptip, $localip, @deny) ||
+		    @allow && !&ip_match($acptip, $localip, @allow)) {
+			&http_error(403, "Access denied for ".&html_strip($acptip));
+			return 0;
+			}
+
+		if ($use_libwrap) {
+			# Check address with TCP-wrappers
+			if (!hosts_ctl($config{'pam'}, STRING_UNKNOWN,
+				       $acptip, STRING_UNKNOWN)) {
+				&http_error(403, "Access denied for ".&html_strip($acptip).
+						 " by TCP wrappers");
+				return 0;
+				}
+			}
+		print DEBUG "handle_request: passed Remote IP checks\n";
+		}
+	$loghost = $acpthost;
+	}
+elsif ($config{'logtrust'}) {
+	# If a client IP address was provided, such as via a proxy, log it
+	$loghost = $headerhost || $loghost;
+	}
+
+if (defined($header{'host'})) {
+	if ($header{'host'} =~ /^\[(.+)\]:([0-9]+)$/) {
+		($host, $port) = ($1, $2);
+		}
+	elsif ($header{'host'} =~ /^([^:]+):([0-9]+)$/) {
+		($host, $port) = ($1, $2);
+		}
+	else {
+		$host = $header{'host'};
+		}
+	if ($config{'musthost'} && $host ne $config{'musthost'} &&
+	    !$config{'musthost_redirect'}) {
+		# Disallowed hostname used
+		&http_error(400, "Invalid HTTP hostname");
+		}
+	}
+
+# Create strings for use in redirects
+$ssl = $config{'redirect_ssl'} ne '' ? $config{'redirect_ssl'} : $use_ssl;
+$redirport = $config{'redirect_port'} || $port;
+$redirport = $config{'redirect_port'}
+	if ($config{'redirect_host'});
+$portstr = $redirport == 80 && !$ssl ? "" :
+	   $redirport == 443 && $ssl ? "" : ":".$redirport;
+$redirhost = $config{'redirect_host'} || $host;
+$hostport = &check_ip6address($redirhost) ? "[".$redirhost."]".$portstr
+				          : $redirhost.$portstr;
+
+# If the redirect_prefix exists change redirect base to include the prefix #1271
+if ($config{'redirect_prefix'}) {
+	$hostport .= $config{'redirect_prefix'}
+	}
+$prot = $ssl ? "https" : "http";
+
+# Redirect to the configured "musthost", if "musthost_redirect" is set, rather
+# than showing an error
+if ($config{'musthost'} && $host ne $config{'musthost'} &&
+    $config{'musthost_redirect'}) {
+	&write_data("HTTP/1.0 302 Moved Temporarily\r\n");
+	&write_data("Date: $datestr\r\n");
+	&write_data("Server: @{[&server_info()]}\r\n");
+	&write_data("Location: $prot://$config{'musthost'}:$redirport\r\n");
+	&write_keep_alive(0);
+	&write_data("\r\n");
+	&log_request($loghost, $authuser, $reqline, 302, 0) if $reqline;
+	shutdown(SOCK, 1);
+	close(SOCK);
+	return;
+	}
+
+undef(%in);
+if ($page =~ /^([^\?]+)\?(.*)$/) {
+	# There is some query string information
+	$page = $1;
+	$querystring = $2;
+	print DEBUG "handle_request: querystring=$querystring\n";
+	if ($querystring !~ /=/) {
+		$queryargs = $querystring;
+		$queryargs =~ s/\+/ /g;
+		$queryargs =~ s/%(..)/pack("c",hex($1))/ge;
+		$querystring = "";
+		}
+	else {
+		# Parse query-string parameters
+		local @in = split(/\&/, $querystring);
+		foreach $i (@in) {
+			local ($k, $v) = split(/=/, $i, 2);
+			$k =~ s/\+/ /g; $k =~ s/%(..)/pack("c",hex($1))/ge;
+			$v =~ s/\+/ /g; $v =~ s/%(..)/pack("c",hex($1))/ge;
+			$in{$k} = $v;
+			}
+		}
+	}
+$posted_data = undef;
+if ($method eq 'POST' &&
+    $header{'content-type'} eq 'application/x-www-form-urlencoded') {
+	# Read in posted query string information, up the configured maximum
+	# post request length
+	$clen = $header{"content-length"};
+	$clen_read = $clen > $config{'max_post'} ? $config{'max_post'} : $clen;
+	while(length($posted_data) < $clen_read) {
+		alarm(60);
+		$SIG{'ALRM'} = sub { die "timeout" };
+		eval {
+			$buf = &read_data($clen_read - length($posted_data));
+			};
+		alarm(0);
+		if ($@) {
+			&http_error(500, "Timeout reading POST request");
+			}
+		if (!length($buf)) {
+			&http_error(500, "Failed to read POST request");
+			}
+		chomp($posted_data);
+		$posted_data =~ s/\015$//mg;
+		$posted_data .= $buf;
+		}
+	print DEBUG "clen_read=$clen_read clen=$clen posted_data=",length($posted_data),"\n";
+	if ($clen_read != $clen && length($posted_data) > $clen) {
+		# If the client sent more data than we asked for, chop the
+		# rest off
+		$posted_data = substr($posted_data, 0, $clen);
+		}
+	if (length($posted_data) > $clen) {
+		# When the client sent too much, delay so that it gets headers
+		sleep(3);
+		}
+	if ($header{'user-agent'} =~ /MSIE/ &&
+	    $header{'user-agent'} !~ /Opera/i) {
+		# MSIE includes an extra newline in the data
+		$posted_data =~ s/\r|\n//g;
+		}
+	local @in = split(/\&/, $posted_data);
+	foreach $i (@in) {
+		local ($k, $v) = split(/=/, $i, 2);
+		#$v =~ s/\r|\n//g;
+		$k =~ s/\+/ /g; $k =~ s/%(..)/pack("c",hex($1))/ge;
+		$v =~ s/\+/ /g; $v =~ s/%(..)/pack("c",hex($1))/ge;
+		$in{$k} = $v;
+		}
+	print DEBUG "handle_request: posted_data=$posted_data\n";
+	}
+
+# Reject CONNECT request, which isn't supported
+if ($method eq "CONNECT" || $method eq "TRACE") {
+	&http_error(405, "Method ".&html_strip($method)." is not supported");
+	}
+
+# work out accepted encodings
+%acceptenc = map { $_, 1 } split(/,/, $header{'accept-encoding'});
+
+# replace %XX sequences in page
+$page =~ s/%(..)/pack("c",hex($1))/ge;
+
+# Check if the browser's user agent indicates a mobile device
+$mobile_device = &is_mobile_useragent($header{'user-agent'});
+
+# Check if Host: header is for a mobile URL
+foreach my $m (@mobile_prefixes) {
+	if ($header{'host'} =~ /^\Q$m\E/i) {
+		$mobile_device = 1;
+		}
+	}
+
+# check for the logout flag file, and if existent deny authentication
+if ($config{'logout'} && -r $config{'logout'}.$in{'miniserv_logout_id'}) {
+	print DEBUG "handle_request: logout flag set\n";
+	$deny_authentication++;
+	open(LOGOUT, $config{'logout'}.$in{'miniserv_logout_id'});
+	chop($count = <LOGOUT>);
+	close(LOGOUT);
+	$count--;
+	if ($count > 0) {
+		open(LOGOUT, ">$config{'logout'}$in{'miniserv_logout_id'}");
+		print LOGOUT "$count\n";
+		close(LOGOUT);
+		}
+	else {
+		unlink($config{'logout'}.$in{'miniserv_logout_id'});
+		}
+	}
+
+# check for any redirect for the requested URL
+foreach my $pfx (@strip_prefix) {
+	my $l = length($pfx);
+	if(length($page) >= $l &&
+	   substr($page,0,$l) eq $pfx) {
+		$page=substr($page,$l);
+		last;
+		}
+	}
+$simple = &simplify_path($page, $bogus);
+$rpath = $simple;
+$rpath .= "&".$querystring if (defined($querystring));
+$redir = $redirect{$rpath};
+if (defined($redir)) {
+	print DEBUG "handle_request: redir=$redir\n";
+	&write_data("HTTP/1.0 302 Moved Temporarily\r\n");
+	&write_data("Date: $datestr\r\n");
+	&write_data("Server: @{[&server_info()]}\r\n");
+	&write_data("Location: $prot://$hostport$redir\r\n");
+	&write_keep_alive(0);
+	&write_data("\r\n");
+	return 0;
+	}
+
+# Check for a DAV request
+$davpath = undef;
+foreach my $d (@davpaths) {
+	if ($simple eq $d || $simple =~ /^\Q$d\E\//) {
+		$davpath = $d;
+		last;
+		}
+	}
+if (!$davpath && ($method eq "SEARCH" || $method eq "PUT")) {
+	&http_error(400, "Bad Request method ".&html_strip($method));
+	}
+
+# Check for some form of authentication
+print DEBUG "handle_request: Need authentication\n";
+$validated = 0;
+$blocked = 0;
+local $http_auth_error;
+local $http_auth_reason;
+
+# Session authentication is never used for connections by
+# another webmin server, or for specified pages, or for DAV, or XMLRPC,
+# or mobile browsers if requested.
+if ($header{'user-agent'} =~ /webmin/i ||
+    $header{'user-agent'} =~ /$config{'agents_nosession'}/i ||
+    $sessiononly{$simple} || $davpath ||
+    $simple eq "/xmlrpc.cgi" ||
+    $acptip eq $config{'host_nosession'} ||
+    $mobile_device && $config{'mobile_nosession'}) {
+	print DEBUG "handle_request: Forcing HTTP authentication\n";
+	$config{'session'} = 0;
+	}
+
+# Check for SSL authentication
+my $trust_ssl = $config{'trust_real_ip'} && !$config{'no_trust_ssl'};
+if ($use_ssl && $verified_client ||
+    $trust_ssl && $header{'x-ssl-client-dn'} &&
+                  $header{'x-ssl-client-verify'} =~ /^success$/i) {
+	my $u;
+	if ($use_ssl && $verified_client) {
+		$peername = Net::SSLeay::X509_NAME_oneline(
+				Net::SSLeay::X509_get_subject_name(
+					Net::SSLeay::get_peer_certificate(
+						$ssl_con)));
+		$u = &find_user_by_cert($peername);
+		}
+	if ($trust_ssl && !$u && $header{'x-ssl-client-dn'} &&
+	    !($use_ssl && $verified_client)) {
+		# Use proxied client cert (only when this connection
+		# is not itself a verified mTLS client; otherwise the
+		# header could be set by a real-cert client that didn't
+		# match a user, to authenticate as someone else).
+		$u = &find_user_by_cert($header{'x-ssl-client-dn'});
+		}
+	if ($u) {
+		$authuser = $u;
+		$validated = 2;
+		}
+	if ($use_syslog && !$validated && $use_ssl && $verified_client) {
+		syslog("crit", "%s",
+		       "Unknown SSL certificate $peername");
+		}
+	}
+
+if (!$validated && !$deny_authentication) {
+	# check for IP-based authentication
+	local $a;
+	foreach $a (keys %ipaccess) {
+		if ($acptip eq $a) {
+			# It does! Auth as the user
+			$validated = 3;
+			$baseauthuser = $authuser =
+				$ipaccess{$a};
+			}
+		}
+	}
+
+# Keep Basic auth disabled in session mode except for websocket routes that
+# explicitly allow no-cookie Basic-auth hops. Token/user checks still run
+# before the backend connection is opened.
+if (!$validated && !$deny_authentication &&
+    (!$config{'session'} || $websocket_basic_auth_ok) &&
+    $header{authorization} =~ /^basic\s+(\S+)$/i) {
+	# authorization given..
+	($authuser, $authpass) = split(/:/, &b64decode($1), 2);
+	print DEBUG "handle_request: doing basic auth check ".
+		    "authuser=$authuser authpass=$authpass\n";
+	local ($vu, $expired, $nonexist, $wvu) =
+		&validate_user_caseless($authuser, $authpass, $host,
+				        $acptip, $port);
+	local $twofactor_blocked = 0;
+	if ($vu && $wvu) {
+		# Don't allow a 2FA-protected account to fall back to
+		# password-only HTTP Basic authentication.
+		my $uinfo = &get_user_details($wvu, $vu);
+		if ($uinfo && $uinfo->{'twofactor_provider'}) {
+			print DEBUG "handle_request: rejecting basic auth for ".
+				    "$wvu because two-factor authentication ".
+				    "is enabled\n";
+			$twofactor_blocked = 1;
+			$http_auth_error = 'twofactor-required';
+			$http_auth_reason = 'With two-factor authentication '.
+					    'enabled for this account, RPC '.
+					    'access requires a separate '.
+					    'Webmin user without 2FA';
+			$vu = undef;
+			}
+		}
+	print DEBUG "handle_request: vu=$vu expired=$expired ".
+		    "nonexist=$nonexist\n";
+	if ($vu && (!$expired || $config{'passwd_mode'} == 1)) {
+		$authuser = $vu;
+		$validated = 1;
+		}
+	else {
+		$validated = 0;
+		}
+	if ($use_syslog && !$validated) {
+		my $msg = $twofactor_blocked
+			? "Login as $authuser from $acpthost rejected because ".
+			  "two-factor authentication is enabled"
+			: ($nonexist
+				? "Non-existent"
+				: $expired
+					? "Expired"
+					: "Invalid").
+			  " login as $authuser from $acpthost";
+		syslog("crit", "%s", $msg);
+		}
+	if ($authuser =~ /\r|\n|\s/) {
+		&http_error(500, "Invalid username",
+			    "Username contains invalid characters");
+		}
+	if ($authpass =~ /\r|\n/) {
+		&http_error(500, "Invalid password",
+			    "Password contains invalid characters");
+		}
+
+	if ($config{'passdelay'} && $authuser) {
+		# check with main process for delay
+		print DEBUG "handle_request: about to ask for password delay\n";
+		print $PASSINw "delay $authuser $acptip $validated\n";
+		<$PASSOUTr> =~ /(\d+) (\d+)/;
+		$blocked = $2;
+		print DEBUG "handle_request: password delay $1 $2\n";
+		sleep($1);
+		}
+	}
+
+# Check for a visit to the special session login page
+if ($config{'session'} && !$deny_authentication &&
+    $page eq $config{'session_login'}) {
+	if ($in{'logout'} && $header{'cookie'} =~ /(^|\s|;)$sidname=([a-f0-9]+)/) {
+		# Logout clicked .. remove the session
+		local $sid = $2;
+		print $PASSINw "delete $sid\n";
+		local $louser = <$PASSOUTr>;
+		chop($louser);
+		$logout = 1;
+		$already_session_id = undef;
+		$authuser = $baseauthuser = undef;
+		if ($louser) {
+			if ($use_syslog) {
+				syslog("info", "%s", "Logout by $louser from $acpthost");
+				}
+			&run_logout_script($louser, $sid,
+					   $loghost, $localip);
+			&write_logout_utmp($louser, $acpthost);
+			}
+		}
+	elsif ($in{'session'}) {
+		# Session ID given, perhaps from a single-use login link.
+		local $sid = $in{'session'};
+		if ($sid =~ /\r|\n|\s/) {
+			&http_error(500, "Invalid session",
+			    "Session ID contains invalid characters");
+			}
+		print $PASSINw "verify $sid $acptip 1\n";
+		<$PASSOUTr> =~ /^(\d+)\s+(\S+)/;
+		if ($1 != 2) {
+			&http_error(500, "Invalid session",
+			    "Session ID is not valid");
+			}
+
+		# If this was a one-time session ID link, the username will
+		# have a - prefix to prevent it from being used as a regular
+		# session.
+		local $vu = $2;
+		$vu =~ s/^-//;
+
+		# Clear this one-time session, and issue a new one
+		print $PASSINw "delete $sid\n";
+		local $louser = <$PASSOUTr>;
+		local $hrv = &handle_login(
+				$vu, $vu ? 1 : 0,
+				0, 0, undef, 1, 0);
+		return $hrv if (defined($hrv));
+		}
+	else {
+		# Trim username to remove leading and trailing spaces to
+		# be able to login, if username pastes from somewhere
+		$in{'user'} =~ s/^\s+|\s+$//g;
+
+		# Validate the user
+		if ($in{'user'} =~ /\r|\n|\s/) {
+			&run_failed_script($in{'user'}, 'baduser',
+					   $loghost, $localip);
+			&http_error(500, "Invalid username",
+			    "Username contains invalid characters");
+			}
+		if ($in{'pass'} =~ /\r|\n/) {
+			&run_failed_script($in{'user'}, 'badpass',
+					   $loghost, $localip);
+			&http_error(500, "Invalid password",
+			    "Password contains invalid characters");
+			}
+
+		local $twofactor_probe = 0;
+		local ($vu, $expired, $nonexist, $wvu) =
+			&validate_user_caseless($in{'user'}, $in{'pass'}, $host,
+					        $acptip, $port);
+		if ($vu && $wvu) {
+			my $uinfo = &get_user_details($wvu, $vu);
+			my $can2fa = $uinfo && $uinfo->{'twofactor_provider'};
+			$twofactor_probe = 1 if ($in{'twofprobe'} && $can2fa);
+			if ($can2fa && !$twofactor_probe) {
+				# Check two-factor token ID
+				$err = &validate_twofactor(
+					$wvu, $in{'twofactor'}, $vu);
+				if ($err) {
+					&run_failed_script(
+						$vu, 'twofactor',
+						$loghost, $localip);
+					$twofactor_msg = $err;
+					$twofactor_nolog = 'nolog'
+						if (!$in{'twofactor'});
+					$vu = undef;
+					}
+				}
+			}
+		local $hrv = &handle_login(
+				$vu || $in{'user'}, $vu ? 1 : 0,
+				$expired, $nonexist, $in{'pass'},
+				$in{'notestingcookie'}, $twofactor_nolog,
+				$twofactor_probe);
+		return $hrv if (defined($hrv));
+		}
+	}
+
+# Check for a visit to the special PAM login page
+if ($config{'session'} && !$deny_authentication &&
+    $use_pam && $config{'pam_conv'} && $page eq $config{'pam_login'} &&
+    !$in{'restart'}) {
+	# A question has been entered .. submit it to the main process
+	print DEBUG "handle_request: Got call to $page ($in{'cid'})\n";
+	print DEBUG "handle_request: For PAM, authuser=$authuser\n";
+	if ($in{'answer'} =~ /\r|\n/ || $in{'cid'} =~ /\r|\n|\s/) {
+		&http_error(500, "Invalid response",
+		    "Response contains invalid characters");
+		}
+
+	if (!$in{'cid'}) {
+		# Start of a new conversation - answer must be username
+		$cid = &generate_random_id();
+		print $PASSINw "pamstart $cid $host $in{'answer'}\n";
+		}
+	else {
+		# A response to a previous question
+		$cid = $in{'cid'};
+		print $PASSINw "pamanswer $cid $in{'answer'}\n";
+		}
+
+	# Read back the response, and the next question (if any)
+	local $line = <$PASSOUTr>;
+	$line =~ s/\r|\n//g;
+	local ($rv, $question) = split(/\s+/, $line, 2);
+	if ($rv == 0) {
+		# Cannot login!
+		local $hrv = &handle_login(
+			!$in{'cid'} && $in{'answer'} ? $in{'answer'}
+						     : "unknown",
+			0, 0, 1, undef);
+		return $hrv if (defined($hrv));
+		}
+	elsif ($rv == 1 || $rv == 3) {
+		# Another question .. force use of PAM CGI
+		$validated = 1;
+		$method = "GET";
+		$querystring .= "&cid=$cid&question=".
+				&urlize($question);
+		$querystring .= "&password=1" if ($rv == 3);
+		$queryargs = "";
+		$page = $config{'pam_login'};
+		$miniserv_internal = 1;
+		$logged_code = 401;
+		}
+	elsif ($rv == 2) {
+		# Got back a final ok or failure
+		local ($user, $ok, $expired, $nonexist) =
+			split(/\s+/, $question);
+		local $hrv = &handle_login(
+			$user, $ok, $expired, $nonexist, undef,
+			$in{'notestingcookie'});
+		return $hrv if (defined($hrv));
+		}
+	elsif ($rv == 4) {
+		# A message from PAM .. tell the user
+		$validated = 1;
+		$method = "GET";
+		$querystring .= "&cid=$cid&message=".
+				&urlize($question);
+		$queryargs = "";
+		$page = $config{'pam_login'};
+		$miniserv_internal = 1;
+		$logged_code = 401;
+		}
+	}
+
+# Check for a visit to the special password change page
+if ($config{'session'} && !$deny_authentication &&
+    $page eq $config{'password_change'} && !$validated) {
+	# Just let this slide ..
+	$validated = 1;
+	$miniserv_internal = 3;
+
+	# check with main process for delay
+	if ($config{'passdelay'}) {
+		print DEBUG "handle_request: requesting delay acptip=$acptip\n";
+		print $PASSINw "delay - $acptip 0\n";
+		<$PASSOUTr> =~ /(\d+) (\d+)/;
+		sleep($1);
+		print DEBUG "handle_request: delay=$1 blocked=$2\n";
+		}
+	}
+
+# Check for an existing session
+if ($config{'session'} && !$validated) {
+	if ($already_session_id) {
+		$session_id = $already_session_id;
+		$authuser = $already_authuser;
+		$validated = 1;
+		}
+	elsif (!$deny_authentication &&
+	       $header{'cookie'} =~ /(^|\s|;)$sidname=([a-f0-9]+)/) {
+		# Try all session cookies
+		local $cookie = $header{'cookie'};
+		while($cookie =~ s/(^|\s|;)$sidname=([a-f0-9]+)//) {
+			$session_id = $2;
+			print $PASSINw "verify $session_id $acptip 1\n";
+			<$PASSOUTr> =~ /(\d+)\s+(\S+)/;
+			if ($1 == 2) {
+				# Valid session continuation
+				$validated = 1;
+				$authuser = $2;
+				$already_authuser = $authuser;
+				$timed_out = undef;
+				last;
+				}
+			elsif ($1 == 1) {
+				# Session timed out
+				$timed_out = $2;
+				}
+			elsif ($1 == 3) {
+				# Session is OK, but from the wrong IP
+				&log_error("Session $session_id was ",
+				  "used from $acptip instead of ",
+				  "original IP $2");
+				}
+			else {
+				# Invalid session ID .. don't set
+				# verified flag
+				}
+			}
+		}
+	if ($authuser) {
+		# We got a session .. but does the user still exist?
+		my @can = &can_user_login($authuser, undef, $host);
+		$baseauthuser = $can[3] || $authuser;
+		my $auser = &get_user_details($baseauthuser, $authuser);
+		if (!$auser) {
+			&log_error("Session $session_id is for user ",
+				     "$authuser who does not exist");
+			$validated = 0;
+			$already_authuser = $authuser = undef;
+			}
+		}
+	}
+
+# Check for local authentication
+if ($localauth_user && !$header{'x-forwarded-for'} && !$header{'via'}) {
+	my $luser = &get_user_details($localauth_user);
+	if ($luser) {
+		# Local user exists in webmin users file
+		$validated = 1;
+		$authuser = $localauth_user;
+		}
+	else {
+		# Check if local user is allowed by unixauth
+		local @can = &can_user_login($localauth_user,
+					     undef, $host);
+		if ($can[0]) {
+			$validated = 2;
+			$authuser = $localauth_user;
+			}
+		else {
+			$localauth_user = undef;
+			}
+		}
+	}
+
+if (!$validated) {
+	# Check if this path allows anonymous access
+	local $a;
+	foreach $a (keys %anonymous) {
+		if (substr($simple, 0, length($a)) eq $a) {
+			# It does! Auth as the user, if IP access
+			# control allows him.
+			if (&check_user_ip($anonymous{$a}) &&
+			    &check_user_time($anonymous{$a})) {
+				$validated = 3;
+				$baseauthuser = $authuser =
+					$anonymous{$a};
+				}
+			}
+		}
+	}
+
+if (!$validated) {
+	# Check if this path allows unauthenticated access
+	my $unauth;
+	foreach my $u (@unauth) {
+		$unauth = 4 if ($simple =~ /$u/);
+		}
+	foreach my $u (@unauthcgi) {
+		$unauth = 3 if ($simple =~ /$u/);
+		}
+	if (!$bogus && $unauth) {
+		# Unauthenticated directory or file request - approve it
+		$validated = $unauth;
+		$baseauthuser = $authuser = undef;
+		}
+	}
+
+if (!$validated) {
+	if ($blocked == 0) {
+		# No password given.. ask
+		if ($config{'pam_conv'} && $use_pam) {
+			# Force CGI for PAM question, starting with
+			# the username which is always needed
+			$validated = 1;
+			$method = "GET";
+			$querystring .= "&initial=1&question=".
+					&urlize("Username");
+			$querystring .= "&failed=$failed_user" if ($failed_user);
+			$querystring .= "&timed_out=$timed_out" if ($timed_out);
+			$queryargs = "";
+			$page = $config{'pam_login'};
+			$miniserv_internal = 1;
+			$logged_code = 401;
+			}
+		elsif ($config{'session'}) {
+			# Force CGI for session login
+			$validated = 1;
+			if ($logout) {
+				$querystring .= "&logout=1&page=/";
+				}
+			else {
+				# Re-direct to current module only
+				local $rpage = $request_uri;
+				if (!$config{'loginkeeppage'}) {
+					$rpage =~ s/\?.*$//;
+					$rpage =~ s/[^\/]+$//
+					}
+				$querystring = "page=".&urlize($rpage);
+				}
+			$method = "GET";
+			$querystring .= "&failed=".&urlize($failed_user)
+				if ($failed_user);
+			$querystring .= "&twofactor_msg=".&urlize($twofactor_msg)
+				if ($twofactor_msg);
+			$querystring .= "&timed_out=$timed_out"
+				if ($timed_out);
+			$queryargs = "";
+			$page = $config{'session_login'};
+			$miniserv_internal = 1;
+			$logged_code = 401;
+			}
+		else {
+			# Ask for login with HTTP authentication
+			&write_data("HTTP/1.0 401 Unauthorized\r\n");
+			&write_data("Date: $datestr\r\n");
+			&write_data("Server: @{[&server_info()]}\r\n");
+			&write_data("WWW-authenticate: Basic ".
+				   "realm=\"$config{'realm'}\"\r\n");
+			if ($http_auth_error) {
+				my $err = $http_auth_error;
+				$err =~ s/\r|\n//g;
+				&write_data("X-Webmin-Auth-Error: $err\r\n");
+				if ($http_auth_reason) {
+					my $reason = $http_auth_reason;
+					$reason =~ s/\r|\n//g;
+					&write_data(
+					  "X-Webmin-Auth-Reason: $reason\r\n");
+					}
+				}
+			&write_keep_alive(0);
+			&write_data("Content-type: text/html; Charset=utf-8\r\n");
+			&write_data("\r\n");
+			&reset_byte_count();
+			my $auth_err = $http_auth_reason ||
+				"A password is required to access this ".
+				"web server. Please try again.";
+			&write_data("<html>\n");
+			&write_data("<head>".&embed_error_styles($roots[0])."<title>401 &mdash; Unauthorized</title></head>\n");
+			&write_data("<body><h2 class=\"err-head\">401 &mdash; Unauthorized</h2>\n");
+			&write_data("<p class=\"err-content\">".
+				    &html_escape($auth_err)."</p> <p>\n");
+			&write_data("</body></html>\n");
+			&log_request($loghost, undef, $reqline, 401, &byte_count());
+			return 0;
+			}
+		}
+	elsif ($blocked == 1) {
+		# when the host has been blocked, give it an error
+		&http_error(403, "Access denied for $acptip. The host ".
+				 "has been blocked because of too ".
+				 "many authentication failures.");
+		}
+	elsif ($blocked == 2) {
+		# when the user has been blocked, give it an error
+		&http_error(403, "Access denied. The user ".
+				 "has been blocked because of too ".
+				 "many authentication failures.");
+		}
+	}
+else {
+	# Get the real Webmin username
+	if (!$baseauthuser) {
+		local @can = &can_user_login($authuser, undef, $host);
+		$baseauthuser = $can[3] || $authuser;
+		}
+
+	if ($config{'remoteuser'} && !$< && $validated) {
+		# Switch to the UID of the remote user (if he exists)
+		local @u = getpwnam($authuser);
+		if (@u && $< != $u[2]) {
+			$( = $u[3]; $) = "$u[3] $u[3]";
+			($>, $<) = ($u[2], $u[2]);
+			}
+		else {
+			&http_error(500, "Unix user ".
+			  &html_strip($authuser)." does not exist");
+			return 0;
+			}
+		}
+	}
+
+# Check per-user IP access control
+if (!&check_user_ip($baseauthuser)) {
+	&http_error(403, "Access denied for $acptip for ".
+			 &html_strip($baseauthuser));
+	return 0;
+	}
+
+# Check per-user allowed times
+if (!&check_user_time($baseauthuser)) {
+	&http_error(403, "Access denied at the current time");
+	return 0;
+	}
+$uinfo = &get_user_details($baseauthuser, $authuser);
+
+# Validate the path, and convert to canonical form
+rerun:
+$simple = &simplify_path($page, $bogus);
+print DEBUG "handle_request: page=$page simple=$simple\n";
+if ($bogus) {
+	&http_error(400, "Invalid path");
+	return 0;
+	}
+
+# Check for a DAV request
+if ($davpath) {
+	return &handle_dav_request($davpath);
+	}
+
+# Check for a websockets request
+if ($websocket_upgrade_request && $baseauthuser) {
+	print DEBUG "websockets request to $simple\n";
+	my ($ws, $ws_simple) = &find_websocket_config($simple);
+	if (!$ws) {
+		&http_error(400, "Unknown websocket path");
+		return 0;
+		}
+	return &handle_websocket_request($ws, $ws_simple);
+	}
+
+# Work out the active theme(s)
+local $preroots = $mobile_device && defined($config{'mobile_preroot'}) ?
+			$config{'mobile_preroot'} :
+		 $authuser && defined($config{'preroot_'.$authuser}) ?
+			$config{'preroot_'.$authuser} :
+	         $uinfo && defined($uinfo->{'preroot'}) ?
+			$uinfo->{'preroot'} :
+			$config{'preroot'};
+local @preroots = reverse(split(/\s+/, $preroots));
+
+# Canonicalize the directories
+local @themes;
+foreach my $preroot (@preroots) {
+	# Always under the current webmin root
+	$preroot =~ s/^.*\///g;
+	push(@themes, $preroot);
+	$preroot = $roots[0].'/'.$preroot;
+	}
+
+# Look in the theme root directories first
+local ($full, @stfull);
+$foundroot = undef;
+foreach my $preroot (@preroots) {
+	$is_directory = 1;
+	$sofar = "";
+	$full = $preroot.$sofar;
+	$scriptname = $simple;
+	foreach $b (split(/\//, $simple)) {
+		if ($b ne "") { $sofar .= "/$b"; }
+		$full = $preroot.$sofar;
+		@stfull = stat($full);
+		if (!@stfull) { undef($full); last; }
+
+		# Check if this is a directory
+		if (-d _) {
+			# It is.. go on parsing
+			$is_directory = 1;
+			next;
+			}
+		else {
+			$is_directory = 0;
+			}
+
+		# Check if this is a CGI program
+		if (&get_type($full) eq "internal/cgi") {
+			$pathinfo = substr($simple, length($sofar));
+			$pathinfo .= "/" if ($page =~ /\/$/);
+			$scriptname = $sofar;
+			last;
+			}
+		}
+
+	# Don't stop at a directory unless this is the last theme, which
+	# is the 'real' one that provides the .cgi scripts
+	if ($is_directory && $preroot ne $preroots[$#preroots]) {
+		next;
+		}
+
+	if ($full) {
+		# Found it!
+		if ($sofar eq '') {
+			$cgi_pwd = $roots[0];
+			}
+		elsif ($is_directory) {
+			$cgi_pwd = "$roots[0]$sofar";
+			}
+		else {
+			"$roots[0]$sofar" =~ /^(.*\/)[^\/]+$/;
+			$cgi_pwd = $1;
+			}
+		$foundroot = $preroot;
+		if ($is_directory) {
+			# Check for index files in the directory
+			local $foundidx;
+			foreach $idx (split(/\s+/, $config{"index_docs"})) {
+				$idxfull = "$full/$idx";
+				local @stidxfull = stat($idxfull);
+				if (-r _ && !-d _) {
+					$full = $idxfull;
+					@stfull = @stidxfull;
+					$is_directory = 0;
+					$scriptname .= "/"
+						if ($scriptname ne "/");
+					$foundidx++;
+					last;
+					}
+				}
+			@stfull = stat($full) if (!$foundidx);
+			}
+		}
+	last if ($foundroot);
+	}
+print DEBUG "handle_request: initial full=$full\n";
+
+# Look in the real root directories, stopping when we find a file or directory
+if (!$full || $is_directory) {
+	ROOT: foreach $root (@roots) {
+		$sofar = "";
+		$full = $root.$sofar;
+		$scriptname = $simple;
+		foreach $b ($simple eq "/" ? ( "" ) : split(/\//, $simple)) {
+			if ($b ne "") { $sofar .= "/$b"; }
+			$full = $root.$sofar;
+			@stfull = stat($full);
+			if (!@stfull) {
+				next ROOT;
+				}
+
+			# Check if this is a directory
+			if (-d _) {
+				# It is.. go on parsing
+				next;
+				}
+
+			# Check if this is a CGI program
+			if (&get_type($full) eq "internal/cgi") {
+				$pathinfo = substr($simple, length($sofar));
+				$pathinfo .= "/" if ($page =~ /\/$/);
+				$scriptname = $sofar;
+				last;
+				}
+			}
+
+		# Run CGI in the same directory as whatever file
+		# was requested
+		$full =~ /^(.*\/)[^\/]+$/; $cgi_pwd = $1;
+
+		if (-e $full) {
+			# Found something!
+			$realroot = $root;
+			$foundroot = $root;
+			last;
+			}
+		}
+	if (!@stfull) { &http_error(404, "File not found"); }
+	}
+print DEBUG "handle_request: full=$full\n";
+@stfull = stat($full) if (!@stfull);
+
+# check filename against denyfile regexp
+local $denyfile = $config{'denyfile'};
+if ($denyfile && $full =~ /$denyfile/) {
+	&http_error(403, "Access denied to ".&html_strip($page));
+	return 0;
+	}
+
+# Reached the end of the path OK.. see what we've got
+if (-d _) {
+	# See if the URL ends with a / as it should
+	print DEBUG "handle_request: found a directory\n";
+	if ($page !~ /\/$/) {
+		# It doesn't.. redirect
+		&write_data("HTTP/1.0 302 Moved Temporarily\r\n");
+		&write_data("Date: $datestr\r\n");
+		&write_data("Server: @{[&server_info()]}\r\n");
+		&write_data("Location: $prot://$hostport$page/\r\n");
+		&write_keep_alive(0);
+		&write_data("\r\n");
+		&log_request($loghost, $authuser, $reqline, 302, 0);
+		return 0;
+		}
+	# A directory.. check for index files
+	local $foundidx;
+	foreach $idx (split(/\s+/, $config{"index_docs"})) {
+		$idxfull = "$full/$idx";
+		@stidxfull = stat($idxfull);
+		if (-r _ && !-d _) {
+			$cgi_pwd = $full;
+			$full = $idxfull;
+			@stfull = @stidxfull;
+			$scriptname .= "/" if ($scriptname ne "/");
+			$foundidx++;
+			last;
+			}
+		}
+	@stfull = stat($full) if (!$foundidx);
+	}
+if (-d _) {
+	# This is definitely a directory.. list it
+	if ($config{'nolistdir'}) {
+		&http_error(500, "Directory is missing an index file");
+		}
+	print DEBUG "handle_request: listing directory\n";
+	local $resp = "HTTP/1.0 $ok_code $ok_message\r\n".
+		      "Date: $datestr\r\n".
+		      "Server: @{[&server_info()]}\r\n".
+		      "Content-type: text/html; Charset=utf-8\r\n";
+	&write_data($resp);
+	&write_keep_alive(0);
+	&write_data("\r\n");
+	&reset_byte_count();
+	&write_data("".&embed_error_styles($roots[0])."<h2 class=\"err-head\">Index of $simple</h2>\n");
+	&write_data("<pre class=\"err-content\">\n");
+	&write_data(sprintf "%-35.35s %-20.20s %-10.10s\n",
+			"Name", "Last Modified", "Size");
+	&write_data("</pre>\n");
+	&write_data("<hr>\n");
+	opendir(DIR, $full);
+	while($df = readdir(DIR)) {
+		if ($df =~ /^\./) { next; }
+		$fulldf = $full eq "/" ? $full.$df : $full."/".$df;
+		(@stbuf = stat($fulldf)) || next;
+		if (-d _) { $df .= "/"; }
+		@tm = localtime($stbuf[9]);
+		$fdate = sprintf "%2.2d/%2.2d/%4.4d %2.2d:%2.2d:%2.2d",
+				$tm[3],$tm[4]+1,$tm[5]+1900,
+				$tm[0],$tm[1],$tm[2];
+		$len = length($df); $rest = " "x(35-$len);
+		&write_data(sprintf
+		 "<a href=\"%s\">%-${len}.${len}s</a>$rest %-20.20s %-10.10s\n",
+		 &urlize($df), &html_strip($df), $fdate, $stbuf[7]);
+		}
+	closedir(DIR);
+	&log_request($loghost, $authuser, $reqline, $ok_code, &byte_count());
+	return 0;
+	}
+
+# CGI or normal file
+local $rv;
+if (&get_type($full) eq "internal/cgi" && $validated != 4) {
+	# A CGI program to execute
+	print DEBUG "handle_request: executing CGI\n";
+	$envtz = $ENV{"TZ"};
+	$envuser = $ENV{"USER"};
+	$envpath = $ENV{"PATH"};
+	$envlang = $ENV{"LANG"};
+	$envroot = $ENV{"SystemRoot"};
+	$envperllib = $ENV{'PERLLIB'};
+	$envdoclroot = $ENV{'LIBROOT'};
+	foreach my $k (keys %ENV) {
+		delete($ENV{$k});
+		}
+	$ENV{"PATH"} = $envpath if ($envpath);
+	$ENV{"TZ"} = $envtz if ($envtz);
+	$ENV{"USER"} = $envuser if ($envuser);
+	$ENV{"OLD_LANG"} = $envlang if ($envlang);
+	$ENV{"SystemRoot"} = $envroot if ($envroot);
+	$ENV{'LIBROOT'} = $envdoclroot if ($envdoclroot);
+	$ENV{'PERLLIB'} = $envperllib if ($envperllib);
+	$ENV{"HOME"} = $user_homedir;
+	$ENV{"SERVER_SOFTWARE"} = $config{"server"};
+	$ENV{"SERVER_NAME"} = $host;
+	$ENV{"SERVER_ADMIN"} = $config{"email"};
+	$ENV{"SERVER_ROOT"} = $roots[0];
+	$ENV{"SERVER_REALROOT"} = $realroot;
+	$ENV{"SERVER_PORT"} = $port;
+	$ENV{"REMOTE_HOST"} = $acpthost;
+	$ENV{"REMOTE_ADDR"} = $acptip;
+	$ENV{"REMOTE_ADDR_PROTOCOL"} = $ipv6 ? 6 : 4;
+	$ENV{"REMOTE_USER"} = $authuser;
+	$ENV{"BASE_REMOTE_USER"} = $authuser ne $baseauthuser ?
+					$baseauthuser : undef;
+	$ENV{"REMOTE_PASS"} = $authpass if (defined($authpass) &&
+					    $config{'pass_password'});
+	if ($uinfo && $uinfo->{'proto'}) {
+		$ENV{"REMOTE_USER_PROTO"} = $uinfo->{'proto'};
+		$ENV{"REMOTE_USER_ID"} = $uinfo->{'id'};
+		}
+	print DEBUG "REMOTE_USER = ",$ENV{"REMOTE_USER"},"\n";
+	print DEBUG "BASE_REMOTE_USER = ",$ENV{"BASE_REMOTE_USER"},"\n";
+	print DEBUG "proto=$uinfo->{'proto'} id=$uinfo->{'id'}\n" if ($uinfo);
+	$ENV{"SSL_USER"} = $peername if ($validated == 2);
+	$ENV{"ANONYMOUS_USER"} = "1" if ($validated == 3 || $validated == 4);
+	$ENV{"DOCUMENT_ROOT"} = $roots[0];
+	$ENV{"THEME_ROOT"} = $preroots[0];
+	$ENV{"THEME_DIRS"} = join(" ", @themes) || "";
+	$ENV{"DOCUMENT_REALROOT"} = $realroot;
+	$ENV{"GATEWAY_INTERFACE"} = "CGI/1.1";
+	$ENV{"SERVER_PROTOCOL"} = "HTTP/1.0";
+	$ENV{"REQUEST_METHOD"} = $method;
+	$ENV{"SCRIPT_NAME"} = $scriptname;
+	$ENV{"SCRIPT_FILENAME"} = $full;
+	$ENV{"REQUEST_URI"} = $request_uri;
+	$ENV{"PATH_INFO"} = $pathinfo;
+	if ($pathinfo) {
+		$ENV{"PATH_TRANSLATED"} = "$roots[0]$pathinfo";
+		$ENV{"PATH_REALTRANSLATED"} = "$realroot$pathinfo";
+		}
+	$ENV{"QUERY_STRING"} = $querystring;
+	$ENV{"MINISERV_CONFIG"} = $config_file;
+	$ENV{"HTTPS"} = $use_ssl ? "ON" : "";
+	$ENV{"SSL_HSTS"} = $config{"ssl_hsts"};
+	if ($use_ssl) {
+		$ENV{"SSL_CN"} = $ssl_cn;
+		$ENV{"SSL_CN_CERT"} =
+			&ssl_hostname_match($header{'host'}, $ssl_alts) &&
+			&ssl_hostname_match($ssl_cn, $ssl_alts);
+		}
+	$ENV{"MINISERV_PID"} = $miniserv_main_pid;
+	if ($use_ssl) {
+		$ENV{"MINISERV_CERTFILE"} = $ssl_certfile;
+		$ENV{"MINISERV_KEYFILE"} = $ssl_keyfile;
+		}
+	$ENV{"SESSION_ID"} = $session_id if ($session_id);
+	$ENV{"LOCAL_USER"} = $localauth_user if ($localauth_user);
+	$ENV{"MINISERV_INTERNAL"} = $miniserv_internal if ($miniserv_internal);
+	if (defined($header{"content-length"})) {
+		$ENV{"CONTENT_LENGTH"} = $header{"content-length"};
+		}
+	if (defined($header{"content-type"})) {
+		$ENV{"CONTENT_TYPE"} = $header{"content-type"};
+		}
+	foreach $h (keys %header) {
+		($hname = $h) =~ tr/a-z/A-Z/;
+		$hname =~ s/\-/_/g;
+		$ENV{"HTTP_$hname"} = $header{$h};
+		}
+	$ENV{"PWD"} = $cgi_pwd;
+	foreach $k (keys %config) {
+		if ($k =~ /^env_(\S+)$/) {
+			$ENV{$1} = $config{$k};
+			}
+		}
+	delete($ENV{'HTTP_AUTHORIZATION'});
+	$ENV{'HTTP_COOKIE'} =~ s/;?\s*$sidname=([a-f0-9]+)//;
+	$ENV{'MOBILE_DEVICE'} = 1 if ($mobile_device);
+
+	# Check if the CGI can be handled internally
+	open(CGI, $full);
+	local $first = <CGI>;
+	close(CGI);
+	$first =~ s/[#!\r\n]//g;
+	$nph_script = ($full =~ /\/nph-([^\/]+)$/);
+	seek(STDERR, 0, 2);
+	if (!$config{'forkcgis'} &&
+	    ($first eq $perl_path || $first eq $linked_perl_path ||
+	     $first =~ /\/perl$/ || $first =~ /^\/\S+\/env\s+perl$/) &&
+	      $] >= 5.004 ||
+            $config{'internalcgis'}) {
+		# setup environment for eval
+		chdir($ENV{"PWD"});
+		@ARGV = split(/\s+/, $queryargs);
+		$0 = $full;
+		if ($posted_data) {
+			# Already read the post input
+			$postinput = $posted_data;
+			}
+		$clen = $header{"content-length"};
+		$SIG{'CHLD'} = 'DEFAULT';
+		eval {
+			# Have SOCK closed if the perl exec's something
+			use Fcntl;
+			fcntl(SOCK, F_SETFD, FD_CLOEXEC);
+			};
+		#shutdown(SOCK, 0);
+
+		if ($config{'log'}) {
+			open(MINISERVLOG, ">>$config{'logfile'}");
+			if ($config{'logperms'}) {
+				chmod(oct($config{'logperms'}),
+				      $config{'logfile'});
+				}
+			else {
+				chmod(0600, $config{'logfile'});
+				}
+			}
+		$doing_cgi_eval = 1;
+		$main_process_id = $$;
+		$pkg = "main";
+		if ($full =~ /^\Q$foundroot\E\/([^\/]+)\//) {
+			# Eval in package from Webmin module name
+			$pkg = $1;
+			$pkg =~ s/[^A-Za-z0-9]/_/g;
+			}
+		eval "
+			\%pkg::ENV = \%ENV;
+			package $pkg;
+			tie(*STDOUT, 'miniserv');
+			tie(*STDIN, 'miniserv');
+			do \$miniserv::full;
+			die \$@ if (\$@);
+			";
+		$doing_cgi_eval = 0;
+		if ($@) {
+			# Error in perl!
+			&http_error(500, "Perl execution failed",
+				    $config{'noshowstderr'} ? undef : "$@");
+			}
+		elsif (!$doneheaders && !$nph_script) {
+			&http_error(500, "Missing Headers");
+			}
+		$rv = 0;
+		}
+	else {
+		$infile = undef;
+		if (!$on_windows) {
+			# fork the process that actually executes the CGI
+			pipe(CGIINr, CGIINw);
+			pipe(CGIOUTr, CGIOUTw);
+			pipe(CGIERRr, CGIERRw);
+			if (!($cgipid = fork())) {
+				@execargs = ( $full, split(/\s+/, $queryargs) );
+				chdir($ENV{"PWD"});
+				close(SOCK);
+				open(STDIN, "<&CGIINr");
+				open(STDOUT, ">&CGIOUTw");
+				open(STDERR, ">&CGIERRw");
+				close(CGIINw); close(CGIOUTr); close(CGIERRr);
+				exec(@execargs) ||
+					die "Failed to exec $full : $!\n";
+				exit(0);
+				}
+			close(CGIINr); close(CGIOUTw); close(CGIERRw);
+			}
+		else {
+			# write CGI input to a temp file
+			$infile = "$config{'tempbase'}.$$";
+			open(CGIINw, ">$infile");
+			# NOT binary mode, as CGIs don't read in it!
+			}
+
+		# send post data
+		if ($posted_data) {
+			# already read the posted data
+			print CGIINw $posted_data;
+			}
+		$clen = $header{"content-length"};
+		if ($method eq "POST" && $clen_read < $clen) {
+			$SIG{'PIPE'} = 'IGNORE';
+			$got = $clen_read;
+			while($got < $clen) {
+				$buf = &read_data($clen-$got);
+				if (!length($buf)) {
+					kill('TERM', $cgipid);
+					unlink($infile) if ($infile);
+					&http_error(500, "Failed to read ".
+							 "POST request");
+					}
+				$got += length($buf);
+				local ($wrote) = (print CGIINw $buf);
+				last if (!$wrote);
+				}
+			# If the CGI terminated early, we still need to read
+			# from the browser and throw away
+			while($got < $clen) {
+				$buf = &read_data($clen-$got);
+				if (!length($buf)) {
+					kill('TERM', $cgipid);
+					unlink($infile) if ($infile);
+					&http_error(500, "Failed to read ".
+							 "POST request");
+					}
+				$got += length($buf);
+				}
+			$SIG{'PIPE'} = 'DEFAULT';
+			}
+		close(CGIINw);
+		shutdown(SOCK, 0);
+
+		if ($on_windows) {
+			# Run the CGI program, and feed it input
+			chdir($ENV{"PWD"});
+			local $qqueryargs = join(" ",
+				map { s/([<>|&"^])/^$1/g; "\"$_\"" }
+				    split(/\s+/, $queryargs));
+			if ($first =~ /(perl|perl.exe)$/i) {
+				# On Windows, run with Perl
+				open(CGIOUTr, "$perl_path \"$full\" $qqueryargs <$infile |");
+				}
+			else {
+				open(CGIOUTr, "\"$full\" $qqueryargs <$infile |");
+				}
+			binmode(CGIOUTr);
+			}
+
+		if (!$nph_script) {
+			# read back cgi headers
+			select(CGIOUTr); $|=1; select(STDOUT);
+			$got_blank = 0;
+			while(1) {
+				$line = <CGIOUTr>;
+				$line =~ s/\r|\n//g;
+				if ($line eq "") {
+					if ($got_blank || %cgiheader) { last; }
+					$got_blank++;
+					next;
+					}
+				if ($line !~ /^(\S+):\s+(.*)$/) {
+					$errs = &read_errors(CGIERRr);
+					close(CGIOUTr); close(CGIERRr);
+					unlink($infile) if ($infile);
+					&http_error(500, "Bad Header", $errs);
+					}
+				$cgiheader{lc($1)} = $2;
+				push(@cgiheader, [ $1, $2 ]);
+				}
+			if ($cgiheader{"location"}) {
+				&write_data("HTTP/1.0 302 Moved Temporarily\r\n");
+				&write_data("Date: $datestr\r\n");
+				&write_data("Server: @{[&server_info()]}\r\n");
+				&write_keep_alive(0);
+				# ignore the rest of the output. This is a hack,
+				# but is necessary for IE in some cases :(
+				close(CGIOUTr); close(CGIERRr);
+				}
+			elsif ($cgiheader{"content-type"} eq "") {
+				close(CGIOUTr); close(CGIERRr);
+				unlink($infile) if ($infile);
+				$errs = &read_errors(CGIERRr);
+				&http_error(500, "Missing Content-Type Header",
+				    $config{'noshowstderr'} ? undef : $errs);
+				}
+			else {
+				&write_data("HTTP/1.0 $ok_code $ok_message\r\n");
+				&write_data("Date: $datestr\r\n");
+				&write_data("Server: @{[&server_info()]}\r\n");
+				&write_keep_alive(0);
+				}
+			foreach $h (@cgiheader) {
+				&write_data("$h->[0]: $h->[1]\r\n");
+				}
+			&write_data("\r\n");
+			}
+		&reset_byte_count();
+		while($line = <CGIOUTr>) {
+			&write_data($line);
+			}
+		close(CGIOUTr);
+		close(CGIERRr);
+		unlink($infile) if ($infile);
+		$rv = 0;
+		}
+	}
+else {
+	# A file to output
+	print DEBUG "handle_request: outputting file $full\n";
+	$gzfile = $full.".gz";
+	$gzipped = 0;
+	if ($config{'gzip'} ne '0' && -r $gzfile && $acceptenc{'gzip'}) {
+		# Using gzipped version
+		@stopen = stat($gzfile);
+		if ($stopen[9] >= $stfull[9] && open(FILE, $gzfile)) {
+			print DEBUG "handle_request: using gzipped $gzfile\n";
+			$gzipped = 1;
+			}
+		}
+	if (!$gzipped) {
+		# Using original file
+		@stopen = @stfull;
+		open(FILE, $full) || &http_error(404, "Failed to open file");
+		}
+	binmode(FILE);
+
+	# Build common headers
+	local $etime = &get_expires_time($simple);
+	local $resp = "HTTP/1.0 $ok_code $ok_message\r\n".
+		      "Date: $datestr\r\n".
+		      "Server: @{[&server_info()]}\r\n".
+		      "Content-type: ".&get_type($full)."\r\n".
+		      "Last-Modified: ".&http_date($stopen[9])."\r\n".
+		      "Expires: ".&http_date(time()+$etime)."\r\n".
+		      "Cache-Control: public; max-age=".$etime."\r\n";
+
+	if (!$gzipped && $use_gzip && $acceptenc{'gzip'} &&
+	    &should_gzip_file($full)) {
+		# Load and compress file, then output
+		print DEBUG "handle_request: outputting gzipped file $full\n";
+		open(FILE, $full) || &http_error(404, "Failed to open file");
+		{
+			local $/ = undef;
+			$data = <FILE>;
+		}
+		close(FILE);
+		@stopen = stat($file);
+		$data = Compress::Zlib::memGzip($data);
+		$resp .= "Content-length: ".length($data)."\r\n".
+			 "Content-Encoding: gzip\r\n";
+		&write_data($resp);
+		$rv = &write_keep_alive();
+		&write_data("\r\n");
+		&reset_byte_count();
+		&write_data($data);
+		}
+	else {
+		# Stream file output
+		$resp .= "Content-length: $stopen[7]\r\n";
+		$resp .= "Content-Encoding: gzip\r\n" if ($gzipped);
+		&write_data($resp);
+		$rv = &write_keep_alive();
+		&write_data("\r\n");
+		&reset_byte_count();
+		my $bufsize = $config{'bufsize'} || 32768;
+		while(read(FILE, $buf, $bufsize) > 0) {
+			&write_data($buf);
+			}
+		close(FILE);
+		}
+	}
+
+# log the request
+&log_request($loghost, $authuser, $reqline,
+	     $logged_code ? $logged_code :
+	     $cgiheader{"location"} ? "302" : $ok_code, &byte_count());
+return $rv;
+}
+
+# http_error(code, message, body, [dontexit], [dontstderr])
+# Output an error message to the browser, and log it to the error log
+sub http_error
+{
+my ($code, $msg, $body, $noexit, $noerr) = @_;
+local $eh = $error_handler_recurse ? undef :
+	    $config{"error_handler_".$code} ? $config{"error_handler_".$code} :
+	    $config{'error_handler'} ? $config{'error_handler'} : undef;
+print DEBUG "http_error code=$code message=$msg body=$body\n";
+if ($eh) {
+	my $found;
+	foreach my $root (@preroots, @roots) {
+		$found++ if (-e $root."/".$eh);
+		}
+	$eh = undef if (!$found);
+	}
+if ($eh) {
+	# Call a CGI program for the error
+	$page = "/$eh";
+	$querystring = "code=".&urlize($code)."&message=".&urlize($msg).
+		       "&body=".&urlize($body);
+	$error_handler_recurse++;
+	$ok_code = $code;
+	$ok_message = $msg;
+	goto rerun;
+	}
+else {
+	# Use the standard error message display
+	&write_data("HTTP/1.0 $code $msg\r\n");
+	&write_data("Server: @{[&server_info()]}\r\n");
+	&write_data("Date: $datestr\r\n");
+	&write_data("Content-type: text/html; Charset=utf-8\r\n");
+	&write_keep_alive(0);
+	&write_data("\r\n");
+	&reset_byte_count();
+	&write_data("<html>\n");
+	&write_data("<head>".&embed_error_styles($roots[0])."<title>$code &mdash; $msg</title></head>\n");
+	&write_data("<body class=\"err-body\"><h2 class=\"err-head\">Error &mdash; $msg</h2>\n");
+	if ($body) {
+		&write_data("<p class=\"err-content\">$body</p>\n");
+		}
+	&write_data("</body></html>\n");
+	}
+&log_request($loghost, $authuser, $reqline, $code, &byte_count())
+	if ($reqline);
+&log_error($msg, $body ? " : $body" : "") if (!$noerr);
+shutdown(SOCK, 1);
+close(SOCK);
+exit if (!$noexit);
+}
+
+# embed_error_styles()
+# Returns HTML styles for nicer errors. For internal use only.
+sub embed_error_styles
+{
+my ($root) = @_;
+if ($root) {
+	my $err_style = &read_any_file("$root/unauthenticated/errors.css");
+	if ($err_style) {
+		$err_style =~ s/[\n\r]//g;
+		$err_style =~ s/\s+/ /g;
+		$err_style = "<style data-err type=\"text/css\">$err_style</style>";
+		return "\n$err_style\n";
+		}
+	}
+return undef;
+}
+
+sub get_type
+{
+if ($_[0] =~ /\.([A-z0-9]+)$/) {
+	$t = $mime{$1};
+	if ($t ne "") {
+		return $t;
+		}
+	}
+return "text/plain";
+}
+
+# simplify_path(path, bogus)
+# Given a path, maybe containing stuff like ".." and "." convert it to a
+# clean, absolute form.
+sub simplify_path
+{
+local($dir, @bits, @fixedbits, $b);
+$dir = $_[0];
+$dir =~ s/\\/\//g;	# fix windows \ in path
+$dir =~ s/^\/+//g;
+$dir =~ s/\/+$//g;
+$dir =~ s/\0//g;	# remove null bytes
+@bits = split(/\/+/, $dir);
+@fixedbits = ();
+$_[1] = 0;
+foreach $b (@bits) {
+        if ($b eq ".") {
+                # Do nothing..
+                }
+        elsif ($b eq ".." || $b eq "...") {
+                # Remove last dir
+                if (scalar(@fixedbits) == 0) {
+                        $_[1] = 1;
+                        return "/";
+                        }
+                pop(@fixedbits);
+                }
+        else {
+                # Add dir to list
+                push(@fixedbits, $b);
+                }
+        }
+return "/" . join('/', @fixedbits);
+}
+
+# b64decode(string)
+# Converts a string from base64 format to normal
+sub b64decode
+{
+    local($str) = $_[0];
+    local($res);
+    $str =~ tr|A-Za-z0-9+=/||cd;
+    $str =~ s/=+$//;
+    $str =~ tr|A-Za-z0-9+/| -_|;
+    while ($str =~ /(.{1,60})/gs) {
+        my $len = chr(32 + length($1)*3/4);
+        $res .= unpack("u", $len . $1 );
+    }
+    return $res;
+}
+
+# b64encode(string)
+# Encodes a string into base64 format
+sub b64encode
+{
+my ($str) = @_;
+my $res;
+pos($str) = 0;                          # ensure start at the beginning
+while($str =~ /(.{1,57})/gs) {
+	$res .= substr(pack('u57', $1), 1);
+	chop($res);
+	}
+$res =~ tr|\` -_|AA-Za-z0-9+/|;
+my $padding = (3 - length($str) % 3) % 3;
+$res =~ s/.{$padding}$/'=' x $padding/e if ($padding);
+return $res;
+}
+
+# ip_match(remoteip, localip, [match]+)
+# Checks an IP address against a list of IPs, networks and networks/masks
+sub ip_match
+{
+local(@io, @mo, @ms, $i, $j, $hn, $needhn);
+@io = &check_ip6address($_[0]) ? split(/:/, $_[0])
+			       : split(/\./, $_[0]);
+for($i=2; $i<@_; $i++) {
+	$needhn++ if ($_[$i] =~ /^\*(\S+)$/);
+	}
+if ($needhn && !defined($hn = $ip_match_cache{$_[0]})) {
+	# Reverse-lookup hostname if any rules match based on it
+	$hn = &to_hostname($_[0]);
+	if (&check_ip6address($_[0])) {
+		local $ip6 = &to_ip6address($hn);
+		$hn = "" if (!$ip6 ||
+			     &canonicalize_ip6($ip6) ne
+				&canonicalize_ip6($_[0]));
+		}
+	else {
+		$hn = "" if (&to_ipaddress($hn) ne $_[0]);
+		}
+	$ip_match_cache{$_[0]} = $hn;
+	}
+for($i=2; $i<@_; $i++) {
+	local $mismatch = 0;
+	if ($_[$i] =~ /^([0-9\.]+)\/(\d+)$/) {
+		# Convert CIDR to netmask format
+		$_[$i] = $1."/".&prefix_to_mask($2);
+		}
+	if ($_[$i] =~ /^([0-9\.]+)\/([0-9\.]+)$/) {
+		# Compare with IPv4 network/mask
+		@mo = split(/\./, $1);
+		@ms = split(/\./, $2);
+		for($j=0; $j<4; $j++) {
+			if ((int($io[$j]) & int($ms[$j])) != (int($mo[$j]) & int($ms[$j]))) {
+				$mismatch = 1;
+				}
+			}
+		}
+	elsif ($_[$i] =~ /^([0-9\.]+)-([0-9\.]+)$/) {
+		# Compare with an IPv4 range (separated by a hyphen -)
+		local ($remote, $min, $max);
+		local @low = split(/\./, $1);
+		local @high = split(/\./, $2);
+		for($j=0; $j<4; $j++) {
+			$remote += $io[$j] << ((3-$j)*8);
+			$min += $low[$j] << ((3-$j)*8);
+			$max += $high[$j] << ((3-$j)*8);
+			}
+		if ($remote < $min || $remote > $max) {
+			$mismatch = 1;
+			}
+		}
+	elsif ($_[$i] =~ /^\*(\S+)$/) {
+		# Compare with hostname regexp
+		$mismatch = 1 if ($hn !~ /^.*\Q$1\E$/i);
+		}
+	elsif ($_[$i] eq 'LOCAL' && &check_ipaddress($_[1])) {
+		# Compare with local IPv4 network
+		local @lo = split(/\./, $_[1]);
+		if ($lo[0] < 128) {
+			$mismatch = 1 if ($lo[0] != $io[0]);
+			}
+		elsif ($lo[0] < 192) {
+			$mismatch = 1 if ($lo[0] != $io[0] ||
+					  $lo[1] != $io[1]);
+			}
+		else {
+			$mismatch = 1 if ($lo[0] != $io[0] ||
+					  $lo[1] != $io[1] ||
+					  $lo[2] != $io[2]);
+			}
+		}
+	elsif ($_[$i] eq 'LOCAL' && &check_ip6address($_[1])) {
+		# Compare with local IPv6 network, which is always first 4 words
+		local @lo = split(/:/, $_[1]);
+		for(my $i=0; $i<4; $i++) {
+			$mismatch = 1 if ($lo[$i] ne $io[$i]);
+			}
+		}
+	elsif ($_[$i] =~ /^[0-9\.]+$/) {
+		# Compare with a full or partial IPv4 address
+		@mo = split(/\./, $_[$i]);
+		while(@mo && !$mo[$#mo]) { pop(@mo); }
+		for($j=0; $j<@mo; $j++) {
+			if ($mo[$j] != $io[$j]) {
+				$mismatch = 1;
+				}
+			}
+		}
+	elsif ($_[$i] =~ /^[a-f0-9:]+$/) {
+		# Compare with a full IPv6 address
+		if (&canonicalize_ip6($_[$i]) ne canonicalize_ip6($_[0])) {
+			$mismatch = 1;
+			}
+		}
+	elsif ($_[$i] =~ /^([a-f0-9:]+)\/(\d+)$/) {
+		# Compare with an IPv6 network
+		local $v6size = $2;
+		local $v6addr = &canonicalize_ip6($1);
+		$mismatch = 1 if (!&ip6_prefix_match($_[0], $v6addr, $v6size));
+		}
+	elsif ($_[$i] !~ /^[0-9\.]+$/) {
+		# Compare with hostname
+		if (&check_ip6address($_[0])) {
+			local $ip6 = &to_ip6address($_[$i]);
+			$mismatch = 1 if (!$ip6 ||
+					  &canonicalize_ip6($ip6) ne
+						&canonicalize_ip6($_[0]));
+			}
+		else {
+			$mismatch = 1 if ($_[0] ne &to_ipaddress($_[$i]));
+			}
+		}
+	return 1 if (!$mismatch);
+	}
+return 0;
+}
+
+# users_match(&uinfo, user, ...)
+# Returns 1 if a user is in a list of users and groups
+sub users_match
+{
+local $uinfo = shift(@_);
+local $u;
+local @ginfo = getgrgid($uinfo->[3]);
+foreach $u (@_) {
+	if ($u =~ /^\@(\S+)$/) {
+		return 1 if (&is_group_member($uinfo, $1));
+		}
+	elsif ($u =~ /^(\d*)-(\d*)$/ && ($1 || $2)) {
+		return (!$1 || $uinfo[2] >= $1) &&
+		       (!$2 || $uinfo[2] <= $2);
+		}
+	else {
+		return 1 if ($u eq $uinfo->[0]);
+		}
+	}
+return 0;
+}
+
+# restart_miniserv()
+# Called when a SIGHUP is received to restart the web server. This is done
+# by exec()ing perl with the same command line as was originally used
+sub restart_miniserv
+{
+&log_error("Restarting");
+close(SOCK);
+&close_all_sockets();
+&close_all_pipes();
+dbmclose(%sessiondb);
+kill('KILL', $logclearer) if ($logclearer);
+kill('KILL', $extauth) if ($extauth);
+if (&indexof("--nofork", @miniserv_argv) < 0) {
+	unshift(@miniserv_argv, "--nofork");
+	}
+exec($perl_path, $miniserv_path, @miniserv_argv);
+die "Failed to restart miniserv with $perl_path $miniserv_path";
+}
+
+sub trigger_restart
+{
+$need_restart = 1;
+}
+
+sub trigger_reload
+{
+$need_reload = 1;
+}
+
+# to_ip46address(address, ...)
+# Convert hostnames to v4 and v6 addresses, if possible
+sub to_ip46address
+{
+local @rv;
+foreach my $i (@_) {
+	if (&check_ipaddress($i) || &check_ip6address($i)) {
+		push(@rv, $i);
+		}
+	else {
+		my $addr = &to_ipaddress($i);
+		$addr ||= &to_ip6address($i);
+		push(@rv, $addr) if ($addr);
+		}
+	}
+return @rv;
+}
+
+# to_ipaddress(address, ...)
+sub to_ipaddress
+{
+local (@rv, $i);
+foreach $i (@_) {
+	if ($i =~ /(\S+)\/(\S+)/ || $i =~ /^\*\S+$/ ||
+	    $i eq 'LOCAL' || $i =~ /^[0-9\.]+$/ || $i =~ /^[a-f0-9:]+$/) {
+		# A pattern or IP, not a hostname, so don't change
+		push(@rv, $i);
+		}
+	else {
+		# Lookup IP address
+		push(@rv, join('.', unpack("CCCC", inet_aton($i))));
+		}
+	}
+return wantarray ? @rv : $rv[0];
+}
+
+# to_ip6address(address, ...)
+sub to_ip6address
+{
+local (@rv, $i);
+foreach $i (@_) {
+	if ($i =~ /(\S+)\/(\S+)/ || $i =~ /^\*\S+$/ ||
+	    $i eq 'LOCAL' || $i =~ /^[0-9\.]+$/ || $i =~ /^[a-f0-9:]+$/) {
+		# A pattern, not a hostname, so don't change
+		push(@rv, $i);
+		}
+	elsif ($config{'ipv6'}) {
+		# Lookup IPv6 address
+		local ($inaddr, $addr);
+		eval {
+			(undef, undef, undef, $inaddr) =
+			    getaddrinfo($i, undef, AF_INET6(), SOCK_STREAM);
+			};
+		if (!$inaddr) {
+			push(@rv, undef);
+			}
+		else {
+			(undef, $addr) = unpack_sockaddr_in6($inaddr);
+			push(@rv, inet_ntop(AF_INET6(), $addr));
+			}
+		}
+	}
+return wantarray ? @rv : $rv[0];
+}
+
+# to_hostname(ipv4|ipv6-address)
+# Reverse-resolves an IPv4 or 6 address to a hostname
+sub to_hostname
+{
+local ($addr) = @_;
+if (&check_ip6address($_[0])) {
+	return gethostbyaddr(inet_pton(AF_INET6(), $addr),
+			     AF_INET6());
+	}
+else {
+	return gethostbyaddr(inet_aton($addr), AF_INET);
+	}
+}
+
+# read_line(no-wait, no-limit)
+# Reads one line from SOCK or SSL
+sub read_line
+{
+local ($nowait, $nolimit) = @_;
+local($idx, $more, $rv);
+while(($idx = index($main::read_buffer, "\n")) < 0) {
+	if (length($main::read_buffer) > 100000 && !$nolimit) {
+		&http_error(414, "Request too long",
+		    "Received excessive line <pre class=\"err-content\">".&html_strip($main::read_buffer)."</pre>");
+		}
+
+	# need to read more..
+	&wait_for_data_error() if (!$nowait);
+	if ($use_ssl) {
+		$more = Net::SSLeay::read($ssl_con);
+		}
+	else {
+		my $bufsize = $config{'bufsize'} || 32768;
+                local $ok = sysread(SOCK, $more, $bufsize);
+		$more = undef if ($ok <= 0);
+		}
+	if ($more eq '') {
+		# end of the data
+		$rv = $main::read_buffer;
+		undef($main::read_buffer);
+		return $rv;
+		}
+	$main::read_buffer .= $more;
+	}
+$rv = substr($main::read_buffer, 0, $idx+1);
+$main::read_buffer = substr($main::read_buffer, $idx+1);
+return $rv;
+}
+
+# read_data(length)
+# Reads up to some amount of data from SOCK or the SSL connection
+sub read_data
+{
+local ($rv);
+if (length($main::read_buffer)) {
+	if (length($main::read_buffer) > $_[0]) {
+		# Return the first part of the buffer
+		$rv = substr($main::read_buffer, 0, $_[0]);
+		$main::read_buffer = substr($main::read_buffer, $_[0]);
+		return $rv;
+		}
+	else {
+		# Return the whole buffer
+		$rv = $main::read_buffer;
+		undef($main::read_buffer);
+		return $rv;
+		}
+	}
+elsif ($use_ssl) {
+	# Call SSL read function
+	return Net::SSLeay::read($ssl_con, $_[0]);
+	}
+else {
+	# Just do a normal read
+	local $buf;
+	sysread(SOCK, $buf, $_[0]) || return undef;
+	return $buf;
+	}
+}
+
+# wait_for_data(secs)
+# Waits at most the given amount of time for some data on SOCK, returning
+# 0 if not found, 1 if some arrived.
+sub wait_for_data
+{
+local $rmask;
+vec($rmask, fileno(SOCK), 1) = 1;
+local $got = select($rmask, undef, undef, $_[0]);
+return $got == 0 ? 0 : 1;
+}
+
+# wait_for_data_error()
+# Waits 60 seconds for data on SOCK, and fails if none arrives
+sub wait_for_data_error
+{
+local $got = &wait_for_data(60);
+if (!$got) {
+	&http_error(400, "Timeout",
+		    "Waited more than 60 seconds for request data");
+	}
+}
+
+# write_data(data, ...)
+# Writes a string to SOCK or the SSL connection
+sub write_data
+{
+local $str = join("", @_);
+if ($use_ssl) {
+	Net::SSLeay::write($ssl_con, $str);
+	}
+else {
+	eval { syswrite(SOCK, $str, length($str)); };
+	if ($@ =~ /wide\s+character/i) {
+		eval { utf8::encode($str);
+		       syswrite(SOCK, $str, length($str)); };
+		}
+	if ($@) {
+		# Somehow a string come through that contains invalid chars
+		&log_error($@);
+		for(my $i=0; my @stack = caller($i); $i++) {
+			&log_error(join(" ", @stack));
+			}
+		}
+	}
+$write_data_count += length($str);
+}
+
+# reset_byte_count()
+sub reset_byte_count { $write_data_count = 0; }
+
+# byte_count()
+sub byte_count { return $write_data_count; }
+
+# get_logged_sensitive_params()
+# Returns query parameter names whose values should be redacted in access logs
+sub get_logged_sensitive_params
+{
+my @rv = qw(access_token api_key auth key pass passwd password refresh_token secret token);
+my %seen = map { lc($_) => 1 } @rv;
+if ($config{'log_redact_params'}) {
+	foreach my $param (split(/\s+|,\s*/, $config{'log_redact_params'})) {
+		next if (!$param);
+		my $lparam = lc($param);
+		next if ($seen{$lparam}++);
+		push(@rv, $param);
+		}
+	}
+return @rv;
+}
+
+# sanitise_logged_request(request)
+# Redacts sensitive query parameter values from a request line before logging
+sub sanitise_logged_request
+{
+my ($request) = @_;
+return $request if (!defined($request));
+my $sanitised = $request;
+my @sensitive = &get_logged_sensitive_params();
+return $request if (!@sensitive);
+my $sensitive = qr/(?:@{[join("|", map { quotemeta($_) } @sensitive)]})/i;
+
+if ($sanitised =~ /^(\S+\s+)(\S+)(\s+HTTP\/\d+\.\d+)$/) {
+	my ($prefix, $uri, $suffix) = ($1, $2, $3);
+	$uri =~ s/([?&;])((?:$sensitive))=([^&;\s]*)/$1.$2."=***"/ige;
+	$sanitised = $prefix.$uri.$suffix;
+	}
+
+return $sanitised;
+}
+
+# log_request(hostname, user, request, code, bytes)
+# Write an HTTP request to the log file
+sub log_request
+{
+local ($host, $user, $request, $code, $bytes) = @_;
+local $headers;
+my $request_nolog = $request;
+my $request_log = &sanitise_logged_request($request);
+
+# Process full request string like `POST /index.cgi?param=1 HTTP/1.1` as well
+if ($request =~ /^(POST|GET)\s+/) {
+	$request_nolog =~ s/(.*?)(\/.*?)\s+(.*)/$2/g;
+	}
+if ($config{'nolog'}) {
+	foreach my $nolog (split(/\s+/, $config{'nolog'})) {
+		return if ($request_nolog =~ /^$nolog$/);
+		}
+	}
+if ($config{'log'}) {
+	local $ident = "-";
+	$user ||= "-";
+	local $dstr = &make_datestr();
+	if (fileno(MINISERVLOG)) {
+		seek(MINISERVLOG, 0, 2);
+		}
+	else {
+		open(MINISERVLOG, ">>$config{'logfile'}");
+		chmod(0600, $config{'logfile'});
+		}
+	if (defined($config{'logheaders'})) {
+		foreach $h (split(/\s+/, $config{'logheaders'})) {
+			$headers .= " $h=\"$header{$h}\"";
+			}
+		}
+	elsif ($config{'logclf'}) {
+		$headers = " \"$header{'referer'}\" \"$header{'user-agent'}\"";
+		}
+	else {
+		$headers = "";
+		}
+	print MINISERVLOG "$host $ident $user [$dstr] \"$request_log\" ",
+			  "$code $bytes$headers\n";
+	close(MINISERVLOG);
+	}
+}
+
+# make_datestr()
+sub make_datestr
+{
+local @tm = localtime(time());
+return sprintf "%2.2d/%s/%4.4d:%2.2d:%2.2d:%2.2d %s",
+		$tm[3], $month[$tm[4]], $tm[5]+1900,
+	        $tm[2], $tm[1], $tm[0], $timezone;
+}
+
+# log_error(message)
+sub log_error
+{
+seek(STDERR, 0, 2);
+print STDERR "[",&make_datestr(),"] ",
+	$acpthost ? ( "[",$acpthost,"] " ) : ( ),
+	$page ? ( $page," : " ) : ( ),
+	@_,"\n";
+}
+
+# read_errors(handle)
+# Read and return all input from some filehandle
+sub read_errors
+{
+local($fh, $_, $rv);
+$fh = $_[0];
+while(<$fh>) { $rv .= $_; }
+return $rv;
+}
+
+sub write_keep_alive
+{
+local $mode;
+if ($config{'nokeepalive'}) {
+	# Keep alives have been disabled in config
+	$mode = 0;
+	}
+elsif (@childpids > $config{'maxconns'}*.8) {
+	# Disable because nearing process limit
+	$mode = 0;
+	}
+elsif (@_) {
+	# Keep alive specified by caller
+	$mode = $_[0];
+	}
+else {
+	# Keep alive determined by browser
+	$mode = $header{'connection'} =~ /keep-alive/i;
+	}
+&write_data("Connection: ".($mode ? "Keep-Alive" : "close")."\r\n");
+return $mode;
+}
+
+sub term_handler
+{
+&log_error("Shutting down");
+kill('TERM', @childpids) if (@childpids);
+kill('KILL', $logclearer) if ($logclearer);
+kill('KILL', $extauth) if ($extauth);
+unlink($config{'pidfile'});
+exit(1);
+}
+
+sub http_date
+{
+local @tm = gmtime($_[0]);
+return sprintf "%s, %d %s %d %2.2d:%2.2d:%2.2d GMT",
+		$weekday[$tm[6]], $tm[3], $month[$tm[4]], $tm[5]+1900,
+		$tm[2], $tm[1], $tm[0];
+}
+
+sub TIEHANDLE
+{
+my $i; bless \$i, shift;
+}
+
+sub WRITE
+{
+$r = shift;
+my($buf,$len,$offset) = @_;
+&write_to_sock(substr($buf, $offset, $len));
+$miniserv::page_capture_out .= substr($buf, $offset, $len)
+	if ($miniserv::page_capture);
+}
+
+sub PRINT
+{
+$r = shift;
+$$r++;
+my $buf = join(defined($,) ? $, : "", @_);
+$buf .= $\ if defined($\);
+&write_to_sock($buf);
+$miniserv::page_capture_out .= $buf
+	if ($miniserv::page_capture);
+}
+
+sub PRINTF
+{
+shift;
+my $fmt = shift;
+my $buf = sprintf $fmt, @_;
+&write_to_sock($buf);
+$miniserv::page_capture_out .= $buf
+	if ($miniserv::page_capture);
+}
+
+# Send back already read data while we have it, then read from SOCK
+sub READ
+{
+my $r = shift;
+my $bufref = \$_[0];
+my $len = $_[1];
+my $offset = $_[2];
+if ($postpos < length($postinput)) {
+	# Reading from already fetched array
+	my $left = length($postinput) - $postpos;
+	my $canread = $len > $left ? $left : $len;
+	substr($$bufref, $offset, $canread) =
+		substr($postinput, $postpos, $canread);
+	$postpos += $canread;
+	return $canread;
+	}
+else {
+	# Read from network socket
+	local $data = &read_data($len);
+	if ($data eq '' && $len) {
+		# End of socket
+		shutdown(SOCK, 0);
+		}
+	substr($$bufref, $offset, length($data)) = $data;
+	return length($data);
+	}
+}
+
+sub OPEN
+{
+#print STDERR "open() called - should never happen!\n";
+}
+
+# Read a line of input
+sub READLINE
+{
+my $r = shift;
+if ($postpos < length($postinput) &&
+    ($idx = index($postinput, "\n", $postpos)) >= 0) {
+	# A line exists in the memory buffer .. use it
+	my $line = substr($postinput, $postpos, $idx-$postpos+1);
+	$postpos = $idx+1;
+	return $line;
+	}
+else {
+	# Need to read from the socket
+	my $line;
+	if ($postpos < length($postinput)) {
+		# Start with in-memory data
+		$line = substr($postinput, $postpos);
+		$postpos = length($postinput);
+		}
+	my $nl = &read_line(0, 1);
+	if ($nl eq '') {
+		# End of socket
+		shutdown(SOCK, 0);
+		}
+	$line .= $nl if (defined($nl));
+	return $line;
+	}
+}
+
+# Read one character of input
+sub GETC
+{
+my $r = shift;
+my $buf;
+my $got = READ($r, \$buf, 1, 0);
+return $got > 0 ? $buf : undef;
+}
+
+sub FILENO
+{
+return fileno(SOCK);
+}
+
+sub CLOSE { }
+
+sub DESTROY { }
+
+# write_to_sock(data, ...)
+sub write_to_sock
+{
+local $d;
+foreach $d (@_) {
+	if ($doneheaders || $miniserv::nph_script) {
+		&write_data($d);
+		}
+	else {
+		$headers .= $d;
+		while(!$doneheaders && $headers =~ s/^([^\r\n]*)(\r)?\n//) {
+			if ($1 =~ /^(\S+):\s+(.*)$/) {
+				$cgiheader{lc($1)} = $2;
+				push(@cgiheader, [ $1, $2 ]);
+				}
+			elsif ($1 !~ /\S/) {
+				$doneheaders++;
+				}
+			else {
+				&http_error(500, "Bad Header");
+				}
+			}
+		if ($doneheaders) {
+			if ($cgiheader{"location"}) {
+				&write_data(
+					"HTTP/1.0 302 Moved Temporarily\r\n");
+				&write_data("Date: $datestr\r\n");
+				&write_data("Server: @{[&server_info()]}\r\n");
+				&write_keep_alive(0);
+				}
+			elsif ($cgiheader{"content-type"} eq "") {
+				&http_error(500, "Missing Content-Type Header");
+				}
+			else {
+				&write_data("HTTP/1.0 $ok_code $ok_message\r\n");
+				&write_data("Date: $datestr\r\n");
+				&write_data("Server: @{[&server_info()]}\r\n");
+				&write_keep_alive(0);
+				}
+			foreach $h (@cgiheader) {
+				&write_data("$h->[0]: $h->[1]\r\n");
+				}
+			&write_data("\r\n");
+			&reset_byte_count();
+			&write_data($headers);
+			}
+		}
+	}
+}
+
+sub verify_client
+{
+local $cert = Net::SSLeay::X509_STORE_CTX_get_current_cert($_[1]);
+if ($cert) {
+	local $errnum = Net::SSLeay::X509_STORE_CTX_get_error($_[1]);
+	$verified_client = 1 if (!$errnum);
+	}
+return 1;
+}
+
+sub END
+{
+if ($doing_cgi_eval && $$ == $main_process_id) {
+	# A CGI program called exit! This is a horrible hack to
+	# finish up before really exiting
+	shutdown(SOCK, 1);
+	close(SOCK);
+	close($PASSINw); close($PASSOUTw);
+	&log_request($loghost, $authuser, $reqline,
+		     $cgiheader{"location"} ? "302" : $ok_code, &byte_count());
+	}
+}
+
+# urlize
+# Convert a string to a form ok for putting in a URL
+sub urlize {
+  local($tmp, $tmp2, $c);
+  $tmp = $_[0];
+  $tmp2 = "";
+  while(($c = chop($tmp)) ne "") {
+	if ($c !~ /[A-z0-9]/) {
+		$c = sprintf("%%%2.2X", ord($c));
+		}
+	$tmp2 = $c . $tmp2;
+	}
+  return $tmp2;
+}
+
+# validate_user_caseless(username, password, host, remote-ip, webmin-port)
+# Calls validate_user, but also checks the lower case name if the given login
+# is mixed case
+sub validate_user_caseless
+{
+my @args = @_;
+my @rv = &validate_user(@args);
+if (!$rv[0] && $args[0] ne lc($args[0])) {
+	$args[0] = lc($args[0]);
+	@rv = &validate_user(@args);
+	}
+return @rv;
+}
+
+# validate_user(username, password, host, remote-ip, webmin-port)
+# Checks if some username and password are valid. Returns the modified username,
+# the expired / temp pass flag, the non-existence flag, and the underlying
+# Webmin username.
+sub validate_user
+{
+local ($user, $pass, $host, $actpip, $port) = @_;
+return ( ) if (!$user);
+print DEBUG "validate_user: user=$user pass=$pass host=$host\n";
+local ($canuser, $canmode, $notexist, $webminuser, $sudo) =
+	&can_user_login($user, undef, $host);
+print DEBUG "validate_user: canuser=$canuser canmode=$canmode notexist=$notexist webminuser=$webminuser sudo=$sudo\n";
+if ($notexist) {
+	# User doesn't even exist, so go no further
+	return ( undef, 0, 1, $webminuser );
+	}
+elsif ($canmode == 0) {
+	# User does exist but cannot login
+	return ( $canuser, 0, 0, $webminuser );
+	}
+elsif ($canmode == 1) {
+	# Attempt Webmin authentication
+	my $uinfo = &get_user_details($webminuser, $canuser);
+	if ($uinfo &&
+	    &password_crypt($pass, $uinfo->{'pass'}) eq $uinfo->{'pass'}) {
+		# Password is valid .. but check for expiry
+		local $lc = $uinfo->{'lastchanges'};
+		print DEBUG "validate_user: Password is valid lc=$lc pass_maxdays=$config{'pass_maxdays'}\n";
+		if ($config{'pass_maxdays'} && $lc && !$uinfo->{'nochange'}) {
+			local $daysold = (time() - $lc)/(24*60*60);
+			print DEBUG "maxdays=$config{'pass_maxdays'} daysold=$daysold temppass=$uinfo->{'temppass'}\n";
+			if ($config{'pass_lockdays'} &&
+			    $daysold > $config{'pass_lockdays'}) {
+				# So old that the account is locked
+				return ( undef, 0, 0, $webminuser );
+				}
+			elsif ($daysold > $config{'pass_maxdays'}) {
+				# Password has expired
+				return ( $user, 1, 0, $webminuser );
+				}
+			}
+		if ($uinfo->{'temppass'}) {
+			# Temporary password - force change now
+			return ( $user, 2, 0, $webminuser );
+			}
+		return ( $user, 0, 0, $webminuser );
+		}
+	elsif (!$uinfo) {
+		print DEBUG "validate_user: User $webminuser not found\n";
+		return ( undef, 0, 0, $webminuser );
+		}
+	else {
+		print DEBUG "validate_user: User $webminuser password mismatch $pass != $uinfo->{'pass'}\n";
+		return ( undef, 0, 0, $webminuser );
+		}
+	}
+elsif ($canmode == 2 || $canmode == 3) {
+	# Attempt PAM or passwd file authentication
+	local $val = &validate_unix_user($canuser, $pass, $acptip, $port);
+	print DEBUG "validate_user: unix val=$val\n";
+	if ($val && $sudo) {
+		# Need to check if this Unix user can sudo
+		if (!&check_sudo_permissions($canuser, $pass)) {
+			print DEBUG "validate_user: sudo failed\n";
+			$val = 0;
+			}
+		else {
+			print DEBUG "validate_user: sudo passed\n";
+			}
+		}
+	return $val == 2 ? ( $canuser, 1, 0, $webminuser ) :
+	       $val == 1 ? ( $canuser, 0, 0, $webminuser ) :
+			   ( undef, 0, 0, $webminuser );
+	}
+elsif ($canmode == 4) {
+	# Attempt external authentication
+	return &validate_external_user($canuser, $pass) ?
+		( $canuser, 0, 0, $webminuser ) :
+		( undef, 0, 0, $webminuser );
+	}
+else {
+	# Can't happen!
+	return ( );
+	}
+}
+
+# validate_unix_user(user, password, remote-ip, local-port)
+# Returns 1 if a username and password are valid under unix, 0 if not,
+# or 2 if the account has expired.
+# Checks PAM if available, and falls back to reading the system password
+# file otherwise.
+sub validate_unix_user
+{
+if ($use_pam) {
+	# Check with PAM
+	$pam_username = $_[0];
+	$pam_password = $_[1];
+	eval "use Authen::PAM;";
+	local $pamh = new Authen::PAM($config{'pam'}, $pam_username,
+				      \&pam_conv_func);
+	if (ref($pamh)) {
+		print DEBUG "validate_unix_user: using PAM\n";
+		$pamh->pam_set_item(PAM_RHOST(), $_[2]) if ($_[2]);
+		$pamh->pam_set_item(PAM_TTY(), $_[3]) if ($_[3]);
+		local $rcode = 0;
+		local $pam_ret = $pamh->pam_authenticate();
+		print DEBUG "validate_unix_user: pam_ret=$pam_ret\n";
+		if ($pam_ret == PAM_SUCCESS()) {
+			# Logged in OK .. make sure password hasn't expired
+			local $acct_ret = $pamh->pam_acct_mgmt();
+			print DEBUG "validate_unix_user: acct_ret=$acct_ret\n";
+			$pam_ret = $acct_ret;
+			if ($acct_ret == PAM_SUCCESS()) {
+				$pamh->pam_open_session();
+				$rcode = 1;
+				}
+			elsif ($acct_ret == PAM_NEW_AUTHTOK_REQD() ||
+			       $acct_ret == PAM_ACCT_EXPIRED()) {
+				$rcode = 2;
+				}
+			else {
+				&log_error("Unknown pam_acct_mgmt return value : $acct_ret");
+				$rcode = 0;
+				}
+			}
+		if ($config{'pam_end'}) {
+			$pamh->pam_end($pam_ret);
+			}
+		return $rcode;
+		}
+	}
+elsif ($config{'pam_only'}) {
+	# Pam is not available, but configuration forces it's use!
+	return 0;
+	}
+elsif ($config{'passwd_file'}) {
+	# Check in a password file
+	local $rv = 0;
+	print DEBUG "validate_unix_user: reading $config{'passwd_file'}\n";
+	open(FILE, $config{'passwd_file'});
+	if ($config{'passwd_file'} eq '/etc/security/passwd') {
+		# Assume in AIX format
+		while(<FILE>) {
+			s/\s*$//;
+			if (/^\s*(\S+):/ && $1 eq $_[0]) {
+				$_ = <FILE>;
+				if (/^\s*password\s*=\s*(\S+)\s*$/) {
+					$rv = $1 eq &password_crypt($_[1], $1) ?
+						1 : 0;
+					}
+				last;
+				}
+			}
+		}
+	else {
+		# Read the system password or shadow file
+		while(<FILE>) {
+			local @l = split(/:/, $_, -1);
+			local $u = $l[$config{'passwd_uindex'}];
+			local $p = $l[$config{'passwd_pindex'}];
+			if ($u eq $_[0]) {
+				$rv = $p eq &password_crypt($_[1], $p) ? 1 : 0;
+				if ($config{'passwd_cindex'} ne '' && $rv) {
+					# Password may have expired!
+					local $c = $l[$config{'passwd_cindex'}];
+					local $m = $l[$config{'passwd_mindex'}];
+					local $day = time()/(24*60*60);
+					print DEBUG "validate_unix_user: c=$c m=$m day=$day\n";
+					if ($c =~ /^\d+/ && $m =~ /^\d+/ && $day - $c > $m) {
+						# Yep, it has ..
+						$rv = 2;
+						}
+					}
+				if ($p eq "" && $config{'passwd_blank'}) {
+					# Force password change
+					$rv = 2;
+					}
+				last;
+				}
+			}
+		}
+	close(FILE);
+	return $rv if ($rv);
+	}
+
+# Fallback option - check password returned by getpw*
+local @uinfo = getpwnam($_[0]);
+if ($uinfo[1] ne '' && &password_crypt($_[1], $uinfo[1]) eq $uinfo[1]) {
+	return 1;
+	}
+
+return 0;	# Totally failed
+}
+
+# validate_external_user(user, pass)
+# Validate a user by passing the username and password to an external
+# squid-style authentication program
+sub validate_external_user
+{
+return 0 if (!$config{'extauth'});
+flock(EXTAUTH, 2);
+local $str = "$_[0] $_[1]\n";
+syswrite(EXTAUTH, $str, length($str));
+local $resp = <EXTAUTH>;
+flock(EXTAUTH, 8);
+return $resp =~ /^OK/i ? 1 : 0;
+}
+
+# can_user_login(username, no-append, host)
+# Checks if a user can login or not.
+# First return value is the username.
+# Second is 0 if cannot login, 1 if using Webmin pass, 2 if PAM, 3 if password
+# file, 4 if external.
+# Third is 1 if the user does not exist at all, 0 if he does.
+# Fourth is the Webmin username whose permissions apply, based on unixauth.
+# Fifth is a flag indicating if a sudo check is needed.
+sub can_user_login
+{
+local $uinfo = &get_user_details($_[0]);
+if (!$uinfo) {
+	# See if this user exists in Unix and can be validated by the same
+	# method as the unixauth webmin user
+	local $realuser = $unixauth{$_[0]};
+	local @uinfo;
+	local $sudo = 0;
+	local $pamany = 0;
+	eval { @uinfo = getpwnam($_[0]); };	# may fail on windows
+	if (!$realuser && @uinfo) {
+		# No unixauth entry for the username .. try his groups
+		foreach my $ua (keys %unixauth) {
+			if ($ua =~ /^\@(.*)$/) {
+				if (&is_group_member(\@uinfo, $1)) {
+					$realuser = $unixauth{$ua};
+					last;
+					}
+				}
+			}
+		}
+	if (!$realuser && @uinfo) {
+		# Fall back to unix auth for all Unix users
+		$realuser = $unixauth{"*"};
+		}
+	if (!$realuser && $use_sudo && @uinfo) {
+		# Allow login effectively as root, if sudo permits it
+		$sudo = 1;
+		$realuser = "root";
+		}
+	if (!$realuser && !@uinfo && $config{'pamany'}) {
+		# If the user completely doesn't exist, we can still allow
+		# him to authenticate via PAM
+		$realuser = $config{'pamany'};
+		$pamany = 1;
+		}
+	if (!$realuser) {
+		# For Usermin, always fall back to unix auth for any user,
+		# so that later checks with domain added / removed are done.
+		$realuser = $unixauth{"*"};
+		}
+	return (undef, 0, 1, undef) if (!$realuser);
+	local $uinfo = &get_user_details($realuser);
+	return (undef, 0, 1, undef) if (!$uinfo);
+	local $up = $uinfo->{'pass'};
+
+	# Work out possible domain names from the hostname
+	local @doms = ( $_[2] );
+	if ($_[2] =~ /^([^\.]+)\.(\S+)$/) {
+		push(@doms, $2);
+		}
+
+	if ($config{'user_mapping'} && !%user_mapping) {
+		# Read the user mapping file
+		%user_mapping = ();
+		open(MAPPING, $config{'user_mapping'});
+		while(<MAPPING>) {
+			s/\r|\n//g;
+			s/#.*$//;
+			if (/^(\S+)\s+(\S+)/) {
+				my ($from, $to) = ($1, $2);
+				$from =~ s/\\(.)/$1/g;
+				$to =~ s/\\(.)/$1/g;
+				if ($config{'user_mapping_reverse'}) {
+					$user_mapping{$from} = $to;
+					}
+				else {
+					$user_mapping{$to} = $from;
+					}
+				}
+			}
+		close(MAPPING);
+		}
+
+	# Check the user mapping file to see if there is an entry for the
+	# user login in which specifies a new effective user
+	local $um;
+	foreach my $d (@doms) {
+		$um ||= $user_mapping{"$_[0]\@$d"};
+		}
+	$um ||= $user_mapping{$_[0]};
+	if (defined($um) && ($_[1]&4) == 0) {
+		# A mapping exists - use it!
+		return &can_user_login($um, $_[1]+4, $_[2]);
+		}
+
+	# Check if a user with the entered login and the domains appended
+	# or prepended exists, and if so take it to be the effective user
+	if (!@uinfo && $config{'domainuser'}) {
+		# Try again with name.domain and name.firstpart
+		local @firsts = map { /^([^\.]+)/; $1 } @doms;
+		if (($_[1]&1) == 0) {
+			local ($a, $p);
+			foreach $a (@firsts, @doms) {
+				foreach $p ("$_[0].${a}", "$_[0]-${a}",
+					    "${a}.$_[0]", "${a}-$_[0]",
+					    "$_[0]_${a}", "${a}_$_[0]") {
+					local @vu = &can_user_login(
+							$p, $_[1]+1, $_[2]);
+					return @vu if ($vu[1]);
+					}
+				}
+			}
+		}
+
+	# Check if the user entered a domain at the end of his username when
+	# he really shouldn't have, and if so try without it
+	if (!@uinfo && $config{'domainstrip'} &&
+	    $_[0] =~ /^(\S+)\@(\S+)$/ && ($_[1]&2) == 0) {
+		local ($stripped, $dom) = ($1, $2);
+		local @vu = &can_user_login($stripped, $_[1] + 2, $_[2]);
+		return @vu if ($vu[1]);
+		local @vu = &can_user_login($stripped, $_[1] + 2, $dom);
+		return @vu if ($vu[1]);
+		}
+
+	return ( undef, 0, 1, undef ) if (!@uinfo && !$pamany);
+
+	if (@uinfo) {
+		if (scalar(@allowusers)) {
+			# Only allow people on the allow list
+			return ( undef, 0, 0, undef )
+				if (!&users_match(\@uinfo, @allowusers));
+			}
+		elsif (scalar(@denyusers)) {
+			# Disallow people on the deny list
+			return ( undef, 0, 0, undef )
+				if (&users_match(\@uinfo, @denyusers));
+			}
+		if ($config{'shells_deny'}) {
+			local $found = 0;
+			open(SHELLS, $config{'shells_deny'});
+			while(<SHELLS>) {
+				s/\r|\n//g;
+				s/#.*$//;
+				$found++ if ($_ eq $uinfo[8]);
+				}
+			close(SHELLS);
+			return ( undef, 0, 0, undef ) if (!$found);
+			}
+		}
+
+	if ($up eq 'x') {
+		# PAM or passwd file authentication
+		print DEBUG "can_user_login: Validate with PAM\n";
+		return ( $_[0], $use_pam ? 2 : 3, 0, $realuser, $sudo );
+		}
+	elsif ($up eq 'e') {
+		# External authentication
+		print DEBUG "can_user_login: Validate externally\n";
+		return ( $_[0], 4, 0, $realuser, $sudo );
+		}
+	else {
+		# Fixed Webmin password
+		print DEBUG "can_user_login: Validate by Webmin\n";
+		return ( $_[0], 1, 0, $realuser, $sudo );
+		}
+	}
+elsif ($uinfo->{'pass'} eq 'x') {
+	# Webmin user authenticated via PAM or password file
+	return ( $_[0], $use_pam ? 2 : 3, 0, $_[0] );
+	}
+elsif ($uinfo->{'pass'} eq 'e') {
+	# Webmin user authenticated externally
+	return ( $_[0], 4, 0, $_[0] );
+	}
+else {
+	# Normal Webmin user
+	return ( $_[0], 1, 0, $_[0] );
+	}
+}
+
+# the PAM conversation function for interactive logins
+sub pam_conv_func
+{
+$pam_conv_func_called++;
+my @res;
+while ( @_ ) {
+	my $code = shift;
+	my $msg = shift;
+	my $ans = "";
+
+	$ans = $pam_username if ($code == PAM_PROMPT_ECHO_ON() );
+	$ans = $pam_password if ($code == PAM_PROMPT_ECHO_OFF() );
+
+	push @res, PAM_SUCCESS();
+	push @res, $ans;
+	}
+push @res, PAM_SUCCESS();
+return @res;
+}
+
+sub urandom_timeout
+{
+close(RANDOM);
+}
+
+# get_socket_ip(handle, ipv6-flag)
+# Returns the local IP address of some connection, as both a string and in
+# binary format
+sub get_socket_ip
+{
+local ($fh, $ipv6) = @_;
+local $sn = getsockname($fh);
+return undef if (!$sn);
+return &get_address_ip($sn, $ipv6);
+}
+
+# get_address_ip(address, ipv6-flag)
+# Given a sockaddr object in binary format, return the binary address, text
+# address and port number
+sub get_address_ip
+{
+local ($sn, $ipv6) = @_;
+if ($ipv6) {
+	local ($p, $b) = unpack_sockaddr_in6($sn);
+	return ($b, inet_ntop(AF_INET6(), $b), $p);
+	}
+else {
+	local ($p, $b) = unpack_sockaddr_in($sn);
+	return ($b, inet_ntoa($b), $p);
+	}
+}
+
+# get_socket_name(handle, ipv6-flag)
+# Returns the local hostname or IP address of some connection
+sub get_socket_name
+{
+local ($fh, $ipv6) = @_;
+return $config{'host'} if ($config{'host'});
+local ($mybin, $myaddr) = &get_socket_ip($fh, $ipv6);
+if (!$get_socket_name_cache{$myaddr}) {
+	local $myname;
+	if (!$config{'no_resolv_myname'}) {
+		$myname = gethostbyaddr($mybin,
+					$ipv6 ? AF_INET6() : AF_INET);
+		}
+	$myname ||= $myaddr;
+	$get_socket_name_cache{$myaddr} = $myname;
+	}
+return $get_socket_name_cache{$myaddr};
+}
+
+# run_login_script(username, sid, remoteip, localip)
+sub run_login_script
+{
+if ($config{'login_script'}) {
+	alarm(5);
+	$SIG{'ALRM'} = sub { die "timeout" };
+	eval {
+		system($config{'login_script'}.
+		       " ".join(" ", map { quotemeta($_) || '""' } @_).
+		       " >/dev/null 2>&1 </dev/null");
+		};
+	alarm(0);
+	}
+}
+
+# run_logout_script(username, sid, remoteip, localip)
+sub run_logout_script
+{
+if ($config{'logout_script'}) {
+	alarm(5);
+	$SIG{'ALRM'} = sub { die "timeout" };
+	eval {
+		system($config{'logout_script'}.
+		       " ".join(" ", map { quotemeta($_) || '""' } @_).
+		       " >/dev/null 2>&1 </dev/null");
+		};
+	alarm(0);
+	}
+}
+
+# run_failed_script(username, reason-code, remoteip, localip)
+sub run_failed_script
+{
+if ($config{'failed_script'}) {
+	$_[0] =~ s/\r|\n/ /g;
+	alarm(5);
+	$SIG{'ALRM'} = sub { die "timeout" };
+	eval {
+		system($config{'failed_script'}.
+		       " ".join(" ", map { quotemeta($_) || '""' } @_).
+		       " >/dev/null 2>&1 </dev/null");
+		};
+	alarm(0);
+	}
+}
+
+# close_all_sockets()
+# Closes all the main listening sockets
+sub close_all_sockets
+{
+local $s;
+foreach $s (@socketfhs) {
+	close($s);
+	}
+}
+
+# close_all_pipes()
+# Close all pipes for talking to sub-processes
+sub close_all_pipes
+{
+local $p;
+foreach $p (@passin) { close($p); }
+foreach $p (@passout) { close($p); }
+foreach $p (values %conversations) {
+	if ($p->{'PAMOUTr'}) {
+		close($p->{'PAMOUTr'});
+		close($p->{'PAMINw'});
+		}
+	}
+}
+
+# check_user_ip(user)
+# Returns 1 if some user is allowed to login from the accepting IP, 0 if not
+sub check_user_ip
+{
+local ($username) = @_;
+local $uinfo = &get_user_details($username);
+return 1 if (!$uinfo);
+if ($uinfo->{'deny'} &&
+    &ip_match($acptip, $localip, @{$uinfo->{'deny'}}) ||
+    $uinfo->{'allow'} &&
+    !&ip_match($acptip, $localip, @{$uinfo->{'allow'}})) {
+	return 0;
+	}
+return 1;
+}
+
+# check_user_time(user)
+# Returns 1 if some user is allowed to login at the current date and time
+sub check_user_time
+{
+local ($username) = @_;
+local $uinfo = &get_user_details($username);
+return 1 if (!$uinfo || !$uinfo->{'allowdays'} && !$uinfo->{'allowhours'});
+local @tm = localtime(time());
+if ($uinfo->{'allowdays'}) {
+	# Make sure day is allowed
+	return 0 if (&indexof($tm[6], @{$uinfo->{'allowdays'}}) < 0);
+	}
+if ($uinfo->{'allowhours'}) {
+	# Make sure time is allowed
+	local $m = $tm[2]*60+$tm[1];
+	return 0 if ($m < $uinfo->{'allowhours'}->[0] ||
+		     $m > $uinfo->{'allowhours'}->[1]);
+	}
+return 1;
+}
+
+# generate_random_id(password, [force-urandom])
+# Returns a random session ID number
+sub generate_random_id
+{
+my ($force_urandom) = @_;
+local $sid;
+if (!$bad_urandom) {
+	# First try /dev/urandom, unless we have marked it as bad
+	$SIG{ALRM} = "miniserv::urandom_timeout";
+	alarm(5);
+	if (open(RANDOM, "/dev/urandom")) {
+		my $tmpsid;
+		if (read(RANDOM, $tmpsid, 16) == 16) {
+			$sid = lc(unpack('h*',$tmpsid));
+			if ($sid !~ /^[0-9a-fA-F]{32}$/) {
+				$sid = 'bad';
+				}
+			}
+		close(RANDOM);
+		}
+	alarm(0);
+	}
+if (!$sid && !$force_urandom) {
+	my $offset = int(rand(2048));
+	my @charset = ('0' ..'9', 'a' .. 'f');
+	$sid = join('', map { $charset[rand(@charset)] } 1 .. 4096);
+	$sid = substr($sid, $offset, 32);
+	}
+return $sid;
+}
+
+# handle_login(username, ok, expired, not-exists, password,
+#              [no-test-cookie], [no-log], [twofactor-probe])
+# Called from handle_session to either mark a user as logged in, or not
+sub handle_login
+{
+local ($vu, $ok, $expired, $nonexist, $pass, $notest, $nolog, $twof_probe) = @_;
+$authuser = $vu if ($ok);
+
+# check if the test cookie is set
+if ($header{'cookie'} !~ /testing=1/ && $vu &&
+    !$config{'no_testing_cookie'} && !$notest) {
+	&http_error(500, "Cache issue or no cookies support",
+	   "Please clear your browser's cache for the given ".
+	   "domain and/or try incognito tab; double check ".
+	   "to have cookies support enabled.");
+	}
+
+# check with main process for delay
+if ($config{'passdelay'} && $vu) {
+	print DEBUG "handle_login: requesting delay vu=$vu acptip=$acptip ok=$ok\n";
+	print $PASSINw "delay $vu $acptip $ok $nolog\n";
+	<$PASSOUTr> =~ /(\d+) (\d+)/;
+	$blocked = $2;
+	sleep($1);
+	print DEBUG "handle_login: delay=$1 blocked=$2\n";
+	}
+
+if ($ok && (!$expired ||
+	    $config{'passwd_mode'} == 1)) {
+	# Log in creds were OK but two-factor auth is still pending
+	if ($twof_probe) {
+		# Two-factor auth is required
+		$validated = $already_session_id = undef;
+		$authuser = $baseauthuser = undef;
+		$querystring = $method = $page = $request_uri = undef;
+		$logged_code = undef;
+		$queryargs = "";
+		# Write response
+		&http_error(401, "Two-factor authentication is required");
+		return undef;
+		}
+
+	# Logged in OK! Tell the main process about
+	# the new SID
+	local $sid = &generate_random_id();
+	print DEBUG "handle_login: sid=$sid\n";
+	print $PASSINw "new $sid $authuser $acptip\n";
+
+	# Run the post-login script, if any
+	&run_login_script($authuser, $sid,
+			  $loghost, $localip);
+
+	# Set cookie and redirect to originally requested page
+	&write_data("HTTP/1.0 302 Moved Temporarily\r\n");
+	&write_data("Date: $datestr\r\n");
+	&write_data("Server: @{[&server_info()]}\r\n");
+	local $sec = $ssl ? "; secure" : "";
+	if (!$config{'no_httponly'}) {
+		$sec .= "; httpOnly";
+		}
+	if (!$config{'no_samesite'}) {
+		$sec .= "; SameSite=Lax";
+		}
+	if ($in{'page'} !~ /^\/[A-Za-z0-9\/\.\-\_:]+$/) {
+		# Make redirect URL safe
+		$in{'page'} = "/";
+		}
+	local $cpath = $config{'cookiepath'};
+	if ($in{'save'}) {
+		&write_data("Set-Cookie: $sidname=$sid; path=$cpath; ".
+		    "expires=\"Thu, 31-Dec-2037 00:00:00\"$sec\r\n");
+		}
+	else {
+		&write_data("Set-Cookie: $sidname=$sid; path=$cpath".
+			    "$sec\r\n");
+		}
+	&write_data("Location: $prot://$hostport$in{'page'}\r\n");
+	&write_keep_alive(0);
+	&write_data("\r\n");
+	&log_request($loghost, $authuser, $reqline, 302, 0);
+	syslog("info", "%s", "Successful login as $authuser from $loghost") if ($use_syslog);
+	&write_login_utmp($authuser, $acpthost);
+	return 0;
+	}
+elsif ($ok && $expired &&
+       ($config{'passwd_mode'} == 2 || $expired == 2)) {
+	# Login was ok, but password has expired or was temporary. Need
+	# to force display of password change form.
+	&run_failed_script($authuser, 'expiredpass',
+			   $loghost, $localip);
+	$validated = 1;
+	$authuser = undef;
+	$querystring = "&user=".&urlize($vu).
+		       "&pam=".$use_pam.
+		       "&expired=".$expired;
+	$method = "GET";
+	$queryargs = "";
+	$page = $config{'password_form'};
+	$logged_code = 401;
+	$miniserv_internal = 2;
+	syslog("crit", "%s",
+		"Expired login as $vu ".
+		"from $loghost") if ($use_syslog);
+	}
+else {
+	# Login failed, or password has expired. The login form will be
+	# displayed again by later code
+	&run_failed_script($vu, $handle_login ? 'wronguser' :
+				$expired ? 'expiredpass' : 'wrongpass',
+			   $loghost, $localip);
+	$failed_user = $vu;
+	$failed_save = $in{'save'};
+	$request_uri = $in{'page'};
+	$already_session_id = undef;
+	$method = "GET";
+	$authuser = $baseauthuser = undef;
+
+	# If login page is simply reloaded, with `session_login.cgi` in URL,
+	# without having any parameters sent (user set to empty), don't log
+	# false positive attempt with `Invalid login as  from IP` to syslog
+	$nolog = 1 if (!$vu);
+
+	# Send to log if allowed
+	syslog("crit", "%s",
+		($nonexist ? "Non-existent" :
+		 $expired ? "Expired" : "Invalid").
+		" login as $vu from $loghost")
+		if ($use_syslog && !$nolog);
+	}
+return undef;
+}
+
+# write_login_utmp(user, host)
+# Record the login by some user in utmp
+sub write_login_utmp
+{
+if ($write_utmp) {
+	# Write utmp record for login
+	%utmp = ( 'ut_host' => $_[1],
+		  'ut_time' => time(),
+		  'ut_user' => $_[0],
+		  'ut_type' => 7,	# user process
+		  'ut_pid' => $miniserv_main_pid,
+		  'ut_line' => $config{'pam'},
+		  'ut_id' => '' );
+	if (defined(&User::Utmp::putut)) {
+		User::Utmp::putut(\%utmp);
+		}
+	else {
+		User::Utmp::pututline(\%utmp);
+		}
+	}
+}
+
+# write_logout_utmp(user, host)
+# Record the logout by some user in utmp
+sub write_logout_utmp
+{
+if ($write_utmp) {
+	# Write utmp record for logout
+	%utmp = ( 'ut_host' => $_[1],
+		  'ut_time' => time(),
+		  'ut_user' => $_[0],
+		  'ut_type' => 8,	# dead process
+		  'ut_pid' => $miniserv_main_pid,
+		  'ut_line' => $config{'pam'},
+		  'ut_id' => '' );
+	if (defined(&User::Utmp::putut)) {
+		User::Utmp::putut(\%utmp);
+		}
+	else {
+		User::Utmp::pututline(\%utmp);
+		}
+	}
+}
+
+# pam_conversation_process(username, write-pipe, read-pipe)
+# This function is called inside a sub-process to communicate with PAM. It sends
+# questions down one pipe, and reads responses from another
+sub pam_conversation_process
+{
+local ($user, $writer, $reader) = @_;
+$miniserv::pam_conversation_process_writer = $writer;
+$miniserv::pam_conversation_process_reader = $reader;
+eval "use Authen::PAM;";
+local $convh = new Authen::PAM(
+	$config{'pam'}, $user, \&miniserv::pam_conversation_process_func);
+local $pam_ret = $convh->pam_authenticate();
+if ($pam_ret == PAM_SUCCESS()) {
+	local $acct_ret = $convh->pam_acct_mgmt();
+	if ($acct_ret == PAM_SUCCESS()) {
+		$convh->pam_open_session();
+		print $writer "x2 $user 1 0 0\n";
+		}
+	elsif ($acct_ret == PAM_NEW_AUTHTOK_REQD() ||
+	       $acct_ret == PAM_ACCT_EXPIRED()) {
+		print $writer "x2 $user 1 1 0\n";
+		}
+	else {
+		print $writer "x0 Unknown PAM account status $acct_ret\n";
+		}
+	}
+else {
+	print $writer "x2 $user 0 0 0\n";
+	}
+exit(0);
+}
+
+# pam_conversation_process_func(type, message, [type, message, ...])
+# A pipe that talks to both PAM and the master process
+sub pam_conversation_process_func
+{
+local @rv;
+select($miniserv::pam_conversation_process_writer); $| = 1; select(STDOUT);
+while(@_) {
+	local ($type, $msg) = (shift, shift);
+	$msg =~ s/\r|\n//g;
+	local $ok = (print $miniserv::pam_conversation_process_writer "$type $msg\n");
+	print $miniserv::pam_conversation_process_writer "\n";
+	local $answer = <$miniserv::pam_conversation_process_reader>;
+	$answer =~ s/\r|\n//g;
+	push(@rv, PAM_SUCCESS(), $answer);
+	}
+push(@rv, PAM_SUCCESS());
+return @rv;
+}
+
+# allocate_pipes()
+# Returns 4 new pipe file handles
+sub allocate_pipes
+{
+local ($PASSINr, $PASSINw, $PASSOUTr, $PASSOUTw);
+local $p;
+local %taken = ( (map { $_, 1 } @passin),
+	         (map { $_->{'PASSINr'} } values %conversations) );
+for($p=0; $taken{"PASSINr$p"}; $p++) { }
+$PASSINr = "PASSINr$p";
+$PASSINw = "PASSINw$p";
+$PASSOUTr = "PASSOUTr$p";
+$PASSOUTw = "PASSOUTw$p";
+pipe($PASSINr, $PASSINw);
+pipe($PASSOUTr, $PASSOUTw);
+select($PASSINw); $| = 1;
+select($PASSINr); $| = 1;
+select($PASSOUTw); $| = 1;
+select($PASSOUTw); $| = 1;
+select(STDOUT);
+return ($PASSINr, $PASSINw, $PASSOUTr, $PASSOUTw);
+}
+
+# recv_pam_question(&conv, fd)
+# Reads one PAM question from the sub-process, and sends it to the HTTP handler.
+# Returns 0 if the conversation is over, 1 if not.
+sub recv_pam_question
+{
+local ($conf, $fh) = @_;
+local $pr = $conf->{'PAMOUTr'};
+select($pr); $| = 1; select(STDOUT);
+local $line = <$pr>;
+$line =~ s/\r|\n//g;
+if (!$line) {
+	$line = <$pr>;
+	$line =~ s/\r|\n//g;
+	}
+$conf->{'last'} = time();
+if (!$line) {
+	# Failed!
+	print $fh "0 PAM conversation error\n";
+	return 0;
+	}
+else {
+	local ($type, $msg) = split(/\s+/, $line, 2);
+	if ($type =~ /^x(\d+)/) {
+		# Pass this status code through
+		print $fh "$1 $msg\n";
+		return $1 == 2 || $1 == 0 ? 0 : 1;
+		}
+	elsif ($type == PAM_PROMPT_ECHO_ON()) {
+		# A normal question
+		print $fh "1 $msg\n";
+		return 1;
+		}
+	elsif ($type == PAM_PROMPT_ECHO_OFF()) {
+		# A password
+		print $fh "3 $msg\n";
+		return 1;
+		}
+	elsif ($type == PAM_ERROR_MSG() || $type == PAM_TEXT_INFO()) {
+		# A message that does not require a response
+		print $fh "4 $msg\n";
+		return 1;
+		}
+	else {
+		# Unknown type!
+		print $fh "0 Unknown PAM message type $type\n";
+		return 0;
+		}
+	}
+}
+
+# send_pam_answer(&conv, answer)
+# Sends a response from the user to the PAM sub-process
+sub send_pam_answer
+{
+local ($conf, $answer) = @_;
+local $pw = $conf->{'PAMINw'};
+$conf->{'last'} = time();
+print $pw "$answer\n";
+}
+
+# end_pam_conversation(&conv)
+# Clean up PAM conversation pipes and processes
+sub end_pam_conversation
+{
+local ($conv) = @_;
+kill('KILL', $conv->{'pid'}) if ($conv->{'pid'});
+if ($conv->{'PAMINr'}) {
+	close($conv->{'PAMINr'});
+	close($conv->{'PAMOUTr'});
+	close($conv->{'PAMINw'});
+	close($conv->{'PAMOUTw'});
+	}
+delete($conversations{$conv->{'cid'}});
+}
+
+# get_ipkeys(&miniserv)
+# Returns a list of IP address to key file mappings from a miniserv.conf entry
+sub get_ipkeys
+{
+local (@rv, $k);
+foreach $k (keys %{$_[0]}) {
+	if ($k =~ /^ipkey_(\S+)/) {
+		local $ipkey = { 'ips' => [ split(/,/, $1) ],
+				 'key' => $_[0]->{$k},
+				 'index' => scalar(@rv) };
+		$ipkey->{'cert'} = $_[0]->{'ipcert_'.$1};
+		$ipkey->{'extracas'} = $_[0]->{'ipextracas_'.$1};
+		push(@rv, $ipkey);
+		}
+	}
+return @rv;
+}
+
+# setup_ssl_contexts()
+# Setup all the per-IP and per-domain SSL contexts and the global context based
+# on the config
+sub setup_ssl_contexts
+{
+my @ipkeys = &get_ipkeys(\%config);
+if ($config{'ssl_version'}) {
+	# Force an SSL version
+	$Net::SSLeay::version = $config{'ssl_version'};
+	$Net::SSLeay::ssl_version = $config{'ssl_version'};
+	}
+my $ctx = &create_ssl_context($config{'keyfile'},
+			      $config{'certfile'},
+			      $config{'extracas'},
+			      $ssl_contexts{"*"});
+$ctx || return "Failed to create default SSL context";
+my @added = ( "*" );
+$ssl_contexts{"*"} = $ctx;
+foreach my $ipkey (@ipkeys) {
+	my $ctx = &create_ssl_context(
+		$ipkey->{'key'}, $ipkey->{'cert'},
+		$ipkey->{'extracas'} || $config{'extracas'},
+		$ssl_contexts{$ipkey->{'ips'}->[0]});
+	if ($ctx) {
+		foreach $ip (@{$ipkey->{'ips'}}) {
+			$ssl_contexts{$ip} = $ctx;
+			push(@added, $ip);
+			}
+		}
+	}
+foreach my $ip (keys %ssl_contexts) {
+	if (&indexof($ip, @added) < 0) {
+		delete($ssl_contexts{$ip});
+		}
+	}
+
+# Setup per-hostname SSL contexts on all IPs, not just the default
+# Ref: https://github.com/virtualmin/virtualmin-gpl/pull/1229
+if (defined(&Net::SSLeay::CTX_set_tlsext_servername_callback)) {
+	foreach my $ctx_key (keys %ssl_contexts) {
+		Net::SSLeay::CTX_set_tlsext_servername_callback(
+		    $ssl_contexts{$ctx_key}->{'ctx'},
+		    sub {
+			my $ssl = shift;
+			my $h = Net::SSLeay::get_servername($ssl);
+			my $c = $ssl_contexts{$h} ||
+				$h =~ /^[^\.]+\.(.*)$/ && $ssl_contexts{"*.$1"};
+			if ($c) {
+				Net::SSLeay::set_SSL_CTX($ssl, $c->{'ctx'});
+				}
+			});
+		}
+	}
+return undef;
+}
+
+# create_ssl_context(keyfile, [certfile], [extracas], [&existing-context])
+# Create and return one SSL context based on a key file and optional cert file
+# and CA cert
+sub create_ssl_context
+{
+local ($keyfile, $certfile, $extracas, $already) = @_;
+local @kst = stat($keyfile);
+local @cst = stat($certfile);
+if ($already && $already->{'keyfile'} eq $keyfile &&
+		$already->{'keytime'} == $kst[9] &&
+		$already->{'certfile'} eq $certfile &&
+		$already->{'certtime'} == $cst[9] &&
+		$already->{'extracas'} eq $extracas) {
+	# Context we already have is valid
+	return $already;
+	}
+local $ssl_ctx;
+eval { $ssl_ctx = Net::SSLeay::new_x_ctx() };
+$ssl_ctx ||= Net::SSLeay::CTX_new();
+if (!$ssl_ctx) {
+	&log_error("Failed to create SSL context : $!");
+	return undef;
+	}
+my @extracas = $extracas && $extracas ne "none" ? split(/\s+/, $extracas) : ();
+
+# Validate cert files
+if (!-r $keyfile) {
+	&log_error("SSL key file $keyfile does not exist");
+	return undef;
+	}
+if ($certfile && !-r $certfile) {
+	&log_error("SSL cert file $certfile does not exist");
+	return undef;
+	}
+foreach my $p (@extracas) {
+	if (!-r $p) {
+		&log_error("SSL CA file $p does not exist");
+		return undef;
+		}
+	}
+
+# Setup PFS, if ciphers are in use
+if (-r $config{'dhparams_file'}) {
+	eval {
+		my $bio = Net::SSLeay::BIO_new_file(
+				$config{'dhparams_file'}, 'r');
+		my $DHP = Net::SSLeay::PEM_read_bio_DHparams($bio);
+		Net::SSLeay::CTX_set_tmp_dh($ssl_ctx, $DHP);
+		my $nid = Net::SSLeay::OBJ_sn2nid("secp384r1");
+		my $curve = Net::SSLeay::EC_KEY_new_by_curve_name($nid);
+		Net::SSLeay::CTX_set_tmp_ecdh($ssl_ctx, $curve);
+		Net::SSLeay::BIO_free($bio);
+		};
+	}
+if ($@) {
+	&log_error("Failed to load $config{'dhparams_file'} : $@");
+	}
+
+if ($client_certs) {
+	Net::SSLeay::CTX_load_verify_locations(
+		$ssl_ctx, $config{'ca'}, "");
+	eval {
+		Net::SSLeay::set_verify(
+			$ssl_ctx, &Net::SSLeay::VERIFY_PEER, \&verify_client);
+		};
+	if ($@) {
+		Net::SSLeay::CTX_set_verify(
+			$ssl_ctx, &Net::SSLeay::VERIFY_PEER, \&verify_client);
+		}
+	}
+foreach my $p (@extracas) {
+	Net::SSLeay::CTX_load_verify_locations($ssl_ctx, $p, "");
+	}
+
+if (!Net::SSLeay::CTX_use_PrivateKey_file($ssl_ctx, $keyfile,
+					  &Net::SSLeay::FILETYPE_PEM)) {
+	&log_error("Failed to open SSL key $keyfile");
+	return undef;
+	}
+if (!Net::SSLeay::CTX_use_certificate_file($ssl_ctx, $certfile || $keyfile,
+					   &Net::SSLeay::FILETYPE_PEM)) {
+	&log_error("Failed to open SSL cert ".($certfile || $keyfile));
+	return undef;
+	}
+
+if ($config{'no_ssl2'}) {
+	eval 'Net::SSLeay::CTX_set_options($ssl_ctx,
+		&Net::SSLeay::OP_NO_SSLv2)';
+	}
+if ($config{'no_ssl3'}) {
+	eval 'Net::SSLeay::CTX_set_options($ssl_ctx,
+		&Net::SSLeay::OP_NO_SSLv3)';
+	}
+if ($config{'no_tls1'}) {
+	eval 'Net::SSLeay::CTX_set_options($ssl_ctx,
+		&Net::SSLeay::OP_NO_TLSv1)';
+	}
+if ($config{'no_tls1_1'}) {
+	eval 'Net::SSLeay::CTX_set_options($ssl_ctx,
+		&Net::SSLeay::OP_NO_TLSv1_1)';
+	}
+if ($config{'no_tls1_2'}) {
+	eval 'Net::SSLeay::CTX_set_options($ssl_ctx,
+		&Net::SSLeay::OP_NO_TLSv1_2)';
+	}
+if ($config{'no_sslcompression'}) {
+	eval 'Net::SSLeay::CTX_set_options($ssl_ctx,
+		&Net::SSLeay::OP_NO_COMPRESSION)';
+	}
+if ($config{'ssl_honorcipherorder'}) {
+	eval 'Net::SSLeay::CTX_set_options($ssl_ctx,
+		&Net::SSLeay::OP_CIPHER_SERVER_PREFERENCE)';
+	}
+
+# Disable TLS renegotiation when possible, OpenSSL >= 1.1.0h
+eval 'Net::SSLeay::CTX_set_options($ssl_ctx,
+        &Net::SSLeay::OP_NO_RENEGOTIATION)';
+
+# Get the hostnames each cert is valid for
+my $info = &cert_names($certfile);
+my @hosts;
+push(@hosts, $info->{'cn'}) if ($info->{'cn'});
+push(@hosts, @{$info->{'alt'}}) if ($info->{'alt'});
+
+return { 'keyfile' => $keyfile,
+	 'keytime' => $kst[9],
+	 'certfile' => $certfile,
+	 'certtime' => $cst[9],
+	 'extracas' => $extracas,
+	 'hosts' => \@hosts,
+	 'ctx' => $ssl_ctx };
+}
+
+# ssl_connection_for_ip(socket, ipv6-flag)
+# Returns a new SSL connection object for some socket, or undef if failed
+sub ssl_connection_for_ip
+{
+local ($sock, $ipv6) = @_;
+local $sn = getsockname($sock);
+if (!$sn) {
+	&log_error("Failed to get address for socket $sock");
+	return undef;
+	}
+local (undef, $myip, undef) = &get_address_ip($sn, $ipv6);
+local $ssl_ctx = $ssl_contexts{$myip} || $ssl_contexts{"*"};
+local $ssl_con = Net::SSLeay::new($ssl_ctx->{'ctx'});
+if ($config{'ssl_cipher_list'}) {
+	# Force use of ciphers
+	eval "Net::SSLeay::set_cipher_list(
+			\$ssl_con, \$config{'ssl_cipher_list'})";
+	if ($@) {
+		&log_error("SSL cipher $config{'ssl_cipher_list'} failed : ",
+			     $@);
+		}
+	}
+
+# Accept the SSL connection
+Net::SSLeay::set_fd($ssl_con, fileno($sock));
+alarm(10);
+$SIG{'ALRM'} = sub { die "timeout" };
+my $ok = Net::SSLeay::accept($ssl_con);
+alarm(0);
+return undef if (!$ok);
+
+# Check for a per-hostname SSL context and use that instead
+my $h;
+if (defined(&Net::SSLeay::get_servername)) {
+	$h = Net::SSLeay::get_servername($ssl_con);
+	if ($h) {
+		my $c = $ssl_contexts{$h} ||
+			$h =~ /^[^\.]+\.(.*)$/ && $ssl_contexts{"*.$1"};
+		if ($c) {
+			$ssl_ctx = $c;
+			}
+		}
+	}
+return ($ssl_con, $ssl_ctx->{'certfile'}, $ssl_ctx->{'keyfile'}, $h,
+	$ssl_ctx->{'hosts'});
+}
+
+# parse_websockets_config()
+# Extract websockets proxies from the config hash
+sub parse_websockets_config
+{
+@websocket_paths = ( );
+foreach my $c (keys %config) {
+	if ($c =~ /^websockets_(\S+)$/) {
+		my $ws = { 'path' => $1 };
+		foreach my $kv (split(/\s+/, $config{$c})) {
+			my ($k, $v) = split(/=/, $kv, 2);
+			$ws->{$k} = $v;
+			}
+		push(@websocket_paths, $ws);
+		}
+	}
+}
+
+# find_websocket_config(path)
+# Returns the websocket config and path, after dropping any query string and
+# redirect prefix from the request path.
+sub find_websocket_config
+{
+my ($simple) = @_;
+my $ws_simple = $simple;
+$ws_simple =~ s/\?.*$//;
+my ($ws) = grep { $_->{'path'} eq $ws_simple } @websocket_paths;
+if (!$ws && $config{'redirect_prefix'}) {
+	my $prefix = $config{'redirect_prefix'};
+	$prefix =~ s/[\/]+$//g;
+	if ($prefix && $ws_simple =~ s/^\Q$prefix\E(?=\/|$)//) {
+		$ws_simple ||= "/";
+		print DEBUG "websockets retry without prefix $prefix as $ws_simple\n";
+		($ws) = grep { $_->{'path'} eq $ws_simple } @websocket_paths;
+		}
+	}
+return wantarray ? ($ws, $ws_simple) : $ws;
+}
+
+# reload_config_file()
+# Re-read %config, and call post-config actions
+sub reload_config_file
+{
+print DEBUG "in reload_config_file\n";
+&log_error("Reloading configuration");
+%config = &read_config_file($config_file);
+&update_vital_config();
+&read_users_file();
+&read_mime_types();
+&build_config_mappings();
+&read_webmin_crons();
+&precache_files();
+&setup_ssl_contexts() if ($use_ssl);
+&parse_websockets_config();
+if ($config{'session'}) {
+	dbmclose(%sessiondb);
+	&open_session_db();
+	}
+print DEBUG "done reload_config_file\n";
+}
+
+# read_config_file(file)
+# Reads the given config file, and returns a hash of values
+sub read_config_file
+{
+local %rv;
+open(CONF, $_[0]) || die "Failed to open config file $_[0] : $!";
+while(<CONF>) {
+	s/\r|\n//g;
+	if (/^#/ || !/\S/) { next; }
+	/^([^=]+)=(.*)$/;
+	$name = $1; $val = $2;
+	$name =~ s/^\s+//g; $name =~ s/\s+$//g;
+	$val =~ s/^\s+//g; $val =~ s/\s+$//g;
+	$rv{$name} = $val;
+	}
+close(CONF);
+return %rv;
+}
+
+# lock_config_file(file)
+# Lock a config file using Webmin's .lock sidecar convention. miniserv.pl must
+# stay standalone, but link.cgi also edits miniserv.conf through this lock.
+sub lock_config_file
+{
+my ($file) = @_;
+if ($file =~ /\r|\n|\0/) {
+	die "Lock filename contains invalid characters";
+	}
+my $lockfile = $file.".lock";
+my $tries = 0;
+my $last_lock_err;
+while(1) {
+	my $pid;
+	# Webmin's lock file contains the owner PID. A dead owner means the lock
+	# can be safely reclaimed.
+	if (open(my $locking, "<", $lockfile)) {
+		$pid = int(<$locking>);
+		close($locking);
+		}
+	if (!$pid || !kill(0, $pid) || $pid == $$) {
+		# The sidecar lock is the shared convention with web-lib-funcs.pl;
+		# the non-blocking flock just narrows races between lock claimers.
+		unlink($lockfile);
+		if (open(my $locking, ">", $lockfile)) {
+			if (!flock($locking, 2+4)) {
+				$last_lock_err = "Flock failed : ".$!;
+				close($locking);
+				unlink($lockfile);
+				}
+			elsif (!print $locking $$,"\n") {
+				$last_lock_err = "Lock write failed : ".$!;
+				close($locking);
+				unlink($lockfile);
+				}
+			elsif (!close($locking)) {
+				$last_lock_err = "Lock close failed : ".$!;
+				unlink($lockfile);
+				}
+			else {
+				return 1;
+				}
+			}
+		else {
+			$last_lock_err = "Lock open failed : ".$!;
+			}
+		}
+	elsif ($pid) {
+		$last_lock_err = "Locked by PID $pid";
+		}
+	sleep(1);
+	if ($tries++ > 5*60) {
+		die "Failed to lock config file $file : $last_lock_err";
+		}
+	}
+}
+
+# unlock_config_file(file)
+# Release a config lock taken by lock_config_file.
+sub unlock_config_file
+{
+my ($file) = @_;
+unlink($file.".lock");
+}
+
+# read_any_file(file)
+# Reads any given file and returns its content
+sub read_any_file
+{
+my ($realfile) = @_;
+my $rv;
+open(my $fh, "<".$realfile) || return $rv;
+local $/;
+$rv = <$fh>;
+close($fh);
+return $rv;
+}
+
+# update_vital_config()
+# Updates %config with defaults, and dies if something vital is missing
+sub update_vital_config
+{
+my %vital = ("port", 80,
+	  "root", "./",
+	  "server", "MiniServ/0.01",
+	  "index_docs", "index.html index.htm index.cgi index.php",
+	  "addtype_html", "text/html",
+	  "addtype_txt", "text/plain",
+	  "addtype_gif", "image/gif",
+	  "addtype_jpg", "image/jpeg",
+	  "addtype_jpeg", "image/jpeg",
+	  "realm", "MiniServ",
+	  "session_login", "/session_login.cgi",
+	  "pam_login", "/pam_login.cgi",
+	  "password_form", "/password_form.cgi",
+	  "password_change", "/password_change.cgi",
+	  "maxconns", 50,
+	  "maxconns_per_ip", 25,
+	  "maxconns_per_net", 35,
+	  "listen_delay", 5,
+	  "pam", "webmin",
+	  "sidname", "sid",
+	  "unauth", "^/unauthenticated/ ^/robots.txt\$ ^[A-Za-z0-9\\-/_]+\\.jar\$ ^[A-Za-z0-9\\-/_]+\\.class\$ ^[A-Za-z0-9\\-/_]+\\.gif\$ ^[A-Za-z0-9\\-/_]+\\.png\$ ^[A-Za-z0-9\\-/_]+\\.conf\$ ^[A-Za-z0-9\\-/_]+\\.ico\$ ^/robots.txt\$ ^/service-worker.js\$",
+	  "unauthcgi", "^/forgot_form.cgi\$ ^/forgot_send.cgi\$ ^/forgot.cgi\$",
+	  "max_post", 10000,
+	  "expires", 7*24*60*60,
+	  "pam_test_user", "root",
+	  "precache", "lang/en */lang/en",
+	  "cookiepath", "/",
+	 );
+foreach my $v (keys %vital) {
+	if (!$config{$v}) {
+		if ($vital{$v} eq "") {
+			die "Missing config option $v";
+			}
+		$config{$v} = $vital{$v};
+		}
+	}
+$config_file =~ /^(.*)\/[^\/]+$/;
+my $config_dir = $1;
+$config{'pidfile'} =~ /^(.*)\/[^\/]+$/;
+my $var_dir = $1;
+if (!$config{'sessiondb'}) {
+	$config{'sessiondb'} = "$var_dir/sessiondb";
+	}
+if ($config{'session'}) {
+	if (!$config{'session_keyfile'}) {
+		$config{'session_keyfile'} = "$var_dir/session.key";
+		}
+	&load_session_secret();
+	}
+if (!$config{'errorlog'}) {
+	$config{'logfile'} =~ /^(.*)\/[^\/]+$/;
+	$config{'errorlog'} = "$1/miniserv.error";
+	}
+if (!$config{'tempbase'}) {
+	$config{'tempbase'} = "$var_dir/cgitemp";
+	}
+if (!$config{'blockedfile'}) {
+	$config{'blockedfile'} = "$var_dir/blocked";
+	}
+if (!$config{'webmincron_dir'}) {
+	$config{'webmincron_dir'} = "$config_dir/webmincron/crons";
+	}
+if (!$config{'webmincron_last'}) {
+	$config{'logfile'} =~ /^(.*)\/[^\/]+$/;
+	$config{'webmincron_last'} = "$1/miniserv.lastcrons";
+	}
+if (!$config{'webmincron_wrapper'}) {
+	$config{'webmincron_wrapper'} = $config{'root'}.
+					"/webmincron/webmincron.pl";
+	}
+if (!$config{'twofactor_wrapper'}) {
+	$config{'twofactor_wrapper'} = $config{'root'}."/acl/twofactor.pl";
+	}
+$config{'restartflag'} ||= $var_dir."/restart-flag";
+$config{'reloadflag'} ||= $var_dir."/reload-flag";
+$config{'stopflag'} ||= $var_dir."/stop-flag";
+}
+
+# read_users_file()
+# Fills the %users and %certs hashes from the users file in %config
+sub read_users_file
+{
+undef(%users);
+undef(%certs);
+undef(%allow);
+undef(%deny);
+undef(%allowdays);
+undef(%allowhours);
+undef(%lastchanges);
+undef(%nochange);
+undef(%temppass);
+undef(%twofactor);
+if ($config{'userfile'}) {
+	open(USERS, $config{'userfile'});
+	while(<USERS>) {
+		s/\r|\n//g;
+		local @user = split(/:/, $_, -1);
+		$users{$user[0]} = $user[1];
+		$certs{$user[0]} = $user[3] if ($user[3]);
+		if ($user[4] =~ /^allow\s+(.*)/) {
+			my $allow = $1;
+			$allow =~ s/;/:/g;
+			$allow{$user[0]} = $config{'alwaysresolve'} ?
+				[ split(/\s+/, $allow) ] :
+				[ &to_ip46address(split(/\s+/, $allow)) ];
+			}
+		elsif ($user[4] =~ /^deny\s+(.*)/) {
+			my $deny = $1;
+			$deny =~ s/;/:/g;
+			$deny{$user[0]} = $config{'alwaysresolve'} ?
+				[ split(/\s+/, $deny) ] :
+				[ &to_ip46address(split(/\s+/, $deny)) ];
+			}
+		if ($user[5] =~ /days\s+(\S+)/) {
+			$allowdays{$user[0]} = [ split(/,/, $1) ];
+			}
+		if ($user[5] =~ /hours\s+(\d+)\.(\d+)-(\d+).(\d+)/) {
+			$allowhours{$user[0]} = [ $1*60+$2, $3*60+$4 ];
+			}
+		$lastchanges{$user[0]} = $user[6];
+		$nochange{$user[0]} = $user[9];
+		$temppass{$user[0]} = $user[10];
+		if ($user[11] && $user[12]) {
+			$twofactor{$user[0]} = { 'provider' => $user[11],
+						 'id' => $user[12],
+						 'apikey' => $user[13] };
+			}
+		}
+	close(USERS);
+	}
+if ($config{'twofactorfile'}) {
+	open(TWO, $config{'twofactorfile'});
+	while(<TWO>) {
+		s/\r|\n//g;
+                local @two = split(/:/, $_, -1);
+		$twofactor{$two[0]} = { 'provider' => $two[1],
+					'id' => $two[2],
+					'apikey' => $two[3], };
+		}
+	close(TWO);
+	}
+
+# Test user DB, if configured
+if ($config{'userdb'}) {
+	my $dbh = &connect_userdb($config{'userdb'});
+	if (!ref($dbh)) {
+		&log_error("Failed to open users database : $dbh");
+		}
+	else {
+		&disconnect_userdb($config{'userdb'}, $dbh);
+		}
+	}
+}
+
+# get_user_details(username, [original-username])
+# Returns a hash ref of user details, either from config files or the user DB
+sub get_user_details
+{
+my ($username, $origusername) = @_;
+if (exists($users{$username})) {
+	# In local files
+	my $two = $twofactor{$origusername} || $twofactor{$username};
+	return { 'name' => $username,
+		 'pass' => $users{$username},
+		 'certs' => $certs{$username},
+		 'allow' => $allow{$username},
+		 'deny' => $deny{$username},
+		 'allowdays' => $allowdays{$username},
+		 'allowhours' => $allowhours{$username},
+		 'lastchanges' => $lastchanges{$username},
+		 'nochange' => $nochange{$username},
+		 'temppass' => $temppass{$username},
+		 'preroot' => $config{'preroot_'.$username},
+		 'twofactor_provider' => $two->{'provider'},
+		 'twofactor_id' => $two->{'id'},
+		 'twofactor_apikey' => $two->{'apikey'},
+	       };
+	}
+if ($config{'userdb'}) {
+	# Try querying user database
+	if (exists($get_user_details_cache{$username})) {
+		# Cached already
+		return $get_user_details_cache{$username};
+		}
+	print DEBUG "get_user_details: Connecting to user database\n";
+	my ($dbh, $proto, $prefix, $args) = &connect_userdb($config{'userdb'});
+	my $user;
+	my %attrs;
+	if (!ref($dbh)) {
+		print DEBUG "get_user_details: Failed : $dbh\n";
+		&log_error("Failed to connect to user database : $dbh");
+		}
+	elsif ($proto eq "mysql" || $proto eq "postgresql") {
+		# Fetch user ID and password with SQL
+		print DEBUG "get_user_details: Looking for $username in SQL\n";
+		my $cmd = $dbh->prepare(
+			"select id,pass from webmin_user where name = ?");
+		if (!$cmd || !$cmd->execute($username)) {
+			&log_error("Failed to lookup user : ",
+				     $dbh->errstr);
+			return undef;
+			}
+		my ($id, $pass) = $cmd->fetchrow();
+		$cmd->finish();
+		if (!$id) {
+			&disconnect_userdb($config{'userdb'}, $dbh);
+			$get_user_details_cache{$username} = undef;
+			print DEBUG "get_user_details: User not found\n";
+			return undef;
+			}
+		print DEBUG "get_user_details: id=$id pass=$pass\n";
+
+		# Fetch attributes and add to user object
+		print DEBUG "get_user_details: finding user attributes\n";
+		my $cmd = $dbh->prepare(
+			"select attr,value from webmin_user_attr where id = ?");
+		if (!$cmd || !$cmd->execute($id)) {
+			&log_error("Failed to lookup user attrs : ",
+				     $dbh->errstr);
+			return undef;
+			}
+		$user = { 'name' => $username,
+			  'id' => $id,
+			  'pass' => $pass,
+			  'proto' => $proto };
+		while(my ($attr, $value) = $cmd->fetchrow()) {
+			$attrs{$attr} = $value;
+			}
+		$cmd->finish();
+		}
+	elsif ($proto eq "ldap") {
+		# Fetch user DN with LDAP
+		print DEBUG "get_user_details: Looking for $username in LDAP\n";
+		my $rv = $dbh->search(
+			base => $prefix,
+			filter => '(&(cn='.$username.')(objectClass='.
+                                  $args->{'userclass'}.'))',
+			scope => 'sub');
+		if (!$rv || $rv->code) {
+			&log_error("Failed to lookup user : ",
+				     ($rv ? $rv->error : "Unknown error"));
+			return undef;
+			}
+		my ($u) = $rv->all_entries();
+		if (!$u || $u->get_value('cn') ne $username) {
+			&disconnect_userdb($config{'userdb'}, $dbh);
+                        $get_user_details_cache{$username} = undef;
+			print DEBUG "get_user_details: User not found\n";
+                        return undef;
+			}
+
+		# Extract attributes
+		my $pass = $u->get_value('webminPass');
+		$user = { 'name' => $username,
+			  'id' => $u->dn(),
+			  'pass' => $pass,
+			  'proto' => $proto };
+		foreach my $la ($u->get_value('webminAttr')) {
+			my ($attr, $value) = split(/=/, $la, 2);
+			$attrs{$attr} = $value;
+			}
+		}
+
+	# Convert DB attributes into user object fields
+	if ($user) {
+		print DEBUG "get_user_details: got ",scalar(keys %attrs),
+			    " attributes\n";
+		$user->{'certs'} = $attrs{'cert'};
+		if ($attrs{'allow'}) {
+			$user->{'allow'} = $config{'alwaysresolve'} ?
+				[ split(/\s+/, $attrs{'allow'}) ] :
+				[ &to_ipaddress(split(/\s+/,$attrs{'allow'})) ];
+			}
+		if ($attrs{'deny'}) {
+			$user->{'deny'} = $config{'alwaysresolve'} ?
+				[ split(/\s+/, $attrs{'deny'}) ] :
+				[ &to_ipaddress(split(/\s+/,$attrs{'deny'})) ];
+			}
+		if ($attrs{'days'}) {
+			$user->{'allowdays'} = [ split(/,/, $attrs{'days'}) ];
+			}
+		if ($attrs{'hoursfrom'} && $attrs{'hoursto'}) {
+			my ($hf, $mf) = split(/\./, $attrs{'hoursfrom'});
+			my ($ht, $mt) = split(/\./, $attrs{'hoursto'});
+			$user->{'allowhours'} = [ $hf*60+$ht, $ht*60+$mt ];
+			}
+		$user->{'lastchanges'} = $attrs{'lastchange'};
+		$user->{'nochange'} = $attrs{'nochange'};
+		$user->{'temppass'} = $attrs{'temppass'};
+		$user->{'preroot'} = $attrs{'theme'};
+		$user->{'twofactor_provider'} = $attrs{'twofactor_provider'};
+		$user->{'twofactor_id'} = $attrs{'twofactor_id'};
+		$user->{'twofactor_apikey'} = $attrs{'twofactor_apikey'};
+		}
+	&disconnect_userdb($config{'userdb'}, $dbh);
+	$get_user_details_cache{$user->{'name'}} = $user;
+	return $user;
+	}
+return undef;
+}
+
+# find_user_by_cert(cert)
+# Returns a username looked up by certificate
+sub find_user_by_cert
+{
+my ($peername) = @_;
+my $peername2 = $peername;
+$peername2 =~ s/Email=/emailAddress=/ || $peername2 =~ s/emailAddress=/Email=/;
+
+# First check users in local files
+foreach my $username (keys %certs) {
+	if ($certs{$username} eq $peername ||
+	    $certs{$username} eq $peername2) {
+		return $username;
+		}
+	}
+
+# Check user DB
+if ($config{'userdb'}) {
+	my ($dbh, $proto) = &connect_userdb($config{'userdb'});
+	if (!ref($dbh)) {
+		return undef;
+		}
+	elsif ($proto eq "mysql" || $proto eq "postgresql") {
+		# Query with SQL
+		my $cmd = $dbh->prepare("select webmin_user.name from webmin_user,webmin_user_attr where webmin_user.id = webmin_user_attr.id and webmin_user_attr.attr = 'cert' and webmin_user_attr.value = ?");
+		return undef if (!$cmd);
+		foreach my $p ($peername, $peername2) {
+			my $username;
+			if ($cmd->execute($p)) {
+				($username) = $cmd->fetchrow();
+				}
+			$cmd->finish();
+			return $username if ($username);
+			}
+		}
+	elsif ($proto eq "ldap") {
+		# Lookup in LDAP
+		my $rv = $dbh->search(
+			base => $prefix,
+			filter => '(objectClass='.
+				  $args->{'userclass'}.')',
+			scope => 'sub',
+			attrs => [ 'cn', 'webminAttr' ]);
+		if ($rv && !$rv->code) {
+			foreach my $u ($rv->all_entries) {
+				my @attrs = $u->get_value('webminAttr');
+				foreach my $la (@attrs) {
+					my ($attr, $value) = split(/=/, $la, 2);
+					if ($attr eq "cert" &&
+					    ($value eq $peername ||
+					     $value eq $peername2)) {
+						return $u->get_value('cn');
+						}
+					}
+				}
+			}
+		}
+	}
+return undef;
+}
+
+# connect_userdb(string)
+# Returns a handle for talking to a user database - may be a DBI or LDAP handle.
+# On failure returns an error message string. In an array context, returns the
+# protocol type too.
+sub connect_userdb
+{
+my ($str) = @_;
+my ($proto, $user, $pass, $host, $prefix, $args) = &split_userdb_string($str);
+if ($proto eq "mysql") {
+	# Connect to MySQL with DBI
+	my $drh = eval "use DBI; DBI->install_driver('mysql');";
+	$drh || return $text{'sql_emysqldriver'};
+	my ($host, $port) = split(/:/, $host);
+	my $cstr = "database=$prefix;host=$host";
+	$cstr .= ";port=$port" if ($port);
+	print DEBUG "connect_userdb: Connecting to MySQL $cstr as $user\n";
+	my $dbh = $drh->connect($cstr, $user, $pass, { });
+	$dbh || return "Failed to connect to MySQL : ".$drh->errstr;
+	print DEBUG "connect_userdb: Connected OK\n";
+	return wantarray ? ($dbh, $proto, $prefix, $args) : $dbh;
+	}
+elsif ($proto eq "postgresql") {
+	# Connect to PostgreSQL with DBI
+	my $drh = eval "use DBI; DBI->install_driver('Pg');";
+	$drh || return $text{'sql_epostgresqldriver'};
+	my ($host, $port) = split(/:/, $host);
+	my $cstr = "dbname=$prefix;host=$host";
+	$cstr .= ";port=$port" if ($port);
+	print DEBUG "connect_userdb: Connecting to PostgreSQL $cstr as $user\n";
+	my $dbh = $drh->connect($cstr, $user, $pass);
+	$dbh || return "Failed to connect to PostgreSQL : ".$drh->errstr;
+	print DEBUG "connect_userdb: Connected OK\n";
+	return wantarray ? ($dbh, $proto, $prefix, $args) : $dbh;
+	}
+elsif ($proto eq "ldap") {
+	# Connect with perl LDAP module
+	eval "use Net::LDAP";
+	$@ && return $text{'sql_eldapdriver'};
+	my ($host, $port) = split(/:/, $host);
+	my $scheme = $args->{'scheme'} || 'ldap';
+	if (!$port) {
+		$port = $scheme eq 'ldaps' ? 636 : 389;
+		}
+	my $ldap = Net::LDAP->new($host,
+				  port => $port,
+				  'scheme' => $scheme);
+	$ldap || return "Failed to connect to LDAP : ".$host;
+	my $mesg;
+	if ($args->{'tls'}) {
+		# Switch to TLS mode
+		eval { $mesg = $ldap->start_tls(); };
+		if ($@ || !$mesg || $mesg->code) {
+			return "Failed to switch to LDAP TLS mode : ".
+			    ($@ ? $@ : $mesg ? $mesg->error : "Unknown error");
+			}
+		}
+	# Login to the server
+	if ($pass) {
+		$mesg = $ldap->bind(dn => $user, password => $pass);
+		}
+	else {
+		$mesg = $ldap->bind(dn => $user, anonymous => 1);
+		}
+	if (!$mesg || $mesg->code) {
+		return "Failed to login to LDAP as ".$user." : ".
+		       ($mesg ? $mesg->error : "Unknown error");
+		}
+	return wantarray ? ($ldap, $proto, $prefix, $args) : $ldap;
+	}
+else {
+	return "Unknown protocol $proto";
+	}
+}
+
+# split_userdb_string(string)
+# Converts a string like mysql://user:pass@host/db into separate parts
+sub split_userdb_string
+{
+my ($str) = @_;
+if ($str =~ /^([a-z]+):\/\/([^:]*):([^\@]*)\@([a-z0-9\.\-\_]+)\/([^\?]+)(\?(.*))?$/) {
+	my ($proto, $user, $pass, $host, $prefix, $argstr) =
+		($1, $2, $3, $4, $5, $7);
+	my %args = map { split(/=/, $_, 2) } split(/\&/, $argstr);
+	return ($proto, $user, $pass, $host, $prefix, \%args);
+	}
+return ( );
+}
+
+# disconnect_userdb(string, &handle)
+# Closes a handle opened by connect_userdb
+sub disconnect_userdb
+{
+my ($str, $h) = @_;
+if ($str =~ /^(mysql|postgresql):/) {
+	# DBI disconnect
+	$h->disconnect();
+	}
+elsif ($str =~ /^ldap:/) {
+	# LDAP disconnect
+	$h->disconnect();
+	}
+}
+
+# read_mime_types()
+# Fills %mime with entries from file in %config and extra settings in %config
+sub read_mime_types
+{
+undef(%mime);
+if ($config{"mimetypes"} ne "") {
+	open(MIME, $config{"mimetypes"});
+	while(<MIME>) {
+		chop; s/#.*$//;
+		if (/^(\S+)\s+(.*)$/) {
+			my $type = $1;
+			my @exts = split(/\s+/, $2);
+			foreach my $ext (@exts) {
+				$mime{$ext} = $type;
+				}
+			}
+		}
+	close(MIME);
+	}
+foreach my $k (keys %config) {
+	if ($k !~ /^addtype_(.*)$/) { next; }
+	$mime{$1} = $config{$k};
+	}
+}
+
+# build_config_mappings()
+# Build the anonymous access list, IP access list, unauthenticated URLs list,
+# redirect mapping and allow and deny lists from %config
+sub build_config_mappings
+{
+# build anonymous access list
+undef(%anonymous);
+foreach my $a (split(/\s+/, $config{'anonymous'})) {
+	if ($a =~ /^([^=]+)=(\S+)$/) {
+		$anonymous{$1} = $2;
+		}
+	}
+
+# build IP access list
+undef(%ipaccess);
+foreach my $a (split(/\s+/, $config{'ipaccess'})) {
+	if ($a =~ /^([^=]+)=(\S+)$/) {
+		$ipaccess{$1} = $2;
+		}
+	}
+
+# build unauthenticated URLs list
+@unauth = split(/\s+/, $config{'unauth'});
+@unauthcgi = split(/\s+/, $config{'unauthcgi'});
+
+# build redirect mapping
+undef(%redirect);
+foreach my $r (split(/\s+/, $config{'redirect'})) {
+	if ($r =~ /^([^=]+)=(\S+)$/) {
+		$redirect{$1} = $2;
+		}
+	}
+
+# build prefixes to be stripped
+undef(@strip_prefix);
+foreach my $r (split(/\s+/, $config{'strip_prefix'})) {
+	push(@strip_prefix, $r);
+	}
+
+# Init allow and deny lists
+@deny = split(/\s+/, $config{"deny"});
+@deny = &to_ipaddress(@deny) if (!$config{'alwaysresolve'});
+@allow = split(/\s+/, $config{"allow"});
+@allow = &to_ipaddress(@allow) if (!$config{'alwaysresolve'});
+undef(@allowusers);
+undef(@denyusers);
+if ($config{'allowusers'}) {
+	@allowusers = split(/\s+/, $config{'allowusers'});
+	}
+elsif ($config{'denyusers'}) {
+	@denyusers = split(/\s+/, $config{'denyusers'});
+	}
+
+# Build list of unixauth mappings
+undef(%unixauth);
+foreach my $ua (split(/\s+/, $config{'unixauth'})) {
+	if ($ua =~ /^(\S+)=(\S+)$/) {
+		$unixauth{$1} = $2;
+		}
+	else {
+		$unixauth{"*"} = $ua;
+		}
+	}
+
+# Build list of non-session-auth pages
+undef(%sessiononly);
+foreach my $sp (split(/\s+/, $config{'sessiononly'})) {
+	$sessiononly{$sp} = 1;
+	}
+
+# Build list of logout times
+undef(@logouttimes);
+foreach my $a (split(/\s+/, $config{'logouttimes'})) {
+	if ($a =~ /^([^=]+)=(\S+)$/) {
+		push(@logouttimes, [ $1, $2 ]);
+		}
+	}
+push(@logouttimes, [ undef, $config{'logouttime'} ]);
+
+# Build list of DAV pathss
+undef(@davpaths);
+foreach my $d (split(/\s+/, $config{'davpaths'})) {
+	push(@davpaths, $d);
+	}
+@davusers = split(/\s+/, $config{'dav_users'});
+
+# Mobile agent substrings and hostname prefixes
+@mobile_agents = split(/\t+/, $config{'mobile_agents'});
+@mobile_prefixes = split(/\s+/, $config{'mobile_prefixes'});
+
+# Expires time list
+@expires_paths = ( );
+foreach my $pe (split(/\t+/, $config{'expires_paths'})) {
+	my ($p, $e) = split(/=/, $pe);
+	if ($p && $e ne '') {
+		push(@expires_paths, [ $p, $e ]);
+		}
+	}
+
+# Re-open debug log
+&open_debug_to_log();
+
+# Reset cache of sudo checks
+undef(%sudocache);
+
+# Reset cache of cert files
+undef(%cert_names_cache);
+}
+
+# is_group_member(&uinfo, groupname)
+# Returns 1 if some user is a primary or secondary member of a group
+sub is_group_member
+{
+local ($uinfo, $group) = @_;
+local @ginfo = getgrnam($group);
+return 0 if (!@ginfo);
+return 1 if ($ginfo[2] == $uinfo->[3]);	# primary member
+foreach my $m (split(/\s+/, $ginfo[3])) {
+	return 1 if ($m eq $uinfo->[0]);
+	}
+return 0;
+}
+
+# prefix_to_mask(prefix)
+# Converts a number like 24 to a mask like 255.255.255.0
+sub prefix_to_mask
+{
+return $_[0] >= 24 ? "255.255.255.".(256-(2 ** (32-$_[0]))) :
+       $_[0] >= 16 ? "255.255.".(256-(2 ** (24-$_[0]))).".0" :
+       $_[0] >= 8 ? "255.".(256-(2 ** (16-$_[0]))).".0.0" :
+                     (256-(2 ** (8-$_[0]))).".0.0.0";
+}
+
+# get_logout_time(user, session-id)
+# Given a username, returns the idle time before he will be logged out
+sub get_logout_time
+{
+local ($user, $sid) = @_;
+if (!defined($logout_time_cache{$user,$sid})) {
+	local $time;
+	foreach my $l (@logouttimes) {
+		if ($l->[0] =~ /^\@(.*)$/) {
+			# Check group membership
+			local @uinfo = getpwnam($user);
+			if (@uinfo && &is_group_member(\@uinfo, $1)) {
+				$time = $l->[1];
+				}
+			}
+		elsif ($l->[0] =~ /^\//) {
+			# Check file contents
+			open(FILE, $l->[0]);
+			while(<FILE>) {
+				s/\r|\n//g;
+				s/^\s*#.*$//;
+				if ($user eq $_) {
+					$time = $l->[1];
+					last;
+					}
+				}
+			close(FILE);
+			}
+		elsif (!$l->[0]) {
+			# Always match
+			$time = $l->[1];
+			}
+		else {
+			# Check username
+			if ($l->[0] eq $user) {
+				$time = $l->[1];
+				}
+			}
+		last if (defined($time));
+		}
+	$logout_time_cache{$user,$sid} = $time;
+	}
+return $logout_time_cache{$user,$sid};
+}
+
+# password_crypt(password, salt)
+# If the salt looks like MD5 and we have a library for it, perform MD5 hashing
+# of a password. Otherwise, do Unix crypt.
+sub password_crypt
+{
+local ($pass, $salt) = @_;
+local $rval;
+if ($salt =~ /^\$1\$/ && $use_md5) {
+	$rval = &encrypt_md5($pass, $salt);
+	}
+elsif ($salt =~ /^\$6\$/ && $use_sha512) {
+	$rval = &encrypt_sha512($pass, $salt);
+	}
+if (!defined($rval) || $salt ne $rval) {
+	$rval = &unix_crypt($pass, $salt);
+	}
+return $rval;
+}
+
+# unix_crypt(password, salt)
+# Performs standard Unix hashing for a password
+sub unix_crypt
+{
+local ($pass, $salt) = @_;
+if ($use_perl_crypt) {
+	return Crypt::UnixCrypt::crypt($pass, $salt);
+	}
+else {
+	return crypt($pass, $salt);
+	}
+}
+
+# handle_dav_request(davpath)
+# Pass a request on to the Net::DAV::Server module
+sub handle_dav_request
+{
+local ($path) = @_;
+eval "use Filesys::Virtual::Plain";
+eval "use Net::DAV::Server";
+eval "use HTTP::Request";
+eval "use HTTP::Headers";
+
+if ($Net::DAV::Server::VERSION eq '1.28' && $config{'dav_nolock'}) {
+	delete $Net::DAV::Server::implemented{lock};
+	delete $Net::DAV::Server::implemented{unlock};
+	}
+
+# Read in request data
+if (!$posted_data) {
+	local $clen = $header{"content-length"};
+	while(length($posted_data) < $clen) {
+		$buf = &read_data($clen - length($posted_data));
+		if (!length($buf)) {
+			&http_error(500, "Failed to read POST request");
+			}
+		$posted_data .= $buf;
+		}
+	}
+
+# For subsequent logging
+open(MINISERVLOG, ">>$config{'logfile'}");
+
+# Switch to user
+local $root;
+local @u = getpwnam($authuser);
+if ($config{'dav_remoteuser'} && !$< && $validated) {
+	if (@u) {
+		if ($u[2] != 0) {
+			$( = $u[3]; $) = "$u[3] $u[3]";
+			($>, $<) = ($u[2], $u[2]);
+			}
+		if ($config{'dav_root'} eq '*') {
+			$root = $u[7];
+			}
+		}
+	else {
+		&http_error(500, "Unix user ".&html_strip($authuser).
+				 " does not exist");
+		return 0;
+		}
+	}
+$root ||= $config{'dav_root'};
+$root ||= "/";
+
+# Check if this user can use DAV
+if (@davusers) {
+	&users_match(\@u, @davusers) ||
+		&http_error(500, "You are not allowed to access DAV");
+	}
+
+# Create DAV server
+my $filesys = Filesys::Virtual::Plain->new({root_path => $root});
+my $webdav = Net::DAV::Server->new();
+$webdav->filesys($filesys);
+
+# Make up a request object, and feed to DAV
+local $ho = HTTP::Headers->new;
+foreach my $h (keys %header) {
+	next if (lc($h) eq "connection");
+	$ho->header($h => $header{$h});
+	}
+if ($path ne "/") {
+	$request_uri =~ s/^\Q$path\E//;
+	$request_uri = "/" if ($request_uri eq "");
+	}
+my $request = HTTP::Request->new($method, $request_uri, $ho,
+				 $posted_data);
+if ($config{'dav_debug'}) {
+	&log_error("DAV request :");
+	&log_error("---------------------------------------------");
+	&log_error($request->as_string());
+	&log_error("---------------------------------------------");
+	}
+my $response = $webdav->run($request);
+
+# Send back the reply
+&write_data("HTTP/1.1 ",$response->code()," ",$response->message(),"\r\n");
+local $content = $response->content();
+if ($path ne "/") {
+	$content =~ s|href>/(.+)<|href>$path/$1<|g;
+	$content =~ s|href>/<|href>$path<|g;
+	}
+foreach my $h ($response->header_field_names) {
+	next if (lc($h) eq "connection" || lc($h) eq "content-length");
+	&write_data("$h: ",$response->header($h),"\r\n");
+	}
+&write_data("Content-length: ",length($content),"\r\n");
+local $rv = &write_keep_alive(0);
+&write_data("\r\n");
+&write_data($content);
+
+if ($config{'dav_debug'}) {
+	&log_error("DAV reply :");
+	&log_error("---------------------------------------------");
+	&log_error("HTTP/1.1 ",$response->code()," ",$response->message());
+	foreach my $h ($response->header_field_names) {
+		next if (lc($h) eq "connection" || lc($h) eq "content-length");
+		&log_error("$h: ",$response->header($h));
+		}
+	&log_error("Content-length: ",length($content));
+	&log_error($content);
+	&log_error("---------------------------------------------");
+	}
+
+# Log it
+&log_request($loghost, $authuser, $reqline, $response->code(),
+	     length($response->content()));
+return 0;
+}
+
+# normalise_websocket_origin(scheme, host, port)
+# Canonicalises an origin for websocket security checks
+sub normalise_websocket_origin
+{
+my ($scheme, $host, $port) = @_;
+return undef if (!$scheme || !defined($host) || $host eq '');
+$scheme = lc($scheme);
+$host =~ s/^\s+|\s+$//g;
+$host =~ s/^\[(.+)\]$/$1/;
+$host = lc($host);
+$port ||= $scheme eq 'https' ? 443 : 80;
+my $portstr = $port == 80 && $scheme eq 'http' ? "" :
+	      $port == 443 && $scheme eq 'https' ? "" : ":".$port;
+my $hostport = &check_ip6address($host) ? "[".$host."]".$portstr
+					: $host.$portstr;
+return $scheme."://".$hostport;
+}
+
+# parse_websocket_origin(origin)
+# Parses an Origin header value into canonical scheme://host[:port] form
+sub parse_websocket_origin
+{
+my ($origin) = @_;
+return undef if (!defined($origin));
+$origin =~ s/^\s+|\s+$//g;
+return undef if (!$origin || lc($origin) eq 'null');
+if ($origin =~ /^(https?):\/\/\[([^\]]+)\](?::(\d+))?\/?$/i) {
+	return &normalise_websocket_origin($1, $2, $3);
+	}
+elsif ($origin =~ /^(https?):\/\/([^:\/]+)(?::(\d+))?\/?$/i) {
+	return &normalise_websocket_origin($1, $2, $3);
+	}
+return undef;
+}
+
+# parse_configured_websocket_origin(origin)
+# Parses a configured origin, accepting ws:// and wss:// aliases
+sub parse_configured_websocket_origin
+{
+my ($origin) = @_;
+return undef if (!defined($origin));
+$origin =~ s/^\s+|\s+$//g;
+$origin =~ s/^ws:\/\//http:\/\//i;  # if admin configures websocket URLs
+$origin =~ s/^wss:\/\//https:\/\//i;
+return &parse_websocket_origin($origin);
+}
+
+# forwarded_websocket_origin(proto, host, port)
+# Builds a canonical origin from reverse-proxy forwarding headers
+sub forwarded_websocket_origin
+{
+my ($proto, $host, $port) = @_;
+return undef if (!$proto || !$host);
+$proto =~ s/\s+//g;
+$proto = (split(/,/, $proto))[0];
+$host =~ s/^\s+|\s+$//g;
+$host = (split(/\s*,\s*/, $host))[0];
+if ($host =~ /^\[(.+)\]:(\d+)$/) {
+	($host, $port) = ($1, $2);
+	}
+elsif ($host =~ /^([^:]+):(\d+)$/) {
+	($host, $port) = ($1, $2);
+	}
+return &normalise_websocket_origin($proto, $host, $port);
+}
+
+# get_websocket_allowed_origins()
+# Returns all canonical origins allowed to connect to miniserv websockets
+sub get_websocket_allowed_origins
+{
+my @rv;
+my %seen;
+my $add_origin = sub {
+	my ($origin) = @_;
+	return if (!$origin || $seen{$origin}++);
+	push(@rv, $origin);
+	};
+
+# Direct access to miniserv, based on the current request host and port
+&$add_origin(&normalise_websocket_origin($use_ssl ? 'https' : 'http',
+					 $host, $port));
+
+# Canonical externally-visible URL, if one has been configured
+&$add_origin(&normalise_websocket_origin($prot, $redirhost, $redirport));
+
+# Reverse proxy headers, when present
+if ($config{'trust_real_ip'}) {
+	&$add_origin(&forwarded_websocket_origin($header{'x-forwarded-proto'},
+						 $header{'x-forwarded-host'},
+						 $header{'x-forwarded-port'}));
+	&$add_origin(&forwarded_websocket_origin($header{'x-forwarded-proto'},
+						 $header{'host'},
+						 $header{'x-forwarded-port'}));
+	}
+
+# Explicit websocket host setting, converted back to a page origin
+if ($config{'websocket_host'}) {
+	my $wshost = $config{'websocket_host'};
+	$wshost =~ s/[\/]+$//g;
+	if ($wshost =~ /^wss?:\/\//) {
+		$wshost =~ s/^ws/http/i;
+		&$add_origin(&parse_websocket_origin($wshost));
+		}
+	else {
+		&$add_origin(&forwarded_websocket_origin($ssl ? 'https' : 'http',
+							 $wshost, undef));
+		}
+	}
+
+# Extra public origins can be whitelisted explicitly for unusual edge proxy
+# configs where auto-detection cannot work
+if ($config{'websocket_extra_origins'}) {
+	foreach my $origin (split(/\s+|,\s*/, $config{'websocket_extra_origins'})) {
+		next if (!$origin);
+		my $parsed = &parse_configured_websocket_origin($origin);
+		if ($parsed) {
+			&$add_origin($parsed);
+			}
+		else {
+			print DEBUG "ignoring invalid websocket_extra_origins ".
+				    "entry $origin\n";
+			}
+		}
+	}
+
+return @rv;
+}
+
+# handle_websocket_request(&wsconfig, original-path)
+# Handles a websocket connection, which may proxy to another host and port
+sub handle_websocket_request
+{
+my ($ws, $simple) = @_;
+my $key = $header{'sec-websocket-key'};
+if (!$key) {
+	&http_error(500, "Missing Sec-Websocket-Key header");
+	return 0;
+	}
+my @users = split(/\s+/, $ws->{'user'});
+my @busers = split(/\s+/, $ws->{'buser'});
+if (@users || @busers) {
+	if (&indexof($authuser, @users) < 0 &&
+	    &indexof($baseauthuser, @busers) < 0) {
+		&http_error(500, "Invalid user for Websockets connection");
+		return 0;
+		}
+	}
+if ($ws->{'token'} && (!defined($in{'token'}) ||
+    $in{'token'} ne $ws->{'token'})) {
+	print DEBUG "websockets token mismatch for $simple\n";
+	&http_error(403, "Invalid Websockets token");
+	return 0;
+	}
+my $origin = $header{'origin'} || $header{'sec-websocket-origin'};
+my $parsed_origin = &parse_websocket_origin($origin);
+if (!$origin || !$parsed_origin) {
+	print DEBUG "websockets missing or invalid Origin header\n";
+	&http_error(403, "Invalid Websockets origin");
+	return 0;
+	}
+my @allowed_origins = &get_websocket_allowed_origins();
+if (!grep { $_ eq $parsed_origin } @allowed_origins) {
+	print DEBUG "websockets origin $parsed_origin not in ".
+		    join(" ", @allowed_origins)."\n";
+	&http_error(403, "Invalid Websockets origin");
+	return 0;
+	}
+my @protos = split(/\s*,\s*/, $header{'sec-websocket-protocol'});
+print DEBUG "websockets protos ",join(" ", @protos),"\n";
+# Once token and origin checks have passed, a ws-link route is a live
+# single-use credential. If the backend cannot complete its handshake, remove
+# that route before http_error exits this child.
+my $backend_fail = sub {
+	&cleanup_websocket_route($ws);
+	&http_error(@_);
+	return 0;
+	};
+
+# Connect to the configured backend
+my $fh = "WEBSOCKET";
+my ($backend_ssl, $backend_ssl_ctx);
+if ($ws->{'host'}) {
+	# Backend is a TCP port
+	my $err = &open_socket($ws->{'host'}, $ws->{'port'}, $fh);
+	return &$backend_fail(500, "Websockets connection failed : $err")
+		if ($err);
+	if ($ws->{'ssl'}) {
+		eval "use Net::SSLeay";
+		if ($@) {
+			return &$backend_fail(500,
+				"Missing Net::SSLeay perl module");
+			}
+		$backend_ssl_ctx = Net::SSLeay::CTX_new();
+		if (!$backend_ssl_ctx) {
+			return &$backend_fail(500,
+				"Failed to create SSL context");
+			}
+		$backend_ssl = Net::SSLeay::new($backend_ssl_ctx);
+		if (!$backend_ssl) {
+			return &$backend_fail(500,
+				"Failed to create SSL connection");
+			}
+		Net::SSLeay::set_fd($backend_ssl, fileno($fh));
+		my $sslhost = $ws->{'hostheader'} || $ws->{'host'};
+		if (defined(&Net::SSLeay::set_tlsext_host_name)) {
+			# Linked websocket routes may connect to an IP while the
+			# certificate belongs to the configured linked-server
+			# host.
+			my $snihost = $sslhost;
+			if ($snihost =~ /^\[([^\]]+)\](?::\d+)?$/) {
+				$snihost = $1;
+				}
+			elsif ($snihost =~ /^([^:]+):\d+$/) {
+				$snihost = $1;
+				}
+			Net::SSLeay::set_tlsext_host_name($backend_ssl, $snihost);
+			}
+		if (!Net::SSLeay::connect($backend_ssl)) {
+			return &$backend_fail(500,
+				"SSL connect to websockets backend failed");
+			}
+		if ($ws->{'checkssl'}) {
+			my $err = &check_websocket_backend_ssl(
+				$backend_ssl, $sslhost);
+			if ($err) {
+				return &$backend_fail(500,
+				    "Invalid SSL certificate from websockets ".
+				    "backend : $err");
+				}
+			}
+		}
+	print DEBUG "websockets host $ws->{'host'}:$ws->{'port'}\n";
+	}
+elsif ($ws->{'pipe'}) {
+	# Backend is a Unix pipe
+	open($fh, $ws->{'pipe'}) ||
+		return &$backend_fail(500, "Websockets pipe failed : $?");
+	print DEBUG "websockets pipe $ws->{'pipe'}\n";
+	}
+else {
+	return &$backend_fail(500, "Invalid Webmin websockets config");
+	}
+# Keep the rest of the websocket proxy code independent of whether the
+# backend hop is plain TCP or wrapped in TLS.
+my $backend_write = sub {
+	my ($buf) = @_;
+	my $offset = 0;
+	my $len = length($buf);
+	while($offset < $len) {
+		my $rv = $backend_ssl ?
+			Net::SSLeay::write($backend_ssl, substr($buf, $offset)) :
+			syswrite($fh, $buf, $len - $offset, $offset);
+		return 0 if (!defined($rv) || $rv <= 0);
+		$offset += $rv;
+		}
+	return 1;
+	};
+my $backend_read = sub {
+	my ($size) = @_;
+	if ($backend_ssl) {
+		return Net::SSLeay::read($backend_ssl, $size);
+		}
+	my $buf;
+	my $rv = sysread($fh, $buf, $size);
+	return $rv ? $buf : undef;
+	};
+my $backend_readline = sub {
+	my $line = "";
+	while(1) {
+		my $c = $backend_read->(1);
+		return undef if (!defined($c) || $c eq "");
+		$line .= $c;
+		last if ($c eq "\n");
+		}
+	return $line;
+	};
+
+# OpenSSL can keep decrypted bytes in its own buffer after the socket fd stops
+# being readable, so the forwarding loop must check this before select().
+my $backend_pending = sub {
+	return $backend_ssl && defined(&Net::SSLeay::pending) &&
+	       Net::SSLeay::pending($backend_ssl) > 0;
+	};
+
+# Prepare successful connection headers, but don't send them to the browser
+# until the backend websocket handshake has succeeded.
+eval "use Digest::SHA";
+if ($@) {
+	return &$backend_fail(500, "Missing Digest::SHA perl module");
+	}
+my $rkey = $key."258EAFA5-E914-47DA-95CA-C5AB0DC85B11";
+my $sha1 = Digest::SHA->new;
+$sha1->add($rkey);
+my $digest = $sha1->digest;
+$digest = &b64encode($digest);
+
+# Send a websockets request to the backend
+my $path = $ws->{'wspath'} || $simple;
+# Normal websocket proxies use the browser session id in the backend
+# Sec-WebSocket-Key. Linked xterm routes can instead provide a one-time
+# backend session key because the backend request is authenticated with Basic.
+my $backend_session = $ws->{'backend_session'} || $session_id;
+my $bsession_id = &b64encode($backend_session);
+print DEBUG "send request to $path to websockets backend\n";
+$backend_write->("GET $path HTTP/1.1\r\n") ||
+	return &$backend_fail(500, "Failed to write to websockets backend");
+if ($ws->{'host'} || $ws->{'hostheader'}) {
+	$backend_write->("Host: ".($ws->{'hostheader'} || $ws->{'host'})."\r\n") ||
+		return &$backend_fail(500, "Failed to write to websockets backend");
+	}
+$backend_write->("Upgrade: websocket\r\n") ||
+	return &$backend_fail(500, "Failed to write to websockets backend");
+$backend_write->("Connection: Upgrade\r\n") ||
+	return &$backend_fail(500, "Failed to write to websockets backend");
+if ($ws->{'nokey'}) {
+	$backend_write->("Sec-WebSocket-Key: $key\r\n") ||
+		return &$backend_fail(500, "Failed to write to websockets backend");
+	}
+else {
+	print DEBUG "Sending key $bsession_id\n";
+	$backend_write->("Sec-WebSocket-Key: $bsession_id\r\n") ||
+		return &$backend_fail(500, "Failed to write to websockets backend");
+	}
+if (@protos) {
+	$backend_write->("Sec-WebSocket-Protocol: ".join(" ", @protos)."\r\n") ||
+		return &$backend_fail(500, "Failed to write to websockets backend");
+	}
+if ($ws->{'origin'}) {
+	$backend_write->("Origin: $ws->{'origin'}\r\n") ||
+		return &$backend_fail(500, "Failed to write to websockets backend");
+	}
+if ($ws->{'auth'} && $ws->{'auth'} =~ /^basic:(\S+)$/) {
+	$backend_write->("Authorization: Basic $1\r\n") ||
+		return &$backend_fail(500, "Failed to write to websockets backend");
+	}
+$backend_write->("Sec-WebSocket-Version: $header{'sec-websocket-version'}\r\n") ||
+	return &$backend_fail(500, "Failed to write to websockets backend");
+$backend_write->("\r\n") ||
+	return &$backend_fail(500, "Failed to write to websockets backend");
+
+# Read back the reply
+my $rh = $backend_readline->();
+if (!defined($rh)) {
+	return &$backend_fail(500, "No response from websockets backend");
+	}
+$rh =~ s/\r|\n//g;
+print DEBUG "got $rh from websockets backend\n";
+if ($rh !~ /^HTTP\/1\.1\s+(\d+)/) {
+	return &$backend_fail(500, "Bad response from websockets backend : ".
+			      &html_strip($rh));
+	}
+my $code = $1;
+my %rheader;
+my $lastheader;
+while(1) {
+	$rh = $backend_readline->();
+	if (!defined($rh)) {
+		return &$backend_fail(500,
+			"Unexpected EOF from websockets backend");
+		}
+	$rh =~ s/\r|\n//g;
+	last if ($rh eq "");
+	if ($rh =~ /^(\S+):\s*(.*)$/) {
+		print DEBUG "got websockets header $1 = $2\n";
+                $rheader{$lastheader = lc($1)} = $2;
+                }
+        elsif ($rh =~ /^\s+(.*)$/) {
+                $rheader{$lastheader} .= $headline;
+                }
+        else {
+                return &$backend_fail(500,
+			"Bad header from websockets backend ".
+			&html_strip($rh));
+                }
+	}
+if ($code != 101) {
+	return &$backend_fail(500,
+		"Bad response code $code from websockets backend : ".
+		&html_strip($rh));
+	}
+if (lc($rheader{'upgrade'}) ne 'websocket') {
+	return &$backend_fail(500,
+		"Missing Upgrade header from websockets backend");
+	}
+if (lc($rheader{'connection'}) !~ /upgrade/) {
+	return &$backend_fail(500,
+		"Missing Connection header from websockets backend");
+	}
+
+# Check the reply key
+my $bdigest;
+if ($ws->{'nokey'}) {
+	$bdigest = $digest;
+	}
+else {
+	my $brkey = $bsession_id."258EAFA5-E914-47DA-95CA-C5AB0DC85B11";
+	my $bsha1 = Digest::SHA->new;
+	$bsha1->add($brkey);
+	$bdigest = $bsha1->digest;
+	$bdigest = &b64encode($bdigest);
+	}
+print DEBUG "expecting digest $bdigest\n";
+if (lc($rheader{'sec-websocket-accept'}) ne lc($bdigest)) {
+	return &$backend_fail(500,
+		"Incorrect digest header from websockets backend");
+	}
+# The route has been consumed by this child process. The active tunnel now owns
+# the open backend socket, so the temporary miniserv.conf route can be removed
+# before the tunnel goes long-lived. Final cleanup remains a harmless fallback.
+&cleanup_websocket_route($ws);
+
+# Send successful connection headers
+&write_data("HTTP/1.1 101 Switching Protocols\r\n");
+&write_data("Upgrade: websocket\r\n");
+&write_data("Connection: Upgrade\r\n");
+&write_data("Sec-Websocket-Accept: $digest\r\n");
+if (@protos) {
+	&write_data("Sec-Websocket-Protocol: $protos[0]\r\n");
+	}
+&write_data("\r\n");
+
+# Log now
+&log_request($loghost, $authuser, $reqline, "101", 0);
+
+# Start forwarding data
+seek(DEBUG, 0, 2);
+print DEBUG "in websockets loop\n";
+my $last_session_check_time = time();
+# Frontend browser sockets have a session id and should be revalidated while
+# open. Backend hops authenticated without a browser session must not be closed
+# by the periodic session check.
+my $verify_session = defined($session_id) && $session_id ne "";
+while(1) {
+	my ($buf, $ok);
+	my $uptime = 0;
+	my ($backend_ready, $browser_ready);
+	if (&$backend_pending()) {
+		$backend_ready = 1;
+		my $bm = undef;
+		vec($bm, fileno(SOCK), 1) = 1;
+		select($bm, undef, undef, 0);
+		$browser_ready = vec($bm, fileno(SOCK), 1);
+		}
+	else {
+		my $rmask = undef;
+		vec($rmask, fileno($fh), 1) = 1;
+		vec($rmask, fileno(SOCK), 1) = 1;
+		my $sel = select($rmask, undef, undef, 10);
+		$backend_ready = vec($rmask, fileno($fh), 1);
+		$browser_ready = vec($rmask, fileno(SOCK), 1);
+		}
+	if ($backend_ready) {
+		# Got something from the websockets backend
+		$buf = $backend_read->(1024);
+		last if (!defined($buf) || length($buf) == 0);
+		&write_data($buf);
+		$uptime = 1;
+		}
+	if ($browser_ready) {
+		# Got something from the browser
+		$buf = &read_data(1024);
+		last if (!defined($buf) || length($buf) == 0);
+		$backend_write->($buf) || last;
+		$uptime = 1;
+		}
+	my $now = time();
+	if ($verify_session && $now - $last_session_check_time > 10) {
+		# Re-validate the browser session every 10 seconds
+		print DEBUG "verifying websockets session $session_id\n";
+		print $PASSINw "verify $session_id $acptip $uptime\n";
+		<$PASSOUTr> =~ /(\d+)\s+(\S+)/;
+		if ($1 != 2) {
+			print DEBUG "session $session_id has expired!\n";
+			last;
+			}
+		$last_session_check_time = $now;
+		}
+	}
+Net::SSLeay::free($backend_ssl) if ($backend_ssl);
+Net::SSLeay::CTX_free($backend_ssl_ctx) if ($backend_ssl_ctx);
+close($fh);
+close(SOCK);
+&cleanup_websocket_route($ws);
+print DEBUG "done websockets loop\n";
+
+return 0;
+}
+
+# cleanup_websocket_route(&wsconfig)
+# Removes a single-use linked-server websocket route from miniserv.conf.
+sub cleanup_websocket_route
+{
+my ($ws) = @_;
+# Only link.cgi-created ws-link routes are temporary. Ordinary module
+# websocket routes are managed by their owning code and must be left alone.
+return 0 if (!$ws || !$ws->{'path'} || $ws->{'path'} !~ /\/ws-link-/);
+my $deleted;
+my $locked;
+my $cleanup_ok = eval {
+	&lock_config_file($config_file);
+	$locked = 1;
+	my %miniserv = &read_config_file($config_file);
+	if (delete($miniserv{"websockets_$ws->{'path'}"})) {
+		&write_file($config_file, \%miniserv);
+		$deleted = 1;
+		}
+	1;
+	};
+my $cleanup_err = $@;
+eval { &unlock_config_file($config_file) } if ($locked);
+if (!$cleanup_ok) {
+	&log_error("Failed to cleanup linked websocket route", $cleanup_err);
+	return 0;
+	}
+# The master keeps websocket routes parsed in memory.
+kill('USR1', $miniserv_main_pid || getppid()) if ($deleted);
+return $deleted;
+}
+
+# get_system_hostname()
+# Returns the hostname of this system, for reporting to listeners
+sub get_system_hostname
+{
+# On Windows, try computername environment variable
+return $ENV{'computername'} if ($ENV{'computername'});
+return $ENV{'COMPUTERNAME'} if ($ENV{'COMPUTERNAME'});
+
+# If a specific command is set, use it first
+if ($config{'hostname_command'}) {
+	local $out = `($config{'hostname_command'}) 2>&1`;
+	if (!$?) {
+		$out =~ s/\r|\n//g;
+		return $out;
+		}
+	}
+
+# First try the hostname command
+local $out = `hostname 2>&1`;
+if (!$? && $out =~ /\S/) {
+	$out =~ s/\r|\n//g;
+	return $out;
+	}
+
+# Try the Sys::Hostname module
+eval "use Sys::Hostname";
+if (!$@) {
+	local $rv = eval "hostname()";
+	if (!$@ && $rv) {
+		return $rv;
+		}
+	}
+
+# Must use net name on Windows
+local $out = `net name 2>&1`;
+if ($out =~ /\-+\r?\n(\S+)/) {
+	return $1;
+	}
+
+return undef;
+}
+
+# indexof(string, array)
+# Returns the index of some value in an array, or -1
+sub indexof {
+  local($i);
+  for($i=1; $i <= $#_; $i++) {
+    if ($_[$i] eq $_[0]) { return $i - 1; }
+  }
+  return -1;
+}
+
+
+# has_command(command)
+# Returns the full path if some command is in the path, undef if not
+sub has_command
+{
+local($d);
+if (!$_[0]) { return undef; }
+if (exists($has_command_cache{$_[0]})) {
+	return $has_command_cache{$_[0]};
+	}
+local $rv = undef;
+if ($_[0] =~ /^\//) {
+	$rv = -x $_[0] ? $_[0] : undef;
+	}
+else {
+	local $sp = $on_windows ? ';' : ':';
+	foreach $d (split($sp, $ENV{PATH})) {
+		if (-x "$d/$_[0]") {
+			$rv = "$d/$_[0]";
+			last;
+			}
+		if ($on_windows) {
+			foreach my $sfx (".exe", ".com", ".bat") {
+				if (-r "$d/$_[0]".$sfx) {
+					$rv = "$d/$_[0]".$sfx;
+					last;
+					}
+				}
+			}
+		}
+	}
+$has_command_cache{$_[0]} = $rv;
+return $rv;
+}
+
+# check_sudo_permissions(user, pass)
+# Returns 1 if some user can run any command via sudo
+sub check_sudo_permissions
+{
+local ($user, $pass) = @_;
+
+# First try the cache stored by the main process
+if ($PASSINw) {
+	print DEBUG "check_sudo_permissions: querying cache for $user\n";
+	print $PASSINw "readsudo $user\n";
+	local $can = <$PASSOUTr>;
+	chop($can);
+	print DEBUG "check_sudo_permissions: cache said $can\n";
+	if ($can =~ /^\d+$/ && $can != 2) {
+		return int($can);
+		}
+	}
+
+# Setup pipes for communication with the sudo sub-process
+pipe(SUDOINr, SUDOINw);
+pipe(SUDOOUTr, SUDOOUTw);
+print DEBUG "check_sudo_permissions\n";
+
+my @uinfo = getpwnam($user);
+if (!@uinfo) {
+	&log_error("Unix user $user does not exist for sudo");
+	return 0;
+	}
+
+my $pid = fork();
+print DEBUG "check_sudo_permissions: fork=$pid pid=$$\n";
+if ($pid < 0) {
+	&log_error("fork for sudo failed : $!");
+	return 0;
+	}
+if (!$pid) {
+	setsid();
+	($(, $)) = ( $uinfo[3],
+                     "$uinfo[3] ".join(" ", $uinfo[3],
+                                            &other_groups($uinfo[0])) );
+	($>, $<) = ($uinfo[2], $uinfo[2]);
+	$ENV{'USER'} = $ENV{'LOGNAME'} = $user;
+	$ENV{'HOME'} = $uinfo[7];
+
+	close(STDIN); close(STDOUT); close(STDERR);
+	untie(*STDIN); untie(*STDOUT); untie(*STDERR);
+	close(SUDOINw); close(SUDOOUTr);
+	close(SOCK);
+	close(MAIN);
+	open(STDIN, "<&SUDOINr");
+	open(STDOUT, ">&SUDOOUTw");
+	open(STDERR, ">&STDOUT");
+	exec("sudo -l -S");
+	print "Exec failed : $!\n";
+	exit 1;
+	}
+print DEBUG "check_sudo_permissions: pid=$pid\n";
+close(SUDOINr);
+close(SUDOOUTw);
+
+# Send password, and get back response
+my $oldfh = select(SUDOINw);
+$| = 1;
+select($oldfh);
+print DEBUG "check_sudo_permissions: about to send pass\n";
+local $SIG{'PIPE'} = 'ignore';	# Sometimes sudo doesn't ask for a password
+print SUDOINw $pass,"\n";
+print DEBUG "check_sudo_permissions: sent pass=$pass\n";
+close(SUDOINw);
+my $out;
+while(<SUDOOUTr>) {
+	print DEBUG "check_sudo_permissions: got $_";
+	$out .= $_;
+	}
+close(SUDOOUTr);
+kill('KILL', $pid);
+waitpid($pid, 0);
+local ($ok) = ($out =~ /\(ALL\)\s+ALL|\(ALL\)\s+NOPASSWD:\s+ALL|\(ALL\s*:\s*ALL\)\s+ALL|\(ALL\s*:\s*ALL\)\s+NOPASSWD:\s+ALL/ ? 1 : 0);
+
+# Update cache
+if ($PASSINw) {
+	print $PASSINw "writesudo $user $ok\n";
+	}
+
+return $ok;
+}
+
+sub other_groups
+{
+my ($user) = @_;
+my @rv;
+setgrent();
+while(my @g = getgrent()) {
+        my @m = split(/\s+/, $g[3]);
+        push(@rv, $g[2]) if (&indexof($user, @m) >= 0);
+        }
+endgrent();
+return @rv;
+}
+
+# is_mobile_useragent(agent)
+# Returns 1 if some user agent looks like a cellphone or other mobile device,
+# such as a treo.
+sub is_mobile_useragent
+{
+local ($agent) = @_;
+local @prefixes = (
+    "UP.Link",    # Openwave
+    "Nokia",      # All Nokias start with Nokia
+    "MOT-",       # All Motorola phones start with MOT-
+    "SAMSUNG",    # Samsung browsers
+    "Samsung",    # Samsung browsers
+    "SEC-",       # Samsung browsers
+    "AU-MIC",     # Samsung browsers
+    "AUDIOVOX",   # Audiovox
+    "BlackBerry", # BlackBerry
+    "hiptop",     # Danger hiptop Sidekick
+    "SonyEricsson", # Sony Ericsson
+    "Ericsson",     # Old Ericsson browsers , mostly WAP
+    "Mitsu/1.1.A",  # Mitsubishi phones
+    "Panasonic WAP", # Panasonic old WAP phones
+    "DoCoMo",     # DoCoMo phones
+    "Lynx",	  # Lynx text-mode linux browser
+    "Links",	  # Another text-mode linux browser
+    "Dalvik",	  # Android browser
+    );
+local @substrings = (
+    "UP.Browser",         # Openwave
+    "MobilePhone",        # NetFront
+    "AU-MIC-A700",        # Samsung A700 Obigo browsers
+    "Danger hiptop",      # Danger Sidekick hiptop
+    "Windows CE",         # Windows CE Pocket PC
+    "IEMobile",           # Windows mobile browser
+    "Blazer",             # Palm Treo Blazer
+    "BlackBerry",         # BlackBerries can emulate other browsers, but
+                          # they still keep this string in the UserAgent
+    "SymbianOS",          # New Series60 browser has safari in it and
+                          # SymbianOS is the only distinguishing string
+    "iPhone",		  # Apple iPhone KHTML browser
+    "iPod",		  # iPod touch browser
+    "MobileSafari",	  # HTTP client in iPhone
+    "Mobile Safari",	  # Samsung Galaxy S6 browser
+    "Opera Mini",	  # Opera Mini
+    "HTC_P3700",	  # HTC mobile device
+    "Pre/",		  # Palm Pre
+    "webOS/",		  # Palm WebOS
+    "Nintendo DS",	  # DSi / DSi-XL
+    );
+local @regexps = (
+    "Android.*Mobile",	  # Android phone
+    );
+foreach my $p (@prefixes) {
+	return 1 if ($agent =~ /^\Q$p\E/);
+	}
+foreach my $s (@substrings, @mobile_agents) {
+	return 1 if ($agent =~ /\Q$s\E/);
+	}
+foreach my $s (@regexps) {
+	return 1 if ($agent =~ /$s/);
+	}
+return 0;
+}
+
+# write_blocked_file()
+# Writes out a text file of blocked hosts and users
+sub write_blocked_file
+{
+open(BLOCKED, ">$config{'blockedfile'}");
+foreach my $d (grep { $hostfail{$_} } @deny) {
+	print BLOCKED "host $d $hostfail{$d} $blockhosttime{$d}\n";
+	}
+foreach my $d (grep { $userfail{$_} } @denyusers) {
+	print BLOCKED "user $d $userfail{$d} $blockusertime{$d}\n";
+	}
+close(BLOCKED);
+chmod(0700, $config{'blockedfile'});
+}
+
+sub write_pid_file
+{
+open(PIDFILE, ">$config{'pidfile'}");
+printf PIDFILE "%d\n", getpid();
+close(PIDFILE);
+$miniserv_main_pid = getpid();
+}
+
+# lock_user_password(user)
+# Updates a user's password file entry to lock it, both in memory and on disk.
+# Returns 1 if done, -1 if no such user, 0 if already locked
+sub lock_user_password
+{
+local ($user) = @_;
+local $uinfo = &get_user_details($user);
+if (!$uinfo) {
+	# No such user!
+	return -1;
+	}
+if ($uinfo->{'pass'} =~ /^\!/) {
+	# Already locked
+	return 0;
+	}
+if (!$uinfo->{'proto'}) {
+	# Write to users file
+	$users{$user} = "!".$users{$user};
+	open(USERS, $config{'userfile'});
+	local @ufile = <USERS>;
+	close(USERS);
+	foreach my $u (@ufile) {
+		local @uinfo = split(/:/, $u);
+		if ($uinfo[0] eq $user) {
+			$uinfo[1] = $users{$user};
+			}
+		$u = join(":", @uinfo);
+		}
+	open(USERS, ">$config{'userfile'}");
+	print USERS @ufile;
+	close(USERS);
+	return 0;
+	}
+
+if ($config{'userdb'}) {
+	# Update user DB
+	my ($dbh, $proto, $prefix, $args) = &connect_userdb($config{'userdb'});
+	if (!$dbh) {
+		return -1;
+		}
+	elsif ($proto eq "mysql" || $proto eq "postgresql") {
+		# Update user attribute
+		my $cmd = $dbh->prepare(
+			"update webmin_user set pass = ? where id = ?");
+		if (!$cmd || !$cmd->execute("!".$uinfo->{'pass'},
+					    $uinfo->{'id'})) {
+			# Update failed
+			&log_error("Failed to lock password : ",
+				     $dbh->errstr);
+			return -1;
+			}
+		$cmd->finish() if ($cmd);
+		}
+	elsif ($proto eq "ldap") {
+		# Update LDAP object
+		my $rv = $dbh->modify($uinfo->{'id'},
+		      replace => { 'webminPass' => '!'.$uinfo->{'pass'} });
+		if (!$rv || $rv->code) {
+			&log_error("Failed to lock password : ",
+				     ($rv ? $rv->error : "Unknown error"));
+			return -1;
+			}
+		}
+	&disconnect_userdb($config{'userdb'}, $dbh);
+	return 0;
+	}
+
+return -1;	# This should never be reached
+}
+
+# hash_session_id(sid)
+# Returns a keyed hash of a session ID, used as the lookup key in the
+# session DBM. HMAC-SHA256 with a per-install secret is preferred; the
+# legacy MD5 / Unix crypt paths remain only as fallbacks for systems that
+# lack Digest::SHA.
+sub hash_session_id
+{
+local ($sid) = @_;
+if (!$hash_session_id_cache{$sid}) {
+	if ($use_hmac_sha256 && $session_hmac_key) {
+		$hash_session_id_cache{$sid} =
+			Digest::SHA::hmac_sha256_hex($sid, $session_hmac_key);
+		}
+	elsif ($use_md5) {
+		# Take MD5 hash
+		$hash_session_id_cache{$sid} = &encrypt_md5($sid);
+		}
+	else {
+		# Unix crypt
+		$hash_session_id_cache{$sid} = &unix_crypt($sid, "XX");
+		}
+	}
+return $hash_session_id_cache{$sid};
+}
+
+# load_session_secret()
+# Reads a per-install HMAC key from $config{'session_keyfile'}, or generates
+# a new 32-byte key from /dev/urandom and writes it with mode 0600 if the
+# file is missing. Sets $session_hmac_key. Idempotent across config reloads.
+sub load_session_secret
+{
+my $kf = $config{'session_keyfile'};
+return if (!$kf);
+my $oldumask = umask(0077);
+if (-r $kf) {
+	chmod(0600, $kf);
+	if (open(my $fh, "<", $kf)) {
+		binmode($fh);
+		local $/;
+		$session_hmac_key = <$fh>;
+		close($fh);
+		}
+	}
+if (!$session_hmac_key || length($session_hmac_key) < 16) {
+	my $key;
+	if (open(my $rh, "<", "/dev/urandom")) {
+		binmode($rh);
+		read($rh, $key, 32);
+		close($rh);
+		}
+	if (!$key || length($key) < 32) {
+		# /dev/urandom unusable; fall back to a hashed mix of
+		# Perl's rand() and the PID/time. Weaker, but the file
+		# still ends up 0600 and is per-install.
+		my $mix = '';
+		$mix .= pack("N", int(rand(0xffffffff))) for (1..8);
+		$mix .= pack("NN", $$, time());
+		if ($use_hmac_sha256) {
+			$key = Digest::SHA::sha256($mix);
+			}
+		else {
+			$key = $mix;
+			}
+		}
+	if (open(my $wh, ">", $kf)) {
+		binmode($wh);
+		chmod(0600, $kf);
+		print $wh $key;
+		close($wh);
+		$session_hmac_key = $key;
+		}
+	else {
+		&log_error("Failed to write session key file $kf : $!");
+		}
+	}
+umask($oldumask);
+}
+
+# open_session_db()
+# Opens the session DBM with a tight umask, then forces 0600 on the
+# resulting on-disk files so pre-existing loose perms from older installs
+# are corrected. Tries SDBM first, falling back to NDBM.
+sub open_session_db
+{
+my $oldumask = umask(0077);
+eval "use SDBM_File";
+dbmopen(%sessiondb, $config{'sessiondb'}, 0600);
+eval "\$sessiondb{'1111111111'} = 'foo bar';";
+if ($@) {
+	dbmclose(%sessiondb);
+	eval "use NDBM_File";
+	dbmopen(%sessiondb, $config{'sessiondb'}, 0600);
+	}
+else {
+	delete($sessiondb{'1111111111'});
+	}
+foreach my $f (glob("$config{'sessiondb'}*")) {
+	chmod(0600, $f);
+	}
+umask($oldumask);
+}
+
+# encrypt_md5(string, [salt])
+# Returns a string encrypted in MD5 format
+sub encrypt_md5
+{
+local ($passwd, $salt) = @_;
+local $magic = '$1$';
+if ($salt =~ /^\$1\$([^\$]+)/) {
+	# Extract actual salt from already encrypted password
+	$salt = $1;
+	}
+
+# Add the password
+local $ctx = eval "new $use_md5";
+$ctx->add($passwd);
+if ($salt) {
+	$ctx->add($magic);
+	$ctx->add($salt);
+	}
+
+# Add some more stuff from the hash of the password and salt
+local $ctx1 = eval "new $use_md5";
+$ctx1->add($passwd);
+if ($salt) {
+	$ctx1->add($salt);
+	}
+$ctx1->add($passwd);
+local $final = $ctx1->digest();
+for($pl=length($passwd); $pl>0; $pl-=16) {
+	$ctx->add($pl > 16 ? $final : substr($final, 0, $pl));
+	}
+
+# This piece of code seems rather pointless, but it's in the C code that
+# does MD5 in PAM so it has to go in!
+local $j = 0;
+local ($i, $l);
+for($i=length($passwd); $i; $i >>= 1) {
+	if ($i & 1) {
+		$ctx->add("\0");
+		}
+	else {
+		$ctx->add(substr($passwd, $j, 1));
+		}
+	}
+$final = $ctx->digest();
+
+if ($salt) {
+	# This loop exists only to waste time
+	for($i=0; $i<1000; $i++) {
+		$ctx1 = eval "new $use_md5";
+		$ctx1->add($i & 1 ? $passwd : $final);
+		$ctx1->add($salt) if ($i % 3);
+		$ctx1->add($passwd) if ($i % 7);
+		$ctx1->add($i & 1 ? $final : $passwd);
+		$final = $ctx1->digest();
+		}
+	}
+
+# Convert the 16-byte final string into a readable form
+local $rv;
+local @final = map { ord($_) } split(//, $final);
+$l = ($final[ 0]<<16) + ($final[ 6]<<8) + $final[12];
+$rv .= &to64($l, 4);
+$l = ($final[ 1]<<16) + ($final[ 7]<<8) + $final[13];
+$rv .= &to64($l, 4);
+$l = ($final[ 2]<<16) + ($final[ 8]<<8) + $final[14];
+$rv .= &to64($l, 4);
+$l = ($final[ 3]<<16) + ($final[ 9]<<8) + $final[15];
+$rv .= &to64($l, 4);
+$l = ($final[ 4]<<16) + ($final[10]<<8) + $final[ 5];
+$rv .= &to64($l, 4);
+$l = $final[11];
+$rv .= &to64($l, 2);
+
+# Add salt if needed
+if ($salt) {
+	return $magic.$salt.'$'.$rv;
+	}
+else {
+	return $rv;
+	}
+}
+
+# unix_crypt_supports_sha512()
+# Returns 1 if the built-in crypt() function can already do SHA512
+sub unix_crypt_supports_sha512
+{
+my $hash = '$6$Tk5o/GEE$zjvXhYf/dr5M7/jan3pgunkNrAsKmQO9r5O8sr/Cr1hFOLkWmsH4iE9hhqdmHwXd5Pzm4ubBWTEjtMeC.h5qv1';
+my $newhash = eval { crypt('test', $hash) };
+return $newhash eq $hash;
+}
+
+# encrypt_sha512(password, [salt])
+# Hashes a password, possibly with the given salt, with SHA512. The salt
+# arg may be a full $6$salt$hash form (verification) or a bare $6$salt$
+# (fresh hashing) — either way it must be passed to crypt() intact so
+# crypt() selects SHA512. Only synthesise a new salt when none is given.
+sub encrypt_sha512
+{
+my ($passwd, $salt) = @_;
+$salt = '$6$'.substr(time(), -8).'$' if (!$salt || $salt !~ /^\$6\$/);
+return crypt($passwd, $salt);
+}
+
+sub to64
+{
+local ($v, $n) = @_;
+local $r;
+while(--$n >= 0) {
+        $r .= $itoa64[$v & 0x3f];
+        $v >>= 6;
+        }
+return $r;
+}
+
+# read_file(file, &assoc, [&order], [lowercase])
+# Fill an associative array with name=value pairs from a file
+sub read_file
+{
+open(ARFILE, $_[0]) || return 0;
+while(<ARFILE>) {
+	s/\r|\n//g;
+        if (!/^#/ && /^([^=]*)=(.*)$/) {
+		$_[1]->{$_[3] ? lc($1) : $1} = $2;
+		push(@{$_[2]}, $1) if ($_[2]);
+	}
+        }
+close(ARFILE);
+return 1;
+}
+
+# write_file(file, array)
+# Write out the contents of an associative array as name=value lines
+sub write_file
+{
+local(%old, @order);
+&read_file($_[0], \%old, \@order);
+open(ARFILE, ">$_[0]");
+foreach $k (@order) {
+        print ARFILE $k,"=",$_[1]->{$k},"\n" if (exists($_[1]->{$k}));
+	}
+foreach $k (keys %{$_[1]}) {
+        print ARFILE $k,"=",$_[1]->{$k},"\n" if (!exists($old{$k}));
+        }
+close(ARFILE);
+}
+
+# execute_ready_webmin_crons(run-count)
+# Find and run any cron jobs that are due, based on their last run time and
+# execution interval
+sub execute_ready_webmin_crons
+{
+my ($runs) = @_;
+my $now = time();
+my $changed = 0;
+foreach my $cron (@webmincrons) {
+	my $run = 0;
+	if ($runs == 0 && $cron->{'boot'}) {
+		# If cron job wants to be run at startup, run it now
+		$run = 1;
+		}
+	elsif ($cron->{'disabled'}) {
+		# Explicitly disabled
+		$run = 0;
+		}
+	elsif (!$webmincron_last{$cron->{'id'}}) {
+		# If not ever run before, don't run right away
+		$webmincron_last{$cron->{'id'}} = $now;
+		$changed = 1;
+		}
+	elsif ($cron->{'interval'} &&
+	       $now - $webmincron_last{$cron->{'id'}} > $cron->{'interval'}) {
+		# Older than interval .. time to run
+		$run = 1;
+		}
+	elsif ($cron->{'mins'} ne '') {
+		# Check if current time matches spec, and we haven't run in the
+		# last minute
+		my @tm = localtime($now);
+		if (&matches_cron($cron->{'mins'}, $tm[1], 0) &&
+		    &matches_cron($cron->{'hours'}, $tm[2], 0) &&
+		    &matches_cron($cron->{'days'}, $tm[3], 1) &&
+		    &matches_cron($cron->{'months'}, $tm[4]+1, 1) &&
+		    &matches_cron($cron->{'weekdays'}, $tm[6], 0) &&
+		    $now - $webmincron_last{$cron->{'id'}} > 60) {
+			$run = 1;
+			}
+		}
+
+	if ($run) {
+		print DEBUG "Running cron id=$cron->{'id'} ".
+			    "module=$cron->{'module'} func=$cron->{'func'} ".
+			    "arg0=$cron->{'arg0'}\n";
+		$webmincron_last{$cron->{'id'}} = $now;
+		$changed = 1;
+		my $pid = &execute_webmin_command($config{'webmincron_wrapper'},
+						  [ $cron ]);
+		push(@childpids, $pid);
+		}
+	}
+if ($changed) {
+	# Write out file containing last run times
+	&write_file($config{'webmincron_last'}, \%webmincron_last);
+	}
+}
+
+# matches_cron(cron-spec, time, first-value)
+# Checks if some minute or hour matches some cron spec, which can be * or a list
+# of numbers.
+sub matches_cron
+{
+my ($spec, $tm, $first) = @_;
+if ($spec eq '*') {
+	return 1;
+	}
+else {
+	foreach my $s (split(/,/, $spec)) {
+		if ($s == $tm ||
+		    $s =~ /^(\d+)\-(\d+)$/ &&
+		      $tm >= $1 && $tm <= $2 ||
+		    $s =~ /^\*\/(\d+)$/ &&
+		      $tm % $1 == $first ||
+		    $s =~ /^(\d+)\-(\d+)\/(\d+)$/ &&
+		      $tm >= $1 && $tm <= $2 && $tm % $3 == $first) {
+			return 1;
+			}
+		}
+	return 0;
+	}
+}
+
+# read_webmin_crons()
+# Read all scheduled webmin cron functions and store them in the @webmincrons
+# global list
+sub read_webmin_crons
+{
+@webmincrons = ( );
+opendir(CRONS, $config{'webmincron_dir'});
+print DEBUG "Reading crons from $config{'webmincron_dir'}\n";
+foreach my $f (readdir(CRONS)) {
+	if ($f =~ /^(\d+)\.cron$/) {
+		my %cron;
+		&read_file("$config{'webmincron_dir'}/$f", \%cron);
+		$cron{'id'} = $1;
+		my $broken = 0;
+		foreach my $n ('module', 'func') {
+			if (!$cron{$n}) {
+				&log_error("Cron $1 missing $n");
+				$broken = 1;
+				}
+			}
+		if (!$cron{'interval'} && $cron{'mins'} eq '' &&
+		    $cron{'special'} eq '' && !$cron{'boot'}) {
+			&log_error("Cron $1 missing any time spec");
+			$broken = 1;
+			}
+		if ($cron{'special'} eq 'hourly') {
+			# Run every hour on the hour
+			$cron{'mins'} = 0;
+			$cron{'hours'} = '*';
+			$cron{'days'} = '*';
+			$cron{'months'} = '*';
+			$cron{'weekdays'} = '*';
+			}
+		elsif ($cron{'special'} eq 'daily') {
+			# Run every day at midnight
+			$cron{'mins'} = 0;
+			$cron{'hours'} = '0';
+			$cron{'days'} = '*';
+			$cron{'months'} = '*';
+			$cron{'weekdays'} = '*';
+			}
+		elsif ($cron{'special'} eq 'monthly') {
+			# Run every month on the 1st
+			$cron{'mins'} = 0;
+			$cron{'hours'} = '0';
+			$cron{'days'} = '1';
+			$cron{'months'} = '*';
+			$cron{'weekdays'} = '*';
+			}
+		elsif ($cron{'special'} eq 'weekly') {
+			# Run every month on the 1st
+			$cron{'mins'} = 0;
+			$cron{'hours'} = '0';
+			$cron{'days'} = '*';
+			$cron{'months'} = '*';
+			$cron{'weekdays'} = '0';
+			}
+		elsif ($cron{'special'} eq 'yearly' ||
+		       $cron{'special'} eq 'annually') {
+			# Run every year on 1st january
+			$cron{'mins'} = 0;
+			$cron{'hours'} = '0';
+			$cron{'days'} = '1';
+			$cron{'months'} = '1';
+			$cron{'weekdays'} = '*';
+			}
+		elsif ($cron{'special'}) {
+			&log_error("Cron $1 invalid special time $cron{'special'}");
+			$broken = 1;
+			}
+		if ($cron{'special'}) {
+			delete($cron{'special'});
+			}
+		if (!$broken) {
+			print DEBUG "Adding cron id=$cron{'id'} module=$cron{'module'} func=$cron{'func'} arg0=$cron{'arg0'}\n";
+			push(@webmincrons, \%cron);
+			}
+		}
+	}
+closedir(CRONS);
+}
+
+# precache_files()
+# Read into the Webmin cache all files marked for pre-caching
+sub precache_files
+{
+undef(%main::read_file_cache);
+foreach my $g (split(/\s+/, $config{'precache'})) {
+	next if ($g eq "none");
+	foreach my $f (glob("$config{'root'}/$g")) {
+		my @st = stat($f);
+		next if (!@st);
+		$main::read_file_cache{$f} = { };
+		&read_file($f, $main::read_file_cache{$f});
+		$main::read_file_cache_time{$f} = $st[9];
+		}
+	}
+}
+
+# Check if some address is valid IPv4, returns 1 if so.
+sub check_ipaddress
+{
+return $_[0] =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/ &&
+	$1 >= 0 && $1 <= 255 &&
+	$2 >= 0 && $2 <= 255 &&
+	$3 >= 0 && $3 <= 255 &&
+	$4 >= 0 && $4 <= 255;
+}
+
+# Check if some IPv6 address is properly formatted, and returns 1 if so.
+# Kept in sync with web-lib-funcs.pl's copy.
+sub check_ip6address
+{
+my $addr = $_[0];
+my $m = 0;
+
+# Strip an optional /N netmask before splitting. Doing this on the
+# raw string (rather than from the last split element) keeps split()'s
+# trailing-empty accounting intact for inputs like "2001:db8::/32",
+# where the netmask would otherwise hide the trailing "::" shorthand.
+if ($addr =~ s{/(\d+)\z}{}) {
+	$m = $1;
+	}
+return 0 if ($m < 0 || $m > 128);
+
+# Special case for unspecified address (analogous to 0.0.0.0 in IPv4),
+# both bare and with a netmask.
+return 1 if ($addr eq "::");
+
+my @blocks = split(/:/, $addr);
+return 0 if (@blocks == 0);
+
+# Accept the IPv4-in-IPv6 forms (RFC 4291 §2.5.5: "::ffff:N.N.N.N"
+# IPv4-mapped, and the more general "X:X:X:X:X:X:N.N.N.N"). If the
+# last block is a dotted-quad, validate the octets and count it as two
+# 16-bit groups for the overall 8-group ceiling. The leading ":" guard
+# distinguishes IPv4-tailed IPv6 from a bare IPv4 address — callers
+# like ip_match() rely on this sub returning false for "10.0.0.1".
+my $count = scalar(@blocks);
+if ($addr =~ /:/ &&
+    $blocks[-1] =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)\z/) {
+	return 0 if ($1 > 255 || $2 > 255 || $3 > 255 || $4 > 255);
+	$count++;
+	pop(@blocks);
+	}
+return 0 if ($count > 8);
+
+my $empty = 0;
+foreach my $b (@blocks) {
+	return 0 if ($b ne "" && $b !~ /^[0-9a-f]{1,4}$/i);
+	$empty++ if ($b eq "");
+	}
+return 0 if ($empty > 1 && !($addr =~ /^::/ && $empty == 2));
+return 1;
+}
+
+# network_to_address(binary)
+# Given a network address in binary IPv4 or v4 format, return the string form
+sub network_to_address
+{
+local ($addr) = @_;
+if (length($addr) == 4 || !$use_ipv6) {
+	return inet_ntoa($addr);
+	}
+else {
+	return inet_ntop(AF_INET6(), $addr);
+	}
+}
+
+# redirect_stderr_to_log()
+# Re-direct STDERR to error log file
+sub redirect_stderr_to_log
+{
+if ($config{'errorlog'} ne '-') {
+	close(STDERR);
+	open(STDERR, ">>$config{'errorlog'}") ||
+		die "failed to open $config{'errorlog'} : $!";
+	if ($config{'logperms'}) {
+		chmod(oct($config{'logperms'}), $config{'errorlog'});
+		}
+	}
+select(STDERR); $| = 1; select(STDOUT);
+}
+
+# open_debug_to_log([msg])
+# Direct the DEBUG file handle somewhere
+sub open_debug_to_log
+{
+my ($msg) = @_;
+close(DEBUG);
+if ($config{'debuglog'}) {
+	open(DEBUG, ">>$config{'debuglog'}");
+	chmod(0700, $config{'debuglog'});
+	select(DEBUG); $| = 1; select(STDOUT);
+	print DEBUG $msg if ($msg);
+	}
+else {
+	open(DEBUG, ">/dev/null");
+	}
+}
+
+# should_gzip_file(filename)
+# Returns 1 if some path should be gzipped
+sub should_gzip_file
+{
+my ($path) = @_;
+return $path !~ /\.(gif|png|jpg|jpeg|tif|tiff)$/i;
+}
+
+# get_expires_time(path)
+# Given a URL path, return the client-side expiry time in seconds
+sub get_expires_time
+{
+my ($path) = @_;
+foreach my $pe (@expires_paths) {
+	if ($path =~ /$pe->[0]/i) {
+		return $pe->[1];
+		}
+	}
+return $config{'expires'};
+}
+
+sub html_escape
+{
+my ($tmp) = @_;
+$tmp =~ s/&/&amp;/g;
+$tmp =~ s/</&lt;/g;
+$tmp =~ s/>/&gt;/g;
+$tmp =~ s/\"/&quot;/g;
+$tmp =~ s/\'/&#39;/g;
+$tmp =~ s/=/&#61;/g;
+return $tmp;
+}
+
+sub html_strip
+{
+my ($tmp) = @_;
+$tmp =~ s/<[^>]*>//g;
+return $tmp;
+}
+
+# validate_twofactor(username, token, orig-username)
+# Checks if a user's two-factor token is valid or not. Returns undef on success
+# or the error message on failure.
+sub validate_twofactor
+{
+my ($user, $token, $origuser) = @_;
+local $uinfo = &get_user_details($user, $origuser);
+$token =~ s/^\s+//;
+$token =~ s/\s+$//;
+$token || return "No two-factor token entered";
+$uinfo->{'twofactor_provider'} || return undef;
+pipe(TOKENr, TOKENw);
+my $pid = &execute_webmin_command($config{'twofactor_wrapper'},
+	[ $user, $uinfo->{'twofactor_provider'}, $uinfo->{'twofactor_id'},
+	  $token, $uinfo->{'twofactor_apikey'} ],
+	TOKENw);
+close(TOKENw);
+waitpid($pid, 0);
+my $ex = $?;
+my $out = <TOKENr>;
+close(TOKENr);
+if ($ex) {
+	return $out || "Unknown two-factor authentication failure";
+	}
+return undef;
+}
+
+# execute_webmin_command(command, &argv, [stdout-fd])
+# Run some Webmin script in a sub-process, like webmincron.pl
+# Returns the PID of the new process.
+sub execute_webmin_command
+{
+my ($cmd, $argv, $fd) = @_;
+my $pid = fork();
+if (!$pid) {
+	# Run via a wrapper command, which we run like a CGI
+	dbmclose(%sessiondb);
+	if ($fd) {
+		open(STDOUT, ">&$fd");
+		}
+	else {
+		open(STDOUT, ">&STDERR");
+		}
+	&close_all_sockets();
+	&close_all_pipes();
+	close(LISTEN);
+
+	# Setup CGI-like environment
+	$envtz = $ENV{"TZ"};
+	$envuser = $ENV{"USER"};
+	$envpath = $ENV{"PATH"};
+	$envlang = $ENV{"LANG"};
+	$envroot = $ENV{"SystemRoot"};
+	$envperllib = $ENV{'PERLLIB'};
+	foreach my $k (keys %ENV) {
+		delete($ENV{$k});
+		}
+	$ENV{"PATH"} = $envpath if ($envpath);
+	$ENV{"TZ"} = $envtz if ($envtz);
+	$ENV{"USER"} = $envuser if ($envuser);
+	$ENV{"OLD_LANG"} = $envlang if ($envlang);
+	$ENV{"SystemRoot"} = $envroot if ($envroot);
+	$ENV{'PERLLIB'} = $envperllib if ($envperllib);
+	$ENV{"HOME"} = $user_homedir;
+	$ENV{"SERVER_SOFTWARE"} = $config{"server"};
+	$ENV{"SERVER_ADMIN"} = $config{"email"};
+	$root0 = $roots[0];
+	$ENV{"SERVER_ROOT"} = $root0;
+	$ENV{"SERVER_REALROOT"} = $root0;
+	$ENV{"SERVER_PORT"} = $config{'port'};
+	$ENV{"WEBMIN_CRON"} = 1;
+	$ENV{"DOCUMENT_ROOT"} = $root0;
+	$ENV{"THEME_ROOT"} = $root0."/".$config{"preroot"};
+	$ENV{"THEME_DIRS"} = $config{"preroot"} || "";
+	$ENV{"DOCUMENT_REALROOT"} = $root0;
+	$ENV{"MINISERV_CONFIG"} = $config_file;
+	$ENV{"HTTPS"} = "ON" if ($use_ssl);
+	$ENV{"SSL_HSTS"} = $config{"ssl_hsts"};
+	$ENV{"MINISERV_PID"} = $miniserv_main_pid;
+	$ENV{"SCRIPT_FILENAME"} = $cmd;
+	if ($ENV{"SCRIPT_FILENAME"} =~ /^\Q$root0\E(\/.*)$/) {
+		$ENV{"SCRIPT_NAME"} = $1;
+		}
+	$cmd =~ /^(.*)\//;
+	$ENV{"PWD"} = $1;
+	foreach $k (keys %config) {
+		if ($k =~ /^env_(\S+)$/) {
+			$ENV{$1} = $config{$k};
+			}
+		}
+	chdir($ENV{"PWD"});
+	$SIG{'CHLD'} = 'DEFAULT';
+	eval {
+		# Have SOCK closed if the perl exec's something
+		use Fcntl;
+		fcntl(SOCK, F_SETFD, FD_CLOEXEC);
+		};
+
+	# Run the wrapper script by evaling it
+	if ($cmd =~ /\/([^\/]+)\/([^\/]+)$/) {
+		$pkg = $1;
+		}
+	$0 = $cmd;
+	@ARGV = @$argv;
+	$main_process_id = $$;
+	eval "
+		\%pkg::ENV = \%ENV;
+		package $pkg;
+		do \"$cmd\";
+		die \$@ if (\$@);
+		";
+	if ($@) {
+		&log_error("Perl failure : $@");
+		}
+	exit(0);
+	}
+return $pid;
+}
+
+# canonicalize_ip6(address)
+# Converts an address to its full long form. Ie. 2001:db8:0:f101::20 to
+# 2001:0db8:0000:f101:0000:0000:0000:0020
+sub canonicalize_ip6
+{
+my ($addr) = @_;
+return $addr if (!&check_ip6address($addr));
+my @w = split(/:/, $addr, -1);
+my $idx = &indexof("", @w);
+if ($idx >= 0) {
+	# Expand ::
+	my $endidx = $idx;
+	while($endidx+1 < @w && $w[$endidx+1] eq "") {
+		$endidx++;
+		}
+	my $mis = 8 - (scalar(@w) - ($endidx - $idx + 1));
+	my @nw = @w[0..$idx-1];
+	for(my $i=0; $i<$mis; $i++) {
+		push(@nw, 0);
+		}
+	push(@nw, @w[$endidx+1 .. $#w]);
+	@w = @nw;
+	}
+foreach my $w (@w) {
+	while(length($w) < 4) {
+		$w = "0".$w;
+		}
+	}
+return lc(join(":", @w));
+}
+
+# expand_ipv6_bytes(address)
+# Given a canonical IPv6 address, split it into an array of bytes
+sub expand_ipv6_bytes
+{
+my ($addr) = @_;
+my @rv;
+foreach my $w (split(/:/, $addr)) {
+	$w =~ /^(..)(..)$/ || return ( );
+	push(@rv, hex($1), hex($2));
+	}
+return @rv;
+}
+
+# ip6_prefix_match(address, network, prefix)
+# Returns 1 if an IPv6 address is in a network prefix.
+sub ip6_prefix_match
+{
+my ($addr, $network, $prefix) = @_;
+my @addr = &expand_ipv6_bytes(&canonicalize_ip6($addr));
+my @network = &expand_ipv6_bytes(&canonicalize_ip6($network));
+return 0 if (@addr != 16 || @network != 16 || $prefix < 0 || $prefix > 128);
+my $bytes = int($prefix / 8);
+my $bits = $prefix % 8;
+for(my $i=0; $i<$bytes; $i++) {
+	return 0 if ($addr[$i] != $network[$i]);
+	}
+if ($bits) {
+	my $mask = (0xff << (8 - $bits)) & 0xff;
+	return 0 if (($addr[$bytes] & $mask) != ($network[$bytes] & $mask));
+	}
+return 1;
+}
+
+sub get_somaxconn
+{
+return defined(&SOMAXCONN) ? SOMAXCONN : 128;
+}
+
+sub is_bad_header
+{
+my ($value, $name) = @_;
+return $value =~ /^\s*\(\s*\)\s*\{/ ? 1 : 0;
+}
+
+# sysread_line(fh)
+# Read a line from a file handle, using sysread to get a byte at a time
+sub sysread_line
+{
+local ($fh) = @_;
+local $line;
+while(1) {
+	local ($buf, $got);
+	$got = sysread($fh, $buf, 1);
+	last if ($got <= 0);
+	$line .= $buf;
+	last if ($buf eq "\n");
+	}
+return $line;
+}
+
+# getenv(env_key)
+# Returns env var disregard of case
+sub getenv
+{
+my ($key) = @_;
+return $ENV{ uc($key) } || $ENV{ lc($key) };
+}
+
+# open_socket(host, port, filehandle)
+# Connect to a TCP port on some host. Returns undef on success, or an error
+# message on failure.
+sub open_socket
+{
+my ($host, $port, $fh) = @_;
+
+# Lookup all IPv4 and v6 addresses for the host
+my @ips = &to_ipaddress($host);
+push(@ips, &to_ip6address($host));
+if (!@ips) {
+	return "Failed to lookup IP address for $host";
+	}
+
+# Try each of the resolved IPs
+my $msg;
+my $proto = getprotobyname("tcp");
+foreach my $ip (@ips) {
+	$msg = undef;
+	if (&check_ipaddress($ip)) {
+		# Create IPv4 socket and connection
+		if (!socket($fh, PF_INET(), SOCK_STREAM, $proto)) {
+			$msg = "Failed to create socket : $!";
+			next;
+			}
+		my $addr = inet_aton($ip);
+		if ($gconfig{'bind_proxy'}) {
+			# BIND to outgoing IP
+			if (!bind($fh, pack_sockaddr_in(0, inet_aton($bindip)))) {
+				$msg = "Failed to bind to source address : $!";
+				next;
+				}
+			}
+		if (!connect($fh, pack_sockaddr_in($port, $addr))) {
+			$msg = "Failed to connect to $host:$port : $!";
+			next;
+			}
+		}
+	else {
+		# Create IPv6 socket and connection
+		if (!&supports_ipv6()) {
+			$msg = "IPv6 connections are not supported";
+			next;
+			}
+		if (!socket($fh, PF_INET6(), SOCK_STREAM, $proto)) {
+			$msg = "Failed to create IPv6 socket : $!";
+			next;
+			}
+		my $addr = inet_pton(AF_INET6(), $ip);
+		if (!connect($fh, pack_sockaddr_in6($port, $addr))) {
+			$msg = "Failed to IPv6 connect to $host:$port : $!";
+			next;
+			}
+		}
+	last;	# If we got this far, it worked
+	}
+if ($msg) {
+	# Last attempt failed
+	return $msg;
+	}
+
+# Disable buffering
+my $old = select($fh);
+$| = 1;
+select($old);
+return undef;
+}
+
+# Returns server information in headers
+sub server_info
+{
+my $sig = $config{'server_sig'};
+if (!$sig) {
+	$sig =
+		$session_id ?
+			$config{'server'} : "MiniServ";
+	}
+return $sig;
+}
+
+=head2 cert_names($file)
+
+Extract Common Name and Subject Alternative Names from an X.509 certificate
+file. Supports both PEM and DER certificates. Returns undef if file cannot be
+read or parsed. Cache results for speed.
+
+=cut
+sub cert_names
+{
+my ($file) = @_;
+return $cert_names_cache{$file} if ($cert_names_cache{$file});
+return undef if (!$file || !-r $file);
+my %rv;
+my $cert;
+
+# Try PEM first
+eval {
+	my $bio = Net::SSLeay::BIO_new_file($file, 'r');
+	if ($bio) {
+		$cert = Net::SSLeay::PEM_read_bio_X509($bio);
+		Net::SSLeay::BIO_free($bio);
+		}
+	};
+
+# Try DER if PEM failed
+if (!$cert) {
+	eval {
+		my $bio = Net::SSLeay::BIO_new_file($file, 'rb');
+		if ($bio) {
+			$cert = Net::SSLeay::d2i_X509_bio($bio);
+			Net::SSLeay::BIO_free($bio);
+			}
+		};
+	}
+
+# Certificate not found
+return undef if !$cert;
+
+# Subject
+my $subject = Net::SSLeay::X509_get_subject_name($cert);
+if ($subject) {
+	# commonName
+	my $cn = Net::SSLeay::X509_NAME_get_text_by_NID($subject, 13);
+	$rv{cn} = $cn if defined $cn && $cn ne '' && $cn ne '-1';
+	}
+
+# subjectAltName
+my @alts = Net::SSLeay::X509_get_subjectAltNames($cert);
+if (@alts) {
+	my @dns;
+	while (my ($type, $val) = splice(@alts, 0, 2)) {
+		push @dns, $val if $type == 2;
+		}
+	$rv{alt} = \@dns if @dns;
+	}
+
+Net::SSLeay::X509_free($cert);
+$cert_names_cache{$file} = \%rv;
+return \%rv;
+}
+
+# ssl_hostname_match(hostname, &hosts-list)
+# Does a hostname match a list of hostnames for an SSL cert?
+sub ssl_hostname_match
+{
+my ($h, $hosts) = @_;
+$h =~ s/:\d+$//;
+foreach my $p (@$hosts) {
+	return 1 if (lc($p) eq lc($h));
+	return 1 if ($p =~ /^\*\.(\S+)$/ &&
+		     (lc($h) eq lc($1) || $h =~ /^([^\.]+)\.\Q$1\E$/i));
+	return 2 if ($p eq "*");
+	}
+return 0;
+}
+
+# check_websocket_backend_ssl(ssl-handle, host)
+# Returns an error if the websocket backend certificate is not for host.
+sub check_websocket_backend_ssl
+{
+my ($ssl, $host) = @_;
+if ($host =~ /^\[([^\]]+)\](?::\d+)?$/) {
+	$host = $1;
+	}
+elsif ($host =~ /^([^:]+):\d+$/) {
+	$host = $1;
+	}
+my $cert = Net::SSLeay::get_peer_certificate($ssl);
+return "Could not fetch peer certificate" if (!$cert);
+my @hosts;
+my $subject = Net::SSLeay::X509_get_subject_name($cert);
+if ($subject) {
+	my $cn = Net::SSLeay::X509_NAME_get_text_by_NID($subject, 13);
+	push(@hosts, $cn) if (defined($cn) && $cn ne "" && $cn ne "-1");
+	}
+my @alts = Net::SSLeay::X509_get_subjectAltNames($cert);
+while(my ($type, $val) = splice(@alts, 0, 2)) {
+	push(@hosts, $val) if ($type == 2 || $type == 7);
+	}
+Net::SSLeay::X509_free($cert);
+if (&check_ipaddress($host) || &check_ip6address($host)) {
+	return undef if (grep { lc($_) eq lc($host) } @hosts);
+	return @hosts ? "Certificate is for ".join(", ", @hosts).", not $host"
+		      : "No certificate names found";
+	}
+return undef if (@hosts && &ssl_hostname_match($host, \@hosts));
+return @hosts ? "Certificate is for ".join(", ", @hosts).", not $host"
+	      : "No certificate names found";
+}
+
+1;
diff --git a/miniserv.pl b/miniserv.pl
index 8cd462de8..da05d0e7f 100755
--- a/miniserv.pl
+++ b/miniserv.pl
@@ -1,26 +1,13 @@
 #!/usr/local/bin/perl
 # A very simple perl web server used by Webmin
 
-# Require basic libraries
 package miniserv;
-use Socket;
-use POSIX;
-use Time::Local;
-eval "use Time::HiRes;";
 
-@itoa64 = split(//, "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz");
-@miniserv_argv = @ARGV;
-
-# init days and months for http_date
-@weekday = ( "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" );
-@month = ( "Jan", "Feb", "Mar", "Apr", "May", "Jun",
-	   "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" );
-
-# Only run the server logic when invoked as a script. When loaded as a
-# module (e.g. for unit tests) all subs below remain callable, but none
-# of the config-driven setup, socket binding, forking or accept loop
-# fires.
-unless (caller) {
+use FindBin;
+use lib $FindBin::Bin;
+BEGIN {
+	require 'miniserv-lib.pl';
+	}
 
 # Find and read config file
 if ($ARGV[0] eq "--nofork") {
@@ -1301,6550 +1288,3 @@ while(1) {
 	@passin = grep { defined($_) } @passin;
 	@passout = grep { defined($_) } @passout;
 	}
-
-} # end of unless (caller)
-
-# handle_request(remoteaddress, localaddress, ipv6-flag)
-# Where the real work is done
-sub handle_request
-{
-local ($acptip, $localip, $ipv6) = @_;
-seek(DEBUG, 0, 2);
-print DEBUG "handle_request: from $acptip to $localip ipv6=$ipv6\n";
-if ($config{'loghost'}) {
-	$acpthost = &to_hostname($acptip);
-	$acpthost = $acptip if (!$acpthost);
-	}
-else {
-	$acpthost = $acptip;
-	}
-$loghost = $acpthost;
-$datestr = &http_date(time());
-$ok_code = 200;
-$ok_message = "Document follows";
-$logged_code = undef;
-$reqline = $request_uri = $page = undef;
-$authuser = undef;
-$validated = undef;
-
-# Reset all per-request state. Keep-alive lets one child handle many
-# requests on one TCP connection; behind a proxy that pools backend
-# connections, those requests can be from different clients. Anything
-# left set from the prior request would leak across that boundary -
-# most dangerously $baseauthuser, which feeds BASE_REMOTE_USER and the
-# Webmin ACL layer.
-$baseauthuser = undef;
-$authpass = undef;
-$session_id = undef;
-$already_session_id = undef;
-$already_authuser = undef;
-$miniserv_internal = undef;
-$querystring = undef;
-$queryargs = undef;
-$pathinfo = undef;
-$peername = undef;
-$uinfo = undef;
-$scriptname = undef;
-$cgi_pwd = undef;
-$full = undef;
-$realroot = undef;
-$foundroot = undef;
-$is_directory = undef;
-$nph_script = undef;
-$logout = undef;
-$failed_user = undef;
-$failed_save = undef;
-$twofactor_msg = undef;
-$timed_out = undef;
-$error_handler_recurse = undef;
-%cgiheader = ();
-@cgiheader = ();
-$doneheaders = undef;
-$headers = undef;
-@stfull = ();
-# Reset logout-triggered auth suppression and any partial POST body
-# count before handling the next request on this connection.
-$deny_authentication = undef;
-$clen_read = 0;
-# Restore $host/$port to socket defaults; the Host: header overwrite
-# below should not persist if the next request omits Host.
-local $host = $host;
-local $port = $port;
-# Scope per-request mutation of %config so it cannot leak to later
-# requests on this connection (see $config{'session'} = 0 below).
-local $config{'session'} = $config{'session'};
-
-# check address against access list
-if (@deny && &ip_match($acptip, $localip, @deny) ||
-    @allow && !&ip_match($acptip, $localip, @allow)) {
-	&http_error(403, "Access denied for ".&html_strip($acptip));
-	return 0;
-	}
-
-if ($use_libwrap) {
-	# Check address with TCP-wrappers
-	if (!hosts_ctl($config{'pam'}, STRING_UNKNOWN,
-		       $acptip, STRING_UNKNOWN)) {
-		&http_error(403, "Access denied for ".&html_strip($acptip).
-				 " by TCP wrappers");
-		return 0;
-		}
-	}
-print DEBUG "handle_request: passed IP checks\n";
-
-# Compute a timeout for the start of headers, based on the number of
-# child processes. As this increases, we use a shorter timeout to avoid
-# an attacker overloading the system.
-local $header_timeout = 60 + ($config{'maxconns'} - @childpids) * 10;
-if ($header_timeout > 10*60) {
-	$header_timeout = 10*60;
-	}
-
-local $rmask;
-vec($rmask, fileno(SOCK), 1) = 1;
-local $to = $checked_timeout ? 10*60 : $header_timeout;
-print DEBUG "handle_request: waiting for $to seconds\n";
-local $sel = select($rmask, undef, undef, $to);
-if (!$sel) {
-	if ($checked_timeout) {
-		print DEBUG "handle_request: exiting due to timeout of $to\n";
-		exit;
-		}
-	else {
-		&http_error(400, "Timeout",
-			    "Waited for $to seconds for start of headers");
-		}
-	}
-$checked_timeout++;
-print DEBUG "handle_request: passed timeout check\n";
-
-# Read the HTTP request line
-alarm(10);
-$SIG{'ALRM'} = sub { die "timeout" };
-local $origreqline = &read_line();
-($reqline = $origreqline) =~ s/\r|\n//g;
-$method = $page = $request_uri = undef;
-print DEBUG "handle_request reqline=$reqline\n";
-alarm(0);
-if (!$use_ssl && $config{'ssl'} && $config{'ssl_enforce'}) {
-	# This is an HTTP request when HTTPS should be enforced
-	my $musthost = $config{'musthost'};
-	my $hostheader;
-	if (!$musthost) {
-		# Read host HTTP header because we want one earlier
-		alarm(10);
-		local $SIG{'ALRM'} = sub { die "timeout" };
-		while (defined(my $line = &read_line())) {
-			$line =~ s/\r|\n//g;
-			last if $line eq '';
-			if ($line =~ /^host:\s*(.*)$/i) {
-				$hostheader = "https://$1";
-				last;
-				}
-			}
-		alarm(0);
-		}
-	# Host header must already contain full URL
-	my $url = $hostheader;
-	if (!$url) {
-		# No host header
-		local $urlhost = $musthost || $host;
-		$urlhost = "[".$urlhost."]" if (&check_ip6address($urlhost));
-		local $wantport = $port;
-		if ($wantport == 80 &&
-		&indexof(443, @listening_on_ports) >= 0) {
-			# Connection was to port 80, but since we are also
-			# accepting on port 443, redirect to that
-			$wantport = 443;
-			}
-		$url = $wantport == 443
-			? "https://$urlhost/"
-			: "https://$urlhost:$wantport/";
-		}
-	# Enforce HTTPS
-	&write_data("HTTP/1.0 302 Moved Temporarily\r\n");
-	&write_data("Date: $datestr\r\n");
-	&write_data("Server: @{[&server_info()]}\r\n");
-	&write_data("Location: $url\r\n");
-	&write_keep_alive(0);
-	&write_data("\r\n");
-	&log_error("Redirecting HTTP request to $url");
-	&log_request($loghost, $authuser, $reqline, 302, 0);
-	return 0;
-	}
-elsif (!$reqline && $checked_timeout > 1) {
-	# An empty request .. just close the connection
-	print DEBUG "handle_request: rejecting empty request\n";
-	return 0;
-	}
-elsif ($reqline && $reqline !~ /^(\S+)\s+(.*)\s+HTTP\/1\..$/) {
-	&http_error(400, "Bad Request");
-	return 0;
-	}
-$method = $1;
-$request_uri = $page = $2;
-%header = ();
-
-# Read HTTP headers
-alarm(60);
-$SIG{'ALRM'} = sub { die "timeout" };
-local $lastheader;
-while(1) {
-	($headline = &read_line()) =~ s/\r|\n//g;
-	last if ($headline eq "");
-	print DEBUG "handle_request: got headline $headline\n";
-	if ($headline =~ /^(\S+):\s*(.*)$/) {
-		$header{$lastheader = lc($1)} = $2;
-		}
-	elsif ($headline =~ /^\s+(.*)$/) {
-		$header{$lastheader} .= $headline;
-		}
-	else {
-		alarm(0);
-		&http_error(400, "Bad Header ".&html_strip($headline));
-		}
-	if (&is_bad_header($header{$lastheader}, $lastheader)) {
-		alarm(0);
-		delete($header{$lastheader});
-		&http_error(400, "Bad Header Contents ".
-				 &html_strip($lastheader));
-		}
-	}
-alarm(0);
-my $websocket_upgrade_request = lc($header{'connection'}) =~ /upgrade/ &&
-				lc($header{'upgrade'}) eq 'websocket';
-my $websocket_configured_request;
-my $websocket_basic_auth_ok;
-if ($websocket_upgrade_request) {
-	# Check the configured websocket paths before auth, so Basic auth can
-	# remain disabled for normal session-mode requests.
-	my $wsbogus;
-	my $ws_simple = &simplify_path($page, $wsbogus);
-	$websocket_configured_request = !$wsbogus &&
-					&find_websocket_config($ws_simple);
-	if ($websocket_configured_request) {
-		# Session-mode Basic auth stays disabled unless the websocket
-		# route explicitly allows a no-cookie Basic-auth hop.
-		$websocket_basic_auth_ok =
-			$websocket_configured_request->{'allow_basic_ws'};
-		}
-	}
-
-# If a remote IP is given in a header (such as via a proxy), only use it
-# for logging unless trust_real_ip is set
-local $headerhost = $header{'x-forwarded-for'} ||
-		    $header{'x-real-ip'} ||
-		    $header{'true-client-ip'} ||
-		    $header{'cf-connecting-ip'} ||
-		    $header{'cf-connecting-ip6'};
-if ($headerhost) {
-	# Only real IPs are allowed
-	$headerhost = undef if (!&check_ipaddress($headerhost) &&
-				!&check_ip6address($headerhost));
-	}
-# If trusted_proxies is configured, header-supplied client IP and SSL
-# client info are only honored when the direct TCP peer is in that list.
-# Otherwise drop them so an attacker reaching miniserv directly cannot
-# spoof X-Forwarded-For or X-SSL-Client-* to bypass auth.
-if ($config{'trust_real_ip'} && $config{'trusted_proxies'} ne '' &&
-    !&ip_match($acptip, $localip,
-	       split(/\s+/, $config{'trusted_proxies'}))) {
-	print DEBUG "handle_request: peer $acptip not in trusted_proxies; ".
-		    "ignoring forwarding and SSL client headers\n";
-	$headerhost = undef;
-	delete $header{'x-ssl-client-dn'};
-	delete $header{'x-ssl-client-verify'};
-	}
-if ($config{'trust_real_ip'}) {
-	$acpthost = $headerhost || $acpthost;
-	if (&check_ipaddress($headerhost) || &check_ip6address($headerhost)) {
-		# If a remote IP was given, use it for all access control checks
-		# from now on.
-		$acptip = $headerhost;
-		
-		# re-check remote address against access list
-		if (@deny && &ip_match($acptip, $localip, @deny) ||
-		    @allow && !&ip_match($acptip, $localip, @allow)) {
-			&http_error(403, "Access denied for ".&html_strip($acptip));
-			return 0;
-			}
-		
-		if ($use_libwrap) {
-			# Check address with TCP-wrappers
-			if (!hosts_ctl($config{'pam'}, STRING_UNKNOWN,
-				       $acptip, STRING_UNKNOWN)) {
-				&http_error(403, "Access denied for ".&html_strip($acptip).
-						 " by TCP wrappers");
-				return 0;
-				}
-			}
-		print DEBUG "handle_request: passed Remote IP checks\n";
-		}
-	$loghost = $acpthost;
-	}
-elsif ($config{'logtrust'}) {
-	# If a client IP address was provided, such as via a proxy, log it
-	$loghost = $headerhost || $loghost;
-	}
-
-if (defined($header{'host'})) {
-	if ($header{'host'} =~ /^\[(.+)\]:([0-9]+)$/) {
-		($host, $port) = ($1, $2);
-		}
-	elsif ($header{'host'} =~ /^([^:]+):([0-9]+)$/) {
-		($host, $port) = ($1, $2);
-		}
-	else {
-		$host = $header{'host'};
-		}
-	if ($config{'musthost'} && $host ne $config{'musthost'} &&
-	    !$config{'musthost_redirect'}) {
-		# Disallowed hostname used
-		&http_error(400, "Invalid HTTP hostname");
-		}
-	}
-
-# Create strings for use in redirects
-$ssl = $config{'redirect_ssl'} ne '' ? $config{'redirect_ssl'} : $use_ssl;
-$redirport = $config{'redirect_port'} || $port;
-$redirport = $config{'redirect_port'}
-	if ($config{'redirect_host'});
-$portstr = $redirport == 80 && !$ssl ? "" :
-	   $redirport == 443 && $ssl ? "" : ":".$redirport;
-$redirhost = $config{'redirect_host'} || $host;
-$hostport = &check_ip6address($redirhost) ? "[".$redirhost."]".$portstr
-				          : $redirhost.$portstr;
-
-# If the redirect_prefix exists change redirect base to include the prefix #1271
-if ($config{'redirect_prefix'}) {
-	$hostport .= $config{'redirect_prefix'}
-	}
-$prot = $ssl ? "https" : "http";
-
-# Redirect to the configured "musthost", if "musthost_redirect" is set, rather
-# than showing an error
-if ($config{'musthost'} && $host ne $config{'musthost'} &&
-    $config{'musthost_redirect'}) {
-	&write_data("HTTP/1.0 302 Moved Temporarily\r\n");
-	&write_data("Date: $datestr\r\n");
-	&write_data("Server: @{[&server_info()]}\r\n");
-	&write_data("Location: $prot://$config{'musthost'}:$redirport\r\n");
-	&write_keep_alive(0);
-	&write_data("\r\n");
-	&log_request($loghost, $authuser, $reqline, 302, 0) if $reqline;
-	shutdown(SOCK, 1);
-	close(SOCK);
-	return;
-	}
-
-undef(%in);
-if ($page =~ /^([^\?]+)\?(.*)$/) {
-	# There is some query string information
-	$page = $1;
-	$querystring = $2;
-	print DEBUG "handle_request: querystring=$querystring\n";
-	if ($querystring !~ /=/) {
-		$queryargs = $querystring;
-		$queryargs =~ s/\+/ /g;
-    		$queryargs =~ s/%(..)/pack("c",hex($1))/ge;
-		$querystring = "";
-		}
-	else {
-		# Parse query-string parameters
-		local @in = split(/\&/, $querystring);
-		foreach $i (@in) {
-			local ($k, $v) = split(/=/, $i, 2);
-			$k =~ s/\+/ /g; $k =~ s/%(..)/pack("c",hex($1))/ge;
-			$v =~ s/\+/ /g; $v =~ s/%(..)/pack("c",hex($1))/ge;
-			$in{$k} = $v;
-			}
-		}
-	}
-$posted_data = undef;
-if ($method eq 'POST' &&
-    $header{'content-type'} eq 'application/x-www-form-urlencoded') {
-	# Read in posted query string information, up the configured maximum
-	# post request length
-	$clen = $header{"content-length"};
-	$clen_read = $clen > $config{'max_post'} ? $config{'max_post'} : $clen;
-	while(length($posted_data) < $clen_read) {
-		alarm(60);
-		$SIG{'ALRM'} = sub { die "timeout" };
-		eval {
-			$buf = &read_data($clen_read - length($posted_data));
-			};
-		alarm(0);
-		if ($@) {
-			&http_error(500, "Timeout reading POST request");
-			}
-		if (!length($buf)) {
-			&http_error(500, "Failed to read POST request");
-			}
-		chomp($posted_data);
-		$posted_data =~ s/\015$//mg;
-		$posted_data .= $buf;
-		}
-	print DEBUG "clen_read=$clen_read clen=$clen posted_data=",length($posted_data),"\n";
-	if ($clen_read != $clen && length($posted_data) > $clen) {
-		# If the client sent more data than we asked for, chop the
-		# rest off
-		$posted_data = substr($posted_data, 0, $clen);
-		}
-	if (length($posted_data) > $clen) {
-		# When the client sent too much, delay so that it gets headers
-		sleep(3);
-		}
-	if ($header{'user-agent'} =~ /MSIE/ &&
-	    $header{'user-agent'} !~ /Opera/i) {
-		# MSIE includes an extra newline in the data
-		$posted_data =~ s/\r|\n//g;
-		}
-	local @in = split(/\&/, $posted_data);
-	foreach $i (@in) {
-		local ($k, $v) = split(/=/, $i, 2);
-		#$v =~ s/\r|\n//g;
-		$k =~ s/\+/ /g; $k =~ s/%(..)/pack("c",hex($1))/ge;
-		$v =~ s/\+/ /g; $v =~ s/%(..)/pack("c",hex($1))/ge;
-		$in{$k} = $v;
-		}
-	print DEBUG "handle_request: posted_data=$posted_data\n";
-	}
-
-# Reject CONNECT request, which isn't supported
-if ($method eq "CONNECT" || $method eq "TRACE") {
-	&http_error(405, "Method ".&html_strip($method)." is not supported");
-	}
-
-# work out accepted encodings
-%acceptenc = map { $_, 1 } split(/,/, $header{'accept-encoding'});
-
-# replace %XX sequences in page
-$page =~ s/%(..)/pack("c",hex($1))/ge;
-
-# Check if the browser's user agent indicates a mobile device
-$mobile_device = &is_mobile_useragent($header{'user-agent'});
-
-# Check if Host: header is for a mobile URL
-foreach my $m (@mobile_prefixes) {
-	if ($header{'host'} =~ /^\Q$m\E/i) {
-		$mobile_device = 1;
-		}
-	}
-
-# check for the logout flag file, and if existent deny authentication
-if ($config{'logout'} && -r $config{'logout'}.$in{'miniserv_logout_id'}) {
-	print DEBUG "handle_request: logout flag set\n";
-	$deny_authentication++;
-	open(LOGOUT, $config{'logout'}.$in{'miniserv_logout_id'});
-	chop($count = <LOGOUT>);
-	close(LOGOUT);
-	$count--;
-	if ($count > 0) {
-		open(LOGOUT, ">$config{'logout'}$in{'miniserv_logout_id'}");
-		print LOGOUT "$count\n";
-		close(LOGOUT);
-		}
-	else {
-		unlink($config{'logout'}.$in{'miniserv_logout_id'});
-		}
-	}
-
-# check for any redirect for the requested URL
-foreach my $pfx (@strip_prefix) {
-	my $l = length($pfx);
-	if(length($page) >= $l &&
-	   substr($page,0,$l) eq $pfx) {
-		$page=substr($page,$l);
-		last;
-		}
-	}
-$simple = &simplify_path($page, $bogus);
-$rpath = $simple;
-$rpath .= "&".$querystring if (defined($querystring));
-$redir = $redirect{$rpath};
-if (defined($redir)) {
-	print DEBUG "handle_request: redir=$redir\n";
-	&write_data("HTTP/1.0 302 Moved Temporarily\r\n");
-	&write_data("Date: $datestr\r\n");
-	&write_data("Server: @{[&server_info()]}\r\n");
-	&write_data("Location: $prot://$hostport$redir\r\n");
-	&write_keep_alive(0);
-	&write_data("\r\n");
-	return 0;
-	}
-
-# Check for a DAV request
-$davpath = undef;
-foreach my $d (@davpaths) {
-	if ($simple eq $d || $simple =~ /^\Q$d\E\//) {
-		$davpath = $d;
-		last;
-		}
-	}
-if (!$davpath && ($method eq "SEARCH" || $method eq "PUT")) {
-	&http_error(400, "Bad Request method ".&html_strip($method));
-	}
-
-# Check for some form of authentication
-print DEBUG "handle_request: Need authentication\n";
-$validated = 0;
-$blocked = 0;
-local $http_auth_error;
-local $http_auth_reason;
-
-# Session authentication is never used for connections by
-# another webmin server, or for specified pages, or for DAV, or XMLRPC,
-# or mobile browsers if requested.
-if ($header{'user-agent'} =~ /webmin/i ||
-    $header{'user-agent'} =~ /$config{'agents_nosession'}/i ||
-    $sessiononly{$simple} || $davpath ||
-    $simple eq "/xmlrpc.cgi" ||
-    $acptip eq $config{'host_nosession'} ||
-    $mobile_device && $config{'mobile_nosession'}) {
-	print DEBUG "handle_request: Forcing HTTP authentication\n";
-	$config{'session'} = 0;
-	}
-
-# Check for SSL authentication
-my $trust_ssl = $config{'trust_real_ip'} && !$config{'no_trust_ssl'};
-if ($use_ssl && $verified_client ||
-    $trust_ssl && $header{'x-ssl-client-dn'} &&
-                  $header{'x-ssl-client-verify'} =~ /^success$/i) {
-	my $u;
-	if ($use_ssl && $verified_client) {
-		$peername = Net::SSLeay::X509_NAME_oneline(
-				Net::SSLeay::X509_get_subject_name(
-					Net::SSLeay::get_peer_certificate(
-						$ssl_con)));
-		$u = &find_user_by_cert($peername);
-		}
-	if ($trust_ssl && !$u && $header{'x-ssl-client-dn'} &&
-	    !($use_ssl && $verified_client)) {
-		# Use proxied client cert (only when this connection
-		# is not itself a verified mTLS client; otherwise the
-		# header could be set by a real-cert client that didn't
-		# match a user, to authenticate as someone else).
-		$u = &find_user_by_cert($header{'x-ssl-client-dn'});
-		}
-	if ($u) {
-		$authuser = $u;
-		$validated = 2;
-		}
-	if ($use_syslog && !$validated && $use_ssl && $verified_client) {
-		syslog("crit", "%s",
-		       "Unknown SSL certificate $peername");
-		}
-	}
-
-if (!$validated && !$deny_authentication) {
-	# check for IP-based authentication
-	local $a;
-	foreach $a (keys %ipaccess) {
-		if ($acptip eq $a) {
-			# It does! Auth as the user
-			$validated = 3;
-			$baseauthuser = $authuser =
-				$ipaccess{$a};
-			}
-		}
-	}
-
-# Keep Basic auth disabled in session mode except for websocket routes that
-# explicitly allow no-cookie Basic-auth hops. Token/user checks still run
-# before the backend connection is opened.
-if (!$validated && !$deny_authentication &&
-    (!$config{'session'} || $websocket_basic_auth_ok) &&
-    $header{authorization} =~ /^basic\s+(\S+)$/i) {
-	# authorization given..
-	($authuser, $authpass) = split(/:/, &b64decode($1), 2);
-	print DEBUG "handle_request: doing basic auth check ".
-		    "authuser=$authuser authpass=$authpass\n";
-	local ($vu, $expired, $nonexist, $wvu) =
-		&validate_user_caseless($authuser, $authpass, $host,
-				        $acptip, $port);
-	local $twofactor_blocked = 0;
-	if ($vu && $wvu) {
-		# Don't allow a 2FA-protected account to fall back to
-		# password-only HTTP Basic authentication.
-		my $uinfo = &get_user_details($wvu, $vu);
-		if ($uinfo && $uinfo->{'twofactor_provider'}) {
-			print DEBUG "handle_request: rejecting basic auth for ".
-				    "$wvu because two-factor authentication ".
-				    "is enabled\n";
-			$twofactor_blocked = 1;
-			$http_auth_error = 'twofactor-required';
-			$http_auth_reason = 'With two-factor authentication '.
-					    'enabled for this account, RPC '.
-					    'access requires a separate '.
-					    'Webmin user without 2FA';
-			$vu = undef;
-			}
-		}
-	print DEBUG "handle_request: vu=$vu expired=$expired ".
-		    "nonexist=$nonexist\n";
-	if ($vu && (!$expired || $config{'passwd_mode'} == 1)) {
-		$authuser = $vu;
-		$validated = 1;
-		}
-	else {
-		$validated = 0;
-		}
-	if ($use_syslog && !$validated) {
-		my $msg = $twofactor_blocked
-			? "Login as $authuser from $acpthost rejected because ".
-			  "two-factor authentication is enabled"
-			: ($nonexist
-				? "Non-existent"
-				: $expired
-					? "Expired"
-					: "Invalid").
-			  " login as $authuser from $acpthost";
-		syslog("crit", "%s", $msg);
-		}
-	if ($authuser =~ /\r|\n|\s/) {
-		&http_error(500, "Invalid username",
-			    "Username contains invalid characters");
-		}
-	if ($authpass =~ /\r|\n/) {
-		&http_error(500, "Invalid password",
-			    "Password contains invalid characters");
-		}
-
-	if ($config{'passdelay'} && $authuser) {
-		# check with main process for delay
-		print DEBUG "handle_request: about to ask for password delay\n";
-		print $PASSINw "delay $authuser $acptip $validated\n";
-		<$PASSOUTr> =~ /(\d+) (\d+)/;
-		$blocked = $2;
-		print DEBUG "handle_request: password delay $1 $2\n";
-		sleep($1);
-		}
-	}
-
-# Check for a visit to the special session login page
-if ($config{'session'} && !$deny_authentication &&
-    $page eq $config{'session_login'}) {
-	if ($in{'logout'} && $header{'cookie'} =~ /(^|\s|;)$sidname=([a-f0-9]+)/) {
-		# Logout clicked .. remove the session
-		local $sid = $2;
-		print $PASSINw "delete $sid\n";
-		local $louser = <$PASSOUTr>;
-		chop($louser);
-		$logout = 1;
-		$already_session_id = undef;
-		$authuser = $baseauthuser = undef;
-		if ($louser) {
-			if ($use_syslog) {
-				syslog("info", "%s", "Logout by $louser from $acpthost");
-				}
-			&run_logout_script($louser, $sid,
-					   $loghost, $localip);
-			&write_logout_utmp($louser, $acpthost);
-			}
-		}
-	elsif ($in{'session'}) {
-		# Session ID given, perhaps from a single-use login link.
-		local $sid = $in{'session'};
-		if ($sid =~ /\r|\n|\s/) {
-			&http_error(500, "Invalid session",
-			    "Session ID contains invalid characters");
-			}
-		print $PASSINw "verify $sid $acptip 1\n";
-		<$PASSOUTr> =~ /^(\d+)\s+(\S+)/;
-		if ($1 != 2) {
-			&http_error(500, "Invalid session",
-			    "Session ID is not valid");
-			}
-
-		# If this was a one-time session ID link, the username will
-		# have a - prefix to prevent it from being used as a regular
-		# session.
-		local $vu = $2;
-		$vu =~ s/^-//;
-
-		# Clear this one-time session, and issue a new one
-		print $PASSINw "delete $sid\n";
-		local $louser = <$PASSOUTr>;
-		local $hrv = &handle_login(
-				$vu, $vu ? 1 : 0,
-				0, 0, undef, 1, 0);
-		return $hrv if (defined($hrv));
-		}
-	else {
-		# Trim username to remove leading and trailing spaces to
-		# be able to login, if username pastes from somewhere
-		$in{'user'} =~ s/^\s+|\s+$//g;
-
-		# Validate the user
-		if ($in{'user'} =~ /\r|\n|\s/) {
-			&run_failed_script($in{'user'}, 'baduser',
-					   $loghost, $localip);
-			&http_error(500, "Invalid username",
-			    "Username contains invalid characters");
-			}
-		if ($in{'pass'} =~ /\r|\n/) {
-			&run_failed_script($in{'user'}, 'badpass',
-					   $loghost, $localip);
-			&http_error(500, "Invalid password",
-			    "Password contains invalid characters");
-			}
-		
-		local $twofactor_probe = 0;
-		local ($vu, $expired, $nonexist, $wvu) =
-			&validate_user_caseless($in{'user'}, $in{'pass'}, $host,
-					        $acptip, $port);
-		if ($vu && $wvu) {
-			my $uinfo = &get_user_details($wvu, $vu);
-			my $can2fa = $uinfo && $uinfo->{'twofactor_provider'};
-			$twofactor_probe = 1 if ($in{'twofprobe'} && $can2fa);
-			if ($can2fa && !$twofactor_probe) {
-				# Check two-factor token ID
-				$err = &validate_twofactor(
-					$wvu, $in{'twofactor'}, $vu);
-				if ($err) {
-					&run_failed_script(
-						$vu, 'twofactor',
-						$loghost, $localip);
-					$twofactor_msg = $err;
-					$twofactor_nolog = 'nolog'
-						if (!$in{'twofactor'});
-					$vu = undef;
-					}
-				}
-			}
-		local $hrv = &handle_login(
-				$vu || $in{'user'}, $vu ? 1 : 0,
-				$expired, $nonexist, $in{'pass'},
-				$in{'notestingcookie'}, $twofactor_nolog,
-				$twofactor_probe);
-		return $hrv if (defined($hrv));
-		}
-	}
-
-# Check for a visit to the special PAM login page
-if ($config{'session'} && !$deny_authentication &&
-    $use_pam && $config{'pam_conv'} && $page eq $config{'pam_login'} &&
-    !$in{'restart'}) {
-	# A question has been entered .. submit it to the main process
-	print DEBUG "handle_request: Got call to $page ($in{'cid'})\n";
-	print DEBUG "handle_request: For PAM, authuser=$authuser\n";
-	if ($in{'answer'} =~ /\r|\n/ || $in{'cid'} =~ /\r|\n|\s/) {
-		&http_error(500, "Invalid response",
-		    "Response contains invalid characters");
-		}
-
-	if (!$in{'cid'}) {
-		# Start of a new conversation - answer must be username
-		$cid = &generate_random_id();
-		print $PASSINw "pamstart $cid $host $in{'answer'}\n";
-		}
-	else {
-		# A response to a previous question
-		$cid = $in{'cid'};
-		print $PASSINw "pamanswer $cid $in{'answer'}\n";
-		}
-
-	# Read back the response, and the next question (if any)
-	local $line = <$PASSOUTr>;
-	$line =~ s/\r|\n//g;
-	local ($rv, $question) = split(/\s+/, $line, 2);
-	if ($rv == 0) {
-		# Cannot login!
-		local $hrv = &handle_login(
-			!$in{'cid'} && $in{'answer'} ? $in{'answer'}
-						     : "unknown",
-			0, 0, 1, undef);
-		return $hrv if (defined($hrv));
-		}
-	elsif ($rv == 1 || $rv == 3) {
-		# Another question .. force use of PAM CGI
-		$validated = 1;
-		$method = "GET";
-		$querystring .= "&cid=$cid&question=".
-				&urlize($question);
-		$querystring .= "&password=1" if ($rv == 3);
-		$queryargs = "";
-		$page = $config{'pam_login'};
-		$miniserv_internal = 1;
-		$logged_code = 401;
-		}
-	elsif ($rv == 2) {
-		# Got back a final ok or failure
-		local ($user, $ok, $expired, $nonexist) =
-			split(/\s+/, $question);
-		local $hrv = &handle_login(
-			$user, $ok, $expired, $nonexist, undef,
-			$in{'notestingcookie'});
-		return $hrv if (defined($hrv));
-		}
-	elsif ($rv == 4) {
-		# A message from PAM .. tell the user
-		$validated = 1;
-		$method = "GET";
-		$querystring .= "&cid=$cid&message=".
-				&urlize($question);
-		$queryargs = "";
-		$page = $config{'pam_login'};
-		$miniserv_internal = 1;
-		$logged_code = 401;
-		}
-	}
-
-# Check for a visit to the special password change page
-if ($config{'session'} && !$deny_authentication &&
-    $page eq $config{'password_change'} && !$validated) {
-	# Just let this slide ..
-	$validated = 1;
-	$miniserv_internal = 3;
-
-	# check with main process for delay
-	if ($config{'passdelay'}) {
-		print DEBUG "handle_request: requesting delay acptip=$acptip\n";
-		print $PASSINw "delay - $acptip 0\n";
-		<$PASSOUTr> =~ /(\d+) (\d+)/;
-		sleep($1);
-		print DEBUG "handle_request: delay=$1 blocked=$2\n";
-		}
-	}
-
-# Check for an existing session
-if ($config{'session'} && !$validated) {
-	if ($already_session_id) {
-		$session_id = $already_session_id;
-		$authuser = $already_authuser;
-		$validated = 1;
-		}
-	elsif (!$deny_authentication &&
-	       $header{'cookie'} =~ /(^|\s|;)$sidname=([a-f0-9]+)/) {
-		# Try all session cookies
-		local $cookie = $header{'cookie'};
-		while($cookie =~ s/(^|\s|;)$sidname=([a-f0-9]+)//) {
-			$session_id = $2;
-			print $PASSINw "verify $session_id $acptip 1\n";
-			<$PASSOUTr> =~ /(\d+)\s+(\S+)/;
-			if ($1 == 2) {
-				# Valid session continuation
-				$validated = 1;
-				$authuser = $2;
-				$already_authuser = $authuser;
-				$timed_out = undef;
-				last;
-				}
-			elsif ($1 == 1) {
-				# Session timed out
-				$timed_out = $2;
-				}
-			elsif ($1 == 3) {
-				# Session is OK, but from the wrong IP
-				&log_error("Session $session_id was ",
-				  "used from $acptip instead of ",
-				  "original IP $2");
-				}
-			else {
-				# Invalid session ID .. don't set
-				# verified flag
-				}
-			}
-		}
-	if ($authuser) {
-		# We got a session .. but does the user still exist?
-		my @can = &can_user_login($authuser, undef, $host);
-		$baseauthuser = $can[3] || $authuser;
-		my $auser = &get_user_details($baseauthuser, $authuser);
-		if (!$auser) {
-			&log_error("Session $session_id is for user ",
-				     "$authuser who does not exist");
-			$validated = 0;
-			$already_authuser = $authuser = undef;
-			}
-		}
-	}
-
-# Check for local authentication
-if ($localauth_user && !$header{'x-forwarded-for'} && !$header{'via'}) {
-	my $luser = &get_user_details($localauth_user);
-	if ($luser) {
-		# Local user exists in webmin users file
-		$validated = 1;
-		$authuser = $localauth_user;
-		}
-	else {
-		# Check if local user is allowed by unixauth
-		local @can = &can_user_login($localauth_user,
-					     undef, $host);
-		if ($can[0]) {
-			$validated = 2;
-			$authuser = $localauth_user;
-			}
-		else {
-			$localauth_user = undef;
-			}
-		}
-	}
-
-if (!$validated) {
-	# Check if this path allows anonymous access
-	local $a;
-	foreach $a (keys %anonymous) {
-		if (substr($simple, 0, length($a)) eq $a) {
-			# It does! Auth as the user, if IP access
-			# control allows him.
-			if (&check_user_ip($anonymous{$a}) &&
-			    &check_user_time($anonymous{$a})) {
-				$validated = 3;
-				$baseauthuser = $authuser =
-					$anonymous{$a};
-				}
-			}
-		}
-	}
-
-if (!$validated) {
-	# Check if this path allows unauthenticated access
-	my $unauth;
-	foreach my $u (@unauth) {
-		$unauth = 4 if ($simple =~ /$u/);
-		}
-	foreach my $u (@unauthcgi) {
-		$unauth = 3 if ($simple =~ /$u/);
-		}
-	if (!$bogus && $unauth) {
-		# Unauthenticated directory or file request - approve it
-		$validated = $unauth;
-		$baseauthuser = $authuser = undef;
-		}
-	}
-
-if (!$validated) {
-	if ($blocked == 0) {
-		# No password given.. ask
-		if ($config{'pam_conv'} && $use_pam) {
-			# Force CGI for PAM question, starting with
-			# the username which is always needed
-			$validated = 1;
-			$method = "GET";
-			$querystring .= "&initial=1&question=".
-					&urlize("Username");
-			$querystring .= "&failed=$failed_user" if ($failed_user);
-			$querystring .= "&timed_out=$timed_out" if ($timed_out);
-			$queryargs = "";
-			$page = $config{'pam_login'};
-			$miniserv_internal = 1;
-			$logged_code = 401;
-			}
-		elsif ($config{'session'}) {
-			# Force CGI for session login
-			$validated = 1;
-			if ($logout) {
-				$querystring .= "&logout=1&page=/";
-				}
-			else {
-				# Re-direct to current module only
-				local $rpage = $request_uri;
-				if (!$config{'loginkeeppage'}) {
-					$rpage =~ s/\?.*$//;
-					$rpage =~ s/[^\/]+$//
-					}
-				$querystring = "page=".&urlize($rpage);
-				}
-			$method = "GET";
-			$querystring .= "&failed=".&urlize($failed_user)
-				if ($failed_user);
-			$querystring .= "&twofactor_msg=".&urlize($twofactor_msg)
-				if ($twofactor_msg);
-			$querystring .= "&timed_out=$timed_out"
-				if ($timed_out);
-			$queryargs = "";
-			$page = $config{'session_login'};
-			$miniserv_internal = 1;
-			$logged_code = 401;
-			}
-		else {
-			# Ask for login with HTTP authentication
-			&write_data("HTTP/1.0 401 Unauthorized\r\n");
-			&write_data("Date: $datestr\r\n");
-			&write_data("Server: @{[&server_info()]}\r\n");
-			&write_data("WWW-authenticate: Basic ".
-				   "realm=\"$config{'realm'}\"\r\n");
-			if ($http_auth_error) {
-				my $err = $http_auth_error;
-				$err =~ s/\r|\n//g;
-				&write_data("X-Webmin-Auth-Error: $err\r\n");
-				if ($http_auth_reason) {
-					my $reason = $http_auth_reason;
-					$reason =~ s/\r|\n//g;
-					&write_data(
-					  "X-Webmin-Auth-Reason: $reason\r\n");
-					}
-				}
-			&write_keep_alive(0);
-			&write_data("Content-type: text/html; Charset=utf-8\r\n");
-			&write_data("\r\n");
-			&reset_byte_count();
-			my $auth_err = $http_auth_reason ||
-				"A password is required to access this ".
-				"web server. Please try again.";
-			&write_data("<html>\n");
-			&write_data("<head>".&embed_error_styles($roots[0])."<title>401 &mdash; Unauthorized</title></head>\n");
-			&write_data("<body><h2 class=\"err-head\">401 &mdash; Unauthorized</h2>\n");
-			&write_data("<p class=\"err-content\">".
-				    &html_escape($auth_err)."</p> <p>\n");
-			&write_data("</body></html>\n");
-			&log_request($loghost, undef, $reqline, 401, &byte_count());
-			return 0;
-			}
-		}
-	elsif ($blocked == 1) {
-		# when the host has been blocked, give it an error
-		&http_error(403, "Access denied for $acptip. The host ".
-				 "has been blocked because of too ".
-				 "many authentication failures.");
-		}
-	elsif ($blocked == 2) {
-		# when the user has been blocked, give it an error
-		&http_error(403, "Access denied. The user ".
-				 "has been blocked because of too ".
-				 "many authentication failures.");
-		}
-	}
-else {
-	# Get the real Webmin username
-	if (!$baseauthuser) {
-		local @can = &can_user_login($authuser, undef, $host);
-		$baseauthuser = $can[3] || $authuser;
-		}
-
-	if ($config{'remoteuser'} && !$< && $validated) {
-		# Switch to the UID of the remote user (if he exists)
-		local @u = getpwnam($authuser);
-		if (@u && $< != $u[2]) {
-			$( = $u[3]; $) = "$u[3] $u[3]";
-			($>, $<) = ($u[2], $u[2]);
-			}
-		else {
-			&http_error(500, "Unix user ".
-			  &html_strip($authuser)." does not exist");
-			return 0;
-			}
-		}
-	}
-
-# Check per-user IP access control
-if (!&check_user_ip($baseauthuser)) {
-	&http_error(403, "Access denied for $acptip for ".
-			 &html_strip($baseauthuser));
-	return 0;
-	}
-
-# Check per-user allowed times
-if (!&check_user_time($baseauthuser)) {
-	&http_error(403, "Access denied at the current time");
-	return 0;
-	}
-$uinfo = &get_user_details($baseauthuser, $authuser);
-
-# Validate the path, and convert to canonical form
-rerun:
-$simple = &simplify_path($page, $bogus);
-print DEBUG "handle_request: page=$page simple=$simple\n";
-if ($bogus) {
-	&http_error(400, "Invalid path");
-	return 0;
-	}
-
-# Check for a DAV request
-if ($davpath) {
-	return &handle_dav_request($davpath);
-	}
-
-# Check for a websockets request
-if ($websocket_upgrade_request && $baseauthuser) {
-	print DEBUG "websockets request to $simple\n";
-	my ($ws, $ws_simple) = &find_websocket_config($simple);
-	if (!$ws) {
-		&http_error(400, "Unknown websocket path");
-		return 0;
-		}
-	return &handle_websocket_request($ws, $ws_simple);
-	}
-
-# Work out the active theme(s)
-local $preroots = $mobile_device && defined($config{'mobile_preroot'}) ?
-			$config{'mobile_preroot'} :
-		 $authuser && defined($config{'preroot_'.$authuser}) ?
-			$config{'preroot_'.$authuser} :
-	         $uinfo && defined($uinfo->{'preroot'}) ?
-			$uinfo->{'preroot'} :
-			$config{'preroot'};
-local @preroots = reverse(split(/\s+/, $preroots));
-
-# Canonicalize the directories
-local @themes;
-foreach my $preroot (@preroots) {
-	# Always under the current webmin root
-	$preroot =~ s/^.*\///g;
-	push(@themes, $preroot);
-	$preroot = $roots[0].'/'.$preroot;
-	}
-
-# Look in the theme root directories first
-local ($full, @stfull);
-$foundroot = undef;
-foreach my $preroot (@preroots) {
-	$is_directory = 1;
-	$sofar = "";
-	$full = $preroot.$sofar;
-	$scriptname = $simple;
-	foreach $b (split(/\//, $simple)) {
-		if ($b ne "") { $sofar .= "/$b"; }
-		$full = $preroot.$sofar;
-		@stfull = stat($full);
-		if (!@stfull) { undef($full); last; }
-
-		# Check if this is a directory
-		if (-d _) {
-			# It is.. go on parsing
-			$is_directory = 1;
-			next;
-			}
-		else {
-			$is_directory = 0;
-			}
-
-		# Check if this is a CGI program
-		if (&get_type($full) eq "internal/cgi") {
-			$pathinfo = substr($simple, length($sofar));
-			$pathinfo .= "/" if ($page =~ /\/$/);
-			$scriptname = $sofar;
-			last;
-			}
-		}
-
-	# Don't stop at a directory unless this is the last theme, which
-	# is the 'real' one that provides the .cgi scripts
-	if ($is_directory && $preroot ne $preroots[$#preroots]) {
-		next;
-		}
-
-	if ($full) {
-		# Found it!
-		if ($sofar eq '') {
-			$cgi_pwd = $roots[0];
-			}
-		elsif ($is_directory) {
-			$cgi_pwd = "$roots[0]$sofar";
-			}
-		else {
-			"$roots[0]$sofar" =~ /^(.*\/)[^\/]+$/;
-			$cgi_pwd = $1;
-			}
-		$foundroot = $preroot;
-		if ($is_directory) {
-			# Check for index files in the directory
-			local $foundidx;
-			foreach $idx (split(/\s+/, $config{"index_docs"})) {
-				$idxfull = "$full/$idx";
-				local @stidxfull = stat($idxfull);
-				if (-r _ && !-d _) {
-					$full = $idxfull;
-					@stfull = @stidxfull;
-					$is_directory = 0;
-					$scriptname .= "/"
-						if ($scriptname ne "/");
-					$foundidx++;
-					last;
-					}
-				}
-			@stfull = stat($full) if (!$foundidx);
-			}
-		}
-	last if ($foundroot);
-	}
-print DEBUG "handle_request: initial full=$full\n";
-
-# Look in the real root directories, stopping when we find a file or directory
-if (!$full || $is_directory) {
-	ROOT: foreach $root (@roots) {
-		$sofar = "";
-		$full = $root.$sofar;
-		$scriptname = $simple;
-		foreach $b ($simple eq "/" ? ( "" ) : split(/\//, $simple)) {
-			if ($b ne "") { $sofar .= "/$b"; }
-			$full = $root.$sofar;
-			@stfull = stat($full);
-			if (!@stfull) {
-				next ROOT;
-				}
-
-			# Check if this is a directory
-			if (-d _) {
-				# It is.. go on parsing
-				next;
-				}
-
-			# Check if this is a CGI program
-			if (&get_type($full) eq "internal/cgi") {
-				$pathinfo = substr($simple, length($sofar));
-				$pathinfo .= "/" if ($page =~ /\/$/);
-				$scriptname = $sofar;
-				last;
-				}
-			}
-
-		# Run CGI in the same directory as whatever file
-		# was requested
-		$full =~ /^(.*\/)[^\/]+$/; $cgi_pwd = $1;
-
-		if (-e $full) {
-			# Found something!
-			$realroot = $root;
-			$foundroot = $root;
-			last;
-			}
-		}
-	if (!@stfull) { &http_error(404, "File not found"); }
-	}
-print DEBUG "handle_request: full=$full\n";
-@stfull = stat($full) if (!@stfull);
-
-# check filename against denyfile regexp
-local $denyfile = $config{'denyfile'};
-if ($denyfile && $full =~ /$denyfile/) {
-	&http_error(403, "Access denied to ".&html_strip($page));
-	return 0;
-	}
-
-# Reached the end of the path OK.. see what we've got
-if (-d _) {
-	# See if the URL ends with a / as it should
-	print DEBUG "handle_request: found a directory\n";
-	if ($page !~ /\/$/) {
-		# It doesn't.. redirect
-		&write_data("HTTP/1.0 302 Moved Temporarily\r\n");
-		&write_data("Date: $datestr\r\n");
-		&write_data("Server: @{[&server_info()]}\r\n");
-		&write_data("Location: $prot://$hostport$page/\r\n");
-		&write_keep_alive(0);
-		&write_data("\r\n");
-		&log_request($loghost, $authuser, $reqline, 302, 0);
-		return 0;
-		}
-	# A directory.. check for index files
-	local $foundidx;
-	foreach $idx (split(/\s+/, $config{"index_docs"})) {
-		$idxfull = "$full/$idx";
-		@stidxfull = stat($idxfull);
-		if (-r _ && !-d _) {
-			$cgi_pwd = $full;
-			$full = $idxfull;
-			@stfull = @stidxfull;
-			$scriptname .= "/" if ($scriptname ne "/");
-			$foundidx++;
-			last;
-			}
-		}
-	@stfull = stat($full) if (!$foundidx);
-	}
-if (-d _) {
-	# This is definitely a directory.. list it
-	if ($config{'nolistdir'}) {
-		&http_error(500, "Directory is missing an index file");
-		}
-	print DEBUG "handle_request: listing directory\n";
-	local $resp = "HTTP/1.0 $ok_code $ok_message\r\n".
-		      "Date: $datestr\r\n".
-		      "Server: @{[&server_info()]}\r\n".
-		      "Content-type: text/html; Charset=utf-8\r\n";
-	&write_data($resp);
-	&write_keep_alive(0);
-	&write_data("\r\n");
-	&reset_byte_count();
-	&write_data("".&embed_error_styles($roots[0])."<h2 class=\"err-head\">Index of $simple</h2>\n");
-	&write_data("<pre class=\"err-content\">\n");
-	&write_data(sprintf "%-35.35s %-20.20s %-10.10s\n",
-			"Name", "Last Modified", "Size");
-	&write_data("</pre>\n");
-	&write_data("<hr>\n");
-	opendir(DIR, $full);
-	while($df = readdir(DIR)) {
-		if ($df =~ /^\./) { next; }
-		$fulldf = $full eq "/" ? $full.$df : $full."/".$df;
-		(@stbuf = stat($fulldf)) || next;
-		if (-d _) { $df .= "/"; }
-		@tm = localtime($stbuf[9]);
-		$fdate = sprintf "%2.2d/%2.2d/%4.4d %2.2d:%2.2d:%2.2d",
-				$tm[3],$tm[4]+1,$tm[5]+1900,
-				$tm[0],$tm[1],$tm[2];
-		$len = length($df); $rest = " "x(35-$len);
-		&write_data(sprintf 
-		 "<a href=\"%s\">%-${len}.${len}s</a>$rest %-20.20s %-10.10s\n",
-		 &urlize($df), &html_strip($df), $fdate, $stbuf[7]);
-		}
-	closedir(DIR);
-	&log_request($loghost, $authuser, $reqline, $ok_code, &byte_count());
-	return 0;
-	}
-
-# CGI or normal file
-local $rv;
-if (&get_type($full) eq "internal/cgi" && $validated != 4) {
-	# A CGI program to execute
-	print DEBUG "handle_request: executing CGI\n";
-	$envtz = $ENV{"TZ"};
-	$envuser = $ENV{"USER"};
-	$envpath = $ENV{"PATH"};
-	$envlang = $ENV{"LANG"};
-	$envroot = $ENV{"SystemRoot"};
-	$envperllib = $ENV{'PERLLIB'};
-	$envdoclroot = $ENV{'LIBROOT'};
-	foreach my $k (keys %ENV) {
-		delete($ENV{$k});
-		}
-	$ENV{"PATH"} = $envpath if ($envpath);
-	$ENV{"TZ"} = $envtz if ($envtz);
-	$ENV{"USER"} = $envuser if ($envuser);
-	$ENV{"OLD_LANG"} = $envlang if ($envlang);
-	$ENV{"SystemRoot"} = $envroot if ($envroot);
-	$ENV{'LIBROOT'} = $envdoclroot if ($envdoclroot);
-	$ENV{'PERLLIB'} = $envperllib if ($envperllib);
-	$ENV{"HOME"} = $user_homedir;
-	$ENV{"SERVER_SOFTWARE"} = $config{"server"};
-	$ENV{"SERVER_NAME"} = $host;
-	$ENV{"SERVER_ADMIN"} = $config{"email"};
-	$ENV{"SERVER_ROOT"} = $roots[0];
-	$ENV{"SERVER_REALROOT"} = $realroot;
-	$ENV{"SERVER_PORT"} = $port;
-	$ENV{"REMOTE_HOST"} = $acpthost;
-	$ENV{"REMOTE_ADDR"} = $acptip;
-	$ENV{"REMOTE_ADDR_PROTOCOL"} = $ipv6 ? 6 : 4;
-	$ENV{"REMOTE_USER"} = $authuser;
-	$ENV{"BASE_REMOTE_USER"} = $authuser ne $baseauthuser ?
-					$baseauthuser : undef;
-	$ENV{"REMOTE_PASS"} = $authpass if (defined($authpass) &&
-					    $config{'pass_password'});
-	if ($uinfo && $uinfo->{'proto'}) {
-		$ENV{"REMOTE_USER_PROTO"} = $uinfo->{'proto'};
-		$ENV{"REMOTE_USER_ID"} = $uinfo->{'id'};
-		}
-	print DEBUG "REMOTE_USER = ",$ENV{"REMOTE_USER"},"\n";
-	print DEBUG "BASE_REMOTE_USER = ",$ENV{"BASE_REMOTE_USER"},"\n";
-	print DEBUG "proto=$uinfo->{'proto'} id=$uinfo->{'id'}\n" if ($uinfo);
-	$ENV{"SSL_USER"} = $peername if ($validated == 2);
-	$ENV{"ANONYMOUS_USER"} = "1" if ($validated == 3 || $validated == 4);
-	$ENV{"DOCUMENT_ROOT"} = $roots[0];
-	$ENV{"THEME_ROOT"} = $preroots[0];
-	$ENV{"THEME_DIRS"} = join(" ", @themes) || "";
-	$ENV{"DOCUMENT_REALROOT"} = $realroot;
-	$ENV{"GATEWAY_INTERFACE"} = "CGI/1.1";
-	$ENV{"SERVER_PROTOCOL"} = "HTTP/1.0";
-	$ENV{"REQUEST_METHOD"} = $method;
-	$ENV{"SCRIPT_NAME"} = $scriptname;
-	$ENV{"SCRIPT_FILENAME"} = $full;
-	$ENV{"REQUEST_URI"} = $request_uri;
-	$ENV{"PATH_INFO"} = $pathinfo;
-	if ($pathinfo) {
-		$ENV{"PATH_TRANSLATED"} = "$roots[0]$pathinfo";
-		$ENV{"PATH_REALTRANSLATED"} = "$realroot$pathinfo";
-		}
-	$ENV{"QUERY_STRING"} = $querystring;
-	$ENV{"MINISERV_CONFIG"} = $config_file;
-	$ENV{"HTTPS"} = $use_ssl ? "ON" : "";
-	$ENV{"SSL_HSTS"} = $config{"ssl_hsts"};
-	if ($use_ssl) {
-		$ENV{"SSL_CN"} = $ssl_cn;
-		$ENV{"SSL_CN_CERT"} =
-			&ssl_hostname_match($header{'host'}, $ssl_alts) &&
-			&ssl_hostname_match($ssl_cn, $ssl_alts);
-		}
-	$ENV{"MINISERV_PID"} = $miniserv_main_pid;
-	if ($use_ssl) {
-		$ENV{"MINISERV_CERTFILE"} = $ssl_certfile;
-		$ENV{"MINISERV_KEYFILE"} = $ssl_keyfile;
-		}
-	$ENV{"SESSION_ID"} = $session_id if ($session_id);
-	$ENV{"LOCAL_USER"} = $localauth_user if ($localauth_user);
-	$ENV{"MINISERV_INTERNAL"} = $miniserv_internal if ($miniserv_internal);
-	if (defined($header{"content-length"})) {
-		$ENV{"CONTENT_LENGTH"} = $header{"content-length"};
-		}
-	if (defined($header{"content-type"})) {
-		$ENV{"CONTENT_TYPE"} = $header{"content-type"};
-		}
-	foreach $h (keys %header) {
-		($hname = $h) =~ tr/a-z/A-Z/;
-		$hname =~ s/\-/_/g;
-		$ENV{"HTTP_$hname"} = $header{$h};
-		}
-	$ENV{"PWD"} = $cgi_pwd;
-	foreach $k (keys %config) {
-		if ($k =~ /^env_(\S+)$/) {
-			$ENV{$1} = $config{$k};
-			}
-		}
-	delete($ENV{'HTTP_AUTHORIZATION'});
-	$ENV{'HTTP_COOKIE'} =~ s/;?\s*$sidname=([a-f0-9]+)//;
-	$ENV{'MOBILE_DEVICE'} = 1 if ($mobile_device);
-
-	# Check if the CGI can be handled internally
-	open(CGI, $full);
-	local $first = <CGI>;
-	close(CGI);
-	$first =~ s/[#!\r\n]//g;
-	$nph_script = ($full =~ /\/nph-([^\/]+)$/);
-	seek(STDERR, 0, 2);
-	if (!$config{'forkcgis'} &&
-	    ($first eq $perl_path || $first eq $linked_perl_path ||
-	     $first =~ /\/perl$/ || $first =~ /^\/\S+\/env\s+perl$/) &&
-	      $] >= 5.004 ||
-            $config{'internalcgis'}) {
-		# setup environment for eval
-		chdir($ENV{"PWD"});
-		@ARGV = split(/\s+/, $queryargs);
-		$0 = $full;
-		if ($posted_data) {
-			# Already read the post input
-			$postinput = $posted_data;
-			}
-		$clen = $header{"content-length"};
-		$SIG{'CHLD'} = 'DEFAULT';
-		eval {
-			# Have SOCK closed if the perl exec's something
-			use Fcntl;
-			fcntl(SOCK, F_SETFD, FD_CLOEXEC);
-			};
-		#shutdown(SOCK, 0);
-
-		if ($config{'log'}) {
-			open(MINISERVLOG, ">>$config{'logfile'}");
-			if ($config{'logperms'}) {
-				chmod(oct($config{'logperms'}),
-				      $config{'logfile'});
-				}
-			else {
-				chmod(0600, $config{'logfile'});
-				}
-			}
-		$doing_cgi_eval = 1;
-		$main_process_id = $$;
-		$pkg = "main";
-		if ($full =~ /^\Q$foundroot\E\/([^\/]+)\//) {
-			# Eval in package from Webmin module name
-			$pkg = $1;
-			$pkg =~ s/[^A-Za-z0-9]/_/g;
-			}
-		eval "
-			\%pkg::ENV = \%ENV;
-			package $pkg;
-			tie(*STDOUT, 'miniserv');
-			tie(*STDIN, 'miniserv');
-			do \$miniserv::full;
-			die \$@ if (\$@);
-			";
-		$doing_cgi_eval = 0;
-		if ($@) {
-			# Error in perl!
-			&http_error(500, "Perl execution failed",
-				    $config{'noshowstderr'} ? undef : "$@");
-			}
-		elsif (!$doneheaders && !$nph_script) {
-			&http_error(500, "Missing Headers");
-			}
-		$rv = 0;
-		}
-	else {
-		$infile = undef;
-		if (!$on_windows) {
-			# fork the process that actually executes the CGI
-			pipe(CGIINr, CGIINw);
-			pipe(CGIOUTr, CGIOUTw);
-			pipe(CGIERRr, CGIERRw);
-			if (!($cgipid = fork())) {
-				@execargs = ( $full, split(/\s+/, $queryargs) );
-				chdir($ENV{"PWD"});
-				close(SOCK);
-				open(STDIN, "<&CGIINr");
-				open(STDOUT, ">&CGIOUTw");
-				open(STDERR, ">&CGIERRw");
-				close(CGIINw); close(CGIOUTr); close(CGIERRr);
-				exec(@execargs) ||
-					die "Failed to exec $full : $!\n";
-				exit(0);
-				}
-			close(CGIINr); close(CGIOUTw); close(CGIERRw);
-			}
-		else {
-			# write CGI input to a temp file
-			$infile = "$config{'tempbase'}.$$";
-			open(CGIINw, ">$infile");
-			# NOT binary mode, as CGIs don't read in it!
-			}
-
-		# send post data
-		if ($posted_data) {
-			# already read the posted data
-			print CGIINw $posted_data;
-			}
-		$clen = $header{"content-length"};
-		if ($method eq "POST" && $clen_read < $clen) {
-			$SIG{'PIPE'} = 'IGNORE';
-			$got = $clen_read;
-			while($got < $clen) {
-				$buf = &read_data($clen-$got);
-				if (!length($buf)) {
-					kill('TERM', $cgipid);
-					unlink($infile) if ($infile);
-					&http_error(500, "Failed to read ".
-							 "POST request");
-					}
-				$got += length($buf);
-				local ($wrote) = (print CGIINw $buf);
-				last if (!$wrote);
-				}
-			# If the CGI terminated early, we still need to read
-			# from the browser and throw away
-			while($got < $clen) {
-				$buf = &read_data($clen-$got);
-				if (!length($buf)) {
-					kill('TERM', $cgipid);
-					unlink($infile) if ($infile);
-					&http_error(500, "Failed to read ".
-							 "POST request");
-					}
-				$got += length($buf);
-				}
-			$SIG{'PIPE'} = 'DEFAULT';
-			}
-		close(CGIINw);
-		shutdown(SOCK, 0);
-
-		if ($on_windows) {
-			# Run the CGI program, and feed it input
-			chdir($ENV{"PWD"});
-			local $qqueryargs = join(" ",
-				map { s/([<>|&"^])/^$1/g; "\"$_\"" }
-				    split(/\s+/, $queryargs));
-			if ($first =~ /(perl|perl.exe)$/i) {
-				# On Windows, run with Perl
-				open(CGIOUTr, "$perl_path \"$full\" $qqueryargs <$infile |");
-				}
-			else {
-				open(CGIOUTr, "\"$full\" $qqueryargs <$infile |");
-				}
-			binmode(CGIOUTr);
-			}
-
-		if (!$nph_script) {
-			# read back cgi headers
-			select(CGIOUTr); $|=1; select(STDOUT);
-			$got_blank = 0;
-			while(1) {
-				$line = <CGIOUTr>;
-				$line =~ s/\r|\n//g;
-				if ($line eq "") {
-					if ($got_blank || %cgiheader) { last; }
-					$got_blank++;
-					next;
-					}
-				if ($line !~ /^(\S+):\s+(.*)$/) {
-					$errs = &read_errors(CGIERRr);
-					close(CGIOUTr); close(CGIERRr);
-					unlink($infile) if ($infile);
-					&http_error(500, "Bad Header", $errs);
-					}
-				$cgiheader{lc($1)} = $2;
-				push(@cgiheader, [ $1, $2 ]);
-				}
-			if ($cgiheader{"location"}) {
-				&write_data("HTTP/1.0 302 Moved Temporarily\r\n");
-				&write_data("Date: $datestr\r\n");
-				&write_data("Server: @{[&server_info()]}\r\n");
-				&write_keep_alive(0);
-				# ignore the rest of the output. This is a hack,
-				# but is necessary for IE in some cases :(
-				close(CGIOUTr); close(CGIERRr);
-				}
-			elsif ($cgiheader{"content-type"} eq "") {
-				close(CGIOUTr); close(CGIERRr);
-				unlink($infile) if ($infile);
-				$errs = &read_errors(CGIERRr);
-				&http_error(500, "Missing Content-Type Header",
-				    $config{'noshowstderr'} ? undef : $errs);
-				}
-			else {
-				&write_data("HTTP/1.0 $ok_code $ok_message\r\n");
-				&write_data("Date: $datestr\r\n");
-				&write_data("Server: @{[&server_info()]}\r\n");
-				&write_keep_alive(0);
-				}
-			foreach $h (@cgiheader) {
-				&write_data("$h->[0]: $h->[1]\r\n");
-				}
-			&write_data("\r\n");
-			}
-		&reset_byte_count();
-		while($line = <CGIOUTr>) {
-			&write_data($line);
-			}
-		close(CGIOUTr);
-		close(CGIERRr);
-		unlink($infile) if ($infile);
-		$rv = 0;
-		}
-	}
-else {
-	# A file to output
-	print DEBUG "handle_request: outputting file $full\n";
-	$gzfile = $full.".gz";
-	$gzipped = 0;
-	if ($config{'gzip'} ne '0' && -r $gzfile && $acceptenc{'gzip'}) {
-		# Using gzipped version
-		@stopen = stat($gzfile);
-		if ($stopen[9] >= $stfull[9] && open(FILE, $gzfile)) {
-			print DEBUG "handle_request: using gzipped $gzfile\n";
-			$gzipped = 1;
-			}
-		}
-	if (!$gzipped) {
-		# Using original file
-		@stopen = @stfull;
-		open(FILE, $full) || &http_error(404, "Failed to open file");
-		}
-	binmode(FILE);
-
-	# Build common headers
-	local $etime = &get_expires_time($simple);
-	local $resp = "HTTP/1.0 $ok_code $ok_message\r\n".
-		      "Date: $datestr\r\n".
-		      "Server: @{[&server_info()]}\r\n".
-		      "Content-type: ".&get_type($full)."\r\n".
-		      "Last-Modified: ".&http_date($stopen[9])."\r\n".
-		      "Expires: ".&http_date(time()+$etime)."\r\n".
-		      "Cache-Control: public; max-age=".$etime."\r\n";
-
-	if (!$gzipped && $use_gzip && $acceptenc{'gzip'} &&
-	    &should_gzip_file($full)) {
-		# Load and compress file, then output
-		print DEBUG "handle_request: outputting gzipped file $full\n";
-		open(FILE, $full) || &http_error(404, "Failed to open file");
-		{
-			local $/ = undef;
-			$data = <FILE>;
-		}
-		close(FILE);
-		@stopen = stat($file);
-		$data = Compress::Zlib::memGzip($data);
-		$resp .= "Content-length: ".length($data)."\r\n".
-			 "Content-Encoding: gzip\r\n";
-		&write_data($resp);
-		$rv = &write_keep_alive();
-		&write_data("\r\n");
-		&reset_byte_count();
-		&write_data($data);
-		}
-	else {
-		# Stream file output
-		$resp .= "Content-length: $stopen[7]\r\n";
-		$resp .= "Content-Encoding: gzip\r\n" if ($gzipped);
-		&write_data($resp);
-		$rv = &write_keep_alive();
-		&write_data("\r\n");
-		&reset_byte_count();
-		my $bufsize = $config{'bufsize'} || 32768;
-		while(read(FILE, $buf, $bufsize) > 0) {
-			&write_data($buf);
-			}
-		close(FILE);
-		}
-	}
-
-# log the request
-&log_request($loghost, $authuser, $reqline,
-	     $logged_code ? $logged_code :
-	     $cgiheader{"location"} ? "302" : $ok_code, &byte_count());
-return $rv;
-}
-
-# http_error(code, message, body, [dontexit], [dontstderr])
-# Output an error message to the browser, and log it to the error log
-sub http_error
-{
-my ($code, $msg, $body, $noexit, $noerr) = @_;
-local $eh = $error_handler_recurse ? undef :
-	    $config{"error_handler_".$code} ? $config{"error_handler_".$code} :
-	    $config{'error_handler'} ? $config{'error_handler'} : undef;
-print DEBUG "http_error code=$code message=$msg body=$body\n";
-if ($eh) {
-	my $found;
-	foreach my $root (@preroots, @roots) {
-		$found++ if (-e $root."/".$eh);
-		}
-	$eh = undef if (!$found);
-	}
-if ($eh) {
-	# Call a CGI program for the error
-	$page = "/$eh";
-	$querystring = "code=".&urlize($code)."&message=".&urlize($msg).
-		       "&body=".&urlize($body);
-	$error_handler_recurse++;
-	$ok_code = $code;
-	$ok_message = $msg;
-	goto rerun;
-	}
-else {
-	# Use the standard error message display
-	&write_data("HTTP/1.0 $code $msg\r\n");
-	&write_data("Server: @{[&server_info()]}\r\n");
-	&write_data("Date: $datestr\r\n");
-	&write_data("Content-type: text/html; Charset=utf-8\r\n");
-	&write_keep_alive(0);
-	&write_data("\r\n");
-	&reset_byte_count();
-	&write_data("<html>\n");
-	&write_data("<head>".&embed_error_styles($roots[0])."<title>$code &mdash; $msg</title></head>\n");
-	&write_data("<body class=\"err-body\"><h2 class=\"err-head\">Error &mdash; $msg</h2>\n");
-	if ($body) {
-		&write_data("<p class=\"err-content\">$body</p>\n");
-		}
-	&write_data("</body></html>\n");
-	}
-&log_request($loghost, $authuser, $reqline, $code, &byte_count())
-	if ($reqline);
-&log_error($msg, $body ? " : $body" : "") if (!$noerr);
-shutdown(SOCK, 1);
-close(SOCK);
-exit if (!$noexit);
-}
-
-# embed_error_styles()
-# Returns HTML styles for nicer errors. For internal use only.
-sub embed_error_styles
-{
-my ($root) = @_;
-if ($root) {
-	my $err_style = &read_any_file("$root/unauthenticated/errors.css");
-	if ($err_style) {
-		$err_style =~ s/[\n\r]//g;
-		$err_style =~ s/\s+/ /g;
-		$err_style = "<style data-err type=\"text/css\">$err_style</style>";
-		return "\n$err_style\n";
-		}
-	}
-return undef;
-}
-
-sub get_type
-{
-if ($_[0] =~ /\.([A-z0-9]+)$/) {
-	$t = $mime{$1};
-	if ($t ne "") {
-		return $t;
-		}
-	}
-return "text/plain";
-}
-
-# simplify_path(path, bogus)
-# Given a path, maybe containing stuff like ".." and "." convert it to a
-# clean, absolute form.
-sub simplify_path
-{
-local($dir, @bits, @fixedbits, $b);
-$dir = $_[0];
-$dir =~ s/\\/\//g;	# fix windows \ in path
-$dir =~ s/^\/+//g;
-$dir =~ s/\/+$//g;
-$dir =~ s/\0//g;	# remove null bytes
-@bits = split(/\/+/, $dir);
-@fixedbits = ();
-$_[1] = 0;
-foreach $b (@bits) {
-        if ($b eq ".") {
-                # Do nothing..
-                }
-        elsif ($b eq ".." || $b eq "...") {
-                # Remove last dir
-                if (scalar(@fixedbits) == 0) {
-                        $_[1] = 1;
-                        return "/";
-                        }
-                pop(@fixedbits);
-                }
-        else {
-                # Add dir to list
-                push(@fixedbits, $b);
-                }
-        }
-return "/" . join('/', @fixedbits);
-}
-
-# b64decode(string)
-# Converts a string from base64 format to normal
-sub b64decode
-{
-    local($str) = $_[0];
-    local($res);
-    $str =~ tr|A-Za-z0-9+=/||cd;
-    $str =~ s/=+$//;
-    $str =~ tr|A-Za-z0-9+/| -_|;
-    while ($str =~ /(.{1,60})/gs) {
-        my $len = chr(32 + length($1)*3/4);
-        $res .= unpack("u", $len . $1 );
-    }
-    return $res;
-}
-
-# b64encode(string)
-# Encodes a string into base64 format
-sub b64encode
-{
-my ($str) = @_;
-my $res;
-pos($str) = 0;                          # ensure start at the beginning
-while($str =~ /(.{1,57})/gs) {
-	$res .= substr(pack('u57', $1), 1);
-	chop($res);
-	}
-$res =~ tr|\` -_|AA-Za-z0-9+/|;
-my $padding = (3 - length($str) % 3) % 3;
-$res =~ s/.{$padding}$/'=' x $padding/e if ($padding);
-return $res;
-}
-
-# ip_match(remoteip, localip, [match]+)
-# Checks an IP address against a list of IPs, networks and networks/masks
-sub ip_match
-{
-local(@io, @mo, @ms, $i, $j, $hn, $needhn);
-@io = &check_ip6address($_[0]) ? split(/:/, $_[0])
-			       : split(/\./, $_[0]);
-for($i=2; $i<@_; $i++) {
-	$needhn++ if ($_[$i] =~ /^\*(\S+)$/);
-	}
-if ($needhn && !defined($hn = $ip_match_cache{$_[0]})) {
-	# Reverse-lookup hostname if any rules match based on it
-	$hn = &to_hostname($_[0]);
-	if (&check_ip6address($_[0])) {
-		local $ip6 = &to_ip6address($hn);
-		$hn = "" if (!$ip6 ||
-			     &canonicalize_ip6($ip6) ne
-			     	&canonicalize_ip6($_[0]));
-		}
-	else {
-		$hn = "" if (&to_ipaddress($hn) ne $_[0]);
-		}
-	$ip_match_cache{$_[0]} = $hn;
-	}
-for($i=2; $i<@_; $i++) {
-	local $mismatch = 0;
-	if ($_[$i] =~ /^([0-9\.]+)\/(\d+)$/) {
-		# Convert CIDR to netmask format
-		$_[$i] = $1."/".&prefix_to_mask($2);
-		}
-	if ($_[$i] =~ /^([0-9\.]+)\/([0-9\.]+)$/) {
-		# Compare with IPv4 network/mask
-		@mo = split(/\./, $1);
-		@ms = split(/\./, $2);
-		for($j=0; $j<4; $j++) {
-			if ((int($io[$j]) & int($ms[$j])) != (int($mo[$j]) & int($ms[$j]))) {
-				$mismatch = 1;
-				}
-			}
-		}
-	elsif ($_[$i] =~ /^([0-9\.]+)-([0-9\.]+)$/) {
-		# Compare with an IPv4 range (separated by a hyphen -)
-		local ($remote, $min, $max);
-		local @low = split(/\./, $1);
-		local @high = split(/\./, $2);
-		for($j=0; $j<4; $j++) {
-			$remote += $io[$j] << ((3-$j)*8);
-			$min += $low[$j] << ((3-$j)*8);
-			$max += $high[$j] << ((3-$j)*8);
-			}
-		if ($remote < $min || $remote > $max) {
-			$mismatch = 1;
-			}
-		}
-	elsif ($_[$i] =~ /^\*(\S+)$/) {
-		# Compare with hostname regexp
-		$mismatch = 1 if ($hn !~ /^.*\Q$1\E$/i);
-		}
-	elsif ($_[$i] eq 'LOCAL' && &check_ipaddress($_[1])) {
-		# Compare with local IPv4 network
-		local @lo = split(/\./, $_[1]);
-		if ($lo[0] < 128) {
-			$mismatch = 1 if ($lo[0] != $io[0]);
-			}
-		elsif ($lo[0] < 192) {
-			$mismatch = 1 if ($lo[0] != $io[0] ||
-					  $lo[1] != $io[1]);
-			}
-		else {
-			$mismatch = 1 if ($lo[0] != $io[0] ||
-					  $lo[1] != $io[1] ||
-					  $lo[2] != $io[2]);
-			}
-		}
-	elsif ($_[$i] eq 'LOCAL' && &check_ip6address($_[1])) {
-		# Compare with local IPv6 network, which is always first 4 words
-		local @lo = split(/:/, $_[1]);
-		for(my $i=0; $i<4; $i++) {
-			$mismatch = 1 if ($lo[$i] ne $io[$i]);
-			}
-		}
-	elsif ($_[$i] =~ /^[0-9\.]+$/) {
-		# Compare with a full or partial IPv4 address
-		@mo = split(/\./, $_[$i]);
-		while(@mo && !$mo[$#mo]) { pop(@mo); }
-		for($j=0; $j<@mo; $j++) {
-			if ($mo[$j] != $io[$j]) {
-				$mismatch = 1;
-				}
-			}
-		}
-	elsif ($_[$i] =~ /^[a-f0-9:]+$/) {
-		# Compare with a full IPv6 address
-		if (&canonicalize_ip6($_[$i]) ne canonicalize_ip6($_[0])) {
-			$mismatch = 1;
-			}
-		}
-	elsif ($_[$i] =~ /^([a-f0-9:]+)\/(\d+)$/) {
-		# Compare with an IPv6 network
-		local $v6size = $2;
-		local $v6addr = &canonicalize_ip6($1);
-		$mismatch = 1 if (!&ip6_prefix_match($_[0], $v6addr, $v6size));
-		}
-	elsif ($_[$i] !~ /^[0-9\.]+$/) {
-		# Compare with hostname
-		if (&check_ip6address($_[0])) {
-			local $ip6 = &to_ip6address($_[$i]);
-			$mismatch = 1 if (!$ip6 ||
-					  &canonicalize_ip6($ip6) ne
-					  	&canonicalize_ip6($_[0]));
-			}
-		else {
-			$mismatch = 1 if ($_[0] ne &to_ipaddress($_[$i]));
-			}
-		}
-	return 1 if (!$mismatch);
-	}
-return 0;
-}
-
-# users_match(&uinfo, user, ...)
-# Returns 1 if a user is in a list of users and groups
-sub users_match
-{
-local $uinfo = shift(@_);
-local $u;
-local @ginfo = getgrgid($uinfo->[3]);
-foreach $u (@_) {
-	if ($u =~ /^\@(\S+)$/) {
-		return 1 if (&is_group_member($uinfo, $1));
-		}
-	elsif ($u =~ /^(\d*)-(\d*)$/ && ($1 || $2)) {
-		return (!$1 || $uinfo[2] >= $1) &&
-		       (!$2 || $uinfo[2] <= $2);
-		}
-	else {
-		return 1 if ($u eq $uinfo->[0]);
-		}
-	}
-return 0;
-}
-
-# restart_miniserv()
-# Called when a SIGHUP is received to restart the web server. This is done
-# by exec()ing perl with the same command line as was originally used
-sub restart_miniserv
-{
-&log_error("Restarting");
-close(SOCK);
-&close_all_sockets();
-&close_all_pipes();
-dbmclose(%sessiondb);
-kill('KILL', $logclearer) if ($logclearer);
-kill('KILL', $extauth) if ($extauth);
-if (&indexof("--nofork", @miniserv_argv) < 0) {
-	unshift(@miniserv_argv, "--nofork");
-	}
-exec($perl_path, $miniserv_path, @miniserv_argv);
-die "Failed to restart miniserv with $perl_path $miniserv_path";
-}
-
-sub trigger_restart
-{
-$need_restart = 1;
-}
-
-sub trigger_reload
-{
-$need_reload = 1;
-}
-
-# to_ip46address(address, ...)
-# Convert hostnames to v4 and v6 addresses, if possible
-sub to_ip46address
-{
-local @rv;
-foreach my $i (@_) {
-	if (&check_ipaddress($i) || &check_ip6address($i)) {
-		push(@rv, $i);
-		}
-	else {
-		my $addr = &to_ipaddress($i);
-		$addr ||= &to_ip6address($i);
-		push(@rv, $addr) if ($addr);
-		}
-	}
-return @rv;
-}
-
-# to_ipaddress(address, ...)
-sub to_ipaddress
-{
-local (@rv, $i);
-foreach $i (@_) {
-	if ($i =~ /(\S+)\/(\S+)/ || $i =~ /^\*\S+$/ ||
-	    $i eq 'LOCAL' || $i =~ /^[0-9\.]+$/ || $i =~ /^[a-f0-9:]+$/) {
-		# A pattern or IP, not a hostname, so don't change
-		push(@rv, $i);
-		}
-	else {
-		# Lookup IP address
-		push(@rv, join('.', unpack("CCCC", inet_aton($i))));
-		}
-	}
-return wantarray ? @rv : $rv[0];
-}
-
-# to_ip6address(address, ...)
-sub to_ip6address
-{
-local (@rv, $i);
-foreach $i (@_) {
-	if ($i =~ /(\S+)\/(\S+)/ || $i =~ /^\*\S+$/ ||
-	    $i eq 'LOCAL' || $i =~ /^[0-9\.]+$/ || $i =~ /^[a-f0-9:]+$/) {
-		# A pattern, not a hostname, so don't change
-		push(@rv, $i);
-		}
-	elsif ($config{'ipv6'}) {
-		# Lookup IPv6 address
-		local ($inaddr, $addr);
-		eval {
-			(undef, undef, undef, $inaddr) =
-			    getaddrinfo($i, undef, AF_INET6(), SOCK_STREAM);
-			};
-		if (!$inaddr) {
-			push(@rv, undef);
-			}
-		else {
-			(undef, $addr) = unpack_sockaddr_in6($inaddr);
-			push(@rv, inet_ntop(AF_INET6(), $addr));
-			}
-		}
-	}
-return wantarray ? @rv : $rv[0];
-}
-
-# to_hostname(ipv4|ipv6-address)
-# Reverse-resolves an IPv4 or 6 address to a hostname
-sub to_hostname
-{
-local ($addr) = @_;
-if (&check_ip6address($_[0])) {
-	return gethostbyaddr(inet_pton(AF_INET6(), $addr),
-			     AF_INET6());
-	}
-else {
-	return gethostbyaddr(inet_aton($addr), AF_INET);
-	}
-}
-
-# read_line(no-wait, no-limit)
-# Reads one line from SOCK or SSL
-sub read_line
-{
-local ($nowait, $nolimit) = @_;
-local($idx, $more, $rv);
-while(($idx = index($main::read_buffer, "\n")) < 0) {
-	if (length($main::read_buffer) > 100000 && !$nolimit) {
-		&http_error(414, "Request too long",
-		    "Received excessive line <pre class=\"err-content\">".&html_strip($main::read_buffer)."</pre>");
-		}
-
-	# need to read more..
-	&wait_for_data_error() if (!$nowait);
-	if ($use_ssl) {
-		$more = Net::SSLeay::read($ssl_con);
-		}
-	else {
-		my $bufsize = $config{'bufsize'} || 32768;
-                local $ok = sysread(SOCK, $more, $bufsize);
-		$more = undef if ($ok <= 0);
-		}
-	if ($more eq '') {
-		# end of the data
-		$rv = $main::read_buffer;
-		undef($main::read_buffer);
-		return $rv;
-		}
-	$main::read_buffer .= $more;
-	}
-$rv = substr($main::read_buffer, 0, $idx+1);
-$main::read_buffer = substr($main::read_buffer, $idx+1);
-return $rv;
-}
-
-# read_data(length)
-# Reads up to some amount of data from SOCK or the SSL connection
-sub read_data
-{
-local ($rv);
-if (length($main::read_buffer)) {
-	if (length($main::read_buffer) > $_[0]) {
-		# Return the first part of the buffer
-		$rv = substr($main::read_buffer, 0, $_[0]);
-		$main::read_buffer = substr($main::read_buffer, $_[0]);
-		return $rv;
-		}
-	else {
-		# Return the whole buffer
-		$rv = $main::read_buffer;
-		undef($main::read_buffer);
-		return $rv;
-		}
-	}
-elsif ($use_ssl) {
-	# Call SSL read function
-	return Net::SSLeay::read($ssl_con, $_[0]);
-	}
-else {
-	# Just do a normal read
-	local $buf;
-	sysread(SOCK, $buf, $_[0]) || return undef;
-	return $buf;
-	}
-}
-
-# wait_for_data(secs)
-# Waits at most the given amount of time for some data on SOCK, returning
-# 0 if not found, 1 if some arrived.
-sub wait_for_data
-{
-local $rmask;
-vec($rmask, fileno(SOCK), 1) = 1;
-local $got = select($rmask, undef, undef, $_[0]);
-return $got == 0 ? 0 : 1;
-}
-
-# wait_for_data_error()
-# Waits 60 seconds for data on SOCK, and fails if none arrives
-sub wait_for_data_error
-{
-local $got = &wait_for_data(60);
-if (!$got) {
-	&http_error(400, "Timeout",
-		    "Waited more than 60 seconds for request data");
-	}
-}
-
-# write_data(data, ...)
-# Writes a string to SOCK or the SSL connection
-sub write_data
-{
-local $str = join("", @_);
-if ($use_ssl) {
-	Net::SSLeay::write($ssl_con, $str);
-	}
-else {
-	eval { syswrite(SOCK, $str, length($str)); };
-	if ($@ =~ /wide\s+character/i) {
-		eval { utf8::encode($str);
-		       syswrite(SOCK, $str, length($str)); };
-		}
-	if ($@) {
-		# Somehow a string come through that contains invalid chars
-		&log_error($@);
-		for(my $i=0; my @stack = caller($i); $i++) {
-			&log_error(join(" ", @stack));
-			}
-		}
-	}
-$write_data_count += length($str);
-}
-
-# reset_byte_count()
-sub reset_byte_count { $write_data_count = 0; }
-
-# byte_count()
-sub byte_count { return $write_data_count; }
-
-# get_logged_sensitive_params()
-# Returns query parameter names whose values should be redacted in access logs
-sub get_logged_sensitive_params
-{
-my @rv = qw(access_token api_key auth key pass passwd password refresh_token secret token);
-my %seen = map { lc($_) => 1 } @rv;
-if ($config{'log_redact_params'}) {
-	foreach my $param (split(/\s+|,\s*/, $config{'log_redact_params'})) {
-		next if (!$param);
-		my $lparam = lc($param);
-		next if ($seen{$lparam}++);
-		push(@rv, $param);
-		}
-	}
-return @rv;
-}
-
-# sanitise_logged_request(request)
-# Redacts sensitive query parameter values from a request line before logging
-sub sanitise_logged_request
-{
-my ($request) = @_;
-return $request if (!defined($request));
-my $sanitised = $request;
-my @sensitive = &get_logged_sensitive_params();
-return $request if (!@sensitive);
-my $sensitive = qr/(?:@{[join("|", map { quotemeta($_) } @sensitive)]})/i;
-
-if ($sanitised =~ /^(\S+\s+)(\S+)(\s+HTTP\/\d+\.\d+)$/) {
-	my ($prefix, $uri, $suffix) = ($1, $2, $3);
-	$uri =~ s/([?&;])((?:$sensitive))=([^&;\s]*)/$1.$2."=***"/ige;
-	$sanitised = $prefix.$uri.$suffix;
-	}
-
-return $sanitised;
-}
-
-# log_request(hostname, user, request, code, bytes)
-# Write an HTTP request to the log file
-sub log_request
-{
-local ($host, $user, $request, $code, $bytes) = @_;
-local $headers;
-my $request_nolog = $request;
-my $request_log = &sanitise_logged_request($request);
-
-# Process full request string like `POST /index.cgi?param=1 HTTP/1.1` as well
-if ($request =~ /^(POST|GET)\s+/) {
-	$request_nolog =~ s/(.*?)(\/.*?)\s+(.*)/$2/g;
-	}
-if ($config{'nolog'}) {
-	foreach my $nolog (split(/\s+/, $config{'nolog'})) {
-		return if ($request_nolog =~ /^$nolog$/);
-		}
-	}
-if ($config{'log'}) {
-	local $ident = "-";
-	$user ||= "-";
-	local $dstr = &make_datestr();
-	if (fileno(MINISERVLOG)) {
-		seek(MINISERVLOG, 0, 2);
-		}
-	else {
-		open(MINISERVLOG, ">>$config{'logfile'}");
-		chmod(0600, $config{'logfile'});
-		}
-	if (defined($config{'logheaders'})) {
-		foreach $h (split(/\s+/, $config{'logheaders'})) {
-			$headers .= " $h=\"$header{$h}\"";
-			}
-		}
-	elsif ($config{'logclf'}) {
-		$headers = " \"$header{'referer'}\" \"$header{'user-agent'}\"";
-		}
-	else {
-		$headers = "";
-		}
-	print MINISERVLOG "$host $ident $user [$dstr] \"$request_log\" ",
-			  "$code $bytes$headers\n";
-	close(MINISERVLOG);
-	}
-}
-
-# make_datestr()
-sub make_datestr
-{
-local @tm = localtime(time());
-return sprintf "%2.2d/%s/%4.4d:%2.2d:%2.2d:%2.2d %s",
-		$tm[3], $month[$tm[4]], $tm[5]+1900,
-	        $tm[2], $tm[1], $tm[0], $timezone;
-}
-
-# log_error(message)
-sub log_error
-{
-seek(STDERR, 0, 2);
-print STDERR "[",&make_datestr(),"] ",
-	$acpthost ? ( "[",$acpthost,"] " ) : ( ),
-	$page ? ( $page," : " ) : ( ),
-	@_,"\n";
-}
-
-# read_errors(handle)
-# Read and return all input from some filehandle
-sub read_errors
-{
-local($fh, $_, $rv);
-$fh = $_[0];
-while(<$fh>) { $rv .= $_; }
-return $rv;
-}
-
-sub write_keep_alive
-{
-local $mode;
-if ($config{'nokeepalive'}) {
-	# Keep alives have been disabled in config
-	$mode = 0;
-	}
-elsif (@childpids > $config{'maxconns'}*.8) {
-	# Disable because nearing process limit
-	$mode = 0;
-	}
-elsif (@_) {
-	# Keep alive specified by caller
-	$mode = $_[0];
-	}
-else {
-	# Keep alive determined by browser
-	$mode = $header{'connection'} =~ /keep-alive/i;
-	}
-&write_data("Connection: ".($mode ? "Keep-Alive" : "close")."\r\n");
-return $mode;
-}
-
-sub term_handler
-{
-&log_error("Shutting down");
-kill('TERM', @childpids) if (@childpids);
-kill('KILL', $logclearer) if ($logclearer);
-kill('KILL', $extauth) if ($extauth);
-unlink($config{'pidfile'});
-exit(1);
-}
-
-sub http_date
-{
-local @tm = gmtime($_[0]);
-return sprintf "%s, %d %s %d %2.2d:%2.2d:%2.2d GMT",
-		$weekday[$tm[6]], $tm[3], $month[$tm[4]], $tm[5]+1900,
-		$tm[2], $tm[1], $tm[0];
-}
-
-sub TIEHANDLE
-{
-my $i; bless \$i, shift;
-}
- 
-sub WRITE
-{
-$r = shift;
-my($buf,$len,$offset) = @_;
-&write_to_sock(substr($buf, $offset, $len));
-$miniserv::page_capture_out .= substr($buf, $offset, $len)
-	if ($miniserv::page_capture);
-}
- 
-sub PRINT
-{
-$r = shift;
-$$r++;
-my $buf = join(defined($,) ? $, : "", @_);
-$buf .= $\ if defined($\);
-&write_to_sock($buf);
-$miniserv::page_capture_out .= $buf
-	if ($miniserv::page_capture);
-}
- 
-sub PRINTF
-{
-shift;
-my $fmt = shift;
-my $buf = sprintf $fmt, @_;
-&write_to_sock($buf);
-$miniserv::page_capture_out .= $buf
-	if ($miniserv::page_capture);
-}
- 
-# Send back already read data while we have it, then read from SOCK
-sub READ
-{
-my $r = shift;
-my $bufref = \$_[0];
-my $len = $_[1];
-my $offset = $_[2];
-if ($postpos < length($postinput)) {
-	# Reading from already fetched array
-	my $left = length($postinput) - $postpos;
-	my $canread = $len > $left ? $left : $len;
-	substr($$bufref, $offset, $canread) =
-		substr($postinput, $postpos, $canread);
-	$postpos += $canread;
-	return $canread;
-	}
-else {
-	# Read from network socket
-	local $data = &read_data($len);
-	if ($data eq '' && $len) {
-		# End of socket
-		shutdown(SOCK, 0);
-		}
-	substr($$bufref, $offset, length($data)) = $data;
-	return length($data);
-	}
-}
-
-sub OPEN
-{
-#print STDERR "open() called - should never happen!\n";
-}
- 
-# Read a line of input
-sub READLINE
-{
-my $r = shift;
-if ($postpos < length($postinput) &&
-    ($idx = index($postinput, "\n", $postpos)) >= 0) {
-	# A line exists in the memory buffer .. use it
-	my $line = substr($postinput, $postpos, $idx-$postpos+1);
-	$postpos = $idx+1;
-	return $line;
-	}
-else {
-	# Need to read from the socket
-	my $line;
-	if ($postpos < length($postinput)) {
-		# Start with in-memory data
-		$line = substr($postinput, $postpos);
-		$postpos = length($postinput);
-		}
-	my $nl = &read_line(0, 1);
-	if ($nl eq '') {
-		# End of socket
-		shutdown(SOCK, 0);
-		}
-	$line .= $nl if (defined($nl));
-	return $line;
-	}
-}
- 
-# Read one character of input
-sub GETC
-{
-my $r = shift;
-my $buf;
-my $got = READ($r, \$buf, 1, 0);
-return $got > 0 ? $buf : undef;
-}
-
-sub FILENO
-{
-return fileno(SOCK);
-}
- 
-sub CLOSE { }
- 
-sub DESTROY { }
-
-# write_to_sock(data, ...)
-sub write_to_sock
-{
-local $d;
-foreach $d (@_) {
-	if ($doneheaders || $miniserv::nph_script) {
-		&write_data($d);
-		}
-	else {
-		$headers .= $d;
-		while(!$doneheaders && $headers =~ s/^([^\r\n]*)(\r)?\n//) {
-			if ($1 =~ /^(\S+):\s+(.*)$/) {
-				$cgiheader{lc($1)} = $2;
-				push(@cgiheader, [ $1, $2 ]);
-				}
-			elsif ($1 !~ /\S/) {
-				$doneheaders++;
-				}
-			else {
-				&http_error(500, "Bad Header");
-				}
-			}
-		if ($doneheaders) {
-			if ($cgiheader{"location"}) {
-				&write_data(
-					"HTTP/1.0 302 Moved Temporarily\r\n");
-				&write_data("Date: $datestr\r\n");
-				&write_data("Server: @{[&server_info()]}\r\n");
-				&write_keep_alive(0);
-				}
-			elsif ($cgiheader{"content-type"} eq "") {
-				&http_error(500, "Missing Content-Type Header");
-				}
-			else {
-				&write_data("HTTP/1.0 $ok_code $ok_message\r\n");
-				&write_data("Date: $datestr\r\n");
-				&write_data("Server: @{[&server_info()]}\r\n");
-				&write_keep_alive(0);
-				}
-			foreach $h (@cgiheader) {
-				&write_data("$h->[0]: $h->[1]\r\n");
-				}
-			&write_data("\r\n");
-			&reset_byte_count();
-			&write_data($headers);
-			}
-		}
-	}
-}
-
-sub verify_client
-{
-local $cert = Net::SSLeay::X509_STORE_CTX_get_current_cert($_[1]);
-if ($cert) {
-	local $errnum = Net::SSLeay::X509_STORE_CTX_get_error($_[1]);
-	$verified_client = 1 if (!$errnum);
-	}
-return 1;
-}
-
-sub END
-{
-if ($doing_cgi_eval && $$ == $main_process_id) {
-	# A CGI program called exit! This is a horrible hack to 
-	# finish up before really exiting
-	shutdown(SOCK, 1);
-	close(SOCK);
-	close($PASSINw); close($PASSOUTw);
-	&log_request($loghost, $authuser, $reqline,
-		     $cgiheader{"location"} ? "302" : $ok_code, &byte_count());
-	}
-}
-
-# urlize
-# Convert a string to a form ok for putting in a URL
-sub urlize {
-  local($tmp, $tmp2, $c);
-  $tmp = $_[0];
-  $tmp2 = "";
-  while(($c = chop($tmp)) ne "") {
-	if ($c !~ /[A-z0-9]/) {
-		$c = sprintf("%%%2.2X", ord($c));
-		}
-	$tmp2 = $c . $tmp2;
-	}
-  return $tmp2;
-}
-
-# validate_user_caseless(username, password, host, remote-ip, webmin-port)
-# Calls validate_user, but also checks the lower case name if the given login
-# is mixed case
-sub validate_user_caseless
-{
-my @args = @_;
-my @rv = &validate_user(@args);
-if (!$rv[0] && $args[0] ne lc($args[0])) {
-	$args[0] = lc($args[0]);
-	@rv = &validate_user(@args);
-	}
-return @rv;
-}
-
-# validate_user(username, password, host, remote-ip, webmin-port)
-# Checks if some username and password are valid. Returns the modified username,
-# the expired / temp pass flag, the non-existence flag, and the underlying
-# Webmin username.
-sub validate_user
-{
-local ($user, $pass, $host, $actpip, $port) = @_;
-return ( ) if (!$user);
-print DEBUG "validate_user: user=$user pass=$pass host=$host\n";
-local ($canuser, $canmode, $notexist, $webminuser, $sudo) =
-	&can_user_login($user, undef, $host);
-print DEBUG "validate_user: canuser=$canuser canmode=$canmode notexist=$notexist webminuser=$webminuser sudo=$sudo\n";
-if ($notexist) {
-	# User doesn't even exist, so go no further
-	return ( undef, 0, 1, $webminuser );
-	}
-elsif ($canmode == 0) {
-	# User does exist but cannot login
-	return ( $canuser, 0, 0, $webminuser );
-	}
-elsif ($canmode == 1) {
-	# Attempt Webmin authentication
-	my $uinfo = &get_user_details($webminuser, $canuser);
-	if ($uinfo &&
-	    &password_crypt($pass, $uinfo->{'pass'}) eq $uinfo->{'pass'}) {
-		# Password is valid .. but check for expiry
-		local $lc = $uinfo->{'lastchanges'};
-		print DEBUG "validate_user: Password is valid lc=$lc pass_maxdays=$config{'pass_maxdays'}\n";
-		if ($config{'pass_maxdays'} && $lc && !$uinfo->{'nochange'}) {
-			local $daysold = (time() - $lc)/(24*60*60);
-			print DEBUG "maxdays=$config{'pass_maxdays'} daysold=$daysold temppass=$uinfo->{'temppass'}\n";
-			if ($config{'pass_lockdays'} &&
-			    $daysold > $config{'pass_lockdays'}) {
-				# So old that the account is locked
-				return ( undef, 0, 0, $webminuser );
-				}
-			elsif ($daysold > $config{'pass_maxdays'}) {
-				# Password has expired
-				return ( $user, 1, 0, $webminuser );
-				}
-			}
-		if ($uinfo->{'temppass'}) {
-			# Temporary password - force change now
-			return ( $user, 2, 0, $webminuser );
-			}
-		return ( $user, 0, 0, $webminuser );
-		}
-	elsif (!$uinfo) {
-		print DEBUG "validate_user: User $webminuser not found\n";
-		return ( undef, 0, 0, $webminuser );
-		}
-	else {
-		print DEBUG "validate_user: User $webminuser password mismatch $pass != $uinfo->{'pass'}\n";
-		return ( undef, 0, 0, $webminuser );
-		}
-	}
-elsif ($canmode == 2 || $canmode == 3) {
-	# Attempt PAM or passwd file authentication
-	local $val = &validate_unix_user($canuser, $pass, $acptip, $port);
-	print DEBUG "validate_user: unix val=$val\n";
-	if ($val && $sudo) {
-		# Need to check if this Unix user can sudo
-		if (!&check_sudo_permissions($canuser, $pass)) {
-			print DEBUG "validate_user: sudo failed\n";
-			$val = 0;
-			}
-		else {
-			print DEBUG "validate_user: sudo passed\n";
-			}
-		}
-	return $val == 2 ? ( $canuser, 1, 0, $webminuser ) :
-	       $val == 1 ? ( $canuser, 0, 0, $webminuser ) :
-			   ( undef, 0, 0, $webminuser );
-	}
-elsif ($canmode == 4) {
-	# Attempt external authentication
-	return &validate_external_user($canuser, $pass) ?
-		( $canuser, 0, 0, $webminuser ) :
-		( undef, 0, 0, $webminuser );
-	}
-else {
-	# Can't happen!
-	return ( );
-	}
-}
-
-# validate_unix_user(user, password, remote-ip, local-port)
-# Returns 1 if a username and password are valid under unix, 0 if not,
-# or 2 if the account has expired.
-# Checks PAM if available, and falls back to reading the system password
-# file otherwise.
-sub validate_unix_user
-{
-if ($use_pam) {
-	# Check with PAM
-	$pam_username = $_[0];
-	$pam_password = $_[1];
-	eval "use Authen::PAM;";
-	local $pamh = new Authen::PAM($config{'pam'}, $pam_username,
-				      \&pam_conv_func);
-	if (ref($pamh)) {
-		print DEBUG "validate_unix_user: using PAM\n";
-		$pamh->pam_set_item(PAM_RHOST(), $_[2]) if ($_[2]);
-		$pamh->pam_set_item(PAM_TTY(), $_[3]) if ($_[3]);
-		local $rcode = 0;
-		local $pam_ret = $pamh->pam_authenticate();
-		print DEBUG "validate_unix_user: pam_ret=$pam_ret\n";
-		if ($pam_ret == PAM_SUCCESS()) {
-			# Logged in OK .. make sure password hasn't expired
-			local $acct_ret = $pamh->pam_acct_mgmt();
-			print DEBUG "validate_unix_user: acct_ret=$acct_ret\n";
-			$pam_ret = $acct_ret;
-			if ($acct_ret == PAM_SUCCESS()) {
-				$pamh->pam_open_session();
-				$rcode = 1;
-				}
-			elsif ($acct_ret == PAM_NEW_AUTHTOK_REQD() ||
-			       $acct_ret == PAM_ACCT_EXPIRED()) {
-				$rcode = 2;
-				}
-			else {
-				&log_error("Unknown pam_acct_mgmt return value : $acct_ret");
-				$rcode = 0;
-				}
-			}
-		if ($config{'pam_end'}) {
-			$pamh->pam_end($pam_ret);
-			}
-		return $rcode;
-		}
-	}
-elsif ($config{'pam_only'}) {
-	# Pam is not available, but configuration forces it's use!
-	return 0;
-	}
-elsif ($config{'passwd_file'}) {
-	# Check in a password file
-	local $rv = 0;
-	print DEBUG "validate_unix_user: reading $config{'passwd_file'}\n";
-	open(FILE, $config{'passwd_file'});
-	if ($config{'passwd_file'} eq '/etc/security/passwd') {
-		# Assume in AIX format
-		while(<FILE>) {
-			s/\s*$//;
-			if (/^\s*(\S+):/ && $1 eq $_[0]) {
-				$_ = <FILE>;
-				if (/^\s*password\s*=\s*(\S+)\s*$/) {
-					$rv = $1 eq &password_crypt($_[1], $1) ?
-						1 : 0;
-					}
-				last;
-				}
-			}
-		}
-	else {
-		# Read the system password or shadow file
-		while(<FILE>) {
-			local @l = split(/:/, $_, -1);
-			local $u = $l[$config{'passwd_uindex'}];
-			local $p = $l[$config{'passwd_pindex'}];
-			if ($u eq $_[0]) {
-				$rv = $p eq &password_crypt($_[1], $p) ? 1 : 0;
-				if ($config{'passwd_cindex'} ne '' && $rv) {
-					# Password may have expired!
-					local $c = $l[$config{'passwd_cindex'}];
-					local $m = $l[$config{'passwd_mindex'}];
-					local $day = time()/(24*60*60);
-					print DEBUG "validate_unix_user: c=$c m=$m day=$day\n";
-					if ($c =~ /^\d+/ && $m =~ /^\d+/ && $day - $c > $m) {
-						# Yep, it has ..
-						$rv = 2;
-						}
-					}
-				if ($p eq "" && $config{'passwd_blank'}) {
-					# Force password change
-					$rv = 2;
-					}
-				last;
-				}
-			}
-		}
-	close(FILE);
-	return $rv if ($rv);
-	}
-
-# Fallback option - check password returned by getpw*
-local @uinfo = getpwnam($_[0]);
-if ($uinfo[1] ne '' && &password_crypt($_[1], $uinfo[1]) eq $uinfo[1]) {
-	return 1;
-	}
-
-return 0;	# Totally failed
-}
-
-# validate_external_user(user, pass)
-# Validate a user by passing the username and password to an external
-# squid-style authentication program
-sub validate_external_user
-{
-return 0 if (!$config{'extauth'});
-flock(EXTAUTH, 2);
-local $str = "$_[0] $_[1]\n";
-syswrite(EXTAUTH, $str, length($str));
-local $resp = <EXTAUTH>;
-flock(EXTAUTH, 8);
-return $resp =~ /^OK/i ? 1 : 0;
-}
-
-# can_user_login(username, no-append, host)
-# Checks if a user can login or not.
-# First return value is the username.
-# Second is 0 if cannot login, 1 if using Webmin pass, 2 if PAM, 3 if password
-# file, 4 if external.
-# Third is 1 if the user does not exist at all, 0 if he does.
-# Fourth is the Webmin username whose permissions apply, based on unixauth.
-# Fifth is a flag indicating if a sudo check is needed.
-sub can_user_login
-{
-local $uinfo = &get_user_details($_[0]);
-if (!$uinfo) {
-	# See if this user exists in Unix and can be validated by the same
-	# method as the unixauth webmin user
-	local $realuser = $unixauth{$_[0]};
-	local @uinfo;
-	local $sudo = 0;
-	local $pamany = 0;
-	eval { @uinfo = getpwnam($_[0]); };	# may fail on windows
-	if (!$realuser && @uinfo) {
-		# No unixauth entry for the username .. try his groups 
-		foreach my $ua (keys %unixauth) {
-			if ($ua =~ /^\@(.*)$/) {
-				if (&is_group_member(\@uinfo, $1)) {
-					$realuser = $unixauth{$ua};
-					last;
-					}
-				}
-			}
-		}
-	if (!$realuser && @uinfo) {
-		# Fall back to unix auth for all Unix users
-		$realuser = $unixauth{"*"};
-		}
-	if (!$realuser && $use_sudo && @uinfo) {
-		# Allow login effectively as root, if sudo permits it
-		$sudo = 1;
-		$realuser = "root";
-		}
-	if (!$realuser && !@uinfo && $config{'pamany'}) {
-		# If the user completely doesn't exist, we can still allow
-		# him to authenticate via PAM
-		$realuser = $config{'pamany'};
-		$pamany = 1;
-		}
-	if (!$realuser) {
-		# For Usermin, always fall back to unix auth for any user,
-		# so that later checks with domain added / removed are done.
-		$realuser = $unixauth{"*"};
-		}
-	return (undef, 0, 1, undef) if (!$realuser);
-	local $uinfo = &get_user_details($realuser);
-	return (undef, 0, 1, undef) if (!$uinfo);
-	local $up = $uinfo->{'pass'};
-
-	# Work out possible domain names from the hostname
-	local @doms = ( $_[2] );
-	if ($_[2] =~ /^([^\.]+)\.(\S+)$/) {
-		push(@doms, $2);
-		}
-
-	if ($config{'user_mapping'} && !%user_mapping) {
-		# Read the user mapping file
-		%user_mapping = ();
-		open(MAPPING, $config{'user_mapping'});
-		while(<MAPPING>) {
-			s/\r|\n//g;
-			s/#.*$//;
-			if (/^(\S+)\s+(\S+)/) {
-				my ($from, $to) = ($1, $2);
-				$from =~ s/\\(.)/$1/g;
-				$to =~ s/\\(.)/$1/g;
-				if ($config{'user_mapping_reverse'}) {
-					$user_mapping{$from} = $to;
-					}
-				else {
-					$user_mapping{$to} = $from;
-					}
-				}
-			}
-		close(MAPPING);
-		}
-
-	# Check the user mapping file to see if there is an entry for the
-	# user login in which specifies a new effective user
-	local $um;
-	foreach my $d (@doms) {
-		$um ||= $user_mapping{"$_[0]\@$d"};
-		}
-	$um ||= $user_mapping{$_[0]};
-	if (defined($um) && ($_[1]&4) == 0) {
-		# A mapping exists - use it!
-		return &can_user_login($um, $_[1]+4, $_[2]);
-		}
-
-	# Check if a user with the entered login and the domains appended
-	# or prepended exists, and if so take it to be the effective user
-	if (!@uinfo && $config{'domainuser'}) {
-		# Try again with name.domain and name.firstpart
-		local @firsts = map { /^([^\.]+)/; $1 } @doms;
-		if (($_[1]&1) == 0) {
-			local ($a, $p);
-			foreach $a (@firsts, @doms) {
-				foreach $p ("$_[0].${a}", "$_[0]-${a}",
-					    "${a}.$_[0]", "${a}-$_[0]",
-					    "$_[0]_${a}", "${a}_$_[0]") {
-					local @vu = &can_user_login(
-							$p, $_[1]+1, $_[2]);
-					return @vu if ($vu[1]);
-					}
-				}
-			}
-		}
-
-	# Check if the user entered a domain at the end of his username when
-	# he really shouldn't have, and if so try without it
-	if (!@uinfo && $config{'domainstrip'} &&
-	    $_[0] =~ /^(\S+)\@(\S+)$/ && ($_[1]&2) == 0) {
-		local ($stripped, $dom) = ($1, $2);
-		local @vu = &can_user_login($stripped, $_[1] + 2, $_[2]);
-		return @vu if ($vu[1]);
-		local @vu = &can_user_login($stripped, $_[1] + 2, $dom);
-		return @vu if ($vu[1]);
-		}
-
-	return ( undef, 0, 1, undef ) if (!@uinfo && !$pamany);
-
-	if (@uinfo) {
-		if (scalar(@allowusers)) {
-			# Only allow people on the allow list
-			return ( undef, 0, 0, undef )
-				if (!&users_match(\@uinfo, @allowusers));
-			}
-		elsif (scalar(@denyusers)) {
-			# Disallow people on the deny list
-			return ( undef, 0, 0, undef )
-				if (&users_match(\@uinfo, @denyusers));
-			}
-		if ($config{'shells_deny'}) {
-			local $found = 0;
-			open(SHELLS, $config{'shells_deny'});
-			while(<SHELLS>) {
-				s/\r|\n//g;
-				s/#.*$//;
-				$found++ if ($_ eq $uinfo[8]);
-				}
-			close(SHELLS);
-			return ( undef, 0, 0, undef ) if (!$found);
-			}
-		}
-
-	if ($up eq 'x') {
-		# PAM or passwd file authentication
-		print DEBUG "can_user_login: Validate with PAM\n";
-		return ( $_[0], $use_pam ? 2 : 3, 0, $realuser, $sudo );
-		}
-	elsif ($up eq 'e') {
-		# External authentication
-		print DEBUG "can_user_login: Validate externally\n";
-		return ( $_[0], 4, 0, $realuser, $sudo );
-		}
-	else {
-		# Fixed Webmin password
-		print DEBUG "can_user_login: Validate by Webmin\n";
-		return ( $_[0], 1, 0, $realuser, $sudo );
-		}
-	}
-elsif ($uinfo->{'pass'} eq 'x') {
-	# Webmin user authenticated via PAM or password file
-	return ( $_[0], $use_pam ? 2 : 3, 0, $_[0] );
-	}
-elsif ($uinfo->{'pass'} eq 'e') {
-	# Webmin user authenticated externally
-	return ( $_[0], 4, 0, $_[0] );
-	}
-else {
-	# Normal Webmin user
-	return ( $_[0], 1, 0, $_[0] );
-	}
-}
-
-# the PAM conversation function for interactive logins
-sub pam_conv_func
-{
-$pam_conv_func_called++;
-my @res;
-while ( @_ ) {
-	my $code = shift;
-	my $msg = shift;
-	my $ans = "";
-
-	$ans = $pam_username if ($code == PAM_PROMPT_ECHO_ON() );
-	$ans = $pam_password if ($code == PAM_PROMPT_ECHO_OFF() );
-
-	push @res, PAM_SUCCESS();
-	push @res, $ans;
-	}
-push @res, PAM_SUCCESS();
-return @res;
-}
-
-sub urandom_timeout
-{
-close(RANDOM);
-}
-
-# get_socket_ip(handle, ipv6-flag)
-# Returns the local IP address of some connection, as both a string and in
-# binary format
-sub get_socket_ip
-{
-local ($fh, $ipv6) = @_;
-local $sn = getsockname($fh);
-return undef if (!$sn);
-return &get_address_ip($sn, $ipv6);
-}
-
-# get_address_ip(address, ipv6-flag)
-# Given a sockaddr object in binary format, return the binary address, text
-# address and port number
-sub get_address_ip
-{
-local ($sn, $ipv6) = @_;
-if ($ipv6) {
-	local ($p, $b) = unpack_sockaddr_in6($sn);
-	return ($b, inet_ntop(AF_INET6(), $b), $p);
-	}
-else {
-	local ($p, $b) = unpack_sockaddr_in($sn);
-	return ($b, inet_ntoa($b), $p);
-	}
-}
-
-# get_socket_name(handle, ipv6-flag)
-# Returns the local hostname or IP address of some connection
-sub get_socket_name
-{
-local ($fh, $ipv6) = @_;
-return $config{'host'} if ($config{'host'});
-local ($mybin, $myaddr) = &get_socket_ip($fh, $ipv6);
-if (!$get_socket_name_cache{$myaddr}) {
-	local $myname;
-	if (!$config{'no_resolv_myname'}) {
-		$myname = gethostbyaddr($mybin,
-					$ipv6 ? AF_INET6() : AF_INET);
-		}
-	$myname ||= $myaddr;
-	$get_socket_name_cache{$myaddr} = $myname;
-	}
-return $get_socket_name_cache{$myaddr};
-}
-
-# run_login_script(username, sid, remoteip, localip)
-sub run_login_script
-{
-if ($config{'login_script'}) {
-	alarm(5);
-	$SIG{'ALRM'} = sub { die "timeout" };
-	eval {
-		system($config{'login_script'}.
-		       " ".join(" ", map { quotemeta($_) || '""' } @_).
-		       " >/dev/null 2>&1 </dev/null");
-		};
-	alarm(0);
-	}
-}
-
-# run_logout_script(username, sid, remoteip, localip)
-sub run_logout_script
-{
-if ($config{'logout_script'}) {
-	alarm(5);
-	$SIG{'ALRM'} = sub { die "timeout" };
-	eval {
-		system($config{'logout_script'}.
-		       " ".join(" ", map { quotemeta($_) || '""' } @_).
-		       " >/dev/null 2>&1 </dev/null");
-		};
-	alarm(0);
-	}
-}
-
-# run_failed_script(username, reason-code, remoteip, localip)
-sub run_failed_script
-{
-if ($config{'failed_script'}) {
-	$_[0] =~ s/\r|\n/ /g;
-	alarm(5);
-	$SIG{'ALRM'} = sub { die "timeout" };
-	eval {
-		system($config{'failed_script'}.
-		       " ".join(" ", map { quotemeta($_) || '""' } @_).
-		       " >/dev/null 2>&1 </dev/null");
-		};
-	alarm(0);
-	}
-}
-
-# close_all_sockets()
-# Closes all the main listening sockets
-sub close_all_sockets
-{
-local $s;
-foreach $s (@socketfhs) {
-	close($s);
-	}
-}
-
-# close_all_pipes()
-# Close all pipes for talking to sub-processes
-sub close_all_pipes
-{
-local $p;
-foreach $p (@passin) { close($p); }
-foreach $p (@passout) { close($p); }
-foreach $p (values %conversations) {
-	if ($p->{'PAMOUTr'}) {
-		close($p->{'PAMOUTr'});
-		close($p->{'PAMINw'});
-		}
-	}
-}
-
-# check_user_ip(user)
-# Returns 1 if some user is allowed to login from the accepting IP, 0 if not
-sub check_user_ip
-{
-local ($username) = @_;
-local $uinfo = &get_user_details($username);
-return 1 if (!$uinfo);
-if ($uinfo->{'deny'} &&
-    &ip_match($acptip, $localip, @{$uinfo->{'deny'}}) ||
-    $uinfo->{'allow'} &&
-    !&ip_match($acptip, $localip, @{$uinfo->{'allow'}})) {
-	return 0;
-	}
-return 1;
-}
-
-# check_user_time(user)
-# Returns 1 if some user is allowed to login at the current date and time
-sub check_user_time
-{
-local ($username) = @_;
-local $uinfo = &get_user_details($username);
-return 1 if (!$uinfo || !$uinfo->{'allowdays'} && !$uinfo->{'allowhours'});
-local @tm = localtime(time());
-if ($uinfo->{'allowdays'}) {
-	# Make sure day is allowed
-	return 0 if (&indexof($tm[6], @{$uinfo->{'allowdays'}}) < 0);
-	}
-if ($uinfo->{'allowhours'}) {
-	# Make sure time is allowed
-	local $m = $tm[2]*60+$tm[1];
-	return 0 if ($m < $uinfo->{'allowhours'}->[0] ||
-		     $m > $uinfo->{'allowhours'}->[1]);
-	}
-return 1;
-}
-
-# generate_random_id(password, [force-urandom])
-# Returns a random session ID number
-sub generate_random_id
-{
-my ($force_urandom) = @_;
-local $sid;
-if (!$bad_urandom) {
-	# First try /dev/urandom, unless we have marked it as bad
-	$SIG{ALRM} = "miniserv::urandom_timeout";
-	alarm(5);
-	if (open(RANDOM, "/dev/urandom")) {
-		my $tmpsid;
-		if (read(RANDOM, $tmpsid, 16) == 16) {
-			$sid = lc(unpack('h*',$tmpsid));
-			if ($sid !~ /^[0-9a-fA-F]{32}$/) {
-				$sid = 'bad';
-				}
-			}
-		close(RANDOM);
-		}
-	alarm(0);
-	}
-if (!$sid && !$force_urandom) {
-	my $offset = int(rand(2048));
-	my @charset = ('0' ..'9', 'a' .. 'f');
-	$sid = join('', map { $charset[rand(@charset)] } 1 .. 4096);
-	$sid = substr($sid, $offset, 32);
-	}
-return $sid;
-}
-
-# handle_login(username, ok, expired, not-exists, password,
-#              [no-test-cookie], [no-log], [twofactor-probe])
-# Called from handle_session to either mark a user as logged in, or not
-sub handle_login
-{
-local ($vu, $ok, $expired, $nonexist, $pass, $notest, $nolog, $twof_probe) = @_;
-$authuser = $vu if ($ok);
-
-# check if the test cookie is set
-if ($header{'cookie'} !~ /testing=1/ && $vu &&
-    !$config{'no_testing_cookie'} && !$notest) {
-	&http_error(500, "Cache issue or no cookies support",
-	   "Please clear your browser's cache for the given ".
-	   "domain and/or try incognito tab; double check ".
-	   "to have cookies support enabled.");
-	}
-
-# check with main process for delay
-if ($config{'passdelay'} && $vu) {
-	print DEBUG "handle_login: requesting delay vu=$vu acptip=$acptip ok=$ok\n";
-	print $PASSINw "delay $vu $acptip $ok $nolog\n";
-	<$PASSOUTr> =~ /(\d+) (\d+)/;
-	$blocked = $2;
-	sleep($1);
-	print DEBUG "handle_login: delay=$1 blocked=$2\n";
-	}
-
-if ($ok && (!$expired ||
-	    $config{'passwd_mode'} == 1)) {
-	# Log in creds were OK but two-factor auth is still pending
-	if ($twof_probe) {
-		# Two-factor auth is required
-		$validated = $already_session_id = undef;
-		$authuser = $baseauthuser = undef;
-		$querystring = $method = $page = $request_uri = undef;
-		$logged_code = undef;
-		$queryargs = "";
-		# Write response
-		&http_error(401, "Two-factor authentication is required");
-		return undef;
-		}
-
-	# Logged in OK! Tell the main process about
-	# the new SID
-	local $sid = &generate_random_id();
-	print DEBUG "handle_login: sid=$sid\n";
-	print $PASSINw "new $sid $authuser $acptip\n";
-
-	# Run the post-login script, if any
-	&run_login_script($authuser, $sid,
-			  $loghost, $localip);
-
-	# Set cookie and redirect to originally requested page
-	&write_data("HTTP/1.0 302 Moved Temporarily\r\n");
-	&write_data("Date: $datestr\r\n");
-	&write_data("Server: @{[&server_info()]}\r\n");
-	local $sec = $ssl ? "; secure" : "";
-	if (!$config{'no_httponly'}) {
-		$sec .= "; httpOnly";
-		}
-	if (!$config{'no_samesite'}) {
-		$sec .= "; SameSite=Lax";
-		}
-	if ($in{'page'} !~ /^\/[A-Za-z0-9\/\.\-\_:]+$/) {
-		# Make redirect URL safe
-		$in{'page'} = "/";
-		}
-	local $cpath = $config{'cookiepath'};
-	if ($in{'save'}) {
-		&write_data("Set-Cookie: $sidname=$sid; path=$cpath; ".
-		    "expires=\"Thu, 31-Dec-2037 00:00:00\"$sec\r\n");
-		}
-	else {
-		&write_data("Set-Cookie: $sidname=$sid; path=$cpath".
-			    "$sec\r\n");
-		}
-	&write_data("Location: $prot://$hostport$in{'page'}\r\n");
-	&write_keep_alive(0);
-	&write_data("\r\n");
-	&log_request($loghost, $authuser, $reqline, 302, 0);
-	syslog("info", "%s", "Successful login as $authuser from $loghost") if ($use_syslog);
-	&write_login_utmp($authuser, $acpthost);
-	return 0;
-	}
-elsif ($ok && $expired &&
-       ($config{'passwd_mode'} == 2 || $expired == 2)) {
-	# Login was ok, but password has expired or was temporary. Need
-	# to force display of password change form.
-	&run_failed_script($authuser, 'expiredpass',
-			   $loghost, $localip);
-	$validated = 1;
-	$authuser = undef;
-	$querystring = "&user=".&urlize($vu).
-		       "&pam=".$use_pam.
-		       "&expired=".$expired;
-	$method = "GET";
-	$queryargs = "";
-	$page = $config{'password_form'};
-	$logged_code = 401;
-	$miniserv_internal = 2;
-	syslog("crit", "%s",
-		"Expired login as $vu ".
-		"from $loghost") if ($use_syslog);
-	}
-else {
-	# Login failed, or password has expired. The login form will be
-	# displayed again by later code
-	&run_failed_script($vu, $handle_login ? 'wronguser' :
-				$expired ? 'expiredpass' : 'wrongpass',
-			   $loghost, $localip);
-	$failed_user = $vu;
-	$failed_save = $in{'save'};
-	$request_uri = $in{'page'};
-	$already_session_id = undef;
-	$method = "GET";
-	$authuser = $baseauthuser = undef;
-	
-	# If login page is simply reloaded, with `session_login.cgi` in URL,
-	# without having any parameters sent (user set to empty), don't log 
-	# false positive attempt with `Invalid login as  from IP` to syslog
-	$nolog = 1 if (!$vu);
-
-	# Send to log if allowed
-	syslog("crit", "%s",
-		($nonexist ? "Non-existent" :
-		 $expired ? "Expired" : "Invalid").
-		" login as $vu from $loghost")
-		if ($use_syslog && !$nolog);
-	}
-return undef;
-}
-
-# write_login_utmp(user, host)
-# Record the login by some user in utmp
-sub write_login_utmp
-{
-if ($write_utmp) {
-	# Write utmp record for login
-	%utmp = ( 'ut_host' => $_[1],
-		  'ut_time' => time(),
-		  'ut_user' => $_[0],
-		  'ut_type' => 7,	# user process
-		  'ut_pid' => $miniserv_main_pid,
-		  'ut_line' => $config{'pam'},
-		  'ut_id' => '' );
-	if (defined(&User::Utmp::putut)) {
-		User::Utmp::putut(\%utmp);
-		}
-	else {
-		User::Utmp::pututline(\%utmp);
-		}
-	}
-}
-
-# write_logout_utmp(user, host)
-# Record the logout by some user in utmp
-sub write_logout_utmp
-{
-if ($write_utmp) {
-	# Write utmp record for logout
-	%utmp = ( 'ut_host' => $_[1],
-		  'ut_time' => time(),
-		  'ut_user' => $_[0],
-		  'ut_type' => 8,	# dead process
-		  'ut_pid' => $miniserv_main_pid,
-		  'ut_line' => $config{'pam'},
-		  'ut_id' => '' );
-	if (defined(&User::Utmp::putut)) {
-		User::Utmp::putut(\%utmp);
-		}
-	else {
-		User::Utmp::pututline(\%utmp);
-		}
-	}
-}
-
-# pam_conversation_process(username, write-pipe, read-pipe)
-# This function is called inside a sub-process to communicate with PAM. It sends
-# questions down one pipe, and reads responses from another
-sub pam_conversation_process
-{
-local ($user, $writer, $reader) = @_;
-$miniserv::pam_conversation_process_writer = $writer;
-$miniserv::pam_conversation_process_reader = $reader;
-eval "use Authen::PAM;";
-local $convh = new Authen::PAM(
-	$config{'pam'}, $user, \&miniserv::pam_conversation_process_func);
-local $pam_ret = $convh->pam_authenticate();
-if ($pam_ret == PAM_SUCCESS()) {
-	local $acct_ret = $convh->pam_acct_mgmt();
-	if ($acct_ret == PAM_SUCCESS()) {
-		$convh->pam_open_session();
-		print $writer "x2 $user 1 0 0\n";
-		}
-	elsif ($acct_ret == PAM_NEW_AUTHTOK_REQD() ||
-	       $acct_ret == PAM_ACCT_EXPIRED()) {
-		print $writer "x2 $user 1 1 0\n";
-		}
-	else {
-		print $writer "x0 Unknown PAM account status $acct_ret\n";
-		}
-	}
-else {
-	print $writer "x2 $user 0 0 0\n";
-	}
-exit(0);
-}
-
-# pam_conversation_process_func(type, message, [type, message, ...])
-# A pipe that talks to both PAM and the master process
-sub pam_conversation_process_func
-{
-local @rv;
-select($miniserv::pam_conversation_process_writer); $| = 1; select(STDOUT);
-while(@_) {
-	local ($type, $msg) = (shift, shift);
-	$msg =~ s/\r|\n//g;
-	local $ok = (print $miniserv::pam_conversation_process_writer "$type $msg\n");
-	print $miniserv::pam_conversation_process_writer "\n";
-	local $answer = <$miniserv::pam_conversation_process_reader>;
-	$answer =~ s/\r|\n//g;
-	push(@rv, PAM_SUCCESS(), $answer);
-	}
-push(@rv, PAM_SUCCESS());
-return @rv;
-}
-
-# allocate_pipes()
-# Returns 4 new pipe file handles
-sub allocate_pipes
-{
-local ($PASSINr, $PASSINw, $PASSOUTr, $PASSOUTw);
-local $p;
-local %taken = ( (map { $_, 1 } @passin),
-	         (map { $_->{'PASSINr'} } values %conversations) );
-for($p=0; $taken{"PASSINr$p"}; $p++) { }
-$PASSINr = "PASSINr$p";
-$PASSINw = "PASSINw$p";
-$PASSOUTr = "PASSOUTr$p";
-$PASSOUTw = "PASSOUTw$p";
-pipe($PASSINr, $PASSINw);
-pipe($PASSOUTr, $PASSOUTw);
-select($PASSINw); $| = 1;
-select($PASSINr); $| = 1;
-select($PASSOUTw); $| = 1;
-select($PASSOUTw); $| = 1;
-select(STDOUT);
-return ($PASSINr, $PASSINw, $PASSOUTr, $PASSOUTw);
-}
-
-# recv_pam_question(&conv, fd)
-# Reads one PAM question from the sub-process, and sends it to the HTTP handler.
-# Returns 0 if the conversation is over, 1 if not.
-sub recv_pam_question
-{
-local ($conf, $fh) = @_;
-local $pr = $conf->{'PAMOUTr'};
-select($pr); $| = 1; select(STDOUT);
-local $line = <$pr>;
-$line =~ s/\r|\n//g;
-if (!$line) {
-	$line = <$pr>;
-	$line =~ s/\r|\n//g;
-	}
-$conf->{'last'} = time();
-if (!$line) {
-	# Failed!
-	print $fh "0 PAM conversation error\n";
-	return 0;
-	}
-else {
-	local ($type, $msg) = split(/\s+/, $line, 2);
-	if ($type =~ /^x(\d+)/) {
-		# Pass this status code through
-		print $fh "$1 $msg\n";
-		return $1 == 2 || $1 == 0 ? 0 : 1;
-		}
-	elsif ($type == PAM_PROMPT_ECHO_ON()) {
-		# A normal question
-		print $fh "1 $msg\n";
-		return 1;
-		}
-	elsif ($type == PAM_PROMPT_ECHO_OFF()) {
-		# A password
-		print $fh "3 $msg\n";
-		return 1;
-		}
-	elsif ($type == PAM_ERROR_MSG() || $type == PAM_TEXT_INFO()) {
-		# A message that does not require a response
-		print $fh "4 $msg\n";
-		return 1;
-		}
-	else {
-		# Unknown type!
-		print $fh "0 Unknown PAM message type $type\n";
-		return 0;
-		}
-	}
-}
-
-# send_pam_answer(&conv, answer)
-# Sends a response from the user to the PAM sub-process
-sub send_pam_answer
-{
-local ($conf, $answer) = @_;
-local $pw = $conf->{'PAMINw'};
-$conf->{'last'} = time();
-print $pw "$answer\n";
-}
-
-# end_pam_conversation(&conv)
-# Clean up PAM conversation pipes and processes
-sub end_pam_conversation
-{
-local ($conv) = @_;
-kill('KILL', $conv->{'pid'}) if ($conv->{'pid'});
-if ($conv->{'PAMINr'}) {
-	close($conv->{'PAMINr'});
-	close($conv->{'PAMOUTr'});
-	close($conv->{'PAMINw'});
-	close($conv->{'PAMOUTw'});
-	}
-delete($conversations{$conv->{'cid'}});
-}
-
-# get_ipkeys(&miniserv)
-# Returns a list of IP address to key file mappings from a miniserv.conf entry
-sub get_ipkeys
-{
-local (@rv, $k);
-foreach $k (keys %{$_[0]}) {
-	if ($k =~ /^ipkey_(\S+)/) {
-		local $ipkey = { 'ips' => [ split(/,/, $1) ],
-				 'key' => $_[0]->{$k},
-				 'index' => scalar(@rv) };
-		$ipkey->{'cert'} = $_[0]->{'ipcert_'.$1};
-		$ipkey->{'extracas'} = $_[0]->{'ipextracas_'.$1};
-		push(@rv, $ipkey);
-		}
-	}
-return @rv;
-}
-
-# setup_ssl_contexts()
-# Setup all the per-IP and per-domain SSL contexts and the global context based
-# on the config
-sub setup_ssl_contexts
-{
-my @ipkeys = &get_ipkeys(\%config);
-if ($config{'ssl_version'}) {
-	# Force an SSL version
-	$Net::SSLeay::version = $config{'ssl_version'};
-	$Net::SSLeay::ssl_version = $config{'ssl_version'};
-	}
-my $ctx = &create_ssl_context($config{'keyfile'},
-			      $config{'certfile'},
-			      $config{'extracas'},
-			      $ssl_contexts{"*"});
-$ctx || return "Failed to create default SSL context";
-my @added = ( "*" );
-$ssl_contexts{"*"} = $ctx;
-foreach my $ipkey (@ipkeys) {
-	my $ctx = &create_ssl_context(
-		$ipkey->{'key'}, $ipkey->{'cert'},
-		$ipkey->{'extracas'} || $config{'extracas'},
-		$ssl_contexts{$ipkey->{'ips'}->[0]});
-	if ($ctx) {
-		foreach $ip (@{$ipkey->{'ips'}}) {
-			$ssl_contexts{$ip} = $ctx;
-			push(@added, $ip);
-			}
-		}
-	}
-foreach my $ip (keys %ssl_contexts) {
-	if (&indexof($ip, @added) < 0) {
-		delete($ssl_contexts{$ip});
-		}
-	}
-
-# Setup per-hostname SSL contexts on all IPs, not just the default
-# Ref: https://github.com/virtualmin/virtualmin-gpl/pull/1229
-if (defined(&Net::SSLeay::CTX_set_tlsext_servername_callback)) {
-	foreach my $ctx_key (keys %ssl_contexts) {
-		Net::SSLeay::CTX_set_tlsext_servername_callback(
-		    $ssl_contexts{$ctx_key}->{'ctx'},
-		    sub {
-			my $ssl = shift;
-			my $h = Net::SSLeay::get_servername($ssl);
-			my $c = $ssl_contexts{$h} ||
-				$h =~ /^[^\.]+\.(.*)$/ && $ssl_contexts{"*.$1"};
-			if ($c) {
-				Net::SSLeay::set_SSL_CTX($ssl, $c->{'ctx'});
-				}
-			});
-		}
-	}
-return undef;
-}
-
-# create_ssl_context(keyfile, [certfile], [extracas], [&existing-context])
-# Create and return one SSL context based on a key file and optional cert file
-# and CA cert
-sub create_ssl_context
-{
-local ($keyfile, $certfile, $extracas, $already) = @_;
-local @kst = stat($keyfile);
-local @cst = stat($certfile);
-if ($already && $already->{'keyfile'} eq $keyfile &&
-		$already->{'keytime'} == $kst[9] &&
-		$already->{'certfile'} eq $certfile &&
-		$already->{'certtime'} == $cst[9] &&
-		$already->{'extracas'} eq $extracas) {
-	# Context we already have is valid
-	return $already;
-	}
-local $ssl_ctx;
-eval { $ssl_ctx = Net::SSLeay::new_x_ctx() };
-$ssl_ctx ||= Net::SSLeay::CTX_new();
-if (!$ssl_ctx) {
-	&log_error("Failed to create SSL context : $!");
-	return undef;
-	}
-my @extracas = $extracas && $extracas ne "none" ? split(/\s+/, $extracas) : ();
-
-# Validate cert files
-if (!-r $keyfile) {
-	&log_error("SSL key file $keyfile does not exist");
-	return undef;
-	}
-if ($certfile && !-r $certfile) {
-	&log_error("SSL cert file $certfile does not exist");
-	return undef;
-	}
-foreach my $p (@extracas) {
-	if (!-r $p) {
-		&log_error("SSL CA file $p does not exist");
-		return undef;
-		}
-	}
-
-# Setup PFS, if ciphers are in use
-if (-r $config{'dhparams_file'}) {
-	eval {
-		my $bio = Net::SSLeay::BIO_new_file(
-				$config{'dhparams_file'}, 'r');
-		my $DHP = Net::SSLeay::PEM_read_bio_DHparams($bio);
-		Net::SSLeay::CTX_set_tmp_dh($ssl_ctx, $DHP);
-		my $nid = Net::SSLeay::OBJ_sn2nid("secp384r1");
-		my $curve = Net::SSLeay::EC_KEY_new_by_curve_name($nid);
-		Net::SSLeay::CTX_set_tmp_ecdh($ssl_ctx, $curve);
-		Net::SSLeay::BIO_free($bio);
-		};
-	}
-if ($@) {
-	&log_error("Failed to load $config{'dhparams_file'} : $@");
-	}
-
-if ($client_certs) {
-	Net::SSLeay::CTX_load_verify_locations(
-		$ssl_ctx, $config{'ca'}, "");
-	eval {
-		Net::SSLeay::set_verify(
-			$ssl_ctx, &Net::SSLeay::VERIFY_PEER, \&verify_client);
-		};
-	if ($@) {
-		Net::SSLeay::CTX_set_verify(
-			$ssl_ctx, &Net::SSLeay::VERIFY_PEER, \&verify_client);
-		}
-	}
-foreach my $p (@extracas) {
-	Net::SSLeay::CTX_load_verify_locations($ssl_ctx, $p, "");
-	}
-
-if (!Net::SSLeay::CTX_use_PrivateKey_file($ssl_ctx, $keyfile,
-					  &Net::SSLeay::FILETYPE_PEM)) {
-	&log_error("Failed to open SSL key $keyfile");
-	return undef;
-	}
-if (!Net::SSLeay::CTX_use_certificate_file($ssl_ctx, $certfile || $keyfile,
-					   &Net::SSLeay::FILETYPE_PEM)) {
-	&log_error("Failed to open SSL cert ".($certfile || $keyfile));
-	return undef;
-	}
-
-if ($config{'no_ssl2'}) {
-	eval 'Net::SSLeay::CTX_set_options($ssl_ctx,
-		&Net::SSLeay::OP_NO_SSLv2)';
-	}
-if ($config{'no_ssl3'}) {
-	eval 'Net::SSLeay::CTX_set_options($ssl_ctx,
-		&Net::SSLeay::OP_NO_SSLv3)';
-	}
-if ($config{'no_tls1'}) {
-	eval 'Net::SSLeay::CTX_set_options($ssl_ctx,
-		&Net::SSLeay::OP_NO_TLSv1)';
-	}
-if ($config{'no_tls1_1'}) {
-	eval 'Net::SSLeay::CTX_set_options($ssl_ctx,
-		&Net::SSLeay::OP_NO_TLSv1_1)';
-	}
-if ($config{'no_tls1_2'}) {
-	eval 'Net::SSLeay::CTX_set_options($ssl_ctx,
-		&Net::SSLeay::OP_NO_TLSv1_2)';
-	}
-if ($config{'no_sslcompression'}) {
-	eval 'Net::SSLeay::CTX_set_options($ssl_ctx,
-		&Net::SSLeay::OP_NO_COMPRESSION)';
-	}
-if ($config{'ssl_honorcipherorder'}) {
-	eval 'Net::SSLeay::CTX_set_options($ssl_ctx,
-		&Net::SSLeay::OP_CIPHER_SERVER_PREFERENCE)';
-	}
-
-# Disable TLS renegotiation when possible, OpenSSL >= 1.1.0h
-eval 'Net::SSLeay::CTX_set_options($ssl_ctx,
-        &Net::SSLeay::OP_NO_RENEGOTIATION)';
-
-# Get the hostnames each cert is valid for
-my $info = &cert_names($certfile);
-my @hosts;
-push(@hosts, $info->{'cn'}) if ($info->{'cn'});
-push(@hosts, @{$info->{'alt'}}) if ($info->{'alt'});
-
-return { 'keyfile' => $keyfile,
-	 'keytime' => $kst[9],
-	 'certfile' => $certfile,
-	 'certtime' => $cst[9],
-	 'extracas' => $extracas,
-	 'hosts' => \@hosts,
-	 'ctx' => $ssl_ctx };
-}
-
-# ssl_connection_for_ip(socket, ipv6-flag)
-# Returns a new SSL connection object for some socket, or undef if failed
-sub ssl_connection_for_ip
-{
-local ($sock, $ipv6) = @_;
-local $sn = getsockname($sock);
-if (!$sn) {
-	&log_error("Failed to get address for socket $sock");
-	return undef;
-	}
-local (undef, $myip, undef) = &get_address_ip($sn, $ipv6);
-local $ssl_ctx = $ssl_contexts{$myip} || $ssl_contexts{"*"};
-local $ssl_con = Net::SSLeay::new($ssl_ctx->{'ctx'});
-if ($config{'ssl_cipher_list'}) {
-	# Force use of ciphers
-	eval "Net::SSLeay::set_cipher_list(
-			\$ssl_con, \$config{'ssl_cipher_list'})";
-	if ($@) {
-		&log_error("SSL cipher $config{'ssl_cipher_list'} failed : ",
-			     $@);
-		}
-	}
-
-# Accept the SSL connection
-Net::SSLeay::set_fd($ssl_con, fileno($sock));
-alarm(10);
-$SIG{'ALRM'} = sub { die "timeout" };
-my $ok = Net::SSLeay::accept($ssl_con);
-alarm(0);
-return undef if (!$ok);
-
-# Check for a per-hostname SSL context and use that instead
-my $h;
-if (defined(&Net::SSLeay::get_servername)) {
-	$h = Net::SSLeay::get_servername($ssl_con);
-	if ($h) {
-		my $c = $ssl_contexts{$h} ||
-			$h =~ /^[^\.]+\.(.*)$/ && $ssl_contexts{"*.$1"};
-		if ($c) {
-			$ssl_ctx = $c;
-			}
-		}
-	}
-return ($ssl_con, $ssl_ctx->{'certfile'}, $ssl_ctx->{'keyfile'}, $h,
-	$ssl_ctx->{'hosts'});
-}
-
-# parse_websockets_config()
-# Extract websockets proxies from the config hash
-sub parse_websockets_config
-{
-@websocket_paths = ( );
-foreach my $c (keys %config) {
-	if ($c =~ /^websockets_(\S+)$/) {
-		my $ws = { 'path' => $1 };
-		foreach my $kv (split(/\s+/, $config{$c})) {
-			my ($k, $v) = split(/=/, $kv, 2);
-			$ws->{$k} = $v;
-			}
-		push(@websocket_paths, $ws);
-		}
-	}
-}
-
-# find_websocket_config(path)
-# Returns the websocket config and path, after dropping any query string and
-# redirect prefix from the request path.
-sub find_websocket_config
-{
-my ($simple) = @_;
-my $ws_simple = $simple;
-$ws_simple =~ s/\?.*$//;
-my ($ws) = grep { $_->{'path'} eq $ws_simple } @websocket_paths;
-if (!$ws && $config{'redirect_prefix'}) {
-	my $prefix = $config{'redirect_prefix'};
-	$prefix =~ s/[\/]+$//g;
-	if ($prefix && $ws_simple =~ s/^\Q$prefix\E(?=\/|$)//) {
-		$ws_simple ||= "/";
-		print DEBUG "websockets retry without prefix $prefix as $ws_simple\n";
-		($ws) = grep { $_->{'path'} eq $ws_simple } @websocket_paths;
-		}
-	}
-return wantarray ? ($ws, $ws_simple) : $ws;
-}
-
-# reload_config_file()
-# Re-read %config, and call post-config actions
-sub reload_config_file
-{
-print DEBUG "in reload_config_file\n";
-&log_error("Reloading configuration");
-%config = &read_config_file($config_file);
-&update_vital_config();
-&read_users_file();
-&read_mime_types();
-&build_config_mappings();
-&read_webmin_crons();
-&precache_files();
-&setup_ssl_contexts() if ($use_ssl);
-&parse_websockets_config();
-if ($config{'session'}) {
-	dbmclose(%sessiondb);
-	&open_session_db();
-	}
-print DEBUG "done reload_config_file\n";
-}
-
-# read_config_file(file)
-# Reads the given config file, and returns a hash of values
-sub read_config_file
-{
-local %rv;
-open(CONF, $_[0]) || die "Failed to open config file $_[0] : $!";
-while(<CONF>) {
-	s/\r|\n//g;
-	if (/^#/ || !/\S/) { next; }
-	/^([^=]+)=(.*)$/;
-	$name = $1; $val = $2;
-	$name =~ s/^\s+//g; $name =~ s/\s+$//g;
-	$val =~ s/^\s+//g; $val =~ s/\s+$//g;
-	$rv{$name} = $val;
-	}
-close(CONF);
-return %rv;
-}
-
-# lock_config_file(file)
-# Lock a config file using Webmin's .lock sidecar convention. miniserv.pl must
-# stay standalone, but link.cgi also edits miniserv.conf through this lock.
-sub lock_config_file
-{
-my ($file) = @_;
-if ($file =~ /\r|\n|\0/) {
-	die "Lock filename contains invalid characters";
-	}
-my $lockfile = $file.".lock";
-my $tries = 0;
-my $last_lock_err;
-while(1) {
-	my $pid;
-	# Webmin's lock file contains the owner PID. A dead owner means the lock
-	# can be safely reclaimed.
-	if (open(my $locking, "<", $lockfile)) {
-		$pid = int(<$locking>);
-		close($locking);
-		}
-	if (!$pid || !kill(0, $pid) || $pid == $$) {
-		# The sidecar lock is the shared convention with web-lib-funcs.pl;
-		# the non-blocking flock just narrows races between lock claimers.
-		unlink($lockfile);
-		if (open(my $locking, ">", $lockfile)) {
-			if (!flock($locking, 2+4)) {
-				$last_lock_err = "Flock failed : ".$!;
-				close($locking);
-				unlink($lockfile);
-				}
-			elsif (!print $locking $$,"\n") {
-				$last_lock_err = "Lock write failed : ".$!;
-				close($locking);
-				unlink($lockfile);
-				}
-			elsif (!close($locking)) {
-				$last_lock_err = "Lock close failed : ".$!;
-				unlink($lockfile);
-				}
-			else {
-				return 1;
-				}
-			}
-		else {
-			$last_lock_err = "Lock open failed : ".$!;
-			}
-		}
-	elsif ($pid) {
-		$last_lock_err = "Locked by PID $pid";
-		}
-	sleep(1);
-	if ($tries++ > 5*60) {
-		die "Failed to lock config file $file : $last_lock_err";
-		}
-	}
-}
-
-# unlock_config_file(file)
-# Release a config lock taken by lock_config_file.
-sub unlock_config_file
-{
-my ($file) = @_;
-unlink($file.".lock");
-}
-
-# read_any_file(file)
-# Reads any given file and returns its content
-sub read_any_file
-{
-my ($realfile) = @_;
-my $rv;
-open(my $fh, "<".$realfile) || return $rv;
-local $/;
-$rv = <$fh>;
-close($fh);
-return $rv;
-}
-
-# update_vital_config()
-# Updates %config with defaults, and dies if something vital is missing
-sub update_vital_config
-{
-my %vital = ("port", 80,
-	  "root", "./",
-	  "server", "MiniServ/0.01",
-	  "index_docs", "index.html index.htm index.cgi index.php",
-	  "addtype_html", "text/html",
-	  "addtype_txt", "text/plain",
-	  "addtype_gif", "image/gif",
-	  "addtype_jpg", "image/jpeg",
-	  "addtype_jpeg", "image/jpeg",
-	  "realm", "MiniServ",
-	  "session_login", "/session_login.cgi",
-	  "pam_login", "/pam_login.cgi",
-	  "password_form", "/password_form.cgi",
-	  "password_change", "/password_change.cgi",
-	  "maxconns", 50,
-	  "maxconns_per_ip", 25,
-	  "maxconns_per_net", 35,
-	  "listen_delay", 5,
-	  "pam", "webmin",
-	  "sidname", "sid",
-	  "unauth", "^/unauthenticated/ ^/robots.txt\$ ^[A-Za-z0-9\\-/_]+\\.jar\$ ^[A-Za-z0-9\\-/_]+\\.class\$ ^[A-Za-z0-9\\-/_]+\\.gif\$ ^[A-Za-z0-9\\-/_]+\\.png\$ ^[A-Za-z0-9\\-/_]+\\.conf\$ ^[A-Za-z0-9\\-/_]+\\.ico\$ ^/robots.txt\$ ^/service-worker.js\$",
-	  "unauthcgi", "^/forgot_form.cgi\$ ^/forgot_send.cgi\$ ^/forgot.cgi\$",
-	  "max_post", 10000,
-	  "expires", 7*24*60*60,
-	  "pam_test_user", "root",
-	  "precache", "lang/en */lang/en",
-	  "cookiepath", "/",
-	 );
-foreach my $v (keys %vital) {
-	if (!$config{$v}) {
-		if ($vital{$v} eq "") {
-			die "Missing config option $v";
-			}
-		$config{$v} = $vital{$v};
-		}
-	}
-$config_file =~ /^(.*)\/[^\/]+$/;
-my $config_dir = $1;
-$config{'pidfile'} =~ /^(.*)\/[^\/]+$/;
-my $var_dir = $1;
-if (!$config{'sessiondb'}) {
-	$config{'sessiondb'} = "$var_dir/sessiondb";
-	}
-if ($config{'session'}) {
-	if (!$config{'session_keyfile'}) {
-		$config{'session_keyfile'} = "$var_dir/session.key";
-		}
-	&load_session_secret();
-	}
-if (!$config{'errorlog'}) {
-	$config{'logfile'} =~ /^(.*)\/[^\/]+$/;
-	$config{'errorlog'} = "$1/miniserv.error";
-	}
-if (!$config{'tempbase'}) {
-	$config{'tempbase'} = "$var_dir/cgitemp";
-	}
-if (!$config{'blockedfile'}) {
-	$config{'blockedfile'} = "$var_dir/blocked";
-	}
-if (!$config{'webmincron_dir'}) {
-	$config{'webmincron_dir'} = "$config_dir/webmincron/crons";
-	}
-if (!$config{'webmincron_last'}) {
-	$config{'logfile'} =~ /^(.*)\/[^\/]+$/;
-	$config{'webmincron_last'} = "$1/miniserv.lastcrons";
-	}
-if (!$config{'webmincron_wrapper'}) {
-	$config{'webmincron_wrapper'} = $config{'root'}.
-					"/webmincron/webmincron.pl";
-	}
-if (!$config{'twofactor_wrapper'}) {
-	$config{'twofactor_wrapper'} = $config{'root'}."/acl/twofactor.pl";
-	}
-$config{'restartflag'} ||= $var_dir."/restart-flag";
-$config{'reloadflag'} ||= $var_dir."/reload-flag";
-$config{'stopflag'} ||= $var_dir."/stop-flag";
-}
-
-# read_users_file()
-# Fills the %users and %certs hashes from the users file in %config
-sub read_users_file
-{
-undef(%users);
-undef(%certs);
-undef(%allow);
-undef(%deny);
-undef(%allowdays);
-undef(%allowhours);
-undef(%lastchanges);
-undef(%nochange);
-undef(%temppass);
-undef(%twofactor);
-if ($config{'userfile'}) {
-	open(USERS, $config{'userfile'});
-	while(<USERS>) {
-		s/\r|\n//g;
-		local @user = split(/:/, $_, -1);
-		$users{$user[0]} = $user[1];
-		$certs{$user[0]} = $user[3] if ($user[3]);
-		if ($user[4] =~ /^allow\s+(.*)/) {
-			my $allow = $1;
-			$allow =~ s/;/:/g;
-			$allow{$user[0]} = $config{'alwaysresolve'} ?
-				[ split(/\s+/, $allow) ] :
-				[ &to_ip46address(split(/\s+/, $allow)) ];
-			}
-		elsif ($user[4] =~ /^deny\s+(.*)/) {
-			my $deny = $1;
-			$deny =~ s/;/:/g;
-			$deny{$user[0]} = $config{'alwaysresolve'} ?
-				[ split(/\s+/, $deny) ] :
-				[ &to_ip46address(split(/\s+/, $deny)) ];
-			}
-		if ($user[5] =~ /days\s+(\S+)/) {
-			$allowdays{$user[0]} = [ split(/,/, $1) ];
-			}
-		if ($user[5] =~ /hours\s+(\d+)\.(\d+)-(\d+).(\d+)/) {
-			$allowhours{$user[0]} = [ $1*60+$2, $3*60+$4 ];
-			}
-		$lastchanges{$user[0]} = $user[6];
-		$nochange{$user[0]} = $user[9];
-		$temppass{$user[0]} = $user[10];
-		if ($user[11] && $user[12]) {
-			$twofactor{$user[0]} = { 'provider' => $user[11],
-						 'id' => $user[12],
-						 'apikey' => $user[13] };
-			}
-		}
-	close(USERS);
-	}
-if ($config{'twofactorfile'}) {
-	open(TWO, $config{'twofactorfile'});
-	while(<TWO>) {
-		s/\r|\n//g;
-                local @two = split(/:/, $_, -1);
-		$twofactor{$two[0]} = { 'provider' => $two[1],
-					'id' => $two[2],
-					'apikey' => $two[3], };
-		}
-	close(TWO);
-	}
-
-# Test user DB, if configured
-if ($config{'userdb'}) {
-	my $dbh = &connect_userdb($config{'userdb'});
-	if (!ref($dbh)) {
-		&log_error("Failed to open users database : $dbh");
-		}
-	else {
-		&disconnect_userdb($config{'userdb'}, $dbh);
-		}
-	}
-}
-
-# get_user_details(username, [original-username])
-# Returns a hash ref of user details, either from config files or the user DB
-sub get_user_details
-{
-my ($username, $origusername) = @_;
-if (exists($users{$username})) {
-	# In local files
-	my $two = $twofactor{$origusername} || $twofactor{$username};
-	return { 'name' => $username,
-		 'pass' => $users{$username},
-		 'certs' => $certs{$username},
-		 'allow' => $allow{$username},
-		 'deny' => $deny{$username},
-		 'allowdays' => $allowdays{$username},
-		 'allowhours' => $allowhours{$username},
-		 'lastchanges' => $lastchanges{$username},
-		 'nochange' => $nochange{$username},
-		 'temppass' => $temppass{$username},
-		 'preroot' => $config{'preroot_'.$username},
-		 'twofactor_provider' => $two->{'provider'},
-		 'twofactor_id' => $two->{'id'},
-		 'twofactor_apikey' => $two->{'apikey'},
-	       };
-	}
-if ($config{'userdb'}) {
-	# Try querying user database
-	if (exists($get_user_details_cache{$username})) {
-		# Cached already
-		return $get_user_details_cache{$username};
-		}
-	print DEBUG "get_user_details: Connecting to user database\n";
-	my ($dbh, $proto, $prefix, $args) = &connect_userdb($config{'userdb'});
-	my $user;
-	my %attrs;
-	if (!ref($dbh)) {
-		print DEBUG "get_user_details: Failed : $dbh\n";
-		&log_error("Failed to connect to user database : $dbh");
-		}
-	elsif ($proto eq "mysql" || $proto eq "postgresql") {
-		# Fetch user ID and password with SQL
-		print DEBUG "get_user_details: Looking for $username in SQL\n";
-		my $cmd = $dbh->prepare(
-			"select id,pass from webmin_user where name = ?");
-		if (!$cmd || !$cmd->execute($username)) {
-			&log_error("Failed to lookup user : ",
-				     $dbh->errstr);
-			return undef;
-			}
-		my ($id, $pass) = $cmd->fetchrow();
-		$cmd->finish();
-		if (!$id) {
-			&disconnect_userdb($config{'userdb'}, $dbh);
-			$get_user_details_cache{$username} = undef;
-			print DEBUG "get_user_details: User not found\n";
-			return undef;
-			}
-		print DEBUG "get_user_details: id=$id pass=$pass\n";
-
-		# Fetch attributes and add to user object
-		print DEBUG "get_user_details: finding user attributes\n";
-		my $cmd = $dbh->prepare(
-			"select attr,value from webmin_user_attr where id = ?");
-		if (!$cmd || !$cmd->execute($id)) {
-			&log_error("Failed to lookup user attrs : ",
-				     $dbh->errstr);
-			return undef;
-			}
-		$user = { 'name' => $username,
-			  'id' => $id,
-			  'pass' => $pass,
-			  'proto' => $proto };
-		while(my ($attr, $value) = $cmd->fetchrow()) {
-			$attrs{$attr} = $value;
-			}
-		$cmd->finish();
-		}
-	elsif ($proto eq "ldap") {
-		# Fetch user DN with LDAP
-		print DEBUG "get_user_details: Looking for $username in LDAP\n";
-		my $rv = $dbh->search(
-			base => $prefix,
-			filter => '(&(cn='.$username.')(objectClass='.
-                                  $args->{'userclass'}.'))',
-			scope => 'sub');
-		if (!$rv || $rv->code) {
-			&log_error("Failed to lookup user : ",
-				     ($rv ? $rv->error : "Unknown error"));
-			return undef;
-			}
-		my ($u) = $rv->all_entries();
-		if (!$u || $u->get_value('cn') ne $username) {
-			&disconnect_userdb($config{'userdb'}, $dbh);
-                        $get_user_details_cache{$username} = undef;
-			print DEBUG "get_user_details: User not found\n";
-                        return undef;
-			}
-
-		# Extract attributes
-		my $pass = $u->get_value('webminPass');
-		$user = { 'name' => $username,
-			  'id' => $u->dn(),
-			  'pass' => $pass,
-			  'proto' => $proto };
-		foreach my $la ($u->get_value('webminAttr')) {
-			my ($attr, $value) = split(/=/, $la, 2);
-			$attrs{$attr} = $value;
-			}
-		}
-
-	# Convert DB attributes into user object fields
-	if ($user) {
-		print DEBUG "get_user_details: got ",scalar(keys %attrs),
-			    " attributes\n";
-		$user->{'certs'} = $attrs{'cert'};
-		if ($attrs{'allow'}) {
-			$user->{'allow'} = $config{'alwaysresolve'} ?
-				[ split(/\s+/, $attrs{'allow'}) ] :
-				[ &to_ipaddress(split(/\s+/,$attrs{'allow'})) ];
-			}
-		if ($attrs{'deny'}) {
-			$user->{'deny'} = $config{'alwaysresolve'} ?
-				[ split(/\s+/, $attrs{'deny'}) ] :
-				[ &to_ipaddress(split(/\s+/,$attrs{'deny'})) ];
-			}
-		if ($attrs{'days'}) {
-			$user->{'allowdays'} = [ split(/,/, $attrs{'days'}) ];
-			}
-		if ($attrs{'hoursfrom'} && $attrs{'hoursto'}) {
-			my ($hf, $mf) = split(/\./, $attrs{'hoursfrom'});
-			my ($ht, $mt) = split(/\./, $attrs{'hoursto'});
-			$user->{'allowhours'} = [ $hf*60+$ht, $ht*60+$mt ];
-			}
-		$user->{'lastchanges'} = $attrs{'lastchange'};
-		$user->{'nochange'} = $attrs{'nochange'};
-		$user->{'temppass'} = $attrs{'temppass'};
-		$user->{'preroot'} = $attrs{'theme'};
-		$user->{'twofactor_provider'} = $attrs{'twofactor_provider'};
-		$user->{'twofactor_id'} = $attrs{'twofactor_id'};
-		$user->{'twofactor_apikey'} = $attrs{'twofactor_apikey'};
-		}
-	&disconnect_userdb($config{'userdb'}, $dbh);
-	$get_user_details_cache{$user->{'name'}} = $user;
-	return $user;
-	}
-return undef;
-}
-
-# find_user_by_cert(cert)
-# Returns a username looked up by certificate
-sub find_user_by_cert
-{
-my ($peername) = @_;
-my $peername2 = $peername;
-$peername2 =~ s/Email=/emailAddress=/ || $peername2 =~ s/emailAddress=/Email=/;
-
-# First check users in local files
-foreach my $username (keys %certs) {
-	if ($certs{$username} eq $peername ||
-	    $certs{$username} eq $peername2) {
-		return $username;
-		}
-	}
-
-# Check user DB
-if ($config{'userdb'}) {
-	my ($dbh, $proto) = &connect_userdb($config{'userdb'});
-	if (!ref($dbh)) {
-		return undef;
-		}
-	elsif ($proto eq "mysql" || $proto eq "postgresql") {
-		# Query with SQL
-		my $cmd = $dbh->prepare("select webmin_user.name from webmin_user,webmin_user_attr where webmin_user.id = webmin_user_attr.id and webmin_user_attr.attr = 'cert' and webmin_user_attr.value = ?");
-		return undef if (!$cmd);
-		foreach my $p ($peername, $peername2) {
-			my $username;
-			if ($cmd->execute($p)) {
-				($username) = $cmd->fetchrow();
-				}
-			$cmd->finish();
-			return $username if ($username);
-			}
-		}
-	elsif ($proto eq "ldap") {
-		# Lookup in LDAP
-		my $rv = $dbh->search(
-			base => $prefix,
-			filter => '(objectClass='.
-				  $args->{'userclass'}.')',
-			scope => 'sub',
-			attrs => [ 'cn', 'webminAttr' ]);
-		if ($rv && !$rv->code) {
-			foreach my $u ($rv->all_entries) {
-				my @attrs = $u->get_value('webminAttr');
-				foreach my $la (@attrs) {
-					my ($attr, $value) = split(/=/, $la, 2);
-					if ($attr eq "cert" &&
-					    ($value eq $peername ||
-					     $value eq $peername2)) {
-						return $u->get_value('cn');
-						}
-					}
-				}
-			}
-		}
-	}
-return undef;
-}
-
-# connect_userdb(string)
-# Returns a handle for talking to a user database - may be a DBI or LDAP handle.
-# On failure returns an error message string. In an array context, returns the
-# protocol type too.
-sub connect_userdb
-{
-my ($str) = @_;
-my ($proto, $user, $pass, $host, $prefix, $args) = &split_userdb_string($str);
-if ($proto eq "mysql") {
-	# Connect to MySQL with DBI
-	my $drh = eval "use DBI; DBI->install_driver('mysql');";
-	$drh || return $text{'sql_emysqldriver'};
-	my ($host, $port) = split(/:/, $host);
-	my $cstr = "database=$prefix;host=$host";
-	$cstr .= ";port=$port" if ($port);
-	print DEBUG "connect_userdb: Connecting to MySQL $cstr as $user\n";
-	my $dbh = $drh->connect($cstr, $user, $pass, { });
-	$dbh || return "Failed to connect to MySQL : ".$drh->errstr;
-	print DEBUG "connect_userdb: Connected OK\n";
-	return wantarray ? ($dbh, $proto, $prefix, $args) : $dbh;
-	}
-elsif ($proto eq "postgresql") {
-	# Connect to PostgreSQL with DBI
-	my $drh = eval "use DBI; DBI->install_driver('Pg');";
-	$drh || return $text{'sql_epostgresqldriver'};
-	my ($host, $port) = split(/:/, $host);
-	my $cstr = "dbname=$prefix;host=$host";
-	$cstr .= ";port=$port" if ($port);
-	print DEBUG "connect_userdb: Connecting to PostgreSQL $cstr as $user\n";
-	my $dbh = $drh->connect($cstr, $user, $pass);
-	$dbh || return "Failed to connect to PostgreSQL : ".$drh->errstr;
-	print DEBUG "connect_userdb: Connected OK\n";
-	return wantarray ? ($dbh, $proto, $prefix, $args) : $dbh;
-	}
-elsif ($proto eq "ldap") {
-	# Connect with perl LDAP module
-	eval "use Net::LDAP";
-	$@ && return $text{'sql_eldapdriver'};
-	my ($host, $port) = split(/:/, $host);
-	my $scheme = $args->{'scheme'} || 'ldap';
-	if (!$port) {
-		$port = $scheme eq 'ldaps' ? 636 : 389;
-		}
-	my $ldap = Net::LDAP->new($host,
-				  port => $port,
-				  'scheme' => $scheme);
-	$ldap || return "Failed to connect to LDAP : ".$host;
-	my $mesg;
-	if ($args->{'tls'}) {
-		# Switch to TLS mode
-		eval { $mesg = $ldap->start_tls(); };
-		if ($@ || !$mesg || $mesg->code) {
-			return "Failed to switch to LDAP TLS mode : ".
-			    ($@ ? $@ : $mesg ? $mesg->error : "Unknown error");
-			}
-		}
-	# Login to the server
-	if ($pass) {
-		$mesg = $ldap->bind(dn => $user, password => $pass);
-		}
-	else {
-		$mesg = $ldap->bind(dn => $user, anonymous => 1);
-		}
-	if (!$mesg || $mesg->code) {
-		return "Failed to login to LDAP as ".$user." : ".
-		       ($mesg ? $mesg->error : "Unknown error");
-		}
-	return wantarray ? ($ldap, $proto, $prefix, $args) : $ldap;
-	}
-else {
-	return "Unknown protocol $proto";
-	}
-}
-
-# split_userdb_string(string)
-# Converts a string like mysql://user:pass@host/db into separate parts
-sub split_userdb_string
-{
-my ($str) = @_;
-if ($str =~ /^([a-z]+):\/\/([^:]*):([^\@]*)\@([a-z0-9\.\-\_]+)\/([^\?]+)(\?(.*))?$/) {
-	my ($proto, $user, $pass, $host, $prefix, $argstr) =
-		($1, $2, $3, $4, $5, $7);
-	my %args = map { split(/=/, $_, 2) } split(/\&/, $argstr);
-	return ($proto, $user, $pass, $host, $prefix, \%args);
-	}
-return ( );
-}
-
-# disconnect_userdb(string, &handle)
-# Closes a handle opened by connect_userdb
-sub disconnect_userdb
-{
-my ($str, $h) = @_;
-if ($str =~ /^(mysql|postgresql):/) {
-	# DBI disconnect
-	$h->disconnect();
-	}
-elsif ($str =~ /^ldap:/) {
-	# LDAP disconnect
-	$h->disconnect();
-	}
-}
-
-# read_mime_types()
-# Fills %mime with entries from file in %config and extra settings in %config
-sub read_mime_types
-{
-undef(%mime);
-if ($config{"mimetypes"} ne "") {
-	open(MIME, $config{"mimetypes"});
-	while(<MIME>) {
-		chop; s/#.*$//;
-		if (/^(\S+)\s+(.*)$/) {
-			my $type = $1;
-			my @exts = split(/\s+/, $2);
-			foreach my $ext (@exts) {
-				$mime{$ext} = $type;
-				}
-			}
-		}
-	close(MIME);
-	}
-foreach my $k (keys %config) {
-	if ($k !~ /^addtype_(.*)$/) { next; }
-	$mime{$1} = $config{$k};
-	}
-}
-
-# build_config_mappings()
-# Build the anonymous access list, IP access list, unauthenticated URLs list,
-# redirect mapping and allow and deny lists from %config
-sub build_config_mappings
-{
-# build anonymous access list
-undef(%anonymous);
-foreach my $a (split(/\s+/, $config{'anonymous'})) {
-	if ($a =~ /^([^=]+)=(\S+)$/) {
-		$anonymous{$1} = $2;
-		}
-	}
-
-# build IP access list
-undef(%ipaccess);
-foreach my $a (split(/\s+/, $config{'ipaccess'})) {
-	if ($a =~ /^([^=]+)=(\S+)$/) {
-		$ipaccess{$1} = $2;
-		}
-	}
-
-# build unauthenticated URLs list
-@unauth = split(/\s+/, $config{'unauth'});
-@unauthcgi = split(/\s+/, $config{'unauthcgi'});
-
-# build redirect mapping
-undef(%redirect);
-foreach my $r (split(/\s+/, $config{'redirect'})) {
-	if ($r =~ /^([^=]+)=(\S+)$/) {
-		$redirect{$1} = $2;
-		}
-	}
-
-# build prefixes to be stripped
-undef(@strip_prefix);
-foreach my $r (split(/\s+/, $config{'strip_prefix'})) {
-	push(@strip_prefix, $r);
-	}
-
-# Init allow and deny lists
-@deny = split(/\s+/, $config{"deny"});
-@deny = &to_ipaddress(@deny) if (!$config{'alwaysresolve'});
-@allow = split(/\s+/, $config{"allow"});
-@allow = &to_ipaddress(@allow) if (!$config{'alwaysresolve'});
-undef(@allowusers);
-undef(@denyusers);
-if ($config{'allowusers'}) {
-	@allowusers = split(/\s+/, $config{'allowusers'});
-	}
-elsif ($config{'denyusers'}) {
-	@denyusers = split(/\s+/, $config{'denyusers'});
-	}
-
-# Build list of unixauth mappings
-undef(%unixauth);
-foreach my $ua (split(/\s+/, $config{'unixauth'})) {
-	if ($ua =~ /^(\S+)=(\S+)$/) {
-		$unixauth{$1} = $2;
-		}
-	else {
-		$unixauth{"*"} = $ua;
-		}
-	}
-
-# Build list of non-session-auth pages
-undef(%sessiononly);
-foreach my $sp (split(/\s+/, $config{'sessiononly'})) {
-	$sessiononly{$sp} = 1;
-	}
-
-# Build list of logout times
-undef(@logouttimes);
-foreach my $a (split(/\s+/, $config{'logouttimes'})) {
-	if ($a =~ /^([^=]+)=(\S+)$/) {
-		push(@logouttimes, [ $1, $2 ]);
-		}
-	}
-push(@logouttimes, [ undef, $config{'logouttime'} ]);
-
-# Build list of DAV pathss
-undef(@davpaths);
-foreach my $d (split(/\s+/, $config{'davpaths'})) {
-	push(@davpaths, $d);
-	}
-@davusers = split(/\s+/, $config{'dav_users'});
-
-# Mobile agent substrings and hostname prefixes
-@mobile_agents = split(/\t+/, $config{'mobile_agents'});
-@mobile_prefixes = split(/\s+/, $config{'mobile_prefixes'});
-
-# Expires time list
-@expires_paths = ( );
-foreach my $pe (split(/\t+/, $config{'expires_paths'})) {
-	my ($p, $e) = split(/=/, $pe);
-	if ($p && $e ne '') {
-		push(@expires_paths, [ $p, $e ]);
-		}
-	}
-
-# Re-open debug log
-&open_debug_to_log();
-
-# Reset cache of sudo checks
-undef(%sudocache);
-
-# Reset cache of cert files
-undef(%cert_names_cache);
-}
-
-# is_group_member(&uinfo, groupname)
-# Returns 1 if some user is a primary or secondary member of a group
-sub is_group_member
-{
-local ($uinfo, $group) = @_;
-local @ginfo = getgrnam($group);
-return 0 if (!@ginfo);
-return 1 if ($ginfo[2] == $uinfo->[3]);	# primary member
-foreach my $m (split(/\s+/, $ginfo[3])) {
-	return 1 if ($m eq $uinfo->[0]);
-	}
-return 0;
-}
-
-# prefix_to_mask(prefix)
-# Converts a number like 24 to a mask like 255.255.255.0
-sub prefix_to_mask
-{
-return $_[0] >= 24 ? "255.255.255.".(256-(2 ** (32-$_[0]))) :
-       $_[0] >= 16 ? "255.255.".(256-(2 ** (24-$_[0]))).".0" :
-       $_[0] >= 8 ? "255.".(256-(2 ** (16-$_[0]))).".0.0" :
-                     (256-(2 ** (8-$_[0]))).".0.0.0";
-}
-
-# get_logout_time(user, session-id)
-# Given a username, returns the idle time before he will be logged out
-sub get_logout_time
-{
-local ($user, $sid) = @_;
-if (!defined($logout_time_cache{$user,$sid})) {
-	local $time;
-	foreach my $l (@logouttimes) {
-		if ($l->[0] =~ /^\@(.*)$/) {
-			# Check group membership
-			local @uinfo = getpwnam($user);
-			if (@uinfo && &is_group_member(\@uinfo, $1)) {
-				$time = $l->[1];
-				}
-			}
-		elsif ($l->[0] =~ /^\//) {
-			# Check file contents
-			open(FILE, $l->[0]);
-			while(<FILE>) {
-				s/\r|\n//g;
-				s/^\s*#.*$//;
-				if ($user eq $_) {
-					$time = $l->[1];
-					last;
-					}
-				}
-			close(FILE);
-			}
-		elsif (!$l->[0]) {
-			# Always match
-			$time = $l->[1];
-			}
-		else {
-			# Check username
-			if ($l->[0] eq $user) {
-				$time = $l->[1];
-				}
-			}
-		last if (defined($time));
-		}
-	$logout_time_cache{$user,$sid} = $time;
-	}
-return $logout_time_cache{$user,$sid};
-}
-
-# password_crypt(password, salt)
-# If the salt looks like MD5 and we have a library for it, perform MD5 hashing
-# of a password. Otherwise, do Unix crypt.
-sub password_crypt
-{
-local ($pass, $salt) = @_;
-local $rval;
-if ($salt =~ /^\$1\$/ && $use_md5) {
-	$rval = &encrypt_md5($pass, $salt);
-	}
-elsif ($salt =~ /^\$6\$/ && $use_sha512) {
-	$rval = &encrypt_sha512($pass, $salt);
-	}
-if (!defined($rval) || $salt ne $rval) {
-	$rval = &unix_crypt($pass, $salt);
-	}
-return $rval;
-}
-
-# unix_crypt(password, salt)
-# Performs standard Unix hashing for a password
-sub unix_crypt
-{
-local ($pass, $salt) = @_;
-if ($use_perl_crypt) {
-	return Crypt::UnixCrypt::crypt($pass, $salt);
-	}
-else {
-	return crypt($pass, $salt);
-	}
-}
-
-# handle_dav_request(davpath)
-# Pass a request on to the Net::DAV::Server module
-sub handle_dav_request
-{
-local ($path) = @_;
-eval "use Filesys::Virtual::Plain";
-eval "use Net::DAV::Server";
-eval "use HTTP::Request";
-eval "use HTTP::Headers";
-
-if ($Net::DAV::Server::VERSION eq '1.28' && $config{'dav_nolock'}) {
-	delete $Net::DAV::Server::implemented{lock};
-	delete $Net::DAV::Server::implemented{unlock};
-	}
-
-# Read in request data
-if (!$posted_data) {
-	local $clen = $header{"content-length"};
-	while(length($posted_data) < $clen) {
-		$buf = &read_data($clen - length($posted_data));
-		if (!length($buf)) {
-			&http_error(500, "Failed to read POST request");
-			}
-		$posted_data .= $buf;
-		}
-	}
-
-# For subsequent logging
-open(MINISERVLOG, ">>$config{'logfile'}");
-
-# Switch to user
-local $root;
-local @u = getpwnam($authuser);
-if ($config{'dav_remoteuser'} && !$< && $validated) {
-	if (@u) {
-		if ($u[2] != 0) {
-			$( = $u[3]; $) = "$u[3] $u[3]";
-			($>, $<) = ($u[2], $u[2]);
-			}
-		if ($config{'dav_root'} eq '*') {
-			$root = $u[7];
-			}
-		}
-	else {
-		&http_error(500, "Unix user ".&html_strip($authuser).
-				 " does not exist");
-		return 0;
-		}
-	}
-$root ||= $config{'dav_root'};
-$root ||= "/";
-
-# Check if this user can use DAV
-if (@davusers) {
-	&users_match(\@u, @davusers) ||
-		&http_error(500, "You are not allowed to access DAV");
-	}
-
-# Create DAV server
-my $filesys = Filesys::Virtual::Plain->new({root_path => $root});
-my $webdav = Net::DAV::Server->new();
-$webdav->filesys($filesys);
-
-# Make up a request object, and feed to DAV
-local $ho = HTTP::Headers->new;
-foreach my $h (keys %header) {
-	next if (lc($h) eq "connection");
-	$ho->header($h => $header{$h});
-	}
-if ($path ne "/") {
-	$request_uri =~ s/^\Q$path\E//;
-	$request_uri = "/" if ($request_uri eq "");
-	}
-my $request = HTTP::Request->new($method, $request_uri, $ho,
-				 $posted_data);
-if ($config{'dav_debug'}) {
-	&log_error("DAV request :");
-	&log_error("---------------------------------------------");
-	&log_error($request->as_string());
-	&log_error("---------------------------------------------");
-	}
-my $response = $webdav->run($request);
-
-# Send back the reply
-&write_data("HTTP/1.1 ",$response->code()," ",$response->message(),"\r\n");
-local $content = $response->content();
-if ($path ne "/") {
-	$content =~ s|href>/(.+)<|href>$path/$1<|g;
-	$content =~ s|href>/<|href>$path<|g;
-	}
-foreach my $h ($response->header_field_names) {
-	next if (lc($h) eq "connection" || lc($h) eq "content-length");
-	&write_data("$h: ",$response->header($h),"\r\n");
-	}
-&write_data("Content-length: ",length($content),"\r\n");
-local $rv = &write_keep_alive(0);
-&write_data("\r\n");
-&write_data($content);
-
-if ($config{'dav_debug'}) {
-	&log_error("DAV reply :");
-	&log_error("---------------------------------------------");
-	&log_error("HTTP/1.1 ",$response->code()," ",$response->message());
-	foreach my $h ($response->header_field_names) {
-		next if (lc($h) eq "connection" || lc($h) eq "content-length");
-		&log_error("$h: ",$response->header($h));
-		}
-	&log_error("Content-length: ",length($content));
-	&log_error($content);
-	&log_error("---------------------------------------------");
-	}
-
-# Log it
-&log_request($loghost, $authuser, $reqline, $response->code(), 
-	     length($response->content()));
-return 0;
-}
-
-# normalise_websocket_origin(scheme, host, port)
-# Canonicalises an origin for websocket security checks
-sub normalise_websocket_origin
-{
-my ($scheme, $host, $port) = @_;
-return undef if (!$scheme || !defined($host) || $host eq '');
-$scheme = lc($scheme);
-$host =~ s/^\s+|\s+$//g;
-$host =~ s/^\[(.+)\]$/$1/;
-$host = lc($host);
-$port ||= $scheme eq 'https' ? 443 : 80;
-my $portstr = $port == 80 && $scheme eq 'http' ? "" :
-	      $port == 443 && $scheme eq 'https' ? "" : ":".$port;
-my $hostport = &check_ip6address($host) ? "[".$host."]".$portstr
-					: $host.$portstr;
-return $scheme."://".$hostport;
-}
-
-# parse_websocket_origin(origin)
-# Parses an Origin header value into canonical scheme://host[:port] form
-sub parse_websocket_origin
-{
-my ($origin) = @_;
-return undef if (!defined($origin));
-$origin =~ s/^\s+|\s+$//g;
-return undef if (!$origin || lc($origin) eq 'null');
-if ($origin =~ /^(https?):\/\/\[([^\]]+)\](?::(\d+))?\/?$/i) {
-	return &normalise_websocket_origin($1, $2, $3);
-	}
-elsif ($origin =~ /^(https?):\/\/([^:\/]+)(?::(\d+))?\/?$/i) {
-	return &normalise_websocket_origin($1, $2, $3);
-	}
-return undef;
-}
-
-# parse_configured_websocket_origin(origin)
-# Parses a configured origin, accepting ws:// and wss:// aliases
-sub parse_configured_websocket_origin
-{
-my ($origin) = @_;
-return undef if (!defined($origin));
-$origin =~ s/^\s+|\s+$//g;
-$origin =~ s/^ws:\/\//http:\/\//i;  # if admin configures websocket URLs
-$origin =~ s/^wss:\/\//https:\/\//i;
-return &parse_websocket_origin($origin);
-}
-
-# forwarded_websocket_origin(proto, host, port)
-# Builds a canonical origin from reverse-proxy forwarding headers
-sub forwarded_websocket_origin
-{
-my ($proto, $host, $port) = @_;
-return undef if (!$proto || !$host);
-$proto =~ s/\s+//g;
-$proto = (split(/,/, $proto))[0];
-$host =~ s/^\s+|\s+$//g;
-$host = (split(/\s*,\s*/, $host))[0];
-if ($host =~ /^\[(.+)\]:(\d+)$/) {
-	($host, $port) = ($1, $2);
-	}
-elsif ($host =~ /^([^:]+):(\d+)$/) {
-	($host, $port) = ($1, $2);
-	}
-return &normalise_websocket_origin($proto, $host, $port);
-}
-
-# get_websocket_allowed_origins()
-# Returns all canonical origins allowed to connect to miniserv websockets
-sub get_websocket_allowed_origins
-{
-my @rv;
-my %seen;
-my $add_origin = sub {
-	my ($origin) = @_;
-	return if (!$origin || $seen{$origin}++);
-	push(@rv, $origin);
-	};
-
-# Direct access to miniserv, based on the current request host and port
-&$add_origin(&normalise_websocket_origin($use_ssl ? 'https' : 'http',
-					 $host, $port));
-
-# Canonical externally-visible URL, if one has been configured
-&$add_origin(&normalise_websocket_origin($prot, $redirhost, $redirport));
-
-# Reverse proxy headers, when present
-if ($config{'trust_real_ip'}) {
-	&$add_origin(&forwarded_websocket_origin($header{'x-forwarded-proto'},
-						 $header{'x-forwarded-host'},
-						 $header{'x-forwarded-port'}));
-	&$add_origin(&forwarded_websocket_origin($header{'x-forwarded-proto'},
-						 $header{'host'},
-						 $header{'x-forwarded-port'}));
-	}
-
-# Explicit websocket host setting, converted back to a page origin
-if ($config{'websocket_host'}) {
-	my $wshost = $config{'websocket_host'};
-	$wshost =~ s/[\/]+$//g;
-	if ($wshost =~ /^wss?:\/\//) {
-		$wshost =~ s/^ws/http/i;
-		&$add_origin(&parse_websocket_origin($wshost));
-		}
-	else {
-		&$add_origin(&forwarded_websocket_origin($ssl ? 'https' : 'http',
-							 $wshost, undef));
-		}
-	}
-
-# Extra public origins can be whitelisted explicitly for unusual edge proxy
-# configs where auto-detection cannot work
-if ($config{'websocket_extra_origins'}) {
-	foreach my $origin (split(/\s+|,\s*/, $config{'websocket_extra_origins'})) {
-		next if (!$origin);
-		my $parsed = &parse_configured_websocket_origin($origin);
-		if ($parsed) {
-			&$add_origin($parsed);
-			}
-		else {
-			print DEBUG "ignoring invalid websocket_extra_origins ".
-				    "entry $origin\n";
-			}
-		}
-	}
-
-return @rv;
-}
-
-# handle_websocket_request(&wsconfig, original-path)
-# Handles a websocket connection, which may proxy to another host and port
-sub handle_websocket_request
-{
-my ($ws, $simple) = @_;
-my $key = $header{'sec-websocket-key'};
-if (!$key) {
-	&http_error(500, "Missing Sec-Websocket-Key header");
-	return 0;
-	}
-my @users = split(/\s+/, $ws->{'user'});
-my @busers = split(/\s+/, $ws->{'buser'});
-if (@users || @busers) {
-	if (&indexof($authuser, @users) < 0 &&
-	    &indexof($baseauthuser, @busers) < 0) {
-		&http_error(500, "Invalid user for Websockets connection");
-		return 0;
-		}
-	}
-if ($ws->{'token'} && (!defined($in{'token'}) ||
-    $in{'token'} ne $ws->{'token'})) {
-	print DEBUG "websockets token mismatch for $simple\n";
-	&http_error(403, "Invalid Websockets token");
-	return 0;
-	}
-my $origin = $header{'origin'} || $header{'sec-websocket-origin'};
-my $parsed_origin = &parse_websocket_origin($origin);
-if (!$origin || !$parsed_origin) {
-	print DEBUG "websockets missing or invalid Origin header\n";
-	&http_error(403, "Invalid Websockets origin");
-	return 0;
-	}
-my @allowed_origins = &get_websocket_allowed_origins();
-if (!grep { $_ eq $parsed_origin } @allowed_origins) {
-	print DEBUG "websockets origin $parsed_origin not in ".
-		    join(" ", @allowed_origins)."\n";
-	&http_error(403, "Invalid Websockets origin");
-	return 0;
-	}
-my @protos = split(/\s*,\s*/, $header{'sec-websocket-protocol'});
-print DEBUG "websockets protos ",join(" ", @protos),"\n";
-# Once token and origin checks have passed, a ws-link route is a live
-# single-use credential. If the backend cannot complete its handshake, remove
-# that route before http_error exits this child.
-my $backend_fail = sub {
-	&cleanup_websocket_route($ws);
-	&http_error(@_);
-	return 0;
-	};
-
-# Connect to the configured backend
-my $fh = "WEBSOCKET";
-my ($backend_ssl, $backend_ssl_ctx);
-if ($ws->{'host'}) {
-	# Backend is a TCP port
-	my $err = &open_socket($ws->{'host'}, $ws->{'port'}, $fh);
-	return &$backend_fail(500, "Websockets connection failed : $err")
-		if ($err);
-	if ($ws->{'ssl'}) {
-		eval "use Net::SSLeay";
-		if ($@) {
-			return &$backend_fail(500,
-				"Missing Net::SSLeay perl module");
-			}
-		$backend_ssl_ctx = Net::SSLeay::CTX_new();
-		if (!$backend_ssl_ctx) {
-			return &$backend_fail(500,
-				"Failed to create SSL context");
-			}
-		$backend_ssl = Net::SSLeay::new($backend_ssl_ctx);
-		if (!$backend_ssl) {
-			return &$backend_fail(500,
-				"Failed to create SSL connection");
-			}
-		Net::SSLeay::set_fd($backend_ssl, fileno($fh));
-		my $sslhost = $ws->{'hostheader'} || $ws->{'host'};
-		if (defined(&Net::SSLeay::set_tlsext_host_name)) {
-			# Linked websocket routes may connect to an IP while the
-			# certificate belongs to the configured linked-server
-			# host.
-			my $snihost = $sslhost;
-			if ($snihost =~ /^\[([^\]]+)\](?::\d+)?$/) {
-				$snihost = $1;
-				}
-			elsif ($snihost =~ /^([^:]+):\d+$/) {
-				$snihost = $1;
-				}
-			Net::SSLeay::set_tlsext_host_name($backend_ssl, $snihost);
-			}
-		if (!Net::SSLeay::connect($backend_ssl)) {
-			return &$backend_fail(500,
-				"SSL connect to websockets backend failed");
-			}
-		if ($ws->{'checkssl'}) {
-			my $err = &check_websocket_backend_ssl(
-				$backend_ssl, $sslhost);
-			if ($err) {
-				return &$backend_fail(500,
-				    "Invalid SSL certificate from websockets ".
-				    "backend : $err");
-				}
-			}
-		}
-	print DEBUG "websockets host $ws->{'host'}:$ws->{'port'}\n";
-	}
-elsif ($ws->{'pipe'}) {
-	# Backend is a Unix pipe
-	open($fh, $ws->{'pipe'}) ||
-		return &$backend_fail(500, "Websockets pipe failed : $?");
-	print DEBUG "websockets pipe $ws->{'pipe'}\n";
-	}
-else {
-	return &$backend_fail(500, "Invalid Webmin websockets config");
-	}
-# Keep the rest of the websocket proxy code independent of whether the
-# backend hop is plain TCP or wrapped in TLS.
-my $backend_write = sub {
-	my ($buf) = @_;
-	my $offset = 0;
-	my $len = length($buf);
-	while($offset < $len) {
-		my $rv = $backend_ssl ?
-			Net::SSLeay::write($backend_ssl, substr($buf, $offset)) :
-			syswrite($fh, $buf, $len - $offset, $offset);
-		return 0 if (!defined($rv) || $rv <= 0);
-		$offset += $rv;
-		}
-	return 1;
-	};
-my $backend_read = sub {
-	my ($size) = @_;
-	if ($backend_ssl) {
-		return Net::SSLeay::read($backend_ssl, $size);
-		}
-	my $buf;
-	my $rv = sysread($fh, $buf, $size);
-	return $rv ? $buf : undef;
-	};
-my $backend_readline = sub {
-	my $line = "";
-	while(1) {
-		my $c = $backend_read->(1);
-		return undef if (!defined($c) || $c eq "");
-		$line .= $c;
-		last if ($c eq "\n");
-		}
-	return $line;
-	};
-
-# OpenSSL can keep decrypted bytes in its own buffer after the socket fd stops
-# being readable, so the forwarding loop must check this before select().
-my $backend_pending = sub {
-	return $backend_ssl && defined(&Net::SSLeay::pending) &&
-	       Net::SSLeay::pending($backend_ssl) > 0;
-	};
-
-# Prepare successful connection headers, but don't send them to the browser
-# until the backend websocket handshake has succeeded.
-eval "use Digest::SHA";
-if ($@) {
-	return &$backend_fail(500, "Missing Digest::SHA perl module");
-	}
-my $rkey = $key."258EAFA5-E914-47DA-95CA-C5AB0DC85B11";
-my $sha1 = Digest::SHA->new;
-$sha1->add($rkey);
-my $digest = $sha1->digest;
-$digest = &b64encode($digest);
-
-# Send a websockets request to the backend
-my $path = $ws->{'wspath'} || $simple;
-# Normal websocket proxies use the browser session id in the backend
-# Sec-WebSocket-Key. Linked xterm routes can instead provide a one-time
-# backend session key because the backend request is authenticated with Basic.
-my $backend_session = $ws->{'backend_session'} || $session_id;
-my $bsession_id = &b64encode($backend_session);
-print DEBUG "send request to $path to websockets backend\n";
-$backend_write->("GET $path HTTP/1.1\r\n") ||
-	return &$backend_fail(500, "Failed to write to websockets backend");
-if ($ws->{'host'} || $ws->{'hostheader'}) {
-	$backend_write->("Host: ".($ws->{'hostheader'} || $ws->{'host'})."\r\n") ||
-		return &$backend_fail(500, "Failed to write to websockets backend");
-	}
-$backend_write->("Upgrade: websocket\r\n") ||
-	return &$backend_fail(500, "Failed to write to websockets backend");
-$backend_write->("Connection: Upgrade\r\n") ||
-	return &$backend_fail(500, "Failed to write to websockets backend");
-if ($ws->{'nokey'}) {
-	$backend_write->("Sec-WebSocket-Key: $key\r\n") ||
-		return &$backend_fail(500, "Failed to write to websockets backend");
-	}
-else {
-	print DEBUG "Sending key $bsession_id\n";
-	$backend_write->("Sec-WebSocket-Key: $bsession_id\r\n") ||
-		return &$backend_fail(500, "Failed to write to websockets backend");
-	}
-if (@protos) {
-	$backend_write->("Sec-WebSocket-Protocol: ".join(" ", @protos)."\r\n") ||
-		return &$backend_fail(500, "Failed to write to websockets backend");
-	}
-if ($ws->{'origin'}) {
-	$backend_write->("Origin: $ws->{'origin'}\r\n") ||
-		return &$backend_fail(500, "Failed to write to websockets backend");
-	}
-if ($ws->{'auth'} && $ws->{'auth'} =~ /^basic:(\S+)$/) {
-	$backend_write->("Authorization: Basic $1\r\n") ||
-		return &$backend_fail(500, "Failed to write to websockets backend");
-	}
-$backend_write->("Sec-WebSocket-Version: $header{'sec-websocket-version'}\r\n") ||
-	return &$backend_fail(500, "Failed to write to websockets backend");
-$backend_write->("\r\n") ||
-	return &$backend_fail(500, "Failed to write to websockets backend");
-
-# Read back the reply
-my $rh = $backend_readline->();
-if (!defined($rh)) {
-	return &$backend_fail(500, "No response from websockets backend");
-	}
-$rh =~ s/\r|\n//g;
-print DEBUG "got $rh from websockets backend\n";
-if ($rh !~ /^HTTP\/1\.1\s+(\d+)/) {
-	return &$backend_fail(500, "Bad response from websockets backend : ".
-			      &html_strip($rh));
-	}
-my $code = $1;
-my %rheader;
-my $lastheader;
-while(1) {
-	$rh = $backend_readline->();
-	if (!defined($rh)) {
-		return &$backend_fail(500,
-			"Unexpected EOF from websockets backend");
-		}
-	$rh =~ s/\r|\n//g;
-	last if ($rh eq "");
-	if ($rh =~ /^(\S+):\s*(.*)$/) {
-		print DEBUG "got websockets header $1 = $2\n";
-                $rheader{$lastheader = lc($1)} = $2;
-                }
-        elsif ($rh =~ /^\s+(.*)$/) {
-                $rheader{$lastheader} .= $headline;
-                }
-        else {
-                return &$backend_fail(500,
-			"Bad header from websockets backend ".
-			&html_strip($rh));
-                }
-	}
-if ($code != 101) {
-	return &$backend_fail(500,
-		"Bad response code $code from websockets backend : ".
-		&html_strip($rh));
-	}
-if (lc($rheader{'upgrade'}) ne 'websocket') {
-	return &$backend_fail(500,
-		"Missing Upgrade header from websockets backend");
-	}
-if (lc($rheader{'connection'}) !~ /upgrade/) {
-	return &$backend_fail(500,
-		"Missing Connection header from websockets backend");
-	}
-
-# Check the reply key
-my $bdigest;
-if ($ws->{'nokey'}) {
-	$bdigest = $digest;
-	}
-else {
-	my $brkey = $bsession_id."258EAFA5-E914-47DA-95CA-C5AB0DC85B11";
-	my $bsha1 = Digest::SHA->new;
-	$bsha1->add($brkey);
-	$bdigest = $bsha1->digest;
-	$bdigest = &b64encode($bdigest);
-	}
-print DEBUG "expecting digest $bdigest\n";
-if (lc($rheader{'sec-websocket-accept'}) ne lc($bdigest)) {
-	return &$backend_fail(500,
-		"Incorrect digest header from websockets backend");
-	}
-# The route has been consumed by this child process. The active tunnel now owns
-# the open backend socket, so the temporary miniserv.conf route can be removed
-# before the tunnel goes long-lived. Final cleanup remains a harmless fallback.
-&cleanup_websocket_route($ws);
-
-# Send successful connection headers
-&write_data("HTTP/1.1 101 Switching Protocols\r\n");
-&write_data("Upgrade: websocket\r\n");
-&write_data("Connection: Upgrade\r\n");
-&write_data("Sec-Websocket-Accept: $digest\r\n");
-if (@protos) {
-	&write_data("Sec-Websocket-Protocol: $protos[0]\r\n");
-	}
-&write_data("\r\n");
-
-# Log now
-&log_request($loghost, $authuser, $reqline, "101", 0);
-
-# Start forwarding data
-seek(DEBUG, 0, 2);
-print DEBUG "in websockets loop\n";
-my $last_session_check_time = time();
-# Frontend browser sockets have a session id and should be revalidated while
-# open. Backend hops authenticated without a browser session must not be closed
-# by the periodic session check.
-my $verify_session = defined($session_id) && $session_id ne "";
-while(1) {
-	my ($buf, $ok);
-	my $uptime = 0;
-	my ($backend_ready, $browser_ready);
-	if (&$backend_pending()) {
-		$backend_ready = 1;
-		my $bm = undef;
-		vec($bm, fileno(SOCK), 1) = 1;
-		select($bm, undef, undef, 0);
-		$browser_ready = vec($bm, fileno(SOCK), 1);
-		}
-	else {
-		my $rmask = undef;
-		vec($rmask, fileno($fh), 1) = 1;
-		vec($rmask, fileno(SOCK), 1) = 1;
-		my $sel = select($rmask, undef, undef, 10);
-		$backend_ready = vec($rmask, fileno($fh), 1);
-		$browser_ready = vec($rmask, fileno(SOCK), 1);
-		}
-	if ($backend_ready) {
-		# Got something from the websockets backend
-		$buf = $backend_read->(1024);
-		last if (!defined($buf) || length($buf) == 0);
-		&write_data($buf);
-		$uptime = 1;
-		}
-	if ($browser_ready) {
-		# Got something from the browser
-		$buf = &read_data(1024);
-		last if (!defined($buf) || length($buf) == 0);
-		$backend_write->($buf) || last;
-		$uptime = 1;
-		}
-	my $now = time();
-	if ($verify_session && $now - $last_session_check_time > 10) {
-		# Re-validate the browser session every 10 seconds
-		print DEBUG "verifying websockets session $session_id\n";
-		print $PASSINw "verify $session_id $acptip $uptime\n";
-		<$PASSOUTr> =~ /(\d+)\s+(\S+)/;
-		if ($1 != 2) {
-			print DEBUG "session $session_id has expired!\n";
-			last;
-			}
-		$last_session_check_time = $now;
-		}
-	}
-Net::SSLeay::free($backend_ssl) if ($backend_ssl);
-Net::SSLeay::CTX_free($backend_ssl_ctx) if ($backend_ssl_ctx);
-close($fh);
-close(SOCK);
-&cleanup_websocket_route($ws);
-print DEBUG "done websockets loop\n";
-
-return 0;
-}
-
-# cleanup_websocket_route(&wsconfig)
-# Removes a single-use linked-server websocket route from miniserv.conf.
-sub cleanup_websocket_route
-{
-my ($ws) = @_;
-# Only link.cgi-created ws-link routes are temporary. Ordinary module
-# websocket routes are managed by their owning code and must be left alone.
-return 0 if (!$ws || !$ws->{'path'} || $ws->{'path'} !~ /\/ws-link-/);
-my $deleted;
-my $locked;
-my $cleanup_ok = eval {
-	&lock_config_file($config_file);
-	$locked = 1;
-	my %miniserv = &read_config_file($config_file);
-	if (delete($miniserv{"websockets_$ws->{'path'}"})) {
-		&write_file($config_file, \%miniserv);
-		$deleted = 1;
-		}
-	1;
-	};
-my $cleanup_err = $@;
-eval { &unlock_config_file($config_file) } if ($locked);
-if (!$cleanup_ok) {
-	&log_error("Failed to cleanup linked websocket route", $cleanup_err);
-	return 0;
-	}
-# The master keeps websocket routes parsed in memory.
-kill('USR1', $miniserv_main_pid || getppid()) if ($deleted);
-return $deleted;
-}
-
-# get_system_hostname()
-# Returns the hostname of this system, for reporting to listeners
-sub get_system_hostname
-{
-# On Windows, try computername environment variable
-return $ENV{'computername'} if ($ENV{'computername'});
-return $ENV{'COMPUTERNAME'} if ($ENV{'COMPUTERNAME'});
-
-# If a specific command is set, use it first
-if ($config{'hostname_command'}) {
-	local $out = `($config{'hostname_command'}) 2>&1`;
-	if (!$?) {
-		$out =~ s/\r|\n//g;
-		return $out;
-		}
-	}
-
-# First try the hostname command
-local $out = `hostname 2>&1`;
-if (!$? && $out =~ /\S/) {
-	$out =~ s/\r|\n//g;
-	return $out;
-	}
-
-# Try the Sys::Hostname module
-eval "use Sys::Hostname";
-if (!$@) {
-	local $rv = eval "hostname()";
-	if (!$@ && $rv) {
-		return $rv;
-		}
-	}
-
-# Must use net name on Windows
-local $out = `net name 2>&1`;
-if ($out =~ /\-+\r?\n(\S+)/) {
-	return $1;
-	}
-
-return undef;
-}
-
-# indexof(string, array)
-# Returns the index of some value in an array, or -1
-sub indexof {
-  local($i);
-  for($i=1; $i <= $#_; $i++) {
-    if ($_[$i] eq $_[0]) { return $i - 1; }
-  }
-  return -1;
-}
-
-
-# has_command(command)
-# Returns the full path if some command is in the path, undef if not
-sub has_command
-{
-local($d);
-if (!$_[0]) { return undef; }
-if (exists($has_command_cache{$_[0]})) {
-	return $has_command_cache{$_[0]};
-	}
-local $rv = undef;
-if ($_[0] =~ /^\//) {
-	$rv = -x $_[0] ? $_[0] : undef;
-	}
-else {
-	local $sp = $on_windows ? ';' : ':';
-	foreach $d (split($sp, $ENV{PATH})) {
-		if (-x "$d/$_[0]") {
-			$rv = "$d/$_[0]";
-			last;
-			}
-		if ($on_windows) {
-			foreach my $sfx (".exe", ".com", ".bat") {
-				if (-r "$d/$_[0]".$sfx) {
-					$rv = "$d/$_[0]".$sfx;
-					last;
-					}
-				}
-			}
-		}
-	}
-$has_command_cache{$_[0]} = $rv;
-return $rv;
-}
-
-# check_sudo_permissions(user, pass)
-# Returns 1 if some user can run any command via sudo
-sub check_sudo_permissions
-{
-local ($user, $pass) = @_;
-
-# First try the cache stored by the main process
-if ($PASSINw) {
-	print DEBUG "check_sudo_permissions: querying cache for $user\n";
-	print $PASSINw "readsudo $user\n";
-	local $can = <$PASSOUTr>;
-	chop($can);
-	print DEBUG "check_sudo_permissions: cache said $can\n";
-	if ($can =~ /^\d+$/ && $can != 2) {
-		return int($can);
-		}
-	}
-
-# Setup pipes for communication with the sudo sub-process
-pipe(SUDOINr, SUDOINw);
-pipe(SUDOOUTr, SUDOOUTw);
-print DEBUG "check_sudo_permissions\n";
-
-my @uinfo = getpwnam($user);
-if (!@uinfo) {
-	&log_error("Unix user $user does not exist for sudo");
-	return 0;
-	}
-
-my $pid = fork();
-print DEBUG "check_sudo_permissions: fork=$pid pid=$$\n";
-if ($pid < 0) {
-	&log_error("fork for sudo failed : $!");
-	return 0;
-	}
-if (!$pid) {
-	setsid();
-	($(, $)) = ( $uinfo[3],
-                     "$uinfo[3] ".join(" ", $uinfo[3],
-                                            &other_groups($uinfo[0])) );
-	($>, $<) = ($uinfo[2], $uinfo[2]);
-	$ENV{'USER'} = $ENV{'LOGNAME'} = $user;
-	$ENV{'HOME'} = $uinfo[7];
-
-	close(STDIN); close(STDOUT); close(STDERR);
-	untie(*STDIN); untie(*STDOUT); untie(*STDERR);
-	close(SUDOINw); close(SUDOOUTr);
-	close(SOCK);
-	close(MAIN);
-	open(STDIN, "<&SUDOINr");
-	open(STDOUT, ">&SUDOOUTw");
-	open(STDERR, ">&STDOUT");
-	exec("sudo -l -S");
-	print "Exec failed : $!\n";
-	exit 1;
-	}
-print DEBUG "check_sudo_permissions: pid=$pid\n";
-close(SUDOINr);
-close(SUDOOUTw);
-
-# Send password, and get back response
-my $oldfh = select(SUDOINw);
-$| = 1;
-select($oldfh);
-print DEBUG "check_sudo_permissions: about to send pass\n";
-local $SIG{'PIPE'} = 'ignore';	# Sometimes sudo doesn't ask for a password
-print SUDOINw $pass,"\n";
-print DEBUG "check_sudo_permissions: sent pass=$pass\n";
-close(SUDOINw);
-my $out;
-while(<SUDOOUTr>) {
-	print DEBUG "check_sudo_permissions: got $_";
-	$out .= $_;
-	}
-close(SUDOOUTr);
-kill('KILL', $pid);
-waitpid($pid, 0);
-local ($ok) = ($out =~ /\(ALL\)\s+ALL|\(ALL\)\s+NOPASSWD:\s+ALL|\(ALL\s*:\s*ALL\)\s+ALL|\(ALL\s*:\s*ALL\)\s+NOPASSWD:\s+ALL/ ? 1 : 0);
-
-# Update cache
-if ($PASSINw) {
-	print $PASSINw "writesudo $user $ok\n";
-	}
-
-return $ok;
-}
-
-sub other_groups
-{
-my ($user) = @_;
-my @rv;
-setgrent();
-while(my @g = getgrent()) {
-        my @m = split(/\s+/, $g[3]);
-        push(@rv, $g[2]) if (&indexof($user, @m) >= 0);
-        }
-endgrent();
-return @rv;
-}
-
-# is_mobile_useragent(agent)
-# Returns 1 if some user agent looks like a cellphone or other mobile device,
-# such as a treo.
-sub is_mobile_useragent
-{
-local ($agent) = @_;
-local @prefixes = ( 
-    "UP.Link",    # Openwave
-    "Nokia",      # All Nokias start with Nokia
-    "MOT-",       # All Motorola phones start with MOT-
-    "SAMSUNG",    # Samsung browsers
-    "Samsung",    # Samsung browsers
-    "SEC-",       # Samsung browsers
-    "AU-MIC",     # Samsung browsers
-    "AUDIOVOX",   # Audiovox
-    "BlackBerry", # BlackBerry
-    "hiptop",     # Danger hiptop Sidekick
-    "SonyEricsson", # Sony Ericsson
-    "Ericsson",     # Old Ericsson browsers , mostly WAP
-    "Mitsu/1.1.A",  # Mitsubishi phones
-    "Panasonic WAP", # Panasonic old WAP phones
-    "DoCoMo",     # DoCoMo phones
-    "Lynx",	  # Lynx text-mode linux browser
-    "Links",	  # Another text-mode linux browser
-    "Dalvik",	  # Android browser
-    );
-local @substrings = (
-    "UP.Browser",         # Openwave
-    "MobilePhone",        # NetFront
-    "AU-MIC-A700",        # Samsung A700 Obigo browsers
-    "Danger hiptop",      # Danger Sidekick hiptop
-    "Windows CE",         # Windows CE Pocket PC
-    "IEMobile",           # Windows mobile browser
-    "Blazer",             # Palm Treo Blazer
-    "BlackBerry",         # BlackBerries can emulate other browsers, but
-                          # they still keep this string in the UserAgent
-    "SymbianOS",          # New Series60 browser has safari in it and
-                          # SymbianOS is the only distinguishing string
-    "iPhone",		  # Apple iPhone KHTML browser
-    "iPod",		  # iPod touch browser
-    "MobileSafari",	  # HTTP client in iPhone
-    "Mobile Safari",	  # Samsung Galaxy S6 browser
-    "Opera Mini",	  # Opera Mini
-    "HTC_P3700",	  # HTC mobile device
-    "Pre/",		  # Palm Pre
-    "webOS/",		  # Palm WebOS
-    "Nintendo DS",	  # DSi / DSi-XL
-    );
-local @regexps = (
-    "Android.*Mobile",	  # Android phone
-    );
-foreach my $p (@prefixes) {
-	return 1 if ($agent =~ /^\Q$p\E/);
-	}
-foreach my $s (@substrings, @mobile_agents) {
-	return 1 if ($agent =~ /\Q$s\E/);
-	}
-foreach my $s (@regexps) {
-	return 1 if ($agent =~ /$s/);
-	}
-return 0;
-}
-
-# write_blocked_file()
-# Writes out a text file of blocked hosts and users
-sub write_blocked_file
-{
-open(BLOCKED, ">$config{'blockedfile'}");
-foreach my $d (grep { $hostfail{$_} } @deny) {
-	print BLOCKED "host $d $hostfail{$d} $blockhosttime{$d}\n";
-	}
-foreach my $d (grep { $userfail{$_} } @denyusers) {
-	print BLOCKED "user $d $userfail{$d} $blockusertime{$d}\n";
-	}
-close(BLOCKED);
-chmod(0700, $config{'blockedfile'});
-}
-
-sub write_pid_file
-{
-open(PIDFILE, ">$config{'pidfile'}");
-printf PIDFILE "%d\n", getpid();
-close(PIDFILE);
-$miniserv_main_pid = getpid();
-}
-
-# lock_user_password(user)
-# Updates a user's password file entry to lock it, both in memory and on disk.
-# Returns 1 if done, -1 if no such user, 0 if already locked
-sub lock_user_password
-{
-local ($user) = @_;
-local $uinfo = &get_user_details($user);
-if (!$uinfo) {
-	# No such user!
-	return -1;
-	}
-if ($uinfo->{'pass'} =~ /^\!/) {
-	# Already locked
-	return 0;
-	}
-if (!$uinfo->{'proto'}) {
-	# Write to users file
-	$users{$user} = "!".$users{$user};
-	open(USERS, $config{'userfile'});
-	local @ufile = <USERS>;
-	close(USERS);
-	foreach my $u (@ufile) {
-		local @uinfo = split(/:/, $u);
-		if ($uinfo[0] eq $user) {
-			$uinfo[1] = $users{$user};
-			}
-		$u = join(":", @uinfo);
-		}
-	open(USERS, ">$config{'userfile'}");
-	print USERS @ufile;
-	close(USERS);
-	return 0;
-	}
-
-if ($config{'userdb'}) {
-	# Update user DB
-	my ($dbh, $proto, $prefix, $args) = &connect_userdb($config{'userdb'});
-	if (!$dbh) {
-		return -1;
-		}
-	elsif ($proto eq "mysql" || $proto eq "postgresql") {
-		# Update user attribute
-		my $cmd = $dbh->prepare(
-			"update webmin_user set pass = ? where id = ?");
-		if (!$cmd || !$cmd->execute("!".$uinfo->{'pass'},
-					    $uinfo->{'id'})) {
-			# Update failed
-			&log_error("Failed to lock password : ",
-				     $dbh->errstr);
-			return -1;
-			}
-		$cmd->finish() if ($cmd);
-		}
-	elsif ($proto eq "ldap") {
-		# Update LDAP object
-		my $rv = $dbh->modify($uinfo->{'id'},
-		      replace => { 'webminPass' => '!'.$uinfo->{'pass'} });
-		if (!$rv || $rv->code) {
-			&log_error("Failed to lock password : ",
-				     ($rv ? $rv->error : "Unknown error"));
-			return -1;
-			}
-		}
-	&disconnect_userdb($config{'userdb'}, $dbh);
-	return 0;
-	}
-
-return -1;	# This should never be reached
-}
-
-# hash_session_id(sid)
-# Returns a keyed hash of a session ID, used as the lookup key in the
-# session DBM. HMAC-SHA256 with a per-install secret is preferred; the
-# legacy MD5 / Unix crypt paths remain only as fallbacks for systems that
-# lack Digest::SHA.
-sub hash_session_id
-{
-local ($sid) = @_;
-if (!$hash_session_id_cache{$sid}) {
-	if ($use_hmac_sha256 && $session_hmac_key) {
-		$hash_session_id_cache{$sid} =
-			Digest::SHA::hmac_sha256_hex($sid, $session_hmac_key);
-		}
-	elsif ($use_md5) {
-		# Take MD5 hash
-		$hash_session_id_cache{$sid} = &encrypt_md5($sid);
-		}
-	else {
-		# Unix crypt
-		$hash_session_id_cache{$sid} = &unix_crypt($sid, "XX");
-		}
-	}
-return $hash_session_id_cache{$sid};
-}
-
-# load_session_secret()
-# Reads a per-install HMAC key from $config{'session_keyfile'}, or generates
-# a new 32-byte key from /dev/urandom and writes it with mode 0600 if the
-# file is missing. Sets $session_hmac_key. Idempotent across config reloads.
-sub load_session_secret
-{
-my $kf = $config{'session_keyfile'};
-return if (!$kf);
-my $oldumask = umask(0077);
-if (-r $kf) {
-	chmod(0600, $kf);
-	if (open(my $fh, "<", $kf)) {
-		binmode($fh);
-		local $/;
-		$session_hmac_key = <$fh>;
-		close($fh);
-		}
-	}
-if (!$session_hmac_key || length($session_hmac_key) < 16) {
-	my $key;
-	if (open(my $rh, "<", "/dev/urandom")) {
-		binmode($rh);
-		read($rh, $key, 32);
-		close($rh);
-		}
-	if (!$key || length($key) < 32) {
-		# /dev/urandom unusable; fall back to a hashed mix of
-		# Perl's rand() and the PID/time. Weaker, but the file
-		# still ends up 0600 and is per-install.
-		my $mix = '';
-		$mix .= pack("N", int(rand(0xffffffff))) for (1..8);
-		$mix .= pack("NN", $$, time());
-		if ($use_hmac_sha256) {
-			$key = Digest::SHA::sha256($mix);
-			}
-		else {
-			$key = $mix;
-			}
-		}
-	if (open(my $wh, ">", $kf)) {
-		binmode($wh);
-		chmod(0600, $kf);
-		print $wh $key;
-		close($wh);
-		$session_hmac_key = $key;
-		}
-	else {
-		&log_error("Failed to write session key file $kf : $!");
-		}
-	}
-umask($oldumask);
-}
-
-# open_session_db()
-# Opens the session DBM with a tight umask, then forces 0600 on the
-# resulting on-disk files so pre-existing loose perms from older installs
-# are corrected. Tries SDBM first, falling back to NDBM.
-sub open_session_db
-{
-my $oldumask = umask(0077);
-eval "use SDBM_File";
-dbmopen(%sessiondb, $config{'sessiondb'}, 0600);
-eval "\$sessiondb{'1111111111'} = 'foo bar';";
-if ($@) {
-	dbmclose(%sessiondb);
-	eval "use NDBM_File";
-	dbmopen(%sessiondb, $config{'sessiondb'}, 0600);
-	}
-else {
-	delete($sessiondb{'1111111111'});
-	}
-foreach my $f (glob("$config{'sessiondb'}*")) {
-	chmod(0600, $f);
-	}
-umask($oldumask);
-}
-
-# encrypt_md5(string, [salt])
-# Returns a string encrypted in MD5 format
-sub encrypt_md5
-{
-local ($passwd, $salt) = @_;
-local $magic = '$1$';
-if ($salt =~ /^\$1\$([^\$]+)/) {
-	# Extract actual salt from already encrypted password
-	$salt = $1;
-	}
-
-# Add the password
-local $ctx = eval "new $use_md5";
-$ctx->add($passwd);
-if ($salt) {
-	$ctx->add($magic);
-	$ctx->add($salt);
-	}
-
-# Add some more stuff from the hash of the password and salt
-local $ctx1 = eval "new $use_md5";
-$ctx1->add($passwd);
-if ($salt) {
-	$ctx1->add($salt);
-	}
-$ctx1->add($passwd);
-local $final = $ctx1->digest();
-for($pl=length($passwd); $pl>0; $pl-=16) {
-	$ctx->add($pl > 16 ? $final : substr($final, 0, $pl));
-	}
-
-# This piece of code seems rather pointless, but it's in the C code that
-# does MD5 in PAM so it has to go in!
-local $j = 0;
-local ($i, $l);
-for($i=length($passwd); $i; $i >>= 1) {
-	if ($i & 1) {
-		$ctx->add("\0");
-		}
-	else {
-		$ctx->add(substr($passwd, $j, 1));
-		}
-	}
-$final = $ctx->digest();
-
-if ($salt) {
-	# This loop exists only to waste time
-	for($i=0; $i<1000; $i++) {
-		$ctx1 = eval "new $use_md5";
-		$ctx1->add($i & 1 ? $passwd : $final);
-		$ctx1->add($salt) if ($i % 3);
-		$ctx1->add($passwd) if ($i % 7);
-		$ctx1->add($i & 1 ? $final : $passwd);
-		$final = $ctx1->digest();
-		}
-	}
-
-# Convert the 16-byte final string into a readable form
-local $rv;
-local @final = map { ord($_) } split(//, $final);
-$l = ($final[ 0]<<16) + ($final[ 6]<<8) + $final[12];
-$rv .= &to64($l, 4);
-$l = ($final[ 1]<<16) + ($final[ 7]<<8) + $final[13];
-$rv .= &to64($l, 4);
-$l = ($final[ 2]<<16) + ($final[ 8]<<8) + $final[14];
-$rv .= &to64($l, 4);
-$l = ($final[ 3]<<16) + ($final[ 9]<<8) + $final[15];
-$rv .= &to64($l, 4);
-$l = ($final[ 4]<<16) + ($final[10]<<8) + $final[ 5];
-$rv .= &to64($l, 4);
-$l = $final[11];
-$rv .= &to64($l, 2);
-
-# Add salt if needed
-if ($salt) {
-	return $magic.$salt.'$'.$rv;
-	}
-else {
-	return $rv;
-	}
-}
-
-# unix_crypt_supports_sha512()
-# Returns 1 if the built-in crypt() function can already do SHA512
-sub unix_crypt_supports_sha512
-{
-my $hash = '$6$Tk5o/GEE$zjvXhYf/dr5M7/jan3pgunkNrAsKmQO9r5O8sr/Cr1hFOLkWmsH4iE9hhqdmHwXd5Pzm4ubBWTEjtMeC.h5qv1';
-my $newhash = eval { crypt('test', $hash) };
-return $newhash eq $hash;
-}
-
-# encrypt_sha512(password, [salt])
-# Hashes a password, possibly with the given salt, with SHA512. The salt
-# arg may be a full $6$salt$hash form (verification) or a bare $6$salt$
-# (fresh hashing) — either way it must be passed to crypt() intact so
-# crypt() selects SHA512. Only synthesise a new salt when none is given.
-sub encrypt_sha512
-{
-my ($passwd, $salt) = @_;
-$salt = '$6$'.substr(time(), -8).'$' if (!$salt || $salt !~ /^\$6\$/);
-return crypt($passwd, $salt);
-}
-
-sub to64
-{
-local ($v, $n) = @_;
-local $r;
-while(--$n >= 0) {
-        $r .= $itoa64[$v & 0x3f];
-        $v >>= 6;
-        }
-return $r;
-}
-
-# read_file(file, &assoc, [&order], [lowercase])
-# Fill an associative array with name=value pairs from a file
-sub read_file
-{
-open(ARFILE, $_[0]) || return 0;
-while(<ARFILE>) {
-	s/\r|\n//g;
-        if (!/^#/ && /^([^=]*)=(.*)$/) {
-		$_[1]->{$_[3] ? lc($1) : $1} = $2;
-		push(@{$_[2]}, $1) if ($_[2]);
-        	}
-        }
-close(ARFILE);
-return 1;
-}
- 
-# write_file(file, array)
-# Write out the contents of an associative array as name=value lines
-sub write_file
-{
-local(%old, @order);
-&read_file($_[0], \%old, \@order);
-open(ARFILE, ">$_[0]");
-foreach $k (@order) {
-        print ARFILE $k,"=",$_[1]->{$k},"\n" if (exists($_[1]->{$k}));
-	}
-foreach $k (keys %{$_[1]}) {
-        print ARFILE $k,"=",$_[1]->{$k},"\n" if (!exists($old{$k}));
-        }
-close(ARFILE);
-}
-
-# execute_ready_webmin_crons(run-count)
-# Find and run any cron jobs that are due, based on their last run time and
-# execution interval
-sub execute_ready_webmin_crons
-{
-my ($runs) = @_;
-my $now = time();
-my $changed = 0;
-foreach my $cron (@webmincrons) {
-	my $run = 0;
-	if ($runs == 0 && $cron->{'boot'}) {
-		# If cron job wants to be run at startup, run it now
-		$run = 1;
-		}
-	elsif ($cron->{'disabled'}) {
-		# Explicitly disabled
-		$run = 0;
-		}
-	elsif (!$webmincron_last{$cron->{'id'}}) {
-		# If not ever run before, don't run right away
-		$webmincron_last{$cron->{'id'}} = $now;
-		$changed = 1;
-		}
-	elsif ($cron->{'interval'} &&
-	       $now - $webmincron_last{$cron->{'id'}} > $cron->{'interval'}) {
-		# Older than interval .. time to run
-		$run = 1;
-		}
-	elsif ($cron->{'mins'} ne '') {
-		# Check if current time matches spec, and we haven't run in the
-		# last minute
-		my @tm = localtime($now);
-		if (&matches_cron($cron->{'mins'}, $tm[1], 0) &&
-		    &matches_cron($cron->{'hours'}, $tm[2], 0) &&
-		    &matches_cron($cron->{'days'}, $tm[3], 1) &&
-		    &matches_cron($cron->{'months'}, $tm[4]+1, 1) &&
-		    &matches_cron($cron->{'weekdays'}, $tm[6], 0) &&
-		    $now - $webmincron_last{$cron->{'id'}} > 60) {
-			$run = 1;
-			}
-		}
-
-	if ($run) {
-		print DEBUG "Running cron id=$cron->{'id'} ".
-			    "module=$cron->{'module'} func=$cron->{'func'} ".
-			    "arg0=$cron->{'arg0'}\n";
-		$webmincron_last{$cron->{'id'}} = $now;
-		$changed = 1;
-		my $pid = &execute_webmin_command($config{'webmincron_wrapper'},
-						  [ $cron ]);
-		push(@childpids, $pid);
-		}
-	}
-if ($changed) {
-	# Write out file containing last run times
-	&write_file($config{'webmincron_last'}, \%webmincron_last);
-	}
-}
-
-# matches_cron(cron-spec, time, first-value)
-# Checks if some minute or hour matches some cron spec, which can be * or a list
-# of numbers.
-sub matches_cron
-{
-my ($spec, $tm, $first) = @_;
-if ($spec eq '*') {
-	return 1;
-	}
-else {
-	foreach my $s (split(/,/, $spec)) {
-		if ($s == $tm ||
-		    $s =~ /^(\d+)\-(\d+)$/ &&
-		      $tm >= $1 && $tm <= $2 ||
-		    $s =~ /^\*\/(\d+)$/ &&
-		      $tm % $1 == $first ||
-		    $s =~ /^(\d+)\-(\d+)\/(\d+)$/ &&
-		      $tm >= $1 && $tm <= $2 && $tm % $3 == $first) {
-			return 1;
-			}
-		}
-	return 0;
-	}
-}
-
-# read_webmin_crons()
-# Read all scheduled webmin cron functions and store them in the @webmincrons
-# global list
-sub read_webmin_crons
-{
-@webmincrons = ( );
-opendir(CRONS, $config{'webmincron_dir'});
-print DEBUG "Reading crons from $config{'webmincron_dir'}\n";
-foreach my $f (readdir(CRONS)) {
-	if ($f =~ /^(\d+)\.cron$/) {
-		my %cron;
-		&read_file("$config{'webmincron_dir'}/$f", \%cron);
-		$cron{'id'} = $1;
-		my $broken = 0;
-		foreach my $n ('module', 'func') {
-			if (!$cron{$n}) {
-				&log_error("Cron $1 missing $n");
-				$broken = 1;
-				}
-			}
-		if (!$cron{'interval'} && $cron{'mins'} eq '' &&
-		    $cron{'special'} eq '' && !$cron{'boot'}) {
-			&log_error("Cron $1 missing any time spec");
-			$broken = 1;
-			}
-		if ($cron{'special'} eq 'hourly') {
-			# Run every hour on the hour
-			$cron{'mins'} = 0;
-			$cron{'hours'} = '*';
-			$cron{'days'} = '*';
-			$cron{'months'} = '*';
-			$cron{'weekdays'} = '*';
-			}
-		elsif ($cron{'special'} eq 'daily') {
-			# Run every day at midnight
-			$cron{'mins'} = 0;
-			$cron{'hours'} = '0';
-			$cron{'days'} = '*';
-			$cron{'months'} = '*';
-			$cron{'weekdays'} = '*';
-			}
-		elsif ($cron{'special'} eq 'monthly') {
-			# Run every month on the 1st
-			$cron{'mins'} = 0;
-			$cron{'hours'} = '0';
-			$cron{'days'} = '1';
-			$cron{'months'} = '*';
-			$cron{'weekdays'} = '*';
-			}
-		elsif ($cron{'special'} eq 'weekly') {
-			# Run every month on the 1st
-			$cron{'mins'} = 0;
-			$cron{'hours'} = '0';
-			$cron{'days'} = '*';
-			$cron{'months'} = '*';
-			$cron{'weekdays'} = '0';
-			}
-		elsif ($cron{'special'} eq 'yearly' ||
-		       $cron{'special'} eq 'annually') {
-			# Run every year on 1st january
-			$cron{'mins'} = 0;
-			$cron{'hours'} = '0';
-			$cron{'days'} = '1';
-			$cron{'months'} = '1';
-			$cron{'weekdays'} = '*';
-			}
-		elsif ($cron{'special'}) {
-			&log_error("Cron $1 invalid special time $cron{'special'}");
-			$broken = 1;
-			}
-		if ($cron{'special'}) {
-			delete($cron{'special'});
-			}
-		if (!$broken) {
-			print DEBUG "Adding cron id=$cron{'id'} module=$cron{'module'} func=$cron{'func'} arg0=$cron{'arg0'}\n";
-			push(@webmincrons, \%cron);
-			}
-		}
-	}
-closedir(CRONS);
-}
-
-# precache_files()
-# Read into the Webmin cache all files marked for pre-caching
-sub precache_files
-{
-undef(%main::read_file_cache);
-foreach my $g (split(/\s+/, $config{'precache'})) {
-	next if ($g eq "none");
-	foreach my $f (glob("$config{'root'}/$g")) {
-		my @st = stat($f);
-		next if (!@st);
-		$main::read_file_cache{$f} = { };
-		&read_file($f, $main::read_file_cache{$f});
-		$main::read_file_cache_time{$f} = $st[9];
-		}
-	}
-}
-
-# Check if some address is valid IPv4, returns 1 if so.
-sub check_ipaddress
-{
-return $_[0] =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/ &&
-	$1 >= 0 && $1 <= 255 &&
-	$2 >= 0 && $2 <= 255 &&
-	$3 >= 0 && $3 <= 255 &&
-	$4 >= 0 && $4 <= 255;
-}
-
-# Check if some IPv6 address is properly formatted, and returns 1 if so.
-# Kept in sync with web-lib-funcs.pl's copy.
-sub check_ip6address
-{
-my $addr = $_[0];
-my $m = 0;
-
-# Strip an optional /N netmask before splitting. Doing this on the
-# raw string (rather than from the last split element) keeps split()'s
-# trailing-empty accounting intact for inputs like "2001:db8::/32",
-# where the netmask would otherwise hide the trailing "::" shorthand.
-if ($addr =~ s{/(\d+)\z}{}) {
-	$m = $1;
-	}
-return 0 if ($m < 0 || $m > 128);
-
-# Special case for unspecified address (analogous to 0.0.0.0 in IPv4),
-# both bare and with a netmask.
-return 1 if ($addr eq "::");
-
-my @blocks = split(/:/, $addr);
-return 0 if (@blocks == 0);
-
-# Accept the IPv4-in-IPv6 forms (RFC 4291 §2.5.5: "::ffff:N.N.N.N"
-# IPv4-mapped, and the more general "X:X:X:X:X:X:N.N.N.N"). If the
-# last block is a dotted-quad, validate the octets and count it as two
-# 16-bit groups for the overall 8-group ceiling. The leading ":" guard
-# distinguishes IPv4-tailed IPv6 from a bare IPv4 address — callers
-# like ip_match() rely on this sub returning false for "10.0.0.1".
-my $count = scalar(@blocks);
-if ($addr =~ /:/ &&
-    $blocks[-1] =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)\z/) {
-	return 0 if ($1 > 255 || $2 > 255 || $3 > 255 || $4 > 255);
-	$count++;
-	pop(@blocks);
-	}
-return 0 if ($count > 8);
-
-my $empty = 0;
-foreach my $b (@blocks) {
-	return 0 if ($b ne "" && $b !~ /^[0-9a-f]{1,4}$/i);
-	$empty++ if ($b eq "");
-	}
-return 0 if ($empty > 1 && !($addr =~ /^::/ && $empty == 2));
-return 1;
-}
-
-# network_to_address(binary)
-# Given a network address in binary IPv4 or v4 format, return the string form
-sub network_to_address
-{
-local ($addr) = @_;
-if (length($addr) == 4 || !$use_ipv6) {
-	return inet_ntoa($addr);
-	}
-else {
-	return inet_ntop(AF_INET6(), $addr);
-	}
-}
-
-# redirect_stderr_to_log()
-# Re-direct STDERR to error log file
-sub redirect_stderr_to_log
-{
-if ($config{'errorlog'} ne '-') {
-	close(STDERR);
-	open(STDERR, ">>$config{'errorlog'}") ||
-		die "failed to open $config{'errorlog'} : $!";
-	if ($config{'logperms'}) {
-		chmod(oct($config{'logperms'}), $config{'errorlog'});
-		}
-	}
-select(STDERR); $| = 1; select(STDOUT);
-}
-
-# open_debug_to_log([msg])
-# Direct the DEBUG file handle somewhere
-sub open_debug_to_log
-{
-my ($msg) = @_;
-close(DEBUG);
-if ($config{'debuglog'}) {
-	open(DEBUG, ">>$config{'debuglog'}");
-	chmod(0700, $config{'debuglog'});
-	select(DEBUG); $| = 1; select(STDOUT);
-	print DEBUG $msg if ($msg);
-	}
-else {
-	open(DEBUG, ">/dev/null");
-	}
-}
-
-# should_gzip_file(filename)
-# Returns 1 if some path should be gzipped
-sub should_gzip_file
-{
-my ($path) = @_;
-return $path !~ /\.(gif|png|jpg|jpeg|tif|tiff)$/i;
-}
-
-# get_expires_time(path)
-# Given a URL path, return the client-side expiry time in seconds
-sub get_expires_time
-{
-my ($path) = @_;
-foreach my $pe (@expires_paths) {
-	if ($path =~ /$pe->[0]/i) {
-		return $pe->[1];
-		}
-	}
-return $config{'expires'};
-}
-
-sub html_escape
-{
-my ($tmp) = @_;
-$tmp =~ s/&/&amp;/g;
-$tmp =~ s/</&lt;/g;
-$tmp =~ s/>/&gt;/g;
-$tmp =~ s/\"/&quot;/g;
-$tmp =~ s/\'/&#39;/g;
-$tmp =~ s/=/&#61;/g;
-return $tmp;
-}
-
-sub html_strip
-{
-my ($tmp) = @_;
-$tmp =~ s/<[^>]*>//g;
-return $tmp;
-}
-
-# validate_twofactor(username, token, orig-username)
-# Checks if a user's two-factor token is valid or not. Returns undef on success
-# or the error message on failure.
-sub validate_twofactor
-{
-my ($user, $token, $origuser) = @_;
-local $uinfo = &get_user_details($user, $origuser);
-$token =~ s/^\s+//;
-$token =~ s/\s+$//;
-$token || return "No two-factor token entered";
-$uinfo->{'twofactor_provider'} || return undef;
-pipe(TOKENr, TOKENw);
-my $pid = &execute_webmin_command($config{'twofactor_wrapper'},
-	[ $user, $uinfo->{'twofactor_provider'}, $uinfo->{'twofactor_id'},
-	  $token, $uinfo->{'twofactor_apikey'} ],
-	TOKENw);
-close(TOKENw);
-waitpid($pid, 0);
-my $ex = $?;
-my $out = <TOKENr>;
-close(TOKENr);
-if ($ex) {
-	return $out || "Unknown two-factor authentication failure";
-	}
-return undef;
-}
-
-# execute_webmin_command(command, &argv, [stdout-fd])
-# Run some Webmin script in a sub-process, like webmincron.pl
-# Returns the PID of the new process.
-sub execute_webmin_command
-{
-my ($cmd, $argv, $fd) = @_;
-my $pid = fork();
-if (!$pid) {
-	# Run via a wrapper command, which we run like a CGI
-	dbmclose(%sessiondb);
-	if ($fd) {
-		open(STDOUT, ">&$fd");
-		}
-	else {
-		open(STDOUT, ">&STDERR");
-		}
-	&close_all_sockets();
-	&close_all_pipes();
-	close(LISTEN);
-
-	# Setup CGI-like environment
-	$envtz = $ENV{"TZ"};
-	$envuser = $ENV{"USER"};
-	$envpath = $ENV{"PATH"};
-	$envlang = $ENV{"LANG"};
-	$envroot = $ENV{"SystemRoot"};
-	$envperllib = $ENV{'PERLLIB'};
-	foreach my $k (keys %ENV) {
-		delete($ENV{$k});
-		}
-	$ENV{"PATH"} = $envpath if ($envpath);
-	$ENV{"TZ"} = $envtz if ($envtz);
-	$ENV{"USER"} = $envuser if ($envuser);
-	$ENV{"OLD_LANG"} = $envlang if ($envlang);
-	$ENV{"SystemRoot"} = $envroot if ($envroot);
-	$ENV{'PERLLIB'} = $envperllib if ($envperllib);
-	$ENV{"HOME"} = $user_homedir;
-	$ENV{"SERVER_SOFTWARE"} = $config{"server"};
-	$ENV{"SERVER_ADMIN"} = $config{"email"};
-	$root0 = $roots[0];
-	$ENV{"SERVER_ROOT"} = $root0;
-	$ENV{"SERVER_REALROOT"} = $root0;
-	$ENV{"SERVER_PORT"} = $config{'port'};
-	$ENV{"WEBMIN_CRON"} = 1;
-	$ENV{"DOCUMENT_ROOT"} = $root0;
-	$ENV{"THEME_ROOT"} = $root0."/".$config{"preroot"};
-	$ENV{"THEME_DIRS"} = $config{"preroot"} || "";
-	$ENV{"DOCUMENT_REALROOT"} = $root0;
-	$ENV{"MINISERV_CONFIG"} = $config_file;
-	$ENV{"HTTPS"} = "ON" if ($use_ssl);
-	$ENV{"SSL_HSTS"} = $config{"ssl_hsts"};
-	$ENV{"MINISERV_PID"} = $miniserv_main_pid;
-	$ENV{"SCRIPT_FILENAME"} = $cmd;
-	if ($ENV{"SCRIPT_FILENAME"} =~ /^\Q$root0\E(\/.*)$/) {
-		$ENV{"SCRIPT_NAME"} = $1;
-		}
-	$cmd =~ /^(.*)\//;
-	$ENV{"PWD"} = $1;
-	foreach $k (keys %config) {
-		if ($k =~ /^env_(\S+)$/) {
-			$ENV{$1} = $config{$k};
-			}
-		}
-	chdir($ENV{"PWD"});
-	$SIG{'CHLD'} = 'DEFAULT';
-	eval {
-		# Have SOCK closed if the perl exec's something
-		use Fcntl;
-		fcntl(SOCK, F_SETFD, FD_CLOEXEC);
-		};
-
-	# Run the wrapper script by evaling it
-	if ($cmd =~ /\/([^\/]+)\/([^\/]+)$/) {
-		$pkg = $1;
-		}
-	$0 = $cmd;
-	@ARGV = @$argv;
-	$main_process_id = $$;
-	eval "
-		\%pkg::ENV = \%ENV;
-		package $pkg;
-		do \"$cmd\";
-		die \$@ if (\$@);
-		";
-	if ($@) {
-		&log_error("Perl failure : $@");
-		}
-	exit(0);
-	}
-return $pid;
-}
-
-# canonicalize_ip6(address)
-# Converts an address to its full long form. Ie. 2001:db8:0:f101::20 to
-# 2001:0db8:0000:f101:0000:0000:0000:0020
-sub canonicalize_ip6
-{
-my ($addr) = @_;
-return $addr if (!&check_ip6address($addr));
-my @w = split(/:/, $addr, -1);
-my $idx = &indexof("", @w);
-if ($idx >= 0) {
-	# Expand ::
-	my $endidx = $idx;
-	while($endidx+1 < @w && $w[$endidx+1] eq "") {
-		$endidx++;
-		}
-	my $mis = 8 - (scalar(@w) - ($endidx - $idx + 1));
-	my @nw = @w[0..$idx-1];
-	for(my $i=0; $i<$mis; $i++) {
-		push(@nw, 0);
-		}
-	push(@nw, @w[$endidx+1 .. $#w]);
-	@w = @nw;
-	}
-foreach my $w (@w) {
-	while(length($w) < 4) {
-		$w = "0".$w;
-		}
-	}
-return lc(join(":", @w));
-}
-
-# expand_ipv6_bytes(address)
-# Given a canonical IPv6 address, split it into an array of bytes
-sub expand_ipv6_bytes
-{
-my ($addr) = @_;
-my @rv;
-foreach my $w (split(/:/, $addr)) {
-	$w =~ /^(..)(..)$/ || return ( );
-	push(@rv, hex($1), hex($2));
-	}
-return @rv;
-}
-
-# ip6_prefix_match(address, network, prefix)
-# Returns 1 if an IPv6 address is in a network prefix.
-sub ip6_prefix_match
-{
-my ($addr, $network, $prefix) = @_;
-my @addr = &expand_ipv6_bytes(&canonicalize_ip6($addr));
-my @network = &expand_ipv6_bytes(&canonicalize_ip6($network));
-return 0 if (@addr != 16 || @network != 16 || $prefix < 0 || $prefix > 128);
-my $bytes = int($prefix / 8);
-my $bits = $prefix % 8;
-for(my $i=0; $i<$bytes; $i++) {
-	return 0 if ($addr[$i] != $network[$i]);
-	}
-if ($bits) {
-	my $mask = (0xff << (8 - $bits)) & 0xff;
-	return 0 if (($addr[$bytes] & $mask) != ($network[$bytes] & $mask));
-	}
-return 1;
-}
-
-sub get_somaxconn
-{
-return defined(&SOMAXCONN) ? SOMAXCONN : 128;
-}
-
-sub is_bad_header
-{
-my ($value, $name) = @_;
-return $value =~ /^\s*\(\s*\)\s*\{/ ? 1 : 0;
-}
-
-# sysread_line(fh)
-# Read a line from a file handle, using sysread to get a byte at a time
-sub sysread_line
-{
-local ($fh) = @_;
-local $line;
-while(1) {
-	local ($buf, $got);
-	$got = sysread($fh, $buf, 1);
-	last if ($got <= 0);
-	$line .= $buf;
-	last if ($buf eq "\n");
-	}
-return $line;
-}
-
-# getenv(env_key)
-# Returns env var disregard of case
-sub getenv
-{
-my ($key) = @_;
-return $ENV{ uc($key) } || $ENV{ lc($key) };
-}
-
-# open_socket(host, port, filehandle)
-# Connect to a TCP port on some host. Returns undef on success, or an error
-# message on failure.
-sub open_socket
-{
-my ($host, $port, $fh) = @_;
-
-# Lookup all IPv4 and v6 addresses for the host
-my @ips = &to_ipaddress($host);
-push(@ips, &to_ip6address($host));
-if (!@ips) {
-	return "Failed to lookup IP address for $host";
-	}
-
-# Try each of the resolved IPs
-my $msg;
-my $proto = getprotobyname("tcp");
-foreach my $ip (@ips) {
-	$msg = undef;
-	if (&check_ipaddress($ip)) {
-		# Create IPv4 socket and connection
-		if (!socket($fh, PF_INET(), SOCK_STREAM, $proto)) {
-			$msg = "Failed to create socket : $!";
-			next;
-			}
-		my $addr = inet_aton($ip);
-		if ($gconfig{'bind_proxy'}) {
-			# BIND to outgoing IP
-			if (!bind($fh, pack_sockaddr_in(0, inet_aton($bindip)))) {
-				$msg = "Failed to bind to source address : $!";
-				next;
-				}
-			}
-		if (!connect($fh, pack_sockaddr_in($port, $addr))) {
-			$msg = "Failed to connect to $host:$port : $!";
-			next;
-			}
-		}
-	else {
-		# Create IPv6 socket and connection
-		if (!&supports_ipv6()) {
-			$msg = "IPv6 connections are not supported";
-			next;
-			}
-		if (!socket($fh, PF_INET6(), SOCK_STREAM, $proto)) {
-			$msg = "Failed to create IPv6 socket : $!";
-			next;
-			}
-		my $addr = inet_pton(AF_INET6(), $ip);
-		if (!connect($fh, pack_sockaddr_in6($port, $addr))) {
-			$msg = "Failed to IPv6 connect to $host:$port : $!";
-			next;
-			}
-		}
-	last;	# If we got this far, it worked
-	}
-if ($msg) {
-	# Last attempt failed
-	return $msg;
-	}
-
-# Disable buffering
-my $old = select($fh);
-$| = 1;
-select($old);
-return undef;
-}
-
-# Returns server information in headers
-sub server_info
-{
-my $sig = $config{'server_sig'};
-if (!$sig) {
-	$sig =
-		$session_id ?
-			$config{'server'} : "MiniServ";
-	}
-return $sig;
-}
-
-=head2 cert_names($file)
-
-Extract Common Name and Subject Alternative Names from an X.509 certificate
-file. Supports both PEM and DER certificates. Returns undef if file cannot be
-read or parsed. Cache results for speed.
-
-=cut
-sub cert_names
-{
-my ($file) = @_;
-return $cert_names_cache{$file} if ($cert_names_cache{$file});
-return undef if (!$file || !-r $file);
-my %rv;
-my $cert;
-
-# Try PEM first
-eval {
-	my $bio = Net::SSLeay::BIO_new_file($file, 'r');
-	if ($bio) {
-		$cert = Net::SSLeay::PEM_read_bio_X509($bio);
-		Net::SSLeay::BIO_free($bio);
-		}
-	};
-
-# Try DER if PEM failed
-if (!$cert) {
-	eval {
-		my $bio = Net::SSLeay::BIO_new_file($file, 'rb');
-		if ($bio) {
-			$cert = Net::SSLeay::d2i_X509_bio($bio);
-			Net::SSLeay::BIO_free($bio);
-			}
-		};
-	}
-
-# Certificate not found
-return undef if !$cert;
-
-# Subject
-my $subject = Net::SSLeay::X509_get_subject_name($cert);
-if ($subject) {
-	# commonName
-	my $cn = Net::SSLeay::X509_NAME_get_text_by_NID($subject, 13);
-	$rv{cn} = $cn if defined $cn && $cn ne '' && $cn ne '-1';
-	}
-
-# subjectAltName
-my @alts = Net::SSLeay::X509_get_subjectAltNames($cert);
-if (@alts) {
-	my @dns;
-	while (my ($type, $val) = splice(@alts, 0, 2)) {
-		push @dns, $val if $type == 2;
-		}
-	$rv{alt} = \@dns if @dns;
-	}
-
-Net::SSLeay::X509_free($cert);
-$cert_names_cache{$file} = \%rv;
-return \%rv;
-}
-
-# ssl_hostname_match(hostname, &hosts-list)
-# Does a hostname match a list of hostnames for an SSL cert?
-sub ssl_hostname_match
-{
-my ($h, $hosts) = @_;
-$h =~ s/:\d+$//;
-foreach my $p (@$hosts) {
-	return 1 if (lc($p) eq lc($h));
-	return 1 if ($p =~ /^\*\.(\S+)$/ &&
-		     (lc($h) eq lc($1) || $h =~ /^([^\.]+)\.\Q$1\E$/i));
-	return 2 if ($p eq "*");
-	}
-return 0;
-}
-
-# check_websocket_backend_ssl(ssl-handle, host)
-# Returns an error if the websocket backend certificate is not for host.
-sub check_websocket_backend_ssl
-{
-my ($ssl, $host) = @_;
-if ($host =~ /^\[([^\]]+)\](?::\d+)?$/) {
-	$host = $1;
-	}
-elsif ($host =~ /^([^:]+):\d+$/) {
-	$host = $1;
-	}
-my $cert = Net::SSLeay::get_peer_certificate($ssl);
-return "Could not fetch peer certificate" if (!$cert);
-my @hosts;
-my $subject = Net::SSLeay::X509_get_subject_name($cert);
-if ($subject) {
-	my $cn = Net::SSLeay::X509_NAME_get_text_by_NID($subject, 13);
-	push(@hosts, $cn) if (defined($cn) && $cn ne "" && $cn ne "-1");
-	}
-my @alts = Net::SSLeay::X509_get_subjectAltNames($cert);
-while(my ($type, $val) = splice(@alts, 0, 2)) {
-	push(@hosts, $val) if ($type == 2 || $type == 7);
-	}
-Net::SSLeay::X509_free($cert);
-if (&check_ipaddress($host) || &check_ip6address($host)) {
-	return undef if (grep { lc($_) eq lc($host) } @hosts);
-	return @hosts ? "Certificate is for ".join(", ", @hosts).", not $host"
-		      : "No certificate names found";
-	}
-return undef if (@hosts && &ssl_hostname_match($host, \@hosts));
-return @hosts ? "Certificate is for ".join(", ", @hosts).", not $host"
-	      : "No certificate names found";
-}
diff --git a/t/README.md b/t/README.md
index 461f5ca56..eb2a52949 100644
--- a/t/README.md
+++ b/t/README.md
@@ -33,37 +33,19 @@ You need Devel::Cover installed.
 | File | What it checks |
 | --- | --- |
 | `compile.t` | Every `.pl`, `.cgi`, and shebang-perl script in `bin/` parses cleanly (`perl -c`). Catches breakage from bulk refactors without browsing every page. ~12s for the full tree. |
-| `miniserv.t` | Contract test for `miniserv.pl` functions — status codes, headers, body rendering, log behaviour. Demonstrates the require-and-stub pattern below. |
+| `miniserv.t` | Contract test for `miniserv-lib.pl` helpers used by `miniserv.pl` — status codes, headers, body rendering, log behaviour. |
 
-## The require-and-stub pattern
+## Testing helpers from executable code
 
-Many Webmin scripts mix sub definitions with a main body that opens sockets,
-reads `/etc/webmin/*`, or spawns CGIs. To test individual subs in isolation
-we need to `require` the script as a library without running the main body.
+Many Webmin scripts mix helper definitions with a main body that opens sockets,
+reads `/etc/webmin/*`, or spawns CGIs. Prefer moving testable helpers into a
+small `*-lib.pl` file, keeping the executable script focused on startup and
+request handling, and requiring the library from tests. `miniserv.pl` follows
+that pattern: daemon startup remains in `miniserv.pl`, while helper coverage
+loads `miniserv-lib.pl` directly.
 
-Two complementary idioms can be used. Both work; they look different because
-the underlying script does.
-
-### Block wrap (main body precedes sub definitions)
-
-Used by `miniserv.pl`. The executable preamble runs at file scope (so any 
-`my` vars stay file-scoped for the subs below); the main body wraps in
-`unless (caller)`:
-
-```perl
-#!/usr/bin/perl
-use Foo;            # use lines and pragmas stay outside the guard
-
-unless (caller) {
-
-# main body: arg parsing, setup, the actual work
-...
-
-} # end of unless (caller)
-
-sub helper { ... }
-sub other_helper { ... }
-```
+A second useful idiom still applies to simple CLI tools whose sub definitions
+precede the main call.
 
 ### One-liner (sub definitions precede the main call)
 
@@ -90,7 +72,7 @@ under `require`.
 
 `miniserv.t` is the canonical example. The pattern:
 
-1. `require` the script. The guard skips its main body.
+1. `require` the helper library.
 2. Replace side-effecting subs (socket I/O, logging, disk reads) with
    capture-buffer overrides under `no warnings 'redefine'`.
 3. Populate package globals (`%miniserv::config`, `@miniserv::roots`, etc.)
diff --git a/t/compile.t b/t/compile.t
index 214055037..4df252ad9 100644
--- a/t/compile.t
+++ b/t/compile.t
@@ -24,7 +24,7 @@ use Test::More;
 use File::Find;
 use File::Basename qw(dirname);
 use File::Spec;
-use Cwd qw(abs_path);
+use Cwd qw(abs_path getcwd);
 
 my $root = abs_path(File::Spec->catdir(dirname(__FILE__), '..'));
 chdir($root) or die "chdir($root): $!";
@@ -68,6 +68,22 @@ if ($filter) {
 	@files or do { diag("filter '$filter' matched zero files"); plan skip_all => "no files match filter"; };
 	}
 
+if (grep { $_ eq q{./miniserv.pl} } @files) {
+	my $cwd = getcwd();
+	my $tmpdir = File::Spec->tmpdir();
+	my $miniserv = File::Spec->catfile($root, q{miniserv.pl});
+	chdir($tmpdir) or BAIL_OUT("chdir($tmpdir): $!");
+	my $out = qx{perl -c -- "$miniserv" 2>&1};
+	chdir($cwd) or BAIL_OUT("chdir($cwd): $!");
+	if ($out =~ /\bsyntax OK\b/) {
+		pass(q{miniserv.pl compiles outside the source tree});
+		}
+	else {
+		fail(q{miniserv.pl compiles outside the source tree});
+		diag($out);
+		}
+	}
+
 diag("compile-checking " . scalar(@files) . " files");
 
 for my $f (@files) {
diff --git a/t/miniserv.t b/t/miniserv.t
index 59a690352..12ccd2760 100644
--- a/t/miniserv.t
+++ b/t/miniserv.t
@@ -1,11 +1,10 @@
 #!/usr/bin/perl
-# Unit tests for miniserv.pl helper subs.
+# Unit tests for miniserv helper subs.
 #
-# miniserv.pl is loaded as a module; its top-level script body is skipped
-# by the `unless (caller) { ... }` guard, so we only get the sub
-# definitions plus a handful of pure-constant globals (@itoa64, @weekday,
-# @month, @miniserv_argv). Everything else (%config, @roots, $datestr,
-# etc.) we populate ourselves.
+# miniserv-lib.pl contains the helper functions and pure-constant globals
+# used by miniserv.pl. The daemon startup path stays in miniserv.pl, while
+# tests load this library directly and populate mutable runtime globals
+# (%config, @roots, $datestr, etc.) themselves.
 #
 # Each helper has its own `subtest`. Assertions target the contract
 # (status code present, headers present, redaction happened, round-trip
@@ -18,9 +17,9 @@ use Test::More;
 use File::Basename qw(dirname);
 use File::Spec;
 
-my $script = File::Spec->rel2abs(
-	File::Spec->catfile(dirname(__FILE__), '..', 'miniserv.pl'));
-require $script;
+my $lib = File::Spec->rel2abs(
+	File::Spec->catfile(dirname(__FILE__), '..', 'miniserv-lib.pl'));
+require $lib;
 
 # Capture buffers populated by overridden I/O subs.
 our @written;
@@ -652,10 +651,9 @@ subtest 'ssl_hostname_match' => sub {
 	   ':port suffix is stripped before matching');
 };
 
-# Capability probes used by the crypto subtests below. miniserv.pl's
-# detection logic runs inside its `unless(caller)` block, so when we load
-# it as a module the $use_md5 / $use_sha512 / $use_hmac_sha256 globals are
-# undef. Recreate them here from the same probes miniserv.pl uses itself.
+# Capability probes used by the crypto subtests below. miniserv.pl sets
+# these globals during daemon startup, while the tests load only the helper
+# library. Recreate them here from the same probes miniserv.pl uses itself.
 my $have_md5 = eval {
 	require Digest::MD5;
 	Digest::MD5->new->add('x');