[ Avaa Bypassed ]

=head1 webmin-lib.pl

Common functions for configuring miniserv and adjusting global Webmin settings.

=cut

BEGIN { push(@INC, ".."); };
use strict;
use warnings;
no warnings 'redefine';
no warnings 'uninitialized';
use WebminCore;
&init_config();
our ($module_root_directory, %text, %gconfig, $root_directory, %config,
     $module_name, $remote_user, $base_remote_user, $gpgpath,
     $module_config_directory, @lang_order_list, @root_directories,
     $module_var_directory);
do "$module_root_directory/gnupg-lib.pl";
do "$module_root_directory/letsencrypt-lib.pl";
do "$module_root_directory/twofactor-funcs-lib.pl";
use Socket;

our @cs_codes = ( 'cs_page', 'cs_text', 'cs_table', 'cs_header', 'cs_link' );
our @cs_names = map { $text{$_} } @cs_codes;

our $osdn_host = "prdownloads.sourceforge.net";
our $osdn_port = 80;

our $update_host = "download.webmin.com";
our $update_port = 80;
our $update_page = "/updates/updates.txt";
our $update_url = "http://$update_host:$update_port$update_page";
our $redirect_host = "www.webmin.com";
our $redirect_url = "http://$redirect_host/cgi-bin/redirect.cgi";
our $update_cache = "$module_config_directory/update-cache";
if (!-r $update_cache) {
	$update_cache = "$module_var_directory/update-cache";
	}

our $primary_host = "www.webmin.com";
our $primary_port = 80;

our $webmin_key_email = "jcameron\@webmin.com";
our $webmin_key_fingerprint = "1719 003A CE3E 5A41 E2DE  70DF D97A 3AE9 11F6 3C51";

our $authentic_key_email = "gpg\@ilia.engineer";
our $authentic_key_fingerprint = "EC60 F3DA 9CB7 9ADC CF56  0D1F 121E 166D D9C8 21AB";

our $standard_host = $primary_host;
our $standard_port = $primary_port;
our $standard_page = "/download/modules/standard.txt";
our $standard_ssl = 0;

our $third_host = $primary_host;
our $third_port = $primary_port;
our $third_page = "/cgi-bin/third.cgi";
our $third_ssl = 0;

our $default_key_size = "2048";

# Obsolete, but still defined so it can be deleted
our $cron_cmd = "$module_config_directory/update.pl";

our $os_info_address = "os\@webmin.com";

our $detect_operating_system_cache = "$module_config_directory/oscache";
if (!-r $detect_operating_system_cache) {
	$detect_operating_system_cache = "$module_var_directory/oscache";
	}

our @webmin_date_formats = ( "dd/mon/yyyy", "dd/mm/yyyy",
			     "mm/dd/yyyy", "yyyy/mm/dd",
			     "d. mon yyyy", "dd.mm.yyyy", "yyyy-mm-dd" );

our @debug_what_events = ( 'start', 'read', 'write', 'ops', 'procs', 'diff', 'cmd', 'net', 'sql' );

our $record_login_cmd = "$config_directory/login.pl";
our $record_logout_cmd = "$config_directory/logout.pl";
our $record_failed_cmd = "$config_directory/failed.pl";

our $strong_ssl_ciphers = "ECDHE-RSA-AES256-SHA384:AES256-SHA256:AES256-SHA256:HIGH:MEDIUM:+TLSv1:+TLSv1.1:+TLSv1.2:!MD5:!ADH:!aNULL:!eNULL:!NULL:!DH:!ADH:!EDH:!AESGCM";
our $pfs_ssl_ciphers = "EECDH+AES:EDH+AES:-SHA1:EECDH+RC4:EDH+RC4:RC4-SHA:EECDH+AES256:EDH+AES256:AES256-SHA:!aNULL:!eNULL:!EXP:!LOW:!MD5";

our $newmodule_users_file = "$config_directory/newmodules";

our $first_install_file = "$config_directory/first-install";

our $hidden_announce_file = "$module_config_directory/announce-hidden";

our $postpone_reboot_required = "$module_var_directory/postpone-reboot-required";

our $realos_cache_file = "$module_var_directory/realos-cache";

our $password_change_mod = "passwd";
our $password_change_path = "/".$password_change_mod."/change_passwd.cgi";

=head2 setup_ca

Internal function to create all the configuration files needed for the Webmin
client SSL certificate CA.

=cut
sub setup_ca
{
my ($miniserv) = @_;
my $adir = &module_root_directory("acl");
my $conf = &read_file_contents("$adir/openssl.cnf");
my $acl = "$config_directory/acl";
$conf =~ s/DIRECTORY/$acl/g;

&lock_file("$acl/openssl.cnf");
my $cfh = "CONF";
&open_tempfile($cfh, ">$acl/openssl.cnf");
&print_tempfile($cfh, $conf);
&close_tempfile($cfh);
chmod(0600, "$acl/openssl.cnf");
&unlock_file("$acl/openssl.cnf");

&lock_file("$acl/index.txt");
my $ifh = "INDEX";
&open_tempfile($ifh, ">$acl/index.txt");
&close_tempfile($ifh);
chmod(0600, "$acl/index.txt");
&unlock_file("$acl/index.txt");

&lock_file("$acl/serial");
my $sfh = "SERIAL";
&open_tempfile($sfh, ">$acl/serial");
&print_tempfile($sfh, "011E\n");
&close_tempfile($sfh);
chmod(0600, "$acl/serial");
&unlock_file("$acl/serial");

&lock_file("$acl/newcerts");
mkdir("$acl/newcerts", 0700);
chmod(0700, "$acl/newcerts");
&unlock_file("$acl/newcerts");
$miniserv->{'ca'} = "$acl/ca.pem";
}

=head2 install_webmin_module(file, unlink, nodeps, &users|groups)

Installs a webmin module or theme, and returns either an error message
or references to three arrays for descriptions, directories and sizes.
On success or failure, the file is deleted if the unlink parameter is set.
Unless the nodeps parameter is set to 1, any missing dependencies will cause
installation to fail.

Any new modules will be granted to the users and groups named in the fourth
parameter, which must be an array reference.

