#!/usr/bin/perl
# A very simple perl web server used by Webmin

# Require basic libraries
package miniserv;
use Socket;
use POSIX;
use Sys::Hostname;

# Find and read config file
if (@ARGV != 1) {
	die "Usage: miniserv.pl <config file>";
	}
if ($ARGV[0] =~ /^\//) {
	$conf = $ARGV[0];
	}
else {
	chop($pwd = `pwd`);
	$conf = "$pwd/$ARGV[0]";
	}
open(CONF, $conf) || die "Failed to open config file $conf : $!";
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;
	$config{$name} = $val;
	}
close(CONF);

# Check is SSL is enabled and available
if ($config{'ssl'}) {
	eval "use Net::SSLeay";
	if (!$@) {
		$use_ssl = 1;
		# These functions only exist for SSLeay 1.0
		eval "Net::SSLeay::SSLeay_add_ssl_algorithms()";
		eval "Net::SSLeay::load_error_strings()";
		if (defined(&Net::SSLeay::X509_STORE_CTX_get_current_cert) &&
		    defined(&Net::SSLeay::CTX_load_verify_locations) &&
		    defined(&Net::SSLeay::CTX_set_verify)) {
			$client_certs = 1;
			}
		}
	}

# Check if the syslog module is available to log hacking attempts
if ($config{'syslog'}) {
	eval "use Sys::Syslog qw(:DEFAULT setlogsock)";
	if (!$@) {
		$use_syslog = 1;
		}
	}

# check if the PAM module is available to authenticate
eval "use Authen::PAM";
if (!$@) {
	# check if the PAM authentication can be used by opening a handle
	if (! ref($pamh = new Authen::PAM("miniserv", "root", \&pam_conv_func))) {
		print STDERR "PAM module available, but error during init !\n";
		print STDERR "Disabling PAM functions.\n";
		}
	else {
		$use_pam = 1;
		}
	}

# check if the TCP-wrappers module is available
if ($config{'libwrap'}) {
	eval "use Authen::Libwrap qw(hosts_ctl STRING_UNKNOWN)";
	if (!$@) {
		$use_libwrap = 1;
		}
	}

# Get miniserv's perl path and location
$miniserv_path = $0;
open(SOURCE, $miniserv_path);
<SOURCE> =~ /^#!(\S+)/; $perl_path = $1;
close(SOURCE);
@miniserv_argv = @ARGV;

# Check vital config options
%vital = ("port", 80,
	  "root", "./",
	  "server", "MiniServ/0.01",
	  "index_docs", "index.html index.htm index.cgi",
	  "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"
	 );
foreach $v (keys %vital) {
	if (!$config{$v}) {
		if ($vital{$v} eq "") {
			die "Missing config option $v";
			}
		$config{$v} = $vital{$v};
		}
	}
if (!$config{'sessiondb'}) {
	$config{'pidfile'} =~ /^(.*)\/[^\/]+$/;
	$config{'sessiondb'} = "$1/sessiondb";
	}
die "Session authentication cannot be used in inetd mode"
	if ($config{'inetd'} && $config{'session'});

# 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" );

# Change dir to the server root
chdir($config{'root'});
$user_homedir = (getpwuid($<))[7];

# Read users file
if ($config{'userfile'}) {
	open(USERS, $config{'userfile'});
	while(<USERS>) {
		s/\r|\n//g;
		local @user = split(/:/, $_);
		$users{$user[0]} = $user[1];
		$certs{$user[0]} = $user[3] if ($user[3]);
		if ($user[4] =~ /^allow\s+(.*)/) {
			$allow{$user[0]} = [ &to_ipaddress(split(/\s+/, $1)) ];
			}
		elsif ($user[4] =~ /^deny\s+(.*)/) {
			$deny{$user[0]} = [ &to_ipaddress(split(/\s+/, $1)) ];
			}
		}
	close(USERS);
	}

