Gecko [ thearyasamaj.org ]

Name	Size	Permission
acl	[ DIR ]	drwxr-xr-x
adsl-client	[ DIR ]	drwxr-xr-x
apache	[ DIR ]	drwxr-xr-x
at	[ DIR ]	drwxr-xr-x
authentic-theme	[ DIR ]	drwxr-xr-x
backup-config	[ DIR ]	drwxr-xr-x
bacula-backup	[ DIR ]	drwxr-xr-x
bandwidth	[ DIR ]	drwxr-xr-x
bin	[ DIR ]	drwxr-xr-x
bind8	[ DIR ]	drwxr-xr-x
blue-theme	[ DIR ]	drwxr-xr-x
change-user	[ DIR ]	drwxr-xr-x
cluster-copy	[ DIR ]	drwxr-xr-x
cluster-cron	[ DIR ]	drwxr-xr-x
cluster-passwd	[ DIR ]	drwxr-xr-x
cluster-shell	[ DIR ]	drwxr-xr-x
cluster-software	[ DIR ]	drwxr-xr-x
cluster-useradmin	[ DIR ]	drwxr-xr-x
cluster-usermin	[ DIR ]	drwxr-xr-x
cluster-webmin	[ DIR ]	drwxr-xr-x
cpan	[ DIR ]	drwxr-xr-x
cron	[ DIR ]	drwxr-xr-x
custom	[ DIR ]	drwxr-xr-x
dfsadmin	[ DIR ]	drwxr-xr-x
dhcpd	[ DIR ]	drwxr-xr-x
dovecot	[ DIR ]	drwxr-xr-x
exim	[ DIR ]	drwxr-xr-x
exports	[ DIR ]	drwxr-xr-x
fail2ban	[ DIR ]	drwxr-xr-x
fdisk	[ DIR ]	drwxr-xr-x
fetchmail	[ DIR ]	drwxr-xr-x
filemin	[ DIR ]	drwxr-xr-x
filter	[ DIR ]	drwxr-xr-x
firewall	[ DIR ]	drwxr-xr-x
firewall6	[ DIR ]	drwxr-xr-x
firewalld	[ DIR ]	drwxr-xr-x
fsdump	[ DIR ]	drwxr-xr-x
gray-theme	[ DIR ]	drwxr-xr-x
grub	[ DIR ]	drwxr-xr-x
heartbeat	[ DIR ]	drwxr-xr-x
htaccess-htpasswd	[ DIR ]	drwxr-xr-x
idmapd	[ DIR ]	drwxr-xr-x
images	[ DIR ]	drwxr-xr-x
inetd	[ DIR ]	drwxr-xr-x
init	[ DIR ]	drwxr-xr-x
inittab	[ DIR ]	drwxr-xr-x
ipfilter	[ DIR ]	drwxr-xr-x
ipfw	[ DIR ]	drwxr-xr-x
ipsec	[ DIR ]	drwxr-xr-x
iscsi-client	[ DIR ]	drwxr-xr-x
iscsi-server	[ DIR ]	drwxr-xr-x
iscsi-target	[ DIR ]	drwxr-xr-x
iscsi-tgtd	[ DIR ]	drwxr-xr-x
jabber	[ DIR ]	drwxr-xr-x
jailkit	[ DIR ]	drwxr-xr-x
krb5	[ DIR ]	drwxr-xr-x
lang	[ DIR ]	drwxr-xr-x
ldap-client	[ DIR ]	drwxr-xr-x
ldap-server	[ DIR ]	drwxr-xr-x
ldap-useradmin	[ DIR ]	drwxr-xr-x
logrotate	[ DIR ]	drwxr-xr-x
logviewer	[ DIR ]	drwxr-xr-x
lpadmin	[ DIR ]	drwxr-xr-x
lvm	[ DIR ]	drwxr-xr-x
mailboxes	[ DIR ]	drwxr-xr-x
mailcap	[ DIR ]	drwxr-xr-x
man	[ DIR ]	drwxr-xr-x
mon	[ DIR ]	drwxr-xr-x
mount	[ DIR ]	drwxr-xr-x
mysql	[ DIR ]	drwxr-xr-x
net	[ DIR ]	drwxr-xr-x
nis	[ DIR ]	drwxr-xr-x
openslp	[ DIR ]	drwxr-xr-x
package-updates	[ DIR ]	drwxr-xr-x
pam	[ DIR ]	drwxr-xr-x
pap	[ DIR ]	drwxr-xr-x
passwd	[ DIR ]	drwxr-xr-x
php-pear	[ DIR ]	drwxr-xr-x
phpini	[ DIR ]	drwxr-xr-x
postfix	[ DIR ]	drwxr-xr-x
postgresql	[ DIR ]	drwxr-xr-x
ppp-client	[ DIR ]	drwxr-xr-x
pptp-client	[ DIR ]	drwxr-xr-x
pptp-server	[ DIR ]	drwxr-xr-x
proc	[ DIR ]	drwxr-xr-x
procmail	[ DIR ]	drwxr-xr-x
proftpd	[ DIR ]	drwxr-xr-x
qmailadmin	[ DIR ]	drwxr-xr-x
quota	[ DIR ]	drwxr-xr-x
raid	[ DIR ]	drwxr-xr-x
ruby-gems	[ DIR ]	drwxr-xr-x
samba	[ DIR ]	drwxr-xr-x
sarg	[ DIR ]	drwxr-xr-x
sendmail	[ DIR ]	drwxr-xr-x
servers	[ DIR ]	drwxr-xr-x
shell	[ DIR ]	drwxr-xr-x
shorewall	[ DIR ]	drwxr-xr-x
shorewall6	[ DIR ]	drwxr-xr-x
smart-status	[ DIR ]	drwxr-xr-x
smf	[ DIR ]	drwxr-xr-x
software	[ DIR ]	drwxr-xr-x
spam	[ DIR ]	drwxr-xr-x
squid	[ DIR ]	drwxr-xr-x
sshd	[ DIR ]	drwxr-xr-x
status	[ DIR ]	drwxr-xr-x
stunnel	[ DIR ]	drwxr-xr-x
syslog	[ DIR ]	drwxr-xr-x
syslog-ng	[ DIR ]	drwxr-xr-x
system-status	[ DIR ]	drwxr-xr-x
tcpwrappers	[ DIR ]	drwxr-xr-x
time	[ DIR ]	drwxr-xr-x
tunnel	[ DIR ]	drwxr-xr-x
unauthenticated	[ DIR ]	drwxr-xr-x
updown	[ DIR ]	drwxr-xr-x
useradmin	[ DIR ]	drwxr-xr-x
usermin	[ DIR ]	drwxr-xr-x
vendor_perl	[ DIR ]	drwxr-xr-x
vgetty	[ DIR ]	drwxr-xr-x
virtual-server	[ DIR ]	drwxr-xr-x
virtualmin-awstats	[ DIR ]	drwxr-xr-x
virtualmin-git	[ DIR ]	drwxr-xr-x
virtualmin-htpasswd	[ DIR ]	drwxr-xr-x
virtualmin-init	[ DIR ]	drwxr-xr-x
virtualmin-registrar	[ DIR ]	drwxr-xr-x
virtualmin-slavedns	[ DIR ]	drwxr-xr-x
virtualmin-sqlite	[ DIR ]	drwxr-xr-x
webalizer	[ DIR ]	drwxr-xr-x
webmin	[ DIR ]	drwxr-xr-x
webmincron	[ DIR ]	drwxr-xr-x
webminlog	[ DIR ]	drwxr-xr-x
wuftpd	[ DIR ]	drwxr-xr-x
xinetd	[ DIR ]	drwxr-xr-x
xterm	[ DIR ]	drwxr-xr-x
LICENCE	1.48 KB	-rw-r--r--
LICENCE.ja	1.62 KB	-rw-r--r--
README.md	4.01 KB	-rw-r--r--
WebminCore.pm	7.78 KB	-rw-r--r--
acl_security.pl	4.51 KB	-rwxr-xr-x
changepass.pl	868 B	-rwxr-xr-x
chooser.cgi	7.21 KB	-rwxr-xr-x
config-aix	227 B	-rw-r--r--
config-cobalt-linux	264 B	-rw-r--r--
config-coherent-linux	264 B	-rw-r--r--
config-corel-linux	264 B	-rw-r--r--
config-debian-linux	264 B	-rw-r--r--
config-freebsd	256 B	-rw-r--r--
config-generic-linux	264 B	-rw-r--r--
config-gentoo-linux	264 B	-rw-r--r--
config-hpux	243 B	-rw-r--r--
config-irix	284 B	-rw-r--r--
config-lib.pl	10.82 KB	-rwxr-xr-x
config-macos	260 B	-rw-r--r--
config-mandrake-linux	278 B	-rw-r--r--
config-msc-linux	264 B	-rw-r--r--
config-netbsd	283 B	-rw-r--r--
config-open-linux	264 B	-rw-r--r--
config-openbsd	241 B	-rw-r--r--
config-openmamba-linux	264 B	-rw-r--r--
config-openserver	236 B	-rw-r--r--
config-osf1	266 B	-rw-r--r--
config-pardus-linux	264 B	-rw-r--r--
config-redhat-linux	264 B	-rw-r--r--
config-slackware-linux	280 B	-rw-r--r--
config-sol-linux	264 B	-rw-r--r--
config-solaris	417 B	-rw-r--r--
config-suse-linux	264 B	-rw-r--r--
config-syno-linux	364 B	-rw-r--r--
config-trustix-linux	264 B	-rw-r--r--
config-turbo-linux	264 B	-rw-r--r--
config-united-linux	264 B	-rw-r--r--
config-unixware	286 B	-rw-r--r--
config-windows	88 B	-rw-r--r--
config.cgi	1.55 KB	-rwxr-xr-x
config_save.cgi	1.64 KB	-rwxr-xr-x
copyconfig.pl	4.33 KB	-rwxr-xr-x
create-module.pl	3.82 KB	-rwxr-xr-x
date_chooser.cgi	2.19 KB	-rwxr-xr-x
defaultacl	98 B	-rw-r--r--
defaulttheme	16 B	-rw-r--r--
entities_map.txt	1.47 KB	-rw-r--r--
fastrpc.cgi	10.59 KB	-rwxr-xr-x
favicon.ico	14.73 KB	-rw-r--r--
feedback.cgi	6.37 KB	-rwxr-xr-x
feedback_form.cgi	3.45 KB	-rwxr-xr-x
group_chooser.cgi	7.36 KB	-rwxr-xr-x
help.cgi	2.94 KB	-rwxr-xr-x
index.cgi	5.61 KB	-rwxr-xr-x
install-module.pl	1.54 KB	-rwxr-xr-x
install-type	4 B	-rw-r--r--
javascript-lib.pl	14.69 KB	-rwxr-xr-x
lang_list.txt	3.41 KB	-rw-r--r--
maketemp.pl	424 B	-rwxr-xr-x
mime.types	12.42 KB	-rw-r--r--
miniserv.pem	2.9 KB	-rw-r--r--
miniserv.pl	178.95 KB	-rwxr-xr-x
module_chooser.cgi	4.14 KB	-rwxr-xr-x
newmods.pl	1.25 KB	-rwxr-xr-x
os_list.txt	34.02 KB	-rw-r--r--
oschooser.pl	4.55 KB	-rwxr-xr-x
pam_login.cgi	2.83 KB	-rwxr-xr-x
password_change.cgi	7 KB	-rwxr-xr-x
password_form.cgi	1.3 KB	-rwxr-xr-x
perlpath.pl	571 B	-rwxr-xr-x
record-failed.pl	503 B	-rwxr-xr-x
record-login.pl	513 B	-rwxr-xr-x
record-logout.pl	516 B	-rwxr-xr-x
robots.txt	26 B	-rw-r--r--
rpc.cgi	4 KB	-rwxr-xr-x
run-postinstalls.pl	1 KB	-rwxr-xr-x
run-uninstalls.pl	1004 B	-rwxr-xr-x
safeacl	44 B	-rw-r--r--
session_login.cgi	3.55 KB	-rwxr-xr-x
setup-repos.sh	4.48 KB	-rwxr-xr-x
setup.bat	3.09 KB	-rw-r--r--
setup.pl	30.26 KB	-rwxr-xr-x
setup.sh	32 KB	-rwxr-xr-x
switch_skill.cgi	293 B	-rwxr-xr-x
switch_user.cgi	404 B	-rwxr-xr-x
thirdparty.pl	1.73 KB	-rwxr-xr-x
ui-lib.pl	82.48 KB	-rwxr-xr-x
update-from-repo.sh	14.8 KB	-rwxr-xr-x
uptracker.cgi	2.88 KB	-rwxr-xr-x
user_chooser.cgi	7.29 KB	-rwxr-xr-x
version	6 B	-rw-r--r--
web-lib-funcs.pl	330.73 KB	-rwxr-xr-x
web-lib.pl	907 B	-rwxr-xr-x
webmin-daemon	80 B	-rw-r--r--
webmin-debian-pam	104 B	-rw-r--r--
webmin-init	1.93 KB	-rwxr-xr-x
webmin-pam	101 B	-rw-r--r--
webmin-search-lib.pl	9.42 KB	-rwxr-xr-x
webmin-systemd	351 B	-rw-r--r--
webmin_search.cgi	2.63 KB	-rwxr-xr-x
xmlrpc.cgi	7.53 KB	-rwxr-xr-x

