use Socket;
use POSIX;
use Time::Local;
+eval "use Time::HiRes;";
@itoa64 = split(//, "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz");
push(@INC, split(/:/, $config{'perllib'}));
$ENV{'PERLLIB'} .= ':'.$config{'perllib'};
}
+@startup_msg = ( );
-# Check is SSL is enabled and available
+# Check if SSL is enabled and available
if ($config{'ssl'}) {
eval "use Net::SSLeay";
if (!$@) {
}
}
+# Check if IPv6 is enabled and available
+if ($config{'ipv6'}) {
+ eval "use Socket6";
+ if (!$@) {
+ push(@startup_msg, "IPv6 support enabled");
+ $use_ipv6 = 1;
+ }
+ else {
+ push(@startup_msg, "IPv6 support cannot be enabled without ".
+ "the Socket6 perl module");
+ }
+ }
+
# Check if the syslog module is available to log hacking attempts
if ($config{'syslog'} && !$config{'inetd'}) {
eval "use Sys::Syslog qw(:DEFAULT setlogsock)";
if ($config{'inetd'} && $config{'session'});
# check if the PAM module is available to authenticate
-if (!$config{'no_pam'}) {
+if ($config{'assume_pam'}) {
+ # Just assume that it will work. This can also be used to work around
+ # a Solaris bug in which using PAM before forking caused it to fail
+ # later!
+ $use_pam = 1;
+ }
+elsif (!$config{'no_pam'}) {
eval "use Authen::PAM;";
if (!$@) {
# check if the PAM authentication can be used by opening a
if (ref($pamh = new Authen::PAM($config{'pam'},
$config{'pam_test_user'},
\&pam_conv_func))) {
- # Now test a login to see if /etc/pam.d/XXX is set
+ # Now test a login to see if /etc/pam.d/webmin is set
# up properly.
$pam_conv_func_called = 0;
$pam_username = "test";
$pam_password = "test";
$pamh->pam_authenticate();
if ($pam_conv_func_called) {
- $pam_msg = "PAM authentication enabled";
+ push(@startup_msg,
+ "PAM authentication enabled");
$use_pam = 1;
}
else {
- $pam_msg = "PAM test failed - maybe /etc/pam.d/$config{'pam'} does not exist";
+ push(@startup_msg,
+ "PAM test failed - maybe ".
+ "/etc/pam.d/$config{'pam'} does not exist");
}
}
else {
- $pam_msg = "PAM initialization of Authen::PAM failed";
+ push(@startup_msg,
+ "PAM initialization of Authen::PAM failed");
}
}
else {
- $pam_msg = "Perl module Authen::PAM needed for PAM is not installed : $@";
+ push(@startup_msg,
+ "Perl module Authen::PAM needed for PAM is ".
+ "not installed : $@");
}
}
if ($config{'pam_only'} && !$use_pam) {
- print STDERR $pam_msg;
+ print STDERR $startup_msg[0],"\n";
print STDERR "PAM use is mandatory, but could not be enabled!\n";
exit(1);
}
elsif ($pam_msg && !$use_pam) {
- $pam_msg2 = "Continuing without the Authen::PAM perl module";
+ push(@startup_msg,
+ "Continuing without the Authen::PAM perl module");
}
# Check if the User::Utmp perl module is installed
eval "use User::Utmp;";
if (!$@) {
$write_utmp = 1;
- $utmp_msg = "UTMP logging enabled";
+ push(@startup_msg, "UTMP logging enabled");
}
else {
- $utmp_msg = "Perl module User::Utmp needed for Utmp logging is not installed : $@";
+ push(@startup_msg,
+ "Perl module User::Utmp needed for Utmp logging is ".
+ "not installed : $@");
}
}
eval "use Crypt::UnixCrypt";
if (!$@) {
$use_perl_crypt = 1;
- $crypt_msg = "Using Crypt::UnixCrypt for password encryption\n";
+ push(@startup_msg,
+ "Using Crypt::UnixCrypt for password encryption");
}
else {
- $crypt_msg = "crypt() function un-implemented, and Crypt::UnixCrypt not installed - password authentication will probably fail\n";
+ push(@startup_msg,
+ "crypt() function un-implemented, and Crypt::UnixCrypt ".
+ "not installed - password authentication will fail");
}
}
# Check if /dev/urandom really generates random IDs, by calling it twice
local $rand1 = &generate_random_id("foo", 1);
local $rand2 = &generate_random_id("foo", 2);
-local $rand_msg;
if ($rand1 eq $rand2) {
$bad_urandom = 1;
- $rand_msg = "Random number generator file /dev/urandom is not reliable";
+ push(@startup_msg,
+ "Random number generator file /dev/urandom is not reliable");
}
# Check if we can call sudo
$use_sudo = 1;
}
else {
- $sudo_msg = "Perl module IO::Pty needed for calling sudo is not installed : $@";
+ push(@startup_msg,
+ "Perl module IO::Pty needed for calling sudo is not ".
+ "installed : $@");
}
}
&read_users_file();
# Setup SSL if possible and if requested
-if (!-r $config{'keyfile'} ||
- $config{'certfile'} && !-r $config{'certfile'}) {
+if (!-r $config{'keyfile'}) {
# Key file doesn't exist!
+ if ($config{'keyfile'}) {
+ print STDERR "SSL key file $config{'keyfile'} does not exist\n";
+ }
+ $use_ssl = 0;
+ }
+elsif ($config{'certfile'} && !-r $config{'certfile'}) {
+ # Cert file doesn't exist!
+ print STDERR "SSL cert file $config{'certfile'} does not exist\n";
$use_ssl = 0;
}
@ipkeys = &get_ipkeys(\%config);
}
$client_certs = 0 if (!-r $config{'ca'} || !%certs);
$ssl_contexts{"*"} = &create_ssl_context($config{'keyfile'},
- $config{'certfile'});
+ $config{'certfile'},
+ $config{'extracas'});
foreach $ipkey (@ipkeys) {
- $ctx = &create_ssl_context($ipkey->{'key'}, $ipkey->{'cert'});
+ $ctx = &create_ssl_context($ipkey->{'key'}, $ipkey->{'cert'},
+ $ipkey->{'extracas'} || $config{'extracas'});
foreach $ip (@{$ipkey->{'ips'}}) {
$ssl_contexts{$ip} = $ctx;
}
}
}
+# Load gzip library if enabled
+if ($config{'gzip'} eq '1') {
+ eval "use Compress::Zlib";
+ if (!$@) {
+ $use_gzip = 1;
+ }
+ }
+
# Setup syslog support if possible and if requested
if ($use_syslog) {
open(ERRDUP, ">&STDERR");
# Write out (empty) blocked hosts file
&write_blocked_file();
-# Re-direct STDERR to a log file
-if ($config{'errorlog'} ne '-') {
- open(STDERR, ">>$config{'errorlog'}") || die "failed to open $config{'errorlog'} : $!";
- if ($config{'logperms'}) {
- chmod(oct($config{'logperms'}), $config{'errorlog'});
- }
- }
-select(STDERR); $| = 1; select(STDOUT);
+# Initially read webmin cron functions and last execution times
+&read_webmin_crons();
+%webmincron_last = ( );
+&read_file($config{'webmincron_last'}, \%webmincron_last);
+
+# Pre-cache lang files
+&precache_files();
if ($config{'inetd'}) {
# We are being run from inetd - go direct to handling the request
+ &redirect_stderr_to_log();
$SIG{'HUP'} = 'IGNORE';
$SIG{'TERM'} = 'DEFAULT';
$SIG{'PIPE'} = 'DEFAULT';
}
}
+ # Work out if IPv6 is being used locally
+ local $sn = getsockname(SOCK);
+ print DEBUG "sn=$sn\n";
+ print DEBUG "length=",length($sn),"\n";
+ $localipv6 = length($sn) > 16;
+ print DEBUG "localipv6=$localipv6\n";
+
# Initialize SSL for this connection
if ($use_ssl) {
- $ssl_con = &ssl_connection_for_ip(SOCK);
+ $ssl_con = &ssl_connection_for_ip(SOCK, $localipv6);
$ssl_con || exit;
}
# Work out the hostname for this web server
- $host = &get_socket_name(SOCK);
+ $host = &get_socket_name(SOCK, $localipv6);
+ print DEBUG "host=$host\n";
$host || exit;
$port = $config{'port'};
$acptaddr = getpeername(SOCK);
+ print DEBUG "acptaddr=$acptaddr\n";
+ print DEBUG "length=",length($acptaddr),"\n";
$acptaddr || exit;
+ # Work out remote and local IPs
+ $ipv6 = length($acptaddr) > 16;
+ print DEBUG "ipv6=$ipv6\n";
+ (undef, $locala) = &get_socket_ip(SOCK, $localipv6);
+ print DEBUG "locala=$locala\n";
+ (undef, $peera, undef) = &get_address_ip($acptaddr, $ipv6);
+ print DEBUG "peera=$peera\n";
+
print DEBUG "main: Starting handle_request loop pid=$$\n";
- while(&handle_request($acptaddr, getsockname(SOCK))) { }
+ while(&handle_request($peera, $locala, $ipv6)) { }
print DEBUG "main: Done handle_request loop pid=$$\n";
close(SOCK);
exit;
}
# Build list of sockets to listen on
-if ($config{"bind"} && $config{"bind"} ne "*") {
- push(@sockets, [ inet_aton($config{'bind'}), $config{'port'} ]);
+$config{'bind'} = '' if ($config{'bind'} eq '*');
+if ($config{'bind'}) {
+ # Listening on a specific IP
+ if (&check_ip6address($config{'bind'})) {
+ # IP is v6
+ $use_ipv6 || die "Cannot bind to $config{'bind'} without IPv6";
+ push(@sockets, [ inet_pton(Socket6::AF_INET6(),$config{'bind'}),
+ $config{'port'},
+ Socket6::PF_INET6() ]);
+ }
+ else {
+ # IP is v4
+ push(@sockets, [ inet_aton($config{'bind'}),
+ $config{'port'},
+ PF_INET() ]);
+ }
}
else {
- push(@sockets, [ INADDR_ANY, $config{'port'} ]);
+ # Listening on all IPs
+ push(@sockets, [ INADDR_ANY, $config{'port'}, PF_INET() ]);
+ if ($use_ipv6) {
+ # Also IPv6
+ push(@sockets, [ in6addr_any(), $config{'port'},
+ Socket6::PF_INET6() ]);
+ }
}
foreach $s (split(/\s+/, $config{'sockets'})) {
if ($s =~ /^(\d+)$/) {
# Just listen on another port on the main IP
- push(@sockets, [ $sockets[0]->[0], $s ]);
+ push(@sockets, [ $sockets[0]->[0], $s, $sockets[0]->[2] ]);
+ if ($use_ipv6 && !$config{'bind'}) {
+ # Also listen on that port on the main IPv6 address
+ push(@sockets, [ $sockets[1]->[0], $s,
+ $sockets[1]->[2] ]);
+ }
+ }
+ elsif ($s =~ /^\*:(\d+)$/) {
+ # Listening on all IPs on some port
+ push(@sockets, [ INADDR_ANY, $1,
+ PF_INET() ]);
+ if ($use_ipv6) {
+ push(@sockets, [ in6addr_any(), $1,
+ Socket6::PF_INET6() ]);
+ }
}
elsif ($s =~ /^(\S+):(\d+)$/) {
# Listen on a specific port and IP
- push(@sockets, [ $1 eq "*" ? INADDR_ANY : inet_aton($1), $2 ]);
+ my ($ip, $port) = ($1, $2);
+ if (&check_ip6address($ip)) {
+ $use_ipv6 || die "Cannot bind to $ip without IPv6";
+ push(@sockets, [ inet_pton(Socket6::AF_INET6(),
+ $ip),
+ $port, Socket6::PF_INET6() ]);
+ }
+ else {
+ push(@sockets, [ inet_aton($ip), $port,
+ PF_INET() ]);
+ }
}
elsif ($s =~ /^([0-9\.]+):\*$/ || $s =~ /^([0-9\.]+)$/) {
- # Listen on the main port on another IP
- push(@sockets, [ inet_aton($1), $sockets[0]->[1] ]);
+ # Listen on the main port on another IPv4 address
+ push(@sockets, [ inet_aton($1), $sockets[0]->[1],
+ PF_INET() ]);
+ }
+ elsif (($s =~ /^([0-9a-f\:]+):\*$/ || $s =~ /^([0-9a-f\:]+)$/) &&
+ $use_ipv6) {
+ # Listen on the main port on another IPv6 address
+ push(@sockets, [ inet_pton(Socket6::AF_INET6(), $1),
+ $sockets[0]->[1],
+ Socket6::PF_INET6() ]);
}
}
$tried_inaddr_any = 0;
for($i=0; $i<@sockets; $i++) {
$fh = "MAIN$i";
- socket($fh, PF_INET, SOCK_STREAM, $proto) ||
- die "Failed to open socket : $!";
+ socket($fh, $sockets[$i]->[2], SOCK_STREAM, $proto) ||
+ die "Failed to open socket family $sockets[$i]->[2] : $!";
setsockopt($fh, SOL_SOCKET, SO_REUSEADDR, pack("l", 1));
+ if ($sockets[$i]->[2] eq PF_INET()) {
+ $pack = pack_sockaddr_in($sockets[$i]->[1], $sockets[$i]->[0]);
+ }
+ else {
+ $pack = pack_sockaddr_in6($sockets[$i]->[1], $sockets[$i]->[0]);
+ setsockopt($fh, 41, 26, pack("l", 1)); # IPv6 only
+ }
for($j=0; $j<5; $j++) {
- last if (bind($fh, pack_sockaddr_in($sockets[$i]->[1],
- $sockets[$i]->[0])));
+ last if (bind($fh, $pack));
sleep(1);
}
if ($j == 5) {
# All attempts failed .. give up
- if ($sockets[$i]->[0] eq INADDR_ANY) {
- push(@sockerrs, "Failed to bind to port $sockets[$i]->[1] : $!");
+ if ($sockets[$i]->[0] eq INADDR_ANY ||
+ $use_ipv6 && $sockets[$i]->[0] eq in6addr_any()) {
+ push(@sockerrs,
+ "Failed to bind to port $sockets[$i]->[1] : $!");
$tried_inaddr_any = 1;
}
else {
- $ip = inet_ntoa($sockets[$i]->[0]);
- push(@sockerrs, "Failed to bind to IP $ip port $sockets[$i]->[1] : $!");
+ $ip = &network_to_address($sockets[$i]->[0]);
+ push(@sockerrs,
+ "Failed to bind to IP $ip port ".
+ "$sockets[$i]->[1] : $!");
}
}
else {
listen($fh, SOMAXCONN);
push(@socketfhs, $fh);
+ $ipv6fhs{$fh} = $sockets[$i]->[2] eq PF_INET() ? 0 : 1;
}
}
foreach $se (@sockerrs) {
if (!@socketfhs && !$tried_inaddr_any) {
print STDERR "Falling back to listening on any address\n";
$fh = "MAIN";
- socket($fh, PF_INET, SOCK_STREAM, $proto) ||
+ socket($fh, PF_INET(), SOCK_STREAM, $proto) ||
die "Failed to open socket : $!";
setsockopt($fh, SOL_SOCKET, SO_REUSEADDR, pack("l", 1));
- bind($fh, pack_sockaddr_in($sockets[0]->[1], INADDR_ANY)) ||
- die "Failed to bind to port $sockets[0]->[1] : $!";
+ if (!bind($fh, pack_sockaddr_in($sockets[0]->[1], INADDR_ANY))) {
+ print STDERR "Failed to bind to port $sockets[0]->[1] : $!\n";
+ exit(1);
+ }
listen($fh, SOMAXCONN);
push(@socketfhs, $fh);
}
elsif (!@socketfhs && $tried_inaddr_any) {
- die "Could not listen on any ports";
+ print STDERR "Could not listen on any ports";
+ exit(1);
}
if ($config{'listen'}) {
# Open the socket that allows other webmin servers to find this one
$proto = getprotobyname('udp');
- if (socket(LISTEN, PF_INET, SOCK_DGRAM, $proto)) {
+ if (socket(LISTEN, PF_INET(), SOCK_DGRAM, $proto)) {
setsockopt(LISTEN, SOL_SOCKET, SO_REUSEADDR, pack("l", 1));
bind(LISTEN, pack_sockaddr_in($config{'listen'}, INADDR_ANY));
listen(LISTEN, SOMAXCONN);
# Close standard file handles
open(STDIN, "</dev/null");
open(STDOUT, ">/dev/null");
+&redirect_stderr_to_log();
&log_error("miniserv.pl started");
-&log_error($pam_msg) if ($pam_msg);
-&log_error($pam_msg2) if ($pam_msg2);
-&log_error($utmp_msg) if ($utmp_msg);
-&log_error($crypt_msg) if ($crypt_msg);
-&log_error($sudo_msg) if ($sudo_msg);
-&log_error($rand_msg) if ($rand_msg);
+foreach $msg (@startup_msg) {
+ &log_error($msg);
+ }
# write out the PID file
&write_pid_file();
&write_blocked_file();
}
+ # Check if any webmin cron jobs are ready to run
+ &execute_ready_webmin_crons();
+
if ($config{'session'} && (++$remove_session_count%50) == 0) {
# Remove sessions with more than 7 days of inactivity,
local $s;
&allocate_pipes();
}
+ # Work out IP and port of client
+ local ($peerb, $peera, $peerp) =
+ &get_address_ip($acptaddr, $ipv6fhs{$s});
+
+ # Work out the local IP
+ (undef, $locala) = &get_socket_ip(SOCK, $ipv6fhs{$s});
+
# 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 ($config{'localauth'} && $peera eq "127.0.0.1") {
if (open(TCP, "/proc/net/tcp")) {
# Get the info direct from the kernel
+ $peerh = sprintf("%4.4X", $peerp);
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]);
+ $t[2] eq $peerh) {
+ $localauth_user =
+ getpwuid($t[11]);
last;
}
}
if (!$localauth_user) {
# Call lsof for the info
local $lsofpid = open(LSOF,
- "$config{'localauth'} -i TCP\@127.0.0.1:$peerp |");
+ "$config{'localauth'} -i ".
+ "TCP\@127.0.0.1:$peerp |");
while(<LSOF>) {
if (/^(\S+)\s+(\d+)\s+(\S+)/ &&
- $2 != $$ && $2 != $lsofpid) {
+ $2 != $$ && $2 != $lsofpid){
$localauth_user = $3;
}
}
}
# Work out the hostname for this web server
- $host = &get_socket_name(SOCK);
+ $host = &get_socket_name(SOCK, $ipv6fhs{$s});
if (!$host) {
- print STDERR "Failed to get local socket name : $!\n";
+ print STDERR
+ "Failed to get local socket name : $!\n";
close(SOCK);
next;
}
$SIG{'HUP'} = 'IGNORE';
$SIG{'USR1'} = 'IGNORE';
- # Initialize SSL for this connection
- if ($use_ssl) {
- $ssl_con = &ssl_connection_for_ip(SOCK);
- $ssl_con || exit;
- }
-
# Close the file handle for the session DBM
dbmclose(%sessiondb);
&close_all_sockets();
close(LISTEN);
+ # Initialize SSL for this connection
+ if ($use_ssl) {
+ $ssl_con = &ssl_connection_for_ip(
+ SOCK, $ipv6fhs{$s});
+ $ssl_con || exit;
+ }
+
print DEBUG
"main: Starting handle_request loop pid=$$\n";
- while(&handle_request($acptaddr,
- getsockname(SOCK))) { }
+ while(&handle_request($peera, $locala,
+ $ipv6fhs{$s})) {
+ # Loop until keepalive stops
+ }
print DEBUG
"main: Done handle_request loop pid=$$\n";
shutdown(SOCK, 1);
getsockname(LISTEN)))[1]);
if ((!@deny || !&ip_match($fromip, $toip, @deny)) &&
(!@allow || &ip_match($fromip, $toip, @allow))) {
- local $listenhost = &get_socket_name(LISTEN);
+ local $listenhost = &get_socket_name(LISTEN, 0);
send(LISTEN, "$listenhost:$config{'port'}:".
- ($use_ssl || $config{'inetd_ssl'} ? 1 : 0).":".
- ($config{'listenhost'} ?
+ ($use_ssl || $config{'inetd_ssl'} ? 1 : 0).":".
+ ($config{'listenhost'} ?
&get_system_hostname() : ""),
- 0, $from)
+ 0, $from)
if ($listenhost);
}
}
@passout = grep { defined($_) } @passout;
}
-# handle_request(remoteaddress, localaddress)
+# handle_request(remoteaddress, localaddress, ipv6-flag)
# Where the real work is done
sub handle_request
{
-$acptip = inet_ntoa((unpack_sockaddr_in($_[0]))[1]);
-$localip = $_[1] ? inet_ntoa((unpack_sockaddr_in($_[1]))[1]) : undef;
-print DEBUG "handle_request: from $acptip to $localip\n";
+local ($acptip, $localip, $ipv6) = @_;
+print DEBUG "handle_request: from $acptip to $localip ipv6=$ipv6\n";
if ($config{'loghost'}) {
- $acpthost = gethostbyaddr(inet_aton($acptip), AF_INET);
+ $acpthost = &to_hostname($acptip);
$acpthost = $acptip if (!$acpthost);
}
else {
print DEBUG "handle_request: posted_data=$posted_data\n";
}
+# Reject CONNECT request, which isn't supported
+if ($method eq "CONNECT") {
+ &http_error(405, "Method $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 for password if needed
-if (%users) {
+if ($config{'userfile'}) {
print DEBUG "handle_request: Need authentication\n";
$validated = 0;
$blocked = 0;
$config{'session'} = 0;
}
- # check for SSL authentication
+ # Check for SSL authentication
if ($use_ssl && $verified_client) {
$peername = Net::SSLeay::X509_NAME_oneline(
Net::SSLeay::X509_get_subject_name(
Net::SSLeay::get_peer_certificate(
$ssl_con)));
- local $peername2 = $peername;
- $peername2 =~ s/Email=/emailAddress=/ ||
- $peername2 =~ s/emailAddress=/Email=/;
- foreach $u (keys %certs) {
- if ($certs{$u} eq $peername ||
- $certs{$u} eq $peername2) {
- $authuser = $u;
- $validated = 2;
- #syslog("info", "%s", "SSL login as $authuser from $acpthost") if ($use_syslog);
- last;
- }
+ $u = &find_user_by_cert($peername);
+ if ($u) {
+ $authuser = $u;
+ $validated = 2;
}
if ($use_syslog && !$validated) {
syslog("crit", "%s",
($authuser, $authpass) = split(/:/, &b64decode($1), 2);
print DEBUG "handle_request: doing basic auth check authuser=$authuser authpass=$authpass\n";
local ($vu, $expired, $nonexist) =
- &validate_user($authuser, $authpass, $host);
+ &validate_user($authuser, $authpass, $host,
+ $acptip, $port);
print DEBUG "handle_request: vu=$vu expired=$expired nonexist=$nonexist\n";
if ($vu && (!$expired || $config{'passwd_mode'} == 1)) {
$authuser = $vu;
"Password contains invalid characters");
}
- if ($config{'passdelay'} && !$config{'inetd'}) {
+ if ($config{'passdelay'} && !$config{'inetd'} && $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";
}
local ($vu, $expired, $nonexist) =
- &validate_user($in{'user'}, $in{'pass'}, $host);
+ &validate_user($in{'user'}, $in{'pass'}, $host,
+ $acptip, $port);
local $hrv = &handle_login(
$vu || $in{'user'}, $vu ? 1 : 0,
$expired, $nonexist, $in{'pass'},
# Check for local authentication
if ($localauth_user && !$header{'x-forwarded-for'} && !$header{'via'}) {
- if (defined($users{$localauth_user})) {
+ my $luser = &get_user_details($localauth_user);
+ if ($luser) {
# Local user exists in webmin users file
$validated = 1;
$authuser = $localauth_user;
&write_data("WWW-authenticate: Basic ".
"realm=\"$config{'realm'}\"\r\n");
&write_keep_alive(0);
- &write_data("Content-type: text/html\r\n");
+ &write_data("Content-type: text/html; Charset=iso-8859-1\r\n");
&write_data("\r\n");
&reset_byte_count();
&write_data("<html>\n");
return 0;
}
}
+$uinfo = &get_user_details($baseauthuser);
# Validate the path, and convert to canonical form
rerun:
$config{'mobile_preroot'} :
$authuser && defined($config{'preroot_'.$authuser}) ?
$config{'preroot_'.$authuser} :
- $authuser && $baseauthuser &&
- defined($config{'preroot_'.$baseauthuser}) ?
- $config{'preroot_'.$baseauthuser} :
+ $uinfo && defined($uinfo->{'preroot'}) ?
+ $uinfo->{'preroot'} :
$config{'preroot'};
local @preroots = reverse(split(/\s+/, $preroots));
local $resp = "HTTP/1.0 $ok_code $ok_message\r\n".
"Date: $datestr\r\n".
"Server: $config{server}\r\n".
- "Content-type: text/html\r\n";
+ "Content-type: text/html; Charset=iso-8859-1\r\n";
&write_data($resp);
&write_keep_alive(0);
&write_data("\r\n");
$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{"QUERY_STRING"} = $querystring;
$ENV{"MINISERV_CONFIG"} = $config_file;
- $ENV{"HTTPS"} = "ON" if ($use_ssl || $config{'inetd_ssl'});
+ $ENV{"HTTPS"} = $use_ssl || $config{'inetd_ssl'} ? "ON" : "";
+ $ENV{"MINISERV_PID"} = $miniserv_main_pid;
$ENV{"SESSION_ID"} = $session_id if ($session_id);
$ENV{"LOCAL_USER"} = $localauth_user if ($localauth_user);
$ENV{"MINISERV_INTERNAL"} = $miniserv_internal if ($miniserv_internal);
chmod(0600, $config{'logfile'});
}
}
- $doing_eval = 1;
+ $doing_cgi_eval = 1;
$main_process_id = $$;
$pkg = "main";
if ($full =~ /^\Q$foundroot\E\/([^\/]+)\//) {
do \$miniserv::full;
die \$@ if (\$@);
";
- $doing_eval = 0;
+ $doing_cgi_eval = 0;
if ($@) {
# Error in perl!
&http_error(500, "Perl execution failed",
}
else {
# A file to output
- print DEBUG "handle_request: outputting file\n";
- open(FILE, $full) || &http_error(404, "Failed to open file");
+ 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 $resp = "HTTP/1.0 $ok_code $ok_message\r\n".
"Date: $datestr\r\n".
"Server: $config{server}\r\n".
"Content-type: ".&get_type($full)."\r\n".
- "Content-length: $stfull[7]\r\n".
- "Last-Modified: ".&http_date($stfull[9])."\r\n".
- "Expires: ".&http_date(time()+$config{'expires'})."\r\n";
- &write_data($resp);
- $rv = &write_keep_alive();
- &write_data("\r\n");
- &reset_byte_count();
- while(read(FILE, $buf, 1024) > 0) {
- &write_data($buf);
+ "Last-Modified: ".&http_date($stopen[9])."\r\n".
+ "Expires: ".
+ &http_date(time()+&get_expires_time($simple))."\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'} || 1024;
+ while(read(FILE, $buf, $bufsize) > 0) {
+ &write_data($buf);
+ }
+ close(FILE);
}
- close(FILE);
}
# log the request
&write_data("HTTP/1.0 $_[0] $_[1]\r\n");
&write_data("Server: $config{server}\r\n");
&write_data("Date: $datestr\r\n");
- &write_data("Content-type: text/html\r\n");
+ &write_data("Content-type: text/html; Charset=iso-8859-1\r\n");
&write_keep_alive(0);
&write_data("\r\n");
&reset_byte_count();
sub ip_match
{
local(@io, @mo, @ms, $i, $j, $hn, $needhn);
-@io = split(/\./, $_[0]);
+@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]})) {
- $hn = gethostbyaddr(inet_aton($_[0]), AF_INET);
- $hn = "" if (&to_ipaddress($hn) ne $_[0]);
+ # Reverse-lookup hostname if any rules match based on it
+ $hn = &to_hostname($_[0]);
+ if (&check_ip6address($_[0])) {
+ $hn = "" if (&to_ip6address($hn) ne $_[0]);
+ }
+ else {
+ $hn = "" if (&to_ipaddress($hn) ne $_[0]);
+ }
$ip_match_cache{$_[0]} = $hn;
}
for($i=2; $i<@_; $i++) {
$_[$i] = $1."/".&prefix_to_mask($2);
}
if ($_[$i] =~ /^(\S+)\/(\S+)$/) {
- # Compare with network/mask
+ # 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])) {
# Compare with hostname regexp
$mismatch = 1 if ($hn !~ /$1$/);
}
- elsif ($_[$i] eq 'LOCAL') {
- # Compare with local network
+ 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]);
$lo[2] != $io[2]);
}
}
- elsif ($_[$i] !~ /^[0-9\.]+$/) {
- # Compare with hostname
- $mismatch = 1 if ($_[0] ne &to_ipaddress($_[$i]));
+ 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]);
+ }
}
- else {
- # Compare with IP or network
+ elsif ($_[$i] =~ /^[0-9\.]+$/) {
+ # Compare with IPv4 address or network
@mo = split(/\./, $_[$i]);
while(@mo && !$mo[$#mo]) { pop(@mo); }
for($j=0; $j<@mo; $j++) {
}
}
}
+ elsif ($_[$i] =~ /^[a-f0-9:]+$/) {
+ # Compare with IPv6 address or network
+ @mo = split(/:/, $_[$i]);
+ while(@mo && !$mo[$#mo]) { pop(@mo); }
+ for($j=0; $j<@mo; $j++) {
+ if ($mo[$j] ne $io[$j]) {
+ $mismatch = 1;
+ }
+ }
+ }
+ elsif ($_[$i] !~ /^[0-9\.]+$/) {
+ # Compare with hostname
+ $mismatch = 1 if ($_[0] ne &to_ipaddress($_[$i]));
+ }
return 1 if (!$mismatch);
}
return 0;
$need_reload = 1;
}
+# to_ipaddress(address, ...)
sub to_ipaddress
{
local (@rv, $i);
foreach $i (@_) {
if ($i =~ /(\S+)\/(\S+)/ || $i =~ /^\*\S+$/ ||
- $i eq 'LOCAL' || $i =~ /^[0-9\.]+$/) { push(@rv, $i); }
- else { push(@rv, join('.', unpack("CCCC", inet_aton($i)))); }
+ $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);
+ }
+ else {
+ # Lookup IPv6 address
+ local ($inaddr, $addr);
+ (undef, undef, undef, $inaddr) =
+ getaddrinfo($i, undef, Socket6::AF_INET6(), SOCK_STREAM);
+ if ($inaddr) {
+ push(@rv, undef);
+ }
+ else {
+ (undef, $addr) = unpack_sockaddr_in6($inaddr);
+ push(@rv, inet_ntop(Socket6::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(Socket6::AF_INET6(), $addr),
+ Socket6::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
$more = Net::SSLeay::read($ssl_con);
}
else {
- local $ok = sysread(SOCK, $more, 1024);
+ my $bufsize = $config{'bufsize'} || 1024;
+ local $ok = sysread(SOCK, $more, $bufsize);
$more = undef if ($ok <= 0);
}
if ($more eq '') {
$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
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;
-&write_to_sock(sprintf $fmt, @_);
+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 END
{
-if ($doing_eval && $$ == $main_process_id) {
+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);
return $tmp2;
}
-# validate_user(username, password, host)
+# 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, and the non-existence flag
sub validate_user
{
-local ($user, $pass, $host) = @_;
+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) =
}
elsif ($canmode == 1) {
# Attempt Webmin authentication
- if ($users{$webminuser} eq
- &password_crypt($pass, $users{$webminuser})) {
+ my $uinfo = &get_user_details($webminuser);
+ if ($uinfo &&
+ &password_crypt($pass, $uinfo->{'pass'}) eq $uinfo->{'pass'}) {
# Password is valid .. but check for expiry
- local $lc = $lastchanges{$user};
- if ($config{'pass_maxdays'} && $lc && !$nochange{$user}) {
+ 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=$temppass{$user}\n";
+ 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 ( $user, 1, 0 );
}
}
- if ($temppass{$user}) {
+ if ($uinfo->{'temppass'}) {
# Temporary password - force change now
return ( $user, 2, 0 );
}
return ( $user, 0, 0 );
}
+ elsif (!$uinfo) {
+ print DEBUG "validate_user: User $webminuser not found\n";
+ return ( undef, 0, 0 );
+ }
else {
+ print DEBUG "validate_user: User $webminuser password mismatch $pass != $uinfo->{'pass'}\n";
return ( undef, 0, 0 );
}
}
elsif ($canmode == 2 || $canmode == 3) {
# Attempt PAM or passwd file authentication
- local $val = &validate_unix_user($canuser, $pass);
+ 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
}
}
-# validate_unix_user(user, password)
+# 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
# 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)) {
+ $pamh->pam_set_item("PAM_RHOST", $_[2]) if ($_[2]);
+ $pamh->pam_set_item("PAM_TTY", $_[3]) if ($_[3]);
local $pam_ret = $pamh->pam_authenticate();
if ($pam_ret == PAM_SUCCESS()) {
# Logged in OK .. make sure password hasn't expired
# Fifth is a flag indicating if a sudo check is needed.
sub can_user_login
{
-if (!$users{$_[0]}) {
+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]};
$realuser = $unixauth{"*"};
}
return (undef, 0, 1, undef) if (!$realuser);
- local $up = $users{$realuser};
- return (undef, 0, 1, undef) if (!defined($up));
+ 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] );
push(@doms, $2);
}
- if ($config{'user_mapping'} && !defined(%user_mapping)) {
+ if ($config{'user_mapping'} && !%user_mapping) {
# Read the user mapping file
%user_mapping = ();
open(MAPPING, $config{'user_mapping'});
return ( undef, 0, 1, undef ) if (!@uinfo && !$pamany);
if (@uinfo) {
- if (defined(@allowusers)) {
+ if (scalar(@allowusers)) {
# Only allow people on the allow list
return ( undef, 0, 0, undef )
if (!&users_match(\@uinfo, @allowusers));
}
- elsif (defined(@denyusers)) {
+ elsif (scalar(@denyusers)) {
# Disallow people on the deny list
return ( undef, 0, 0, undef )
if (&users_match(\@uinfo, @denyusers));
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 ($users{$_[0]} eq 'x') {
+elsif ($uinfo->{'pass'} eq 'x') {
# Webmin user authenticated via PAM or password file
return ( $_[0], $use_pam ? 2 : 3, 0, $_[0] );
}
-elsif ($users{$_[0]} eq 'e') {
+elsif ($uinfo->{'pass'} eq 'e') {
# Webmin user authenticated externally
return ( $_[0], 4, 0, $_[0] );
}
close(RANDOM);
}
-# get_socket_name(handle)
+# 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(Socket6::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 $sn = getsockname($_[0]);
-return undef if (!$sn);
-local $myaddr = (unpack_sockaddr_in($sn))[1];
+local ($mybin, $myaddr) = &get_socket_ip($fh, $ipv6);
if (!$get_socket_name_cache{$myaddr}) {
local $myname;
if (!$config{'no_resolv_myname'}) {
- $myname = gethostbyaddr($myaddr, AF_INET);
- }
- if ($myname eq "") {
- $myname = inet_ntoa($myaddr);
+ $myname = gethostbyaddr($mybin,
+ $ipv6 ? Socket6::AF_INET6() : AF_INET);
}
+ $myname ||= $myaddr;
$get_socket_name_cache{$myaddr} = $myname;
}
return $get_socket_name_cache{$myaddr};
sub run_login_script
{
if ($config{'login_script'}) {
- system($config{'login_script'}.
- " ".join(" ", map { quotemeta($_) || '""' } @_).
- " >/dev/null 2>&1 </dev/null");
+ alarm(5);
+ $SIG{'ALRM'} = sub { die "timeout" };
+ eval {
+ system($config{'login_script'}.
+ " ".join(" ", map { quotemeta($_) || '""' } @_).
+ " >/dev/null 2>&1 </dev/null");
+ };
+ alarm(0);
}
}
sub run_logout_script
{
if ($config{'logout_script'}) {
- system($config{'logout_script'}.
- " ".join(" ", map { quotemeta($_) || '""' } @_).
- " >/dev/null 2>&1 </dev/null");
+ alarm(5);
+ $SIG{'ALRM'} = sub { die "timeout" };
+ eval {
+ system($config{'logout_script'}.
+ " ".join(" ", map { quotemeta($_) || '""' } @_).
+ " >/dev/null 2>&1 </dev/null");
+ };
+ alarm(0);
}
}
# Returns 1 if some user is allowed to login from the accepting IP, 0 if not
sub check_user_ip
{
-if ($deny{$_[0]} &&
- &ip_match($acptip, $localip, @{$deny{$_[0]}}) ||
- $allow{$_[0]} &&
- !&ip_match($acptip, $localip, @{$allow{$_[0]}})) {
+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;
# Returns 1 if some user is allowed to login at the current date and time
sub check_user_time
{
-return 1 if (!$allowdays{$_[0]} && !$allowhours{$_[0]});
+local ($username) = @_;
+local $uinfo = &get_user_details($username);
+return 1 if (!$uinfo || !$uinfo->{'allowdays'} && !$uinfo->{'allowhours'});
local @tm = localtime(time());
-if ($allowdays{$_[0]}) {
+if ($uinfo->{'allowdays'}) {
# Make sure day is allowed
- return 0 if (&indexof($tm[6], @{$allowdays{$_[0]}}) < 0);
+ return 0 if (&indexof($tm[6], @{$uinfo->{'allowdays'}}) < 0);
}
-if ($allowhours{$_[0]}) {
+if ($uinfo->{'allowhours'}) {
# Make sure time is allowed
local $m = $tm[2]*60+$tm[1];
- return 0 if ($m < $allowhours{$_[0]}->[0] ||
- $m > $allowhours{$_[0]}->[1]);
+ return 0 if ($m < $uinfo->{'allowhours'}->[0] ||
+ $m > $uinfo->{'allowhours'}->[1]);
}
return 1;
}
# 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\n";
<$PASSOUTr> =~ /(\d+) (\d+)/;
$blocked = $2;
sleep($1);
+ print DEBUG "handle_login: delay=$1 blocked=$2\n";
}
if ($ok && (!$expired ||
# Logged in OK! Tell the main process about
# the new SID
local $sid = &generate_random_id($pass);
+ print DEBUG "handle_login: sid=$sid\n";
print $PASSINw "new $sid $authuser $acptip\n";
# Run the post-login script, if any
# Check for a redirect URL for the user
local $rurl = &login_redirect($authuser, $pass, $host);
+ print DEBUG "handle_login: redirect URL rurl=$rurl\n";
if ($rurl) {
# Got one .. go to it
&write_data("HTTP/1.0 302 Moved Temporarily\r\n");
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();
'key' => $_[0]->{$k},
'index' => scalar(@rv) };
$ipkey->{'cert'} = $_[0]->{'ipcert_'.$1};
+ $ipkey->{'extracas'} = $_[0]->{'ipextracas_'.$1};
push(@rv, $ipkey);
}
}
return @rv;
}
-# create_ssl_context(keyfile, [certfile])
+# create_ssl_context(keyfile, [certfile], [extracas])
sub create_ssl_context
{
-local ($keyfile, $certfile) = @_;
+local ($keyfile, $certfile, $extracas) = @_;
local $ssl_ctx;
eval { $ssl_ctx = Net::SSLeay::new_x_ctx() };
$ssl_ctx ||= Net::SSLeay::CTX_new();
Net::SSLeay::CTX_set_verify(
$ssl_ctx, &Net::SSLeay::VERIFY_PEER, \&verify_client);
}
-if ($config{'extracas'}) {
- local $p;
- foreach $p (split(/\s+/, $config{'extracas'})) {
+if ($extracas && $extracas ne "none") {
+ foreach my $p (split(/\s+/, $extracas)) {
Net::SSLeay::CTX_load_verify_locations(
$ssl_ctx, $p, "");
}
return $ssl_ctx;
}
-# ssl_connection_for_ip(socket)
+# 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) = @_;
+local ($sock, $ipv6) = @_;
local $sn = getsockname($sock);
if (!$sn) {
print STDERR "Failed to get address for socket $sock\n";
return undef;
}
-local $myip = inet_ntoa((unpack_sockaddr_in($sn))[1]);
+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);
if ($config{'ssl_cipher_list'}) {
&read_users_file();
&read_mime_types();
&build_config_mappings();
+&read_webmin_crons();
+&precache_files();
if ($config{'session'}) {
dbmclose(%sessiondb);
dbmopen(%sessiondb, $config{'sessiondb'}, 0700);
"maxconns", 50,
"pam", "webmin",
"sidname", "sid",
- "unauth", "^/unauthenticated/ ^[A-Za-z0-9\\-/_]+\\.jar\$ ^[A-Za-z0-9\\-/_]+\\.class\$ ^[A-Za-z0-9\\-/_]+\\.gif\$ ^[A-Za-z0-9\\-/_]+\\.conf\$ ^[A-Za-z0-9\\-/_]+\\.ico\$ ^/robots.txt\$",
+ "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\$",
"max_post", 10000,
"expires", 7*24*60*60,
"pam_test_user", "root",
+ "precache", "lang/en */lang/en",
);
foreach my $v (keys %vital) {
if (!$config{$v}) {
$config{'pidfile'} =~ /^(.*)\/[^\/]+$/;
$config{'blockedfile'} = "$1/blocked";
}
+if (!$config{'webmincron_dir'}) {
+ $config_file =~ /^(.*)\/[^\/]+$/;
+ $config{'webmincron_dir'} = "$1/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";
+ }
}
# read_users_file()
}
close(USERS);
}
+
+# Test user DB, if configured
+if ($config{'userdb'}) {
+ my $dbh = &connect_userdb($config{'userdb'});
+ if (!ref($dbh)) {
+ print STDERR "Failed to open users database : $dbh\n"
+ }
+ else {
+ &disconnect_userdb($config{'userdb'}, $dbh);
+ }
+ }
+}
+
+# get_user_details(username)
+# Returns a hash ref of user details, either from config files or the user DB
+sub get_user_details
+{
+my ($username) = @_;
+if (exists($users{$username})) {
+ # In local files
+ 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},
+ };
+ }
+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";
+ print STDERR "Failed to connect to user database : $dbh\n";
+ }
+ 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)) {
+ print STDERR "Failed to lookup user : ",
+ $dbh->errstr,"\n";
+ 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)) {
+ print STDERR "Failed to lookup user attrs : ",
+ $dbh->errstr,"\n";
+ 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) {
+ print STDERR "Failed to lookup user : ",
+ ($rv ? $rv->error : "Unknown error"),"\n";
+ return undef;
+ }
+ my ($u) = $rv->all_entries();
+ if (!$u) {
+ &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'};
+ }
+ &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 &text('sql_emysqlconnect', $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 &text('sql_epostgresqlconnect', $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 &text('sql_eldapconnect', $host);
+ my $mesg;
+ if ($args->{'tls'}) {
+ # Switch to TLS mode
+ eval { $mesg = $ldap->start_tls(); };
+ if ($@ || !$mesg || $mesg->code) {
+ return &text('sql_eldaptls',
+ $@ ? $@ : $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 &text('sql_eldaplogin', $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 disconnnect
+ $h->disconnect();
+ }
+elsif ($str =~ /^ldap:/) {
+ # LDAP disconnect
+ $h->disconnect();
+ }
}
# read_mime_types()
@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 ]);
+ }
+ }
+
# Open debug log
close(DEBUG);
if ($config{'debug'}) {
close(STDIN); close(STDOUT); close(STDERR);
untie(*STDIN); untie(*STDOUT); untie(*STDERR);
close($PASSINw); close($PASSOUTr);
- $( = $uinfo[3]; $) = "$uinfo[3] $uinfo[3]";
+ ($(, $)) = ( $uinfo[3],
+ "$uinfo[3] ".join(" ", $uinfo[3],
+ &other_groups($uinfo[0])) );
($>, $<) = ($uinfo[2], $uinfo[2]);
close(SUDOw);
close($ptyfh);
kill('KILL', $pid);
waitpid($pid, 0);
-local ($ok) = ($out =~ /\(ALL\)\s+ALL/ ? 1 : 0);
+local ($ok) = ($out =~ /\(ALL\)\s+ALL|\(ALL\)\s+NOPASSWD:\s+ALL|\(ALL\s*:\s*ALL\)\s+ALL/ ? 1 : 0);
# Update cache
if ($PASSINw) {
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.
"iPhone", # Apple iPhone KHTML browser
"iPod", # iPod touch browser
"MobileSafari", # HTTP client in iPhone
- "Android", # gPhone
"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;
}
open(PIDFILE, ">$config{'pidfile'}");
printf PIDFILE "%d\n", getpid();
close(PIDFILE);
+$miniserv_main_pid = getpid();
}
# lock_user_password(user)
sub lock_user_password
{
local ($user) = @_;
-if ($users{$user}) {
- if ($users{$user} !~ /^\!/) {
- # Lock the password
- $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);
+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
+ print STDERR "Failed to lock password : ",
+ $dbh->errstr,"\n";
+ 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) {
+ print STDERR "Failed to lock password : ",
+ ($rv ? $rv->error : "Unknown error"),"\n";
+ return -1;
}
- open(USERS, ">$config{'userfile'}");
- print USERS @ufile;
- close(USERS);
- return 1;
}
+ &disconnect_userdb($config{'userdb'}, $dbh);
return 0;
}
-return -1;
+
+return -1; # This should never be reached
}
# hash_session_id(sid)
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()
+# Find and run any cron jobs that are due, based on their last run time and
+# execution interval
+sub execute_ready_webmin_crons
+{
+my $now = time();
+my $changed = 0;
+foreach my $cron (@webmincrons) {
+ my $run = 0;
+ if (!$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'}) {
+ # 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]) &&
+ &matches_cron($cron->{'hours'}, $tm[2]) &&
+ &matches_cron($cron->{'days'}, $tm[3]) &&
+ &matches_cron($cron->{'months'}, $tm[4]+1) &&
+ &matches_cron($cron->{'weekdays'}, $tm[6]) &&
+ $now - $webmincron_last{$cron->{'id'}} > 60) {
+ $run = 1;
+ }
+ }
+
+ if ($run) {
+ print DEBUG "Running cron id=$cron->{'id'} ".
+ "module=$cron->{'module'} func=$cron->{'func'}\n";
+ $webmincron_last{$cron->{'id'}} = $now;
+ $changed = 1;
+ my $pid = fork();
+ if (!$pid) {
+ # Run via a wrapper command, which we run like a CGI
+ dbmclose(%sessiondb);
+
+ # 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{"DOCUMENT_REALROOT"} = $root0;
+ $ENV{"MINISERV_CONFIG"} = $config_file;
+ $ENV{"HTTPS"} = "ON" if ($use_ssl);
+ $ENV{"MINISERV_PID"} = $miniserv_main_pid;
+ $ENV{"SCRIPT_FILENAME"} = $config{'webmincron_wrapper'};
+ if ($ENV{"SCRIPT_FILENAME"} =~ /^\Q$root0\E(\/.*)$/) {
+ $ENV{"SCRIPT_NAME"} = $1;
+ }
+ $config{'webmincron_wrapper'} =~ /^(.*)\//;
+ $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
+ $pkg = "webmincron";
+ $0 = $config{'webmincron_wrapper'};
+ @ARGV = ( $cron );
+ $main_process_id = $$;
+ eval "
+ \%pkg::ENV = \%ENV;
+ package $pkg;
+ do \$miniserv::config{'webmincron_wrapper'};
+ die \$@ if (\$@);
+ ";
+ if ($@) {
+ print STDERR "Perl cron failure : $@\n";
+ }
+
+ exit(0);
+ }
+ push(@childpids, $pid);
+ }
+ }
+if ($changed) {
+ # Write out file containing last run times
+ &write_file($config{'webmincron_last'}, \%webmincron_last);
+ }
+}
+
+# matches_cron(cron-spec, time)
+# Checks if some minute or hour matches some cron spec, which can be * or a list
+# of numbers.
+sub matches_cron
+{
+my ($spec, $tm) = @_;
+if ($spec eq '*') {
+ return 1;
+ }
+else {
+ foreach my $s (split(/,/, $spec)) {
+ if ($s == $tm ||
+ $s =~ /^(\d+)\-(\d+)$/ && $tm >= $1 && $tm <= $2) {
+ 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}) {
+ print STDERR "Cron $1 missing $n\n";
+ $broken = 1;
+ }
+ }
+ if (!$cron{'interval'} && !$cron{'mins'} && !$cron{'special'}) {
+ print STDERR "Cron $1 missing any time spec\n";
+ $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'}) {
+ print STDERR "Cron $1 invalid special time $cron{'special'}\n";
+ $broken = 1;
+ }
+ if ($cron{'special'}) {
+ delete($cron{'special'});
+ }
+ if (!$broken) {
+ print DEBUG "adding cron id=$cron{'id'} module=$cron{'module'} func=$cron{'func'}\n";
+ push(@webmincrons, \%cron);
+ }
+ }
+ }
+}
+
+# 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.
+sub check_ip6address
+{
+ my @blocks = split(/:/, $_[0]);
+ return 0 if (@blocks == 0 || @blocks > 8);
+ my $ib = $#blocks;
+ my $where = index($blocks[$ib],"/");
+ my $m = 0;
+ if ($where != -1) {
+ my $b = substr($blocks[$ib],0,$where);
+ $m = substr($blocks[$ib],$where+1,length($blocks[$ib])-($where+1));
+ $blocks[$ib]=$b;
+ }
+ return 0 if ($m <0 || $m >128);
+ my $b;
+ my $empty = 0;
+ foreach $b (@blocks) {
+ return 0 if ($b ne "" && $b !~ /^[0-9a-f]{1,4}$/i);
+ $empty++ if ($b eq "");
+ }
+ return 0 if ($empty > 1 && !($_[0] =~ /^::/ && $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 Socket6::inet_ntop(Socket6::AF_INET6(), $addr);
+ }
+}
+
+# redirect_stderr_to_log()
+# Re-direct STDERR to error log file
+sub redirect_stderr_to_log
+{
+if ($config{'errorlog'} ne '-') {
+ open(STDERR, ">>$config{'errorlog'}") ||
+ die "failed to open $config{'errorlog'} : $!";
+ if ($config{'logperms'}) {
+ chmod(oct($config{'logperms'}), $config{'errorlog'});
+ }
+ }
+select(STDERR); $| = 1; select(STDOUT);
+}
+
+# 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'};
+}
+
projects / webmin.git / blobdiff