# Setup SSL if possible and if requested
if ($use_ssl) {
	$ssl_ctx = Net::SSLeay::CTX_new() ||
		die "Failed to create SSL context : $!";
	$client_certs = 0 if (!$config{'ca'} || !%certs);
	if ($client_certs) {
		Net::SSLeay::CTX_load_verify_locations(
			$ssl_ctx, $config{'ca'}, "");
		Net::SSLeay::CTX_set_verify(
			$ssl_ctx, &Net::SSLeay::VERIFY_PEER, \&verify_client);
		}

	Net::SSLeay::CTX_use_RSAPrivateKey_file(
		$ssl_ctx, $config{'keyfile'},
		&Net::SSLeay::FILETYPE_PEM) || die "Failed to open SSL key";
	Net::SSLeay::CTX_use_certificate_file(
		$ssl_ctx, $config{'keyfile'},
		&Net::SSLeay::FILETYPE_PEM);
	}

# Setup syslog support if possible and if requested
if ($use_syslog) {
	eval { openlog("miniserv", "cons,pid,ndelay", "daemon") };
	$use_syslog = 0 if ($@);
	}

# Read MIME types file and add extra types
if ($config{"mimetypes"} ne "") {
	open(MIME, $config{"mimetypes"});
	while(<MIME>) {
		chop; s/#.*$//;
		if (/^(\S+)\s+(.*)$/) {
			$type = $1; @exts = split(/\s+/, $2);
			foreach $ext (@exts) {
				$mime{$ext} = $type;
				}
			}
		}
	close(MIME);
	}
foreach $k (keys %config) {
	if ($k !~ /^addtype_(.*)$/) { next; }
	$mime{$1} = $config{$k};
	}
	