Code Editor : web-lib-funcs.pl

=head1 web-lib-funcs.pl

Common functions for Webmin CGI scripts. This file gets in-directly included
by all scripts that use web-lib.pl.
Example code:

use WebminCore;
  init_config();
  ui_print_header(undef, 'My Module', '');
  print 'This is Webmin version ',get_webmin_version(),'<p>\n';
  ui_print_footer();

=cut

##use warnings;
use Socket;
use POSIX;
use feature 'state';
eval "use Socket6";
$ipv6_module_error = $@;
our $error_handler_funcs = [ ];

use vars qw($loaded_theme_library $wait_for_input
	    $done_webmin_header $trust_unknown_referers $unsafe_index_cgi
	    %done_foreign_require $webmin_feedback_address
	    $pragma_no_cache $foreign_args);
# Globals
use vars qw($module_index_name $number_to_month_map $month_to_number_map
	    $umask_already $default_charset $licence_status $os_type
	    $licence_message $script_name $loaded_theme_oo_library
	    $done_web_lib_funcs $os_version $module_index_link
	    $called_from_webmin_core $ipv6_module_error);

=head2 read_file(file, &hash, [&order], [lowercase], [split-char])

Fill the given hash reference with name=value pairs from a file. The required
parameters are :

=item file - The file to head, which must be text with each line like name=value

=item hash - The hash reference to add values read from the file to.

=item order - If given, an array reference to add names to in the order they were read

=item lowercase - If set to 1, names are converted to lower case

=item split-char - If set, names and values are split on this character instead of =

=cut
sub read_file
{
my ($file, $hash, $order, $lowercase, $split) = @_;
$split = "=" if (!defined($split));
my $realfile = &translate_filename($file);
&open_readfile(ARFILE, $file) || return 0;
local $_;
while(<ARFILE>) {
	s/\r|\n//g;
	my $cmt = index($_, "#");
	my $eq = index($_, $split);
	if ($cmt != 0 && $eq >= 0) {
		my $n = substr($_, 0, $eq);
		my $v = substr($_, $eq+1);
		chomp($v);
		$hash->{$lowercase ? lc($n) : $n} = $v;
		push(@$order, $n) if ($order);
        	}
        }
close(ARFILE);
$main::read_file_missing{$realfile} = 0;	# It exists now
if (defined($main::read_file_cache{$realfile})) {
	%{$main::read_file_cache{$realfile}} = %$hash;
	}
return 1;
}

=head2 read_file_cached(file, &hash, [&order], [lowercase], [split-char])

Like read_file, but reads from an in-memory cache if the file has already been
read in this Webmin script. Recommended, as it behaves exactly the same as
read_file, but can be much faster.

=cut
sub read_file_cached
{
my $realfile = &translate_filename($_[0]);
if (defined($main::read_file_cache{$realfile})) {
	# Use cached data
	%{$_[1]} = ( %{$_[1]}, %{$main::read_file_cache{$realfile}} );
	return 1;
	}
elsif ($main::read_file_missing{$realfile}) {
	# Doesn't exist, so don't re-try read
	return 0;
	}
else {
	# Actually read the file
	my %d;
	if (&read_file($_[0], \%d, $_[2], $_[3], $_[4])) {
		%{$main::read_file_cache{$realfile}} = %d;
		%{$_[1]} = ( %{$_[1]}, %d );
		return 1;
		}
	else {
		# Flag as non-existant
		$main::read_file_missing{$realfile} = 1;
		return 0;
		}
	}
}

=head2 read_file_cached_with_stat(file, &hash, [&order], [lowercase], [split-char])

Like read_file, but reads from an in-memory cache if the file has already been
read in this Webmin script AND has not changed.

=cut
sub read_file_cached_with_stat
{
my $realfile = &translate_filename($_[0]);
my $t = $main::read_file_cache_time{$realfile};
my @st = stat($realfile);
if ($t && $st[9] != $t) {
	# Changed, invalidate cache
	delete($main::read_file_cache{$realfile});
	}
my $rv = &read_file_cached(@_);
$main::read_file_cache_time{$realfile} = $st[9];
return $rv;
}

=head2 write_file(file, &data-hash, [join-char], [sort], [sorted-by], [sorted-by-preserved])

Write out the contents of a hash as name=value lines. The parameters are :

=item file - Full path to write to

=item data-hash - A hash reference containing names and values to output

=item join-char - If given, names and values are separated by this instead of =

=item sort - If given, passed hash reference will be sorted by its keys

=item sorted-by - If given, passed as full path to a file, will use its content to sort the keys

=item sorted-by-sectioning-preserved - If sorted-by is used, then preserve the sectioning (line-breaks), and section comment as in hash reference

