# Functions for scripts

# list_scripts([core-only])
# Returns a list of installable script names
sub list_scripts
{
local ($coreonly) = @_;
local @rv;

# From core directories
foreach my $s ($coreonly ? "$module_root_directory/scripts"
		         : @scripts_directories) {
	opendir(DIR, $s);
	foreach $f (readdir(DIR)) {
		push(@rv, $1) if ($f =~ /^(.*)\.pl$/);
		}
	closedir(DIR);
	}

# From plugins
if (!$coreonly) {
	foreach my $p (&list_script_plugins()) {
		push(@rv, &plugin_call($p, "scripts_list"));
		}
	}

return &unique(@rv);
}

# list_available_scripts()
# Returns a list of installable script names, excluding those that are
# not available
sub list_available_scripts
{
local %unavail;
&read_file_cached($scripts_unavail_file, \%unavail);
local @rv = &list_scripts();
if (!&master_admin() || !$unavail{'allowmaster'}) {
	# Remove globally disabled scripts
	@rv = grep { $unavail{$_} eq '0' ||
		     $unavail{$_} eq '' && !$unavail{'denydefault'} } @rv;
	}
if ($access{'allowedscripts'}) {
	# Remove per-user disallowed scripts
	local %allow = map { $_, 1 } split(/\s+/, $access{'allowedscripts'});
	@rv = grep { $allow{$_} } @rv;
	}
return @rv;
}

# get_script(name, [core-only])
# Returns the structure for some script
sub get_script
{
local ($name, $coreonly) = @_;

# Find all .pl files for this script, which may come from plugins or
# the core
local @sfiles;
foreach my $s ($coreonly ? "$module_root_directory/scripts"
		         : @scripts_directories) {
	local $spath = "$s/$name.pl";
	local @st = stat($spath);
	if (@st) {
		push(@sfiles, [ $spath, $st[9],
			&guess_script_version($spath),
			$s eq $scripts_directories[0] ? 'custom' :
			 $s eq $scripts_directories[1] ? 'latest' : 'core' ]);
		}
	}
if (!$coreonly) {
	foreach my $p (&list_script_plugins()) {
		local $spath = &module_root_directory($p)."/$name.pl";
		local @st = stat($spath);
		if (@st) {
			push(@sfiles, [ $spath, $st[9],
				&guess_script_version($spath), 'plugin' ]);
			}
		}
	}
return undef if (!@sfiles);

# Work out the newest one, so that plugins can override Virtualmin and
# vice-versa
if (@sfiles > 1) {
	local @notver = grep { !$_->[2] } @sfiles;
	if (@notver) {
		# Need to use time-based comparison
		@sfiles = sort { $b->[1] <=> $a->[1] } @sfiles;
		}
	else {
		# Use version numbers
		@sfiles = sort { &compare_versions($b->[2], $a->[2]) } @sfiles;
		}
	}
local $spath = $sfiles[0]->[0];
local $sdir = $spath;
$sdir =~ s/\/[^\/]+$//;

# Read in the .pl file
(do $spath) || return undef;
local $dfunc = "script_${name}_desc";
local $lfunc = "script_${name}_longdesc";
local $vfunc = "script_${name}_versions";
local $nvfunc = "script_${name}_numeric_version";
local $ufunc = "script_${name}_uses";
local $vdfunc = "script_${name}_version_desc";
local $catfunc = "script_${name}_category";
local $disfunc = "script_${name}_disabled";
local $sitefunc = "script_${name}_site";
local $authorfunc = "script_${name}_author";

# Check for critical functions
return undef if (!defined(&$dfunc) || !defined(&$vfunc));

# Work out availability
local %unavail;
&read_file_cached($scripts_unavail_file, \%unavail);
local $disabled;
if (defined(&$disfunc)) {
	$disabled = &$disfunc();
	}
local $allowmaster;
if (&master_admin()) {
	($allowmaster) = &get_script_master_permissions();
	}
local $avail = $unavail{$name} eq '0' ||
	       $unavail{$name} eq '' && !$unavail{'denydefault'};
if ($access{'allowedscripts'}) {
	local %allow = map { $_, 1 } split(/\s+/, $access{'allowedscripts'});
	$avail = 0 if (!$allow{$name});
	}

# Create script structure
local $rv = { 'name' => $name,
	      'desc' => &$dfunc(),
	      'longdesc' => defined(&$lfunc) ? &$lfunc() : undef,
	      'versions' => [ &$vfunc(0) ],
	      'install_versions' => [ &$vfunc(1) ],
	      'numeric_version' => defined(&$nvfunc) ? &$nvfunc() : 0,
	      'uses' => defined(&$ufunc) ? [ &$ufunc() ] : [ ],
	      'category' => defined(&$catfunc) ? &$catfunc() : undef,
	      'site' => defined(&$sitefunc) ? &$sitefunc() : undef,
	      'author' => defined(&$authorfunc) ? &$authorfunc() : undef,
	      'dir' => $sdir,
	      'source' => $sfiles[0]->[3],
	      'depends_func' => "script_${name}_depends",
	      'dbs_func' => "script_${name}_dbs",
	      'params_func' => "script_${name}_params",
	      'parse_func' => "script_${name}_parse",
	      'check_func' => "script_${name}_check",
	      'install_func' => "script_${name}_install",
	      'uninstall_func' => "script_${name}_uninstall",
	      'realversion_func' => "script_${name}_realversion",
	      'can_upgrade_func' => "script_${name}_can_upgrade",
	      'stop_func' => "script_${name}_stop",
	      'stop_server_func' => "script_${name}_stop_server",
	      'start_server_func' => "script_${name}_start_server",
	      'status_server_func' => "script_${name}_status_server",
	      'files_func' => "script_${name}_files",
	      'php_vars_func' => "script_${name}_php_vars",
	      'php_vers_func' => "script_${name}_php_vers",
	      'php_mods_func' => "script_${name}_php_modules",
	      'php_opt_mods_func' => "script_${name}_php_optional_modules",
	      'pear_mods_func' => "script_${name}_pear_modules",
	      'perl_mods_func' => "script_${name}_perl_modules",
	      'perl_opt_mods_func' => "script_${name}_opt_perl_modules",
	      'python_mods_func' => "script_${name}_python_modules",
	      'python_opt_mods_func' => "script_${name}_opt_python_modules",
	      'gem_version_func' => "script_${name}_gem_version",
	      'gems_func' => "script_${name}_gems",
	      'latest_func' => "script_${name}_latest",
	      'check_latest_func' => "script_${name}_check_latest",
	      'commands_func' => "script_${name}_commands",
	      'passmode_func' => "script_${name}_passmode",
	      'gpl_func' => "script_${name}_gpl",
	      'avail' => $avail && !$disabled || $allowmaster,
	      'enabled' => !$disabled,
	      'nocheck' => $disabled == 2,
	      'minversion' => $unavail{$name."_minversion"},
	    };
if (defined(&$vdfunc)) {
	foreach my $ver (@{$rv->{'versions'}},
			 @{$rv->{'install_versions'}}) {
		$rv->{'vdesc'}->{$ver} = &$vdfunc($ver);
		}
	}
return $rv;
}

# list_domain_scripts(&domain)
# Returns a list of scripts and versions already installed for a domain. Each
# entry in the list is a hash ref containing the id, name, version and opts
sub list_domain_scripts
{
local ($f, @rv, $i);
local $ddir = "$script_log_directory/$_[0]->{'id'}";
opendir(DIR, $ddir);
while($f = readdir(DIR)) {
	if ($f =~ /^(\S+)\.script$/) {
		local %info;
		&read_file("$ddir/$f", \%info);
		local @st = stat("$ddir/$f");
		$info{'id'} = $1;
		$info{'file'} = "$ddir/$f";
		foreach $i (keys %info) {
			if ($i =~ /^opts_(.*)$/) {
				$info{'opts'}->{$1} = $info{$i};
				delete($info{$i});
				}
			}
		$info{'time'} = $st[9];
		if ($info{'opts'}->{'dir'} && !-d $info{'opts'}->{'dir'}) {
			$info{'deleted'} = 1;
			}
		push(@rv, \%info);
		}
	}
closedir(DIR);
return @rv;
}

# add_domain_script(&domain, name, version, &opts, desc, url,
#		    [login, password], [partial-failure])
# Records the installation of a script for a domains
sub add_domain_script
{
local ($d, $name, $version, $opts, $desc, $url, $user, $pass, $partial) = @_;
$main::add_domain_script_count++;
local %info = ( 'id' => time().$$.$main::add_domain_script_count,
		'name' => $name,
		'version' => $version,
		'desc' => $desc,
		'url' => $url,
		'user' => $user,
		'pass' => $pass,
		'partial' => $partial );
local $o;
foreach $o (keys %$opts) {
	$info{'opts_'.$o} = $opts->{$o};
	}
&make_dir($script_log_directory, 0700);
&make_dir("$script_log_directory/$d->{'id'}", 0700);
&write_file("$script_log_directory/$d->{'id'}/$info{'id'}.script", \%info);
}

# save_domain_script(&domain, &sinfo)
# Updates a script object for a domain on disk
sub save_domain_script
{
local ($d, $sinfo) = @_;
local %info;
foreach my $k (keys %$sinfo) {
	if ($k eq 'id' || $k eq 'file') {
		next;	# No need to save
		}
	elsif ($k eq 'opts') {
		local $opts = $sinfo->{'opts'};
		foreach my $o (keys %$opts) {
			$info{'opts_'.$o} = $opts->{$o};
			}
		}
	else {
		$info{$k} = $sinfo->{$k};
		}
	}
&write_file("$script_log_directory/$d->{'id'}/$sinfo->{'id'}.script", \%info);
}

# remove_domain_script(&domain, &script-info)
# Records the un-install of a script for a domain
sub remove_domain_script
{
local ($d, $info) = @_;
&unlink_file($info->{'file'});
}

# find_database_table(dbtype, dbname, table|regexp)
# Returns 1 if some table exists in the specified database (if the db exists)
sub find_database_table
{
local ($dbtype, $dbname, $table) = @_;
local $cfunc = "check_".$dbtype."_database_clash";
if (&$cfunc(undef, $dbname)) {
	local $lfunc = "list_".$dbtype."_tables";
	local @tables = &$lfunc($dbname);
	foreach my $t (@tables) {
		if ($t =~ /^$table$/i) {
			return $t;
			}
		}
	}
return undef;
}

# save_scripts_available(&scripts)
# Given a list of scripts with avail and minversion flags, update the 
# available file.
sub save_scripts_available
{
local ($scripts) = @_;
&lock_file($scripts_unavail_file);
&read_file_cached($scripts_unavail_file, \%unavail);
foreach my $script (@$scripts) {
	local $n = $script->{'name'};
	delete($unavail{$n."_minversion"});
	if (!$script->{'avail'}) {
		$unavail{$n} = 1;
		}
	else {
		$unavail{$n} = 0;
		}
	if ($script->{'minversion'}) {
		$unavail{$n."_minversion"} = $script->{'minversion'};
		}
	}
&write_file($scripts_unavail_file, \%unavail);
&unlock_file($scripts_unavail_file);
}