# get the time zone
if ($config{'log'}) {
	local(@gmt, @lct, $days, $hours, $mins);
	@make_date_marr = ("Jan", "Feb", "Mar", "Apr", "May", "Jun",
		 	   "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
	@gmt = gmtime(time());
	@lct = localtime(time());
	$days = $lct[3] - $gmt[3];
	$hours = ($days < -1 ? 24 : 1 < $days ? -24 : $days * 24) +
		 $lct[2] - $gmt[2];
	$mins = $hours * 60 + $lct[1] - $gmt[1];
	$timezone = ($mins < 0 ? "-" : "+"); $mins = abs($mins);
	$timezone .= sprintf "%2.2d%2.2d", $mins/60, $mins%60;
	}

if ($config{'inetd'}) {
	# We are being run from inetd - go direct to handling the request
	$SIG{'HUP'} = 'IGNORE';
	$SIG{'TERM'} = 'DEFAULT';
	$SIG{'PIPE'} = 'DEFAULT';
	open(SOCK, "+>&STDIN");

	# Check if it is time for the logfile to be cleared
	if ($config{'logclear'}) {
		local $write_logtime = 0;
		local @st = stat("$config{'logfile'}.time");
		if (@st) {
			if ($st[9]+$config{'logtime'}*60*60 < time()){
				# need to clear log
				$write_logtime = 1;
				unlink($config{'logfile'});
				}
			}
		else { $write_logtime = 1; }
		if ($write_logtime) {
			open(LOGTIME, ">$config{'logfile'}.time");
			print LOGTIME time(),"\n";
			close(LOGTIME);
			}
		}

	# Initialize SSL for this connection
	if ($use_ssl) {
		$ssl_con = Net::SSLeay::new($ssl_ctx);
		Net::SSLeay::set_fd($ssl_con, fileno(SOCK));
		#Net::SSLeay::use_RSAPrivateKey_file(
		#	$ssl_con, $config{'keyfile'},
		#	&Net::SSLeay::FILETYPE_PEM);
		#Net::SSLeay::use_certificate_file(
		#	$ssl_con, $config{'keyfile'},
		#	&Net::SSLeay::FILETYPE_PEM);
		Net::SSLeay::accept($ssl_con) || exit;
		}

	# Work out the hostname for this web server
	if (!$config{'host'}) {
		($myport, $myaddr) =
			unpack_sockaddr_in(getsockname(SOCK));
		$myname = gethostbyaddr($myaddr, AF_INET);
		if ($myname eq "") {
			$myname = inet_ntoa($myaddr);
			}
		$host = $myname;
		}
	else { $host = $config{'host'}; }
	$port = $config{'port'};

	while(&handle_request(getpeername(SOCK), getsockname(SOCK))) { }
	close(SOCK);
	exit;
	}

# Open main socket
$proto = getprotobyname('tcp');
socket(MAIN, PF_INET, SOCK_STREAM, $proto) ||
	die "Failed to open main socket : $!";
setsockopt(MAIN, SOL_SOCKET, SO_REUSEADDR, pack("l", 1));
$baddr = $config{"bind"} ? inet_aton($config{"bind"}) : INADDR_ANY;
for($i=0; $i<5; $i++) {
	last if (bind(MAIN, sockaddr_in($config{port}, $baddr)));
	sleep(1);
	}
die "Failed to bind port $config{port} : $!" if ($i == 5);
listen(MAIN, SOMAXCONN);

if ($config{'listen'}) {
	# Open the socket that allows other miniserv servers to find this one
	$proto = getprotobyname('udp');
	if (socket(LISTEN, PF_INET, SOCK_DGRAM, $proto)) {
		setsockopt(LISTEN, SOL_SOCKET, SO_REUSEADDR, pack("l", 1));
		bind(LISTEN, sockaddr_in($config{'listen'}, INADDR_ANY));
		listen(LISTEN, SOMAXCONN);
		}
	else {
		print STDERR "Failed to open listening socket : $!\n";
		$config{'listen'} = 0;
		}
	}


# Split from the controlling terminal
if (fork()) { exit; }
setsid();

# write out the PID file
open(PIDFILE, "> $config{'pidfile'}");
printf PIDFILE "%d\n", getpid();
close(PIDFILE);

# Start the log-clearing process, if needed. This checks every minute
# to see if the log has passed its reset time, and if so clears it
if ($config{'logclear'}) {
	if (!($logclearer = fork())) {
		while(1) {
			local $write_logtime = 0;
			local @st = stat("$config{'logfile'}.time");
			if (@st) {
				if ($st[9]+$config{'logtime'}*60*60 < time()){
					# need to clear log
					$write_logtime = 1;
					unlink($config{'logfile'});
					}
				}
			else { $write_logtime = 1; }
			if ($write_logtime) {
				open(LOGTIME, ">$config{'logfile'}.time");
				print LOGTIME time(),"\n";
				close(LOGTIME);
				}
			sleep(5*60);
			}
		exit;
		}
	push(@childpids, $logclearer);
	}

# Setup the logout time dbm if needed
if ($config{'session'}) {
	eval "use SDBM_File";
	dbmopen(%sessiondb, $config{'sessiondb'}, 0700);
	eval { $sessiondb{'1111111111'} = 'foo bar' };
	if ($@) {
		dbmclose(%sessiondb);
		eval "use NDBM_File";
		dbmopen(%sessiondb, $config{'sessiondb'}, 0700);
		}
	}

# Run the main loop
$SIG{'HUP'} = 'miniserv::trigger_restart';
$SIG{'TERM'} = 'miniserv::term_handler';
$SIG{'PIPE'} = 'IGNORE';
@deny = &to_ipaddress(split(/\s+/, $config{"deny"}));
@allow = &to_ipaddress(split(/\s+/, $config{"allow"}));
$p = 0;
while(1) {
	# wait for a new connection, or a message from a child process
	undef($rmask);
	vec($rmask, fileno(MAIN), 1) = 1;
	if ($config{'passdelay'} || $config{'session'}) {
		for($i=0; $i<@passin; $i++) {
			vec($rmask, fileno($passin[$i]), 1) = 1;
			}
		}
	vec($rmask, fileno(LISTEN), 1) = 1 if ($config{'listen'});

	local $sel = select($rmask, undef, undef, 10);
	if ($need_restart) { &restart_miniserv(); }
	local $time_now = time();

	# Clean up finished processes
	local($pid);
	do {	$pid = waitpid(-1, WNOHANG);
		@childpids = grep { $_ != $pid } @childpids;
		} while($pid > 0);

	# run the unblocking procedure to check if enough time has passed to
	# unblock hosts that heve been blocked because of password failures
	if ($config{'blockhost_failures'}) {
		$i = 0;
		while ($i <= $#deny) {
			if ($blockhosttime{$deny[$i]} && $config{'blockhost_time'} != 0 &&
			    ($time_now - $blockhosttime{$deny[$i]}) >= $config{'blockhost_time'}) {
				# the host can be unblocked now
				$hostfail{$deny[$i]} = 0;
				splice(@deny, $i, 1);
				}
			$i++;
			}
		}

	if ($config{'session'}) {
		# Remove sessions with more than 7 days of inactivity
		foreach $s (keys %sessiondb) {
			local ($user, $ltime) = split(/\s+/, $sessiondb{$s});
			if ($time_now - $ltime > 7*24*60*60) {
				delete($sessiondb{$s});
				}
			}
		}
	next if ($sel <= 0);
	if (vec($rmask, fileno(MAIN), 1)) {
		# got new connection
		$acptaddr = accept(SOCK, MAIN);
		if (!$acptaddr) { next; }

		# create pipes
		if ($config{'passdelay'} || $config{'session'}) {
			$PASSINr = "PASSINr$p"; $PASSINw = "PASSINw$p";
			$PASSOUTr = "PASSOUTr$p"; $PASSOUTw = "PASSOUTw$p";
			$p++;
			pipe($PASSINr, $PASSINw);
			pipe($PASSOUTr, $PASSOUTw);
			select($PASSINw); $| = 1; select($PASSINr); $| = 1;
			select($PASSOUTw); $| = 1; select($PASSOUTw); $| = 1;
			}
		select(STDOUT);

		# Check username of connecting user
		local ($peerp, $peera) = unpack_sockaddr_in($acptaddr);
		$localauth_user = undef;
		if ($config{'localauth'} && inet_ntoa($peera) eq "127.0.0.1") {
			if (open(TCP, "/proc/net/tcp")) {
				# Get the info direct from the kernel
				while(<TCP>) {
					s/^\s+//;
					local @t = split(/[\s:]+/, $_);
					if ($t[1] eq '0100007F' &&
					    $t[2] eq sprintf("%4.4X", $peerp)) {
						$localauth_user = getpwuid($t[11]);
						last;
						}
					}
				close(TCP);
				}
			else {
				# Call lsof for the info
				local $lsofpid = open(LSOF,
					"$config{'localauth'} -i TCP\@127.0.0.1:$peerp |");
				while(<LSOF>) {
					if (/^(\S+)\s+(\d+)\s+(\S+)/ &&
					    $2 != $$ && $2 != $lsofpid) {
						$localauth_user = $3;
						}
					}
				close(LSOF);
				}
			}

		# fork the subprocess
		if (!($handpid = fork())) {
			# setup signal handlers
			$SIG{'TERM'} = 'DEFAULT';
			$SIG{'PIPE'} = 'DEFAULT';
			#$SIG{'CHLD'} = 'IGNORE';
			$SIG{'HUP'} = 'IGNORE';

			# Initialize SSL for this connection
			if ($use_ssl) {
				$ssl_con = Net::SSLeay::new($ssl_ctx);
				Net::SSLeay::set_fd($ssl_con, fileno(SOCK));
				#Net::SSLeay::use_RSAPrivateKey_file(
				#	$ssl_con, $config{'keyfile'},
				#	&Net::SSLeay::FILETYPE_PEM);
				#Net::SSLeay::use_certificate_file(
				#	$ssl_con, $config{'keyfile'},
				#	&Net::SSLeay::FILETYPE_PEM);
				Net::SSLeay::accept($ssl_con) || exit;
				}

			# close useless pipes
			if ($config{'passdelay'} || $config{'session'}) {
				foreach $p (@passin) { close($p); }
				foreach $p (@passout) { close($p); }
				close($PASSINr); close($PASSOUTw);
				}
			close(MAIN);

			# Work out the hostname for this web server
			if (!$config{'host'}) {
				($myport, $myaddr) =
					unpack_sockaddr_in(getsockname(SOCK));
				$myname = gethostbyaddr($myaddr, AF_INET);
				if ($myname eq "") {
					$myname = inet_ntoa($myaddr);
					}
				$host = $myname;
				}
			else { $host = $config{'host'}; }
			$port = $config{'port'};

			local $switched = 0;
			if ($config{'remoteuser'} && $localauth_user && !$<) {
				# Switch to the UID of the remote user
				local @u = getpwnam($localauth_user);
				if (@u) {
					$( = $u[3]; $) = "$u[3] $u[3]";
					$< = $> = $u[2];
					$switched = 1;
					}
				}
			if ($config{'switchuser'} && !$< && !$switched) {
				# Switch to the UID of server user
				local @u = getpwnam($config{'switchuser'});
				if (@u) {
					$( = $u[3]; $) = "$u[3] $u[3]";
					$< = $> = $u[2];
					}
				}

			while(&handle_request($acptaddr, getsockname(SOCK))) { }
			shutdown(SOCK, 1);
			close(SOCK);
			close($PASSINw); close($PASSOUTw);
			exit;
			}
		push(@childpids, $handpid);
		if ($config{'passdelay'} || $config{'session'}) {
			close($PASSINw); close($PASSOUTr);
			push(@passin, $PASSINr); push(@passout, $PASSOUTw);
			}
		close(SOCK);
		}

	if ($config{'listen'} && vec($rmask, fileno(LISTEN), 1)) {
		# Got UDP packet from another miniserv server
		local $rcvbuf;
		local $from = recv(LISTEN, $rcvbuf, 1024, 0);
		next if (!$from);
		local $fromip = inet_ntoa((unpack_sockaddr_in($from))[1]);
		local $toip = inet_ntoa((unpack_sockaddr_in(
					 getsockname(LISTEN)))[1]);
		if ((!@deny || !&ip_match($fromip, $toip, @deny)) &&
		    (!@allow || &ip_match($fromip, $toip, @allow))) {
			send(LISTEN, "$config{'host'}:$config{'port'}:".
				     "$use_ssl", 0, $from);
			}
		}

	# check for password-timeout messages from subprocesses
	for($i=0; $i<@passin; $i++) {
		if (vec($rmask, fileno($passin[$i]), 1)) {
			# this sub-process is asking about a password
			$infd = $passin[$i]; $outfd = $passout[$i];
			$inline = <$infd>;
			if ($inline =~ /^delay\s+(\S+)\s+(\S+)\s+(\d+)/) {
				# Got a delay request from a subprocess.. for
				# valid logins, there is no delay (to prevent
				# denial of service attacks), but for invalid
				# logins the delay increases with each failed
				# attempt.
				if ($3) {
					# login OK.. no delay
					print $outfd "0 0\n";
					$hostfail{$2} = 0;
					}
				else {
					# login failed..
					$hostfail{$2}++;
					# add the host to the block list if necessary
 					if ($config{'blockhost_failures'} &&
					    $hostfail{$2} >= $config{'blockhost_failures'}) {
						push(@deny, $2);					
						$blockhosttime{$2} = $time_now;
						$blocked = 1;
						if ($use_syslog) {
							local $logtext = "Security alert: Host $2 ".
							  "blocked after $config{'blockhost_failures'} ".
							  "failed logins for user $1";
							syslog("crit", $logtext);
							}
						}