=cut
sub install_webmin_module
{
my ($file, $need_unlink, $nodeps, $grant) = @_;
my (@mdescs, @mdirs, @msizes);
my (@newmods, @newthemes, $m);
my $install_root_directory = $gconfig{'install_root'} || $root_directory;

# Uncompress the module file if needed
my $two;
open(MFILE, "<".$file);
read(MFILE, $two, 2);
close(MFILE);
if ($two eq "\037\235") {
	if (!&has_command("uncompress")) {
		unlink($file) if ($need_unlink);
		return &text('install_ecomp', "<tt>uncompress</tt>");
		}
	my $temp = $file =~ /\/([^\/]+)\.Z/i ? &transname("$1")
						: &transname();
	my $out = &backquote_command("uncompress -c ".&quote_path($file).
				     " 2>&1 >$temp");
	unlink($file) if ($need_unlink);
	if ($?) {
		unlink($temp);
		return &text('install_ecomp2', $out);
		}
	$file = $temp;
	$need_unlink = 1;
	}
elsif ($two eq "\037\213") {
	if (!&has_command("gunzip") && !&has_command("gzip")) {
		unlink($file) if ($need_unlink);
		return &text('install_egzip', "<tt>gunzip</tt>");
		}
	my $temp = $file =~ /\/([^\/]+)\.gz/i ? &transname("$1")
						 : &transname();
	my $cmd = &has_command("gunzip") ? "gunzip -c" : "gzip -d -c";
	my $out = &backquote_command($cmd." ".&quote_path($file).
					"  2>&1 >$temp");
	unlink($file) if ($need_unlink);
	if ($? || !-s $temp) {
		unlink($temp);
		return &text('install_egzip2', $out);
		}
	$file = $temp;
	$need_unlink = 1;
	}
elsif ($two eq "BZ") {
	if (!&has_command("bunzip2")) {
		unlink($file) if ($need_unlink);
		return &text('install_ebunzip', "<tt>bunzip2</tt>");
		}
	my $temp = $file =~ /\/([^\/]+)\.gz/i ? &transname("$1")
						 : &transname();
	my $out = &backquote_command("bunzip2 -c ".&quote_path($file).
				     " 2>&1 >$temp");
	unlink($file) if ($need_unlink);
	if ($?) {
		unlink($temp);
		return &text('install_ebunzip2', $out);
		}
	$file = $temp;
	$need_unlink = 1;
	}

# Check if this is an RPM webmin module or theme
my ($type, $redirect_to);
$type = &read_file_contents("$root_directory/install-type");
chop($type) if ($type);
my $out;
if ($type eq 'rpm' && $file =~ /\.rpm$/i &&
    ($out = &backquote_command("rpm -qp $file 2>/dev/null"))) {
	# Looks like an RPM of some kind, hopefully an RPM webmin module
	# or theme
	my (%minfo, %tinfo, $name);
	if ($out !~ /(^|\n)(wbm|wbt)-([a-z\-]+[a-z])/) {
		unlink($file) if ($need_unlink);
		return $text{'install_erpm'};
		}
	$redirect_to = $name = $3;
	$out = &backquote_logged("rpm -Uv \"$file\" 2>&1");
	if ($?) {
		unlink($file) if ($need_unlink);
		return &text('install_eirpm', "<tt>$out</tt>");
		}
	&flush_webmin_caches();

	$mdirs[0] = &module_root_directory($name);
	if (%minfo = &get_module_info($name)) {
		# Get the new module info
		$mdescs[0] = $minfo{'desc'};
		$msizes[0] = &disk_usage_kb($mdirs[0]);
		@newmods = ( $name );

		# Update the ACL for this user
		&grant_user_module($grant, [ $name ]);
		&webmin_log("install", undef, $name,
			    { 'desc' => $mdescs[0] });
		}
	elsif (%tinfo = &get_theme_info($name)) {
		# Get the theme info
		$mdescs[0] = $tinfo{'desc'};
		$msizes[0] = &disk_usage_kb($mdirs[0]);
		@newthemes = ( $name );
		&webmin_log("tinstall", undef, $name,
			    { 'desc' => $mdescs[0] });
		}
	else {
		unlink($file) if ($need_unlink);
		return $text{'install_eneither'};
		}
	}
else {
	# Check if this is a valid module (a tar file of multiple module or
	# theme directories)
	my (%mods, %hasfile);
	&has_command("tar") || return $text{'install_enotar'};
	my $tar = &backquote_command("tar tf ".&quote_path($file)." 2>&1");
	if ($?) {
		unlink($file) if ($need_unlink);
		return &text('install_etar', $tar);
		}
	foreach my $f (split(/\n/, $tar)) {
		if ($f =~ /^\.\/([^\/]+)\/(.*)$/ || $f =~ /^([^\/]+)\/(.*)$/) {
			$redirect_to = $1 if (!$redirect_to);
			$mods{$1}++;
			$hasfile{$1,$2}++;
			}
		}
	foreach $m (keys %mods) {
		if (!$hasfile{$m,"module.info"} && !$hasfile{$m,"theme.info"}) {
			unlink($file) if ($need_unlink);
			return &text('install_einfo', "<tt>$m</tt>");
			}
		}
	if (!%mods) {
		unlink($file) if ($need_unlink);
		return $text{'install_enone'};
		}

	# Get the module.info or theme.info files to check dependencies
	my $ver = &get_webmin_version();
	my $tmpdir = &transname();
	mkdir($tmpdir, 0700);
	my $err;
	my @realmods;
	foreach $m (keys %mods) {
		next if (!$hasfile{$m,"module.info"} &&
			 !$hasfile{$m,"theme.info"});
		push(@realmods, $m);
		my %minfo;
		system("cd $tmpdir ; tar xf \"$file\" $m/module.info ./$m/module.info $m/theme.info ./$m/theme.info >/dev/null 2>&1");
		if (!&read_file("$tmpdir/$m/module.info", \%minfo) &&
		    !&read_file("$tmpdir/$m/theme.info", \%minfo)) {
			$err = &text('install_einfo', "<tt>$m</tt>");
			}
		elsif (!&check_os_support(\%minfo)) {
			$err = &text('install_eos', "<tt>$m</tt>",
				     $gconfig{'real_os_type'},
				     $gconfig{'real_os_version'});
			}
		elsif ($minfo{'usermin'} && !$minfo{'webmin'}) {
			$err = &text('install_eusermin', "<tt>$m</tt>");
			}
		elsif (!$nodeps) {
			my $deps = $minfo{'webmin_depends'} ||
				   $minfo{'depends'} || "";
			foreach my $dep (split(/\s+/, $deps)) {
				if ($dep =~ /^[0-9\.]+$/) {
					# Depends on some version of webmin
					if ($dep > $ver) {
						$err = &text('install_ever',
							"<tt>$m</tt>",
							"<tt>$dep</tt>");
						}
					}
				elsif ($dep =~ /^(\S+)\/([0-9\.]+)$/) {
					# Depends on a specific version of
					# some other module
					my ($dmod, $dver) = ($1, $2);
					my %dinfo = &get_module_info($dmod);
					if (!$mods{$dmod} &&
					    (!%dinfo ||
					     $dinfo{'version'} < $dver)) {
						$err = &text('install_edep2',
							"<tt>$m</tt>",
							"<tt>$dmod</tt>",
							"<tt>$dver</tt>");
						}
					}
				elsif (!&foreign_exists($dep) &&
				       !$mods{$dep}) {
					# Depends on some other module
					$err = &text('install_edep',
					        "<tt>$m</tt>", "<tt>$dep</tt>");
					}
				}
			foreach my $dep (split(/\s+/, $minfo{'perldepends'} || "")) {
				eval "use $dep";
				if ($@) {
					$err = &text('install_eperldep',
					     "<tt>$m</tt>", "<tt>$dep</tt>",
					     "@{[&get_webprefix()]}/cpan/download.cgi?source=3&cpan=$dep");
					}
				}
			}
		last if ($err);
		}
	system("rm -rf $tmpdir >/dev/null 2>&1");
	if ($err) {
		unlink($file) if ($need_unlink);
		return $err;
		}

	# Delete modules or themes being replaced
	my $oldpwd = &get_current_dir();
	chdir($root_directory);
	my @grantmods;
	foreach $m (@realmods) {
		push(@grantmods, $m) if (!&foreign_exists($m));
		if ($m ne "webmin") {
			system("rm -rf ".quotemeta("$install_root_directory/$m")." 2>&1 >/dev/null");
			}
		}

	# Extract all the modules and update perl path and ownership
	my $out = &backquote_command(
		"cd $install_root_directory ; tar xf ".&quote_path($file).
		" 2>&1 >/dev/null");
	chdir($oldpwd);
	if ($?) {
		unlink($file) if ($need_unlink);
		return &text('install_eextract', $out);
		}
	if ($need_unlink) { unlink($file); }
	&flush_webmin_caches();
	my $perl = &get_perl_path();
	my @st = stat("$module_root_directory/index.cgi");
	foreach my $moddir (keys %mods) {
		my $pwd = &module_root_directory($moddir);
		if ($hasfile{$moddir,"module.info"}) {
			my %minfo = &get_module_info($moddir);
			push(@mdescs, $minfo{'desc'});
			push(@mdirs, $pwd);
			push(@msizes, &disk_usage_kb($pwd));
			&webmin_log("install", undef, $moddir,
				    { 'desc' => $minfo{'desc'} });
			push(@newmods, $moddir);
			}
		else {
			my %tinfo = &get_theme_info($moddir);
			push(@mdescs, $tinfo{'desc'});
			push(@mdirs, $pwd);
			push(@msizes, &disk_usage_kb($pwd));
			push(@newthemes, $moddir);
			&webmin_log("tinstall", undef, $moddir,
				    { 'desc' => $tinfo{'desc'} });
			}
		system("cd $install_root_directory ; (find $pwd -name '*.cgi' ; find $pwd -name '*.pl') 2>/dev/null | $perl $root_directory/perlpath.pl $perl -");
		system("cd $install_root_directory ; chown -R $st[4]:$st[5] $pwd");
		}

	# Copy appropriate config file from modules to /etc/webmin
	my @permmods = grep { !-d "$config_directory/$_" } @newmods;
	system("cd $root_directory && $perl $root_directory/copyconfig.pl ".
	       quotemeta("$gconfig{'os_type'}/$gconfig{'real_os_type'}")." ".
	       quotemeta("$gconfig{'os_version'}/$gconfig{'real_os_version'}")." ".
	       quotemeta($install_root_directory)." ".
	       quotemeta($config_directory)." ".
	       join(' ', @realmods)." >/dev/null");

	# Set correct permissions on *new* config directory
	if (&supports_users()) {
		my @mydir = stat($module_config_directory);
		my $myuser = @mydir ? $mydir[4] : "root";
		my $mygroup = @mydir ? $mydir[5] : "bin";
		my $myperms = @mydir ? sprintf("%o", $mydir[2] & 0777) : "og-rw";
		foreach my $m (@permmods) {
			system("chown -R $myuser $config_directory/$m");
			system("chgrp -R $mygroup $config_directory/$m");
			system("chmod -R $myperms $config_directory/$m");
			}
		}

	# Set reasonable permissions on install directory
	if (&supports_users()) {
		foreach my $m (@newmods) {
			system("chmod -R o-w $root_directory/$m");
			}
		}

	# Update ACL for this user so they can access the new modules
	&grant_user_module($grant, \@grantmods);
	}
&flush_webmin_caches();

# Run post-install scripts
foreach $m (@newmods, @newthemes) {
	next if (!-r &module_root_directory($m)."/postinstall.pl");
	eval {
		local $main::error_must_die = 1;
		&foreign_require($m, "postinstall.pl");
		&foreign_call($m, "module_install");
		};
	}

return [ \@mdescs, \@mdirs, \@msizes ];
}

=head2 grant_user_module(&users/groups, &modules)

Grants users or groups access to a set of modules. The users parameter must
be an array ref of usernames or group names, and modules must be an array
ref of module names.

=cut
sub grant_user_module
{
# Grant to appropriate users
my %acl;
&read_acl(undef, \%acl);
my $fh = "GRANTS";
&open_tempfile($fh, ">".&acl_filename());
my $u;
foreach $u (keys %acl) {
	my @mods = @{$acl{$u}};
	if (!$_[0] || &indexof($u, @{$_[0]}) >= 0) {
		@mods = &unique(@mods, @{$_[1]});
		}
	&print_tempfile($fh, "$u: ",join(' ', @mods),"\n");
	}
&close_tempfile($fh);

# Grant to appropriate groups
if ($_[1] && &foreign_check("acl")) {
	&foreign_require("acl", "acl-lib.pl");
	my @groups = &acl::list_groups();
	my @users = &acl::list_users();
	foreach my $g (@groups) {
		if (&indexof($g->{'name'}, @{$_[0]}) >= 0) {
			$g->{'modules'} = [ &unique(@{$g->{'modules'}},
					    	    @{$_[1]}) ];
			&acl::modify_group($g->{'name'}, $g);
			&acl::update_members(\@users, \@groups, $g->{'modules'},
					     $g->{'members'});
			}
		}
	}
}

=head2 delete_webmin_module(module, [delete-acls])

Deletes some webmin module, clone or theme, and return a description of
the thing deleted. If the delete-acls flag is set, all .acl files are
removed too.

=cut
sub delete_webmin_module
{
my $m = $_[0];
return undef if (!$m);
my %minfo = &get_module_info($m);
%minfo = &get_theme_info($m) if (!%minfo);
return undef if (!%minfo);
my ($mdesc, @aclrm);
@aclrm = ( $m ) if ($_[1]);
if ($minfo{'clone'}) {
	# Deleting a clone
	my %cinfo;
	&read_file("$config_directory/$m/clone", \%cinfo);
	unlink(&module_root_directory($m));
	system("rm -rf $config_directory/$m");
	if ($gconfig{'theme'}) {
		unlink("$root_directory/$gconfig{'theme'}/$m");
		}
	$mdesc = &text('delete_desc1', $minfo{'desc'}, $minfo{'clone'});
	}
else {
	# Delete any clones of this module
	my @clones;
	my $mdir = &module_root_directory($m);
	my @mst = stat($mdir);
	foreach my $r (@root_directories) {
		opendir(DIR, $r);
		foreach my $l (readdir(DIR)) {
			my @lst = stat("$r/$l");
			if (-l "$r/$l" && $lst[1] == $mst[1]) {
				unlink("$r/$l");
				system("rm -rf $config_directory/$l");
				push(@clones, $l);
				}
			}
		closedir(DIR);
		}

	my $type = '';
	if (open(TYPE, "<$mdir/install-type")) {
		chop($type = <TYPE>);
		close(TYPE);
		}

	# Run the module's uninstall script
	if (&check_os_support(\%minfo) &&
	    -r "$mdir/uninstall.pl") {
		eval {
			&foreign_require($m, "uninstall.pl");
			&foreign_call($m, "module_uninstall");
			};
		}

	# Deleting the real module
	my $size = &disk_usage_kb($mdir);
	$mdesc = &text('delete_desc2', "<b>$minfo{'desc'}</b>",
			   "<tt>$mdir</tt>", $size);
	if ($type eq 'rpm') {
		# This module was installed from an RPM .. rpm -e it
		&system_logged("rpm -e wbm-$m");
		}
	else {
		# Module was installed from a .wbm file .. just rm it
		&system_logged("rm -rf ".quotemeta($mdir));
		}

	if ($_[1]) {
		# Delete any .acl files
		&system_logged("rm -f $config_directory/$m/*.acl");
		push(@aclrm, @clones);
		}
	}

# Delete from all users and groups
if (@aclrm) {
	&foreign_require("acl", "acl-lib.pl");
	my ($u, $g, $m);
	foreach $u (&acl::list_users()) {
		my $changed;
		foreach $m (@aclrm) {
			my $mi = &indexof($m, @{$u->{'modules'}});
			my $oi = &indexof($m, @{$u->{'ownmods'}});
			splice(@{$u->{'modules'}}, $mi, 1) if ($mi >= 0);
			splice(@{$u->{'ownmods'}}, $oi, 1) if ($oi >= 0);
			$changed++ if ($mi >= 0 || $oi >= 0);
			}
		&acl::modify_user($u->{'name'}, $u) if ($changed);
		}
	foreach $g (&acl::list_groups()) {
		my $changed;
		foreach $m (@aclrm) {
			my $mi = &indexof($m, @{$g->{'modules'}});
			my $oi = &indexof($m, @{$g->{'ownmods'}});
			splice(@{$g->{'modules'}}, $mi, 1) if ($mi >= 0);
			splice(@{$g->{'ownmods'}}, $oi, 1) if ($oi >= 0);
			$changed++ if ($mi >= 0 || $oi >= 0);
			}
		&acl::modify_group($g->{'name'}, $g) if ($changed);
		}
	}

&webmin_log("delete", undef, $m, { 'desc' => $minfo{'desc'} });
return $mdesc;
}