=cut
sub write_file
{
my ($file, 
    $data_hash,
    $join_char,
    $sort,
    $sorted_by,
    $sorted_by_sectioning_preserved) = @_;
my (%old, @order);
my $join = defined($join_char) ? $join_char : "=";
my $realfile = &translate_filename($file);
&read_file($sorted_by || $file, \%old, \@order);
&open_tempfile(ARFILE, ">$file");
if ($sort || $gconfig{'sortconfigs'}) {
	# Always sort by keys
	foreach $k (sort keys %{$data_hash}) {
		(print ARFILE $k,$join,$data_hash->{$k},"\n") ||
			&error(&text("efilewrite", $realfile, $!));
		}
	}
else {
	# Where possible, write out in the original order
	my %done;
	foreach $k (@order) {
		if (exists($data_hash->{$k}) && !$done{$k}++) {
			(print ARFILE $k,$join,$data_hash->{$k},"\n") ||
				&error(&text("efilewrite", $realfile, $!));
			}
		}
	foreach $k (keys %{$data_hash}) {
		if (!exists($old{$k}) && !$done{$k}++) {
			(print ARFILE $k,$join,$data_hash->{$k},"\n") ||
				&error(&text("efilewrite", $realfile, $!));
			}
		}
	}
&close_tempfile(ARFILE, %{$data_hash} ? 1 : 0);

# Update in-memory caches
if (defined($main::read_file_cache{$realfile})) {
    %{$main::read_file_cache{$realfile}} = %{$data_hash};
    }
if (defined($main::read_file_missing{$realfile})) {
    $main::read_file_missing{$realfile} = 0;
    }

if ($sorted_by && $sorted_by_sectioning_preserved) {
	my $target = read_file_contents($file);
	my $model = read_file_contents($sorted_by);

# Extract version related comments for a block, e.g. #1.962
	my %comments = reverse ($model =~ m/(#\s*[\d\.]+)[\n\s]+(.*?)=/gm);

# Build blocks of line's key separated with a new line break
	my @lines = (($model =~ m/(.*?)$join|(^\s*$)/gm), undef, undef);
	my @blocks;
	my @block;
	for (my $line = 0; $line < scalar(@lines) - 1; $line += 2) {
		if ($lines[$line] =~ /\S+/) {
			push(@block, $lines[$line]);
			}
		else {
			push(@blocks, [@block]);
			@block = ();
			}
		}
	for (my $block = 0; $block <= scalar(@blocks) - 1; $block++) {
		foreach my $line (@{$blocks[$block]}) {
			# Add a comment to the first block element
			if ($target =~ /(\Q$line\E)=(.*)/) {
				foreach my $comment (keys %comments) {
					if (grep(/^\Q$comment\E$/, @{$blocks[$block]})) {
						$target =~ s/(\Q$line\E)=(.*)/$comments{$comment}\n$1=$2/;
						last;
					}
				}
			last;
			}
		}
		foreach my $line (reverse @{$blocks[$block]}) {
			if (
			    # Go to another block immediately
			    # if new line already exists
			    $target =~ /(\Q$line\E)$join.*?(\r?\n|\r\n?)+$/m ||

# Add new line to the last element of
			    # the block and go to another block
			    $target =~ s/(\Q$line\E)$join(.*)/$1=$2\n/) {
				last;
				}
			}
		}
		&write_file_contents($file, $target);
	}
}

=head2 html_escape(string)

Converts &, < and > codes in text to HTML entities, and returns the new string.
This should be used when including data read from other sources in HTML pages.

=cut
sub html_escape
{
my ($tmp) = @_;
if (!defined $tmp) {
    return ''; # empty string
};
$tmp =~ s/&/&amp;/g;
$tmp =~ s/</&lt;/g;
$tmp =~ s/>/&gt;/g;
$tmp =~ s/\"/&quot;/g;
$tmp =~ s/\'/&#39;/g;
$tmp =~ s/=/&#61;/g;
return $tmp;
}

=head2 html_strip(string, replacement)

Removes any HTML from a string, replacing with nothing or given chars

=cut
sub html_strip
{
my ($str, $replacement) = @_;
$replacement ||= "";
$str =~ s/<(?:[^>'"]*|(['"]).*?\1)*>/$replacement/gs;
return $str;
}

=head2 quote_escape(string, [only-quote])

Converts ' and " characters in a string into HTML entities, and returns it.
Useful for outputting HTML tag values.

=cut
sub quote_escape
{
my ($tmp, $only) = @_;
if (!defined $tmp) {
    return ''; # empty string
};
if ($tmp !~ /\&[a-zA-Z]+;/ && $tmp !~ /\&#/) {
	# convert &, unless it is part of &#nnn; or &foo;
	$tmp =~ s/&([^#])/&amp;$1/g;
	}
$tmp =~ s/&$/&amp;/g;
$tmp =~ s/\"/&quot;/g if (!$only || $only eq '"');
$tmp =~ s/\'/&#39;/g if (!$only || $only eq "'");
return $tmp;
}

=head2 quote_javascript(string)

Quote all characters that are unsafe for inclusion in javascript strings in HTML

=cut
sub quote_javascript
{
my ($str) = @_;
$str =~ s/["'<>&\\]/sprintf('\x%02x', ord $&)/ge;
return $str;
}

=head2 tempname_dir()

Returns the base directory under which temp files can be created.

=cut
sub tempname_dir
{
my $tmp_base = $gconfig{'tempdir_'.&get_module_name()} ?
			$gconfig{'tempdir_'.&get_module_name()} :
		  $gconfig{'tempdir'} ? $gconfig{'tempdir'} :
		  $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;
if (-d $remote_user_info[7] && !$gconfig{'nohometemp'}) {
	$tmp_dir = "$remote_user_info[7]/.tmp";
	}
elsif (@remote_user_info) {
	$tmp_dir = $tmp_base."-".$remote_user_info[2]."-".$remote_user;
	}
elsif ($< != 0) {
	my $u = getpwuid($<);
	if ($u) {
		$tmp_dir = $tmp_base."-".$<."-".$u;
		}
	else {
		$tmp_dir = $tmp_base."-".$<;
		}
	}
else {
	$tmp_dir = $tmp_base;
	}
return $tmp_dir;
}

=head2 tempname([filename])

Returns a mostly random temporary file name, typically under the /tmp/.webmin
directory. If filename is given, this will be the base name used. Otherwise
a unique name is selected randomly.

=cut
sub tempname
{
my ($filename) = @_;
my $tmp_dir = &tempname_dir();
if ($gconfig{'os_type'} eq 'windows' || $tmp_dir =~ /^[a-z]:/i) {
	# On Windows system, just create temp dir if missing
	if (!-d $tmp_dir) {
		mkdir($tmp_dir, 0755) ||
			&error("Failed to create temp directory $tmp_dir : $!");
		}
	}
else {
	# On Unix systems, need to make sure temp dir is valid
	if ($tmp_dir ne "/tmp") {
		my $tries = 0;
		my $mkdirerr;
		while($tries++ < 10) {
			my @st = lstat($tmp_dir);
			last if ($st[4] == $< && (-d _) &&
				 ($st[2] & 0777) == 0755);
			if (@st) {
				unlink($tmp_dir) || rmdir($tmp_dir) ||
					system("/bin/rm -rf ".
					       quotemeta($tmp_dir));
				}
			mkdir($tmp_dir, 0755) || (($mkdirerr = $!), next);
			chown($<, $(, $tmp_dir);
			chmod(0755, $tmp_dir);
			}
		if ($tries >= 10) {
			my @st = lstat($tmp_dir);
			$mkdirerr = $mkdirerr ? " : $mkdirerr" : "";
			&error("Failed to create temp directory ".
			       $tmp_dir.$mkdirerr);
			}
		}
	# If running as root, check parent dir (usually /tmp) to make sure it's
	# world-writable and owned by root
	my $tmp_parent = $tmp_dir;
	$tmp_parent =~ s/\/[^\/]+$//;
	if ($tmp_parent eq "/tmp") {
		my @st = stat($tmp_parent);
		if (($st[2] & 0555) != 0555) {
			&error("Base temp directory $tmp_parent is not world readable and listable");
			}
		}
	}
my $rv;
if (defined($filename) && $filename !~ /\.\./) {
	$rv = "$tmp_dir/$filename";
	}
else {
	$main::tempfilecount++;
	&seed_random();
	$rv = $tmp_dir."/".int(rand(1000000))."_".$$."_".
	       $main::tempfilecount."_".$scriptname;
	}
return $rv;
}

=head2 transname([filename])

Behaves exactly like tempname, but records the temp file for deletion when the
current Webmin script process exits.

=cut
sub transname
{
my $rv = &tempname(@_);
push(@main::temporary_files, $rv);
return $rv;
}

=head2 transname_timestamped([filename], [extension])

Behaves exactly like transname, but returns a filename with current timestamp

=item filename - Optional filename prefix to prepend

=item extension - Optional extension for a filename to append

=cut
sub transname_timestamped
{
my ($fname, $fextension) = @_;
my $fdate = strftime('%Y%m%d_%H%M%S', localtime());
$fname = "${fname}-" if ($fname);
return &transname("$fname$fdate$fextension");
}

=head2 trunc(string, maxlen)

Truncates a string to the shortest whole word less than or equal to the
given width. Useful for word wrapping.

=cut
sub trunc
{
if (length($_[0]) <= $_[1]) {
	return $_[0];
	}
my $str = substr($_[0],0,$_[1]);
my $c;
do {
	$c = chop($str);
	} while($c !~ /\S/);
$str =~ s/\s+$//;
return $str;
}

=head2 indexof(string, value, ...)

Returns the index of some value in an array of values, or -1 if it was not
found.

=cut
sub indexof
{
for(my $i=1; $i <= $#_; $i++) {
	if ($_[$i] eq $_[0]) { return $i - 1; }
	}
return -1;
}

=head2 indexoflc(string, value, ...)

Like indexof, but does a case-insensitive match

=cut
sub indexoflc
{
my $str = lc(shift(@_));
my @arr = map { lc($_) } @_;
return &indexof($str, @arr);
}

=head2 sysprint(handle, [string]+)

Outputs some strings to a file handle, but bypassing IO buffering. Can be used
as a replacement for print when writing to pipes or sockets.

=cut
sub sysprint
{
my $fh = &callers_package($_[0]);
my $str = join('', @_[1..$#_]);
syswrite $fh, $str, length($str);
}

=head2 check_ipaddress(ip)

Check if some IPv4 address is properly formatted, returning 1 if so or 0 if not.

=cut
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;
}

=head2 check_ip6address(ip)

Check if some IPv6 address is properly formatted, and returns 1 if so.

=cut
sub check_ip6address
{
  my @blocks = split(/:/, $_[0]);
  return 0 if (@blocks == 0 || @blocks > 8);

# The address/netmask format is accepted. So we're looking for a "/" to isolate a possible netmask.
  # After that, we delete the netmask to control the address only format, but we verify whether the netmask
  # value is in [0;128].
  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;
  }

# The netmask must take its value in [0;128]
  return 0 if ($m <0 || $m >128);

# Check the different blocks of the address : 16 bits block in hexa notation.
  # Possibility of 1 empty block or 2 if the address begins with "::".
  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;
}

=head2 generate_icon(image, title, link, [href], [width], [height], [before-title], [after-title])

Prints HTML for an icon image. The parameters are :

=item image - URL for the image, like images/foo.gif

=item title - Text to appear under the icon

=item link - Optional destination for the icon's link

=item href - Other HTML attributes to be added to the <a href> for the link

=item width - Optional width of the icon

=item height - Optional height of the icon

=item before-title - HTML to appear before the title link, but which is not actually in the link

=item after-title - HTML to appear after the title link, but which is not actually in the link

=cut
sub generate_icon
{
&load_theme_library();
if (defined(&theme_generate_icon)) {
	&theme_generate_icon(@_);
	return;
	}
my $w = !defined($_[4]) ? "width='48'" : $_[4] ? "width='$_[4]'" : "";
my $h = !defined($_[5]) ? "height='48'" : $_[5] ? "height='$_[5]'" : "";
if ($tconfig{'noicons'}) {
	if ($_[2]) {
		print "$_[6]<a href=\"$_[2]\" $_[3]>$_[1]</a>$_[7]\n";
		}
	else {
		print "$_[6]$_[1]$_[7]\n";
		}
	}
elsif ($_[2]) {
	print "<table border><tr><td width='48' height='48'>\n",
	      "<a href=\"$_[2]\" $_[3]><img src=\"$_[0]\" alt=\"\" border='0' ",
	      "$w $h></a></td></tr></table>\n";
	print "$_[6]<a href=\"$_[2]\" $_[3]>$_[1]</a>$_[7]\n";
	}
else {
	print "<table border><tr><td width='48' height='48'>\n",
	      "<img src=\"$_[0]\" alt=\"\" border='0' $w $h>",
	      "</td></tr></table>\n$_[6]$_[1]$_[7]\n";
	}
}

=head2 urlize

Converts a string to a form ok for putting in a URL, using % escaping.

=cut
sub urlize
{
my ($rv) = @_;
$rv =~ s/([^A-Za-z0-9])/sprintf("%%%2.2X", ord($1))/ge;
return $rv;
}

=head2 un_urlize(string)

Converts a URL-encoded string to it's original contents - the reverse of the
urlize function.

=cut
sub un_urlize
{
my ($rv, $plus) = @_;
if (!$plus) {
	$rv =~ s/\+/ /g;
	}
$rv =~ s/%(..)/pack("c",hex($1))/ge;
return $rv;
}

=head2 include(filename)

Read and output the contents of the given file.

=cut
sub include
{
local $_;
open(INCLUDE, "<".&translate_filename($_[0])) || return 0;
while(<INCLUDE>) {
	print;
	}
close(INCLUDE);
return 1;
}

=head2 copydata(in-handle, out-handle)

Read from one file handle and write to another, until there is no more to read.

=cut
sub copydata
{
my ($in, $out) = @_;
$in = &callers_package($in);
$out = &callers_package($out);
my $buf;
my $bs = &get_buffer_size();
while(read($in, $buf, $bs) > 0) {
	(print $out $buf) || return 0;
	}
return 1;
}

=head2 ReadParseMime([maximum], [&cbfunc, &cbargs], [array-mode])

Read data submitted via a POST request using the multipart/form-data coding,
and store it in the global %in hash. The optional parameters are :

=item maximum - If the number of bytes of input exceeds this number, stop reading and call error.

=item cbfunc - A function reference to call after reading each block of data.

=item cbargs - Additional parameters to the callback function.

=item array-mode - If set to 1, values in %in are arrays. If set to 0, multiple values are joined with \0. If set to 2, only the first value is used.

=cut
sub ReadParseMime
{
my ($max, $cbfunc, $cbargs, $arrays) = @_;
my ($boundary, $line, $name, $got, $file, $count_lines, $max_lines);
my $err = &text('readparse_max', $max);
$ENV{'CONTENT_TYPE'} =~ /boundary=(.*)$/ || &error($text{'readparse_enc'});
if ($ENV{'CONTENT_LENGTH'} && $max && $ENV{'CONTENT_LENGTH'} > $max) {
	&error($err);
	}
&$cbfunc(0, $ENV{'CONTENT_LENGTH'}, $file, @$cbargs) if ($cbfunc);
$boundary = $1;
$count_lines = 0;
$max_lines = 1000;
<STDIN>;	# skip first boundary
while(1) {
	$name = "";
	# Read section headers
	my $lastheader;
	while(1) {
		$line = <STDIN>;
		$got += length($line);
		&$cbfunc($got, $ENV{'CONTENT_LENGTH'}, @$cbargs) if ($cbfunc);
		if ($max && $got > $max) {
			&error($err)
			}
		$line =~ tr/\r\n//d;
		last if (!$line);
		if ($line =~ /^(\S+):\s*(.*)$/) {
			$header{$lastheader = lc($1)} = $2;
			}
		elsif ($line =~ /^\s+(.*)$/) {
			$header{$lastheader} .= $line;
			}
		}

# Parse out filename and type
	my $file;
	if ($header{'content-disposition'} =~ /^form-data(.*)/) {
		$rest = $1;
		while ($rest =~ /([a-zA-Z]*)=\"([^\"]*)\"(.*)/) {
			if ($1 eq 'name') {
				$name = $2;
				}
			else {
				my $foo = $name."_".$1;
				if ($1 eq "filename") {
					$file = $2;
					}
				if ($arrays == 1) {
					$in{$foo} ||= [];
					push(@{$in{$foo}}, $2);
					}
				elsif ($arrays == 2) {
					$in{$foo} ||= $2;
					}
				else {
					$in{$foo} .= "\0"
						if (defined($in{$foo}));
					$in{$foo} .= $2;
					}
				}
			$rest = $3;
			}
		}
	else {
		&error($text{'readparse_cdheader'});
		}

# Save content type separately
	if ($header{'content-type'} =~ /^([^\s;]+)/) {
		my $foo = $name."_content_type";
		if ($arrays == 1) {
			$in{$foo} ||= [];
			push(@{$in{$foo}}, $1);
			}
		elsif ($arrays == 2) {
			$in{$foo} ||= $1;
			}
		else {
			$in{$foo} .= "\0" if (defined($in{$foo}));
			$in{$foo} .= $1;
			}
		}

# Read data
	my $data = "";
	while(1) {
		$line = <STDIN>;
		$got += length($line);
		$count_lines++;
		if ($count_lines == $max_lines) {
			&$cbfunc($got, $ENV{'CONTENT_LENGTH'}, $file, @$cbargs)
				if ($cbfunc);
			$count_lines = 0;
			}
		if ($max && $got > $max) {
			#print STDERR "over limit of $max\n";
			#&error($err);
			}
		if (!$line) {
			# Unexpected EOF?
			&$cbfunc(-1, $ENV{'CONTENT_LENGTH'}, $file, @$cbargs)
				if ($cbfunc);
			return;
			}
		if (index($line, $boundary) != -1) { last; }
		$data .= $line;
		}
	chop($data); chop($data);
	if ($arrays == 1) {
		$in{$name} ||= [];
		push(@{$in{$name}}, $data);
		}
	elsif ($arrays == 2) {
		$in{$name} ||= $data;
		}
	else {
		$in{$name} .= "\0" if (defined($in{$name}));
		$in{$name} .= $data;
		}
	if (index($line,"$boundary--") != -1) { last; }
	}
&$cbfunc(-1, $ENV{'CONTENT_LENGTH'}, $file, @$cbargs) if ($cbfunc);
}

=head2 ReadParse([&hash], [method], [noplus], [array-mode])

Fills the given hash reference with CGI parameters, or uses the global hash
%in if none is given. Also sets the global variables $in and @in. The other
parameters are :

=item method - For use of this HTTP method, such as GET

=item noplus - Don't convert + in parameters to spaces.

=item array-mode - If set to 1, values in %in are arrays. If set to 0, multiple values are joined with \0. If set to 2, only the first value is used.

=cut
sub ReadParse
{
my $a = $_[0] || \%in;
%$a = ( );
my $meth = $_[1] ? $_[1] : $ENV{'REQUEST_METHOD'};
undef($in);
if ($meth eq 'POST') {
	my $clen = $ENV{'CONTENT_LENGTH'};
	&read_fully(STDIN, \$in, $clen) == $clen ||
		&error("Failed to read POST input : $!");
	}
if ($ENV{'QUERY_STRING'}) {
	if ($in) { $in .= "&".$ENV{'QUERY_STRING'}; }
	else { $in = $ENV{'QUERY_STRING'}; }
	}
@in = split(/\&/, $in);
foreach my $i (@in) {
	$i =~ /\0/ && &error("Null byte in query string");
	my ($k, $v) = split(/=/, $i, 2);
	if (!$_[2]) {
		$k =~ tr/\+/ /;
		$v =~ tr/\+/ /;
		}
	$k =~ s/%(..)/pack("c",hex($1))/ge;
	$v =~ s/%(..)/pack("c",hex($1))/ge;
	if ($_[3] == 1) {
		$a->{$k} ||= [];
		push(@{$a->{$k}}, $v);
		}
	elsif ($_[3] == 2) {
		$a->{$k} ||= $v;
		}
	else {
		$a->{$k} = defined($a->{$k}) ? $a->{$k}."\0".$v : $v;
		}
	}
}

=head2 read_fully(fh, &buffer, length)

Read data from some file handle up to the given length, even in the face
of partial reads. Reads the number of bytes read. Stores received data in the
string pointed to be the buffer reference.

=cut
sub read_fully
{
my ($fh, $buf, $len) = @_;
$fh = &callers_package($fh);
my $got = 0;
while($got < $len) {
	my $r = read(STDIN, $$buf, $len-$got, $got);
	last if ($r <= 0);
	$got += $r;
	}
return $got;
}

=head2 read_parse_mime_callback(size, totalsize, upload-id)

Called by ReadParseMime as new data arrives from a form-data POST. Only updates
the file on every 1% change though. For internal use by the upload progress
tracker.

=cut
sub read_parse_mime_callback
{
my ($size, $totalsize, $filename, $id) = @_;
return if ($gconfig{'no_upload_tracker'});
return if (!$id);

# Create the upload tracking directory - if running as non-root, this has to
# be under the user's home
my $vardir;
if ($<) {
	my @uinfo = @remote_user_info ? @remote_user_info : getpwuid($<);
	$vardir = "$uinfo[7]/.tmp";
	}
else {
	$vardir = $ENV{'WEBMIN_VAR'};
	}
if (!-d $vardir) {
	&make_dir($vardir, 0755);
	}

# Remove any upload.* files more than 1 hour old
if (!$main::read_parse_mime_callback_flushed) {
	my $now = time();
	opendir(UPDIR, $vardir);
	foreach my $f (readdir(UPDIR)) {
		next if ($f !~ /^upload\./);
		my @st = stat("$vardir/$f");
		if ($st[9] < $now-3600) {
			unlink("$vardir/$f");
			}
		}
	closedir(UPDIR);
	$main::read_parse_mime_callback_flushed++;
	}

# Only update file once per percent
my $upfile = "$vardir/upload.$id";
if ($totalsize && $size >= 0) {
	my $pc = int(100 * $size / $totalsize);
	if (defined($main::read_parse_mime_callback_pc{$upfile}) &&
	    $pc <= $main::read_parse_mime_callback_pc{$upfile}) {
		return;
		}
	$main::read_parse_mime_callback_pc{$upfile} = $pc;
	}

# Write to the file
&open_tempfile(UPFILE, ">$upfile");
print UPFILE $size,"\n";
print UPFILE $totalsize,"\n";
print UPFILE $filename,"\n";
&close_tempfile(UPFILE);
}

=head2 read_parse_mime_javascript(upload-id, [&fields])

Returns an onSubmit= Javascript statement to popup a window for tracking
an upload with the given ID. For internal use by the upload progress tracker.

=cut
sub read_parse_mime_javascript
{
my ($id, $fields) = @_;
return "" if ($gconfig{'no_upload_tracker'});
my $opener = "window.open(\"@{[&get_webprefix()]}/uptracker.cgi?id=$id&uid=$<\", \"uptracker\", \"toolbar=no,menubar=no,scrollbars=no,width=500,height=128\");";
if ($fields) {
	my $if = join(" || ", map { "typeof($_) != \"undefined\" && $_.value != \"\"" } @$fields);
	return "onSubmit='if ($if) { $opener }'";
	}
else {
	return "onSubmit='$opener'";
	}
}

=head2 PrintHeader(charset, [mime-type])

Outputs the HTTP headers for an HTML page. The optional charset parameter
can be used to set a character set. Normally this function is not called
directly, but is rather called by ui_print_header or header.

=cut
sub PrintHeader
{
my ($cs, $mt) = @_;
$mt ||= "text/html";
if ($ENV{'SSL_HSTS'} == 1 && uc($ENV{'HTTPS'}) eq "ON") {
	print "Strict-Transport-Security: max-age=31536000;\n";
	}
elsif (uc($ENV{'HTTPS'}) ne "ON") {
	print "Strict-Transport-Security: max-age=0;\n";
	}
if ($pragma_no_cache || $gconfig{'pragma_no_cache'}) {
	print "pragma: no-cache\n";
	print "Expires: Thu, 1 Jan 1970 00:00:00 GMT\n";
	print "Cache-Control: no-store, no-cache, must-revalidate\n";
	print "Cache-Control: post-check=0, pre-check=0\n";
	}
if ($gconfig{'extra_headers'}) {
	foreach my $l (split(/\t+/, $gconfig{'extra_headers'})) {
		print $l."\n";
		}
	}
if (!$gconfig{'no_frame_options'}) {
	print "X-Frame-Options: SAMEORIGIN\n";
	}
if (!$gconfig{'no_content_security_policy'} &&
	 $gconfig{'extra_headers'} !~ /Content-Security-Policy:/) {
	if ($tconfig{'csp_headers'}) {
		print "Content-Security-Policy: $tconfig{'csp_headers'}\n";
		} 
	else {
		print "Content-Security-Policy: script-src 'self' 'unsafe-inline' 'unsafe-eval'; frame-src 'self'; child-src 'self'\n";
		}
	}
print "X-Content-Type-Options: nosniff\n";
if ($tconfig{'nolinks'}) {
	print "X-no-links: 1\n";
	}
if (defined($cs)) {
	print "Content-type: $mt; Charset=$cs\n\n";
	}
else {
	print "Content-type: $mt\n\n";
	}
$main::header_content_type = $mt;
}

=head2 header(title, image, [help], [config], [nomodule], [nowebmin], [rightside], [head-stuff], [body-stuff], [below])

Outputs a Webmin HTML page header with a title, including HTTP headers. The
parameters are :

=item title - The text to show at the top of the page

=item image - An image to show instead of the title text. This is typically left blank.

=item help - If set, this is the name of a help page that will be linked to in the title.

=item config - If set to 1, the title will contain a link to the module's config page.

=item nomodule - If set to 1, there will be no link in the title section to the module's index.

=item nowebmin - If set to 1, there will be no link in the title section to the Webmin index.

=item rightside - HTML to be shown on the right-hand side of the title. Can contain multiple lines, separated by <br>. Typically this is used for links to stop, start or restart servers.

=item head-stuff - HTML to be included in the <head> section of the page.

=item body-stuff - HTML attributes to be include in the <body> tag.

=item below - HTML to be displayed below the title. Typically this is used for application or server version information.

=cut
sub header
{
return if ($main::done_webmin_header++);
my $ll;
my $charset = defined($main::force_charset) ? $main::force_charset
					    : &get_charset();
&PrintHeader($charset);
&load_theme_library();
if (defined(&theme_header)) {
	$module_name = &get_module_name();
	&theme_header(@_);
	$miniserv::page_capture = 1;
	return;
	}
print "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">\n";
print "<html style=\"height:100%\">\n";
print "<head>\n";
if (defined(&theme_prehead)) {
	&theme_prehead(@_);
	}
if ($charset) {
	print "<meta http-equiv=\"Content-Type\" ",
	      "content=\"text/html; Charset=".&quote_escape($charset)."\">\n";
	}
if (@_ > 0) {
	my $title = &get_html_title($_[0]);
        print "<title>$title</title>\n" if ($_[7] !~ /<title>/i);
	print $_[7] if ($_[7]);
	print &get_html_status_line(0);
	}
print "$tconfig{'headhtml'}\n" if ($tconfig{'headhtml'});
if ($tconfig{'headinclude'}) {
	my ($theme, $overlay) = split(' ', $gconfig{'theme'});
	my $file_contents = read_file_contents("$root_directory/$overlay/$tconfig{'headinclude'}");;
	$file_contents = replace_meta($file_contents);
	print $file_contents;
	}
print "</head>\n";
my $bgcolor = defined($tconfig{'cs_page'}) ? $tconfig{'cs_page'} :
		 defined($gconfig{'cs_page'}) ? $gconfig{'cs_page'} : "ffffff";
my $link = defined($tconfig{'cs_link'}) ? $tconfig{'cs_link'} :
	      defined($gconfig{'cs_link'}) ? $gconfig{'cs_link'} : "0000ee";
my $text = defined($tconfig{'cs_text'}) ? $tconfig{'cs_text'} :
	      defined($gconfig{'cs_text'}) ? $gconfig{'cs_text'} : "000000";
my $bgimage = defined($tconfig{'bgimage'}) ? "background=$tconfig{'bgimage'}" : "";
my $dir = $current_lang_info->{'dir'} ? "dir=\"$current_lang_info->{'dir'}\"" : "";
my $html_body = "<body bgcolor=\"#$bgcolor\" link=\"#$link\" vlink=\"#$link\" text=\"#$text\" style=\"height:100%\" $bgimage $tconfig{'inbody'} $dir $_[8]>\n";
$html_body =~ s/\s+\>/>/g;
print $html_body;

if (defined(&theme_prebody)) {
	&theme_prebody(@_);
	}

my $prebody = $tconfig{'prebody'};
if ($prebody) {
	$prebody = replace_meta($prebody);
	print "$prebody\n";
}
if ($tconfig{'prebodyinclude'}) {
	my ($theme, $overlay) = split(' ', $gconfig{'theme'});
	my $file_contents = read_file_contents("$root_directory/$overlay/$tconfig{'prebodyinclude'}");
	$file_contents = replace_meta($file_contents);
	print $file_contents;
	}
if (@_ > 1) {
	print $tconfig{'preheader'};
	my %this_module_info = &get_module_info(&get_module_name());
	print "<table class='header' width='100%'><tr>\n";
	if ($gconfig{'sysinfo'} == 2 && $remote_user) {
		print "<td id='headln1' colspan='3' align='center'>\n";
		print &get_html_status_line(1);
		print "</td></tr> <tr>\n";
		}
	print "<td id='headln2l' width='15%' valign='top' align='left'>";
	if ($ENV{'HTTP_WEBMIN_SERVERS'} && !$tconfig{'framed'}) {
		print "<a href='$ENV{'HTTP_WEBMIN_SERVERS'}'>",
		      "$text{'header_servers'}</a><br>\n";
		}
	if (!$_[5] && !$tconfig{'noindex'}) {
		my @avail = &get_available_module_infos(1);
		my $nolo = $ENV{'ANONYMOUS_USER'} ||
			      $ENV{'SSL_USER'} || $ENV{'LOCAL_USER'} ||
			      $ENV{'HTTP_USER_AGENT'} =~ /webmin/i;
		if ($gconfig{'gotoone'} && $main::session_id && @avail == 1 &&
		    !$nolo) {
			print "<a href='@{[&get_webprefix()]}/session_login.cgi?logout=1'>",
			      "$text{'main_logout'}</a><br>";
			}
		elsif ($gconfig{'gotoone'} && @avail == 1 && !$nolo) {
			print "<a href=@{[&get_webprefix()]}/switch_user.cgi>",
			      "$text{'main_switch'}</a><br>";
			}
		elsif (!$gconfig{'gotoone'} || @avail > 1) {
			print "<a href='@{[&get_webprefix()]}/?cat=",
			      $this_module_info{'category'},
			      "'>$text{'header_webmin'}</a><br>\n";
			}
		}
	if (!$_[4] && !$tconfig{'nomoduleindex'}) {
		my $idx = $this_module_info{'index_link'};
		my $mi = $module_index_link || "/".&get_module_name()."/$idx";
		my $mt = $module_index_name || $text{'header_module'};
		print "<a href=\"@{[&get_webprefix()]}$mi\">$mt</a><br>\n";
		}
	if (ref($_[2]) eq "ARRAY" && !$ENV{'ANONYMOUS_USER'} &&
	    !$tconfig{'nohelp'}) {
		print &hlink($text{'header_help'}, $_[2]->[0], $_[2]->[1]),
		      "<br>\n";
		}
	elsif (defined($_[2]) && !$ENV{'ANONYMOUS_USER'} &&
	       !$tconfig{'nohelp'}) {
		print &hlink($text{'header_help'}, $_[2]),"<br>\n";
		}
	if ($_[3]) {
		my %access = &get_module_acl();
		if (!$access{'noconfig'} && !$config{'noprefs'}) {
			my $cprog = $user_module_config_directory ?
					"uconfig.cgi" : "config.cgi";
			print "<a href=\"@{[&get_webprefix()]}/$cprog?",
			      &get_module_name()."\">",
			      $text{'header_config'},"</a><br>\n";
			}
		}
	print "</td>\n";
	if ($_[1]) {
		# Title is a single image
		print "<td id='headln2c' align='center' width='70%'>",
		      "<img alt=\"$_[0]\" src=\"$_[1]\"></td>\n";
		}
	else {
		# Title is just text
		my $ts = defined($tconfig{'titlesize'}) ?
				$tconfig{'titlesize'} : "+2";
		print "<td id='headln2c' align='center' width='70%'>",
		      ($ts ? "<font size='$ts'>" : ""),$_[0],
		      ($ts ? "</font>" : "");
		print "<br>$_[9]\n" if ($_[9]);
		print "</td>\n";
		}
	print "<td id='headln2r' width='15%' valign='top' align='right'>";
	print $_[6];
	print "</td></tr></table>\n";
	print $tconfig{'postheader'};
	}
$miniserv::page_capture = 1;
}

=head2 get_html_title(title)

Returns the full string to appear in the HTML <title> block.

=cut
sub get_html_title
{
my ($msg) = @_;
my $title;
my $os_type = $gconfig{'real_os_type'} || $gconfig{'os_type'};
my $os_version = $gconfig{'real_os_version'} || $gconfig{'os_version'};
my $host = &get_display_hostname();
if ($gconfig{'sysinfo'} == 1 && $remote_user) {
	$title = sprintf "%s : %s on %s (%s %s)\n",
		$msg, $remote_user, $host,
		$os_type, $os_version;
	}
elsif ($gconfig{'sysinfo'} == 4 && $remote_user) {
	$title = sprintf "%s on %s (%s %s)\n",
		$remote_user, $host,
		$os_type, $os_version;
	}
else {
	$title = $msg;
	}
if ($gconfig{'showlogin'} && $remote_user) {
	$title = $remote_user.($title ? " : ".$title : "");
	}
if ($gconfig{'showhost'}) {
	$title = $host.($title ? " : ".$title : "");
	}
return $title;
}

=head2 get_html_framed_title

Returns the title text for a framed theme main page.

=cut
sub get_html_framed_title
{
my $ostr;
my $os_type = $gconfig{'real_os_type'} || $gconfig{'os_type'};
my $os_version = $gconfig{'real_os_version'} || $gconfig{'os_version'};
my $title;
if (($gconfig{'sysinfo'} == 4 || $gconfig{'sysinfo'} == 1) && $remote_user) {
	# Alternate title mode requested
	$title = sprintf "%s on %s (%s %s)\n",
		$remote_user, &get_display_hostname(),
		$os_type, $os_version;
	}
else {
	# Title like 'Webmin x.yy on hostname (Linux 6)'
	if ($os_version eq "*") {
		$ostr = $os_type;
		}
	else {
		$ostr = "$os_type $os_version";
		}
	my $host = &get_display_hostname();
	my $ver = &get_webmin_version();
	$title = $gconfig{'nohostname'} ? $text{'main_title2'} :
		 $gconfig{'showhost'} ? &text('main_title3', $ver, $ostr) :
					&text('main_title', $ver, $host, $ostr);
	if ($gconfig{'showlogin'}) {
		$title = $remote_user.($title ? " : ".$title : "");
		}
	if ($gconfig{'showhost'}) {
		$title = $host.($title ? " : ".$title : "");
		}
	}
return $title;
}

=head2 get_html_status_line(text-only)

Returns HTML for a script block that sets the status line, or if text-only
is set to 1, just return the status line text.

=cut
sub get_html_status_line
{
my ($textonly) = @_;
if (($gconfig{'sysinfo'} != 0 || !$remote_user) && !$textonly) {
	# Disabled in this mode
	return undef;
	}
my $os_type = $gconfig{'real_os_type'} || $gconfig{'os_type'};
my $os_version = $gconfig{'real_os_version'} || $gconfig{'os_version'};
my $line = &text('header_statusmsg',
		 ($ENV{'ANONYMOUS_USER'} ? "Anonymous user"
					   : $remote_user).
		 ($ENV{'SSL_USER'} ? " (SSL certified)" :
		  $ENV{'LOCAL_USER'} ? " (Local user)" : ""),
		 $text{'programname'},
		 &get_webmin_version(),
		 &get_display_hostname(),
		 $os_type.($os_version eq "*" ? "" :" $os_version"));
if ($textonly) {
	return $line;
	}
else {
	$line =~ s/\r|\n//g;
	return "<script type='text/javascript'>\n".
	       "window.defaultStatus=\"".&quote_escape($line)."\";\n".
	       "</script>\n";
	}
}

=head2 popup_header([title], [head-stuff], [body-stuff], [no-body])

Outputs a page header, suitable for a popup window. If no title is given,
absolutely no decorations are output. Also useful in framesets. The parameters
are :

=item title - Title text for the popup window.

=item head-stuff - HTML to appear in the <head> section.

=item body-stuff - HTML attributes to be include in the <body> tag.

=item no-body - If set to 1, don't generate a body tag

=cut
sub popup_header
{
return if ($main::done_webmin_header++);
my $ll;
my $charset = defined($main::force_charset) ? $main::force_charset
					    : &get_charset();
&PrintHeader($charset);
&load_theme_library();
if (defined(&theme_popup_header)) {
	&theme_popup_header(@_);
	$miniserv::page_capture = 1;
	return;
	}
print "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">\n";
print "<html>\n";
print "<head>\n";
if (defined(&theme_popup_prehead)) {
	&theme_popup_prehead(@_);
	}
print "<title>$_[0]</title>\n";
print $_[1];
print "$tconfig{'headhtml'}\n" if ($tconfig{'headhtml'});
if ($tconfig{'headinclude'}) {
	print &read_file_contents(
		"$theme_root_directory/$tconfig{'headinclude'}");
	}
print "</head>\n";
my $bgcolor = defined($tconfig{'cs_page'}) ? $tconfig{'cs_page'} :
		 defined($gconfig{'cs_page'}) ? $gconfig{'cs_page'} : "ffffff";
my $link = defined($tconfig{'cs_link'}) ? $tconfig{'cs_link'} :
	      defined($gconfig{'cs_link'}) ? $gconfig{'cs_link'} : "0000ee";
my $text = defined($tconfig{'cs_text'}) ? $tconfig{'cs_text'} :
	      defined($gconfig{'cs_text'}) ? $gconfig{'cs_text'} : "000000";
my $bgimage = defined($tconfig{'bgimage'}) ? "background='$tconfig{'bgimage'}'"
					      : "";
if (!$_[3]) {
	print "<body id='popup' bgcolor='#$bgcolor' link='#$link' vlink='#$link' ",
	      "text='#$text' $bgimage $tconfig{'inbody'} $_[2]>\n";
	if (defined(&theme_popup_prebody)) {
		&theme_popup_prebody(@_);
		}
	}
$miniserv::page_capture = 1;
}

=head2 footer([page, name]+, [noendbody])

Outputs the footer for a Webmin HTML page, possibly with links back to other
pages. The links are specified by pairs of parameters, the first of which is
a link destination, and the second the link text. For example :

footer('/', 'Webmin index', '', 'Module menu');

=cut
sub footer
{
$miniserv::page_capture = 0;
&load_theme_library();
my %this_module_info = &get_module_info(&get_module_name());
if (defined(&theme_footer)) {
	$module_name = &get_module_name();	# Old themes use these
	%module_info = %this_module_info;
	&theme_footer(@_);
	return;
	}
for(my $i=0; $i+1<@_; $i+=2) {
	my $url = $_[$i];
	if ($url ne '/' || !$tconfig{'noindex'}) {
		if ($url eq '/') {
			$url = "/?cat=$this_module_info{'category'}";
			}
		elsif ($url eq '' && &get_module_name()) {
			$url = "/".&get_module_name()."/".
			       $this_module_info{'index_link'};
			}
		elsif ($url =~ /^\?/ && &get_module_name()) {
			$url = "/".&get_module_name()."/$url";
			}
		$url = "@{[&get_webprefix()]}$url" if ($url =~ /^\//);
		if ($i == 0) {
			print "<a href=\"$url\"><img alt=\"<-\" align='middle' border='0' src='@{[&get_webprefix()]}/images/left.gif'></a>\n";
			}
		else {
			print "&nbsp;|\n";
			}
		print "&nbsp;<a href=\"$url\">",&text('main_return', $_[$i+1]),"</a>\n";
		}
	}
print "<br>\n";
if (!$_[$i]) {
	my $postbody = $tconfig{'postbody'};
	if ($postbody) {
		$postbody = replace_meta($postbody);
		print "$postbody\n";
		}
	if ($tconfig{'postbodyinclude'}) {
		my ($theme, $overlay) = split(' ', $gconfig{'theme'});
		my $file_contents = read_file_contents("$root_directory/$overlay/$tconfig{'postbodyinclude'}");
		$file_contents = replace_meta($file_contents);
		print $file_contents;
		}
	if (defined(&theme_postbody)) {
		&theme_postbody(@_);
		}
	print "</body></html>\n";
	}
}

=head2 popup_footer([no-body])

Outputs html for a footer for a popup window, started by popup_header.

=cut
sub popup_footer
{
$miniserv::page_capture = 0;
&load_theme_library();
if (defined(&theme_popup_footer)) {
	&theme_popup_footer(@_);
	return;
	}
if (!$_[0]) {
	print "</body>\n";
	}
print "</html>\n";
}

=head2 load_module_preferences(module, &config)

Check if user preferences can be loaded for given
module based on module's prefs.info special file.

=cut
sub load_module_preferences
{
my ($module, $curr_config) = @_;
my $module_prefs_acls = &get_module_preferences_acl($module, 'allowed');
my $current_user_prefs = "$config_directory/$module/prefs.$remote_user";
if ($module_prefs_acls && -r $current_user_prefs) {
	if ($module_prefs_acls eq "*") {
		&read_file($current_user_prefs, \%$curr_config);
		}
	else {
		my %newconfigtmp;
		&read_file($current_user_prefs, \%newconfigtmp);
		foreach my $key (keys %newconfigtmp) {
		if (grep(/^$key$/, split(",", $module_prefs_acls))) {
				$curr_config->{$key} = $newconfigtmp{$key};
				}
			}
		}
	}
}

=head2 get_module_preferences_acl(module, type)

Return one of module's prefs params (if described by module in prefs.info).

=cut
sub get_module_preferences_acl
{
my ($module, $type) = @_;
my $module_dir = &module_root_directory($module);
my $module_prefs_conf_file = "$module_dir/prefs.info";
if (-r $module_prefs_conf_file) {
	my %module_prefs_conf;
	&read_file($module_prefs_conf_file, \%module_prefs_conf);
	return $module_prefs_conf{$type};
	}
return undef;
}

=head2 load_theme_library

Immediately loads the current theme's theme.pl file. Not generally useful for
most module developers, as this is called automatically by the header function.

=cut
sub load_theme_library
{
return if (!$current_theme || $loaded_theme_library++);
for(my $i=0; $i<@theme_root_directories; $i++) {
	if ($theme_configs[$i]->{'functions'}) {
		my @theme_funcs = split(/\s+/, $theme_configs[$i]->{'functions'});
		foreach my $theme_func (@theme_funcs) {
			do "$theme_root_directories[$i]/$theme_func";
			}
		}
	}
}

=head2 redirect(url)

Output HTTP headers to redirect the browser to some page. The url parameter is
typically a relative URL like index.cgi or list_users.cgi.

=cut
sub redirect
{
my %miniserv;
&get_miniserv_config(\%miniserv);
my $redirhost = $miniserv{'redirect_host'} || $ENV{'SERVER_NAME'};
my $redirport = $miniserv{'redirect_port'} || $ENV{'SERVER_PORT'};
my $redirssl = $miniserv{'redirect_ssl'} ne '' ? $miniserv{'redirect_ssl'} :
	       uc($ENV{'HTTPS'}) eq "ON" ? 1 : 0;
my $port = $redirport == 443 && $redirssl ? "" :
	   $redirport == 80 && !$redirssl ? "" : ":".$redirport;
my $prot = $redirssl ? "https" : "http";
my $wp = $gconfig{'webprefixnoredir'} ? undef : &get_webprefix();
my $url;
if ($_[0] =~ /^(http|https|ftp|gopher):/) {
	# Absolute URL (like http://...)
	$url = $_[0];
	}
elsif ($_[0] =~ /^\//) {
	# Absolute path (like /foo/bar.cgi)
	if ($gconfig{'relative_redir'}) {
		$url = "$wp$_[0]";
		}
	else {
		$url = "$prot://$redirhost$port$wp$_[0]";
		}
	}
elsif ($ENV{'SCRIPT_NAME'} =~ /^(.*)\/[^\/]*$/) {
	# Relative URL (like foo.cgi)
	if ($gconfig{'relative_redir'}) {
		$url = "$wp$1/$_[0]";
		}
	else {
		$url = "$prot://$redirhost$port$wp$1/$_[0]";
		}
	}
else {
	if ($gconfig{'relative_redir'}) {
		$url = "$wp$_[0]";
		}
	else {
		$url = "$prot://$redirhost$port/$wp$_[0]";
		}
	}
&load_theme_library();
if (defined(&theme_redirect)) {
	$module_name = &get_module_name();	# Old themes use these
	%module_info = &get_module_info($module_name);
	&theme_redirect($_[0], $url);
	}
else {
	print "Location: $url\n\n";
	}
}

=head2 kill_byname(name, signal)

Finds a process whose command line contains the given name (such as httpd), and
sends some signal to it. The signal can be numeric (like 9) or named
(like KILL).

=cut
sub kill_byname
{
my @pids = &find_byname($_[0]);
return scalar(@pids) if (&is_readonly_mode());
&webmin_debug_log('KILL', "signal=$_[1] name=$_[0]")
	if ($gconfig{'debug_what_procs'});
if (@pids) { kill($_[1], @pids); return scalar(@pids); }
else { return 0; }
}

=head2 kill_byname_logged(name, signal)

Like kill_byname, but also logs the killing.

=cut
sub kill_byname_logged
{
my @pids = &find_byname($_[0]);
return scalar(@pids) if (&is_readonly_mode());
if (@pids) { &kill_logged($_[1], @pids); return scalar(@pids); }
else { return 0; }
}

=head2 find_byname(name)

Finds processes searching for the given name in their command lines, and
returns a list of matching PIDs.

=cut
sub find_byname
{
if ($gconfig{'os_type'} =~ /-linux$/ && -r "/proc/$$/cmdline") {
	# Linux with /proc filesystem .. use cmdline files, as this is
	# faster than forking
	my @pids;
	opendir(PROCDIR, "/proc");
	foreach my $f (readdir(PROCDIR)) {
		if ($f eq int($f) && $f != $$) {
			my $line = &read_file_contents("/proc/$f/cmdline");
			if ($line =~ /$_[0]/) {
				push(@pids, $f);
				}
			}
		}
	closedir(PROCDIR);
	return @pids;
	}

if (&foreign_check("proc")) {
	# Call the proc module
	&foreign_require("proc", "proc-lib.pl");
	if (defined(&proc::list_processes)) {
		my @procs = &proc::list_processes();
		my @pids;
		foreach my $p (@procs) {
			if ($p->{'args'} =~ /$_[0]/) {
				push(@pids, $p->{'pid'});
				}
			}
		@pids = grep { $_ != $$ } @pids;
		return @pids;
		}
	}

# Fall back to running a command
my ($cmd, @pids);
$cmd = $gconfig{'find_pid_command'};
$cmd =~ s/NAME/"$_[0]"/g;
$cmd = &translate_command($cmd);
@pids = split(/\n/, `($cmd) <$null_file 2>$null_file`);
@pids = grep { $_ != $$ } @pids;
return @pids;
}

=head2 error([message]+)

Display an error message and exit. This should be used by CGI scripts that
encounter a fatal error or invalid user input to notify users of the problem.
If error_setup has been called, the displayed error message will be prefixed
by the message setup using that function.

=cut
sub error
{
$main::no_miniserv_userdb = 1;
&setvar('error-fatal-ignored', 1);
return if $main::ignore_errors;
&setvar('error-fatal', 1);
my $msg = join("", @_);
$msg =~ s/<[^>]*>//g;
my $error_details = (($ENV{'WEBMIN_DEBUG'} || $gconfig{'debug_enabled'}) ? "" : "\n");
my $error_output_right = sub {
	my ($err_msg) = @_;
	return $main::webmin_script_type eq 'cmd' ? entities_to_ascii($err_msg) : $err_msg;
	};
if (!$main::error_must_die) {
	print STDERR "Error: ", &$error_output_right($msg), "\n";
	}
&load_theme_library();
if ($main::error_must_die) {
	die "@_$error_details";
	}
&call_error_handlers();
if (!$ENV{'REQUEST_METHOD'}) {
	# Show text-only error
	print STDERR "$text{'error'}\n";
	print STDERR "-----\n";
	print STDERR ($main::whatfailed ? "$main::whatfailed : " : ""),
			&$error_output_right($msg),"\n";
	print STDERR "-----\n";
	&print_call_stack() if ($gconfig{'error_stack'});
	}
elsif (defined(&theme_error)) {
	&theme_error(@_);
	}
elsif ($ENV{'REQUEST_URI'} =~ /json-error=1/) {
	my %jerror;
	my $error_what = ($main::whatfailed ? "$main::whatfailed: " : "");
	my $error_message = join(",", @_);
	my $error = ($error_what . $error_message);
	%jerror = (error => $error,
		   error_fatal => 1, 
		   error_what => $error_what, 
		   error_message => $error_message
		  );
	print_json(\%jerror);
	}
else {
	&header($text{'error'}, "");
	my $hh = $miniserv::page_capture ? " captured" : "";
	my $err_style = &read_file_contents("$root_directory/unauthenticated/errors.css");
	if ($err_style) {
		$err_style =~ s/[\n\r]//g;
		$err_style =~ s/\s+/ /g;
		$err_style = "<style data-err type=\"text/css\">$err_style</style>";
		print "\n$err_style\n";
		}
	print "<hr>\n" if ($hh);
	if ($hh) {
		print "<h3 data-fatal-error-text>",($main::whatfailed ? "$main::whatfailed : " : ""),
			     @_,"</h3>\n";
		}
	else {
		my $error_what = ($main::whatfailed ? "$main::whatfailed: " : "");
		my $error_html = join(",", @_);
		my $error_text;
		if ($error_html !~ /<pre.*?>/) {
			$error_text = " &mdash; $error_html";
			$error_html = undef;
			}
		print "<title>$text{'error'}</title><h3 class=\"err-head\" data-fatal-error-text>$text{'error'}$error_text</h3>$error_html<br>\n";
		}
	if ($gconfig{'error_stack'}) {
		# Show call stack
		my $cls_err_caption = " class=\"err-head$hh\"";
		my $cls_err_td = $hh ? " class=\"@{[&trim($hh)]}\"" : "";
		print "<hr>\n" if ($hh);
		print "<table class=\"err-stack$hh\"><caption$cls_err_caption>$text{'error_stack'}</caption>\n";
		print "<tr> <td$cls_err_td><b>$text{'error_file'}</b></td> ",
		      "<td$cls_err_td><b>$text{'error_line'}</b></td> ",
		      "<td$cls_err_td><b>$text{'error_sub'}</b></td> </tr>\n";
		for($i=0; my @stack = caller($i); $i++) {
			print "<tr>\n";
			print "<td$cls_err_td>$stack[1]</td>\n";
			print "<td$cls_err_td>$stack[2]</td>\n";
			print "<td$cls_err_td>$stack[3]</td>\n";
			print "</tr>\n";
			}
		print "</table>\n";
		}
	print "<hr>\n" if ($hh);
	if ($ENV{'HTTP_REFERER'} && $main::completed_referers_check) {
		&footer("javascript:history.back()", $text{'error_previous'});
		}
	else {
		&footer();
		}
	}
&unlock_all_files();
&cleanup_tempnames();
exit(1);
}

=head2 print_call_stack()

Output the call stack of the current function to STDERR

=cut
sub print_call_stack
{
print STDERR $text{'error_stack'},"\n";
for(my $i=0; my @stack = caller($i); $i++) {
	print STDERR &text('error_stackline',
		$stack[1], $stack[2], $stack[3]),"\n";
	}
}

=head2 popup_error([message]+)

This function is almost identical to error, but displays the message with HTML
headers suitable for a popup window.

=cut
sub popup_error
{
$main::no_miniserv_userdb = 1;
&load_theme_library();
if ($main::error_must_die) {
	die @_;
	}
&call_error_handlers();
if (defined(&theme_popup_error)) {
	&theme_popup_error(@_);
	}
else {
	&popup_header($text{'error'}, "");
	print "<h3>",($main::whatfailed ? "$main::whatfailed : " : ""),@_,"</h3>\n";
	&popup_footer();
	}
&unlock_all_files();
&cleanup_tempnames();
exit;
}

=head2 register_error_handler(&func, arg, ...)

=cut
sub register_error_handler
{
my ($f, @args) = @_;
push(@$error_handler_funcs, [ $f, @args ]);
}

=head2 call_error_handlers()

Internal function to call all registered error handlers

=cut
sub call_error_handlers
{
my @funcs = @$error_handler_funcs;
$error_handler_funcs = [ ];
foreach my $e (@funcs) {
	my ($f, @args) = @$e;
	&$f(@args);
	}
}

=head2 error_setup(message)

Registers a message to be prepended to all error messages displayed by the
error function.

=cut
sub error_setup
{
$main::whatfailed = $_[0];
}

=head2 wait_for(handle, regexp, regexp, ...)

Reads from the input stream until one of the regexps matches, and returns the
index of the matching regexp, or -1 if input ended before any matched. This is
very useful for parsing the output of interactive programs, and can be used with
a two-way pipe to feed input to a program in response to output matched by
this function.

If the matching regexp contains bracketed sub-expressions, their values will
be placed in the global array @matches, indexed starting from 1. You cannot
use the Perl variables $1, $2 and so on to capture matches.

Example code:

$rv = wait_for($loginfh, "username:");
 if ($rv == -1) {
   error("Didn't get username prompt");
 }
 print $loginfh "joe\n";
 $rv = wait_for($loginfh, "password:");
 if ($rv == -1) {
   error("Didn't get password prompt");
 }
 print $loginfh "smeg\n";

=cut
sub wait_for
{
my ($c, $i, $sw, $rv, $ha);
undef($wait_for_input);
if ($wait_for_debug) {
	print STDERR "wait_for(",join(",", @_),")\n";
	}
$ha = &callers_package($_[0]);
if ($wait_for_debug) {
	print STDERR "File handle=$ha fd=",fileno($ha),"\n";
	}
$codes =
"my \$hit;\n".
"while(1) {\n".
" if ((\$c = getc(\$ha)) eq \"\") { return -1; }\n".
" \$wait_for_input .= \$c;\n";
if ($wait_for_debug) {
	$codes .= "print STDERR \$wait_for_input,\"\\n\";";
	}
for($i=1; $i<@_; $i++) {
        $sw = $i>1 ? "elsif" : "if";
        $codes .= " $sw (\$wait_for_input =~ /$_[$i]/i) { \$hit = $i-1; }\n";
        }
$codes .=
" if (defined(\$hit)) {\n".
"  \@matches = (-1, \$1, \$2, \$3, \$4, \$5, \$6, \$7, \$8, \$9);\n".
"  return \$hit;\n".
"  }\n".
" }\n";
$rv = eval $codes;
if ($@) {
	&error("wait_for error : $@\n");
	}
return $rv;
}

=head2 fast_wait_for(handle, string, string, ...)

This function behaves very similar to wait_for (documented above), but instead
of taking regular expressions as parameters, it takes strings. As soon as the
input contains one of them, it will return the index of the matching string.
If the input ends before any match, it returns -1.

=cut
sub fast_wait_for
{
my ($inp, $maxlen, $ha, $i, $c, $inpl);
for($i=1; $i<@_; $i++) {
	$maxlen = length($_[$i]) > $maxlen ? length($_[$i]) : $maxlen;
	}
$ha = $_[0];
while(1) {
	if (($c = getc($ha)) eq "") {
		&error("fast_wait_for read error : $!");
		}
	$inp .= $c;
	if (length($inp) > $maxlen) {
		$inp = substr($inp, length($inp)-$maxlen);
		}
	$inpl = length($inp);
	for($i=1; $i<@_; $i++) {
		if ($_[$i] eq substr($inp, $inpl-length($_[$i]))) {
			return $i-1;
			}
		}
	}
}

=head2 has_command(command)

Returns the full path to the executable if some command is in the path, or
undef if not found. If the given command is already an absolute path and
exists, then the same path will be returned.

=cut
sub has_command
{
if (!$_[0]) { return undef; }
if (exists($main::has_command_cache{$_[0]})) {
	return $main::has_command_cache{$_[0]};
	}
my $rv = undef;
my $slash = $gconfig{'os_type'} eq 'windows' ? '\\' : '/';
if ($_[0] =~ /^\// || $_[0] =~ /^[a-z]:[\\\/]/i) {
	# Absolute path given - just use it
	my $t = &translate_filename($_[0]);
	$rv = (-x $t && !-d _) ? $_[0] : undef;
	}
else {
	# Check each directory in the path
	my %donedir;
	foreach my $d (split($path_separator, $ENV{'PATH'})) {
		next if ($donedir{$d}++);
		$d =~ s/$slash$// if ($d ne $slash);
		my $t = &translate_filename("$d/$_[0]");
		if (-x $t && !-d _) {
			$rv = $d.$slash.$_[0];
			last;
			}
		if ($gconfig{'os_type'} eq 'windows') {
			foreach my $sfx (".exe", ".com", ".bat") {
				my $t = &translate_filename("$d/$_[0]").$sfx;
				if (-r $t && !-d _) {
					$rv = $d.$slash.$_[0].$sfx;
					last;
					}
				}
			}
		}
	}
$main::has_command_cache{$_[0]} = $rv;
return $rv;
}

=head2 make_date(seconds, [date-only], [fmt])

Converts a Unix date/time in seconds to a human-readable form, by default
formatted like dd/mmm/yyyy hh:mm:ss. Parameters are :

=item seconds - Unix time is seconds to convert.

=item date-only - If set to 1, exclude the time from the returned string.

=item fmt - Optional, one of dd/mon/yyyy, dd/mm/yyyy, mm/dd/yyyy or yyyy/mm/dd

=cut
sub make_date
{
&load_theme_library();
if (defined(&theme_make_date) &&
    !$main::theme_prevent_make_date && 
    (($main::header_content_type eq "text/html" &&
    $main::webmin_script_type eq "web") || 
    $main::theme_allow_make_date)) {
	return &theme_make_date(@_);
	}
my ($secs, $only, $fmt) = @_;
my @tm = localtime($secs);
my $date;
if (!$fmt) {
	$fmt = $gconfig{'dateformat'} || 'dd/mon/yyyy';
	}
if ($fmt eq 'dd/mon/yyyy') {
	$date = sprintf "%2.2d/%s/%4.4d",
			$tm[3], $text{"smonth_".($tm[4]+1)}, $tm[5]+1900;
	}
elsif ($fmt eq 'dd/mm/yyyy') {
	$date = sprintf "%2.2d/%2.2d/%4.4d", $tm[3], $tm[4]+1, $tm[5]+1900;
	}
elsif ($fmt eq 'mm/dd/yyyy') {
	$date = sprintf "%2.2d/%2.2d/%4.4d", $tm[4]+1, $tm[3], $tm[5]+1900;
	}
elsif ($fmt eq 'yyyy/mm/dd') {
	$date = sprintf "%4.4d/%2.2d/%2.2d", $tm[5]+1900, $tm[4]+1, $tm[3];
	}
elsif ($fmt eq 'd. mon yyyy') {
	$date = sprintf "%d. %s %4.4d",
			$tm[3], $text{"smonth_".($tm[4]+1)}, $tm[5]+1900;
	}
elsif ($fmt eq 'dd.mm.yyyy') {
	$date = sprintf "%2.2d.%2.2d.%4.4d", $tm[3], $tm[4]+1, $tm[5]+1900;
	}
elsif ($fmt eq 'yyyy-mm-dd') {
	$date = sprintf "%4.4d-%2.2d-%2.2d", $tm[5]+1900, $tm[4]+1, $tm[3];
	}
if (!$only) {
	$date .= sprintf " %2.2d:%2.2d", $tm[2], $tm[1];
	}
return $date;
}

=head2 file_chooser_button(input, type, [form], [chroot], [addmode])

Return HTML for a button that pops up a file chooser when clicked, and places
the selected filename into another HTML field. The parameters are :

=item input - Name of the form field to store the filename in.

=item type - 0 for file or directory chooser, or 1 for directory only.

=item form - Index of the form containing the button.

=item chroot - If set to 1, the chooser will be limited to this directory.

=item addmode - If set to 1, the selected filename will be appended to the text box instead of replacing it's contents.

=cut
sub file_chooser_button
{
return &theme_file_chooser_button(@_)
	if (defined(&theme_file_chooser_button));
my $form = defined($_[2]) ? $_[2] : 0;
my $chroot = defined($_[3]) ? $_[3] : "/";
my $add = int($_[4]);
my ($w, $h) = (400, 300);
if ($gconfig{'db_sizefile'}) {
	($w, $h) = split(/x/, $gconfig{'db_sizefile'});
	}
return "<input type=button onClick='ifield = form.$_[0]; chooser = window.open(\"@{[&get_webprefix()]}/chooser.cgi?add=$add&type=$_[1]&chroot=$chroot&file=\"+encodeURIComponent(ifield.value), \"chooser\", \"toolbar=no,menubar=no,scrollbars=no,resizable=yes,width=$w,height=$h\"); chooser.ifield = ifield; window.ifield = ifield' value=\"...\">\n";
}

=head2 popup_window_button(url, width, height, scrollbars?, &field-mappings)

Returns HTML for a button that will popup a chooser window of some kind. The
parameters are :

=item url - Base URL of the popup window's contents

=item width - Width of the window in pixels

=item height - Height in pixels

=item scrollbars - Set to 1 if the window should have scrollbars

=item fields - See below

=item disabled - The button is disabled if non-zero

The field-mappings parameter is an array ref of array refs containing

=item - Attribute to assign field to in the popup window

=item - Form field name

=item - CGI parameter to URL for value, if any

=cut
sub popup_window_button
{
return &theme_popup_window_button(@_) if (defined(&theme_popup_window_button));
my ($url, $w, $h, $scroll, $fields, $disabled) = @_;
my $scrollyn = $scroll ? "yes" : "no";
my $rv = "<input type=button onClick='";
foreach my $m (@$fields) {
	$rv .= "$m->[0] = form.$m->[1]; ";
	}
my $sep = $url =~ /\?/ ? "&" : "?";
$rv .= "chooser = window.open(\"$url\"";
foreach my $m (@$fields) {
	if ($m->[2]) {
		$rv .= "+\"$sep$m->[2]=\"+escape($m->[0].value)";
		$sep = "&";
		}
	}
$rv .= ", \"chooser\", \"toolbar=no,menubar=no,scrollbars=$scrollyn,resizable=yes,width=$w,height=$h\"); ";
foreach my $m (@$fields) {
	$rv .= "chooser.$m->[0] = $m->[0]; ";
	$rv .= "window.$m->[0] = $m->[0]; ";
	}
$rv .= "' value=\"...\"";
if ($disabled) {
	$rv .= " disabled";
	}
$rv .= ">";
return $rv;
}

=head2 popup_window_link(url, title, width, height, scrollbar, &field-mappings)

Returns HTML for a link that will popup a chooser window of some kind. The
parameters are :

=item url - Base URL of the popup window's contents

=item title - Text of the link

=item width - Width of the window in pixels

=item height - Height in pixels

=item scrollbars - Set to 1 if the window should have scrollbars

=item fields - See below

The field-mappings parameter is an array ref of array refs containing

=item - Attribute to assign field to in the popup window

=item - Form field name

=item - CGI parameter to URL for value, if any

=cut
sub popup_window_link
{
return &theme_popup_window_link(@_) if (defined(&theme_popup_window_link));
my ($url, $title, $w, $h, $scrollyn, $fields) = @_;
my $scrollyn = $scroll ? "yes" : "no";
my $rv = "onClick='";
foreach my $m (@$fields) {
	$rv .= "$m->[0] = form.$m->[1]; ";
	}
my $sep = $url =~ /\?/ ? "&" : "?";
$rv .= "chooser = window.open(\"$url\"";
foreach my $m (@$fields) {
	if ($m->[2]) {
		$rv .= "+\"$sep$m->[2]=\"+escape($m->[0].value)";
		$sep = "&";
		}
	}
$rv .= ", \"chooser\", \"toolbar=no,menubar=no,scrollbars=$scrollyn,resizable=yes,width=$w,height=$h\"); ";
foreach my $m (@$fields) {
	$rv .= "chooser.$m->[0] = $m->[0]; ";
	$rv .= "window.$m->[0] = $m->[0]; ";
	}
$rv .= "return false;'";
return &ui_link($url, $title, undef, $rv);
}

=head2 read_acl(&user-module-hash, &user-list-hash, [&only-users])

Reads the Webmin acl file into the given hash references. The first is indexed
by a combined key of username,module , with the value being set to 1 when
the user has access to that module. The second is indexed by username, with
the value being an array ref of allowed modules.

This function is deprecated in favour of foreign_available, which performs a
more comprehensive check of module availability.

If the only-users array ref parameter is given, the results may be limited to
users in that list of names.

=cut
sub read_acl
{
my ($usermod, $userlist, $only) = @_;
if (!%main::acl_hash_cache) {
	# Read from local files
	local $_;
	open(ACL, "<".&acl_filename());
	while(<ACL>) {
		if (/^([^:]+):\s*(.*)/) {
			my $user = $1;
			my @mods = split(/\s+/, $2);
			foreach my $m (@mods) {
				$main::acl_hash_cache{$user,$m}++;
				}
			$main::acl_array_cache{$user} = \@mods;
			}
		}
	close(ACL);
	}
%$usermod = %main::acl_hash_cache if ($usermod);
%$userlist = %main::acl_array_cache if ($userlist);

# Read from user DB
my $userdb = &get_userdb_string();
my ($dbh, $proto, $prefix, $args) =
	$userdb ? &connect_userdb($userdb) : ( );
if (ref($dbh)) {
	if ($proto eq "mysql" || $proto eq "postgresql") {
		# Select usernames and modules from SQL DB
		my $cmd = $dbh->prepare(
			"select webmin_user.name,webmin_user_attr.value ".
			"from webmin_user,webmin_user_attr ".
			"where webmin_user.id = webmin_user_attr.id ".
			"and webmin_user_attr.attr = 'modules' ".
			($only ? " and webmin_user.name in (".
				 join(",", map { "'$_'" } @$only).")" : ""));
		if ($cmd && $cmd->execute()) {
			while(my ($user, $mods) = $cmd->fetchrow()) {
				my @mods = split(/\s+/, $mods);
				foreach my $m (@mods) {
					$usermod->{$user,$m}++ if ($usermod);
					}
				$userlist->{$user} = \@mods if ($userlist);
				}
			}
		$cmd->finish() if ($cmd);
		}
	elsif ($proto eq "ldap") {
		# Find users in LDAP
		my $filter = '(objectClass='.$args->{'userclass'}.')';
		if ($only) {
			my $ufilter =
				"(|".join("", map { "(cn=$_)" } @$only).")";
			$filter = "(&".$filter.$ufilter.")";
			}
		my $rv = $dbh->search(
			base => $prefix,
			filter => $filter,
			scope => 'sub',
			attrs => [ 'cn', 'webminModule' ]);
		if ($rv && !$rv->code) {
			foreach my $u ($rv->all_entries) {
				my $user = $u->get_value('cn');
				my @mods =$u->get_value('webminModule');
				foreach my $m (@mods) {
					$usermod->{$user,$m}++ if ($usermod);
					}
				$userlist->{$user} = \@mods if ($userlist);
				}
			}
		}
	&disconnect_userdb($userdb, $dbh);
	}
}

=head2 acl_filename

Returns the file containing the webmin ACL, which is usually
/etc/webmin/webmin.acl.

=cut
sub acl_filename
{
return "$config_directory/webmin.acl";
}

=head2 acl_check

Does nothing, but kept around for compatibility.

=cut
sub acl_check
{
}

=head2 get_miniserv_config_file

Returns the full path to the Miniserv config file.

=cut
sub get_miniserv_config_file
{
return $ENV{'MINISERV_CONFIG'} || "$config_directory/miniserv.conf";
}

=head2 get_miniserv_config(&hash)

Reads the Webmin webserver's (miniserv.pl) configuration file, usually located
at /etc/webmin/miniserv.conf, and stores its names and values in the given
hash reference.

=cut
sub get_miniserv_config
{
return &read_file_cached_with_stat(&get_miniserv_config_file(), $_[0]);
}

=head2 put_miniserv_config(&hash)

Writes out the Webmin webserver configuration file from the contents of
the given hash ref. This should be initially populated by get_miniserv_config,
like so :

get_miniserv_config(\%miniserv);
 $miniserv{'port'} = 10005;
 put_miniserv_config(\%miniserv);
 restart_miniserv();

=cut
sub put_miniserv_config
{
&write_file(&get_miniserv_config_file(), $_[0]);
}

=head2 restart_miniserv([nowait], [ignore-errors])

Kill the old miniserv process and re-start it, then optionally waits for
it to restart. This will apply all configuration settings.

=cut
sub restart_miniserv
{
return undef if (&is_readonly_mode());
my ($nowait, $ignore) = @_;
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;
my $flag = $miniserv{'restartflag'} || $var_directory."/restart-flag";
if ($gconfig{'os_type'} ne 'windows') {
	# On Unix systems, we can restart with a signal
	my ($pid, $addr, $i);
	$miniserv{'inetd'} && return;
	my @oldst = stat($miniserv{'pidfile'});
	$pid = $ENV{'MINISERV_PID'};
	if (!$pid || !kill(0, $pid)) {
		if (!open(PID, "<".$miniserv{'pidfile'})) {
			print STDERR "PID file $miniserv{'pidfile'} does ",
				     "not exist\n" if (!$ignore);
			return;
			}
		chop($pid = <PID>);
		close(PID);
		if (!$pid) {
			print STDERR "Invalid PID file $miniserv{'pidfile'}\n"
				if (!$ignore);
			return;
			}
		if (!kill(0, $pid)) {
			print STDERR "PID $pid from file $miniserv{'pidfile'} ",
			             "is not valid\n" if (!$ignore);
			return;
			}
		}

# Just signal miniserv to restart, and also create the flag file in
	# case signals aren't being processed
	if (!&kill_logged('HUP', $pid)) {
		&error("Incorrect Webmin PID $pid") if (!$ignore);
		}
	open(TOUCH, ">$flag");
	close(TOUCH);

# Wait till new PID is written, indicating a restart
	for($i=0; $i<60; $i++) {
		sleep(1);
		my @newst = stat($miniserv{'pidfile'});
		last if ($newst[9] != $oldst[9]);
		}
	$i < 60 || $ignore || &error("Webmin server did not write new PID file");

## Totally kill the process and re-run it
	#$SIG{'TERM'} = 'IGNORE';
	#&kill_logged('TERM', $pid);
	#&system_logged("$config_directory/start >/dev/null 2>&1 </dev/null");
	}
else {
	# On Windows, we need to use the flag file
	open(TOUCH, ">$flag");
	close(TOUCH);
	}

if (!$nowait) {
	# Wait for miniserv to come back up
	my $addr = $miniserv{'bind'} || "127.0.0.1";
	my $ok = 0;
	for($i=0; $i<20; $i++) {
		my $err;
		sleep(1);
		&open_socket($addr, $miniserv{'port'}, STEST, \$err);
		close(STEST);
		last if (!$err && ++$ok >= 2);
		}
	$i < 20 || $ignore || &error("Failed to restart Webmin server!");
	}
}

=head2 reload_miniserv([ignore-errors])

Sends a USR1 signal to the miniserv process, telling it to read-read it's
configuration files. Not all changes will be applied though, such as the
IP addresses and ports to accept connections on.

=cut
sub reload_miniserv
{
return undef if (&is_readonly_mode());
my ($ignore) = @_;
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 || !kill(0, $pid)) {
		if (!open(PID, "<".$miniserv{'pidfile'})) {
			print STDERR "PID file $miniserv{'pidfile'} does ",
				     "not exist\n" if (!$ignore);
			return;
			}
		chop($pid = <PID>);
		close(PID);
		if (!$pid) {
			print STDERR "Invalid PID file $miniserv{'pidfile'}\n"
				if (!$ignore);
			return;
			}
		if (!kill(0, $pid)) {
			print STDERR "PID $pid from file $miniserv{'pidfile'} ",
			             "is not valid\n" if (!$ignore);
			return;
			}
		}
	if (!&kill_logged('USR1', $pid)) {
		&error("Incorrect Webmin PID $pid") if (!$ignore);
		}

# Make sure this didn't kill Webmin!
	sleep(1);
	if (!kill(0, $pid)) {
		print STDERR "USR1 signal killed Webmin - restarting\n"
			if (!$ignore);
		&system_logged("$config_directory/start >/dev/null 2>&1 </dev/null");
		}
	}
else {
	# On Windows, we need to use the flag file
	open(TOUCH, ">$miniserv{'reloadflag'}");
	close(TOUCH);
	}
}

=head2 check_os_support(&minfo, [os-type, os-version], [api-only])

Returns 1 if some module is supported on the current operating system, or the
OS supplies as parameters. The parameters are :

=item minfo - A hash ref of module information, as returned by get_module_info

=item os-type - The Webmin OS code to use instead of the system's real OS, such as redhat-linux

=item os-version - The Webmin OS version to use, such as 13.0

=item api-only - If set to 1, considers a module supported if it provides an API to other modules on this OS, even if the majority of its functionality is not supported.

=cut
sub check_os_support
{
my $oss = $_[0]->{'os_support'};
if ($_[3] && $oss && $_[0]->{'api_os_support'}) {
	# May provide usable API
	$oss .= " ".$_[0]->{'api_os_support'};
	}
if ($_[0]->{'nozone'} && &running_in_zone()) {
	# Not supported in a Solaris Zone
	return 0;
	}
if ($_[0]->{'novserver'} && &running_in_vserver()) {
	# Not supported in a Linux Vserver
	return 0;
	}
if ($_[0]->{'noopenvz'} && &running_in_openvz()) {
	# Not supported in an OpenVZ container
	return 0;
	}
return 1 if (!$oss || $oss eq '*');
my $osver = $_[2] || $gconfig{'os_version'};
my $ostype = $_[1] || $gconfig{'os_type'};
my $anyneg = 0;
while(1) {
	my ($os, $ver, $codes);
	my ($neg) = ($oss =~ s/^!//);	# starts with !
	$anyneg++ if ($neg);
	if ($oss =~ /^([^\/\s]+)\/([^\{\s]+)\{([^\}]*)\}\s*(.*)$/) {
		# OS/version{code}
		$os = $1; $ver = $2; $codes = $3; $oss = $4;
		}
	elsif ($oss =~ /^([^\/\s]+)\/([^\/\s]+)\s*(.*)$/) {
		# OS/version
		$os = $1; $ver = $2; $oss = $3;
		}
	elsif ($oss =~ /^([^\{\s]+)\{([^\}]*)\}\s*(.*)$/) {
		# OS/{code}
		$os = $1; $codes = $2; $oss = $3;
		}
	elsif ($oss =~ /^\{([^\}]*)\}\s*(.*)$/) {
		# {code}
		$codes = $1; $oss = $2;
		}
	elsif ($oss =~ /^(\S+)\s*(.*)$/) {
		# OS
		$os = $1; $oss = $2;
		}
	else { last; }
	next if ($os && !($os eq $ostype ||
			  $ostype =~ /^(\S+)-(\S+)$/ && $os eq "*-$2"));
	if ($ver =~ /^([0-9\.]+)\-([0-9\.]+)$/) {
		next if ($osver < $1 || $osver > $2);
		}
	elsif ($ver =~ /^([0-9\.]+)\-\*$/) {
		next if ($osver < $1);
		}
	elsif ($ver =~ /^\*\-([0-9\.]+)$/) {
		next if ($osver > $1);
		}
	elsif ($ver) {
		next if ($ver ne $osver);
		}
	next if ($codes && !eval $codes);
	return !$neg;
	}
return $anyneg;
}

=head2 http_download(host, port, page, destfile, [&error], [&callback], [sslmode], [user], [pass], [timeout], [osdn-convert], [no-cache], [&headers])

Downloads data from a HTTP url 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 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_download
{
my ($host, $port, $page, $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));
	}

# Check if we already have cached the URL
my $url = ($ssl ? "https://" : "http://").$host.":".$port.$page;
my $cfile = &check_in_http_cache($url);
if ($cfile && !$nocache) {
	# Yes! Copy to dest file or variable
	&$cbfunc(6, $url) if ($cbfunc);
	if (ref($dest)) {
		&open_readfile(CACHEFILE, $cfile);
		local $/ = undef;
		$$dest = <CACHEFILE>;
		close(CACHEFILE);
		}
	else {
		&copy_source_dest($cfile, $dest);
		}
	return;
	}

# Build headers
my @headers;
push(@headers, [ "Host", $host ]);
push(@headers, [ "User-agent", "Webmin" ]);
push(@headers, [ "Accept-language", "en" ]);
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;
$timeout = 60 if (!defined($timeout));
alarm($timeout) if ($timeout);
my $h = &make_http_connection($host, $port, $ssl, "GET", $page, \@headers);
alarm(0) if ($timeout);
$h = $main::download_timed_out if ($main::download_timed_out);
if (!ref($h)) {
	$h ||= "Unknown error";
	if ($error) { $$error = $h; return; }
	else { &error(&html_escape($h)); }
	}
&complete_http_download($h, $dest, $error, $cbfunc, $osdn, $host, $port,
			$headers, $ssl, $nocache, $timeout);
if ((!$error || !$$error) && !$nocache) {
	&write_to_http_cache($url, $dest);
	}
}

=head2 complete_http_download(handle, destfile, [&error], [&callback], [osdn], [oldhost], [oldport], [&send-headers], [old-ssl], [no-cache], [timeout])

Do a HTTP download, after the headers have been sent. For internal use only,
typically called by http_download.

=cut
sub complete_http_download
{
my ($h, $destfile, $error, $cbfunc, $osdn, $oldhost, $oldport, $headers,
    $oldssl, $nocache, $timeout) = @_;
local ($line, %header, @headers, $s);  # Kept local so that callback funcs
				       # can access them.

# read headers
$timeout = 60 if (!defined($timeout));
alarm($timeout) if ($timeout);
($line = &read_http_connection($h)) =~ tr/\r\n//d;
if ($line !~ /^HTTP\/1\..\s+(200|30[0-9]|400)(\s+|$)/) {
	$line ||= "Failed to read HTTP response line";
	alarm(0) if ($timeout);
	&close_http_connection($h);
	if ($error) { ${$error} = $line; return; }
	else { &error("Download failed : ".&html_escape($line)); }
	}
my $rcode = $1;
&$cbfunc(1, $rcode >= 300 && $rcode < 400 ? 1 : 0)
	if ($cbfunc);
while(1) {
	$line = &read_http_connection($h);
	$line =~ tr/\r\n//d;
	$line =~ /^(\S+):\s*(.*)$/ || last;
	$header{lc($1)} = $2;
	push(@headers, [ lc($1), $2 ]);
	}
alarm(0) if ($timeout);
if ($main::download_timed_out) {
	&close_http_connection($h);
	if ($error) { ${$error} = $main::download_timed_out; return 0; }
	else { &error($main::download_timed_out); }
	}
&$cbfunc(2, $header{'content-length'}) if ($cbfunc);
if ($rcode >= 300 && $rcode < 400) {
	# follow the redirect
	&$cbfunc(5, $header{'location'}) if ($cbfunc);
	my ($host, $port, $page, $ssl);
	if ($header{'location'} =~ /^(http|https):\/\/([^:]+):(\d+)(\/.*)?$/) {
		$ssl = $1 eq 'https' ? 1 : 0;
		$host = $2;
		$port = $3;
		$page = $4 || "/";
		}
	elsif ($header{'location'} =~ /^(http|https):\/\/([^:\/]+)(\/.*)?$/) {
		$ssl = $1 eq 'https' ? 1 : 0;
		$host = $2;
		$port = $ssl ? 443 : 80;
		$page = $3 || "/";
		}
	elsif ($header{'location'} =~ /^\// && $_[5]) {
		# Relative to same server
		$host = $_[5];
		$port = $_[6];
		$ssl = $_[8];
		$page = $header{'location'};
		}
	elsif ($header{'location'}) {
		# Assume relative to same dir .. not handled
		&close_http_connection($h);
		if ($error) { ${$error} = "Invalid Location header $header{'location'}"; return; }
		else { &error("Invalid Location header ".
			      &html_escape($header{'location'})); }
		}
	else {
		&close_http_connection($h);
		if ($error) { ${$error} = "Missing Location header"; return; }
		else { &error("Missing Location header"); }
		}
	my $params;
	($page, $params) = split(/\?/, $page);
	$page =~ s/ /%20/g;
	$page .= "?".$params if (defined($params));
	&http_download($host, $port, $page, $destfile, $error, $cbfunc, $ssl,
		       undef, undef, undef, $_[4], $_[9], $_[7]);
	}
else {
	# read data
	if (ref($destfile)) {
		# Append to a variable
		while(defined($buf = &read_http_connection($h, 1024))) {
			${$destfile} .= $buf;
			&$cbfunc(3, length(${$destfile})) if ($cbfunc);
			}
		}
	else {
		# Write to a file
		my $got = 0;
		if (!&open_tempfile(PFILE, ">$destfile", 1)) {
			&close_http_connection($h);
			if ($error) { ${$error} = "Failed to write to $destfile : $!"; return; }
			else { &error("Failed to write to ".&html_escape($destfile)." : ".&html_escape("$!")); }
			}
		binmode(PFILE);		# For windows
		while(defined($buf = &read_http_connection($h, 1024))) {
			&print_tempfile(PFILE, $buf);
			$got += length($buf);
			&$cbfunc(3, $got) if ($cbfunc);
			}
		&close_tempfile(PFILE);
		if ($header{'content-length'} &&
		    $got != $header{'content-length'}) {
			&close_http_connection($h);
			if ($error) { ${$error} = "Download incomplete"; return; }
			else { &error("Download incomplete"); }
			}
		}
	&$cbfunc(4) if ($cbfunc);
	}
&close_http_connection($h);
}

=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