# fetch_script_files(&domain, version, opts, &old-info, &gotfiles, [nocallback])
# Downloads or otherwise fetches all files needed by some script. Returns undef
# on success, or an error message on failure. Also prints out download progress.
sub fetch_script_files
{
local ($d, $ver, $opts, $sinfo, $gotfiles, $nocallback) = @_;
local %serial;
&read_env_file($virtualmin_license_file, \%serial);

local $cb = $nocallback ? undef : \&progress_callback;
local @files = &{$script->{'files_func'}}($d, $ver, $opts, $sinfo);
foreach my $f (@files) {
	if (-r "$script->{'dir'}/$f->{'file'}") {
		# Included in script's directory
		$gotfiles->{$f->{'name'}} = "$script->{'dir'}/$f->{'file'}";
		}
	elsif (-r "$d->{'home'}/$f->{'file'}") {
		# User already has it
		$gotfiles->{$f->{'name'}} = "$d->{'home'}/$f->{'file'}";
		}
	else {
		# Need to fetch it .. build list of possible URLs, from script
		# and from Virtualmin
		local @urls;
		my $temp = &transname($f->{'file'});
		local $newurl = &convert_osdn_url($f->{'url'});
		push(@urls, [ $newurl || $f->{'url'}, $f->{'nocache'},
			      $f->{'user'}, $f->{'pass'} ]);
		local $vurl = "http://$script_download_host:$script_download_port$script_download_dir$f->{'file'}";
		if ($f->{'virtualmin'}) {
			# Use Virtualmin site first, for scripts that don't
			# have a version-specific name
			unshift(@urls, [ $vurl, $f->{'nocache'},
					 $serial{'SerialNumber'},
					 $serial{'LicenseKey'} ]);
			}
		else {
			push(@urls, [ $vurl, $f->{'nocache'},
				      $serial{'SerialNumber'},
				      $serial{'LicenseKey'} ]);
			}

		# Add to URL list attempts with no cache, for cached URLs
		my @firsturls = @urls;
		foreach my $urlcache (@firsturls) {
			next if ($urlcache->[0] !~ /^(http|https):/);
			my ($host, $port, $page, $ssl) =
				&parse_http_url($urlcache->[0]);
			my $canonical = ($ssl ? "https" : "http")."://".
					$host.":".$port.$page;
			if (&check_in_http_cache($canonical) &&
			    !$urlcache->[1]) {
				push(@urls, [ $urlcache->[0], 1,
					      $urlcache->[2], $urlcache->[3] ]);
				}
			}

		# Try each URL
		local $firsterror;
		foreach my $urlcache (@urls) {
			my ($url, $nocache, $user, $pass) = @$urlcache;
			local $error;
			$progress_callback_url = $url;
			local %headers;
			if ($f->{'referer'}) {
				$headers{'Referer'} = $f->{'referer'};
				}
			if ($url =~ /^http/) {
				# Via HTTP
				my ($host, $port, $page, $ssl) =
					&parse_http_url($url);
				&http_download($host, $port, $page, $temp,
					       \$error, $cb, $ssl, $user, $pass,
					       undef, 0, $nocache,
					       \%headers);
				}
			elsif ($url =~ /^ftp:\/\/([^\/]+)(\/.*)/) {
				# Via FTP
				my ($host, $page) = ($1, $2);
				&ftp_download($host, $page, $temp, \$error,
					    $cb, $user, $pass, undef, $nocache);
				}
			else {
				$firsterror ||= &text('scripts_eurl', $url);
				next;
				}
			if ($error) {
				$firsterror ||=
				    &text('scripts_edownload', $error, $url);
				next;
				}
			&set_ownership_permissions($d->{'uid'}, $d->{'ugid'},
						   undef, $temp);

			# Make sure the downloaded file is in some archive
			# format, or is Perl or PHP.
			local $fmt = &compression_format($temp);
			local $cont;
			if (!$fmt && $temp =~ /\.(pl|php)$/i) {
				$cont = &read_file_contents($temp);
				}
			if (!$fmt &&
			    $cont !~ /^\#\!\s*\S+(perl|php)/i &&
			    $cont !~ /^\s*<\?php/i) {
				$firsterror ||=
					&text('scripts_edownload2', $url);
				next;
				}

			# Check that it is a valid compressed file
			if ($fmt) {
				local $e = &extract_compressed_file($temp);
				if ($e) {
					$firsterror ||=
					  &text('scripts_edownload3', $url, $e);
					next;
					}
				}

			# If we got this far, it must have worked!
			&set_ownership_permissions(undef, undef, 0644, $temp);
			$firsterror = undef;
			last;
			}
		return $firsterror if ($firsterror);

		$gotfiles->{$f->{'name'}} = $temp;
		}
	}
return undef;
}

# ui_database_select(name, value, &dbs, [&domain, new-db-suffix])
# Returns a field for selecting a database, from those available for the
# domain. Can also include an option for a new database
sub ui_database_select
{
local ($name, $value, $dbs, $d, $newsuffix) = @_;
local ($newdbname, $newdbtype);
if ($newsuffix) {
	# Work out a name for the new DB (if one is allowed)
	local $tmpl = &get_template($d->{'template'});
	local ($dleft, $dreason, $dmax) = &count_feature("dbs");
	if ($dleft != 0 && &can_edit_databases()) {
		# Choose a name ether based on the allowed prefix, or the
		# default DB name
		$newdbtype = $d->{'mysql'} ? "mysql" : "postgres";
		if ($tmpl->{'mysql_suffix'} ne "none") {
			local $prefix = &substitute_domain_template(
						$tmpl->{'mysql_suffix'}, $d);
			$prefix =~ s/-/_/g;
			$prefix =~ s/\./_/g;
			if ($prefix && $prefix !~ /_$/) {
				# Always use _ as separator
				$prefix .= "_";
				}
			$newdbname = &fix_database_name($prefix.$newsuffix,
							$newdbtype);
			}
		else {
			$newdbname = $d->{'db'}."_".$newsuffix;
			}
		$newdbdesc = $text{'databases_'.$newdbtype};
		local ($already) = grep { $_->{'type'} eq $newdbtype &&
					  $_->{'name'} eq $newdbname } @$dbs;
		if ($already) {
			# Don't offer to create if already exists
			$newdbname = $newdbtype = $newdbdesc = undef;
			}
		$value ||= "*".$newdbtype."_".$newdbname;
		}
	}
return &ui_select($name, $value,
	[ sort { $a->[0] cmp $b->[0] }
	  (map { [ $_->{'type'}."_".$_->{'name'},
		   $_->{'name'}." (".$_->{'desc'}.")" ] } @$dbs),
	  $newdbname ? ( [ "*".$newdbtype."_".$newdbname,
			   &text('scripts_newdb', $newdbname, $newdbdesc) ] )
		     : ( ) ] );
}

# create_script_database(&domain, db-spec, [&options])
# Create a new database for a script. Returns undef on success, or an error
# message on failure.
sub create_script_database
{
local ($d, $dbspec, $opts) = @_;
local ($dbtype, $dbname) = split(/_/, $dbspec, 2);

# Check limits (again)
local ($dleft, $dreason, $dmax) = &count_feature("dbs");
if ($dleft == 0) {
	return "You are not allowed to create any more databases";
	}
if (!&can_edit_databases()) {
	return "You are not allowed to create databases";
	}

$cfunc = "check_".$dbtype."_database_clash";
&$cfunc($d, $dbname) && return "The database $dbname already exists";

# Work out default creation options
$ofunc = "default_".$dbtype."_creation_opts";
if (!$opts && defined(&$ofunc)) {
	$opts = &$ofunc($d);
	}

# Do the creation
&push_all_print();
if (&indexof($dbtype, &list_database_plugins()) >= 0) {
	&plugin_call($dbtype, "database_create", $d, $dbname);
	}
else {
	$crfunc = "create_".$dbtype."_database";
	&$crfunc($d, $dbname, $opts);
	}
&save_domain($d);
&refresh_webmin_user($d);
&pop_all_print();

return undef;
}

# cleanup_script_database(&domain, dbspec, &tables|table-re)
# Delete all tables in some database owned by some script. Returns an error
# on failure, or undef on success.
sub cleanup_script_database
{
local ($d, $dbspec, $tables) = @_;
local ($dbtype, $dbname) = split(/_/, $dbspec, 2);
local $droperr;
eval {
	local $main::error_must_die = 1;
	if ($dbtype eq "mysql") {
		# Delete from MySQL
		&require_mysql();
		foreach my $t (&mysql::list_tables($dbname)) {
			if (ref($tables) && &indexoflc($t, @$tables) >= 0 ||
			    !ref($tables) && $t =~ /^$tables/i) {
				eval {
					&mysql::execute_sql_logged($dbname,
						"drop table ".
						&mysql::quotestr($t));
					};
				$droperr ||= $@;
				}
			}
		}
	elsif ($dbtype eq "postgres") {
		# Delete from PostgreSQL
		&require_postgres();
		foreach my $t (&postgresql::list_tables($dbname)) {
			if (ref($tables) && &indexoflc($t, @$tables) >= 0 ||
			    !ref($tables) && $t =~ /^$tables/i) {
				eval {
					&postgresql::execute_sql_logged($dbname,
						"drop table ".
						&postgresql::quote_table($t));
					};
				$droperr ||= $@;
				}
			}
		}
	};
return $@ || $droperr;
}

# delete_script_database(&domain, dbspec)
# Deletes the database that was created for some script, if it is empty
sub delete_script_database
{
local ($d, $dbspec) = @_;
local ($dbtype, $dbname) = split(/_/, $opts->{'db'}, 2);

local $cfunc = "check_".$dbtype."_database_clash";
if (!&$cfunc($d, $dbname)) {
	return "Database $dbname does not exist";
	}

local $lfunc = "list_".$dbtype."_tables";
local @tables = &$lfunc($dbname);
if (!@tables) {
	&push_all_print();
	local $dfunc = "delete_".$dbtype."_database";
	&$dfunc($d, $dbname);
	&save_domain($d);
	&refresh_webmin_user($d);
	&pop_all_print();
	}
else {
	return "Database $dbname still contains ".scalar(@tables)." tables";
	}
}