=head2 file_basename(name)

Returns the part of a filename after the last /.

=cut
sub file_basename
{
my $rv = $_[0];
$rv =~ s/^.*[\/\\]//;
return $rv;
}

=head2 gnupg_setup

Setup gnupg so that rpms and .tar.gz files can be verified.
Returns 0 if ok, 1 if gnupg is not installed, or 2 if something went wrong
Assumes that gnupg-lib.pl is available

=cut
sub gnupg_setup
{
return ( 1, &text('enogpg', "<tt>gpg</tt>") ) if (!&has_command($gpgpath));

my ($ok, $err) = &import_gnupg_key(
	$webmin_key_email, $webmin_key_fingerprint,
	"$module_root_directory/jcameron-key.asc");
return ($ok, $err) if ($ok);

($ok, $err) = &import_gnupg_key(
	$authentic_key_email, $authentic_key_fingerprint,
	"$root_directory/authentic-theme/THEME.pgp");
return ($ok, $err) if ($ok);

return (0);
}

=head2 import_gnupg_key(email, fingerprint, keyfile)

Imports the given key if not already in the key list

=cut
sub import_gnupg_key
{
my ($email, $finger, $path) = @_;
return (0) if (!-r $path);

# Check if we already have the key
my @keys = &list_keys();
foreach my $k (@keys) {
	my $fp = &key_fingerprint($k);
	# Key already been imported with correct contact
	if ($k->{'email'}->[0] eq $email && $fp && $fp eq $finger) {
		return (0);
		}
	# Key been imported before but contact changed, delete first
	elsif ($k->{'email'}->[0] ne $email && $fp && $fp eq $finger) {
		my $lfinger = $finger;
		$lfinger =~ s/\s+//g;
		my $out = &backquote_logged("$gpgpath --batch --delete-key ".quotemeta($lfinger)." 2>&1");
		if ($?) {
			return (2, $out);
			}
		}
	}

# Import it if not
&list_keys();
my $out = &backquote_logged("$gpgpath --import ".quotemeta($path)." 2>&1");
if ($?) {
	return (2, $out);
	}
return (0);
}

=head2 list_standard_modules

Returns a list containing the short names, URLs and descriptions of the
standard Webmin modules from www.webmin.com. If an error occurs, returns the
message instead.

=cut
sub list_standard_modules
{
my $temp = &transname();
my $error;
my ($host, $port, $page, $ssl);
if ($config{'standard_url'}) {
	($host, $port, $page, $ssl) = &parse_http_url($config{'standard_url'});
	return $text{'standard_eurl'} if (!$host);
	}
else {
	($host, $port, $page, $ssl) = ($standard_host, $standard_port,
				       $standard_page, $standard_ssl);
	}
&http_download($host, $port, $page, $temp, \$error, undef, $ssl);
return $error if ($error);
my @rv;
open(TEMP, "<".$temp);
while(<TEMP>) {
	s/\r|\n//g;
	my @l = split(/\t+/, $_);
	push(@rv, \@l);
	}
close(TEMP);
unlink($temp);
return \@rv;
}

=head2 standard_chooser_button(input, [form])

Returns HTML for a popup button for choosing a standard module.

=cut
sub standard_chooser_button
{
return &popup_window_button("standard_chooser.cgi", 800, 500, 1,
	[ [ "ifield", $_[0], "mod" ] ]);
}

=head2 list_third_modules

Returns a list containing the names, versions, URLs and descriptions of the
third-party Webmin modules from thirdpartymodules.webmin.com. If an error
occurs, returns the message instead.

=cut
sub list_third_modules
{
my $temp = &transname();
my $error;
my ($host, $port, $page, $ssl);
if ($config{'third_url'}) {
	($host, $port, $page, $ssl) = &parse_http_url($config{'third_url'});
	return $text{'third_eurl'} if (!$host);
	}
else {
	($host, $port, $page, $ssl) = ($third_host, $third_port,
				       $third_page, $third_ssl);
	}
&http_download($host, $port, $page, $temp, \$error, undef, $ssl);
return $error if ($error);
my @rv;
open(TEMP, "<".$temp);
while(<TEMP>) {
	s/\r|\n//g;
	my @l = split(/\t+/, $_);
	push(@rv, \@l);
	}
close(TEMP);
unlink($temp);
return \@rv;
}

=head2 third_chooser_button(input, [form])

Returns HTML for a popup button for choosing a third-party module.

=cut
sub third_chooser_button
{
return &popup_window_button("third_chooser.cgi", 800, 500, 1,
	[ [ "ifield", $_[0], "mod" ] ]);
}

=head2 get_webmin_base_version

Gets the webmin version, rounded to the nearest .01

=cut
sub get_webmin_base_version
{
return &base_version(&get_webmin_version());
}

=head2 base_version

Rounds a version number down to the nearest .01

=cut
sub base_version
{
my ($ver) = @_;
#remove waning about (possible) postfixes from update-from-repo.sh
$ver =~ s/[-a-z:_].*//gi;
if ($ver =~ /^((\d+)\.(\d+))\.*/) {
	$ver = $1;
	}
return sprintf("%.2f0", $ver);
}

=head2 get_newmodule_users

Returns a ref to an array of users to whom new modules are granted by default,
or undef if the admin hasn't chosen any yet.

=cut
sub get_newmodule_users
{
if (open(NEWMODS, "<".$newmodule_users_file)) {
	my @rv;
	while(<NEWMODS>) {
		s/\r|\n//g;
		push(@rv, $_) if (/\S/);
		}
	close(NEWMODS);
	return \@rv;
	}
else {
	return undef;
	}
}

=head2 save_newmodule_users(&users)

Saves the list of users to whom new modules are granted. If undef is given,
the default behaviour (of using root or admin) is used.

=cut
sub save_newmodule_users
{
&lock_file($newmodule_users_file);
if ($_[0]) {
	my $fh = "NEWUSERS";
	&open_tempfile($fh, ">$newmodule_users_file");
	foreach my $u (@{$_[0]}) {
		&print_tempfile($fh, "$u\n");
		}
	&close_tempfile($fh);
	}
else {
	unlink($newmodule_users_file);
	}
&unlock_file($newmodule_users_file);
}

=head2 get_miniserv_sockets(&miniserv)

Returns an array of tuple refs, each of which contains an IP address and port
number that Webmin listens on. The IP can be * (meaning any), and the port can
be * (meaning the primary port).

=cut
sub get_miniserv_sockets
{
my @sockets;
push(@sockets, [ $_[0]->{'bind'} || "*", $_[0]->{'port'} ]);
foreach my $s (split(/\s+/, $_[0]->{'sockets'} || "")) {
	if ($s =~ /^(\d+)$/) {
		# Just listen on another port on the main IP
		push(@sockets, [ $sockets[0]->[0], $s ]);
		}
	elsif ($s =~ /^(\S+):(\d+)$/) {
		# Listen on a specific port and IP
		push(@sockets, [ $1, $2 ]);
		}
	elsif ($s =~ /^([0-9\.]+):\*$/ || $s =~ /^([0-9\.]+)$/ ||
	       $s =~ /^([a-f0-9:]+):\*$/ || $s =~ /^([a-f0-9:]+)$/) {
		# Listen on the main port on another IP
		push(@sockets, [ $1, "*" ]);
		}
	}
return @sockets;
}

=head2 fetch_updates(url, [login, pass], [sig-mode])

Returns a list of updates from some URL, or calls &error. Each element is an
array reference containing :

=item Module directory name.

=item Version number.

=item Absolute or relative download URL.

=item Operating systems the update is relevant for, in the same format as the os_support line in a module.info file.

=item Human-readable description of the update.

The parameters are :

=item url - Full URL to download updates from.

=item login - Optional login for the URL.

=item pass - Optional password for the URL.

=item sig-mode - 0=No check, 1=Check if possible, 2=Must check

=cut
sub fetch_updates
{
my ($url, $user, $pass, $sigmode) = @_;
my ($host, $port, $page, $ssl) = &parse_http_url($url);
$host || &error($text{'update_eurl'});

# Download the file
my $temp = &transname();
&retry_http_download($host, $port, $page, $temp, undef, undef, $ssl, $user, $pass,
	       0, 0, 1);

# Download the signature, if we can check it
my ($ec, $emsg) = &gnupg_setup();
if (!$ec && $sigmode) {
	my $err;
	my $sig;
	&retry_http_download($host, $port, $page."-sig.asc", \$sig,
		       \$err, undef, $ssl, $user, $pass, 0, 0, 1);
	if ($err) {
		$sigmode == 2 && &error(&text('update_enosig', $err));
		}
	else {
		my $data = &read_file_contents($temp);
		my ($vc, $vmsg) = &verify_data($data, $sig);
		if ($vc > 1) {
			&error(&text('update_ebadsig',
				&text('upgrade_everify'.$vc, $vmsg)));
			}
		}
	}

my @updates;
open(UPDATES, "<".$temp);
while(<UPDATES>) {
	if (/^([^\t]+)\t+([^\t]+)\t+([^\t]+)\t+([^\t]+)\t+(.*)/) {
		push(@updates, [ $1, $2, $3, $4, $5 ]);
		}
	}
close(UPDATES);
unlink($temp);
@updates || &error($text{'update_efile'});

return ( \@updates, $host, $port, $page, $ssl );
}

=head2 check_update_signature(host, port, page, ssl, user, pass, file, sig-mode)

Given a downloaded module update file, fetch the signature from the same URL
with -sig.asc appended, and check that it is valid. Parameters are :

=item host - Module download host

=item port - Module download port

=item page - Module download URL path

=item ssl - Use SSL to download?

=item user - Login for module download

=item pass - Password for module download

=item file - File containing module to check

=item sig-mode - 0=No check, 1=Check if possible, 2=Must check

=cut
sub check_update_signature
{
my ($host, $port, $page, $ssl, $user, $pass, $file, $sigmode) = @_;

my ($ec, $emsg) = &gnupg_setup();
if (!$ec && $sigmode) {
	my $err;
	my $sig;
	&http_download($host, $port, $page."-sig.asc", \$sig,
		       \$err, undef, $ssl, $user, $pass);
	if ($err) {
                $sigmode == 2 && return &text('update_enomodsig', $err);
                }
	else {
		my $data = &read_file_contents($file);
		my ($vc, $vmsg) = &verify_data($data, $sig);
		if ($vc > 1) {
			return &text('update_ebadmodsig',
				&text('upgrade_everify'.$vc, $vmsg));
			}
		}
	}
return undef;
}

