Handle hostnames with upper-case letters
[webmin.git] / miniserv.pl
index c2f18c2..2975c84 100755 (executable)
@@ -6,6 +6,7 @@ package miniserv;
 use Socket;
 use POSIX;
 use Time::Local;
+eval "use Time::HiRes;";
 
 @itoa64 = split(//, "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz");
 
@@ -236,9 +237,16 @@ if ($@) {
 &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);
@@ -250,15 +258,25 @@ if ($use_ssl) {
                }
        $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");
@@ -368,17 +386,12 @@ if ($config{'debuglog'}) {
 %webmincron_last = ( );
 &read_file($config{'webmincron_last'}, \%webmincron_last);
 
-# 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);
+# 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';
@@ -403,28 +416,47 @@ if ($config{'inetd'}) {
                        }
                }
 
+       # 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, 0);
+       $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 "*") {
+$config{'bind'} = '' if ($config{'bind'} eq '*');
+if ($config{'bind'}) {
        # Listening on a specific IP
        if (&check_ip6address($config{'bind'})) {
                # IP is v6
@@ -437,36 +469,36 @@ if ($config{"bind"} && $config{"bind"} ne "*") {
                # IP is v4
                push(@sockets, [ inet_aton($config{'bind'}),
                                 $config{'port'},
-                                PF_INET ]);
+                                PF_INET() ]);
                }
        }
 else {
        # Listening on all IPs
+       push(@sockets, [ INADDR_ANY, $config{'port'}, PF_INET() ]);
        if ($use_ipv6) {
-               # Accept IPv6 and v4 connections
+               # Also IPv6
                push(@sockets, [ in6addr_any(), $config{'port'},
                                 Socket6::PF_INET6() ]);
                }
-       else {
-               # Accept IPv4 only
-               push(@sockets, [ INADDR_ANY, $config{'port'}, PF_INET ]);
-               }
        }
 foreach $s (split(/\s+/, $config{'sockets'})) {
        if ($s =~ /^(\d+)$/) {
                # Just listen on another port on the main IP
                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(), $config{'port'},
+                       push(@sockets, [ in6addr_any(), $1,
                                         Socket6::PF_INET6() ]);
                        }
-               else {
-                       push(@sockets, [ INADDR_ANY, $config{'port'},
-                                        PF_INET ]);
-                       }
                }
        elsif ($s =~ /^(\S+):(\d+)$/) {
                # Listen on a specific port and IP
@@ -479,13 +511,13 @@ foreach $s (split(/\s+/, $config{'sockets'})) {
                        }
                else {
                        push(@sockets, [ inet_aton($ip), $port,
-                                        PF_INET ]);
+                                        PF_INET() ]);
                        }
                }
        elsif ($s =~ /^([0-9\.]+):\*$/ || $s =~ /^([0-9\.]+)$/) {
                # Listen on the main port on another IPv4 address
                push(@sockets, [ inet_aton($1), $sockets[0]->[1],
-                                PF_INET ]);
+                                PF_INET() ]);
                }
        elsif (($s =~ /^([0-9a-f\:]+):\*$/ || $s =~ /^([0-9a-f\:]+)$/) &&
               $use_ipv6) {
@@ -501,16 +533,17 @@ $proto = getprotobyname('tcp');
 @sockerrs = ( );
 $tried_inaddr_any = 0;
 for($i=0; $i<@sockets; $i++) {
-       print STDERR "socket=",join(" ", @{$sockets[$i]}),"\n";
        $fh = "MAIN$i";
        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));
-       $pack = $sockets[$i]->[2] eq PF_INET ?
-                       pack_sockaddr_in($sockets[$i]->[1],
-                                        $sockets[$i]->[0]) :
-                       pack_sockaddr_in6($sockets[$i]->[1],
-                                          $sockets[$i]->[0]);
+       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));
                sleep(1);
@@ -533,7 +566,7 @@ for($i=0; $i<@sockets; $i++) {
        else {
                listen($fh, SOMAXCONN);
                push(@socketfhs, $fh);
-               $ipv6fhs{$fh} = $sockets[$i]->[2] eq PF_INET ? 0 : 1;
+               $ipv6fhs{$fh} = $sockets[$i]->[2] eq PF_INET() ? 0 : 1;
                }
        }
 foreach $se (@sockerrs) {
@@ -544,22 +577,25 @@ 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);
@@ -578,6 +614,7 @@ eval { setsid(); }; # may not work on Windows
 # Close standard file handles
 open(STDIN, "</dev/null");
 open(STDOUT, ">/dev/null");