# setup_web_for_php(&domain, &script, php-version)
# Update a virtual server's web config to add any PHP settings from the template
sub setup_web_for_php
{
local ($d, $script, $phpver) = @_;
local $tmpl = &get_template($d->{'template'});
local $any = 0;
local $varstr = &substitute_domain_template($tmpl->{'php_vars'}, $d);
local @tmplphpvars = $varstr eq 'none' ? ( ) : split(/\t+/, $varstr);

if ($apache::httpd_modules{'mod_php4'} ||
    $apache::httpd_modules{'mod_php5'}) {
	# Add the PHP variables to the domain's <Virtualhost> in Apache config
	&require_apache();
	local $conf = &apache::get_config();
	local @ports;
	push(@ports, $d->{'web_port'}) if ($d->{'web'});
	push(@ports, $d->{'web_sslport'}) if ($d->{'ssl'});
	foreach my $port (@ports) {
		local ($virt, $vconf) = &get_apache_virtual($d->{'dom'}, $port);
		next if (!$virt);

		# Find currently set PHP variables
		local @phpv = &apache::find_directive("php_value", $vconf);
		local %got;
		foreach my $p (@phpv) {
			if ($p =~ /^(\S+)/) {
				$got{$1}++;
				}
			}

		# Get PHP variables from template
		local @oldphpv = @phpv;
		local $changed;
		foreach my $pv (@tmplphpvars) {
			local ($n, $v) = split(/=/, $pv, 2);
			local $diff = $n =~ s/^(\+|\-)// ? $1 : undef;
			if (!$got{$n}) {
				push(@phpv, "$n $v");
				$changed++;
				}
			}
		if ($script && defined(&{$script->{'php_vars_func'}})) {
			# Get from script too
			foreach my $v (&{$script->{'php_vars_func'}}($d)) {
				if (!$got{$v->[0]}) {
					if ($v->[1] =~ /\s/) {
						push(@phpv,
						     "$v->[0] \"$v->[1]\"");
						}
					else {
						push(@phpv, "$v->[0] $v->[1]");
						}
					$changed++;
					}
				}
			}

		# Update if needed
		if ($changed) {
			&apache::save_directive("php_value",
						\@phpv, $vconf, $conf);
			$any++;
			}
		&flush_file_lines();
		}
	}

local $phpini = &get_domain_php_ini($d, $phpver);
if (-r $phpini && &foreign_check("phpini")) {
	# Add the variables to the domain's php.ini file. Start by finding
	# the variables already set, including those that are commented out.
	&foreign_require("phpini", "phpini-lib.pl");
	local $conf = &phpini::get_config($phpini);
	local $anyini;

	# Find PHP variables from template and from script
	local @todo;
	foreach my $pv (@tmplphpvars) {
		local ($n, $v) = split(/=/, $pv, 2);
		local $diff = $n =~ s/^(\+|\-)// ? $1 : undef;
		push(@todo, [ $n, $v, $diff ]);
		}
	if ($script && defined(&{$script->{'php_vars_func'}})) {
		push(@todo, &{$script->{'php_vars_func'}}($d));
		}

	# Always set the session.save_path to ~/tmp, as on some systems
	# it is set by default to a directory only writable by Apache
	push(@todo, [ 'session.save_path', &create_server_tmp($d) ]);

	# Make any needed changes. Variables can be either forced to a
	# particular value, or have maximums or minumums
	foreach my $t (@todo) {
		local ($n, $v, $diff) = @$t;
		local $ov = &phpini::find_value($n, $conf);
		local $change = $diff eq '' && $ov ne $v ||
				$diff eq '+' && &php_value_diff($ov, $v) < 0 ||
				$diff eq '-' && &php_value_diff($ov, $v) > 0;
		if ($change) {
			&phpini::save_directive($conf, $n, $v);
			if ($n eq "max_execution_time" &&
			    $config{'fcgid_max'} eq "") {
				&set_fcgid_max_execution_time($d, $v);
				}
			$any++;
			$anyini++;
			}
		}

	if ($anyini) {
		&write_as_domain_user($d, sub { &flush_file_lines($phpini) });
		}
	}

return $any;
}

# php_value_diff(value1, value2)
# Compares two values like 32 and 64 or 8M and 32M. Returns -1 if v1 is < v2,
# +1 if v1 > v2, or 0 if same
sub php_value_diff
{
local ($v1, $v2) = @_;
$v1 = $v1 =~ /^(\d+)k/i ? $1*1024 :
      $v1 =~ /^(\d+)M/i ? $1*1024*1024 :
      $v1 =~ /^(\d+)G/i ? $1*1024*1024*1024 : $v1;
$v2 = $v2 =~ /^(\d+)k/i ? $1*1024 :
      $v2 =~ /^(\d+)M/i ? $1*1024*1024 :
      $v2 =~ /^(\d+)G/i ? $1*1024*1024*1024 : $v2;
return $v1 <=> $v2;
}

# check_pear_module(mod, [php-version], [&domain])
# Returns 1 if some PHP Pear module is installed, 0 if not, or -1 if pear is
# missing.
sub check_pear_module
{
local ($mod, $ver, $d) = @_;
local ($mod, $modver) = split(/\-/, $mod);
return -1 if (!&foreign_check("php-pear"));
&foreign_require("php-pear", "php-pear-lib.pl");
local @cmds = &php_pear::get_pear_commands();
return -1 if (!@cmds);
if ($ver) {
	# Check if we have Pear for this PHP version
	local ($vercmd) = grep { $_->[1] == $ver } @cmds;
	return -1 if (!$vercmd);
	}
if (!scalar(@php_pear_modules)) {
	@php_pear_modules = &php_pear::list_installed_pear_modules();
	}
local ($got) = grep { $_->{'name'} eq $mod &&
		      (!$ver || $_->{'pear'} == $ver) } @php_pear_modules;
return $got ? 1 : 0;
}

# check_php_module(mod, [version], [&domain])
# Returns 1 if some PHP module is installed, 0 if not, or -1 if the php command
# is missing
sub check_php_module
{
local ($mod, $ver, $d) = @_;
local $mode = &get_domain_php_mode($d);
local @vers = &list_available_php_versions();
local $verinfo;
if ($ver) {
	($verinfo) = grep { $_->[0] == $ver } @vers;
	}
$verinfo ||= $vers[0];
return -1 if (!$verinfo);
local $cmd = $verinfo->[1];
&has_command($cmd) || return -1;
local @mods = &list_php_modules($d, $verinfo->[0], $verinfo->[1]);
return &indexof($mod, @mods) >= 0 ? 1 : 0;
}

# check_perl_module(mod, &domain)
# Checks if some Perl module exists
sub check_perl_module
{
local ($mod, $d) = @_;
eval "use $mod";
return $@ ? 0 : 1;
}

# check_python_module(mod, &domain)
# Checks if some Python module exists
sub check_python_module
{
local ($mod, $d) = @_;
local $out = &backquote_command("echo import ".quotemeta($mod).
				" | python 2>&1");
return $? ? 0 : 1;
}

# check_php_version(&domain, [number])
# Returns true if the given version of PHP is supported by Apache. If no version
# is given, any is allowed.
sub check_php_version
{
local ($d, $ver) = @_;
local @avail = map { $_->[0] } &list_available_php_versions($d);
return $ver ? &indexof($ver, @avail) >= 0
	    : scalar(@avail);
}

# setup_php_version(&domain, &versions, path)
# Checks if one of the given PHP versions is available for the domain.
# If not, sets up a per-directory version if possible.
sub setup_php_version
{
local ($d, $vers, $path) = @_;

# Find the best matching directory
local $dirpath = &public_html_dir($d).$path;
local @dirs = &list_domain_php_directories($d);
local $bestdir;
foreach my $dir (sort { length($a->{'dir'}) cmp length($b->{'dir'}) } @dirs) {
	if (&is_under_directory($dir->{'dir'}, $dirpath) ||
	    $dir->{'dir'} eq $dirpath) {
		$bestdir = $dir;
		}
	}
$bestdir || &error("Could not find PHP version for $dirpath");

if (&indexof($bestdir->{'version'}, @$vers) >= 0) {
	# The best match dir supports this PHP version .. so we are OK!
	return $bestdir->{'version'};
	}

# Need to add a directory, or fix one
local $ok = &save_domain_php_directory($d, $dirpath, $vers->[0]);
return $ok ? $vers->[0] : undef;
}

# clear_php_version(&domain, &sinfo)
# Removes the custom PHP version setting for some script
sub clear_php_version
{
local ($d, $sinfo) = @_;
if ($sinfo->{'opts'}->{'dir'} &&
    $sinfo->{'opts'}->{'dir'} ne &public_html_dir($d)) {
	&delete_domain_php_directory($d, $sinfo->{'opts'}->{'dir'});
	}
}