=head2 find_cron_job(\@jobs)

Finds the cron job for Webmin updates, given an array ref of cron jobs
as returned by cron::list_cron_jobs

=cut
sub find_cron_job
{
my ($jobs) = @_;
my ($job) = grep { $_->{'user'} eq 'root' &&
		   $_->{'command'} eq $cron_cmd } @$jobs;
return $job;
}

=head2 get_ipkeys(&miniserv)

Returns a list of IP address to key file mappings from a miniserv.conf entry.

=cut
sub get_ipkeys
{
my @rv;
foreach my $k (keys %{$_[0]}) {
	if ($k =~ /^ipkey_(\S+)/) {
		my $ipkey = { 'ips' => [ split(/,/, $1) ],
			      'key' => $_[0]->{$k},
			      'index' => scalar(@rv) };
		$ipkey->{'cert'} = $_[0]->{'ipcert_'.$1};
		$ipkey->{'extracas'} = $_[0]->{'ipextracas_'.$1};
		push(@rv, $ipkey);
		}
	}
return @rv;
}

=head2 save_ipkeys(&miniserv, &keys)

Updates miniserv.conf entries from the given list of keys.

=cut
sub save_ipkeys
{
my $k;
foreach $k (keys %{$_[0]}) {
	if ($k =~ /^(ipkey_|ipcert_|ipextracas_)/) {
		delete($_[0]->{$k});
		}
	}
foreach $k (@{$_[1]}) {
	my $ips = join(",", @{$k->{'ips'}});
	$_[0]->{'ipkey_'.$ips} = $k->{'key'};
	if ($k->{'cert'}) {
		$_[0]->{'ipcert_'.$ips} = $k->{'cert'};
		}
	else {
		delete($_[0]->{'ipcert_'.$ips});
		}
	if ($k->{'extracas'}) {
		$_[0]->{'ipextracas_'.$ips} = $k->{'extracas'};
		}
	else {
		delete($_[0]->{'ipextracas_'.$ips});
		}
	}
}

=head2 validate_key_cert(key, [cert])

Call &error if some key and cert file don't look correct, based on the BEGIN
line.

=cut
sub validate_key_cert
{
my ($keyfile, $certfile) = @_;
-r $keyfile || return &error(&text('ssl_ekey', $keyfile));
my $key = &read_file_contents($keyfile);
$key =~ /BEGIN (RSA |EC )?PRIVATE KEY/i ||  
	&error(&text('ssl_ekey2', $keyfile));
if (!$certfile) {
	$key =~ /BEGIN CERTIFICATE/ || &error(&text('ssl_ecert2', $keyfile));
	}
else {
	-r $certfile || return &error(&text('ssl_ecert', $certfile));
	my $cert = &read_file_contents($certfile);
	$cert =~ /BEGIN CERTIFICATE/ || &error(&text('ssl_ecert2', $certfile));
	}
}

=head2 detect_operating_system([os-list-file], [with-cache])

Returns a hash containing os_type, os_version, real_os_type and
real_os_version, suitable for the current system.

=cut
sub detect_operating_system
{
my $file = $_[0] || "$root_directory/os_list.txt";
my $cache = $_[1];
if ($cache) {
	# Check the cache file, and only re-check the OS if older than
	# 1 day, or if we have rebooted recently
	my %cache;
	my $uptime = &get_system_uptime();
	my $lastreboot = $uptime ? time()-$uptime : undef;
	if (&read_file($detect_operating_system_cache, \%cache) &&
	    $cache{'os_type'} && $cache{'os_version'} &&
	    $cache{'real_os_type'} && $cache{'real_os_version'}) {
		if ($cache{'time'} > time()-24*60*60 &&
		    $cache{'time'} > $lastreboot) {
			return %cache;
			}
		}
	}
my $temp = &transname();
my $perl = &get_perl_path();
system("$root_directory/oschooser.pl $file $temp 1");
my %rv;
&read_env_file($temp, \%rv);
$rv{'time'} = time();
&write_file($detect_operating_system_cache, \%rv);
return %rv;
}

=head2 show_webmin_notifications([no-updates])

Print various notifications for the current user, if any. These can include
password expiry, Webmin updates and more.

=cut
sub show_webmin_notifications
{
my ($noupdates) = @_;
my @notifs = &get_webmin_notifications($noupdates);
if (@notifs) {
	print "<center>\n",join("<hr>\n", @notifs),"</center>\n";
	}
}

=head2 get_webmin_notifications([no-updates])

Returns a list of Webmin notification messages, each of which is a string of
HTML. If the no-updates flag is set, Webmin version / module updates are
not included.

=cut
sub get_webmin_notifications
{
my ($noupdates) = @_;
$noupdates = 1 if (&shared_root_directory());
my @notifs;
my %miniserv;
&get_miniserv_config(\%miniserv);
&load_theme_library();	# So that UI functions work

# Need OS upgrade, but only once per day
# XXX use a cache
my $now = time();
if (&foreign_available("webmin")) {
	my %realos;
	my @st = stat($realos_cache_file);
	if (!@st || $now - $st[9] > 24*60*60) {
		%realos = &detect_operating_system(undef, 1);
		&write_file($realos_cache_file, \%realos);
		}
	else {
		&read_file($realos_cache_file, \%realos);
		}
	if (($realos{'os_version'} ne $gconfig{'os_version'} ||
	     $realos{'real_os_version'} ne $gconfig{'real_os_version'} ||
	     $realos{'os_type'} ne $gconfig{'os_type'}) &&
	    $realos{'os_version'} && $realos{'os_type'} &&
	    &foreign_available("webmin")) {

		# Tell the user that OS version was updated
		push(@notifs,
		    &ui_form_start("@{[&get_webprefix()]}/webmin/fix_os.cgi").
		    &text('os_incorrect',
			  $realos{'real_os_type'},
			  $realos{'real_os_version'}).
		    &show_os_release_notes($realos{'real_os_version'}).
		    "<p>\n".
		    &ui_form_end([ [ undef, $text{'os_fix'} ] ])
		    );
		}
	}

# Password close to expiry
my $warn_days = $config{'warn_days'};
if (&foreign_check("acl")) {
	# Get the Webmin user
	&foreign_require("acl", "acl-lib.pl");
	my @users = &acl::list_users();
	my ($uinfo) = grep { $_->{'name'} eq $base_remote_user } @users;
	if ($uinfo && $uinfo->{'pass'} eq 'x' && &foreign_check("useradmin")) {
		# Unix auth .. check password in Users and Groups
		&foreign_require("useradmin", "user-lib.pl");
		($uinfo) = grep { $_->{'user'} eq $remote_user }
				&useradmin::list_users();
		if ($uinfo && $uinfo->{'warn'} && $uinfo->{'change'} &&
		    $uinfo->{'max'}) {
			my $daysago = int(time()/(24*60*60)) -
					 $uinfo->{'change'};
			my $cdate = &make_date(
				$uinfo->{'change'}*24*60*60, 1);
			if ($daysago > $uinfo->{'max'}) {
				# Passed expiry date
				push(@notifs, &text('notif_unixexpired',
						    $cdate));
				}
			elsif ($daysago > $uinfo->{'max'}-$uinfo->{'warn'}) {
				# Passed warning date
				push(@notifs, &text('notif_unixwarn',
						    $cdate,
						    $uinfo->{'max'}-$daysago));
				}
			}
		}
	elsif ($uinfo && $uinfo->{'lastchange'}) {
		# Webmin auth .. check password in Webmin
		my $daysold = (time() - $uinfo->{'lastchange'})/(24*60*60);
		my $link = &foreign_available("change-user") ?
			&text('notif_changenow',
			     "@{[&get_webprefix()]}/change-user/")."<p>\n" : "";
		if ($miniserv{'pass_maxdays'} &&
		    $daysold > $miniserv{'pass_maxdays'}) {
			# Already expired
			push(@notifs, &text('notif_passexpired')."<p>\n".$link);
			}
		elsif ($miniserv{'pass_maxdays'} &&
		       $daysold > $miniserv{'pass_maxdays'} - $warn_days) {
			# About to expire
			push(@notifs, &text('notif_passchange',
				&make_date($uinfo->{'lastchange'}, 1),
				int($miniserv{'pass_maxdays'} - $daysold)).
				"<p>\n".$link);
			}
		elsif ($miniserv{'pass_lockdays'} &&
		       $daysold > $miniserv{'pass_lockdays'} - $warn_days) {
			# About to lock out
			push(@notifs, &text('notif_passlock',
				&make_date($uinfo->{'lastchange'}, 1),
				int($miniserv{'pass_maxdays'} - $daysold)).
				"<p>\n".$link);
			}
		}
	}

# New Webmin version is available, but only once per day
my %raccess = &get_module_acl('root');
my %rdisallow = map { $_, 1 } split(/\s+/, $raccess{'disallow'} || "");
my %access = &get_module_acl();
my %disallow = map { $_, 1 } split(/\s+/, $access{'disallow'} || "");
my %allow = map { $_, 1 } split(/\s+/, $access{'allow'} || "");
if (&foreign_available($module_name) && !$gconfig{'nowebminup'} &&
    !$noupdates && ($allow{'upgrade'} ||
		    (!$disallow{'upgrade'} && !$rdisallow{'upgrade'}))) {
	if (!$config{'last_version_check'} ||
	    $now - $config{'last_version_check'} > 24*60*60) {
		# Cached last version has expired .. re-fetch
		my ($ok, $version, $release) = &get_latest_webmin_version();
		if ($ok) {
			$config{'last_version_check'} = $now;
			$config{'last_version_number'} = $version;
			$config{'last_version_release'} = $release;
			$config{'last_version_full'} =
				$version.($release ? "-".$release : "");
			&save_module_config();
			}
		}
	my $minor_release =
		$config{'last_version_release'} &&
		$config{'last_version_release'} >= 2;
	my $full = &get_webmin_full_version();
	if ($config{'last_version_full'} &&
	    &compare_version_numbers($config{'last_version_full'}, $full) > 0) {
		# New version is out there .. offer to upgrade
		my $mode = &get_install_type();
		my $checksig = 0;
		if ((!$mode || $mode eq "rpm") && &foreign_check("proc")) {
			my ($ec, $emsg) = &gnupg_setup();
			if (!$ec) {
				$checksig = 1;
				}
			}
		my $release_notes_link = " ".
		   &ui_link("https://github.com/webmin/webmin/releases/tag/".
		     	    "$config{'last_version_number'}",
	                    $text{'os_release_notes'}, undef,
	                    'target="_blank" data-link-external="after"').".";
		# $release_notes_link = "" if ($minor_release);
		push(@notifs,
		     &ui_form_start("@{[&get_webprefix()]}/webmin/upgrade.cgi",
				    "form-data").
		     &ui_hidden("source", 2).
		     &ui_hidden("sig", $checksig).
		     &ui_hidden("mode", $mode).
		     &text('notif_upgrade', $config{'last_version_full'}, $full).
		     "$release_notes_link<p>\n".
		     &ui_form_end([ [ undef, $text{'notif_upgradeok'} ] ]));
		}
	}

# Reboot needed
if (&foreign_check("package-updates") && &foreign_available("init")) {
	&foreign_require("package-updates");
	my $allow_reboot_required = 1;
	if (-r $postpone_reboot_required) {
		my $uptime = &get_system_uptime();
		my $lastreboot = $uptime ? time()-$uptime : undef;
		if ($lastreboot) {
			my @prr = stat($postpone_reboot_required);
			if ($lastreboot < $prr[9]) {
				$allow_reboot_required = 0;
				}
			}
		}
	if ($allow_reboot_required && &package_updates::check_reboot_required()) {
		push(@notifs,
			&ui_form_start("@{[&get_webprefix()]}/init/reboot.cgi").
			$text{'notif_reboot'}."<p>\n".
			&ui_form_end([ [ undef, $text{'notif_rebootok'} ],
				       [ 'removenotify', $text{'alert_hide'} ] ]));
		}
	}

return @notifs;
}