+&redirect_stderr_to_log();
 &log_error("miniserv.pl started");
 foreach $msg (@startup_msg) {
        &log_error($msg);
@@ -782,20 +819,14 @@ while(1) {
                                        &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, $peerb, $peera);
-                       if ($ipv6fhs{$s}) {
-                               # Extract IPv6 address
-                               ($peerp, $peerb) =
-                                       unpack_sockaddr_in6($acptaddr);
-                               $peera = inet_ntop(Socket6::AF_INET6(), $peerb);
-                               }
-                       else {
-                               # Extract IPv4 address
-                               ($peerp, $peerb) =
-                                       unpack_sockaddr_in($acptaddr);
-                               $peera = inet_ntoa($peerb);
-                               }
                        $localauth_user = undef;
                        if ($config{'localauth'} && $peera eq "127.0.0.1") {
                                if (open(TCP, "/proc/net/tcp")) {
@@ -848,12 +879,6 @@ while(1) {
                                $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);
 
@@ -865,11 +890,19 @@ while(1) {
                                &close_all_sockets();
                                close(LISTEN);
 
-                               # XXX IPv6 - refactor to not resolve IP again
+                               # 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);
@@ -900,10 +933,10 @@ while(1) {
                    (!@allow || &ip_match($fromip, $toip, @allow))) {
                        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);
                        }
                }
@@ -1171,15 +1204,14 @@ while(1) {
        @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 {
@@ -1425,6 +1457,14 @@ if ($method eq 'POST' &&
        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;
 
@@ -1552,7 +1592,8 @@ if ($config{'userfile'}) {
                ($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;
@@ -1620,7 +1661,8 @@ if ($config{'userfile'}) {
                                }
 
                        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'},
@@ -1843,7 +1885,7 @@ if ($config{'userfile'}) {
                                &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");
@@ -2100,7 +2142,7 @@ if (-d _) {
        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");
@@ -2159,6 +2201,7 @@ if (&get_type($full) eq "internal/cgi" && $validated != 4) {
        $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;
@@ -2188,7 +2231,7 @@ if (&get_type($full) eq "internal/cgi" && $validated != 4) {
                }
        $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);
@@ -2420,24 +2463,67 @@ if (&get_type($full) eq "internal/cgi" && $validated != 4) {
        }
 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
@@ -2469,7 +2555,7 @@ else {
        &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();
@@ -2551,13 +2637,20 @@ sub b64decode
 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++) {
@@ -2567,7 +2660,7 @@ 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])) {
@@ -2579,8 +2672,8 @@ for($i=2; $i<@_; $i++) {
                # 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]);
@@ -2595,12 +2688,15 @@ for($i=2; $i<@_; $i++) {
                                          $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++) {
@@ -2609,6 +2705,20 @@ for($i=2; $i<@_; $i++) {
                                }
                        }
                }
+       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;
@@ -2663,17 +2773,65 @@ sub trigger_reload
 $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
@@ -2692,7 +2850,8 @@ while(($idx = index($main::read_buffer, "\n")) < 0) {
                $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 '') {
@@ -2913,6 +3072,8 @@ 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
@@ -2922,13 +3083,18 @@ $$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;
-&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
@@ -3101,12 +3267,12 @@ sub urlize {
   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) =
@@ -3158,7 +3324,7 @@ elsif ($canmode == 1) {
        }
 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
@@ -3184,7 +3350,7 @@ else {
        }
 }
 
-# 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
@@ -3199,6 +3365,8 @@ if ($use_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
@@ -3420,12 +3588,12 @@ if (!$uinfo) {
        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));
@@ -3498,35 +3666,47 @@ sub urandom_timeout
 close(RANDOM);
 }
 
-# get_socket_name(handle, ipv6-flag)
-# Returns the local hostname or IP address of some connection
-sub get_socket_name
+# 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) = @_;
-return $config{'host'} if ($config{'host'});
 local $sn = getsockname($fh);
 return undef if (!$sn);
-local $myaddr;
+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) {
-       $myaddr = (unpack_sockaddr_in6($sn))[1];
+       local ($p, $b) = unpack_sockaddr_in6($sn);
+       return ($b, inet_ntop(Socket6::AF_INET6(), $b), $p);
        }
 else {
-       $myaddr = (unpack_sockaddr_in($sn))[1];
+       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($myaddr,
+               $myname = gethostbyaddr($mybin,
                                        $ipv6 ? Socket6::AF_INET6() : AF_INET);
                }
-       if ($myname eq "") {
-               if ($ipv6) {
-                       $myname = inet_ntop(Socket6::AF_INET6(), $myaddr);
-                       }
-               else {
-                       $myname = inet_ntoa($myaddr);
-                       }
-               }
+       $myname ||= $myaddr;
        $get_socket_name_cache{$myaddr} = $myname;
        }
 return $get_socket_name_cache{$myaddr};
@@ -3536,9 +3716,14 @@ 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);
        }
 }
 
@@ -3546,9 +3731,14 @@ if ($config{'login_script'}) {
 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);
        }
 }
 
@@ -3964,16 +4154,17 @@ foreach $k (keys %{$_[0]}) {
                                 '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();
@@ -3984,9 +4175,8 @@ if ($client_certs) {
        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, "");
                }
@@ -4002,17 +4192,17 @@ Net::SSLeay::CTX_use_certificate_file(
 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'}) {
@@ -4059,6 +4249,7 @@ sub reload_config_file
 &read_mime_types();
 &build_config_mappings();
 &read_webmin_crons();
+&precache_files();
 if ($config{'session'}) {
        dbmclose(%sessiondb);
        dbmopen(%sessiondb, $config{'sessiondb'}, 0700);
@@ -4105,10 +4296,11 @@ my %vital = ("port", 80,
          "maxconns", 50,
          "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\\-/_]+\\.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}) {
@@ -4621,6 +4813,15 @@ foreach my $d (split(/\s+/, $config{'davpaths'})) {
 @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'}) {
@@ -4984,7 +5185,9 @@ if (!$pid) {
        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);
@@ -5019,7 +5222,7 @@ while(<$ptyfh>) {
 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) {
@@ -5029,6 +5232,19 @@ 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.
@@ -5069,19 +5285,24 @@ local @substrings = (
     "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;
 }
 
@@ -5362,6 +5583,7 @@ foreach my $cron (@webmincrons) {
                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"};
@@ -5537,6 +5759,23 @@ foreach my $f (readdir(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
 {
@@ -5584,3 +5823,38 @@ else {
        }
 }
 
+# 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'};
+}
+