# setup_php_modules(&domain, &script, version, php-version, &opts, [&installed])
# If possible, downloads PHP module packages need by the given script. Progress
# of the install is written to STDOUT. Returns 1 if successful, 0 if not.
sub setup_php_modules
{
local ($d, $script, $ver, $phpver, $opts, $installed) = @_;
local $modfunc = $script->{'php_mods_func'};
local $optmodfunc = $script->{'php_opt_mods_func'};
return 1 if (!defined(&$modfunc) && !defined(&$optmodfunc));
local (@mods, @optmods);
if (defined(&$modfunc)) {
	push(@mods, &$modfunc($d, $ver, $phpver, $opts));
	}
if (defined(&$optmodfunc)) {
	@optmods = &$optmodfunc($d, $ver, $phpver, $opts);
	push(@mods, @optmods);
	}
foreach my $m (@mods) {
	next if (&check_php_module($m, $phpver, $d) == 1);
	local $opt = &indexof($m, @optmods) >= 0 ? 1 : 0;
	&$first_print(&text($opt ? 'scripts_optmod' : 'scripts_needmod',
			    "<tt>$m</tt>"));

	# Find the php.ini file
	&foreign_require("phpini", "phpini-lib.pl");
	local $mode = &get_domain_php_mode($d);
	local $inifile = $mode eq "mod_php" ?
			&get_global_php_ini($phpver, $mode) :
			&get_domain_php_ini($d, $phpver);
	if (!$inifile) {
		# Could not find php.ini
		&$second_print($mode eq "mod_php" ? $text{'scripts_noini'}
						  : $text{'scripts_noini2'});
		if ($opt) { next; }
		else { return 0; }
		}

	# Configure the domain's php.ini to load it, if needed
	&$indent_print();
	local $pconf = &phpini::get_config($inifile);
	local @allexts = grep { $_->{'name'} eq 'extension' } @$pconf;
	local @exts = grep { $_->{'enabled'} } @allexts;
	local ($got) = grep { $_->{'value'} eq "$m.so" } @exts;
	if (!$got) {
		# Needs to be enabled
		&$first_print($text{'scripts_addext'});
		local $lref = &read_file_lines($inifile);
		if (@exts) {
			# After current extensions
			splice(@$lref, $exts[$#exts]->{'line'}+1, 0,
			       "extension=$m.so");
			}
		elsif (@allexts) {
			# After commented out extensions
			splice(@$lref, $allexts[$#allexts]->{'line'}+1, 0,
			       "extension=$m.so");
			}
		else {
			# At end of file (should never happen, but..)
			push(@$lref, "extension=$m.so");
			}
		if ($mode eq "mod_php") {
			&flush_file_lines($inifile);
			}
		else {
			&write_as_domain_user($d,
				sub { &flush_file_lines($inifile) });
			}
		undef($phpini::get_config_cache{$inifile});
		undef(%main::php_modules);
		&$second_print($text{'setup_done'});
		if (&check_php_module($m, $phpver, $d) == 1) {
			# We have it now!
			goto GOTMODULE;
			}
		}

	# Make sure the software module is installed and can do updates
	if (!&foreign_installed("software")) {
		&$outdent_print();
		&$second_print($text{'scripts_esoftware'});
		if ($opt) { next; }
		else { return 0; }
		}
	&foreign_require("software", "software-lib.pl");
	if (!defined(&software::update_system_install)) {
		&$outdent_print();
		&$second_print($text{'scripts_eupdate'});
		if ($opt) { next; }
		else { return 0; }
		}

	# Check if the package is already installed
	local $iok = 0;
	local @poss;
	local $fullphpver = &get_php_version($phpver, $d);
	if ($software::update_system eq "csw") {
		@poss = ( "php".$phpver."_".$m );
		}
	else {
		@poss = ( "php".$phpver."-".$m, "php-".$m );
		if ($software::update_system eq "apt" &&
		    $m eq "pdo_mysql") {
			# On Debian, the pdo_mysql module is in the mysql module
			push(@poss, "php".$phpver."-mysql", "php-mysql");
			}
		elsif ($software::update_system eq "yum" &&
		       ($m eq "domxml" || $m eq "dom") && $phpver >= 5) {
			# On Redhat, the domxml module is in php-domxml
			push(@poss, "php".$phpver."-xml", "php-xml");
			}
		if ($software::update_system eq "yum" &&
		    $fullphpver =~ /^5\.3/) {
			# If PHP 5.3 is being used, packages may start with
			# php53-
			my @vposs = grep { /^php5-/ } @poss;
			push(@poss, map { my $p = $_;
					     $p =~ s/php5/php53/; $p } @vposs);
			}
		}
	foreach my $pkg (@poss) {
		local @pinfo = &software::package_info($pkg);
		if (!@pinfo || $pinfo[0] ne $pkg) {
			# Not installed .. try to fetch it
			&$first_print(&text('scripts_softwaremod',
					    "<tt>$pkg</tt>"));
			if ($first_print eq \&null_print) {
				# Suppress output
				&capture_function_output(
				    \&software::update_system_install, $pkg);
				}
			elsif ($first_print eq \&first_text_print) {
				# Make output text
				local $out = &capture_function_output(
				    \&software::update_system_install, $pkg);
				print &html_tags_to_text($out);
				}
			else {
				# Show HTML output
				&software::update_system_install($pkg);
				}
			local $newpkg = $pkg;
			if ($software::update_system eq "csw") {
				# Real package name is different
				$newpkg = "CSWphp".$phpver.$m;
				}
			@pinfo = &software::package_info($newpkg);
			if (@pinfo && $pinfo[0] eq $newpkg) {
				# Yep, it worked
				&$second_print($text{'setup_done'});
				$iok = 1;
				push(@$installed, $m) if ($installed);
				last;
				}
			}
		else {
			# Already installed .. we're done
			$iok = 1;
			last;
			}
		}
	if (!$iok) {
		&$second_print($text{'scripts_esoftwaremod'});
		&$outdent_print();
		if ($opt) { next; }
		else { return 0; }
		}

	# Finally re-check to make sure it worked (but this is only possible
	# in CGI mode)
	GOTMODULE:
	&$outdent_print();
	undef(%main::php_modules);
	if (&check_php_module($m, $phpver, $d) != 1) {
		&$second_print($text{'scripts_einstallmod'});
		if ($opt) { next; }
		else { return 0; }
		}
	else {
		&$second_print(&text('scripts_gotmod', $m));
		}

	# If we are running via mod_php or fcgid, an Apache reload is needed
	if ($mode eq "mod_php" || $mode eq "fcgid") {
		&register_post_action(\&restart_apache);
		}
	}
return 1;
}

# setup_pear_modules(&domain, &script, version, php-version, &opts)
# If possible, downloads Pear PHP modules needed by the given script. Progress
# of the install is written to STDOUT. Returns 1 if successful, 0 if not.
sub setup_pear_modules
{
local ($d, $script, $ver, $phpver) = @_;
local $modfunc = $script->{'pear_mods_func'};
return 1 if (!defined(&$modfunc));
local @mods = &$modfunc($d, $opts);
return 1 if (!@mods);

# Make sure we have the pear module
if (!&foreign_check("php-pear")) {
	# Cannot do anything
	&$first_print(&text('scripts_nopearmod',
			    "<tt>".join(" ", @mods)."</tt>"));
	return 1;
	}

# And that we have Pear for this PHP version
&foreign_require("php-pear", "php-pear-lib.pl");
local @cmds = &php_pear::get_pear_commands();
local ($vercmd) = grep { $_->[1] == $phpver } @cmds;
if (!$vercmd) {
	# No pear .. cannot do anything
	&$first_print(&text('scripts_nopearcmd',
			    "<tt>".join(" ", @mods)."</tt>", $phpver));
	return 1;
	}

foreach my $m (@mods) {
	next if (&check_pear_module($m, $phpver, $d) == 1);
	local ($mname, $mver) = split(/\-/, $m);

	# Install if needed
	&$first_print(&text('scripts_needpear', "<tt>$mname</tt>"));
	&foreign_require("php-pear", "php-pear-lib.pl");
	local $err = &php_pear::install_pear_module($m, $phpver);
	if ($err) {
		print $err;
		&$second_print($text{'scripts_esoftwaremod'});
		return 0;
		}

	# Finally re-check to make sure it worked
	undef(@php_pear_modules);
	if (&check_pear_module($m, $phpver, $d) != 1) {
		&$second_print($text{'scripts_einstallpear'});
		return 0;
		}
	else {
		&$second_print(&text('scripts_gotpear', $m));
		}
	}
return 1;
}

# setup_perl_modules(&domain, &script, version, &opts)
# If possible, downloads Perl needed by the given script. Progress
# of the install is written to STDOUT. Returns 1 if successful, 0 if not.
# At the moment, auto-install of modules is done only from APT or YUM.
sub setup_perl_modules
{
local ($d, $script, $ver, $opts) = @_;
local $modfunc = $script->{'perl_mods_func'};
local $optmodfunc = $script->{'perl_opt_mods_func'};
return 1 if (!defined(&$modfunc) && !defined(&$optmodfunc));
if (defined(&$modfunc)) {
	push(@mods, &$modfunc($d, $ver, $opts));
	}
if (defined(&$optmodfunc)) {
	@optmods = &$optmodfunc($d, $ver, $opts);
	push(@mods, @optmods);
	}

# Check if the software module is installed and can do update
local $canpkgs = 0;
if (&foreign_installed("software")) {
	&foreign_require("software", "software-lib.pl");
	if (defined(&software::update_system_install)) {
		$canpkgs = 1;
		}
	}

foreach my $m (@mods) {
	next if (&check_perl_module($m, $d) == 1);
	local $opt = &indexof($m, @optmods) >= 0 ? 1 : 0;
	&$first_print(&text($opt ? 'scripts_optperlmod' : 'scripts_needperlmod',
			    "<tt>$m</tt>"));

	local $pkg;
	local $done = 0;
	if ($canpkgs) {
		# Work out the package name
		local $mp = $m;
		if ($software::config{'package_system'} eq 'rpm') {
			# Some RPM packages for Perl modules have odd names,
			# but most are like perl-Foo-Bar
			if ($mp eq "Template") {
				$pkg = "perl-Template-Toolkit";
				}
			elsif ($mp eq "Date::Format") {
				$pkg = "perl-TimeDate";
				}
			else {
				$mp =~ s/::/\-/g;
				$pkg = "perl-$mp";
				}
			}
		elsif ($software::config{'package_system'} eq 'debian') {
			# Most Debian package perl modules are named
			# like libfoo-bar-perl
			if ($mp eq "Date::Format") {
				$pkg = "libtimedate-perl";
				}
			else {
				$mp = lc($mp);
				$mp =~ s/::/\-/g;
				$pkg = "lib$mp-perl";
				}
			}
		elsif ($software::config{'package_system'} eq 'pkgadd') {
			$mp = lc($mp);
			$mp =~ s/:://g;
			$pkg = "pm_$mp";
			}
		}

	if ($pkg) {
		# Install the RPM, Debian or CSW package
		&$first_print(&text('scripts_softwaremod', "<tt>$pkg</tt>"));
		&$indent_print();
		&software::update_system_install($pkg);
		&$outdent_print();
		@pinfo = &software::package_info($pkg);
		if (@pinfo && $pinfo[0] eq $pkg) {
			# Yep, it worked
			&$second_print($text{'setup_done'});
			$done = 1;
			}
		}

	if (!$done) {
		# Fall back to CPAN
		&$first_print(&text('scripts_perlmod', "<tt>$m</tt>"));
		eval "use CPAN";
		if ($@) {
			# Cpan is missing??
			&$second_print($text{'scripts_ecpan'});
			if ($opt) { next; }
			else { return 0; }
			}
		else {
			local $perl = &get_perl_path();
			&open_execute_command(CPAN,
			    "echo n | $perl -MCPAN -e 'install $m' 2>&1", 1);
			&$indent_print();
			print "<pre>";
			while(<CPAN>) {
				print &html_escape($_);
				}
			print "</pre>";
			close(CPAN);
			&$outdent_print();
			if ($?) {
				&$second_print($text{'scripts_eperlmod'});
				if ($opt) { next; }
				else { return 0; }
				}
			else {
				&$second_print($text{'setup_done'});
				}
			}
		}
	}
return 1;
}

# setup_python_modules(&domain, &script, version, &opts)
# If possible, downloads Python needed by the given script. Progress
# of the install is written to STDOUT. Returns 1 if successful, 0 if not.
# At the moment, auto-install of modules is done only from APT or YUM.
sub setup_python_modules
{
local ($d, $script, $ver, $opts) = @_;
local $modfunc = $script->{'python_mods_func'};
local $optmodfunc = $script->{'python_opt_mods_func'};
local (@mods, @optmods);
if (defined(&$modfunc)) {
	push(@mods, &$modfunc($d, $ver, $opts));
	}
if (defined(&$optmodfunc)) {
	push(@optmods, &$optmodfunc($d, $ver, $opts));
	push(@mods, @optmods);
	}
return 1 if (!@mods);

# Check if the software module is installed and can do update
local $canpkgs = 0;
if (&foreign_installed("software")) {
	&foreign_require("software", "software-lib.pl");
	if (defined(&software::update_system_install)) {
		$canpkgs = 1;
		}
	}

foreach my $m (@mods) {
	next if (&check_python_module($m, $d) == 1);
	local $opt = &indexof($m, @optmods) >= 0 ? 1 : 0;
	&$first_print(&text($opt ? 'scripts_optpythonmod'
				 : 'scripts_needpythonmod', "<tt>$m</tt>"));
	if (!$canpkgs) {
		&$second_print($text{'scripts_epythonmod'});
		if ($opt) { next; }
		else { return 0; }
		}

	# Work out the package name
	local @pkgs;
	local $done = 0;
	local $mp = $m;
	if ($software::config{'package_system'} eq 'debian') {
		# For APT, the package name is python- followed
		# by the lower-case module name, except for the svn module
		# which is in python-subversion
		$mp = lc($mp);
		if ($mp eq "svn") {
			push(@pkgs, "python-subversion");
			}
		elsif ($mp eq "psycopg") {
			# Try to install old and new versions on Debian
			push(@pkgs, "python-psycopg", "python-psycopg2");
			}
		else {
			push(@pkgs, "python-".$mp);
			}
		}
	elsif ($software::config{'package_system'} eq 'rpm') {
		# For YUM, naming is less standard .. the MySQLdb package
		# is in MySQL-python
		if ($m eq "MySQLdb") {
			push(@pkgs, "MySQL-python");
			}
		elsif ($m eq "setuptools") {
			push(@pkgs, "setuptools", "python-setuptools");
			}
		else {
			$mp = lc($mp);
			push(@pkgs, "python-".$mp);
			}
		}
	elsif ($software::config{'package_system'} eq 'pkgadd') {
		# For CSW, the package is py_ and the module name. Very few
		# seem to be packaged though
		$mp = lc($mp);
		$mp =~ s/:://g;
		push(@pkgs, "py_$mp");
		}
	else {
		&$second_print($text{'scripts_epythonmod'});
		if ($opt) { next; }
		else { return 0; }
		}

	# Install the RPM, Debian or CSW package. If any work, then we are done
	local $anyok;
	foreach my $pkg (@pkgs) {
		&$first_print(&text('scripts_softwaremod', "<tt>$pkg</tt>"));
		&$indent_print();
		&software::update_system_install($pkg);
		&$outdent_print();
		local @pinfo = &software::package_info($pkg);
		if (@pinfo && $pinfo[0] eq $pkg) {
			# Yep, it worked
			&$second_print($text{'setup_done'});
			$anyok = 1;
			last;
			}
		else {
			&$second_print($text{'scripts_epythoninst'});
			}
		}
	return 0 if (!$anyok && !$opt);
	}
return 1;
}

# validate_script_path(&opts, &script, &domain)
# Checks the 'path' in script options, and sets 'dir' and possibly
# modifies 'path'. Returns an error message if the path is not valid
sub validate_script_path
{
local ($opts, $script, $d) = @_;
if (&indexof("horde", @{$script->{'uses'}}) >= 0) {
	# Under Horde directory
	local @scripts = &list_domain_scripts($d);
	local ($horde) = grep { $_->{'name'} eq 'horde' } @scripts;
	$horde || return "Script uses Horde, but it is not installed";
	$opts->{'path'} eq '/' && return "A path of / is not valid for Horde scripts";
	$opts->{'db'} = $horde->{'opts'}->{'db'};
	$opts->{'dir'} = $horde->{'opts'}->{'dir'}.$opts->{'path'};
	$opts->{'path'} = $horde->{'opts'}->{'path'}.$opts->{'path'};
	}
elsif ($opts->{'path'} =~ /^\/cgi-bin/) {
	# Under cgi directory
	local $hdir = &cgi_bin_dir($d);
	$opts->{'dir'} = $opts->{'path'} eq "/" ?
				$hdir : $hdir.$opts->{'path'};
	}
else {
	# Under HTML directory
	local $hdir = &public_html_dir($d);
	$opts->{'dir'} = $opts->{'path'} eq "/" ?
				$hdir : $hdir.$opts->{'path'};
	}
return undef;
}

# script_path_url(&domain, &opts)
# Returns a URL for a script, based on the domain name and path from options.
# The path always ends with a /
sub script_path_url
{
local ($d, $opts) = @_;
local $pt = $d->{'web_port'} == 80 ? "" : ":$d->{'web_port'}";
local $pp = $opts->{'path'} eq '/' ? '' : $opts->{'path'};
if ($pp !~ /\.(cgi|pl|php)$/i) {
	$pp .= "/";
	}
return "http://$d->{'dom'}$pt$pp";
}

# show_template_scripts(&tmpl)
# Outputs HTML for editing script installer template options
sub show_template_scripts
{
local ($tmpl) = @_;
local $scripts = &list_template_scripts($tmpl);
local $empty = { 'db' => '${DB}' };
local @list = $scripts eq "none" ? ( $empty ) : ( @$scripts, $empty );

# Build field list and disablers
local @sfields = map { ("name_".$_, "path_".$_,
			"version_".$_, "version_".$_."_def",
			"db_def_".$_, "db_".$_, "dbtype_".$_) }
		     (0..scalar(@list)-1);
local $dis1 = &js_disable_inputs(\@sfields, [ ]);
local $dis2 = &js_disable_inputs([ ], \@sfields);

# None/default/listed selector
local $stable = $text{'tscripts_what'}."\n";
$stable .= &ui_radio("def",
	$scripts eq "none" ? 2 :
	  @$scripts ? 0 :
	  $tmpl->{'default'} ? 2 : 1,
	[ [ 2, $text{'tscripts_none'}, "onClick='$dis1'" ],
	  $tmpl->{'default'} ? ( ) : ( [ 1, $text{'default'}, "onClick='$dis1'" ] ),
	  [ 0, $text{'tscripts_below'}, "onClick='$dis2'" ] ]),"<p>\n";

# Find scripts
local @opts = ( );
foreach $sname (&list_available_scripts()) {
	$script = &get_script($sname);
	push(@opts, [ $sname, $script->{'desc'} ]);
	}
@opts = sort { lc($a->[1]) cmp lc($b->[1]) } @opts;
local @dbopts = ( );
push(@dbopts, [ "mysql", $text{'databases_mysql'} ]) if ($config{'mysql'});
push(@dbopts, [ "postgres", $text{'databases_postgres'} ]) if ($config{'postgres'});

# Show table of scripts
local $i = 0;
local @table;
foreach $script (@list) {
	$db_def = $script->{'db'} eq '${DB}' ? 1 :
                        $script->{'db'} ? 2 : 0;
	local ($name, $ver) = split(/\s+/, $script->{'name'});
	push(@table, [
		&ui_select("name_$i", $name,
			   [ [ undef, "&nbsp;" ], @opts ]),
		&ui_opt_textbox("version_$i", $ver eq "latest" ? undef : $ver,
				10, $text{'tscripts_latest'}."<br>",
				$text{'tscripts_exact'}),
		&ui_textbox("path_$i", $script->{'path'}, 25),
		&ui_radio("db_def_$i",
			$db_def,
			[ [ 0, $text{'tscripts_none'} ],
			  [ 1, $text{'tscripts_dbdef'}."<br>" ],
			  [ 2, $text{'tscripts_other'}." ".
			       &ui_textbox("db_$i",
				$db_def == 1 ? "" : $script->{'db'}, 10) ] ]),
		&ui_select("dbtype_$i", $script->{'dbtype'}, \@dbopts),
		]);
	$i++;
	}
$stable .= &ui_columns_table(
	[ $text{'tscripts_name'}, $text{'tscripts_version'},
	  $text{'tscripts_path'}, $text{'tscripts_db'},
	  $text{'tscripts_dbtype'} ],
	undef,
	\@table,
	undef,
	0,
	undef,
	undef,
	);

print &ui_table_row(undef, $stable, 2);
}

# parse_template_scripts(&tmpl)
# Updates script installer template options from %in
sub parse_template_scripts
{
local ($tmpl) = @_;

local $scripts;
if ($in{'def'} == 2) {
	# None explicitly chosen
	$scripts = "none";
	}
elsif ($in{'def'} == 1) {
	# Fall back to default
	$scripts = [ ];
	}
else {
	# Parse script list
	$scripts = [ ];
	for($i=0; defined($name = $in{"name_$i"}); $i++) {
		next if (!$name);
		local $ver = $in{"version_${i}_def"} ? "latest"
						     : $in{"version_${i}"};
		$ver =~ /^\S+$/ || &error(&text('tscripts_eversion', $i+1));
		local $script = { 'id' => $i,
			    	  'name' => $name." ".$ver };
		local $path = $in{"path_$i"};
		$path =~ /^\/\S*$/ || &error(&text('tscripts_epath', $i+1));
		$script->{'path'} = $path;
		$script->{'dbtype'} = $in{"dbtype_$i"};
		if ($in{"db_def_$i"} == 1) {
			$script->{'db'} = '${DB}';
			}
		elsif ($in{"db_def_$i"} == 2) {
			$in{"db_$i"} =~ /^\S+$/ ||
				&error(&text('tscripts_edb', $i+1));
			$in{"db_$i"} =~ /\$/ ||
				&error(&text('tscripts_edb2', $i+1));
			$script->{'db'} = $in{"db_$i"};
			}
		push(@$scripts, $script);
		}
	@$scripts || &error($text{'tscripts_enone'});
	}
&save_template_scripts($tmpl, $scripts);
}

# osdn_package_versions(project, fileregexp, ...)
# Given a sourceforge project name and a regexp that matches filenames
# (like cpg([0-9\.]+).zip), returns a list of version numbers found, newest 1st
sub osdn_package_versions
{
local ($project, @res) = @_;
local ($alldata, $err);
&http_download($osdn_website_host, $osdn_website_port,
	       "/projects/$project/files",
	       \$alldata, \$err, undef, 0, undef, undef, undef, 0, 1);
return ( ) if ($err);

# Search for sub-directories
local @data = ( $alldata );
local $data = $alldata;
local %donepath;
while($data =~ /href="(\/projects\/$project\/files\/[^: ]+)"(.*)/is) {
	$data = $2;
	local $spath = $1;
	next if ($donepath{$spath}++ || $spath =~ /\/stats\/timeline/ ||
		 $spath =~ /\.\.$/ || $spath =~ /\/download$/);
	local ($sdata, $err);
	&http_download($osdn_website_host, $osdn_website_port, $spath,
		       \$sdata, \$err, undef, 0, undef, undef, undef, 0, 1);
	push(@data, $sdata) if (!$err);
	$data .= $sdata;
	}

# Check them all for files
local @vers;
foreach my $alldata (@data) {
	foreach my $re (@res) {
		local $data = $alldata;
		while($data =~ /$re(.*)/is) {
			push(@vers, $1);
			$data = $2;
			}
		}
	}
@vers = sort { &compare_versions($b, $a) } &unique(@vers);
return @vers;
}

# can_script_version(&script, version-number)
# Returns 1 if the current user can install some version of a script
sub can_script_version
{
local ($script, $ver) = @_;
local ($allowmaster, $allowvers) = &get_script_master_permissions();
if (&master_admin() && $allowvers) {
	# No limits for master admin
	return 1;
	}
elsif (!$script->{'minversion'}) {
	return 1;	# No restrictions
	}
elsif ($script->{'minversion'} =~ /^<=(.*)$/) {
	return &compare_versions($ver, "$1", $script) <= 0;	# At or below
	}
elsif ($script->{'minversion'} =~ /^=(.*)$/) {
	return $ver eq $1;				# At exact version
	}
elsif ($script->{'minversion'} =~ /^>=(.*)$/ ||
       $script->{'minversion'} =~ /^(.*)$/) {
	return &compare_versions($ver, "$1", $script) >= 0;	# At or above
	}
else {
	return 1;	# Can never happen!
	}
}

# post_http_connection(&domain, page, &cgi-params, &out, &err,
#		       &moreheaders, &returnheaders, &returnheaders-array)
# Makes an HTTP post to some URL, sending the given CGI parameters as data.
sub post_http_connection
{
local ($d, $page, $params, $out, $err, $headers,
       $returnheaders, $returnheaders_array) = @_;
local $ip = $d->{'ip'};
local $host = &get_domain_http_hostname($d);
local $port = $d->{'web_port'};

local $oldproxy = $gconfig{'http_proxy'};	# Proxies mess up connection
$gconfig{'http_proxy'} = '';			# to the IP explicitly
local $h = &make_http_connection($ip, $port, 0, "POST", $page);
$gconfig{'http_proxy'} = $oldproxy;
if (!ref($h)) {
	$$err = $h;
	return 0;
	}
&write_http_connection($h, "Host: $host\r\n");
&write_http_connection($h, "User-agent: Webmin\r\n");
&write_http_connection($h, "Content-type: application/x-www-form-urlencoded\r\n");
&write_http_connection($h, "Content-length: ".length($params)."\r\n");
if ($headers) {
	foreach my $hd (keys %$headers) {
		&write_http_connection($h, "$hd: $headers->{$hd}\r\n");
		}
	}
&write_http_connection($h, "\r\n");
&write_http_connection($h, "$params\r\n");

# Read back the results
$post_http_headers = undef;
$post_http_headers_array = undef;
local $SIG{'ALRM'} = 'IGNORE';		# Let complete function run forever
&complete_http_download($h, $out, $err, \&capture_http_headers, 0, $host,
			$port, $headers);
if ($returnheaders && $post_http_headers) {
	%$returnheaders = %$post_http_headers;
	}
if ($returnheaders_array && $post_http_headers_array) {
	@$returnheaders_array = @$post_http_headers_array;
	}
}

sub capture_http_headers
{
if ($_[0] == 4) {
	$post_http_headers = %WebminCore::header ?
				\%WebminCore::header : \%header;
	$post_http_headers_array = scalar(@WebminCore::header) ?
				\@WebminCore::header : \@headers;
	}
}

# get_http_connection(&domain, page, &output, [&error], [&callback],
#  [sslmode], [user, pass], [timeout], [osdn-convert], [no-cache], [&headers])
# Does effectively the same thing as http_download, but connects to the right
# IP, hostname and port. For use by scripts needing to call wizards and such.
sub get_http_connection
{
local ($d, $page, $dest, $error, $cbfunc, $ssl, $user, $pass,
       $timeout, $osdn, $nocache, $headers) = @_;
local $ip = $d->{'ip'};
local $host = &get_domain_http_hostname($d);
local $port = $d->{'web_port'};

# Build headers
local @headers;
push(@headers, [ "Host", $host ]);
push(@headers, [ "User-agent", "Webmin" ]);
if ($user) {
	local $auth = &encode_base64("$user:$pass");
	$auth =~ tr/\r\n//d;
	push(@headers, [ "Authorization", "Basic $auth" ]);
	}
foreach my $hname (keys %$headers) {
	push(@headers, [ $hname, $headers->{$hname} ]);
	}

# Actually download it
$main::download_timed_out = undef;
local $SIG{ALRM} = \&download_timeout;
alarm($timeout || 60);
local $h = &make_http_connection($ip, $port, $ssl, "GET", $page, \@headers);
alarm(0);
$h = $main::download_timed_out if ($main::download_timed_out);
if (!ref($h)) {
	if ($error) { $$error = $h; return; }
	else { &error($h); }
	}
&complete_http_download($h, $dest, $error, $cbfunc, $osdn, $host, $port,
			$headers);
}

# make_file_php_writable(&domain, file, [dir-only], [owner-too])
# Set permissions on a file so that it is writable by PHP
sub make_file_php_writable
{
local ($d, $file, $dironly, $setowner) = @_;
local $mode = &get_domain_php_mode($d);
local $perms = $mode eq "mod_php" ? 0777 : 0755;
local @st = stat($file);
if (-d $file && !$dironly) {
	if ($setowner && $st[4] != $d->{'uid'}) {
		&system_logged(sprintf("chown -R %d:%d %s",
			$d->{'uid'}, $d->{'gid'}, quotemeta($file)));
		}
	&run_as_domain_user(
		$d, sprintf("chmod -R %o %s", $perms, quotemeta($file)));
	}
else {
	if ($setowner && $st[4] != $d->{'uid'}) {
		&set_ownership_permissions($d->{'uid'}, $d->{'gid'},
					   undef, $file);
		}
	&set_permissions_as_domain_user($d, $perms, $file);
	}
}

# make_file_php_nonwritable(&domain, file, [dir-only])
sub make_file_php_nonwritable
{
local ($d, $file, $dironly) = @_;
if (-d $file && !$dironly) {
	&execute_as_domain_user($d, "chmod -R 555 ".quotemeta($file));
	}
else {
	&set_permissions_as_domain_user($d, 0555, $file);
	}
}

# delete_script_install_directory(&domain, &opts)
# Delete all files installed by a script, based on the 'dir' option. Returns
# an error message on failure.
sub delete_script_install_directory
{
local ($d, $opts) = @_;
$opts->{'dir'} || return "Missing install directory!";
&is_under_directory($d->{'home'}, $opts->{'dir'}) ||
	return "Invalid install directory $opts->{'dir'}";

# Check for overlapping script dirs
local @others = &list_domain_scripts($d);
local %overlap;
foreach my $sinfo (@others) {
	if ($sinfo->{'opts'}->{'dir'} =~ /^\Q$opts->{'dir'}\E\/(\S+)$/) {
		$overlap{$1} = 1;
		}
	}

if (!scalar(keys %overlap)) {
	# Delete all sub-directories
	local $out = &backquote_logged(
		"rm -rf ".quotemeta($opts->{'dir'})."/* ".
			  quotemeta($opts->{'dir'})."/.??* 2>&1");
	$? && return "Failed to delete files : <tt>$out</tt>";

	if ($opts->{'dir'} ne &public_html_dir($d, 0)) {
		# Take out the directory too
		&run_as_domain_user($d, "rmdir ".quotemeta($opts->{'dir'}));
		}
	}
else {
	# Only delete those not belonging to other scripts
	opendir(DIR, $opts->{'dir'});
	foreach my $f (readdir(DIR)) {
		if ($f ne '.' && $f ne '..' && !$overlap{$f}) {
			&unlink_file_as_domain_user($f, "$opts->{'dir'}/$f");
			}
		}
	closedir(DIR);
	}
return undef;
}

# get_script_ratings()
# Returns a hash of script ratings (from 1 to 5) for the current user
sub get_script_ratings
{
local %srf;
&read_file("$script_ratings_dir/$remote_user", \%srf);
return \%srf;
}

# save_script_ratings(&ratings)
# Updates the script ratings for the current user
sub save_script_ratings
{
local ($srf) = @_;
&make_dir($script_ratings_dir, 0700) if (!-d $script_ratings_dir);
&write_file("$script_ratings_dir/$remote_user", $srf);
}

# list_all_script_ratings()
# Returns a hash of ratings, indexed by user
sub list_all_script_ratings
{
local %rv;
opendir(SRD, $script_ratings_dir);
foreach my $user (readdir(SRD)) {
	next if ($user eq "." || $user eq "..");
	local %srf;
	&read_file("$script_ratings_dir/$user", \%srf);
	$rv{$user} = \%srf;
	}
closedir(DIR);
return \%rv;
}

# get_overall_script_ratings()
# Returns a hash ref containing summary ratings from virtualmin.com
sub get_overall_script_ratings
{
local %overall;
&read_file($script_ratings_overall, \%overall);
return \%overall;
}

# save_overall_script_ratings(&overall)
# Save overall ratings from virtualmin.com
sub save_overall_script_ratings
{
local ($overall) = @_;
&write_file($script_ratings_overall, $overall);
}

# check_script_db_connection(dbtype, dbname, dbuser, dbpass)
# Returns an error message if connection to the database with the given details
# would fail, undef otherwise
sub check_script_db_connection
{
local ($dbtype, $dbname, $dbuser, $dbpass) = @_;
if (&indexof($dbtype, @database_features) >= 0) {
	# Core feature
	local $cfunc = "check_".$dbtype."_login";
	if (defined(&$cfunc)) {
		return &$cfunc($dbname, $dbuser, $dbpass);
		}
	}
elsif (&indexof($dbtype, &list_database_plugins()) >= 0) {
	# Plugin database
	return &plugin_call($dbtype, "feature_database_check_login",
			    $dbname, $dbuser, $dbpass);
	}
return undef;
}

# setup_ruby_modules(&domain, &script, version, &opts)
# Attempt to install any support programs needed by this script for Ruby.
# At the moment, all it does is try to install 'gem'
sub setup_ruby_modules
{
local ($d, $script, $ver, $opts) = @_;

if (!&has_command("gem") &&
    &indexof("ruby", @{$script->{'uses'}}) >= 0) {
	# Try to install gem from YUM or APT
	&$first_print($text{'scripts_installgem'});

	# Make sure the software module is installed and can do updates
	if (!&foreign_installed("software")) {
		&$second_print($text{'scripts_esoftware'});
		return 0;
		}
	&foreign_require("software", "software-lib.pl");
	if (!defined(&software::update_system_install)) {
		&$second_print($text{'scripts_eupdate'});
		return 0;
		}

	# Try to install it. We assume that the package is always called
	# 'rubygems' on all update systems.
	&software::update_system_install("rubygems");
	delete($main::has_command_cache{'gem'});
	local $newpkg = $software::update_system eq "csw" ? "CSWrubygems"
							  : "rubygems";
	local @pinfo = &software::package_info($newpkg);
	if (@pinfo && $pinfo[0] eq $newpkg) {
		# Worked
		&$second_print($text{'setup_done'});
		}
	else {
		&$second_print($text{'scripts_esoftwaremod'});
		return 0;
		}
	}

# Check if a Gem version was requested, and if so update to it
local $vfunc = $script->{'gem_version_func'};
if (defined(&$vfunc)) {
	local $needver = &$vfunc($d, $ver, $opts);
	local $gotver = &get_gem_version();
	if (&compare_versions($needver, $gotver) > 0) {
		# Need a newer Gem version! Try to update
		&$first_print(&text('scripts_gemver', $gotver));
		local $gempath = &has_command("gem");
		local $rver = &get_ruby_version();
		$rver =~ s/^(\d+\.\d+).*/$1/;	# Make it like just 1.8
		local $oldgemverpath = &has_command("gem".$rver);
		&execute_command("gem list --remote");	# Force cache init
		$out = &backquote_logged(
			"gem update --system 2>&1 </dev/null");
		if ($?) {
			# Failed
			&$second_print(&text('scripts_gemverfailed',
					   "<tt>".&html_escape($out)."</tt>"));
			return 0;
			}
		elsif (&get_gem_version() eq $gotver) {
			# Appeared to be OK, but really failed
			&$second_print(&text('scripts_gemverfailed2', $gotver,
					   "<tt>".&html_escape($out)."</tt>"));
			return 0;
			}
		else {
			&$second_print($text{'setup_done'});

			# If the update installed gem1.8, link the old gem
			# command to it instead
			local $newgemverpath = &has_command("gem".$rver);
			if ($newgemverpath && !$oldgemverpath &&
			    $gempath &&
			    !&same_file($gempath, $newgemverpath)) {
				&$first_print(&text('scripts_gemlink',
						"<tt>$gempath</tt>",
						"<tt>$newgemverpath</tt>"));
				&unlink_file($gempath);
				&symlink_file($newgemverpath, $gempath);
				&$second_print($text{'setup_done'});
				}
			}
		}
	}

# Check if any Gems were needed
local $gfunc = $script->{'gems_func'};
if (defined(&$gfunc)) {
	local @gems = &$gfunc($d, $ver, $opts);
	foreach my $g (@gems) {
		local ($name, $version, $nore) = @$g;
		&$first_print(
		  $version ? &text('scripts_geminstall2',
				   "<tt>$name</tt>", $version) :
			     &text('scripts_geminstall', "<tt>$name</tt>"));
		local $err = &install_ruby_gem($name, $version, $nore);
		if ($err) {
			&$second_print(&text('scripts_gemfailed',
					"<tt>".&html_escape($err)."</tt>"));
			return 0;
			}
		else {
			&$second_print($text{'setup_done'});
			}
		}
	}

return 1;
}

# check_script_required_commands(&domain, &script, version)
# Checks for commands required by some script, and returns a list of those
# that are missing.
sub check_script_required_commands
{
local ($d, $script, $ver, $opts) = @_;
local $cfunc = $script->{'commands_func'};
local @missing;
if ($cfunc && defined(&$cfunc)) {
	foreach my $c (&$cfunc($d, $ver, $opts)) {
		if (!&has_command($c)) {
			push(@missing, $c);
			}
		}
	}
return @missing;
}

# create_script_wget_job(&domain, url, mins, hours, [call-now])
# Creates a cron job running as some domain owner which regularly wget's
# some URL, to perform some periodic task for a script
sub create_script_wget_job
{
local ($d, $url, $mins, $hours, $callnow) = @_;
return 0 if (!&foreign_check("cron"));
&foreign_require("cron", "cron-lib.pl");
local $wget = &has_command("wget");
return 0 if (!$wget);
local $job = { 'user' => $d->{'user'},
	       'active' => 1,
	       'command' => "$wget -q -O /dev/null $url",
	       'mins' => $mins,
	       'hours' => $hours,
	       'days' => '*',
	       'months' => '*',
	       'weekdays' => '*' };
&cron::create_cron_job($job);
if ($callnow) {
	# Run wget now
	&system_logged("$wget -q -O /dev/null $url >/dev/null 2>&1 </dev/null");
	}
return 1;
}

# delete_script_wget_job(&domain, url)
# Deletes the cron job that regularly fetches some URL
sub delete_script_wget_job
{
local ($d, $url) = @_;
return 0 if (!&foreign_check("cron"));
&foreign_require("cron", "cron-lib.pl");
local @jobs = &cron::list_cron_jobs();
local ($job) = grep { $_->{'user'} eq $d->{'user'} &&
		      $_->{'command'} =~ /^\S*wget\s.*\s(\S+)$/ &&
		      $1 eq $url } @jobs;
return 0 if (!$job);
&cron::delete_cron_job($job);
return 1;
}

sub find_scriptwarn_job
{
local $job = &find_virtualmin_cron_job($scriptwarn_cron_cmd);
return $job;
}

sub find_scriptlatest_job
{
local $job = &find_virtualmin_cron_job($scriptlatest_cron_cmd);
return $job;
}

# list_script_upgrades(&domains)
# Returns a list of script updates that can be done in the given domains
sub list_script_upgrades
{
local ($doms) = @_;
local (%scache, @rv);
foreach my $d (@$doms) {
	&detect_real_script_versions($d);
	foreach my $sinfo (&list_domain_scripts($d)) {
		# Find the lowest version better or equal to the one we have
		$script = $scache{$sinfo->{'name'}} ||
			    &get_script($sinfo->{'name'});
		$scache{$sinfo->{'name'}} = $script;
		local @vers = grep { &can_script_version($script, $_) }
			     @{$script->{'versions'}};
		local $canupfunc = $script->{'can_upgrade_func'};
		if (defined(&$canupfunc)) {
			@vers = grep { &$canupfunc($sinfo, $_) } @vers;
			}
		@vers = sort { &compare_versions($b, $a, $script) } @vers;
		local @better = grep { &compare_versions($_,
				$sinfo->{'version'}, $script) >= 0 } @vers;
		local $ver = @better ? $better[$#better] : undef;
		next if (!$ver);

		# Don't upgrade if we are already running this version
		next if ($ver eq $sinfo->{'version'});

		# Don't upgrade if deleted
		next if ($sinfo->{'deleted'});

		# We have one - add to the results
		push(@rv, { 'sinfo' => $sinfo,
			    'script' => $script,
			    'dom' => $d,
			    'ver' => $ver });
		}
	}
return @rv;
}

# extract_script_archive(file, dir, &domain, [copy-to-dir], [sub-dir],
#			 [single-file], [ignore-errors], [&skip-files])
# Attempts to extract a tar.gz or tar or zip file for a script. Returns undef
# on success, or an HTML error message on failure.
sub extract_script_archive
{
local ($file, $dir, $d, $copydir, $subdir, $single, $ignore, $skip) = @_;

# Create the target dir if missing
if (!$single && $copydir && !-d $copydir) {
	local $out = &run_as_domain_user(
		$d, "mkdir -p ".quotemeta($copydir)." 2>&1");
	if ($?) {
		return "Failed to create target directory : ".
		       "<tt>".&html_escape($out)."</tt>";
		}
	elsif (!-d $copydir) {
		return "Command to create target directory did not work!";
		}
	&set_permissions_as_domain_user($d, 0755, $copydir);
	}

# Extract compressed file to a temp dir
if (!-d $dir) {
	# Can be done as root, as it is in /tmp
	&make_dir($dir, 0755);
	&set_ownership_permissions($d->{'uid'}, $d->{'ugid'}, undef, $dir);
	}
local $fmt = &compression_format($file);
local $qfile = quotemeta($file);
local $cmd;
local $tar = &get_tar_command();
if ($fmt == 0) {
	return "Not a compressed file";
	}
elsif ($fmt == 1) {
	$cmd = "(gunzip -c $qfile | $tar xf -)";
	}
elsif ($fmt == 2) {
	$cmd = "(uncompress -c $qfile | $tar xf -)";
	}
elsif ($fmt == 3) {
	$cmd = "(".&get_bunzip2_command()." -c $qfile | $tar xf -)";
	}
elsif ($fmt == 4) {
	$cmd = "unzip $qfile";
	}
elsif ($fmt == 5) {
	$cmd = "$tar xf $qfile";
	}
else {
	return "Unknown compression format";
	}
local $out = &run_as_domain_user($d, "(cd ".quotemeta($dir)." && ".$cmd.") 2>&1");
return "Uncompression failed : <pre>".&html_escape($out)."</pre>"
	if ($? && !$ignore);

# Make sure the target files are owner-writable, so we can copy over them
if ($copydir && -e $copydir) {
	&run_as_domain_user($d, "chmod -R u+w ".quotemeta($copydir));
	}

# Copy to a target dir, if requested
if ($copydir) {
	local $path = "$dir/$subdir";
	($path) = glob("$dir/$subdir") if (!-e $path);

	# Remove files to skip copying
	if ($skip) {
		foreach my $s (@$skip) {
			&run_as_domain_user($d,
				"rm -rf ".quotemeta($path)."/".$s);
			}
		}

	local $out;
	if (-f $path) {
		# Copy one file
		$out = &run_as_domain_user($d, "cp ".quotemeta($dir).
				   "/$subdir ".quotemeta($copydir)." 2>&1");
		}
	elsif (-d $path) {
		# Copy a directory's contents
		$out = &run_as_domain_user($d, "cp -r ".quotemeta($dir).
				   ($subdir ? "/$subdir/*" : "/*").
				   " ".quotemeta($copydir)." 2>&1");
		}
	else {
		return "Sub-directory $subdir was not found";
		}
	$out = undef if ($out !~ /\S/);
	if ($? && !$ignore) {
		return "<pre>".&html_escape($out || "Exit status $?")."</pre>";
		}

	# Copy any dot-files too
	if (-d $path) {
		$out = &run_as_domain_user($d, "cp -r ".quotemeta($dir).
				   ($subdir ? "/$subdir/.??*" : "/.??*").
				   " ".quotemeta($copydir)." 2>&1");
		}

	# Make dest files non-world-readable and user writable, unless we don't
	# add Apache to a group, or if the home is world-readable
	local $mode = &get_domain_php_mode($d);
	local @st = stat($d->{'home'});
	if (&apache_in_domain_group($d) && ($st[2]&07) == 0) {
		# Apache is a member of the domain's group, so we can make
		# all script files non-world-readable
		&run_as_domain_user($d, "chmod -R o-rxw ".quotemeta($copydir));
		}
	elsif ($mode ne "mod_php") {
		# Running via CGI or fastCGI, so make .php, .cgi and .pl files
		# non-world-readable
		&run_as_domain_user($d,
		  "find ".quotemeta($copydir)." -type f ".
		  "-name '*.php' -o -name '*.php?' -o -name '*.cgi' ".
		  "-o -name '*.pl' | xargs chmod -R o-rxw 2>/dev/null");
		}
	&run_as_domain_user($d, "chmod -R u+rwx ".quotemeta($copydir));
	&run_as_domain_user($d, "chmod -R g+rx ".quotemeta($copydir));
	}

return undef;
}

# has_domain_databases($d, &types, [dont-create])
# Returns 1 if a domain has any databases of the given types, or if one can
# be created by the script install process.
sub has_domain_databases
{
local ($d, $types, $nocreate) = @_;
local @dbs = &domain_databases($d, $types);
if (@dbs) {
	return 1;
	}
if (!$nocreate) {
	# Can we create one?
	local ($dleft, $dreason, $dmax) = &count_feature("dbs");
	local @ftypes = grep { $d->{$_} } @$types;
	if (@ftypes && $dleft != 0 && &can_edit_databases()) {
		return 1;
		}
	}
return 0;
}

# guess_script_version(file)
# Returns the highest version number from some script file
sub guess_script_version
{
local ($file) = @_;
local $lref = &read_file_lines($file, 1);
for(my $i=0; $i<@$lref; $i++) {
	if ($lref->[$i] =~ /^\s*sub\s+script_\S+_versions/) {
		if ($lref->[$i+2] =~ /^\s*return\s+\(([^\)]*)\)/ ||
		    $lref->[$i+1] =~ /^\s*return\s+\(([^\)]*)\)/) {
			local $verlist = $1;
			$verlist =~ s/^\s+//; $verlist =~ s/\s+$//;
			local @vers = &split_quoted_string($verlist);
			return $vers[0];
			}
		return undef;	# Versions not found where expected
		}
	}
return undef;
}

# setup_noproxy_path(&domain, &script, ver, &opts, add-even-if-no-clash)
# If a script isn't using proxying, ensure that it's path is not blocked.
# Prints messages, and returns 1 on success, 0 on failure.
sub setup_noproxy_path
{
local ($d, $script, $ver, $opts, $forceadd) = @_;

# Check if the script doesn't use proxying, and if Apache supports negatives
return 1 if (&indexof("proxy", @{$script->{'uses'}}) >= 0);
return 1 if (!&has_proxy_balancer($d) || !&has_proxy_none());

# Check if a proxy exists for a parent path
local @proxies = &list_proxy_balancers($d);
local $clash;
foreach my $p (@proxies) {
	if (!$p->{'none'} &&
	    ($p->{'path'} eq '/' ||
	     $p->{'path'} eq $opts->{'path'} ||
	     substr($opts->{'path'}, 0, length($p->{'path'})+1) eq
	     $p->{'path'}."/")) {
		$clash = $p;
		last;
		}
	}

# Check if we are already negating this path
foreach my $p (@proxies) {
	if ($p->{'path'} eq $opts->{'path'} && $p->{'none'}) {
		return 1;
		}
	}

local $err;
if ($clash && $clash->{'path'} eq $opts->{'path'}) {
	# Remove direct clash
	&$first_print(&text('scripts_delproxy', $opts->{'path'}));
	$err = &delete_proxy_balancer($d, $clash);
	}
elsif ($clash || $forceadd) {
	# Add a negative override
	&$first_print(&text('scripts_addover', $opts->{'path'}));
	local $over = { 'path' => $opts->{'path'}, 'none' => 1 };
	$err = &create_proxy_balancer($d, $over);
	}
else {
	# Nothing needs to be done
	return 1;
	}
if ($err) {
	&$second_print(&text('scripts_proxyfailed', $err));
	return 0;
	}
else {
	&$second_print($text{'setup_done'});
	return 1;
	}
}

# delete_noproxy_path(&domain, &script, ver, &opts)
# Delete any negative proxy for a script, as created by setup_noproxy_path
sub delete_noproxy_path
{
local ($d, $script, $ver, $opts) = @_;

# Check if the script doesn't use proxying, and if Apache supports negatives
return 0 if (&indexof("proxy", @{$script->{'uses'}}) >= 0);
return 0 if (!&has_proxy_balancer($d) || !&has_proxy_none());

# Find and remove the negator
local @proxies = &list_proxy_balancers($d);
foreach my $p (@proxies) {
	if ($p->{'path'} eq $opts->{'path'} && $p->{'none'}) {
		&delete_proxy_balancer($d, $p);
		return 1;
		}
	}
return 0;
}

# setup_script_requirements(&domain, &script, ver, &phpver, &opts)
# Install any needed PHP modules or other dependencies for some script.
# Returns 1 on success, 0 on failure. May print stuff.
sub setup_script_requirements
{
local ($d, $script, $ver, $phpver, $opts) = @_;

# Install modules needed for various scripting languages
&setup_php_modules($d, $script, $ver, $phpver, $opts) || return 0;
&setup_pear_modules($d, $script, $ver, $phpver, $opts) || return 0;
&setup_perl_modules($d, $script, $ver, $opts) || return 0;
&setup_ruby_modules($d, $script, $ver, $opts) || return 0;
&setup_python_modules($d, $script, $ver, $opts) || return 0;
&setup_noproxy_path($d, $script, $ver, $opts) || return 0;

# Setup PHP variables
if (&indexof("php", @{$script->{'uses'}}) >= 0) {
	&$first_print($text{'scripts_apache'});
	if (&setup_web_for_php($d, $script, $phpver)) {
		&$second_print($text{'setup_done'});
		&register_post_action(\&restart_apache);
		}
	else {
		&$second_print($text{'scripts_aalready'});
		}
	}

return 1;
}

# check_script_depends(&script, &domain, &ver, [&upgrade-info])
# Returns a list of dependency problems found for this script, including
# missing commands.
sub check_script_depends
{
local ($script, $d, $ver, $sinfo) = @_;
local @rv;
if (defined(&{$script->{'depends_func'}})) {
	push(@rv, grep { $_ } &{$script->{'depends_func'}}($d, $ver, $sinfo));
	}
if (defined(&{$script->{'dbs_func'}})) {
	local @dbs = &{$script->{'dbs_func'}}($d, $ver);
	if (!&has_domain_databases($d, \@dbs)) {
		local @dbnames = map { $text{'databases_'.$_} || $_ } @dbs;
		local $dbneed = @dbnames == 1 ?
			$dbnames[0] :
			&text('scripts_idbneedor', @dbnames[0..$#dbnames-1],
						   $dbnames[$#dbnames]);
		push(@rv, &text('scripts_idbneed', $dbneed));
		}
	}
push(@rv, map { &text('scripts_icommand', $_) }
      &check_script_required_commands($d, $script, $ver, $sinfo->{'opts'}));
return wantarray ? @rv : join(", ", @rv);
}

# get_script_master_permissions()
# Returns flags indicating if the master admin is allowed to use
# disabled scripts or versions, and if new scripts are denied by default
sub get_script_master_permissions
{
local %unavail;
&read_file_cached($scripts_unavail_file, \%unavail);
return ($unavail{'allowmaster'}, $unavail{'allowvers'},
	$unavail{'denydefault'});
}

# save_script_master_permissions(allow-disabled, allow-versions, deny-default)
# Updates flags indicating what the master is allow to do for disabled scripts
sub save_script_master_permissions
{
local ($allow, $allowvers, $denydefault) = @_;
local %unavail;
&lock_file($scripts_unavail_file);
&read_file_cached($scripts_unavail_file, \%unavail);
($unavail{'allowmaster'}, $unavail{'allowvers'},
 $unavail{'denydefault'}) = ($allow, $allowvers, $denydefault);
&write_file($scripts_unavail_file, \%unavail);
&unlock_file($scripts_unavail_file);
}

# setup_scriptwarn_job(enabled, when)
# Create, update or delete the cron job that sends script update notifications
sub setup_scriptwarn_job
{
local ($enabled, $when) = @_;
&foreign_require("cron", "cron-lib.pl");
local $job = &find_scriptwarn_job();
if ($job && !$enabled) {
	# Delete job
	&lock_file(&cron::cron_file($job));
	&cron::delete_cron_job($job);
	&unlock_file(&cron::cron_file($job));
	}
elsif (!$job && $enabled) {
	# Create daily job
	$job = { 'user' => 'root',
		 'command' => $scriptwarn_cron_cmd,
		 'active' => 1 };
	&apply_cron_schedule($job, $when || 'daily');
	&lock_file(&cron::cron_file($job));
	&cron::create_cron_job($job);
	&unlock_file(&cron::cron_file($job));
	}
elsif ($job && $enabled && $when &&
       $when ne &parse_cron_schedule($job)) {
	# Update schedule if needed
	&apply_cron_schedule($job, $when);
	&lock_file(&cron::cron_file($job));
	&cron::change_cron_job($job);
	&unlock_file(&cron::cron_file($job));
	}
&cron::create_wrapper($scriptwarn_cron_cmd, $module_name, "scriptwarn.pl");
}

# setup_scriptlatest_job(enabled)
# Create or delete the cron job that downloads script updates
sub setup_scriptlatest_job
{
local ($enabled) = @_;
&foreign_require("cron", "cron-lib.pl");
local $job = &find_scriptlatest_job();
if ($job && !$enabled) {
	# Delete job
	&lock_file(&cron::cron_file($job));
	&cron::delete_cron_job($job);
	&unlock_file(&cron::cron_file($job));
	}
elsif (!$job && $enabled) {
	# Create daily job
	$job = { 'user' => 'root',
		 'command' => $scriptlatest_cron_cmd,
		 'active' => 1,
		 'mins' => int(rand()*60),
		 'hours' => int(rand()*24),
		 'days' => '*',
		 'months' => '*',
		 'weekdays' => '*', };
	&lock_file(&cron::cron_file($job));
	&cron::create_cron_job($job);
	&unlock_file(&cron::cron_file($job));
	}
&cron::create_wrapper($scriptlatest_cron_cmd, $module_name, "scriptlatest.pl");
}

# apply_cron_schedule(&job, 'daily'|'weekly'|'monthly')
# Sets attributes of a Cron job to match some named schedule
sub apply_cron_schedule
{
my ($job, $sched) = @_;
$job->{'mins'} = int(rand()*60);
$job->{'hours'} = 0;
if ($sched eq 'daily') {
	$job->{'days'} = $job->{'months'} = $job->{'weekdays'} = '*';
	}
elsif ($sched eq 'weekly') {
	$job->{'weekdays'} = '1';
	$job->{'months'} = $job->{'days'} = '*';
	}
elsif ($sched eq 'monthly') {
	$job->{'days'} = '1';
	$job->{'months'} = $job->{'weekdays'} = '*';
	}
}

# parse_cron_schedule(&job)
# Returns 'daily', 'weekly', 'monthly' or undef depending on how often a Cron
# job runs
sub parse_cron_schedule
{
my ($job) = @_;
return $job->{'hours'} eq '0' && $job->{'days'} eq '*' &&
	 $job->{'months'} eq '*' && $job->{'weekdays'} eq '*' ? 'daily' :
       $job->{'days'} eq '1' &&
	  $job->{'months'} eq '*' && $job->{'weekdays'} eq '*' ? 'monthly' :
       $job->{'days'} eq '*' &&
	  $job->{'months'} eq '*' && $job->{'weekdays'} eq '1' ? 'weekly' :
								 undef;
}

# detect_real_script_versions(&domain)
# Scan the list of installed scripts for some domain, and update the real
# version number where necessary. Used to detect scripts that have been updated
# manually via some internal function, like Wordpress
sub detect_real_script_versions
{
local ($d) = @_;
foreach my $sinfo (&list_domain_scripts($d)) {
	my $script = &get_script($sinfo->{'name'});
	my $rfunc = $script->{'realversion_func'};
	if (defined(&$rfunc)) {
		local $realver = &$rfunc($d, $sinfo->{'opts'}, $sinfo);
		if ($realver && $realver ne $sinfo->{'version'}) {
			# Version has changed .. fix
			$sinfo->{'version'} = $realver;
			&save_domain_script($d, $sinfo);
			}
		}
	}
}

# php_quotemeta(string)
# Quote ' and " characters in a PHP string
sub php_quotemeta
{
local ($str) = @_;
$str =~ s/\\/\\\\/g;
$str =~ s/'/\\'/g;
$str =~ s/"/\\"/g;
return $str;
}

# substitute_scriptname_template(scriptname, &domain)
# Returns an install script directory name, based on the config
sub substitute_scriptname_template
{
local ($name, $d) = @_;
if ($config{'scriptdir'}) {
	local %hash = &make_domain_substitions($d, 0);
	$hash{'SCRIPTNAME'} = $name;
	return &substitute_virtualmin_template($config{'scriptdir'}, \%hash);
	}
return $name;
}

1;