=head2 get_system_uptime

Returns the number of seconds the system has been up, or undef if un-available.

=cut
sub get_system_uptime
{
# Try Linux /proc/uptime first
if (open(UPTIME, "</proc/uptime")) {
	my $line = <UPTIME>;
	close(UPTIME);
	my ($uptime, $dummy) = split(/\s+/, $line);
	if ($uptime > 0) {
		return int($uptime);
		}
	}

# Try to parse uptime command output
if ($gconfig{'os_type'} ne 'windows') {
	my $out = &backquote_command("uptime");
	if ($out =~ /up\s+(\d+)\s+day/) {
		return $1*24*60*60;
		}
	elsif ($out =~ /up\s+(\d+)\s+min/) {
		return $1*60;
		}
	elsif ($out =~ /up\s+(\d+)\s+hour/) {
		return $1*60*60;
		}
	elsif ($out =~ /up\s+(\d+):(\d+)/) {
		return $1*60*60 + $2*60;
		}
	}

return undef;
}

=head2 list_operating_systems([os-list-file])

Returns a list of known OSs, each of which is a hash ref with keys :

=item realtype - A human-readable OS name, like Ubuntu Linux.

=item realversion - A human-readable version, like 8.04.

=item type - Webmin's internal OS code, like debian-linux.

=item version - Webmin's internal version number, like 3.1.

=item code - A fragment of Perl that will return true if evaluated on this OS.

=cut
sub list_operating_systems
{
my $file = $_[0] || "$root_directory/os_list.txt";
my @rv;
open(OSLIST, "<".$file);
while(<OSLIST>) {
	if (/^([^\t]+)\t+([^\t]+)\t+([^\t]+)\t+([^\t]+)\t+(.*)/) {
		push(@rv, { 'realtype' => $1,
			    'realversion' => $2,
			    'type' => $3,
			    'version' => $4,
			    'code' => $5 });
		}
	}
close(OSLIST);
return @rv;
}

=head2 shared_root_directory

Returns 1 if the Webmin root directory is shared with another system, such as
via NFS, or in a Solaris zone. If so, updates and module installs are not
allowed.

=cut
sub shared_root_directory
{
if (exists($gconfig{'shared_root'}) && $gconfig{'shared_root'} eq '1') {
	# Always shared
	return 1;
	}
elsif (exists($gconfig{'shared_root'}) && $gconfig{'shared_root'} eq '0') {
	# Definitely not shared
	return 0;
	}
if (&running_in_zone()) {
	# In a Solaris zone .. is the root directory loopback mounted?
	if (&foreign_exists("mount")) {
		&foreign_require("mount", "mount-lib.pl");
		my @rst = stat($root_directory);
		my $m;
		foreach $m (&mount::list_mounted()) {
			my @mst = stat($m->[0]);
			if ($mst[0] == $rst[0] &&
			    &is_under_directory($m->[0], $root_directory)) {
				# Found the mount!
				if ($m->[2] eq "lofs" || $m->[2] eq "nfs") {
					return 1;
					}
				}
			}
		}
	}
return 0;
}

=head2 submit_os_info(id)

Send via email a message about this system's OS and Perl version. Returns
undef if OK, or an error message.

=cut
sub submit_os_info
{
if (!&foreign_installed("mailboxes", 1)) {
	return $text{'submit_emailboxes'};
	}
&foreign_require("mailboxes", "mailboxes-lib.pl");
my $mail = {    'headers' => [ [ 'From', &mailboxes::get_from_address() ],
			       [ 'To', $os_info_address ],
			       [ 'Subject', 'Webmin OS Information' ] ],
		'attach' => [ {
		   'headers' => [ [ 'Content-type', 'text/plain' ] ],
		   'data' => "OS: $gconfig{'real_os_type'}\n".
			     "Version: $gconfig{'real_os_version'}\n".
		 	     "OS code: $gconfig{'os_type'}\n".
		 	     "Version code: $gconfig{'os_version'}\n".
			     "Perl: $]\n".
			     "Webmin: ".&get_webmin_version()."\n".
			     "ID: ".&get_webmin_id()."\n" } ],
		};
eval { &mailboxes::send_mail($mail); };
return $@ ? $@ : undef;
}

=head2 get_webmin_id

Returns a (hopefully) unique ID for this Webmin install.

=cut
sub get_webmin_id
{
if (!$config{'webminid'}) {
	my $salt = substr(time(), -2);
	$config{'webminid'} = &unix_crypt(&get_system_hostname(), $salt);
	&save_module_config();
	}
return $config{'webminid'};
}

=head2 ip_match(ip, [match]+)

Checks an IP address against a list of IPs, networks and networks/masks, and
returns 1 if a match is found.

