Handle hostnames with upper-case letters
[webmin.git] / web-lib-funcs.pl
index 61811e9..16a2a52 100755 (executable)
@@ -214,8 +214,8 @@ sub tempname
 my $tmp_base = $gconfig{'tempdir_'.&get_module_name()} ?
                        $gconfig{'tempdir_'.&get_module_name()} :
                  $gconfig{'tempdir'} ? $gconfig{'tempdir'} :
-                 $ENV{'TEMP'} ? $ENV{'TEMP'} :
-                 $ENV{'TMP'} ? $ENV{'TMP'} :
+                 $ENV{'TEMP'} && $ENV{'TEMP'} ne "/tmp" ? $ENV{'TEMP'} :
+                 $ENV{'TMP'} && $ENV{'TMP'} ne "/tmp" ? $ENV{'TMP'} :
                  -d "c:/temp" ? "c:/temp" : "/tmp/.webmin";
 my $tmp_dir = -d $remote_user_info[7] && !$gconfig{'nohometemp'} ?
                        "$remote_user_info[7]/.tmp" :
@@ -1869,7 +1869,8 @@ my ($nowait) = @_;
 return undef if (&is_readonly_mode());
 my %miniserv;
 &get_miniserv_config(\%miniserv) || return;
-if ($main::webmin_script_type eq 'web' && !$ENV{"MINISERV_CONFIG"}) {
+if ($main::webmin_script_type eq 'web' && !$ENV{"MINISERV_CONFIG"} &&
+    !$ENV{'MINISERV_PID'}) {
        # Running under some web server other than miniserv, so do nothing
        return;
        }
@@ -1881,7 +1882,7 @@ if ($gconfig{'os_type'} ne 'windows') {
        $miniserv{'inetd'} && return;
        my @oldst = stat($miniserv{'pidfile'});
        $pid = $ENV{'MINISERV_PID'};
-       if (!$pid) {
+       if (!$pid || !kill(0, $pid)) {
                if (!open(PID, $miniserv{'pidfile'})) {
                        print STDERR "PID file $miniserv{'pidfile'} does ",
                                     "not exist\n";
@@ -1949,7 +1950,8 @@ sub reload_miniserv
 return undef if (&is_readonly_mode());
 my %miniserv;
 &get_miniserv_config(\%miniserv) || return;
-if ($main::webmin_script_type eq 'web' && !$ENV{"MINISERV_CONFIG"}) {
+if ($main::webmin_script_type eq 'web' && !$ENV{"MINISERV_CONFIG"} &&
+    !$ENV{'MINISERV_PID'}) {
        # Running under some web server other than miniserv, so do nothing
        return;
        }
@@ -1959,7 +1961,7 @@ if ($gconfig{'os_type'} ne 'windows') {
        my ($pid, $addr, $i);
        $miniserv{'inetd'} && return;
        $pid = $ENV{'MINISERV_PID'};
-       if (!$pid) {
+       if (!$pid || !kill(0, $pid)) {
                if (!open(PID, $miniserv{'pidfile'})) {
                        print STDERR "PID file $miniserv{'pidfile'} does ",
                                     "not exist\n";
@@ -2216,11 +2218,15 @@ if ($rcode >= 300 && $rcode < 400) {
        my ($host, $port, $page, $ssl);
        if ($header{'location'} =~ /^(http|https):\/\/([^:]+):(\d+)(\/.*)?$/) {
                $ssl = $1 eq 'https' ? 1 : 0;
-               $host = $2; $port = $3; $page = $4 || "/";
+               $host = $2;
+               $port = $3;
+               $page = $4 || "/";
                }
        elsif ($header{'location'} =~ /^(http|https):\/\/([^:\/]+)(\/.*)?$/) {
                $ssl = $1 eq 'https' ? 1 : 0;
-               $host = $2; $port = 80; $page = $3 || "/";
+               $host = $2;
+               $port = $ssl ? 443 : 80;
+               $page = $3 || "/";
                }
        elsif ($header{'location'} =~ /^\// && $_[5]) {
                # Relative to same server
@@ -2280,6 +2286,92 @@ else {
 }
 
 
+=head2 http_post(host, port, page, content, destfile, [&error], [&callback], [sslmode], [user, pass], [timeout], [osdn-convert], [no-cache], [&headers])
+
+Posts data to an HTTP url and downloads the response to a local file or string. The parameters are :
+
+=item host - The hostname part of the URL, such as www.google.com
+
+=item port - The HTTP port number, such as 80
+
+=item page - The filename part of the URL, like /index.html
+
+=item content - The data to post
+
+=item destfile - The local file to save the URL data to, like /tmp/index.html. This can also be a scalar reference, in which case the data will be appended to that scalar.
+
+=item error - If set to a scalar ref, the function will store any error message in this scalar and return 0 on failure, or 1 on success. If not set, it will simply call the error function if the download fails.
+
+=item callback - If set to a function ref, it will be called after each block of data is received. This is typically set to \&progress_callback, for printing download progress.
+
+=item sslmode - If set to 1, an HTTPS connection is used instead of HTTP.
+
+=item user - If set, HTTP authentication is done with this username.
+
+=item pass - The HTTP password to use with the username above.
+
+=item timeout - A timeout in seconds to wait for the TCP connection to be established before failing.
+
+=item osdn-convert - If set to 1, URL for downloads from sourceforge are converted to use an appropriate mirror site.
+
+=item no-cache - If set to 1, Webmin's internal caching for this URL is disabled.
+
+=item headers - If set to a hash ref of additional HTTP headers, they will be added to the request.
+
+=cut
+sub http_post
+{
+my ($host, $port, $page, $content, $dest, $error, $cbfunc, $ssl, $user, $pass,
+    $timeout, $osdn, $nocache, $headers) = @_;
+if ($gconfig{'debug_what_net'}) {
+       &webmin_debug_log('HTTP', "host=$host port=$port page=$page ssl=$ssl".
+                                 ($user ? " user=$user pass=$pass" : "").
+                                 (ref($dest) ? "" : " dest=$dest"));
+       }
+if ($osdn) {
+       # Convert OSDN URL first
+       my $prot = $ssl ? "https://" : "http://";
+       my $portstr = $ssl && $port == 443 ||
+                        !$ssl && $port == 80 ? "" : ":$port";
+       ($host, $port, $page, $ssl) = &parse_http_url(
+               &convert_osdn_url($prot.$host.$portstr.$page));
+       }
+
+# Build headers
+my @headers;
+push(@headers, [ "Host", $host ]);
+push(@headers, [ "User-agent", "Webmin" ]);
+push(@headers, [ "Accept-language", "en" ]);
+push(@headers, [ "Content-type", "application/x-www-form-urlencoded" ]);
+push(@headers, [ "Content-length", length($content) ]);
+if ($user) {
+       my $auth = &encode_base64("$user:$pass");
+       $auth =~ tr/\r\n//d;
+       push(@headers, [ "Authorization", "Basic $auth" ]);
+       }
+foreach my $hname (keys %$headers) {
+       push(@headers, [ $hname, $headers->{$hname} ]);
+       }
+
+# Actually download it
+$main::download_timed_out = undef;
+local $SIG{ALRM} = \&download_timeout;
+alarm($timeout || 60);
+my $h = &make_http_connection($host, $port, $ssl, "POST", $page, \@headers);
+alarm(0);
+$h = $main::download_timed_out if ($main::download_timed_out);
+if (!ref($h)) {
+       if ($error) { $$error = $h; return; }
+       else { &error($h); }
+       }
+&write_http_connection($content."\r\n");
+&complete_http_download($h, $dest, $error, $cbfunc, $osdn, $host, $port,
+                       $headers, $ssl, $nocache);
+if ((!$error || !$$error) && !$nocache) {
+       &write_to_http_cache($url, $dest);
+       }
+}
+
 =head2 ftp_download(host, file, destfile, [&error], [&callback], [user, pass], [port], [no-cache])
 
 Download data from an FTP site to a local file. The parameters are :
@@ -4033,6 +4125,7 @@ if ($> == 0 && $< != 0 && !$ENV{'FOREIGN_MODULE_NAME'}) {
 $config_file = "$config_directory/config";
 %gconfig = ( );
 &read_file_cached($config_file, \%gconfig);
+$gconfig{'webprefix'} = '' if (!exists($gconfig{'webprefix'}));
 $null_file = $gconfig{'os_type'} eq 'windows' ? "NUL" : "/dev/null";
 $path_separator = $gconfig{'os_type'} eq 'windows' ? ';' : ':';
 
@@ -4055,8 +4148,14 @@ if (!$main::webmin_script_type) {
                }
        }
 
+# If this is a cron job, suppress STDERR warnings
+if ($main::webmin_script_type eq 'cron') {
+       $SIG{__WARN__} = sub { };
+       }
+
 # If debugging is enabled, open the debug log
-if ($gconfig{'debug_enabled'} && !$main::opened_debug_log++) {
+if (($ENV{'WEBMIN_DEBUG'} || $gconfig{'debug_enabled'}) &&
+    !$main::opened_debug_log++) {
        my $dlog = $gconfig{'debug_file'} || $main::default_debug_log_file;
        if ($gconfig{'debug_size'}) {
                my @st = stat($dlog);
@@ -4071,7 +4170,6 @@ if ($gconfig{'debug_enabled'} && !$main::opened_debug_log++) {
                my $script_name = $0 =~ /([^\/]+)$/ ? $1 : '-';
                $main::debug_log_start_time = time();
                &webmin_debug_log("START", "script=$script_name");
-               $main::debug_log_start_module = $module_name;
                }
        }
 
@@ -4305,6 +4403,7 @@ my @langs = &list_languages();
 my $accepted_lang;
 if ($gconfig{'acceptlang'}) {
        foreach my $a (split(/,/, $ENV{'HTTP_ACCEPT_LANGUAGE'})) {
+               $a =~ s/;.*//;  # Remove ;q=0.5 or similar
                my ($al) = grep { $_->{'lang'} eq $a } @langs;
                if ($al) {
                        $accepted_lang = $al->{'lang'};
@@ -4773,6 +4872,33 @@ foreach my $m (@rv) {
 return @rv;
 }
 
+=head2 list_themes
+
+Returns an array of all installed themes, each of which is a hash ref
+corresponding to the theme.info file.
+
+=cut
+sub list_themes
+{
+my @rv;
+opendir(DIR, $root_directory);
+foreach my $m (readdir(DIR)) {
+       my %tinfo;
+       next if ($m =~ /^\./);
+       next if (!&read_file_cached("$root_directory/$m/theme.info", \%tinfo));
+       next if (!&check_os_support(\%tinfo));
+       foreach my $o (@lang_order_list) {
+               if ($tinfo{'desc_'.$o}) {
+                       $tinfo{'desc'} = $tinfo{'desc_'.$o};
+                       }
+               }
+       $tinfo{'dir'} = $m;
+       push(@rv, \%tinfo);
+       }
+closedir(DIR);
+return sort { lc($a->{'desc'}) cmp lc($b->{'desc'}) } @rv;
+}
+
 =head2 get_theme_info(theme)
 
 Returns a hash containing a theme's details, taken from it's theme.info file.
@@ -5487,8 +5613,6 @@ command is safe for read-only mode users to run.
 sub backquote_with_timeout
 {
 my $realcmd = &translate_command($_[0]);
-&webmin_debug_log('CMD', "cmd=$realcmd timeout=$_[1]")
-       if ($gconfig{'debug_what_cmd'});
 my $out;
 my $pid = &open_execute_command(OUT, "($realcmd) <$null_file", 1, $_[2]);
 my $start = time();
@@ -6956,6 +7080,22 @@ if (%UNCLEAN_ENV) {
        }
 }
 
+=head2 clean_language
+
+Sets all language and locale-related environment variables to US english, to
+ensure that commands run output in the expected language. Can be reverted by
+reset_environment.
+
+=cut
+sub clean_language
+{
+%UNCLEAN_ENV = %ENV;
+$ENV{'LANG'} = '';
+$ENV{'LANGUAGE'} = '';
+$ENV{'LC_ALL'} = '';
+$ENV{'LOCALE'} = '';
+}
+
 =head2 progress_callback
 
 Never called directly, but useful for passing to &http_download to print
@@ -8288,6 +8428,11 @@ $fh = &callers_package($fh);
 my $lockfile = $file;
 $lockfile =~ s/^[^\/]*//;
 if ($lockfile =~ /^\//) {
+       while(-l $lockfile) {
+               # If the file is a link, follow it so that locking is done on
+               # the same file that gets unlocked later
+               $lockfile = &resolve_links($lockfile);
+               }
        $main::open_templocks{$lockfile} = &lock_file($lockfile);
        }
 return &open_tempfile($fh, $file, $noerror, $notemp, $safe);
@@ -8299,14 +8444,12 @@ $main::end_exit_status ||= $?;
 if ($$ == $main::initial_process_id) {
        # Exiting from initial process
        &cleanup_tempnames();
-       if ($gconfig{'debug_what_start'} && $main::debug_log_start_time &&
-           $main::debug_log_start_module eq &get_module_name()) {
+       if ($gconfig{'debug_what_start'} && $main::debug_log_start_time) {
                my $len = time() - $main::debug_log_start_time;
                &webmin_debug_log("STOP", "runtime=$len");
                $main::debug_log_start_time = 0;
                }
-       if (!$ENV{'SCRIPT_NAME'} &&
-           $main::initial_module_name eq &get_module_name()) {
+       if (!$ENV{'SCRIPT_NAME'}) {
                # In a command-line script - call the real exit, so that the
                # exit status gets properly propogated. In some cases this
                # was not happening.