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" :
return undef if (&is_readonly_mode());
my %miniserv;
&get_miniserv_config(\%miniserv) || return;
+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;
+ }
my $i;
if ($gconfig{'os_type'} ne 'windows') {
$miniserv{'inetd'} && return;
my @oldst = stat($miniserv{'pidfile'});
$pid = $ENV{'MINISERV_PID'};
- if (!$pid) {
- open(PID, $miniserv{'pidfile'}) ||
- &error("Failed to open PID file $miniserv{'pidfile'}");
+ if (!$pid || !kill(0, $pid)) {
+ if (!open(PID, $miniserv{'pidfile'})) {
+ print STDERR "PID file $miniserv{'pidfile'} does ",
+ "not exist\n";
+ return;
+ }
chop($pid = <PID>);
close(PID);
- $pid || &error("Invalid PID file $miniserv{'pidfile'}");
+ if (!$pid) {
+ print STDERR "Invalid PID file $miniserv{'pidfile'}\n";
+ return;
+ }
+ if (!kill(0, $pid)) {
+ print STDERR "PID $pid from file $miniserv{'pidfile'} ",
+ "is not valid\n";
+ return;
+ }
}
# Just signal miniserv to restart
return undef if (&is_readonly_mode());
my %miniserv;
&get_miniserv_config(\%miniserv) || return;
+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;
+ }
if ($gconfig{'os_type'} ne 'windows') {
# Send a USR1 signal to re-read the config
my ($pid, $addr, $i);
$miniserv{'inetd'} && return;
$pid = $ENV{'MINISERV_PID'};
- if (!$pid) {
- open(PID, $miniserv{'pidfile'}) ||
- &error("Failed to open PID file $miniserv{'pidfile'}");
+ if (!$pid || !kill(0, $pid)) {
+ if (!open(PID, $miniserv{'pidfile'})) {
+ print STDERR "PID file $miniserv{'pidfile'} does ",
+ "not exist\n";
+ return;
+ }
chop($pid = <PID>);
close(PID);
- $pid || &error("Invalid PID file $miniserv{'pidfile'}");
+ if (!$pid) {
+ print STDERR "Invalid PID file $miniserv{'pidfile'}\n";
+ return;
+ }
+ if (!kill(0, $pid)) {
+ print STDERR "PID $pid from file $miniserv{'pidfile'} ",
+ "is not valid\n";
+ return;
+ }
}
&kill_logged('USR1', $pid) || &error("Incorrect Webmin PID $pid");
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
}
-=head2 ftp_download(host, file, destfile, [&error], [&callback], [user, pass], [port])
+=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 :
=item port - FTP server port number, which defaults to 21 if not set.
+=item no-cache - If set to 1, Webmin's internal caching for this URL is disabled.
+
=cut
sub ftp_download
{
-my ($host, $file, $dest, $error, $cbfunc, $user, $pass, $port) = @_;
+my ($host, $file, $dest, $error, $cbfunc, $user, $pass, $port, $nocache) = @_;
$port ||= 21;
if ($gconfig{'debug_what_net'}) {
&webmin_debug_log('FTP', "host=$host port=$port file=$file".
# Check if we already have cached the URL
my $url = "ftp://".$host.$file;
my $cfile = &check_in_http_cache($url);
-if ($cfile) {
+if ($cfile && !$nocache) {
# Yes! Copy to dest file or variable
&$cbfunc(6, $url) if ($cbfunc);
if (ref($dest)) {
print SOCK "Proxy-Authorization: Basic $auth\r\n";
}
print SOCK "\r\n";
- &complete_http_download({ 'fh' => "SOCK" }, $_[2], $_[3], $_[4]);
+ &complete_http_download({ 'fh' => "SOCK" }, $_[2], $_[3], $_[4],
+ undef, undef, undef, undef, 0, $nocache);
$connected = 1;
}
elsif (!$gconfig{'proxy_fallback'}) {
return defined(&$func);
}
-=head2 get_system_hostname([short])
+=head2 get_system_hostname([short], [skip-file])
Returns the hostname of this system. If the short parameter is set to 1,
then the domain name is not prepended - otherwise, Webmin will attempt to get
sub get_system_hostname
{
my $m = int($_[0]);
+my $skipfile = $_[1];
if (!$main::get_system_hostname[$m]) {
if ($gconfig{'os_type'} ne 'windows') {
# Try some common Linux hostname files first
my $fromfile;
- if ($gconfig{'os_type'} eq 'redhat-linux') {
+ if ($skipfile) {
+ # Never get from file
+ }
+ elsif ($gconfig{'os_type'} eq 'redhat-linux') {
my %nc;
&read_env_file("/etc/sysconfig/network", \%nc);
if ($nc{'HOSTNAME'}) {
}
}
- # If we found a hostname, use it if value
+ # If we found a hostname in a file, use it
if ($fromfile && ($m || $fromfile =~ /\./)) {
if ($m) {
$fromfile =~ s/\..*$//;
$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' ? ';' : ':';
}
}
+# 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);
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;
}
}
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'};
}
}
&read_file_cached("$config_directory/custom-lang", \%text);
+foreach my $o (@lang_order_list) {
+ next if ($o eq "en");
+ &read_file_cached("$config_directory/custom-lang.$o", \%text);
+ }
my $norefs = $text{'__norefs'};
if ($_[0]) {
}
}
&read_file_cached("$config_directory/$_[0]/custom-lang", \%text);
+ foreach my $o (@lang_order_list) {
+ next if ($o eq "en");
+ &read_file_cached("$config_directory/$_[0]/custom-lang.$o",
+ \%text);
+ }
$norefs = $text{'__norefs'} if ($norefs);
}
$rv{'realdesc'} = $rv{'desc'};
my %descs;
&read_file_cached("$config_directory/webmin.descs", \%descs);
-if ($descs{$_[0]." ".$current_lang}) {
- $rv{'desc'} = $descs{$_[0]." ".$current_lang};
- }
-elsif ($descs{$_[0]}) {
+if ($descs{$_[0]}) {
$rv{'desc'} = $descs{$_[0]};
}
+foreach my $o (@lang_order_list) {
+ my $ov = $descs{$_[0]." ".$o} || $descs{$_[0]."_".$o};
+ $rv{'desc'} = $ov if ($ov);
+ }
if (!$_[2]) {
# Apply per-user description overridde
$cache{'mtime_'.$r} = $st[9];
}
$cache{'lang'} = $current_lang;
- &write_file($cache_file, \%cache) if (!$_[0] && $< == 0 && $> == 0);
+ if (!$_[0] && $< == 0 && $> == 0) {
+ eval {
+ # Don't fail if cache write fails
+ local $main::error_must_die = 1;
+ &write_file($cache_file, \%cache);
+ }
+ }
}
# Override descriptions for modules for current user
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.
return @main::list_languages_cache;
}
-=head2 read_env_file(file, &hash)
+=head2 read_env_file(file, &hash, [include-commented])
Similar to Webmin's read_file function, but handles files containing shell
environment variables formatted like :
local $_;
&open_readfile(FILE, $_[0]) || return 0;
while(<FILE>) {
+ if ($_[2]) {
+ # Remove start of line comments
+ s/^\s*#+\s*//;
+ }
s/#.*$//g;
if (/^\s*(export\s*)?([A-Za-z0-9_\.]+)\s*=\s*"(.*)"/i ||
/^\s*(export\s*)?([A-Za-z0-9_\.]+)\s*=\s*'(.*)'/i ||
my @tm = localtime($now);
my $script_name = $0 =~ /([^\/]+)$/ ? $1 : '-';
my $id = sprintf "%d.%d.%d", $now, $$, $main::action_id_count;
+my $idprefix = substr($now, 0, 5);
$main::action_id_count++;
my $line = sprintf "%s [%2.2d/%s/%4.4d %2.2d:%2.2d:%2.2d] %s %s %s %s %s \"%s\" \"%s\" \"%s\"",
$id, $tm[3], ucfirst($number_to_month_map{$tm[4]}), $tm[5]+1900,
my $i = 0;
mkdir("$ENV{'WEBMIN_VAR'}/diffs", 0700);
foreach my $d (@main::locked_file_diff) {
- mkdir("$ENV{'WEBMIN_VAR'}/diffs/$id", 0700);
- open(DIFFLOG, ">$ENV{'WEBMIN_VAR'}/diffs/$id/$i");
+ mkdir("$ENV{'WEBMIN_VAR'}/diffs/$idprefix", 0700);
+ mkdir("$ENV{'WEBMIN_VAR'}/diffs/$idprefix/$id", 0700);
+ open(DIFFLOG, ">$ENV{'WEBMIN_VAR'}/diffs/$idprefix/$id/$i");
print DIFFLOG "$d->{'type'} $d->{'object'}\n";
print DIFFLOG $d->{'data'};
close(DIFFLOG);
if ($d->{'input'}) {
- open(DIFFLOG, ">$ENV{'WEBMIN_VAR'}/diffs/$id/$i.input");
+ open(DIFFLOG,
+ ">$ENV{'WEBMIN_VAR'}/diffs/$idprefix/$id/$i.input");
print DIFFLOG $d->{'input'};
close(DIFFLOG);
}
if ($gconfig{'logperms'}) {
chmod(oct($gconfig{'logperms'}),
- "$ENV{'WEBMIN_VAR'}/diffs/$id/$i",
- "$ENV{'WEBMIN_VAR'}/diffs/$id/$i.input");
+ "$ENV{'WEBMIN_VAR'}/diffs/$idprefix/$id/$i",
+ "$ENV{'WEBMIN_VAR'}/diffs/$idprefix/$id/$i.input");
}
$i++;
}
my $i = 0;
mkdir("$ENV{'WEBMIN_VAR'}/files", 0700);
foreach my $f (keys %main::orig_file_data) {
- mkdir("$ENV{'WEBMIN_VAR'}/files/$id", 0700);
- open(ORIGLOG, ">$ENV{'WEBMIN_VAR'}/files/$id/$i");
+ mkdir("$ENV{'WEBMIN_VAR'}/files/$idprefix", 0700);
+ mkdir("$ENV{'WEBMIN_VAR'}/files/$idprefix/$id", 0700);
+ open(ORIGLOG, ">$ENV{'WEBMIN_VAR'}/files/$idprefix/$id/$i");
if (!defined($main::orig_file_type{$f})) {
print ORIGLOG -1," ",$f,"\n";
}
close(ORIGLOG);
if ($gconfig{'logperms'}) {
chmod(oct($gconfig{'logperms'}),
- "$ENV{'WEBMIN_VAR'}/files/$id.$i");
+ "$ENV{'WEBMIN_VAR'}/files/$idprefix/$id.$i");
}
$i++;
}
if ($miniserv::page_capture_out) {
# Save the whole page output
mkdir("$ENV{'WEBMIN_VAR'}/output", 0700);
- open(PAGEOUT, ">$ENV{'WEBMIN_VAR'}/output/$id");
+ mkdir("$ENV{'WEBMIN_VAR'}/output/$idprefix", 0700);
+ open(PAGEOUT, ">$ENV{'WEBMIN_VAR'}/output/$idprefix/$id");
print PAGEOUT $miniserv::page_capture_out;
close(PAGEOUT);
if ($gconfig{'logperms'}) {
chmod(oct($gconfig{'logperms'}),
- "$ENV{'WEBMIN_VAR'}/output/$id");
+ "$ENV{'WEBMIN_VAR'}/output/$idprefix/$id");
}
$miniserv::page_capture_out = undef;
}
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();
}
}
+=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
&nice_size($progress_size)),"<br>\n";
}
else {
+ $progress_size = undef;
print &text('progress_nosize', $progress_callback_url),"<br>\n";
}
$last_progress_time = $last_progress_size = undef;
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);
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.
projects / webmin.git / blobdiff