=cut
sub ip_match
{
my @io = &check_ip6address($_[0]) ? split(/:/, $_[0])
			          : split(/\./, $_[0]);

# Resolve to hostname and check that it forward resolves again
my $hn = &to_hostname($_[0]);
if (&check_ip6address($_[0])) {
	$hn = "" if (&to_ip6address($hn) ne $_[0]);
	}
else {
	$hn = "" if (&to_ipaddress($hn) ne $_[0]);
	}

for(my $i=1; $i<@_; $i++) {
	my $mismatch = 0;
	my $ip = $_[$i];
        if ($ip =~ /^([0-9\.]+)\/(\d+)$/) {
                # Convert CIDR to netmask format
                $ip = $1."/".&prefix_to_mask($2);
                }
	if ($ip =~ /^([0-9\.]+)\/([0-9\.]+)$/) {
		# Compare with IPv4 network/mask
		my @mo = split(/\./, $1);
		my @ms = split(/\./, $2);
		for(my $j=0; $j<4; $j++) {
			if ((int($io[$j]) & int($ms[$j])) != (int($mo[$j]) & int($ms[$j]))) {
				$mismatch = 1;
				}
			}
		}
	elsif ($_[$i] =~ /^([0-9\.]+)-([0-9\.]+)$/) {
		# Compare with an IPv4 range (separated by a hyphen -)
		my ($remote, $min, $max);
		my @low = split(/\./, $1);
		my @high = split(/\./, $2);
		for(my $j=0; $j<4; $j++) {
			$remote += $io[$j] << ((3-$j)*8);
			$min += $low[$j] << ((3-$j)*8);
			$max += $high[$j] << ((3-$j)*8);
			}
		if ($remote < $min || $remote > $max) {
			$mismatch = 1;
			}
		}
	elsif ($ip =~ /^\*(\.\S+)$/) {
		# Compare with hostname regexp
		$mismatch = 1 if ($hn !~ /^.*\Q$1\E$/i);
		}
	elsif ($ip eq 'LOCAL') {
		# Just assume OK for now
		}
	elsif ($_[$i] =~ /^[0-9\.]+$/) {
		# Compare with IPv4 address or network
		my @mo = split(/\./, $_[$i]);
		while(@mo && !$mo[$#mo]) { pop(@mo); }
		for(my $j=0; $j<@mo; $j++) {
			if ($mo[$j] != $io[$j]) {
				$mismatch = 1;
				}
			}
		}
	elsif ($_[$i] =~ /^[a-f0-9:]+$/) {
		# Compare with a full IPv6 address
		if (&canonicalize_ip6($_[$i]) ne canonicalize_ip6($_[0])) {
			$mismatch = 1;
			}
		}
	elsif ($_[$i] =~ /^([a-f0-9:]+)\/(\d+)$/) {
		# Compare with an IPv6 network
		my $v6size = $2;
		my $v6addr = &canonicalize_ip6($1);
		my $bytes = $v6size / 8;
		my @mo = &expand_ipv6_bytes($v6addr);
		my @io = &expand_ipv6_bytes(&canonicalize_ip6($_[0]));
		for(my $j=0; $j<$bytes; $j++) {
			if ($mo[$j] ne $io[$j]) {
				$mismatch = 1;
				}
			}
		}
	elsif ($_[$i] !~ /^[0-9\.]+$/) {
		# Compare with hostname
		$mismatch = 1 if ($_[0] ne &to_ipaddress($_[$i]));
		}
	return 1 if (!$mismatch);
	}
return 0;
}

=head2 expand_ipv6_bytes(address)

Given a canonical IPv6 address, split it into an array of bytes

=cut
sub expand_ipv6_bytes
{
my ($addr) = @_;
my @rv;
foreach my $w (split(/:/, $addr)) {
	$w =~ /^(..)(..)$/ || return ( );
	push(@rv, hex($1), hex($2));
	}
return @rv;
}



=head2 prefix_to_mask(prefix)

Converts a number like 24 to a mask like 255.255.255.0.

=cut
sub prefix_to_mask
{
return $_[0] >= 24 ? "255.255.255.".(256-(2 ** (32-$_[0]))) :
       $_[0] >= 16 ? "255.255.".(256-(2 ** (24-$_[0]))).".0" :
       $_[0] >= 8 ? "255.".(256-(2 ** (16-$_[0]))).".0.0" :
                     (256-(2 ** (8-$_[0]))).".0.0.0";
}

=head2 valid_allow(text)

Returns undef if some text is a valid IP, hostname or network for use in
allowed IPs, or an error message if not

=cut
sub valid_allow
{
my ($h) = @_;
if ($h =~ /^([0-9\.]+)\/(\d+)$/) {
	# IPv4 address/cidr
	&check_ipaddress($1) ||
		return &text('access_enet', "$1");
	$2 >= 0 && $2 <= 32 ||
		return &text('access_ecidr', "$2");
	}
elsif ($h =~ /^([0-9\.]+)\/([0-9\.]+)$/) {
	# IPv4 address/netmask
	&check_ipaddress($1) ||
		return &text('access_enet', "$1");
	&check_ipaddress($2) ||
		return &text('access_emask', "$2");
	}
elsif ($h =~ /^([0-9\.]+)\-([0-9\.]+)$/) {
	# IPv4 address
	&check_ipaddress("$1") ||
		return &text('access_eip', "$1");
	&check_ipaddress("$2") ||
		return &text('access_eip', "$2");
	}
elsif ($h =~ /^[0-9\.]+$/) {
	# IPv4 address
	&check_ipaddress($h) ||
		return &text('access_eip', $h);
	}
elsif ($h =~ /^([a-f0-9:]+)\/(\d+)$/) {
	# IPv6 address/prefix
	&check_ip6address($1) ||
		return &text('access_eip6', $1);
	$2 >= 0 && $2 <= 128 ||
		return &text('access_ecidr6', "$2");
	$2 % 8 == 0 ||
		return &text('access_ecidr8', "$2");
	}
elsif ($h =~ /^[a-f0-9:]+$/) {
	# IPv6 address
	&check_ip6address($h) ||
		return &text('access_eip6', $h);
	}
elsif ($h =~ /^\*\.(\S+)$/) {
	# *.domain is OK
	}
elsif ($h eq 'LOCAL') {
	# Local means any on local nets
	}
elsif (&to_ipaddress($h) || &to_ip6address($h)) {
	# Resolvable hostname
	}
else {
	return &text('access_ehost', $h);
	}
return undef;
}

=head2 get_preloads(&miniserv)

Returns a list of module names and files to pre-load, based on a Webmin
miniserv configuration hash. Each is a two-element array ref containing
a package name and the relative path of the .pl file to pre-load.

=cut
sub get_preloads
{
my @rv = map { [ split(/=/, $_) ] } split(/\s+/, $_[0]->{'preload'} || "");
return @rv;
}

=head2 save_preloads(&miniserv, &preloads)

Updates a Webmin miniserv configuration hash from a list of preloads, in
the format returned by get_preloads.

=cut
sub save_preloads
{
$_[0]->{'preload'} = join(" ", map { "$_->[0]=$_->[1]" } @{$_[1]});
}

=head2 get_tempdirs(&gconfig)

Returns a list of per-module temp directories, each of which is an array
ref containing a module name and directory.

=cut
sub get_tempdirs
{
my ($gconfig) = @_;
my @rv;
foreach my $k (keys %$gconfig) {
	if ($k =~ /^tempdir_(.*)$/) {
		push(@rv, [ $1, $gconfig->{$k} ]);
		}
	}
return sort { $a->[0] cmp $b->[0] } @rv;
}

=head2 save_tempdirs(&gconfig, &tempdirs)

Updates the global config with a list of per-module temp dirs

=cut
sub save_tempdirs
{
my ($gconfig, $dirs) = @_;
foreach my $k (keys %$gconfig) {
	if ($k =~ /^tempdir_(.*)$/) {
		delete($gconfig->{$k});
		}
	}
foreach my $d (@$dirs) {
	$gconfig->{'tempdir_'.$d->[0]} = $d->[1];
	}
}

=head2 get_module_install_type(dir)

Returns the installation method used for some module (such as 'rpm'), or undef
if it was installed from a .wbm.

=cut
sub get_module_install_type
{
my ($mod) = @_;
my $it = &module_root_directory($mod)."/install-type";
open(TYPE, "<".$it) || return undef;
my $type = <TYPE>;
chop($type);
close(TYPE);
return $type;
}

=head2 get_install_type

Returns the package type Webmin was installed form (rpm, deb, solaris-pkg
or undef for tar.gz).

=cut
sub get_install_type
{
my $mode;
if (open(MODE, "<$root_directory/install-type")) {
	chop($mode = <MODE>);
	close(MODE);
	}
else {
	if ($root_directory eq "/usr/libexec/webmin") {
		$mode = "rpm";
		}
	elsif ($root_directory eq "/usr/share/webmin") {
		$mode = "deb";
		}
	elsif ($root_directory eq "/opt/webmin") {
		$mode = "solaris-pkg";
		}
	elsif (&has_command("eix") &&
	       &backquote_command("eix webmin 2>/dev/null") =~ /Installed/i) {
		$mode = "portage";
		}
	else {
		$mode = undef;
		}
	}
return $mode;
}

=head2 list_cached_files

Returns a list of cached filenames for downloads made by Webmin, as array refs
containing a full path and url.

=cut
sub list_cached_files
{
my @rv;
opendir(DIR, $main::http_cache_directory);
foreach my $cfile (readdir(DIR)) {
	next if ($cfile eq "." || $cfile eq "..");
	my $curl = $cfile;
	$curl =~ s/_/\//g;
	push(@rv, [ $cfile, "$main::http_cache_directory/$cfile", $curl ]);
	}
closedir(DIR);
return @rv;
}

=head2 show_restart_page([title, msg])

Output a page with header and footer about Webmin needing to restart.

=cut
sub show_restart_page
{
if (!$gconfig{'restart_async'}) {
	&restart_miniserv();
	&redirect("");
	return;
	}
my ($title, $msg) = @_;
$title ||= $text{'restart_title'};
$msg ||= $text{'restart_done'};
&ui_print_header(undef, $title, "");

print "$msg<p>\n";

&ui_print_footer("", $text{'index_return'});
&restart_miniserv(1);
}

=head2 cert_info(file)

Returns a hash of details of a cert in some file.

=cut
sub cert_info
{
my %rv;
local $_;
open(OUT, "openssl x509 -in ".quotemeta($_[0])." -issuer -subject -enddate -text |");
while(<OUT>) {
	s/\r|\n//g;
	if (/subject=.*CN\s*=\s*([^\/,]+)/) {
		$rv{'cn'} = $1;
		}
	if (/subject=.*O\s*=\s*([^\/,]+)/) {
		$rv{'o'} = $1;
		}
	if (/subject=.*Email\s*=\s*([^\/,]+)/) {
		$rv{'email'} = $1;
		}
	if (/issuer=.*CN\s*=\s*([^\/,]+)/) {
		$rv{'issuer_cn'} = $1;
		}
	if (/issuer=.*O\s*=\s*([^\/,]+)/) {
		$rv{'issuer_o'} = $1;
		}
	if (/issuer=.*Email\s*=\s*([^\/,]+)/) {
		$rv{'issuer_email'} = $1;
		}
	if (/notAfter\s*=\s*(.*)/) {
		$rv{'notafter'} = $1;
		}
	if (/Subject\s+Alternative\s+Name/i) {
		my $alts = <OUT>;
		$alts =~ s/^\s+//;
		foreach my $a (split(/[, ]+/, $alts)) {
			if ($a =~ /^DNS:(\S+)/) {
				push(@{$rv{'alt'}}, $1);
				}
			}
		}
	}
close(OUT);
if ($rv{'o'} && $rv{'issuer_o'}) {
	$rv{'type'} = $rv{'o'} eq $rv{'issuer_o'} ? $text{'ssl_typeself'}
						  : $text{'ssl_typereal'};
	}
return \%rv;
}

=head2 cert_pem_data(file)

Returns a cert in PEM format, from a file containing the PEM and possibly
other keys.

=cut
sub cert_pem_data
{
my ($d) = @_;
my $data = &read_file_contents($_[0]);
if ($data =~ /(-----BEGIN\s+CERTIFICATE-----\n([A-Za-z0-9\+\/=\n\r]+)-----END\s+CERTIFICATE-----)/) {
	return $1;
	}
return undef;
}

=head2 cert_pkcs12_data(keyfile, [certfile])

Returns a cert in PKCS12 format.

=cut
sub cert_pkcs12_data
{
my ($keyfile, $certfile) = @_;
if ($certfile) {
	open(OUT, "openssl pkcs12 -in ".quotemeta($certfile).
		  " -inkey ".quotemeta($keyfile).
		  " -export -passout pass: -nokeys |");
	}
else {
	open(OUT, "openssl pkcs12 -in ".quotemeta($keyfile).
		  " -export -passout pass: -nokeys |");
	}
my $data;
while(<OUT>) {
	$data .= $_;
	}
close(OUT);
return $data;
}

=head2 cert_file_split(file)

Returns a list of certs in some file

=cut
sub cert_file_split
{
my ($file) = @_;
my @rv;
my $lref = &read_file_lines($file, 1);
foreach my $l (@$lref) {
	my $cl = $l;
	$cl =~ s/^#.*//;
	if ($cl =~ /^-----BEGIN/) {
		push(@rv, $cl."\n");
		}
	elsif ($cl =~ /\S/ && @rv) {
		$rv[$#rv] .= $cl."\n";
		}
	}
return @rv;
}

=head2 get_blocked_users_hosts(&miniserv)

Returns a list of blocked users and hosts from the file written by Webmin
at run-time.

=cut
sub get_blocked_users_hosts
{
my ($miniserv) = @_;
my $bf = $miniserv->{'blockedfile'};
if (!$bf) {
	$miniserv->{'pidfile'} =~ /^(.*)\/[^\/]+$/;
	$bf = "$1/blocked";
	}
my @rv;
my $fh = "BLOCKED";
&open_readfile($fh, $bf) || return ();
while(<$fh>) {
	s/\r|\n//g;
	my ($type, $who, $fails, $when) = split(/\s+/, $_);
	push(@rv, { 'type' => $type,
		    $type => $who,
		    'fails' => $fails,
		    'when' => $when });
	}
close($fh);
return @rv;
}

=head2 show_ssl_key_form([defhost], [defemail], [deforg])

Returns HTML for inputs to generate a new self-signed cert.

=cut
sub show_ssl_key_form
{
my ($defhost, $defemail, $deforg) = @_;
my $rv;

$rv .= &ui_table_row($text{'ssl_cn'},
		    &ui_opt_textbox("commonName", $defhost, 50,
				    $text{'ssl_all'}));

$rv .= &ui_table_row($text{'ca_email'},
		    &ui_textbox("emailAddress", $defemail, 30));

$rv .= &ui_table_row($text{'ca_ou'},
		    &ui_textbox("organizationalUnitName", undef, 30));

$rv .= &ui_table_row($text{'ca_o'},
		    &ui_textbox("organizationName", $deforg, 30));

$rv .= &ui_table_row($text{'ca_city'},
		    &ui_textbox("cityName", undef, 30));

$rv .= &ui_table_row($text{'ca_sp'},
		    &ui_textbox("stateOrProvinceName", undef, 15));

$rv .= &ui_table_row($text{'ca_c'},
		    &ui_textbox("countryName", undef, 2));

$rv .= &ui_table_row($text{'ssl_size'},
		    &ui_opt_textbox("size", undef, 6,
				    "$text{'default'} ($default_key_size)").
			" ".$text{'ssl_bits'});

$rv .= &ui_table_row($text{'ssl_days'},
		    &ui_textbox("days", 1825, 8));

return $rv;
}

=head2 parse_ssl_key_form(&in, keyfile, [certfile])

Parses the key generation form, and creates new key and cert files.
Returns undef on success or an error message on failure.

=cut
sub parse_ssl_key_form
{
my ($in, $keyfile, $certfile) = @_;
my %in = %$in;

# Validate inputs
my @cns;
if ($in{'commonName_def'}) {
	@cns = ( &get_system_hostname(0), 
		 &get_system_hostname(1),
		 "localhost" );
	}
else {
	@cns = split(/\s+/, $in{'commonName'});
	@cns || return $text{'newkey_ecns'};
	foreach my $cn (@cns) {
		$cn =~ /^[A-Za-z0-9\.\-\*]+$/ || return $text{'newkey_ecn'};
		}
	}
@cns = &unique(@cns);
$in{'size_def'} || $in{'size'} =~ /^\d+$/ || return $text{'newkey_esize'};
$in{'days'} =~ /^\d+$/ || return $text{'newkey_edays'};
$in{'countryName'} =~ /^\S\S$/ || return $text{'newkey_ecountry'};

# Work out SSL command
my %aclconfig = &foreign_config('acl');
&foreign_require("acl", "acl-lib.pl");
my $cmd = &acl::get_ssleay();
if (!$cmd) {
	return &text('newkey_ecmd', "<tt>$aclconfig{'ssleay'}</tt>",
		     "@{[&get_webprefix()]}/config.cgi?acl");
	}

# Run openssl and feed it key data
my $ctemp = &transname();
my $ktemp = &transname();
my $size = $in{'size_def'} ? $default_key_size : quotemeta($in{'size'});
my $subject = &build_ssl_subject($in{'countryName'},
				 $in{'stateOrProvinceName'},
				 $in{'cityName'},
				 $in{'organizationName'},
				 $in{'organizationalUnitName'},
				 \@cns,
				 $in{'emailAddress'});
my $conf = &build_ssl_config(\@cns);
my $out = &backquote_logged(
	"$cmd req -newkey rsa:$size -x509 -sha256 -nodes -out ".quotemeta($ctemp)." -keyout ".quotemeta($ktemp)." ".
	"-days ".quotemeta($in{'days'})." -subj ".quotemeta($subject)." ".
	"-config ".quotemeta($conf)." -reqexts v3_req -utf8 2>&1");
if (!-r $ctemp || !-r $ktemp || $?) {
	return $text{'newkey_essl'}."<br>"."<pre>".&html_escape($out)."</pre>";
	}

# Write to the final files
my $certout = &read_file_contents($ctemp);
my $keyout = &read_file_contents($ktemp);
unlink($ctemp, $ktemp);

my ($kfh, $cfh) = ("KEY", "CERT");
&open_lock_tempfile($kfh, ">$keyfile");
&print_tempfile($kfh, $keyout);
if ($certfile) {
	# Separate files
	&open_lock_tempfile($cfh, ">$certfile");
	&print_tempfile($cfh, $certout);
	&close_tempfile($cfh);
	&set_ownership_permissions(undef, undef, 0600, $certfile);
	}
else {
	# Both go in the same file
	&print_tempfile($kfh, $certout);
	}
&close_tempfile($kfh);
&set_ownership_permissions(undef, undef, 0600, $keyfile);

return undef;
}

=head2 parse_ssl_csr_form(&in, keyfile, csrfile)

Parses the CSR generation form, and creates new key and CSR files.
Returns undef on success or an error message on failure.

=cut
sub parse_ssl_csr_form
{
my ($in, $keyfile, $csrfile) = @_;
my %in = %$in;

# Validate inputs
my @cns;
if (!$in{'commonName_def'}) {
	@cns = split(/\s+/, $in{'commonName'});
	@cns || return $text{'newkey_ecns'};
	foreach my $cn (@cns) {
		$cn =~ /^[A-Za-z0-9\.\-\*]+$/ || return $text{'newkey_ecn'};
		}
	}
else {
	@cns = ( "*" );
	}
$in{'size_def'} || $in{'size'} =~ /^\d+$/ || return $text{'newkey_esize'};
$in{'days'} =~ /^\d+$/ || return $text{'newkey_edays'};
$in{'countryName'} =~ /^\S\S$/ || return $text{'newkey_ecountry'};

# Work out SSL command
my %aclconfig = &foreign_config('acl');
&foreign_require("acl");
my $cmd = &acl::get_ssleay();
if (!$cmd) {
	return &text('newkey_ecmd', "<tt>$aclconfig{'ssleay'}</tt>",
		     "@{[&get_webprefix()]}/config.cgi?acl");
	}

# Generate the key
my $ktemp = &transname();
my $size = $in{'size_def'} ? $default_key_size : quotemeta($in{'size'});
my $out = &backquote_command("$cmd genrsa -out ".quotemeta($ktemp)." $size 2>&1 </dev/null");
if (!-r $ktemp || $?) {
	return $text{'newkey_essl'}."<br>"."<pre>".&html_escape($out)."</pre>";
	}

# Run openssl and feed it key data
my ($ok, $ctemp) = &generate_ssl_csr(
			$ktemp,
			$in{'countryName'},
			$in{'stateOrProvinceName'},
			$in{'cityName'},
			$in{'organizationName'},
			$in{'organizationalUnitName'},
			\@cns,
			$in{'emailAddress'});
if (!$ok) {
	return $text{'newkey_essl'}."<br>".
	       "<pre>".&html_escape($ctemp)."</pre>";
	}

# Write to the final files
my $csrout = &read_file_contents($ctemp);
my $keyout = &read_file_contents($ktemp);
unlink($ctemp, $ktemp);

my ($kfh, $cfh);
&open_lock_tempfile($kfh, ">$keyfile");
&print_tempfile($kfh, $keyout);
&close_tempfile($kfh);
&set_ownership_permissions(undef, undef, 0600, $keyfile);
&open_lock_tempfile($cfh, ">$csrfile");
&print_tempfile($cfh, $csrout);
&close_tempfile($cfh);
&set_ownership_permissions(undef, undef, 0600, $csrfile);

return undef;
}

# build_ssl_subject(country, state, city, org, orgunit, cname|&cnames, email)
# Generate a full subject line suitable for use with the -subj parameter
sub build_ssl_subject
{
my ($country, $state, $city, $org, $orgunit, $cn, $email) = @_;
$org =~ s/[\177-\377]//g if ($org);		# Remove non-ascii chars
$orgunit =~ s/[\177-\377]//g if ($orgunit);
my @cns = ref($cn) ? @$cn : ( $cn );
my $subject;
$city = substr($city, 0, 64) if ($city && length($city) > 64);
$org = substr($org, 0, 64) if ($org && length($org) > 64);
$orgunit = substr($orgunit, 0, 64) if ($orgunit && length($orgunit) > 64);
$email = substr($email, 0, 64) if ($email && length($email) > 64);
$subject .= "/C=$country" if ($country);
$subject .= "/ST=$state" if ($state);
$subject .= "/L=$city" if ($city);
$subject .= "/O=$org" if ($org);
$subject .= "/OU=$orgunit" if ($orgunit);
$subject .= "/CN=$cns[0]";
$subject .= "/emailAddress=$email" if ($email);
return $subject;
}

# build_ssl_config(cname|&cnames)
# Create a temporary openssl config file that is setup to include altnames, if needed
sub build_ssl_config
{
my ($cn) = @_;
my @cns = ref($cn) ? @$cn : ( $cn );
my $conf = &find_openssl_config_file();
$conf || &error("No OpenSSL configuration file found on this system!");
my $temp = &transname();
&copy_source_dest($conf, $temp);

# Make sure subjectAltNames is set in .cnf file, in the right places
my $lref = &read_file_lines($temp);
my $i = 0;
my $found_req = 0;
my $found_ca = 0;
my $found_alt = 0;
my $altline = "subjectAltName=".join(",", map { "DNS:$_" } @cns);
foreach my $l (@$lref) {
	if ($l =~ /^\s*subjectAltName\s*=/) {
		$lref->[$i] = $altline;
		$found_alt++;
		}
	$i++;
	}
if (!$found_alt) {
	$i = 0;
	foreach my $l (@$lref) {
		if ($l =~ /^\s*\[\s*v3_req\s*\]/ && !$found_req) {
			splice(@$lref, $i+1, 0, $altline);
			$found_req = 1;
			}
		if ($l =~ /^\s*\[\s*v3_ca\s*\]/ && !$found_ca) {
			splice(@$lref, $i+1, 0, $altline);
			$found_ca = 1;
			}
		$i++;
		}
	# If v3_req or v3_ca sections are missing, add at end
	if (!$found_req) {
		push(@$lref, "[ v3_req ]", $altline);
		}
	if (!$found_ca) {
		push(@$lref, "[ v3_ca ]", $altline);
		}
	}

# Add copyall line if needed
$i = 0;
my $found_copy = 0;
my $copyline = "copy_extensions=copyall";
foreach my $l (@$lref) {
	if ($l =~ /^\s*\#*\s*copy_extensions\s*=/) {
		$l = $copyline;
		$found_copy = 1;
		last;
		}
	elsif ($l =~ /^\s*\[\s*CA_default\s*\]/) {
		$found_ca = $i;
		}
	$i++;
	}
if (!$found_copy) {
	if ($found_ca) {
		splice(@$lref, $found_ca+1, 0, $copyline);
		}
	else {
		push(@$lref, "[ CA_default ]", $copyline);
		}
	}

&flush_file_lines($temp);
return $temp;
}

# generate_ssl_csr(keyfile, country, state, city, org, orgunit, cname|&cnames,
# 		   email, ["sha1"|"sha2"])
# Generates a new CSR, and returns either 1 and the temp file path, or 0 and
# an error message
sub generate_ssl_csr
{
my ($ktemp, $country, $state, $city, $org, $orgunit, $cn, $email, $ctype) = @_;
$ctype ||= "sha2";
&foreign_require("acl");
my $ctemp = &transname();
my $cmd = &acl::get_ssleay();
my $subject = &build_ssl_subject($country, $state, $city, $org, $orgunit, $cn,$email);
my $conf = &build_ssl_config($cn);
my $ctypeflag = $ctype eq "sha2" ? "-sha256" : "";
my $out = &backquote_command(
	"$cmd req -new -key ".quotemeta($ktemp)." -out $ctemp $ctypeflag ".
	"-subj ".quotemeta($subject)." -config $conf -reqexts v3_req ".
	"-utf8 2>&1");
if (!-r $ctemp || $?) {
	return (0, $out);
	}
else {
	return (1, $ctemp);
	}
}

=head2 build_installed_modules(force-all, force-mod)

Calls each module's install_check function, and updates the cache of
modules whose underlying servers are installed.

=cut
sub build_installed_modules
{
my ($force, $mod) = @_;
my %installed;
my $changed;
&read_file_cached("$config_directory/installed.cache", \%installed);
my @changed;
foreach my $minfo (&get_all_module_infos()) {
	next if ($mod && $minfo->{'dir'} ne $mod);
	next if (defined($installed{$minfo->{'dir'}}) && !$force && !$mod);
	next if (!&check_os_support($minfo));
	$@ = undef;
	my $o = $installed{$minfo->{'dir'}} || 0;
	my $pid = fork();
	if (!$pid) {
		# Check in a sub-process
		my $rv;
		eval {
			local $main::error_must_die = 1;
			$rv = &foreign_installed($minfo->{'dir'}, 0) ? 1 : 0;
			};
		if ($@) {
			# Install check failed .. but assume the module is OK
			$rv = 1;
			}
		exit($rv);
		}
	waitpid($pid, 0);
	$installed{$minfo->{'dir'}} = $? / 256;
	push(@changed, $minfo->{'dir'}) if ($installed{$minfo->{'dir'}} &&
					    $installed{$minfo->{'dir'}} ne $o);
	}
&write_file("$config_directory/installed.cache", \%installed);
return wantarray ? (\%installed, \@changed) : \%installed;
}

=head2 get_latest_webmin_version

Returns 1 and the latest version of Webmin available on www.webmin.com, or
0 and an error message

=cut
sub get_latest_webmin_version
{
my $file = &transname();
my ($error, $version, $release);
&http_download($primary_host, $primary_port, '/', $file, \$error, undef, 0,
	       undef, undef, 5);
return (0, $error) if ($error);
open(FILE, "<".$file);
while(<FILE>) {
	if (/webmin-([0-9\.]+)-(\d+)\.tar\.gz/ ||
	    /webmin-([0-9\.]+)\.tar\.gz/) {
		$version = $1;
		$release = $2;
		last;
		}
	}
close(FILE);
unlink($file);
return $version ? (1, $version, $release)
		: (0, "No version number found at $primary_host");
}

=head2 filter_updates(&updates, [version], [include-third], [include-missing])

Given a list of updates, filters them to include only those that are
suitable for this system. The parameters are :

=item updates - Array ref of updates, as returned by fetch_updates.

=item version - Webmin version number to use in comparisons.

=item include-third - Set to 1 to include non-core modules in the results.

=item include-missing - Set to 1 to include modules not currently installed.

=cut
sub filter_updates
{
my ($allupdates, $version, $third, $missing) = @_;
$version ||= &get_webmin_version();
my $bversion = &base_version($version);
my $updatestemp = &transname();
my @updates;
foreach my $u (@$allupdates) {
	my %minfo = &get_module_info($u->[0]);
	my %tinfo = &get_theme_info($u->[0]);
	my %info = %minfo ? %minfo : %tinfo;

	# Skip if wrong version of Webmin, unless this is non-core module and
	# we are handling them too
	my $nver = $u->[1];
	$nver =~ s/^(\d+\.\d+)\..*$/$1/;
	next if (($nver >= $bversion + .01 ||
		  $nver <= $bversion ||
		  $nver <= $version) &&
		 (!%info || $info{'longdesc'} || !$third));

	# Skip if not installed, unless installing new
	next if (!%info && !$missing);

	# Skip if module has a version, and we already have it
	next if (%info && $info{'version'} && $info{'version'} >= $nver);

	# Skip if not supported on this OS
	my $osinfo = { 'os_support' => $u->[3] };
	next if (!&check_os_support($osinfo));

	# Skip if installed from RPM or Deb and update was not
	my $itype = &get_module_install_type($u->[0]);
	next if ($itype && $u->[2] !~ /\.$itype$/i);

	push(@updates, $u);
	}
return \@updates;
}

# get_clone_source(dir)
# Given a module dir, returns the dir of its original
sub get_clone_source
{
my ($dir) = @_;
my $lnk = readlink(&module_root_directory($dir));
return undef if (!$lnk);
if ($lnk =~ /\/([^\/]+)$/) {
	return $1;
	}
elsif ($lnk =~ /^[^\/ ]+$/) {
	return $lnk;
	}
return undef;
}

# retry_http_download(host, port, etc..)
# Calls http_download until it succeeds
sub retry_http_download
{
my ($host, $port, $page, $dest, $error, $cbfunc, $ssl, $user, $pass,
    $timeout, $osdn, $nocache, $headers) = @_;
my $tries = 5;
my $i = 0;
my $tryerror;
while($i < $tries) {
	$tryerror = undef;
	&http_download($host, $port, $page, $dest, \$tryerror, $cbfunc, $ssl, $user,
		       $pass, $timeout, $osdn, $nocache, $headers);
	if (!$tryerror) {
		last;
		}
	$i++;
	sleep($i);
	}
if ($tryerror) {
	# Failed every time
	if (ref($error)) {
		$$error = $tryerror;
		}
	else {
		&error($tryerror);
		}
	}
}

# canonicalize_ip6(address)
# Converts an address to its full long form. Ie. 2001:db8:0:f101::20 to
# 2001:0db8:0000:f101:0000:0000:0000:0020
sub canonicalize_ip6
{
my ($addr) = @_;
return $addr if (!&check_ip6address($addr));
my @w = split(/:/, $addr);
my $idx = &indexof("", @w);
if ($idx >= 0) {
	# Expand ::
	my $mis = 8 - scalar(@w);
	my @nw = @w[0..$idx];
	for(my $i=0; $i<$mis; $i++) {
		push(@nw, 0);
		}
	push(@nw, @w[$idx+1 .. $#w]);
	@w = @nw;
	}
foreach my $w (@w) {
	while(length($w) < 4) {
		$w = "0".$w;
		}
	}
return lc(join(":", @w));
}

# list_visible_themes([current-theme])
# Lists all themes the user should be able to use, possibly including their
# current theme if one is set.
sub list_visible_themes
{
my ($curr) = @_;
my @rv;
my %done;
foreach my $theme (&list_themes()) {
	my $iscurr = $curr && $theme->{'dir'} eq $curr;
	my $lnk = readlink($root_directory."/".$theme->{'dir'});
	next if ($lnk && $lnk !~ /^\// && $lnk !~ /^\.\.\// && !$iscurr);
	next if ($done{$theme->{'desc'}}++ && !$iscurr);
	push(@rv, $theme);
	}
return @rv;
}

# apply_new_os_version(&info)
# Update the Webmin and Usermin detected OS name and version
sub apply_new_os_version
{
my %osinfo = %{$_[0]};

# Do Webmin
&lock_file("$config_directory/config");
$gconfig{'real_os_type'} = $osinfo{'real_os_type'};
$gconfig{'real_os_version'} = $osinfo{'real_os_version'};
$gconfig{'os_type'} = $osinfo{'os_type'};
$gconfig{'os_version'} = $osinfo{'os_version'};
&write_file("$config_directory/config", \%gconfig);
&unlock_file("$config_directory/config");

# Do Usermin too, if installed and running an equivalent version
if (&foreign_installed("usermin")) {
	&foreign_require("usermin");
	my %miniserv;
	&usermin::get_usermin_miniserv_config(\%miniserv);
	my @ust = stat("$miniserv{'root'}/os_list.txt");
	my @wst = stat("$root_directory/os_list.txt");
	if ($ust[7] == $wst[7]) {
		# os_list.txt is the same, so we can assume the same OS codes
		# are supported
		my %uconfig;
		&lock_file($usermin::usermin_config);
		&usermin::get_usermin_config(\%uconfig);
		$uconfig{'real_os_type'} = $osinfo{'real_os_type'};
		$uconfig{'real_os_version'} = $osinfo{'real_os_version'};
		$uconfig{'os_type'} = $osinfo{'os_type'};
		$uconfig{'os_version'} = $osinfo{'os_version'};
		&usermin::put_usermin_config(\%uconfig);
		&unlock_file($usermin::usermin_config);
		}
	}
}

sub find_letsencrypt_cron_job
{
if (&foreign_check("webmincron")) {
	&foreign_require("webmincron");
	return &webmincron::find_webmin_cron($module_name,
					     'renew_letsencrypt_cert');
	}
return undef;
}

# renew_letsencrypt_cert()
# Called by cron to renew the last requested cert
sub renew_letsencrypt_cert
{
my @doms = split(/\s+/, $config{'letsencrypt_doms'});
my $webroot = $config{'letsencrypt_webroot'};
my $mode = $config{'letsencrypt_mode'} || "web";
my $size = $config{'letsencrypt_size'};
if (!@doms) {
	print "No domains saved to renew cert for!\n";
	return;
	}
if (!$webroot) {
	print "No webroot saved to renew cert for!\n";
	return;
	}
elsif (!-d $webroot) {
	print "Webroot $webroot does not exist!\n";
	return;
	}
my ($ok, $cert, $key, $chain) = &request_letsencrypt_cert(\@doms, $webroot,
							  undef, $size, $mode);
if (!$ok) {
	print "Failed to renew certificate : $cert\n";
	return;
	}

# Copy into place
my %miniserv;
&lock_file($ENV{'MINISERV_CONFIG'});
&get_miniserv_config(\%miniserv);

&lock_file($miniserv{'keyfile'});
&copy_source_dest($key, $miniserv{'keyfile'}, 1);
&unlock_file($miniserv{'keyfile'});

&lock_file($miniserv{'certfile'});
&copy_source_dest($cert, $miniserv{'certfile'}, 1);
&unlock_file($miniserv{'certfile'});

if ($chain) {
	&lock_file($miniserv{'extracas'});
	&copy_source_dest($chain, $miniserv{'extracas'}, 1);
	&unlock_file($miniserv{'extracas'});
	}
else {
	delete($miniserv{'extracas'});
	}
&put_miniserv_config(\%miniserv);
&unlock_file($ENV{'MINISERV_CONFIG'});
&restart_miniserv(1);
}

# find_openssl_config_file()
# Returns the full path to the OpenSSL config file, or undef if not found
sub find_openssl_config_file
{
my %vconfig = &foreign_config("virtual-server");
foreach my $p ($vconfig{'openssl_cnf'},		# Virtualmin module config
	       "/etc/ssl/openssl.cnf",		# Debian and FreeBSD
	       "/etc/openssl.cnf",
               "/usr/local/etc/openssl.cnf",
	       "/etc/pki/tls/openssl.cnf",	# Redhat
	       "/opt/csw/ssl/openssl.cnf",	# Solaris CSW
	       "/opt/csw/etc/ssl/openssl.cnf",	# Solaris CSW
	       "/System/Library/OpenSSL/openssl.cnf", # OSX
	      ) {
	return $p if ($p && -r $p);
	}
return undef;
}

# show_os_release_notes()
# Returns a link with `Release notes` after OS
# upgrade, within alert displayed on the Dashboard
sub show_os_release_notes
{
my ($ver) = @_;
return if (!$ver);
my $basever = $ver;
($basever) = $basever =~ /(\d+)/;
return if (!$basever);
my $link;
my $os = $gconfig{'real_os_type'};
return if (!$os);
my $link_tag = 'target="_blank" data-link-external="after"';
# Ubuntu release notes
if ($os =~ /ubuntu/i &&
    $ver =~ /\d+\.04/ &&
    $basever >= 18) {
	my $ubuntuver = $ver;
	$ubuntuver =~ s/\./-/g;
	$link = &ui_link("https://fridge.ubuntu.com/".
	                    "ubuntu-$ubuntuver-lts-released",
	                 $text{'os_release_notes'}, undef, $link_tag);
	}
# AlmaLinux release notes
if ($os =~ /alma/i && $basever >= 8) {
	$link = &ui_link("https://wiki.almalinux.org/release-notes/$ver.html",
	                 $text{'os_release_notes'}, undef, $link_tag);
	}
# Rocky linux release notes
if ($os =~ /rocky/i && $basever >= 8) {
	$ver =~ s/\./_/;
	$link = &ui_link("https://docs.rockylinux.org/release_notes/$ver",
	                 $text{'os_release_notes'}, undef, $link_tag);
	}
return ". $link" if ($link);
}

1;