Fix to replace raw octal mode literals

https://github.com/webmin/webmin/pull/2743#discussion_r3319948219

.github/workflows/close-inactive.yml

@@ -0,0 +1,15 @@
+name: Close inactive
+
+on:
+  schedule:
+    - cron: "0 12 * * *"
+  workflow_dispatch:
+
+permissions:
+  contents: read
+  issues: write
+  pull-requests: write
+
+jobs:
+  close-inactive:
+    uses: webmin/webmin-ci-cd/.github/workflows/close-inactive.yml@main

.github/workflows/code-review.yml

@@ -0,0 +1,12 @@
+name: Code Review
+
+on:
+  pull_request:
+    branches:
+      - master
+
+jobs:
+  code-review:
+    uses: webmin/webmin-ci-cd/.github/workflows/code-review.yml@main
+    secrets:
+      CODE_REVIEW_API_KEY: ${{ secrets.CODE_REVIEW_API_KEY }}

.github/workflows/tests.yml

@@ -0,0 +1,19 @@
+name: Tests
+
+on:
+  pull_request:
+    branches:
+      - master
+  push:
+    branches:
+      - master
+
+jobs:
+  prove:
+    runs-on: ubuntu-latest
+    steps:
+      - uses: actions/checkout@v4
+      - name: Install Perl::Critic
+        run: sudo apt-get update && sudo apt-get install -y libperl-critic-perl
+      - name: prove -lr
+        run: prove -lr

.github/workflows/webmin.dev+webmin.yml

@@ -1,4 +1,4 @@
-name: "webmin.dev: webmin/webmin"
+name: Build
 
 on:
   push:
@@ -25,3 +25,5 @@ jobs:
       PRERELEASE_UPLOAD_SSH_DIR: ${{ secrets.PRERELEASE_UPLOAD_SSH_DIR }}
       DEV_SSH_PRV_KEY: ${{ secrets.DEV_SSH_PRV_KEY }}
       ALL_GPG_PH2: ${{ secrets.ALL_GPG_PH2 }}
+      CODE_REVIEW_API_KEY: ${{ secrets.CODE_REVIEW_API_KEY }}
+      CODE_REVIEW_SMTP_PASSWORD: ${{ secrets.CODE_REVIEW_SMTP_PASSWORD }}

.perlcriticrc

@@ -0,0 +1,6 @@
+severity = 5
+
+# Octal file permission literals (0700, 0640, etc.) are the standard Perl
+# idiom for chmod/mkdir/permission helpers throughout this codebase. The
+# policy flags chmod 0700 itself, so it is too coarse for our use.
+[-ValuesAndExpressions::ProhibitLeadingZeros]

CHANGELOG.md

@@ -1,5 +1,10 @@
 ## Changelog
 
+#### 2.641 (May 10, 2026)
+* Fixed a bug when editing monitors in the System and Server Status module
+* Fix Fail2Ban default jail options
+* Added support for trusted proxy IP addresses
+
 #### 2.640 (May 4, 2026)
 * Add new nftables module with profiles, saved tables, and chains/sets management
 * Add new Nginx module with look and feel matching the Apache module

acl/acl-lib.pl

@@ -11,7 +11,7 @@ Library for editing webmin users, passwords and access rights.
 
 =cut
 
-BEGIN { push(@INC, ".."); };
+BEGIN { push(@INC, ".."); };    ## no critic
 use strict;
 use warnings;
 no warnings 'redefine';
@@ -92,7 +92,6 @@ while(my $l = <$fh>) {
 		$user{'locale'} = $gconfig{"locale_$user[0]"};
 		$user{'dateformat'} = $gconfig{"dateformat_$user[0]"};
 		$user{'notabs'} = $gconfig{"notabs_$user[0]"};
-		$user{'rbacdeny'} = $gconfig{"rbacdeny_$user[0]"};
 		if ($gconfig{"theme_$user[0]"}) {
 			($user{'theme'}, $user{'overlay'}) =
 				split(/\s+/, $gconfig{"theme_$user[0]"});
@@ -353,7 +352,8 @@ each of which is a hash reference in the same format as their module.info files.
 sub list_module_infos
 {
 my @mods = grep { &check_os_support($_) } &get_all_module_infos();
-return sort { $a->{'desc'} cmp $b->{'desc'} } @mods;
+my @sorted = sort { $a->{'desc'} cmp $b->{'desc'} } @mods;
+return @sorted;
 }
 
 =head2 create_user(&details, [clone])
@@ -501,8 +501,6 @@ else {
 	$gconfig{"lang_".$user->{'name'}} = $user->{'lang'} if ($user->{'lang'});
 	delete($gconfig{"notabs_".$user->{'name'}});
 	$gconfig{"notabs_".$user->{'name'}} = $user->{'notabs'} if ($user->{'notabs'});
-	delete($gconfig{"rbacdeny_".$user->{'name'}});
-	$gconfig{"rbacdeny_".$user->{'name'}} = $user->{'rbacdeny'} if ($user->{'rbacdeny'});
 	delete($gconfig{"ownmods_".$user->{'name'}});
 	$gconfig{"ownmods_".$user->{'name'}} = join(" ", @{$user->{'ownmods'}})
 		if ($user->{'ownmods'} && @{$user->{'ownmods'}});
@@ -722,9 +720,6 @@ else {
 	delete($gconfig{"notabs_".$username});
 	$gconfig{"notabs_".$user->{'name'}} = $user->{'notabs'}
 		if ($user->{'notabs'});
-	delete($gconfig{"rbacdeny_".$username});
-	$gconfig{"rbacdeny_".$user->{'name'}} = $user->{'rbacdeny'}
-		if ($user->{'rbacdeny'});
 	delete($gconfig{"ownmods_".$username});
 	$gconfig{"ownmods_".$user->{'name'}} = join(" ", @{$user->{'ownmods'}})
 		if ($user->{'ownmods'} && @{$user->{'ownmods'}});
@@ -1337,12 +1332,12 @@ my ($miniserv) = @_;
 my $sfile = $miniserv->{'sessiondb'} ? $miniserv->{'sessiondb'} :
 	    $miniserv->{'pidfile'} =~ /^(.*)\/[^\/]+$/ ? "$1/sessiondb"
 						     : return;
-eval "use SDBM_File";
+eval { require SDBM_File; SDBM_File->import; 1 };
 dbmopen(%sessiondb, $sfile, 0700);
 eval { $sessiondb{'1111111111'} = 'foo bar' };
 if ($@) {
 	dbmclose(%sessiondb);
-	eval "use NDBM_File";
+	eval { require NDBM_File; NDBM_File->import; 1 };
 	dbmopen(%sessiondb, $sfile, 0700);
 	}
 else {
@@ -1428,10 +1423,10 @@ Creates a new session ID that's already logged in as the given user
 sub create_session_user
 {
 my ($miniserv, $username, $lifetime) = @_;
-return undef if (&is_readonly_mode());
+return if (&is_readonly_mode());
 &open_session_db($miniserv);
 my $sid = &generate_random_session_id();
-return undef if (!$sid);
+return if (!$sid);
 my $t = time();
 $sessiondb{$sid} = "$username $t 127.0.0.1".($lifetime ? " ".$lifetime : "");
 dbmclose(%sessiondb);
@@ -1699,7 +1694,7 @@ elsif (&has_command("ssleay")) {
 	return &has_command("ssleay");
 	}
 else {
-	return undef;
+	return;
 	}
 }
 
@@ -1815,6 +1810,7 @@ foreach my $g (&list_groups()) {
 		return $g;
 		}
 	}
+return;
 }
 
 =head2 check_password_restrictions(username, password)
@@ -1859,7 +1855,7 @@ if ($miniserv{'pass_oldblock'} && $user) {
 		last if ($c++ > $miniserv{'pass_oldblock'});
 		}
 	}
-return undef;
+return;
 }
 
 =head2 hash_session_id(sid)
@@ -1896,11 +1892,11 @@ my $use_md5 = &md5_perl_module();
 $use_md5 || &error("No Perl MD5 hashing module found!");
 
 # Add the password
-my $ctx = eval "new $use_md5";
+my $ctx = $use_md5->new;
 $ctx->add($passwd);
 
 # Add some more stuff from the hash of the password and salt
-my $ctx1 = eval "new $use_md5";
+my $ctx1 = $use_md5->new;
 $ctx1->add($passwd);
 $ctx1->add($passwd);
 my $final = $ctx1->digest();
@@ -1949,12 +1945,12 @@ Returns a Perl module for MD5 hashing, or undef if none.
 sub md5_perl_module
 {
 my $use_md5;
-eval "use MD5";
+eval { require MD5; MD5->import; 1 };
 if (!$@) {
         $use_md5 = "MD5";
         }
 else {
-        eval "use Digest::MD5";
+        eval { require Digest::MD5; Digest::MD5->import; 1 };
         if (!$@) {
                 $use_md5 = "Digest::MD5";
                 }
@@ -2111,16 +2107,16 @@ my ($str, $notablecheck) = @_;
 my ($proto, $user, $pass, $host, $prefix, $args) = &split_userdb_string($str);
 if ($proto eq "mysql" || $proto eq "postgresql") {
 	# Load DBI driver
-	eval 'use DBI;';
+	eval { require DBI; DBI->import; 1 };
 	return &text('sql_emod', 'DBI') if ($@);
 	if ($proto eq "mysql") {
-		eval 'use DBD::mysql;';
+		eval { require DBD::mysql; DBD::mysql->import; 1 };
 		return &text('sql_emod', 'DBD::mysql') if ($@);
 		my $drh = DBI->install_driver("mysql");
 		return $text{'sql_emysqldriver'} if (!$drh);
 		}
 	else {
-		eval 'use DBD::Pg;';
+		eval { require DBD::Pg; DBD::Pg->import; 1 };
 		return &text('sql_emod', 'DBD::Pg') if ($@);
 		my $drh = DBI->install_driver("Pg");
 		return $text{'sql_epostgresqldriver'} if (!$drh);
@@ -2152,11 +2148,11 @@ if ($proto eq "mysql" || $proto eq "postgresql") {
 			}
 		}
 	&disconnect_userdb($str, $dbh);
-	return undef;
+	return;
 	}
 elsif ($proto eq "ldap") {
 	# Load LDAP module
-	eval 'use Net::LDAP;';
+	eval { require Net::LDAP; Net::LDAP->import; 1 };
 	return &text('sql_emod', 'Net::LDAP') if ($@);
 
 	# Try to connect
@@ -2190,7 +2186,7 @@ elsif ($proto eq "ldap") {
 		$found || return &text('sql_eldapdn', $prefix);
 		}
 	&disconnect_userdb($str, $dbh);
-	return undef;
+	return;
 	}
 else {
 	return "Unknown user database type $proto";
@@ -2284,8 +2280,8 @@ if (!$miniserv) {
 	$miniserv = { };
 	&get_miniserv_config($miniserv);
 	}
-foreach $a (split(/\s+/, $miniserv->{'anonymous'})) {
-        if ($a =~ /^([^=]+)=(\S+)$/ && $2 eq $user) {
+foreach my $tok (split(/\s+/, $miniserv->{'anonymous'})) {
+        if ($tok =~ /^([^=]+)=(\S+)$/ && $2 eq $user) {
 		push(@rv, $1);
 		}
 	}
@@ -2299,7 +2295,7 @@ sub get_safe_acl
 my ($m) = @_;
 my $mdir = &module_root_directory($m);
 my %rv;
-&read_file_cached("$mdir/safeacl", \%rv) || return undef;
+&read_file_cached("$mdir/safeacl", \%rv) || return;
 return \%rv;
 }
 
@@ -2313,17 +2309,19 @@ sub generate_random_session_id
 my $sid;
 
 # Try /dev/urandom, but with a timeout
-$SIG{ALRM} = sub { close(RANDOM) };
+my $randomfh;
+$SIG{ALRM} = sub { close($randomfh) if ($randomfh) };
 alarm(5);
-if (open(RANDOM, "/dev/urandom")) {
+if (open($randomfh, "<", "/dev/urandom")) {
 	my $tmpsid;
-	if (read(RANDOM, $tmpsid, 16) == 16) {
+	if (read($randomfh, $tmpsid, 16) == 16) {
 		$sid = lc(unpack('h*',$tmpsid));
 		if ($sid !~ /^[0-9a-fA-F]{32}$/) {
 			$sid = 'bad';
 			}
 		}
-	close(RANDOM);
+	close($randomfh);
+	undef($randomfh);
 	}
 alarm(0);
 
@@ -2341,7 +2339,7 @@ return $sid eq 'bad' ? undef : $sid;
 # Generate an ID string that can be used for a password reset link
 sub generate_random_id
 {
-if (open(my $RANDOM, "</dev/urandom")) {
+if (open(my $RANDOM, "<", "/dev/urandom")) {
 	my $sid;
 	my $tmpsid;
 	if (read($RANDOM, $tmpsid, 16) == 16) {
@@ -2350,7 +2348,9 @@ if (open(my $RANDOM, "</dev/urandom")) {
 	close($RANDOM);
 	return $sid;
 	}
-return undef;
+# Explicit undef: callers consume this in hash-literal value position,
+# where bare 'return' would yield () and shift the surrounding pairing.
+return undef;    ## no critic (ProhibitExplicitReturnUndef)
 }
 
 # obsfucate_email(email)

acl/backup_config.pl

@@ -3,7 +3,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require 'acl-lib.pl';
+require 'acl-lib.pl';    ## no critic
 our ($config_directory, %gconfig);
 
 # backup_config_files()
@@ -43,7 +43,7 @@ return @rv;
 # Called before the files are actually read
 sub pre_backup
 {
-return undef;
+return;
 }
 
 # post_backup(&files)
@@ -52,7 +52,7 @@ sub post_backup
 {
 unlink("$config_directory/config.aclbackup");
 unlink("$config_directory/miniserv.conf.aclbackup");
-return undef;
+return;
 }
 
 # pre_restore(&files)
@@ -66,7 +66,7 @@ foreach my $u (&list_users(), &list_groups()) {
 		       glob("$config_directory/*/$u->{'name'}.acl"));
 		}
 	}
-return undef;
+return;
 }
 
 # post_restore(&files)
@@ -101,7 +101,7 @@ foreach my $k (keys %aclbackup) {
 &put_miniserv_config(\%miniserv);
 
 &restart_miniserv();
-return undef;
+return;
 }
 
 1;

acl/cert_form.cgi

@@ -5,11 +5,11 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access);
 &ui_print_header(undef, $text{'cert_title'}, "", undef, undef, undef, undef,
 		 undef, undef, "language=VBSCRIPT onload='postLoad()'");
-eval "use Net::SSLeay";
+eval { require Net::SSLeay; Net::SSLeay->import; 1 };
 
 print "<p>$text{'cert_msg'}<p>\n";
 if ($ENV{'SSL_USER'}) {

acl/cert_issue.cgi

@@ -5,7 +5,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access, $module_config_directory, $base_remote_user);
 &ReadParse();
 

acl/cert_output.cgi

@@ -5,7 +5,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access);
 
 &ReadParse();

acl/cgi_args.pl

@@ -27,5 +27,5 @@ elsif ($cgi eq 'edit_acl.cgi') {
 		}
 	return 'none';
 	}
-return undef;
+return;
 }

acl/convert.cgi

@@ -6,7 +6,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access, $config_directory);
 &ReadParse();
 &error_setup($text{'convert_err'});

acl/convert_form.cgi

@@ -6,7 +6,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access);
 $access{'sync'} && $access{'create'} || &error($text{'convert_ecannot'});
 &ui_print_header(undef, $text{'convert_title'}, "");

acl/defaultacl

@@ -19,7 +19,6 @@ sessions=1
 cats=1
 ips=1
 switch=1
-rbacenable=1
 logouttime=1
 times=1
 minsize=1

acl/delete_group.cgi

@@ -6,7 +6,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access, $base_remote_user);
 &ReadParse();
 &error_setup($text{'gdelete_err'});

acl/delete_groups.cgi

@@ -5,7 +5,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access, $base_remote_user);
 &ReadParse();
 &error_setup($text{'gdeletes_err'});

acl/delete_session.cgi

@@ -6,7 +6,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access, %sessiondb);
 &ReadParse();
 $access{'sessions'} || &error($text{'sessions_ecannot'});

acl/delete_user.cgi

@@ -6,7 +6,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access, $base_remote_user);
 &ReadParse();
 &error_setup($text{'delete_err'});

acl/delete_users.cgi

@@ -5,7 +5,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access, $base_remote_user);
 &ReadParse();
 &error_setup($in{'joingroup'} ? $text{'udeletes_jerr'} : $text{'udeletes_err'});

acl/edit_acl.cgi

@@ -6,7 +6,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access, $base_remote_user, %gconfig);
 &ReadParse();
 $access{'acl'} || &error($text{'acl_emod'});
@@ -48,15 +48,6 @@ else {
 	}
 print &ui_table_start(&text('acl_options', $minfo{'desc'}), "width=100%", 4);
 
-if ($in{'mod'} && $in{'user'} && &supports_rbac($in{'mod'}) &&
-    !$gconfig{'rbacdeny_'.$who}) {
-	# Show RBAC option
-	print &ui_table_row($text{'acl_rbac'},
-		&ui_radio("rbac", $maccess{'rbac'} ? 1 : 0,
-			[ [ 1, $text{'acl_rbacyes'} ],
-			  [ 0, $text{'no'} ] ]), 3);
-	}
-
 # Load custom ACL library
 my $mdir = &module_root_directory($in{'mod'});
 if (-r "$mdir/acl_security.pl") {

acl/edit_group.cgi

@@ -6,7 +6,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access, $config_directory);
 &ReadParse();
 $access{'groups'} || &error($text{'gedit_ecannot'});

acl/edit_pass.cgi

@@ -5,7 +5,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access);
 $access{'pass'} || &error($text{'pass_ecannot'});
 &ui_print_header(undef, $text{'pass_title'}, "");

acl/edit_rbac.cgi

@@ -1,32 +0,0 @@
-#!/usr/local/bin/perl
-# Show RBAC status
-
-use strict;
-use warnings;
-no warnings 'redefine';
-no warnings 'uninitialized';
-require './acl-lib.pl';
-our (%in, %text, %gconfig, %access, $module_name, $module_root_directory);
-$access{'rbacenable'} || &error($text{'rbac_ecannot'});
-&ui_print_header(undef, $text{'rbac_title'}, "");
-
-print "$text{'rbac_desc'}<p>\n";
-if ($gconfig{'os_type'} ne 'solaris') {
-	print &text('rbac_esolaris', $gconfig{'real_os_type'}),"<p>\n";
-	}
-elsif (!&supports_rbac()) {
-	if (&foreign_available("cpan")) {
-		print &text('rbac_eperl', "<tt>Authen::SolarisRBAC</tt>",
-			    "../cpan/download.cgi?source=0&local=$module_root_directory/Authen-SolarisRBAC-0.1.tar.gz&mode=2&return=/$module_name/&returndesc=".&urlize($text{'index_return'})),"<p>\n";
-		}
-	else {
-		print &text('rbac_ecpan', "<tt>Authen::SolarisRBAC</tt>"),
-		      "<p>\n";
-		}
-	}
-else {
-	print "$text{'rbac_ok'}<p>\n";
-	}
-
-&ui_print_footer("", $text{'index_return'});
-

acl/edit_sql.cgi

@@ -5,7 +5,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access);
 $access{'sql'} || &error($text{'sql_ecannot'});
 &ui_print_header(undef, $text{'sql_title'}, "");

acl/edit_sync.cgi

@@ -6,7 +6,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access);
 $access{'sync'} && $access{'create'} && $access{'delete'} ||
 	&error($text{'sync_ecannot'});

acl/edit_unix.cgi

@@ -7,7 +7,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access);
 $access{'unix'} && $access{'create'} && $access{'delete'} ||
 	&error($text{'unix_ecannot'});

acl/edit_user.cgi

@@ -6,7 +6,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %gconfig, %access, $config_directory, $base_remote_user, $remote_user);
 &foreign_require("webmin", "webmin-lib.pl");
 
@@ -42,6 +42,11 @@ else {
 				      : $text{'edit_title2'}, "");
 	}
 my $me = &get_user($base_remote_user);
+my %uaccess = &get_module_acl($in{'user'} || "", "", 1);
+if (!$in{'user'} && $uaccess{'rpc'} == 2) {
+	# Don't offer the confusing 'root' or 'admin' RPC option by default
+	$uaccess{'rpc'} = 0;
+	}
 
 # Give up if readonly
 if ($user{'readonly'} && !$in{'readwrite'}) {
@@ -210,7 +215,10 @@ if ($access{'lang'}) {
 
 if ($access{'locale'}) {
 	# Current locale
-	eval "use DateTime; use DateTime::Locale; use DateTime::TimeZone;";
+	eval { require DateTime; DateTime->import;
+	       require DateTime::Locale; DateTime::Locale->import;
+	       require DateTime::TimeZone; DateTime::TimeZone->import;
+	       1 };
 	if (!$@ && $] > 5.011) {
 		my $locales = &list_locales();
 		my %localesrev = reverse %{$locales};
@@ -280,7 +288,7 @@ if ($showui) {
 # Start of security options section
 my $showsecurity = $access{'logouttime'} || $access{'ips'} ||
 		   $access{'minsize'} ||
-		   &supports_rbac() && $access{'mode'} == 0 || $access{'times'};
+		   $access{'times'};
 if ($showsecurity) {
 	print &ui_hidden_table_start($text{'edit_security'}, "width=100%", 2,
 				     "security", 0, [ "width=30%" ]);
@@ -321,14 +329,6 @@ if ($access{'ips'}) {
 		    4, 30));
 	}
 
-if (&supports_rbac() && $access{'mode'} == 0) {
-	# Deny access to modules not managed by RBAC?
-	print &ui_table_row($text{'edit_rbacdeny'},
-		&ui_radio("rbacdeny", $user{'rbacdeny'} ? 1 : 0,
-			  [ [ 0, $text{'edit_rbacdeny0'} ],
-			    [ 1, $text{'edit_rbacdeny1'} ] ]));
-	}
-
 if ($access{'times'}) {
 	# Show allowed days of the week
 	my %days = map { $_, 1 } split(/,/, $user{'days'} || '');
@@ -371,6 +371,16 @@ elsif ($miniserv{'twofactor_provider'}) {
 		&ui_submit($text{'edit_twofactoradd'}, "twofactor"));
 	}
 
+# Can accept RPC calls?
+if ($access{'acl'} && !$safe) {
+	print &ui_table_row(&hlink($text{'acl_rpc'}, 'rpc'),
+		&ui_radio("rpc", int($uaccess{'rpc'}),
+			  [ [ 1, $text{'acl_rpc1'} ],
+			    $uaccess{'rpc'} == 2 ? ( [ 2, $text{'acl_rpc2'} ] ) : ( ),
+			    [ 3, $text{'acl_rpc3'} ],
+			    [ 0, $text{'acl_rpc0'} ] ]));
+	}
+
 print &ui_hidden_table_end("security");
 
 # Work out which modules can be selected
@@ -450,11 +460,9 @@ print &ui_hidden_table_end("mods");
 
 # Add global ACL section, but only if not set from the group
 my $groupglobal = $memg && -r "$config_directory/$memg->{'name'}.acl";
-if ($access{'acl'} && !$groupglobal && $in{'user'} && !$safe) {
+if ($access{'acl'} && !$groupglobal && !$safe) {
 	print &ui_hidden_table_start($text{'edit_global'}, "width=100%", 2,
 				     "global", 0, [ "width=30%" ]);
-	my %uaccess;
-	%uaccess = &get_module_acl($in{'user'}, "", 1);
 	print &ui_hidden("acl_security_form", 1);
 	&foreign_require("", "acl_security.pl");
 	&foreign_call("", "acl_security_form", \%uaccess);

acl/forgot_form.cgi

@@ -5,7 +5,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text);
 &foreign_require("webmin");
 &error_setup($text{'forgot_err'});

acl/forgot_send.cgi

@@ -5,7 +5,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %gconfig);
 &foreign_require("webmin");
 &error_setup($text{'forgot_err'});

acl/help/rpc.html

@@ -0,0 +1,14 @@
+<header>Can accept RPC calls?</header>
+
+This option determines if the user can make use of Webmin's poweful RPC calls
+feature, which is designed to allow this system to be controlled by a script
+or other Webmin server via HTTP. Because the RPC feature does <b>not</b>
+respect any module grants or fine-grained access controls, this option should
+only be enabled for fully trusted <tt>root</tt>-equivalent users. <p>
+
+In addition, if the <b>RPC calls only</b> option is selected, the user will not
+be able to use the Webmin UI. This is useful for creating a separate login with
+a longer password for RPC purposes only, as two-factor authentication cannot be
+used when making RPC calls. <p>
+
+<footer>

acl/index.cgi

@@ -6,7 +6,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %gconfig, %access, $base_remote_user);
 &ReadParse();
 &ui_print_header(undef, $text{'index_title'}, "", undef, 1, 1);
@@ -206,11 +206,6 @@ if (uc($ENV{'HTTPS'}) eq "ON" && $miniserv{'ca'}) {
 push(@icons, "images/twofactor.gif");
 push(@links, "twofactor_form.cgi");
 push(@titles, $text{'index_twofactor'});
-if ($access{'rbacenable'} && $gconfig{'os_type'} eq 'solaris') {
-	push(@icons, "images/rbac.gif");
-	push(@links, "edit_rbac.cgi");
-	push(@titles, $text{'index_rbac'});
-	}
 if ($access{'pass'}) {
 	push(@icons, "images/pass.gif");
 	push(@links, "edit_pass.cgi");

acl/lang/en

@@ -23,7 +23,6 @@ index_modgroups=Modules from group $1
 index_sync=Configure Unix User Synchronization
 index_unix=Configure Unix User Authentication
 index_sessions=View Login Sessions
-index_rbac=Setup RBAC
 index_delete=Delete Selected
 index_joingroup=Add To Group:
 index_eulist=Failed to list users : $1
@@ -95,9 +94,6 @@ edit_switch=Switch to User
 edit_forgot=Send Password Reset Link
 edit_return=Webmin user
 edit_return2=Webmin group
-edit_rbacdeny=RBAC access mode
-edit_rbacdeny0=RBAC only controls selected module ACLs
-edit_rbacdeny1=RBAC controls all modules and ACLs
 edit_global=Permissions for all modules
 edit_templock=Temporarily locked
 edit_temppass=Force change at next login
@@ -185,8 +181,6 @@ acl_title3=For group $1 in $2
 acl_options=$1 access control options
 acl_config=Can edit module configuration?
 acl_reset=Reset To Full Access
-acl_rbac=Get access control settings from RBAC?
-acl_rbacyes=Yes (overrides settings below)
 
 acl_uall=All users
 acl_uthis=This user
@@ -382,13 +376,6 @@ hide_clone=(Clone $1)
 switch_euser=You are not allowed to switch to this user
 switch_eold=Existing session not found!
 
-rbac_title=Setup RBAC
-rbac_desc=Webmin's RBAC integration provides a way for user module and ACL permissions to be determined from an RBAC (Role Based Access Control) database, rather than Webmin's own configuration files. Once RBAC support is enabled, any user for whom the <b>RBAC controls all modules and ACLs</b> option is selected will have his capabilities determined by RBAC rather than Webmin's own access control settings.
-rbac_esolaris=RBAC is only supported on Solaris at the moment, and so cannot be used on this $1 system.
-rbac_eperl=The Perl module $1 needed for RBAC integration is not installed. <a href='$2'>Click here</a> to have it installed now.
-rbac_ecpan=You do not have access to Webmin's Perl Modules page in order to install the necessary $1 module for RBAC integration.
-rbac_ok=RBAC integration is available on this system, and can be enabled on a per-user basis on the Edit Webmin User page.
-
 udeletes_err=Failed to delete users
 udeletes_jerr=Failed to add users to group
 udeletes_enone=None selected

acl/list_sessions.cgi

@@ -6,7 +6,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access, %sessiondb);
 $access{'sessions'} || &error($text{'sessions_ecannot'});
 &ui_print_header(undef, $text{'sessions_title'}, "");

acl/log_parser.pl

@@ -16,8 +16,9 @@ my ($user, $script, $action, $type, $object, $p) = @_;
 my $g = $type eq 'group' ? "_g" : "";
 if ($action eq 'modify') {
 	if ($p->{'old'} ne $p->{'name'}) {
-		return &text('log_rename'.$g, "<tt>$p->{'old'}</tt>",
-					      "<tt>$p->{'name'}</tt>");
+		return &text('log_rename'.$g,
+			     "<tt>".&html_escape($p->{'old'})."</tt>",
+			     "<tt>".&html_escape($p->{'name'})."</tt>");
 		}
 	else {
 		return &text('log_modify'.$g,
@@ -26,7 +27,8 @@ if ($action eq 'modify') {
 	}
 elsif ($action eq 'create') {
 	if ($p->{'clone'}) {
-		return &text('log_clone'.$g, "<tt>$p->{'clone'}</tt>",
+		return &text('log_clone'.$g,
+			     "<tt>".&html_escape($p->{'clone'})."</tt>",
 			     "<tt>".&html_escape($object)."</tt>");
 		}
 	else {
@@ -36,21 +38,23 @@ elsif ($action eq 'create') {
 	}
 elsif ($action eq 'delete') {
 	if ($type eq "users" || $type eq "groups") {
-		return &text('log_delete_'.$type, $object);
+		return &text('log_delete_'.$type, &html_escape($object));
 		}
 	else {
-		return &text('log_delete'.$g, "<tt>$object</tt>");
+		return &text('log_delete'.$g,
+			     "<tt>".&html_escape($object)."</tt>");
 		}
 	}
 elsif ($action eq 'joingroup') {
-	return &text('log_joingroup', $object, $p->{'group'});
+	return &text('log_joingroup', &html_escape($object),
+		     &html_escape($p->{'group'}));
 	}
 elsif ($action eq 'acl') {
-	return &text('log_acl', "<tt>$object</tt>",
+	return &text('log_acl', "<tt>".&html_escape($object)."</tt>",
 		     "<i>".&html_escape($p->{'moddesc'})."</i>");
 	}
 elsif ($action eq 'reset') {
-	return &text('log_reset', "<tt>$object</tt>",
+	return &text('log_reset', "<tt>".&html_escape($object)."</tt>",
 		     "<i>".&html_escape($p->{'moddesc'})."</i>");
 	}
 elsif ($action eq 'cert') {
@@ -60,7 +64,9 @@ elsif ($action eq 'switch') {
 	return &text('log_switch', "<tt>".&html_escape($object)."</tt>");
 	}
 elsif ($action eq 'twofactor') {
-	return &text('log_twofactor', $object, $p->{'provider'}, $p->{'id'});
+	return &text('log_twofactor', &html_escape($object),
+		     &html_escape($p->{'provider'}),
+		     &html_escape($p->{'id'}));
 	}
 elsif ($action eq 'forgot') {
 	return &text('log_forgot_'.$type, &html_escape($p->{'user'}),

acl/makedn.cgi

@@ -5,7 +5,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access);
 $access{'pass'} || &error($text{'sql_ecannot'});
 &ReadParse();

acl/maketables.cgi

@@ -5,7 +5,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access);
 $access{'pass'} || &error($text{'sql_ecannot'});
 &ReadParse();

acl/postinstall.pl

@@ -3,7 +3,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require 'acl-lib.pl';
+require 'acl-lib.pl';    ## no critic
 our ($config_directory);
 
 # Rename the .acl files for any groups to .gacl files

acl/save_acl.cgi

@@ -6,7 +6,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access, $base_remote_user, %gconfig,
      $config_directory);
 &ReadParse();
@@ -54,13 +54,8 @@ else {
 	if (defined($in{'noconfig'})) {
 		$maccess{'noconfig'} = $in{'noconfig'};
 		}
-	if ($in{'rbac'}) {
-		# RBAC overrides everything
-		$maccess{'rbac'} = 1;
-		}
-	elsif (-r "../$in{'_acl_mod'}/acl_security.pl") {
+	if (-r "../$in{'_acl_mod'}/acl_security.pl") {
 		# Use user inputs
-		$maccess{'rbac'} = 0 if (defined($in{'rbac'}));
 		&foreign_require($in{'_acl_mod'}, "acl_security.pl");
 		&foreign_call($in{'_acl_mod'}, "acl_security_save",
 			      \%maccess, \%in);

acl/save_group.cgi

@@ -6,7 +6,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access, $config_directory);
 &ReadParse();
 

acl/save_pass.cgi

@@ -5,7 +5,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access);
 $access{'pass'} || &error($text{'pass_ecannot'});
 &error_setup($text{'pass_err'});

acl/save_sql.cgi

@@ -5,7 +5,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access);
 $access{'pass'} || &error($text{'sql_ecannot'});
 &ReadParse();

acl/save_sync.cgi

@@ -6,7 +6,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access, $module_config_directory);
 &ReadParse();
 $access{'sync'} && $access{'create'} && $access{'delete'} ||

acl/save_twofactor.cgi

@@ -5,7 +5,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access, $base_remote_user);
 &foreign_require("webmin");
 &error_setup($text{'twofactor_err'});

acl/save_unix.cgi

@@ -6,7 +6,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access);
 &ReadParse();
 &error_setup($text{'unix_err'});
@@ -70,7 +70,7 @@ else {
 	}
 if ($in{'sudo'}) {
 	&has_command("sudo") || &error(&text('unix_esudo', "<tt>sudo</tt>"));
-	eval "use IO::Pty";
+	eval { require IO::Pty; IO::Pty->import; 1 };
 	$@ && &error(&text('unix_esudomod', "<tt>IO::Pty</tt>"));
 	}
 $miniserv{'sudo'} = $in{'sudo'};

acl/save_user.cgi

@@ -6,7 +6,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access, $config_directory, $base_remote_user);
 &foreign_require("webmin", "webmin-lib.pl");
 &ReadParse();
@@ -105,11 +105,6 @@ foreach my $u (@ulist) {
 # Find the current group
 my $oldgroup = $in{'old'} ? &get_users_group($in{'old'}) : undef;
 
-if (&supports_rbac()) {
-	# Save RBAC mode
-	$user{'rbacdeny'} = $in{'rbacdeny'};
-	}
-
 my $newgroup;
 if (defined($in{'group'})) {
 	# Check if group is allowed
@@ -374,11 +369,13 @@ else {
 	}
 
 my $aclfile = "$config_directory/$in{'name'}.acl";
-if ($in{'old'} && $in{'acl_security_form'} && !$newgroup && !$in{'safe'}) {
-	# Update user's global ACL
+if ($in{'acl_security_form'} && !$newgroup && !$in{'safe'}) {
+	# Update user's global ACL, and merge in RPC setting which has
+	# been moved out of this form
 	&foreign_require("", "acl_security.pl");
 	my %uaccess;
 	&foreign_call("", "acl_security_save", \%uaccess, \%in);
+	$uaccess{'rpc'} = $in{'rpc'};
 	&lock_file($aclfile);
 	&save_module_acl(\%uaccess, $in{'name'}, "", 1);
 	&set_ownership_permissions(undef, undef, 0640, $aclfile);

acl/schema.cgi

@@ -5,7 +5,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access);
 $access{'pass'} || &error($text{'sql_ecannot'});
 

acl/switch.cgi

@@ -5,7 +5,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access, %sessiondb);
 &ReadParse();
 &can_edit_user($in{'user'}) && $access{'switch'} ||

acl/t/perlcritic.t

@@ -0,0 +1,65 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Test::More;
+
+BEGIN {
+    eval { require Perl::Critic; 1 }
+        or plan skip_all => 'Perl::Critic not installed';
+}
+
+use File::Find;
+
+sub script_dir
+{
+    my $path = $0;
+    if ($path =~ m{^/}) {
+        $path =~ s{/[^/]+$}{};
+        return $path;
+    }
+    my $cwd = `pwd`;
+    chomp($cwd);
+    if ($path =~ m{/}) {
+        $path =~ s{/[^/]+$}{};
+        return $cwd.'/'.$path;
+    }
+    return $cwd;
+}
+
+my $bindir = script_dir();
+my $module_dir = "$bindir/..";
+chdir($module_dir) or die "chdir: $!";
+
+my @files;
+find(
+    sub {
+        return if -d;
+        # Skip symlinks: shared libs (e.g. md5-lib.pl -> ../useradmin/md5-lib.pl)
+        # belong to the module that owns the underlying file.
+        return if -l;
+        return unless /\.(pl|cgi)\z/;
+        # *.info.pl is the Polish-locale translation of *.info, not Perl code.
+        return if /\.info\.pl\z/;
+        push(@files, $File::Find::name);
+    },
+    '.'
+);
+
+@files = sort @files;
+if (!@files) {
+    plan skip_all => 'no perl files to check';
+}
+
+my $critic = Perl::Critic->new(
+    -profile => "$bindir/../../.perlcriticrc",
+);
+
+foreach my $file (@files) {
+    my @violations = $critic->critique($file);
+    is(scalar @violations, 0, "$file perlcritic");
+    if (@violations) {
+        diag join("", @violations);
+    }
+}
+
+done_testing();

acl/test_twofactor.cgi

@@ -5,7 +5,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %access, $base_remote_user);
 &foreign_require("webmin");
 &error_setup($text{'twofactor_terr'});

acl/twofactor.pl

@@ -1,6 +1,10 @@
 #!/usr/local/bin/perl
 # Validate the OTP for some user
 
+use strict;
+use warnings;
+no warnings 'once';
+our $module_name;
 $main::no_acl_check = 1;
 $main::no_referers_check = 1;
 $ENV{'WEBMIN_CONFIG'} = "/etc/webmin";
@@ -8,17 +12,19 @@ $ENV{'WEBMIN_VAR'} = "/var/webmin";
 if ($0 =~ /^(.*\/)[^\/]+$/) {
         chdir($1);
         }
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 $module_name eq 'acl' || die "Command must be run with full path";
 
 # Check command-line args
 @ARGV == 5 || die "Usage: $0 user provider id token api-key";
-($user, $provider, $id, $token, $apikey) = @ARGV;
+my ($user, $provider, $id, $token, $apikey) = @ARGV;
 
 # Call the provider validation function
 &foreign_require("webmin");
-$func = "webmin::validate_twofactor_".$provider;
-$err = &$func($id, $token, $apikey);
+my $method = "validate_twofactor_".$provider;
+my $code = webmin->can($method)
+	or die "Unknown twofactor provider: $provider\n";
+my $err = $code->($id, $token, $apikey);
 if ($err) {
 	$err =~ s/\r|\n/ /g;
 	print $err,"\n";

acl/twofactor_form.cgi

@@ -5,7 +5,7 @@ use strict;
 use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
-require './acl-lib.pl';
+require './acl-lib.pl';    ## no critic
 our (%in, %text, %config, %access, $base_remote_user);
 &foreign_require("webmin");
 &error_setup($text{'twofactor_err'});

acl_security.pl

@@ -16,7 +16,7 @@ print &ui_table_row($text{'acl_root'},
 # Other dirs to allow
 print &ui_table_row($text{'acl_otherdirs'},
 	&ui_textarea("otherdirs", join("\n", split(/\t+/, $o->{'otherdirs'})),
-		     5, 40), 3);
+		     3, 40), 3);
 
 # Can see dot files?
 print &ui_table_row($text{'acl_nodot'},
@@ -77,18 +77,6 @@ print &ui_table_row($text{'acl_gedit'},
 
 print &ui_table_hr();
 
-# Can submit feedback?
-print &ui_table_row($text{'acl_feedback'},
-	&ui_radio("feedback", int($o->{'feedback'}),
-	  	  [ map { [ $_, $text{'acl_feedback'.$_} ] } (2,3,1,0) ]));
-
-# Can accept RPC calls?
-print &ui_table_row($text{'acl_rpc'},
-	&ui_radio("rpc", int($o->{'rpc'}),
-		  [ [ 1, $text{'acl_rpc1'} ],
-		    $o->{'rpc'} == 2 ? ( [ 2, $text{'acl_rpc2'} ] ) : ( ),
-		    [ 0, $text{'acl_rpc0'} ] ]));
-
 # Get new permissions?
 print &ui_table_row($text{'acl_negative'},
 	&ui_radio("negative", int($o->{'negative'}),
@@ -110,27 +98,26 @@ print &ui_table_row($text{'acl_webminsearch'},
 # Parse the form for global security options
 sub acl_security_save
 {
-$_[0]->{'root'} = $in{'root_def'} ? undef : $in{'root'};
-$_[0]->{'otherdirs'} = join("\t", split(/\r?\n/, $in{'otherdirs'}));
-$_[0]->{'nodot'} = $in{'nodot'};
+my ($o) = @_;
+$o->{'root'} = $in{'root_def'} ? undef : $in{'root'};
+$o->{'otherdirs'} = join("\t", split(/\r?\n/, $in{'otherdirs'}));
+$o->{'nodot'} = $in{'nodot'};
 
-$_[0]->{'uedit_mode'} = $in{'uedit_mode'};
-$_[0]->{'uedit'} = $in{'uedit_mode'} == 2 ? $in{'uedit_can'} :
+$o->{'uedit_mode'} = $in{'uedit_mode'};
+$o->{'uedit'} = $in{'uedit_mode'} == 2 ? $in{'uedit_can'} :
 		   $in{'uedit_mode'} == 3 ? $in{'uedit_cannot'} :
 		   $in{'uedit_mode'} == 4 ? $in{'uedit_uid'} :
 		   $in{'uedit_mode'} == 5 ? getgrnam($in{'uedit_group'}) : "";
-$_[0]->{'uedit2'} = $in{'uedit_mode'} == 4 ? $in{'uedit_uid2'} : undef;
+$o->{'uedit2'} = $in{'uedit_mode'} == 4 ? $in{'uedit_uid2'} : undef;
 
-$_[0]->{'gedit_mode'} = $in{'gedit_mode'};
-$_[0]->{'gedit'} = $in{'gedit_mode'} == 2 ? $in{'gedit_can'} :
+$o->{'gedit_mode'} = $in{'gedit_mode'};
+$o->{'gedit'} = $in{'gedit_mode'} == 2 ? $in{'gedit_can'} :
 		   $in{'gedit_mode'} == 3 ? $in{'gedit_cannot'} :
 		   $in{'gedit_mode'} == 4 ? $in{'gedit_gid'} : "";
-$_[0]->{'gedit2'} = $in{'gedit_mode'} == 4 ? $in{'gedit_gid2'} : undef;
-$_[0]->{'feedback'} = $in{'feedback'};
-$_[0]->{'rpc'} = $in{'rpc'};
-$_[0]->{'negative'} = $in{'negative'};
-$_[0]->{'readonly'} = $in{'readonly'};
-$_[0]->{'fileunix'} = $in{'fileunix_def'} ? undef : $in{'fileunix'};
-$_[0]->{'webminsearch'} = $in{'webminsearch'};
+$o->{'gedit2'} = $in{'gedit_mode'} == 4 ? $in{'gedit_gid2'} : undef;
+$o->{'negative'} = $in{'negative'};
+$o->{'readonly'} = $in{'readonly'};
+$o->{'fileunix'} = $in{'fileunix_def'} ? undef : $in{'fileunix'};
+$o->{'webminsearch'} = $in{'webminsearch'};
 }
 

apache/apache-lib.pl

@@ -436,6 +436,13 @@ foreach $v (@virt) {
 return \@get_config_cache;
 }
 
+# flush_config_cache()
+# Delete all in-memory config caches
+sub flush_config_cache
+{
+undef(@get_config_cache);
+}
+
 # get_config_file(filename, [&seen-files])
 # Returns a list of config hash refs from some file
 sub get_config_file
@@ -788,6 +795,428 @@ unlink($file);
 &delete_webfile_link($file);
 }
 
+# can_manage_vhost_files()
+# Returns 1 if this system uses Debian-style available/enabled site dirs
+sub can_manage_vhost_files
+{
+return 0 if ($gconfig{'os_type'} ne 'debian-linux');
+my $avail = &vhost_available_dir();
+my $enabled = &vhost_enabled_dir();
+return $avail && -d $avail && $enabled && -d $enabled &&
+       &simplify_path(&resolve_links($avail)) ne
+       &simplify_path(&resolve_links($enabled));
+}
+
+# vhost_available_dir()
+# Returns the configured directory of available Apache virtual host files
+sub vhost_available_dir
+{
+return $config{'virt_file'} ? &server_root($config{'virt_file'}) : undef;
+}
+
+# vhost_enabled_dir()
+# Returns the configured directory of enabled Apache virtual host symlinks
+sub vhost_enabled_dir
+{
+return $config{'link_dir'} ? &server_root($config{'link_dir'}) : undef;
+}
+
+# get_vhost_available_files()
+# Returns real config files from the directory used for new virtual hosts
+sub get_vhost_available_files
+{
+my @rv;
+return @rv if (!&can_manage_vhost_files());
+my $avail = &vhost_available_dir();
+opendir(AVAIL, $avail) || return @rv;
+foreach my $f (sort { lc($a) cmp lc($b) } readdir(AVAIL)) {
+	next if ($f eq "." || $f eq "..");
+	my $file = $avail."/".$f;
+	my $rfile = &simplify_path(&resolve_links($file));
+	next if (!$rfile || !-f $rfile || !-r $rfile);
+	push(@rv, $rfile);
+	}
+closedir(AVAIL);
+return &unique(@rv);
+}
+
+# find_virtuals_in_file(file)
+# Returns VirtualHost blocks parsed from one config file
+sub find_virtuals_in_file
+{
+my ($file) = @_;
+my $rfile = &simplify_path(&resolve_links($file));
+$rfile ||= $file;
+return ( ) if (!-r $rfile);
+my @conf = &get_config_file($rfile);
+return grep { $_->{'file'} eq $rfile }
+       &find_directive_struct("VirtualHost", \@conf);
+}
+
+# is_default_vhost(&virt)
+# Returns 1 if a VirtualHost looks like a default/catch-all host
+sub is_default_vhost
+{
+my ($virt) = @_;
+return 1 if (!$virt);
+return 1 if ($virt->{'value'} =~ /_default_/i);
+return 1 if (!&find_directive("ServerName", $virt->{'members'}));
+return 0;
+}
+
+# can_manage_vhost_file(file)
+# Returns 1 if all virtual hosts in a file are manageable by this user
+sub can_manage_vhost_file
+{
+my ($file) = @_;
+my $rfile = &simplify_path(&resolve_links($file));
+$rfile ||= $file;
+return 0 if (!$rfile || !-f $rfile || !-r $rfile);
+my @virts = &find_virtuals_in_file($rfile);
+return 0 if (!@virts);
+foreach my $virt (@virts) {
+	return 0 if (&is_default_vhost($virt));
+	return 0 if (!&can_edit_virt($virt));
+	}
+return 1;
+}
+
+# can_manage_vhost_state_file(file)
+# Returns 1 if a virtual host file can have its enabled state managed here
+sub can_manage_vhost_state_file
+{
+my ($file) = @_;
+my $rfile = &simplify_path(&resolve_links($file));
+$rfile ||= $file;
+return 0 if (!$rfile || !-f $rfile);
+my %available = map { $_, 1 } &get_vhost_available_files();
+return 0 if (!$available{$rfile});
+return &can_manage_vhost_file($rfile);
+}
+
+# get_virtual_list_rows(&config)
+# Returns row hashes for the virtual-host list, preserving sites-available order
+sub get_virtual_list_rows
+{
+my ($conf) = @_;
+my @active = grep { &can_edit_virt($_) }
+	     &find_directive_struct("VirtualHost", $conf);
+if (&can_manage_vhost_files()) {
+	my @rows;
+	my %active_by_file;
+	foreach my $v (@active) {
+		my $file = &simplify_path(&resolve_links($v->{'file'}));
+		$file ||= $v->{'file'};
+		push(@{$active_by_file{$file}}, $v);
+		}
+	my %done_virt;
+	foreach my $file (&get_vhost_available_files()) {
+		my @filevirts = @{$active_by_file{$file} || [ ]};
+		my $active = @filevirts ? 1 : 0;
+		if (!@filevirts) {
+			@filevirts = grep { &can_edit_virt($_) &&
+					     !&is_default_vhost($_) }
+				     &find_virtuals_in_file($file);
+			}
+		foreach my $v (@filevirts) {
+			push(@rows, { 'virt' => $v,
+				      'active' => $active,
+				      'file' => $file });
+			$done_virt{$v}++;
+			}
+		}
+	foreach my $v (@active) {
+		next if ($done_virt{$v});
+		push(@rows, { 'virt' => $v,
+			      'active' => 1,
+			      'file' => $v->{'file'} });
+		}
+	return @rows;
+	}
+return map { { 'virt' => $_, 'active' => 1, 'file' => $_->{'file'} } }
+       @active;
+}
+
+# vhost_file_link(file)
+# Returns the enabled symlink path for a virtual host file
+sub vhost_file_link
+{
+my ($file) = @_;
+return undef if (!&can_manage_vhost_files());
+my $rfile = &simplify_path(&resolve_links($file));
+$rfile ||= $file;
+my $avail = &vhost_available_dir();
+my $short;
+if (opendir(AVAIL, $avail)) {
+	foreach my $f (sort { lc($a) cmp lc($b) } readdir(AVAIL)) {
+		next if ($f eq "." || $f eq "..");
+		my $afile = $avail."/".$f;
+		my $rafile = &simplify_path(&resolve_links($afile));
+		if ($rafile && $rafile eq $rfile) {
+			$short = $f;
+			last;
+			}
+		}
+	closedir(AVAIL);
+	}
+$short ||= $rfile;
+$short =~ s/^.*\///;
+return &vhost_enabled_dir()."/".$short;
+}
+
+# vhost_file_links(file)
+# Returns enabled symlinks for a virtual host file
+sub vhost_file_links
+{
+my ($file) = @_;
+my @rv;
+return @rv if (!&can_manage_vhost_files());
+my $rfile = &simplify_path(&resolve_links($file));
+$rfile ||= $file;
+my $enabled = &vhost_enabled_dir();
+opendir(LINKDIR, $enabled) || return @rv;
+foreach my $f (readdir(LINKDIR)) {
+	next if ($f eq "." || $f eq "..");
+	my $link = $enabled."/".$f;
+	next if (!-l $link);
+	my $rlink = &simplify_path(&resolve_links($link));
+	if ($rlink && $rlink eq $rfile) {
+		push(@rv, $link);
+		}
+	}
+closedir(LINKDIR);
+return @rv;
+}
+
+# vhost_file_enabled(file)
+# Returns 1 if a virtual host file has an enabled symlink
+sub vhost_file_enabled
+{
+my ($file) = @_;
+return scalar(&vhost_file_links($file)) ? 1 : 0;
+}
+
+# enable_vhost_file(file)
+# Enables a virtual host file and rolls back if apache configtest fails
+sub enable_vhost_file
+{
+my ($file) = @_;
+my $rfile = &simplify_path(&resolve_links($file));
+$rfile ||= $file;
+return $text{'enable_efile'} if (!&can_manage_vhost_state_file($rfile));
+my $verr = &virtualmin_vhost_file_state_error($rfile, "enable");
+return $verr if ($verr);
+my $link = &vhost_file_link($rfile);
+$link || return $text{'enable_elinkdir'};
+return undef if (&vhost_file_enabled($rfile));
+if (-e $link || -l $link) {
+	return &text('enable_elinkexists', "<tt>".&html_escape($link)."</tt>");
+	}
+&symlink_logged($rfile, $link) ||
+	return &text('enable_elink', "<tt>".&html_escape($link)."</tt>",
+		     "<tt>".&html_escape($!)."</tt>");
+my $err = &test_config();
+if ($err) {
+	&unlink_logged($link);
+	return &text('enable_etest', "<tt>".&html_escape($err)."</tt>");
+	}
+&flush_config_cache();
+&update_last_config_change();
+return undef;
+}
+
+# disable_vhost_file(file)
+# Disables a virtual host file and rolls back if apache configtest fails
+sub disable_vhost_file
+{
+my ($file) = @_;
+my $rfile = &simplify_path(&resolve_links($file));
+$rfile ||= $file;
+return $text{'enable_efile'} if (!&can_manage_vhost_state_file($rfile));
+my $verr = &virtualmin_vhost_file_state_error($rfile, "disable");
+return $verr if ($verr);
+my @links = &vhost_file_links($file);
+return undef if (!@links);
+my @restore = map { [ $_, readlink($_) ] } @links;
+my @removed;
+foreach my $link (@links) {
+	if (!&unlink_logged($link)) {
+		foreach my $r (@removed) {
+			&symlink_logged($r->[1], $r->[0])
+				if (defined($r->[1]) && !-e $r->[0] && !-l $r->[0]);
+			}
+		return &text('enable_eunlink',
+			     "<tt>".&html_escape($link)."</tt>",
+			     "<tt>".&html_escape($!)."</tt>");
+		}
+	my ($restore) = grep { $_->[0] eq $link } @restore;
+	push(@removed, $restore) if ($restore);
+	}
+my $err = &test_config();
+if ($err) {
+	foreach my $r (@restore) {
+		&symlink_logged($r->[1], $r->[0])
+			if (defined($r->[1]) && !-e $r->[0] && !-l $r->[0]);
+		}
+	return &text('enable_etest', "<tt>".&html_escape($err)."</tt>");
+	}
+&flush_config_cache();
+&update_last_config_change();
+return undef;
+}
+
+# virtualmin_available()
+# Returns 1 if Virtualmin is installed and supported on this system
+sub virtualmin_available
+{
+return $main::apache_virtualmin_available
+	if (defined($main::apache_virtualmin_available));
+$main::apache_virtualmin_available = &foreign_check("virtual-server");
+return $main::apache_virtualmin_available;
+}
+
+# virtualmin_domain_by_name(name)
+# Returns a Virtualmin domain object by domain name, if one exists
+sub virtualmin_domain_by_name
+{
+my ($name) = @_;
+return undef if (!&virtualmin_available());
+return $main::apache_virtualmin_domain_by_name_cache{$name}
+	if (exists($main::apache_virtualmin_domain_by_name_cache{$name}));
+&foreign_require("virtual-server");
+my $d = &virtual_server::get_domain_by("dom", $name);
+$main::apache_virtualmin_domain_by_name_cache{$name} = $d;
+return $d;
+}
+
+# virtual_names(&virt)
+# Returns all hostnames from ServerName and ServerAlias directives
+sub virtual_names
+{
+my ($virt) = @_;
+my @rv;
+my $sn = &find_directive("ServerName", $virt->{'members'});
+push(@rv, $sn) if ($sn);
+foreach my $sa (&find_directive_struct("ServerAlias", $virt->{'members'})) {
+	push(@rv, @{$sa->{'words'} || [ ]});
+	if (!@{$sa->{'words'} || [ ]} && $sa->{'value'}) {
+		push(@rv, $sa->{'value'});
+		}
+	}
+return grep { $_ && $_ ne "*" } &unique(@rv);
+}
+
+# virtualmin_domain_for_vhost_file(file)
+# Returns the Virtualmin domain object for a virtual host file, if any
+sub virtualmin_domain_for_vhost_file
+{
+my ($file) = @_;
+return undef if (!&virtualmin_available());
+my $rfile = &simplify_path(&resolve_links($file));
+$rfile ||= $file;
+return $main::apache_virtualmin_domain_for_file_cache{$rfile}
+	if (exists($main::apache_virtualmin_domain_for_file_cache{$rfile}));
+foreach my $virt (&find_virtuals_in_file($file)) {
+	next if (!&can_edit_virt($virt));
+	foreach my $name (&virtual_names($virt)) {
+		my $d = &virtualmin_domain_by_name($name);
+		if (!$d && $name =~ /^www\.(\S+)/i) {
+			$d = &virtualmin_domain_by_name($1);
+			}
+		if ($d) {
+			$main::apache_virtualmin_domain_for_file_cache{$rfile} = $d;
+			return $d;
+			}
+		}
+	}
+$main::apache_virtualmin_domain_for_file_cache{$rfile} = undef;
+return undef;
+}
+
+# vhost_file_state(file)
+# Returns the effective enabled state for a virtual host file
+sub vhost_file_state
+{
+my ($file) = @_;
+my $d = &virtualmin_domain_for_vhost_file($file);
+if ($d) {
+	return { 'enabled' => $d->{'disabled'} ? 0 : 1,
+		 'source' => 'virtualmin',
+		 'domain' => $d };
+	}
+return { 'enabled' => &vhost_file_enabled($file) ? 1 : 0,
+	 'source' => 'apache' };
+}
+
+# vhost_file_toggle_action(file)
+# Returns the action needed to toggle a virtual host file's effective state
+sub vhost_file_toggle_action
+{
+my ($file) = @_;
+return &vhost_file_state($file)->{'enabled'} ? "disable" : "enable";
+}
+
+# virtualmin_domain_state_link(&domain, enabled?)
+# Returns a link to the Virtualmin state change form for some domain
+sub virtualmin_domain_state_link
+{
+my ($d, $enabled) = @_;
+my $page = $enabled ? "disable_domain.cgi" : "enable_domain.cgi";
+my $label = $enabled ? $text{'enable_virtualmin_disable_label'} :
+		       $text{'enable_virtualmin_enable_label'};
+my $url = "../virtual-server/".$page."?dom=".&urlize($d->{'id'});
+return &ui_link(&quote_escape($url), "\"".$label."\"");
+}
+
+# virtualmin_vhost_file_state_error(file, action)
+# Returns an error if a Virtualmin-owned site is being enabled or disabled here
+sub virtualmin_vhost_file_state_error
+{
+my ($file, $action) = @_;
+return undef if ($action ne "enable" && $action ne "disable");
+my $state_info = &vhost_file_state($file);
+return undef if ($state_info->{'source'} ne "virtualmin");
+my $d = $state_info->{'domain'};
+return undef if (!$d);
+my $state = lc($state_info->{'enabled'} ? $text{'index_enabled'} :
+					  $text{'index_disabled'});
+my $dom = "<tt>".&html_escape($d->{'dom'})."</tt>";
+my $link = &virtualmin_domain_state_link($d, $state_info->{'enabled'});
+return $state_info->{'enabled'} ?
+	&text('enable_evirtualmin_disable', $dom, $state, $link) :
+	&text('enable_evirtualmin_enable', $dom, $state, $link);
+}
+
+# delete_virtuals_from_file(file, &virtualhosts...)
+# Deletes VirtualHost blocks from one file and removes the file if empty
+sub delete_virtuals_from_file
+{
+my ($file, @virts) = @_;
+return 0 if (!@virts);
+my $lref = &read_file_lines($file);
+foreach my $virt (sort { $b->{'line'} <=> $a->{'line'} } @virts) {
+	my $len = $virt->{'eline'} - $virt->{'line'} + 1;
+	splice(@$lref, $virt->{'line'}, $len);
+	}
+my $empty = 1;
+foreach my $line (@$lref) {
+	if ($line =~ /\S/) {
+		$empty = 0;
+		last;
+		}
+	}
+&flush_file_lines($file);
+if ($empty) {
+	foreach my $link (&vhost_file_links($file)) {
+		&unlink_logged($link);
+		}
+	&unlink_logged($file);
+	}
+&flush_config_cache();
+&update_last_config_change();
+return scalar(@virts);
+}
+
 # renumber(&config, line, file, offset)
 # Recursively changes the line number of all directives from some file 
 # beyond the given line.
@@ -1544,9 +1973,10 @@ return undef;
 # if necessary.
 sub before_changing
 {
+my @extra = grep { $_ } @_;
 if ($config{'test_always'} || $access{'test_always'}) {
 	local $conf = &get_config();
-	local @files = &unique(map { $_->{'file'} } @$conf);
+	local @files = &unique((map { $_->{'file'} } @$conf), @extra);
 	local $/ = undef;
 	local $f;
 	foreach $f (@files) {
@@ -1969,10 +2399,11 @@ return @rv;
 sub create_webfile_link
 {
 local ($file) = @_;
-if ($config{'link_dir'}) {
+my $linkdir = &vhost_enabled_dir();
+if ($linkdir) {
 	local $short = $file;
 	$short =~ s/^.*\///;
-	local $linksrc = "$config{'link_dir'}/$short";
+	local $linksrc = "$linkdir/$short";
 	&lock_file($linksrc);
 	symlink($file, $linksrc);
 	&unlock_file($linksrc);
@@ -1985,16 +2416,16 @@ if ($config{'link_dir'}) {
 sub delete_webfile_link
 {
 local ($file) = @_;
-if ($config{'link_dir'}) {
-	local $short = $file;
-	$short =~ s/^.*\///;
-	opendir(LINKDIR, $config{'link_dir'});
+$file = &simplify_path(&resolve_links($file));
+my $linkdir = &vhost_enabled_dir();
+if ($linkdir && opendir(LINKDIR, $linkdir)) {
 	foreach my $f (readdir(LINKDIR)) {
-		if ($f ne "." && $f ne ".." &&
-		    (&simplify_path(
-		       &resolve_links($config{'link_dir'}."/".$f)) eq $file ||
-		     $short eq $f)) {
-			&unlink_logged($config{'link_dir'}."/".$f);
+		if ($f ne "." && $f ne "..") {
+			my $link = $linkdir."/".$f;
+			next if (!-l $link);
+			if (&simplify_path(&resolve_links($link)) eq $file) {
+				&unlink_logged($link);
+				}
 			}
 		}
 	closedir(LINKDIR);

apache/delete_vservs.cgi

@@ -3,31 +3,107 @@
 
 require './apache-lib.pl';
 &ReadParse();
-&error_setup($text{'delete_err'});
+@d = split(/\0/, $in{'d'});
+$file_action = $in{'toggle'} ? "toggle" : undef;
+&error_setup($file_action ? $text{'enable_err'} : $text{'delete_err'});
 $access{'vaddr'} || &error($text{'delete_ecannot'});
 $conf = &get_config();
-@d = split(/\0/, $in{'d'});
+$can_vhost_files = &can_manage_vhost_files();
 @d || &error($text{'delete_enone'});
 
+if ($file_action) {
+	&can_manage_vhost_files() || &error($text{'enable_elinkdir'});
+	foreach $d (@d) {
+		if ($d =~ /^file\t([^\t]+)/) {
+			$file = $1;
+			}
+		elsif ($d !~ /^file\t/) {
+			($vmembers, $vconf) = &get_virtual_config($d);
+			next if (!$vconf || !&can_edit_virt($vconf));
+			$file = $vconf->{'file'};
+			}
+		else {
+			next;
+			}
+		$rfile = $file ? &simplify_path(&resolve_links($file)) : undef;
+		$files{$rfile}++ if ($rfile && -f $rfile &&
+				      &can_manage_vhost_state_file($rfile));
+		}
+	@files = keys %files;
+	@files || &error($text{'enable_enone'});
+	foreach $file (@files) {
+		$action = &vhost_file_toggle_action($file);
+		$err = &virtualmin_vhost_file_state_error($file, $action);
+		$err && &error($err);
+		$file_actions{$file} = $action;
+		}
+	foreach $file (@files) {
+		$err = $file_actions{$file} eq "enable" ?
+			&enable_vhost_file($file) :
+			&disable_vhost_file($file);
+		$err && &error($err);
+		}
+	&webmin_log($file_action, "vhostfile", scalar(@files));
+	&redirect("");
+	exit;
+	}
+if (!$in{'delete'}) {
+	&error($text{'delete_eaction'});
+	}
+
 # Get them all
 foreach $d (@d) {
+	if ($d =~ /^file\t([^\t]+)\t(\d+)$/) {
+		push(@{$file_lines{$1}}, $2);
+		next;
+		}
+	elsif ($d =~ /^file\t/) {
+		next;
+		}
 	($vmembers, $vconf) = &get_virtual_config($d);
+	$vconf || &error($text{'delete_egone'});
 	&can_edit_virt($vconf) || &error(&text('delete_ecannot2',
 					       &virtual_name($vconf)));
+	$can_vhost_files && &is_default_vhost($vconf) &&
+		&error($text{'delete_edefault'});
 	push(@virts, $vconf);
 	}
+if (%file_lines) {
+	foreach $file (keys %file_lines) {
+		$rfile = &simplify_path(&resolve_links($file));
+		next if (!$rfile || !-f $rfile ||
+			 !&can_manage_vhost_state_file($rfile));
+		@fvirts = &find_virtuals_in_file($rfile);
+		foreach $line (@{$file_lines{$file}}) {
+			($vconf) = grep { $_->{'line'} == $line } @fvirts;
+			$vconf || &error($text{'delete_egone'});
+			&can_edit_virt($vconf) ||
+				&error(&text('delete_ecannot2',
+					     &virtual_name($vconf)));
+			&is_default_vhost($vconf) &&
+				&error($text{'delete_edefault'});
+			push(@{$file_virts{$rfile}}, $vconf);
+			}
+		}
+	}
+@virts || %file_virts || &error($text{'delete_enone'});
 
 # Delete their structures
-&before_changing();
+&before_changing(keys %file_virts);
 foreach $vconf (@virts) {
 	&lock_file($vconf->{'file'});
 	&save_directive_struct($vconf, undef, $conf, $conf);
 	&delete_file_if_empty($vconf->{'file'});
 	}
+foreach $file (keys %file_virts) {
+	&lock_file($file);
+	$deleted += &delete_virtuals_from_file($file, @{$file_virts{$file}});
+	&unlock_file($file);
+	}
 &flush_file_lines();
 &unlock_all_files();
 &update_last_config_change();
 &after_changing();
-&webmin_log("virts", "delete", scalar(@virts));
+$deleted += scalar(@virts);
+&webmin_log("virts", "delete", $deleted);
 &redirect("");
-

apache/index.cgi

@@ -102,6 +102,10 @@ if (&can_edit_virt()) {
 	push(@vproxy, undef);
 	$sn ||= &get_system_hostname();
 	push(@vurl, $defport ? "http://$sn:$defport/" : "http://$sn/");
+	push(@vfile, undef);
+	push(@vstatus, "");
+	push(@vsel, undef);
+	push(@vfilemanage, 0);
 	$showing_default++;
 	}
 
@@ -128,16 +132,23 @@ elsif ($httpd_modules{'core'} >= 1.2) {
 	$ba = &find_directive("ServerName", $conf);
 	$nv{&to_ipaddress($ba ? $ba : &get_system_hostname())}++;
 	}
-@virt = grep { &can_edit_virt($_) } @virt;
+$can_vhost_files = &can_manage_vhost_files();
+@vrows = &get_virtual_list_rows($conf);
 if ($config{'show_order'} == 1) {
 	# sort by server name
-	@virt = sort { &server_name_sort($a) cmp &server_name_sort($b) } @virt;
+	@vrows = sort { &server_name_sort($a->{'virt'}) cmp
+			&server_name_sort($b->{'virt'}) } @vrows;
 	}
 elsif ($config{'show_order'} == 2) {
 	# sort by IP address
-	@virt = sort { &server_ip_sort($a) cmp &server_ip_sort($b) } @virt;
+	@vrows = sort { &server_ip_sort($a->{'virt'}) cmp
+			&server_ip_sort($b->{'virt'}) } @vrows;
 	}
-foreach $v (@virt) {
+@virt = map { $_->{'virt'} } grep { $_->{'active'} } @vrows;
+%available_vhost_file = map { $_, 1 } &get_vhost_available_files()
+	if ($can_vhost_files);
+foreach $r (@vrows) {
+	$v = $r->{'virt'};
 	$vm = $v->{'members'};
 	if ($v->{'words'}->[0] =~ /^\[(\S+)\]:(\d+)$/) {
 		# IPv6 address and port
@@ -163,7 +174,7 @@ foreach $v (@virt) {
 	$idx = &indexof($v, @$conf);
 	push(@vidx, $idx);
 	push(@vname, $text{'index_virt'});
-	push(@vlink, "virt_index.cgi?virt=$idx");
+	push(@vlink, $r->{'active'} ? "virt_index.cgi?virt=$idx" : undef);
 	$sname = &find_directive("ServerName", $vm);
 	local $daddr = $addr eq "_default_" ||
                        ($addr eq "*" && $httpd_modules{'core'} < 1.2);
@@ -225,10 +236,34 @@ foreach $v (@virt) {
 		}
 	$sp = undef if ($sp == 80 && $prot eq "http" ||
 			$sp == 443 && $prot eq "https");
-	push(@vurl, $sp ? "$prot://$sn:$sp/" : "$prot://$sn/");
+	push(@vurl, $r->{'active'} ?
+		    ($sp ? "$prot://$sn:$sp/" : "$prot://$sn/") : undef);
+	local $rfile = $r->{'file'} ? &simplify_path(&resolve_links($r->{'file'}))
+				    : undef;
+	push(@vfile, $rfile);
+	local $status = "";
+	if ($can_vhost_files && $rfile && $available_vhost_file{$rfile}) {
+		local $enabled = &vhost_file_state($rfile)->{'enabled'};
+		$status = $enabled ? $text{'index_enabled'} :
+				     $text{'index_disabled'};
+		}
+	push(@vstatus, $status);
+	local $file_manage = $can_vhost_files && $rfile &&
+			     $available_vhost_file{$rfile} &&
+			     &can_manage_vhost_state_file($rfile);
+	push(@vfilemanage, $file_manage ? 1 : 0);
+	local $sel;
+	if ($r->{'active'} && (!$can_vhost_files || !&is_default_vhost($v))) {
+		$sel = $idx;
+		}
+	elsif (!$r->{'active'} && $can_vhost_files && $rfile &&
+	       $available_vhost_file{$rfile} && $file_manage) {
+		$sel = "file\t".$rfile."\t".$v->{'line'};
+		}
+	push(@vsel, $sel);
 	}
 
-if (@vlink == 1 && !$access{'global'} && $access{'virts'} ne "*" &&
+if (@vlink == 1 && $vlink[0] && !$access{'global'} && $access{'virts'} ne "*" &&
     !$access{'create'} && $access{'noconfig'}) {
 	# Can only manage one vhost, so go direct to it
 	&redirect($vlink[0]);
@@ -297,7 +332,9 @@ if ($access{'global'}) {
 # work out select links
 print &ui_tabs_start_tab("mode", "list");
 #print $text{'index_desclist'},"<p>\n";
-$showdel = $access{'vaddr'} && ($vidx[0] || $vidx[1]);
+$showdel = $access{'vaddr'} &&
+	   grep { defined($_) && $_ ne "" } @vsel;
+$showtoggle = $can_vhost_files && grep { $_ } @vfilemanage;
 @links = ( );
 if ($showdel) {
 	push(@links, &select_all_link("d"),
@@ -326,8 +363,10 @@ if ($config{'max_servers'} && @vname > $config{'max_servers'}) {
 	}
 elsif ($config{'show_list'} && scalar(@vname)) {
 	# as list for people with lots of servers
+	$list_form = "vhosts_form";
 	if ($showdel) {
-		print &ui_form_start("delete_vservs.cgi", "post");
+		print &ui_form_start("delete_vservs.cgi", "post", undef,
+				     "id='$list_form'");
 		}
 	print &ui_links_row(\@links);
 	print &ui_columns_start([
@@ -337,19 +376,23 @@ elsif ($config{'show_list'} && scalar(@vname)) {
 		$text{'index_port'},
 		$text{'index_name'},
 		$text{'index_root'},
+		$can_vhost_files ? ( $text{'index_status'} ) : ( ),
 		$text{'index_url'} ], 100);
 	for($i=0; $i<@vname; $i++) {
 		local @cols;
-		push(@cols, &ui_link($vlink[$i], $vname[$i]) );
+		push(@cols, $vlink[$i] ? &ui_link($vlink[$i], $vname[$i]) :
+					  $vname[$i] );
 		push(@cols, &html_escape($vaddr[$i]));
 		push(@cols, &html_escape($vport[$i]));
 		push(@cols, $vserv[$i] || $text{'index_auto'});
 		push(@cols, &html_escape($vproxy[$i]) ||
 			    &html_escape($vroot[$i]));
-		push(@cols, &ui_link($vurl[$i], $text{'index_view'}) );
-		if ($showdel && $vidx[$i]) {
+		push(@cols, $vstatus[$i]) if ($can_vhost_files);
+		push(@cols, $vurl[$i] ? &ui_link($vurl[$i], $text{'index_view'}) :
+					"" );
+		if ($showdel && defined($vsel[$i]) && $vsel[$i] ne "") {
 			print &ui_checked_columns_row(\@cols, undef,
-						      "d", $vidx[$i]);
+						      "d", $vsel[$i]);
 			}
 		elsif ($showdel) {
 			print &ui_columns_row([ "", @cols ]);
@@ -361,13 +404,23 @@ elsif ($config{'show_list'} && scalar(@vname)) {
 	print &ui_columns_end();
 	print &ui_links_row(\@links);
 	if ($showdel) {
-		print &ui_form_end([ [ "delete", $text{'index_delete'} ] ]);
+		if ($showtoggle) {
+			print &ui_form_end_side_by_side($list_form,
+				[ [ "delete", $text{'index_delete'} ] ],
+				[ [ "toggle", $text{'index_toggle'}, undef,
+				    undef, "form=\"$list_form\"" ] ]);
+			}
+		else {
+			print &ui_form_end([ [ "delete", $text{'index_delete'} ] ]);
+			}
 		}
 	}
 else {
 	# as icons for niceness
+	$list_form = "vhosts_form";
 	if ($showdel) {
-		print &ui_form_start("delete_vservs.cgi", "post");
+		print &ui_form_start("delete_vservs.cgi", "post", undef,
+				     "id='$list_form'");
 		}
 	print &ui_links_row(\@links);
 	print "<table width=100% cellpadding=5>\n";
@@ -376,8 +429,9 @@ else {
 		print '<div class="row icons-row inline-row">';
 		&generate_icon("images/virt.gif", $vname[$i], $vlink[$i],
 			       undef, undef, undef,
-			       $vidx[$i] && $access{'vaddr'} ?
-					&ui_checkbox("d", $vidx[$i]) : "");
+			       defined($vsel[$i]) && $vsel[$i] ne "" &&
+			       $access{'vaddr'} ?
+					&ui_checkbox("d", $vsel[$i]) : "");
 		print "</div>\n";
 		print "</td> <td valign=top>\n";
 		print "$vdesc[$i]<br>\n";
@@ -397,12 +451,24 @@ else {
 			print "<b>$text{'index_root'}</b> ",
 			      &html_escape($vroot[$i]),"</td> </tr>\n";
 			}
+		if ($can_vhost_files && $vstatus[$i]) {
+			print "<tr><td colspan=2><b>$text{'index_status'}</b> ",
+			      $vstatus[$i],"</td></tr>\n";
+			}
 		print "</table></td> </tr>\n";
 		}
 	print "</table>\n";
 	print &ui_links_row(\@links);
 	if ($showdel) {
-		print &ui_form_end([ [ "delete", $text{'index_delete'} ] ]);
+		if ($showtoggle) {
+			print &ui_form_end_side_by_side($list_form,
+				[ [ "delete", $text{'index_delete'} ] ],
+				[ [ "toggle", $text{'index_toggle'}, undef,
+				    undef, "form=\"$list_form\"" ] ]);
+			}
+		else {
+			print &ui_form_end([ [ "delete", $text{'index_delete'} ] ]);
+			}
 		}
 	}
 print &ui_tabs_end_tab();
@@ -492,4 +558,3 @@ return $addr eq '_default_' || $addr eq '*' ? undef :
        $addr =~ /^\[(\S+)\]$/ && &check_ip6address($1) ? $1 :
 			         &to_ipaddress($addr);
 }
-

apache/lang/en

@@ -34,6 +34,9 @@ index_listen=Listen on address (if needed)
 index_port=Port
 index_name=Server Name
 index_root=Document Root
+index_status=State
+index_enabled=Enabled
+index_disabled=Disabled
 index_url=URL
 index_view=Open..
 index_adddir=Allow access to this directory
@@ -57,6 +60,7 @@ index_fmode1=Virtual servers file $1
 index_fmode1d=New file under virtual servers directory $1
 index_fmode2=Selected file..
 index_delete=Delete Selected Servers
+index_toggle=Toggle State
 
 cvirt_ecannot=You are not allowed to create a virtual server
 cvirt_err=Failed to create virtual server
@@ -1032,6 +1036,7 @@ log_stop=Stopped webserver
 log_apply=Applied changes
 log_manual=Manually edited configuration file $1
 log_virts_delete=Deleted $1 virtual servers
+log_toggle_vhostfile=Toggled state of $1 virtual host files
 
 search_title=Find Servers
 search_notfound=No matching virtual servers found
@@ -1148,6 +1153,22 @@ delete_err=Failed to delete virtual servers
 delete_enone=None selected
 delete_ecannot=You are not allowed to delete servers
 delete_ecannot2=You are not allowed to edit the server $1
+delete_eaction=No action was selected
+delete_egone=The selected virtual server no longer exists
+delete_edefault=The default virtual server cannot be deleted
+
+enable_err=Failed to change virtual host file state
+enable_enone=No manageable virtual host files were selected
+enable_efile=Virtual host file does not exist or cannot be managed
+enable_elinkdir=No enabled virtual host links directory is configured
+enable_elink=Failed to create symbolic link $1 : $2
+enable_eunlink=Failed to remove symbolic link $1 : $2
+enable_elinkexists=The symbolic link $1 already exists
+enable_etest=Apache configuration test failed after changing the virtual host file state : $1
+enable_evirtualmin_disable=This Apache virtual host is managed by Virtualmin virtual server $1, which is currently $2. Site disabling should be done in Virtualmin using $3.
+enable_evirtualmin_enable=This Apache virtual host is managed by Virtualmin virtual server $1, which is currently $2. Site enabling should be done in Virtualmin using $3.
+enable_virtualmin_disable_label=Disable and Delete ⇾ Disable Virtual Server
+enable_virtualmin_enable_label=Disable and Delete ⇾ Enable Virtual Server
 
 syslog_desc=Apache error log
 

apache/t/vhost-files.t

@@ -0,0 +1,409 @@
+#!/usr/bin/perl
+# Tests for Debian-style Apache sites-available/sites-enabled handling.
+
+use strict;
+use warnings;
+use Test::More;
+use File::Basename qw(dirname);
+use File::Path qw(make_path);
+use File::Spec;
+use File::Temp qw(tempdir);
+use Cwd qw(abs_path);
+
+my $root = abs_path(File::Spec->catdir(dirname(__FILE__), '..', '..'));
+my $tmp = abs_path(tempdir(CLEANUP => 1));
+my $webmin_config = File::Spec->catdir($tmp, 'webmin-config');
+my $webmin_var = File::Spec->catdir($tmp, 'webmin-var');
+my $apache_root = File::Spec->catdir($tmp, 'apache2');
+my $available = File::Spec->catdir($apache_root, 'sites-available');
+my $enabled = File::Spec->catdir($apache_root, 'sites-enabled');
+my $apache_conf = File::Spec->catfile($apache_root, 'apache2.conf');
+
+make_path($webmin_config, $webmin_var, "$webmin_config/apache",
+	  "$webmin_var/apache", $apache_root, $available, $enabled);
+
+sub write_text
+{
+my ($file, $text) = @_;
+open(my $fh, '>', $file) || die "Failed to write $file: $!";
+print $fh $text;
+close($fh) || die "Failed to close $file: $!";
+}
+
+sub read_text
+{
+my ($file) = @_;
+open(my $fh, '<', $file) || die "Failed to read $file: $!";
+local $/ = undef;
+my $text = <$fh>;
+close($fh) || die "Failed to close $file: $!";
+return $text;
+}
+
+sub vhost_conf
+{
+my ($name, $rootdir) = @_;
+my $name_line = defined($name) ? "    ServerName $name\n" : "";
+return "<VirtualHost *:80>\n".
+       $name_line.
+       "    DocumentRoot $rootdir\n".
+       "</VirtualHost>\n";
+}
+
+my $default = File::Spec->catfile($available, '000-default.conf');
+my $alpha = File::Spec->catfile($available, 'alpha.conf');
+my $beta = File::Spec->catfile($available, 'beta.conf');
+my $charlie = File::Spec->catfile($available, 'charlie.conf');
+
+write_text($default, vhost_conf(undef, '/srv/default'));
+write_text($alpha, vhost_conf('alpha.example', '/srv/alpha'));
+write_text($beta, vhost_conf('beta.example', '/srv/beta'));
+write_text($charlie, vhost_conf('charlie.example', '/srv/charlie'));
+write_text($apache_conf,
+	"ServerRoot \"$apache_root\"\n".
+	"Listen 80\n".
+	"IncludeOptional $enabled/*.conf\n");
+
+symlink($default, File::Spec->catfile($enabled, '000-default.conf')) ||
+	die "Failed to symlink default: $!";
+symlink($alpha, File::Spec->catfile($enabled, 'alpha.conf')) ||
+	die "Failed to symlink alpha: $!";
+symlink($charlie, File::Spec->catfile($enabled, 'charlie.conf')) ||
+	die "Failed to symlink charlie: $!";
+
+write_text(File::Spec->catfile($webmin_config, 'config'),
+	"os_type=debian-linux\n".
+	"os_version=12\n".
+	"real_os_type=Debian Linux\n".
+	"real_os_version=12\n");
+write_text(File::Spec->catfile($webmin_config, 'miniserv.conf'),
+	"root=$root\n");
+write_text(File::Spec->catfile($webmin_config, 'apache', 'config'),
+	"httpd_dir=$apache_root\n".
+	"httpd_path=/bin/true\n".
+	"httpd_conf=$apache_conf\n".
+	"apachectl_path=/bin/true\n".
+	"httpd_version=2.4.57\n".
+	"test_apachectl=0\n".
+	"test_config=1\n".
+	"virt_file=$available\n".
+	"link_dir=$enabled\n");
+
+$ENV{'WEBMIN_CONFIG'} = $webmin_config;
+$ENV{'WEBMIN_VAR'} = $webmin_var;
+$ENV{'FOREIGN_MODULE_NAME'} = 'apache';
+$ENV{'FOREIGN_ROOT_DIRECTORY'} = $root;
+$ENV{'REMOTE_USER'} = 'root';
+
+unshift(@INC, $root);
+require File::Spec->catfile($root, 'apache', 'apache-lib.pl');
+
+{
+	no warnings 'once';
+	$main::text{'enable_elinkdir'} = 'No enabled virtual host links directory is configured';
+	$main::text{'enable_efile'} = 'Virtual host file does not exist or cannot be managed';
+	$main::text{'enable_elink'} = 'Failed to create symbolic link $1 : $2';
+	$main::text{'enable_eunlink'} = 'Failed to remove symbolic link $1 : $2';
+	$main::text{'enable_elinkexists'} = 'The symbolic link $1 already exists';
+	$main::text{'enable_etest'} = 'Apache configuration test failed after changing the virtual host file state : $1';
+	$main::text{'enable_evirtualmin_disable'} = 'This Apache virtual host is managed by Virtualmin virtual server $1, which is currently $2. Site disabling should be done in Virtualmin using $3.';
+	$main::text{'enable_evirtualmin_enable'} = 'This Apache virtual host is managed by Virtualmin virtual server $1, which is currently $2. Site enabling should be done in Virtualmin using $3.';
+	$main::text{'enable_virtualmin_disable_label'} = 'Disable and Delete &#x21fe; Disable Virtual Server';
+	$main::text{'enable_virtualmin_enable_label'} = 'Disable and Delete &#x21fe; Enable Virtual Server';
+	$main::text{'index_enabled'} = 'Enabled';
+	$main::text{'index_disabled'} = 'Disabled';
+	$main::text{'eafter'} = 'Apache configuration test failed : $1';
+}
+
+sub apache_config
+{
+main::flush_config_cache();
+my $conf = main::get_config();
+ok($conf, 'test apache config can be parsed');
+return $conf;
+}
+
+sub row_names
+{
+return [ map {
+	scalar(main::find_directive('ServerName', $_->{'virt'}->{'members'})) || ''
+	} @_ ];
+}
+
+sub row_states
+{
+return [ map { $_->{'active'} ? 'enabled' : 'disabled' } @_ ];
+}
+
+subtest 'sites-available files are manageable and ordered' => sub {
+	ok(main::can_manage_vhost_files(),
+	   'sites-available/enabled dirs are manageable');
+	is_deeply(
+		[ main::get_vhost_available_files() ],
+		[ $default, $alpha, $beta, $charlie ],
+		'available files are listed in stable filename order',
+	);
+
+	my @rows = main::get_virtual_list_rows(apache_config());
+	is_deeply(row_names(@rows),
+		  [ '', 'alpha.example', 'beta.example', 'charlie.example' ],
+		  'disabled rows stay in sites-available order');
+	is_deeply(row_states(@rows),
+		  [ 'enabled', 'enabled', 'disabled', 'enabled' ],
+		  'row active state follows sites-enabled symlinks');
+	ok(!main::can_manage_vhost_file($default),
+	   'default virtual host file is not file-state manageable');
+};
+
+subtest 'disable removes only the enabled symlink' => sub {
+	no warnings 'once';
+	unlink($main::last_config_change_flag);
+	unlink($main::last_restart_time_flag);
+	main::restart_last_restart_time();
+	my $old = time() - 10;
+	utime($old, $old, $main::last_restart_time_flag);
+
+	{
+		no warnings 'redefine';
+		local *main::test_config = sub { return undef; };
+		is(main::disable_vhost_file($alpha), undef, 'disable succeeds');
+	}
+	ok(main::needs_config_restart(),
+	   'disable marks config as needing apply');
+
+	ok(-f $alpha, 'disable leaves the sites-available file in place');
+	ok(!-e File::Spec->catfile($enabled, 'alpha.conf'),
+	   'disable removes the sites-enabled symlink');
+
+	my @rows = main::get_virtual_list_rows(apache_config());
+	is_deeply(row_names(@rows),
+		  [ '', 'alpha.example', 'beta.example', 'charlie.example' ],
+		  'disabled row remains in the same list position');
+	is_deeply(row_states(@rows),
+		  [ 'enabled', 'disabled', 'disabled', 'enabled' ],
+		  'disabled row status is updated');
+};
+
+subtest 'enable creates a symlink without touching the source file' => sub {
+	no warnings 'once';
+	unlink($main::last_config_change_flag);
+	unlink($main::last_restart_time_flag);
+	main::restart_last_restart_time();
+	my $old = time() - 10;
+	utime($old, $old, $main::last_restart_time_flag);
+
+	{
+		no warnings 'redefine';
+		local *main::test_config = sub { return undef; };
+		is(main::enable_vhost_file($beta), undef, 'enable succeeds');
+	}
+	ok(main::needs_config_restart(),
+	   'enable marks config as needing apply');
+
+	my $link = File::Spec->catfile($enabled, 'beta.conf');
+	ok(-f $beta, 'enable leaves the sites-available file in place');
+	ok(-l $link, 'enable creates the sites-enabled symlink');
+	is(readlink($link), $beta, 'enabled symlink points to the available file');
+	ok(main::vhost_file_enabled($beta), 'vhost_file_enabled sees the symlink');
+};
+
+subtest 'same-name symlink to another target is not disabled' => sub {
+	my $otherdir = File::Spec->catdir($tmp, 'other-sites');
+	my $other = File::Spec->catfile($otherdir, 'charlie.conf');
+	my $link = File::Spec->catfile($enabled, 'charlie.conf');
+	make_path($otherdir);
+	write_text($other, vhost_conf('other.example', '/srv/other'));
+	unlink($link) || die "Failed to remove charlie link: $!";
+	symlink($other, $link) || die "Failed to symlink other charlie: $!";
+
+	ok(!main::vhost_file_enabled($charlie),
+	   'same-name symlink to another file is not considered enabled');
+	{
+		no warnings 'redefine';
+		local *main::test_config = sub { return undef; };
+		is(main::disable_vhost_file($charlie), undef, 'disable is a no-op');
+	}
+	ok(-l $link, 'same-name symlink to another target is preserved');
+	is(readlink($link), $other, 'preserved symlink target is unchanged');
+};
+
+subtest 'disabled default virtual hosts stay hidden' => sub {
+	my $disabled_default = File::Spec->catfile($available,
+						  'zz-disabled-default.conf');
+	write_text($disabled_default, vhost_conf(undef, '/srv/disabled-default'));
+
+	my @rows = main::get_virtual_list_rows(apache_config());
+	ok(!(grep { $_->{'file'} eq $disabled_default } @rows),
+	   'disabled catch-all virtual host file is not listed as a normal vhost');
+};
+
+subtest 'legacy webfile link helpers resolve relative link_dir' => sub {
+	my $relative = File::Spec->catfile($available, 'relative.conf');
+	my $link = File::Spec->catfile($enabled, 'relative.conf');
+	write_text($relative, vhost_conf('relative.example', '/srv/relative'));
+	unlink($link);
+
+	{
+		no warnings 'once';
+		local $main::config{'link_dir'} = 'sites-enabled';
+		main::create_webfile_link($relative);
+		ok(-l $link, 'relative link_dir creates link under ServerRoot');
+		is(readlink($link), $relative,
+		   'created relative link_dir symlink points to the vhost file');
+		main::delete_webfile_link($relative);
+		ok(!-e $link && !-l $link,
+		   'relative link_dir delete removes the enabled symlink');
+	}
+};
+
+subtest 'file-level actions require access to every virtual host in the file' => sub {
+	my $mixed = File::Spec->catfile($available, 'mixed.conf');
+	write_text($mixed,
+		vhost_conf('alpha.example', '/srv/mixed-alpha').
+		vhost_conf('hidden.example', '/srv/mixed-hidden'));
+
+	{
+		no warnings 'once';
+		local $main::access{'virts'} = 'alpha.example:80';
+		ok(!main::can_manage_vhost_file($mixed),
+		   'mixed-access file cannot be managed by a restricted user');
+	}
+	ok(main::can_manage_vhost_file($mixed),
+	   'shared file can be managed when all contained vhosts are allowed');
+};
+
+subtest 'state helpers enforce allowed files and ACLs directly' => sub {
+	my $outside = File::Spec->catfile($tmp, 'outside.conf');
+	write_text($outside, vhost_conf('outside.example', '/srv/outside'));
+	is(main::enable_vhost_file($outside),
+	   'Virtual host file does not exist or cannot be managed',
+	   'enable rejects files outside sites-available');
+
+	my $mixed = File::Spec->catfile($available, 'state-mixed.conf');
+	write_text($mixed,
+		vhost_conf('alpha.example', '/srv/state-alpha').
+		vhost_conf('hidden.example', '/srv/state-hidden'));
+	{
+		no warnings 'once';
+		local $main::access{'virts'} = 'alpha.example:80';
+		is(main::enable_vhost_file($mixed),
+		   'Virtual host file does not exist or cannot be managed',
+		   'enable rejects mixed-access files without relying on caller validation');
+	}
+};
+
+subtest 'change rollback covers extra disabled vhost files' => sub {
+	my $rollback = File::Spec->catfile($available, 'rollback.conf');
+	my $original = vhost_conf('rollback.example', '/srv/rollback');
+	write_text($rollback, $original);
+	my @virts = main::find_virtuals_in_file($rollback);
+	is(scalar(@virts), 1, 'rollback fixture has one vhost');
+
+	{
+		no warnings qw(redefine once);
+		local %main::before_changing;
+		local $main::config{'test_always'} = 1;
+		local *main::test_config = sub { return 'bad config'; };
+		local *main::error = sub { die $_[0]; };
+		main::before_changing($rollback);
+		is(main::delete_virtuals_from_file($rollback, @virts), 1,
+		   'disabled vhost file deletion removes the vhost');
+		ok(!-e $rollback, 'empty disabled vhost file is deleted');
+		like(eval { main::after_changing(); 1 } ? '' : $@,
+		     qr/bad config/, 'failed post-change test reports an error');
+	}
+	ok(-f $rollback, 'rollback recreates the disabled vhost file');
+	is(read_text($rollback), $original,
+	   'rollback restores the disabled vhost file contents');
+};
+
+subtest 'apache configtest failure rolls back link changes' => sub {
+	my $delta = File::Spec->catfile($available, 'delta.conf');
+	my $delta_link = File::Spec->catfile($enabled, 'delta.conf');
+	write_text($delta, vhost_conf('delta.example', '/srv/delta'));
+
+	{
+		no warnings 'redefine';
+		local *main::test_config = sub { return 'bad config'; };
+		like(main::enable_vhost_file($delta), qr/bad config/,
+		     'failed enable reports apache configtest output');
+	}
+	ok(!-e $delta_link, 'failed enable removes the new symlink');
+
+	symlink($delta, $delta_link) || die "Failed to symlink delta: $!";
+	{
+		no warnings 'redefine';
+		local *main::test_config = sub { return 'bad config'; };
+		like(main::disable_vhost_file($delta), qr/bad config/,
+		     'failed disable reports apache configtest output');
+	}
+	ok(-l $delta_link, 'failed disable restores the removed symlink');
+	is(readlink($delta_link), $delta, 'restored symlink target is unchanged');
+};
+
+subtest 'Virtualmin-managed virtual host files cannot be toggled directly' => sub {
+	my $enabled_domain = File::Spec->catfile($available, 'vm-enabled.conf');
+	my $disabled_domain = File::Spec->catfile($available, 'vm-disabled.conf');
+	write_text($enabled_domain,
+		vhost_conf('www.vm-enabled.example', '/srv/vm-enabled'));
+	write_text($disabled_domain,
+		vhost_conf('vm-disabled.example', '/srv/vm-disabled'));
+
+	{
+		no warnings qw(redefine once);
+		local %main::apache_virtualmin_domain_for_file_cache;
+		local %main::apache_virtualmin_domain_by_name_cache;
+		local *main::virtualmin_available = sub { return 1; };
+		local *main::virtualmin_domain_by_name = sub {
+			my ($name) = @_;
+			return $name eq 'vm-enabled.example' ?
+				{ 'dom' => $name, 'id' => '12345',
+				  'disabled' => '' } :
+			       $name eq 'vm-disabled.example' ?
+				{ 'dom' => $name, 'id' => '67890',
+				  'disabled' => 'web' } :
+				undef;
+			};
+
+		my $disable_err =
+			main::virtualmin_vhost_file_state_error($enabled_domain,
+								'disable');
+		my $enabled_state = main::vhost_file_state($enabled_domain);
+		is($enabled_state->{'source'}, 'virtualmin',
+		   'Virtualmin is the effective state source for managed files');
+		ok($enabled_state->{'enabled'},
+		   'Virtualmin enabled domain is reported as enabled');
+		is(main::vhost_file_toggle_action($enabled_domain), 'disable',
+		   'toggle action follows the Virtualmin enabled state');
+		like($disable_err, qr/currently enabled/,
+		     'Virtualmin state is included for enabled domains');
+		like($disable_err, qr/Disable Virtual Server/,
+		     'disabling directs users to Virtualmin disable action');
+		like($disable_err,
+		     qr{virtual-server/disable_domain\.cgi\?dom=12345},
+		     'disabling links to the Virtualmin disable form');
+
+		my $enable_err =
+			main::virtualmin_vhost_file_state_error($disabled_domain,
+								'enable');
+		my $disabled_state = main::vhost_file_state($disabled_domain);
+		is($disabled_state->{'source'}, 'virtualmin',
+		   'Virtualmin remains the state source for disabled domains');
+		ok(!$disabled_state->{'enabled'},
+		   'Virtualmin disabled domain is reported as disabled');
+		is(main::vhost_file_toggle_action($disabled_domain), 'enable',
+		   'toggle action follows the Virtualmin disabled state');
+		like($enable_err, qr/currently disabled/,
+		     'Virtualmin state is included for disabled domains');
+		like($enable_err, qr/Enable Virtual Server/,
+		     'enabling directs users to Virtualmin enable action');
+		like($enable_err,
+		     qr{virtual-server/enable_domain\.cgi\?dom=67890},
+		     'enabling links to the Virtualmin enable form');
+
+		is(main::virtualmin_vhost_file_state_error($alpha, 'disable'),
+		   undef, 'non-Virtualmin virtual host files can still be toggled');
+	}
+};
+
+done_testing();

bacula-backup/bacula-backup-lib.pl

@@ -58,6 +58,23 @@ $testcmd->finish();
 return $dbh;
 }
 
+# bacula_catalog_table_exists(&dbh, table)
+# Returns 1 if the Bacula catalog contains a table, 0 if not
+sub bacula_catalog_table_exists
+{
+local ($dbh, $table) = @_;
+$table =~ /^\w+\z/ || die "Illegal catalog table name";
+local $dbh->{'PrintError'} = 0;
+local $dbh->{'RaiseError'} = 0;
+my $cmd = eval { $dbh->prepare("SELECT 1 FROM $table WHERE 1 = 0") };
+my $ok;
+if ($cmd) {
+	$ok = eval { $cmd->execute() };
+	$cmd->finish();
+	}
+return $ok ? 1 : 0;
+}
+
 # read_config_file(file)
 # Parses a bacula config file
 sub read_config_file
@@ -1678,4 +1695,3 @@ return ( \%tags, $run );
 }
 
 1;
-

bacula-backup/list.cgi

@@ -78,6 +78,12 @@ $cmd->finish();
 
 @rv = &unique(@rv);
 
+my $filename_table = &bacula_catalog_table_exists($dbh, "Filename");
+my $filename_col = $filename_table ? "Filename.Name" : "File.Filename";
+my $filename_from = $filename_table ? ", Filename" : "";
+my $filename_join = $filename_table ?
+	"AND File.FilenameId  = Filename.FilenameId" : "";
+
 # Build the nodes structure for folders
 foreach $f (@rv) {
 	$f =~ /([^\/]+)\/\Z/;
@@ -92,16 +98,16 @@ foreach $f (@rv) {
 if ($in{'volume'}) {
 	# Files in directory, that are on this volume
 	$cmd = $dbh->prepare("
-		SELECT Filename.Name
-		FROM File, Filename, Job, JobMedia, Media
-		WHERE File.FilenameId  = Filename.FilenameId
-		  AND File.JobId       = Job.JobId
+		SELECT $filename_col
+		FROM File$filename_from, Job, JobMedia, Media
+		WHERE File.JobId       = Job.JobId
 		  AND Job.JobId        = JobMedia.JobId
 		  AND JobMedia.MediaId = Media.MediaId
 		  AND File.PathId      = ?
 		  AND Media.VolumeName = ?
+		  $filename_join
 		  $jobsql
-		ORDER BY Filename.Name
+		ORDER BY $filename_col
 	");
 
 	$cmd->execute($pid, $in{'volume'}) || die "db error: ".$dbh->errstr;
@@ -109,13 +115,13 @@ if ($in{'volume'}) {
 else {
 	# Files in directory
 	$cmd = $dbh->prepare("
-		SELECT Filename.Name
-		FROM Job, File, Filename
+		SELECT $filename_col
+		FROM Job, File$filename_from
 		WHERE Job.JobId       = File.JobId
-		  AND File.FilenameId = Filename.FilenameId
 		  AND File.PathId     = ?
+		  $filename_join
 		  $jobsql
-		ORDER BY Filename.Name
+		ORDER BY $filename_col
 	");
 
 	$cmd->execute($pid) || die "db error: ".$dbh->errstr;

bind8/mass_rcreate.cgi

@@ -23,7 +23,7 @@ foreach my $d (split(/\0/, $in{'d'})) {
 $access{'ro'} && &error($text{'master_ero'});
 
 # Validate inputs
-&valdnsname($in{'name'}) || $in{'name'} eq '@' || &error($text{'rmass_ename'});
+&valdnsname($in{'name'}, 0, undef, $in{'type'}) || $in{'name'} eq '@' || &error($text{'rmass_ename'});
 $in{'name'} =~ /\.$/ && &error($text{'rmass_ename2'});
 my $mxpri;
 if ($in{'type'} eq 'A') {
@@ -70,6 +70,12 @@ foreach my $zi (@zones) {
 	my $fullname = $in{'name'} eq '@' ?
 			$zi->{'name'}."." :
 			$in{'name'}.".".$zi->{'name'}.".";
+	if (length($fullname) > 255) {
+		# The owner name fits on its own but exceeds the 255-octet
+		# DNS limit once this zone's name is appended; skip this one.
+		print &text('edit_efqdn', "<tt>$fullname</tt>"),"<p>\n";
+		next;
+		}
 	&before_editing($zi);
 	my @recs = &read_zone_file($zi->{'file'}, $zi->{'name'});
 	my $clash;

bind8/records-lib.pl

@@ -726,25 +726,38 @@ return $addr;
 our $uscore = $config{'allow_underscore'} ? "_" : "";
 our $star = $config{'allow_wild'} ? "\\*" : "";
 
-# valdnsname(name, wild, origin)
-# Returns 1 if a DNS record has a valid name
+# Record types whose owner names must follow hostname rules. Other types
+# (TXT, CNAME, SRV, PTR, TLSA, CAA, ...) may legitimately use underscores
+# in their owner names (e.g. _domainkey, _dmarc, _acme-challenge), so the
+# allow_underscore config is ignored for them, matching BIND's check-names.
+our %hostname_owner_types = map { $_ => 1 } qw(A AAAA MX NS DS DNAME);
+
+# valdnsname(name, wild, [origin], [type])
+# Returns 1 if a DNS record has a valid name. If a type is supplied and
+# isn't one of the hostname-bearing types, underscores are accepted in
+# the name regardless of the allow_underscore config.
 sub valdnsname
 {
-my ($name, $wild, $origin) = @_;
-my $fqdn = $name !~ /\.$/ ? "$name.$origin." : $name;
+my ($name, $wild, $origin, $type) = @_;
+my $root = !defined($origin) || $origin eq "" || $origin eq ".";
+my $fqdn = $name =~ /\.$/    ? $name
+	 : $root              ? "$name."
+	 :                      "$name.$origin.";
 if (length($fqdn) > 255) {
 	&error(&text('edit_efqdn', $fqdn));
 	}
-if ($_[0] =~ /[^\.]{64}/) {
+if ($name =~ /[^\.]{64}/) {
 	# no label longer than 63 chars
-	&error(&text('edit_elabel', $_[0]));
+	&error(&text('edit_elabel', $name));
 	}
+my $u = ($config{'allow_underscore'} ||
+	 ($type && !$hostname_owner_types{uc($type)})) ? "_" : "";
 return ((($wild && $config{'allow_wild'})
-	 ? (($name =~ /^[\*A-Za-z0-9\-\.$uscore]+$/)
+	 ? (($name =~ /^[\*A-Za-z0-9\-\.$u]+$/)
 	   && ($name !~ /.\*/ || $bind_version >= 9) # "*" can be only the first
 						    # char, for bind 8
 	   && ($name !~ /\*[^\.]/))	# a "." must always follow "*"
-	 : ($name =~ /^[\A-Za-z0-9\-\.$uscore]+$/))
+	 : ($name =~ /^[A-Za-z0-9\-\.$u]+$/))
 	&& ($name !~ /\.\./)		# no ".." inside
 	&& ($name !~ /^\../)		# no "." at the beginning
 	&& ($name !~ /^\-/)		# no "-" at the beginning

bind8/save_record.cgi

@@ -153,7 +153,7 @@ if ($in{'type'} eq "PTR" && $reverse) {
 	}
 else {
 	# some other kind of record
-	$in{'name'} eq "" || $in{'name'} eq "@" || &valnamewild($in{'name'}) ||
+	$in{'name'} eq "" || $in{'name'} eq "@" || &valnamewild($in{'name'}, $in{'type'}) ||
 		&error(&text('edit_ename', $in{'name'}));
 	if ($in{'type'} eq "A") {
 		&check_ipaddress($vals) ||
@@ -723,14 +723,14 @@ $r->{'newvalues'} = $vals;
 &redirect("edit_recs.cgi?zone=$in{'zone'}&view=$in{'view'}&".
 	  "type=$in{'redirtype'}&sort=$in{'sort'}");
 
-# valname(name)
+# valname(name, [type])
 sub valname
 {
-return valdnsname($_[0], 0, $in{'origin'});
+return valdnsname($_[0], 0, $in{'origin'}, $_[1]);
 }
 
-# valnamewild(name)
+# valnamewild(name, [type])
 sub valnamewild
 {
-return valdnsname($_[0], 1, $in{'origin'});
+return valdnsname($_[0], 1, $in{'origin'}, $_[1]);
 }

fastrpc.cgi

@@ -8,6 +8,8 @@ BEGIN { push(@INC, "."); };
 use WebminCore;
 use POSIX;
 use Socket;
+
+$main::allow_rpc_only = 1;
 $force_lang = $default_lang;
 &init_config();
 

feedback.cgi

@@ -1,262 +0,0 @@
-#!/usr/local/bin/perl
-# Send the webmin feedback form
-
-BEGIN { push(@INC, "."); };
-use WebminCore;
-
-&init_config();
-if (&get_product_name() eq 'usermin') {
-	&switch_to_remote_user();
-	}
-&ReadParseMime();
-&error_setup($text{'feedback_err'});
-%access = &get_module_acl();
-$access{'feedback'} || &error($text{'feedback_ecannot'});
-
-# Construct the email body
-$in{'text'} =~ s/\r//g;
-$date = localtime(time());
-$ver = &get_webmin_version();
-if ($in{'name'} && $in{'email'}) {
-	$from = "$in{'name'} <$in{'email'}>";
-	$email = $in{'email'};
-	}
-elsif ($in{'email'}) {
-	$email = $from = $in{'email'};
-	}
-else {
-	$email = $from = "feedback\@".&get_system_hostname();
-	}
-local $m = $in{'module'};
-$m || !$in{'config'} || &error($text{'feedback_emodule'});
-&check_os_support($m) && $m !~ /\.\./ || &error($text{'feedback_emodule2'});
-if ($m) {
-	%minfo = &get_module_info($m);
-	$ver .= " (Module: $minfo{'version'})" if ($minfo{'version'});
-	$module = "$m ($minfo{'desc'})";
-	}
-else {
-	$module = "None";
-	}
-if ($gconfig{'nofeedbackcc'}) {
-	@tolist = ( $gconfig{'feedback_to'} ||
-		    $minfo{'feedback'} ||
-		    $webmin_feedback_address );
-	}
-else {
-	@tolist = split(/\s+/, $in{'to'});
-	}
-@tolist || &error($text{'feedback_enoto'});
-foreach $t (@tolist) {
-	$headers .= "To: $t\n";
-	}
-$headers .= "From: $from\n";
-$headers .= "Subject: $text{'feedback_title'}\n";
-
-$attach[0] = <<EOF;
-Content-Type: text/plain
-Content-Transfer-Encoding: 7bit
-
-Name:           $in{'name'}
-Email address:  $in{'email'}
-Date:           $date
-Webmin version: $ver
-Perl version:   $]
-Module:         $module
-Browser:        $ENV{'HTTP_USER_AGENT'}
-EOF
-
-if ($in{'os'}) {
-	$uname = `uname -a`;
-	$attach[0] .= <<EOF;
-OS from webmin: $gconfig{'real_os_type'} $gconfig{'real_os_version'}
-OS code:        $gconfig{'os_type'} $gconfig{'os_version'}
-Uname output:   $uname
-EOF
-	}
-
-$attach[0] .= "\n".$in{'text'}."\n";
-
-if ($in{'config'} && !$gconfig{'nofeedbackconfig'}) {
-	# Check if this user has full rights to the module
-	$access{'feedback'} >= 2 || &error($text{'feedback_ecannot2'});
-	local %uacl = &get_module_acl(undef, $m);
-	local %defacl;
-	local $mdir = &module_root_directory($m);
-	&read_file("$mdir/defaultacl", \%defacl);
-	if ($access{'feedback'} != 3) {
-		foreach $k (keys %uacl) {
-			if ($defacl{$k} ne $uacl{$k}) {
-				&error($text{'feedback_econfig'});
-				}
-			}
-		}
-
-	# Attach all the text file from the module's config
-	local %mconfig = &foreign_config($m);
-	if (keys %mconfig) {
-		local $a;
-		$a .= "Content-Type: text/plain; name=\"config\"\n";
-		$a .= "Content-Transfer-Encoding: 7bit\n";
-		$a .= "\n";
-		foreach $k (keys %mconfig) {
-			$a .= "$k=$mconfig{$k}\n";
-			}
-		push(@attach, $a);
-		}
-
-	# Find out what config files the module uses
-	local @files;
-	if (-r "$mdir/feedback_files.pl") {
-		# Ask the module for it's files
-		&foreign_require($m, "feedback_files.pl");
-		@files = &foreign_call($m, "feedback_files", $m);
-		}
-
-	# Use all the path in the config
-	foreach $k (keys %mconfig) {
-		push(@files, $mconfig{$k}) if ($mconfig{$k} =~ /^\//);
-		}
-	@files = &unique(@files);
-
-	# Attach those config files that are plain text (less than 5%
-	# non-ascii characters). Also skip logfiles.
-	foreach $f (@files) {
-		next if (!$f || -d $f);
-		next if ($f =~ /\/var\/log\//);
-		local $/ = undef;
-		open(FILE, "<$f") || next;
-		local $data = <FILE>;
-		close(FILE);
-		local $count = ($data =~ tr/[\000-\176]/[\000-\176]/);
-		if (!length($data) || 100*$count / length($data) > 95) {
-			# File is text
-			local $a;
-			local $sf = &short_name($f);
-			$a .= "Content-Type: text/plain; name=\"$sf\"\n";
-			$a .= "Content-Transfer-Encoding: 7bit\n";
-			$a .= "\n";
-			$a .= $data;
-			push(@attach, $a);
-			}
-		}
-	}
-
-# Include uploaded attached files
-foreach $u ('attach0', 'attach1') {
-	if ($in{$u} ne '') {
-		local $a;
-		local $name = &short_name($in{"${u}_filename"});
-		local $type = $in{"${u}_content_type"};
-		$type = &guess_mime_type($name) if (!$type);
-		$a .= "Content-type: $type; name=\"$name\"\n";
-		$a .= "Content-Transfer-Encoding: base64\n";
-		$a .= "\n\n";
-		$a .= &encode_base64($in{$u});
-		push(@attach, $a);
-		}
-	}
-
-# Build the MIME email
-$bound = "bound".time();
-$mail = $headers;
-$mail .= "Content-Type: multipart/mixed; boundary=\"$bound\"\n";
-$mail .= "MIME-Version: 1.0\n";
-$mail .= "\n";
-$mail .= "This is a multi-part message in MIME format.\n";
-foreach $a (@attach) {
-	$mail .= "\n--".$bound."\n";
-	$mail .= $a;
-	}
-$mail .= "\n--".$bound."--\n";
-
-if (!$in{'mailserver_def'}) {
-	$ok = &send_via_smtp($in{'mailserver'});
-	$sent = 3 if ($ok);
-	}
-
-if (!$sent) {
-	# Try to send the email by calling sendmail -t
-	%sconfig = &foreign_config("sendmail");
-	$sendmail = $sconfig{'sendmail_path'} ? $sconfig{'sendmail_path'}
-					      : &has_command("sendmail");
-	if (-x $sendmail && open(MAIL, "| $sendmail -t")) {
-		print MAIL $mail;
-		if (close(MAIL)) {
-			$sent = 2;
-			}
-		}
-	}
-
-if (!$sent) {
-	# Try to connect to a local SMTP server
-	$ok = &send_via_smtp("localhost");
-	$sent = 1 if ($ok);
-	}
-
-if ($sent) {
-	# Tell the user that it was sent OK
-	&ui_print_header(undef, $text{'feedback_title'}, "", undef, 0, 1);
-	if ($sent == 3) {
-		print &text('feedback_via', join(",", @tolist),
-			    "<tt>$in{'mailserver'}</tt>"),"\n";
-		}
-	elsif ($sent == 2) {
-		print &text('feedback_prog', join(",", @tolist),
-			    "<tt>$sendmail</tt>"),"\n";
-		}
-	else {
-		print &text('feedback_via', join(",", @tolist),
-			    "<tt>localhost</tt>"),"\n";
-		}
-	print "<p>\n";
-	&ui_print_footer("/", $text{'index'});
-
-	# Save settings in config
-	$gconfig{'feedback_name'} = $in{'name'};
-	$gconfig{'feedback_email'} = $in{'email'};
-	$gconfig{'feedback_mailserver'} =
-		$in{'mailserver_def'} ? undef : $in{'mailserver'};
-	&write_file("$config_directory/config", \%gconfig);
-	}
-else {
-	# Give up! Tell the user ..
-	&error($text{'feedback_esend'});
-	}
-
-sub send_via_smtp
-{
-local $error;
-&open_socket($_[0], 25, MAIL, \$error);
-return 0 if ($error);
-&smtp_command(MAIL) || return 0;
-&smtp_command(MAIL, "helo ".&get_system_hostname()."\r\n") || return 0;
-&smtp_command(MAIL, "mail from: <$email>\r\n") || return 0;
-foreach $t (@tolist) {
-	&smtp_command(MAIL, "rcpt to: <$t>\r\n") || return 0;
-	}
-&smtp_command(MAIL, "data\r\n");
-$mail =~ s/\r//g;
-$mail =~ s/\n/\r\n/g;
-print MAIL $mail;
-&smtp_command(MAIL, ".\r\n");
-&smtp_command(MAIL, "quit\r\n");
-close(MAIL);
-return 1;
-}
-
-# smtp_command(handle, command)
-sub smtp_command
-{
-local ($m, $c) = @_;
-print $m $c;
-local $r = <$m>;
-return $r =~ /^[23]\d+/;
-}
-
-sub short_name
-{
-$_[0] =~ /([^\\\/]+)$/;
-return $1;
-}
-

feedback_form.cgi

@@ -1,93 +0,0 @@
-#!/usr/local/bin/perl
-# feedback_form.cgi
-# Display a form so that the user can send in a webmin bug report
-
-BEGIN { push(@INC, "."); };
-use WebminCore;
-
-&init_config();
-if (&get_product_name() eq 'usermin') {
-	&switch_to_remote_user();
-	}
-&ReadParse();
-&error_setup($text{'feedback_err'});
-%access = &get_module_acl();
-$access{'feedback'} || &error($text{'feedback_ecannot'});
-&ui_print_header(undef, $text{'feedback_title'}, "", undef, 0, 1);
-
-%minfo = &get_module_info($in{'module'}) if ($in{'module'});
-$fb = $gconfig{'feedback_to'} ||
-      $minfo{'feedback'} ||
-      $webmin_feedback_address;
-print &text('feedback_desc', "<tt>$fb</tt>"),"<p>\n";
-print "<b>$text{'feedback_desc2'}</b><p>\n" if (!$gconfig{'feedback_to'});
-
-print "<form action=feedback.cgi method=post enctype=multipart/form-data>\n";
-print "<table border width=100%>\n";
-print "<tr $tb> <td><b>$text{'feedback_header'}</b></td> </tr>\n";
-print "<tr $cb> <td><table width=100%>\n";
-
-print "<tr> <td><b>$text{'feedback_name'}</b></td>\n";
-print "<td><input name=name size=25 value='$gconfig{'feedback_name'}'></td>\n";
-
-print "<td><b>$text{'feedback_email'}</b></td>\n";
-print "<td><input name=email size=25 value='$gconfig{'feedback_email'}'></td> </tr>\n";
-
-print "<tr> <td><b>$text{'feedback_module'}</b></td>\n";
-print "<td><select name=module>\n";
-printf "<option value='' %s>%s</option>\n",
-	$in{'module'} ? "" : "selected", $text{'feedback_all'};
-@modules = ( );
-foreach $minfo (&get_all_module_infos()) {
-	if (&check_os_support($minfo) &&
-	    ($minfo->{'longdesc'} || $minfo->{'feedback'})) {
-		push(@modules, $minfo);
-		}
-	}
-foreach $m (sort { $a->{'desc'} cmp $b->{'desc'} } @modules) {
-	printf "<option %s value=%s>%s</option>\n",
-		$in{'module'} eq $m->{'dir'} ? "selected" : "",
-		$m->{'dir'}, $m->{'desc'};
-	}
-print "</select></td>\n";
-
-print "<td><b>$text{'feedback_mailserver'}</b></td>\n";
-printf "<td><input type=radio name=mailserver_def value=1 %s> %s\n",
-	$gconfig{'feedback_mailserver'} ? "" : "checked",
-	$text{'feedback_mailserver_def'};
-printf "<input type=radio name=mailserver_def value=0 %s>\n",
-	$gconfig{'feedback_mailserver'} ? "checked" : "";
-printf "<input name=mailserver size=15 value='%s'></td> </tr>\n",
-	$gconfig{'feedback_mailserver'};
-
-if (!$gconfig{'nofeedbackcc'}) {
-	print "<tr> <td valign=top><b>$text{'feedback_to'}</b></td>\n";
-	print "<td colspan=3><textarea name=to rows=4 cols=50>",
-		$fb,"</textarea></td> </tr>\n";
-	}
-
-print "<tr> <td valign=top><b>$text{'feedback_text'}</b></td>\n";
-print "<td colspan=3><textarea name=text rows=6 cols=70 wrap=on>",
-      "</textarea></td> </tr>\n";
-
-print "<tr> <td colspan=2 nowrap><b>$text{'feedback_os'}</b>&nbsp;&nbsp;\n";
-printf "<input type=radio name=os value=1> $text{'yes'}\n";
-printf "<input type=radio name=os value=0 checked> $text{'no'}</td>\n";
-print "<td colspan=2>($text{'feedback_osdesc'})</td> </tr>\n";
-
-if (!$gconfig{'nofeedbackconfig'}) {
-	print "<tr> <td colspan=2 nowrap><b>$text{'feedback_config'}</b>&nbsp;&nbsp;\n";
-	printf "<input type=radio name=config value=1> $text{'yes'}\n";
-	printf "<input type=radio name=config value=0 checked> $text{'no'}</td>\n";
-	print "<td colspan=2>($text{'feedback_configdesc'})</td> </tr>\n";
-	}
-
-print "<tr> <td><b>$text{'feedback_attach'}</b></td>\n";
-print "<td><input type=file name=attach0></td>",
-      "<td colspan=2><input type=file name=attach1></td> </tr>\n";
-
-print "</table></td></tr></table>\n";
-print "<input type=submit value='$text{'feedback_send'}'></form>\n";
-
-&ui_print_footer("/", $text{'index'});
-

filemin/chattr.cgi

@@ -29,11 +29,10 @@ if (scalar(@errors) > 0) {
 	}
 else {
 	foreach my $file (split(/\0/, $in{'name'})) {
-		$file =~ s/\.\.//g;
-		$file = &simplify_path($file);
+		my $full = &validate_filename_path($file);
 		if (system_logged(
 			"chattr $recursive ".$label.
-			" ".quotemeta("$cwd/$file")
+			" ".quotemeta($full)
 			) != 0) {
 			push @errors,
 				(html_escape($file).

filemin/chcon.cgi

@@ -25,12 +25,11 @@ if (scalar(@errors) > 0) {
 	}
 else {
 	foreach my $file (split(/\0/, $in{'name'})) {
-		$file =~ s/\.\.//g;
-		$file = &simplify_path($file);
+		my $full = &validate_filename_path($file);
 		if (system_logged(
 			"chcon $recursive ".
 			quotemeta($in{'label'}).
-			" ".quotemeta("$cwd/$file")
+			" ".quotemeta($full)
 			) != 0) {
 			push @errors,
 				(html_escape($file).

filemin/chmod.cgi

@@ -9,13 +9,19 @@ get_paths();
 my @errors;
 
 my $perms = $in{'perms'};
+my @names = split(/\0/, $in{'name'});
+my @files;
+foreach my $name (@names) {
+	push(@files, [ $name, &validate_filename_path($name) ]);
+	}
 
 # Selected directories and files only
 if ($in{'applyto'} eq '1') {
-	foreach $name (split(/\0/, $in{'name'})) {
+	foreach my $file (@files) {
+		my ($name, $full) = @$file;
 		if (system_logged(
 			"chmod " . quotemeta($perms) . " " .
-			quotemeta("$cwd/$name")) != 0) {
+			quotemeta($full)) != 0) {
 			push @errors,
 				"$name - $text{'error_chmod'}: $?";
 			}
@@ -25,17 +31,18 @@ if ($in{'applyto'} eq '1') {
 # Selected files and directories and files in
 # selected directories
 if ($in{'applyto'} eq '2') {
-	foreach $name (split(/\0/, $in{'name'})) {
+	foreach my $file (@files) {
+		my ($name, $full) = @$file;
 		if (system_logged(
 			"chmod " . quotemeta($perms) . " " .
-			quotemeta("$cwd/$name")) != 0) {
+			quotemeta($full)) != 0) {
 			push @errors,
 				"$name - $text{'error_chmod'}: $?";
 			}
-		if (-d "$cwd/$name") {
+		if (-d $full) {
 			if (system_logged(
 				"find " .
-				quotemeta("$cwd/$name") .
+				quotemeta($full) .
 				" -maxdepth 1 -type f" .
 				" -exec chmod " .
 				quotemeta($perms) .
@@ -50,11 +57,12 @@ if ($in{'applyto'} eq '2') {
 
 # All (recursive)
 if ($in{'applyto'} eq '3') {
-	foreach $name (split(/\0/, $in{'name'})) {
+	foreach my $file (@files) {
+		my ($name, $full) = @$file;
 		if (system_logged(
 			"chmod -R " . quotemeta($perms) .
 			" " .
-			quotemeta("$cwd/$name")) != 0) {
+			quotemeta($full)) != 0) {
 			push @errors,
 				"$name - $text{'error_chmod'}: $?";
 			}
@@ -64,12 +72,13 @@ if ($in{'applyto'} eq '3') {
 # Selected files and files under selected directories
 # and subdirectories
 if ($in{'applyto'} eq '4') {
-	foreach $name (split(/\0/, $in{'name'})) {
-		if (-f "$cwd/$name") {
+	foreach my $file (@files) {
+		my ($name, $full) = @$file;
+		if (-f $full) {
 			if (system_logged(
 				"chmod " .
 				quotemeta($perms) . " " .
-				quotemeta("$cwd/$name")) != 0) {
+				quotemeta($full)) != 0) {
 				push @errors,
 					"$name - " .
 					"$text{'error_chmod'}: $?";
@@ -78,7 +87,7 @@ if ($in{'applyto'} eq '4') {
 		else {
 			if (system_logged(
 				"find " .
-				quotemeta("$cwd/$name") .
+				quotemeta($full) .
 				" -type f -exec chmod " .
 				quotemeta($perms) .
 				" {} \\;") != 0) {
@@ -92,19 +101,20 @@ if ($in{'applyto'} eq '4') {
 
 # Selected directories and subdirectories
 if ($in{'applyto'} eq '5') {
-	foreach $name (split(/\0/, $in{'name'})) {
-		if (-d "$cwd/$name") {
+	foreach my $file (@files) {
+		my ($name, $full) = @$file;
+		if (-d $full) {
 			if (system_logged(
 				"chmod " .
 				quotemeta($perms) . " " .
-				quotemeta("$cwd/$name")) != 0) {
+				quotemeta($full)) != 0) {
 				push @errors,
 					"$name - " .
 					"$text{'error_chmod'}: $?";
 				}
 			if (system_logged(
 				"find " .
-				quotemeta("$cwd/$name") .
+				quotemeta($full) .
 				" -type d -exec chmod " .
 				quotemeta($perms) .
 				" {} \\;") != 0) {

filemin/chown.cgi

@@ -22,6 +22,11 @@ else {
 	}
 
 my @errors;
+my @names = split(/\0/, $in{'name'});
+my @files;
+foreach my $name (@names) {
+	push(@files, [ $name, &validate_filename_path($name) ]);
+	}
 
 if (!defined($login)) {
 	push @errors,
@@ -39,10 +44,11 @@ if (scalar(@errors) > 0) {
 	print_errors(@errors);
 	}
 else {
-	foreach $name (split(/\0/, $in{'name'})) {
+	foreach my $file (@files) {
+		my ($name, $full) = @$file;
 		if (system_logged(
 			"chown $recursive $uid:$grid ".
-			quotemeta("$cwd/$name")) != 0) {
+			quotemeta($full)) != 0) {
 			push @errors,
 				"$name - " .
 				"$text{'error_chown'}: $?";

filemin/compress.cgi

@@ -10,30 +10,37 @@ if (!$in{'arch'}) {
 	}
 
 my $command;
+my $full;
+my $extension;
 
 if ($in{'method'} eq 'plain-tar') {
-	$full = "$cwd/$in{'arch'}.tar";
+	$extension = ".tar";
+	$full = &validate_filename_path($in{'arch'}.$extension);
 	$command = "tar cf ".quotemeta($full).
 		" -C ".quotemeta($cwd);
 	}
 elsif ($in{'method'} eq 'xz-tar') {
-	$full = "$cwd/$in{'arch'}.tar.xz";
+	$extension = ".tar.xz";
+	$full = &validate_filename_path($in{'arch'}.$extension);
 	$command = "tar cJf ".quotemeta($full).
 		" -C ".quotemeta($cwd);
 	}
 elsif ($in{'method'} eq 'zstd-tar') {
-	$full = "$cwd/$in{'arch'}.zst";
+	$extension = ".zst";
+	$full = &validate_filename_path($in{'arch'}.$extension);
 	$command = "ZSTD_CLEVEL=19 tar --zstd -cf ".
 		quotemeta($full).
 		" -C ".quotemeta($cwd);
 	}
 elsif ($in{'method'} eq 'tar') {
-	$full = "$cwd/$in{'arch'}.tar.gz";
+	$extension = ".tar.gz";
+	$full = &validate_filename_path($in{'arch'}.$extension);
 	$command = "tar czf ".quotemeta($full).
 		" -C ".quotemeta($cwd);
 	}
 elsif ($in{'method'} eq 'zip') {
-	$full = "$cwd/$in{'arch'}.zip";
+	$extension = ".zip";
+	$full = &validate_filename_path($in{'arch'}.$extension);
 	$command = "cd ".quotemeta($cwd).
 		" && zip -r ".quotemeta($full);
 	}
@@ -43,7 +50,10 @@ else {
 $newfile = !-e $full;
 
 foreach my $name (split(/\0/, $in{'name'})) {
-	$command .= " ".quotemeta($name);
+	my $full_name = &validate_filename_path($name);
+	my $relative_name = $full_name;
+	$relative_name =~ s/^\Q$cwd\E\/?//;
+	$command .= " ".quotemeta($relative_name);
 	}
 
 my @st = stat($cwd);

filemin/copy.cgi

@@ -5,12 +5,17 @@ require './filemin-lib.pl';
 
 get_paths();
 
+my @names = split(/\0/, $in{'name'});
+foreach $name (@names) {
+	&validate_filename_path($name);
+	}
+
 open(my $fh, ">", &get_paste_buffer_file()) or die "Error: $!";
 print $fh "copy\n";
 print $fh "$path\n";
 #$info = "Copied ".scalar(@list)." files to buffer";
 
-foreach $name (split(/\0/, $in{'name'})) {
+foreach $name (@names) {
 	print $fh "$name\n";
 	}
 

filemin/create_file.cgi

@@ -9,10 +9,11 @@ if (!$in{'name'}) {
 	&redirect("index.cgi?path=".&urlize($path));
 	return;
 	}
+my $name = $in{'name'};
+my $full = &validate_filename_path($name);
 
-my $full = "$cwd/$in{'name'}";
 if (-e $full) {
-	print_errors(&html_escape($in{'name'}).
+	print_errors(&html_escape($name).
 		" ".$text{'error_exists'});
 	}
 else {
@@ -26,7 +27,7 @@ else {
 		}
 	else {
 		print_errors($text{'error_create'}." ".
-			&html_escape($in{'name'}).
+			&html_escape($name).
 			" : ".$!);
 		}
 	}

filemin/create_folder.cgi

@@ -9,10 +9,11 @@ if (!$in{'name'}) {
 	&redirect("index.cgi?path=".&urlize($path));
 	return;
 	}
+my $name = $in{'name'};
+my $full = &validate_filename_path($name);
 
-my $full = "$cwd/$in{'name'}";
 if (-e $full) {
-	print_errors(&html_escape($in{'name'}).
+	print_errors(&html_escape($name).
 		" ".$text{'error_exists'});
 	}
 else {
@@ -25,7 +26,7 @@ else {
 		}
 	else {
 		print_errors($text{'error_create'}." ".
-			&html_escape($in{'name'}).
+			&html_escape($name).
 			" : ".$!);
 		}
 	}

filemin/cut.cgi

@@ -5,12 +5,17 @@ require './filemin-lib.pl';
 
 get_paths();
 
+my @names = split(/\0/, $in{'name'});
+foreach $name (@names) {
+	&validate_filename_path($name);
+	}
+
 open(my $fh, ">", &get_paste_buffer_file()) or die "Error: $!";
 print $fh "cut\n";
 print $fh "$path\n";
 #$info = "Copied ".scalar(@list)." files to buffer";
 
-foreach $name (split(/\0/, $in{'name'})) {
+foreach $name (@names) {
 	print $fh "$name\n";
 	}
 

filemin/delete.cgi

@@ -8,12 +8,13 @@ get_paths();
 my @errors;
 
 foreach $name (split(/\0/, $in{'name'})) {
-	if (!can_write($cwd.'/'.$name)) {
+	my $full = &validate_filename_path($name);
+	if (!can_write($full)) {
 		push @errors,
 			"$name - $text{'error_write'}";
 		next;
 		}
-	if (!&unlink_file($cwd.'/'.$name)) {
+	if (!&unlink_file($full)) {
 		push @errors,
 			"$name - $text{'error_delete'}: $!";
 		}

filemin/extract.cgi

@@ -6,52 +6,53 @@ require './filemin-lib.pl';
 
 get_paths();
 
-$archive_type = clean_mimetype($cwd.'/'.$in{'file'});
+my $name = $in{'file'};
+my $full = &validate_filename_path($name);
+$archive_type = clean_mimetype($full);
 
 if ($archive_type =~ /x-bzip/) {
 	$cmd = "tar xvjfp ".
-		quotemeta("$cwd/$in{'file'}").
+		quotemeta($full).
 		" -C ".quotemeta($cwd);
 	}
 elsif ($archive_type =~
        /x-tar|\/gzip|x-xz|zstd|x-compressed-tar/) {
 	$cmd = "tar xfp ".
-		quotemeta("$cwd/$in{'file'}").
+		quotemeta($full).
 		" -C ".quotemeta($cwd);
 	}
 elsif ($archive_type =~ /x-7z/ ||
        $archive_type =~ /x-raw-disk-image/ ||
        $archive_type =~ /x-cd-image/) {
 	$cmd = "7z x ".
-		quotemeta("$cwd/$in{'file'}").
+		quotemeta($full).
 		" -o".quotemeta($cwd);
 	}
 elsif ($archive_type =~ /\/zip/) {
 	my $unzip_out = `unzip --help`;
 	my $uu = ($unzip_out =~ /-UU/ ? '-UU' : undef);
 	$cmd = "unzip $uu -q -o ".
-		quotemeta("$cwd/$in{'file'}").
+		quotemeta($full).
 		" -d ".quotemeta($cwd);
 	}
 elsif ($archive_type =~ /\/x-rar|\/vnd\.rar/) {
 	$cmd = "unrar x -r -y ".
-		quotemeta("$cwd/$in{'file'}").
+		quotemeta($full).
 		" ".quotemeta($cwd);
 	}
 elsif ($archive_type =~ /(\/x-rpm|\/x-deb)/) {
-	my $dir = fileparse(
-		"$cwd/$name", qr/\.[^.]*/);
-	my $path = quotemeta("$cwd/$dir");
+	my ($dir) = fileparse($full, qr/\.[^.]*/);
+	my $path = &validate_filename_path($dir);
 	&make_dir($path, 0755);
 	if ($archive_type =~ /\/x-rpm/) {
 		$cmd = "(rpm2cpio ".
-			quotemeta("$cwd/$name").
+			quotemeta($full).
 			" | (cd ".quotemeta($path).
 			"; cpio -idmv))";
 		}
 	else {
 		$cmd = "dpkg -x ".
-			quotemeta("$cwd/$name").
+			quotemeta($full).
 			" ".quotemeta($path);
 		}
 	}

filemin/filemin-lib.pl

@@ -872,6 +872,73 @@ $error && &error(
 		join(" , ", @allowed_paths)) . '`.'));
 }
 
+# filemin_path_under_directory(directory, file)
+# Like is_under_directory, but permits legitimate names containing "..".
+sub filemin_path_under_directory
+{
+my ($dir, $file) = @_;
+$dir = &simplify_path($dir);
+$file = &simplify_path($file);
+return 0 if (!defined($dir) || !defined($file));
+return 1 if ($dir eq "/");
+$dir = &simplify_path(&resolve_links($dir));
+$file = &simplify_path(&resolve_links($file));
+return 0 if (!defined($dir) || !defined($file));
+return 1 if ($dir eq $file);
+$dir =~ s/\/*$/\//;
+return substr($file, 0, length($dir)) eq $dir;
+}
+
+# filemin_lexical_path_under_directory(directory, file)
+# Like filemin_path_under_directory, but does not resolve symlinks. Used before
+# the allowed-path check to make sure the submitted name was relative to the
+# current directory, while still allowing symlinks to other allowed paths.
+sub filemin_lexical_path_under_directory
+{
+my ($dir, $file) = @_;
+$dir = &simplify_path($dir);
+$file = &simplify_path($file);
+return 0 if (!defined($dir) || !defined($file));
+return 1 if ($dir eq "/");
+return 1 if ($dir eq $file);
+$dir =~ s/\/*$/\//;
+return substr($file, 0, length($dir)) eq $dir;
+}
+
+# validate_filename_path(file)
+# Returns a checked full path for a name or relative path from the current
+# directory, or calls error if it could escape the allowed paths.
+sub validate_filename_path
+{
+my ($file) = @_;
+my $display_file = defined($file) ? $file : '';
+if (!defined($file) || $file eq '' || $file =~ /[\0\r\n]/ ||
+    $file =~ m!(^|/)\.\.(?:/|$)!) {
+	&error(&text('error_invalid_filename',
+		     '<tt>'.&html_escape($display_file).'</tt>'));
+	}
+my $full = &simplify_path("$cwd/$file");
+if (!defined($full) || !&filemin_lexical_path_under_directory($cwd, $full)) {
+	&error(&text('error_invalid_filename',
+		     '<tt>'.&html_escape($display_file).'</tt>'));
+	}
+my $allowed = 0;
+foreach my $allowed_path (@allowed_paths) {
+	if (&filemin_path_under_directory($allowed_path, $full)) {
+		$allowed = 1;
+		last;
+		}
+	}
+if (!$allowed) {
+	&error(
+		&text('notallowed',
+		      '`' . &html_escape($full) . '`',
+		      '`' . &html_escape(
+			join(" , ", @allowed_paths)) . '`.'));
+	}
+return $full;
+}
+
 # clean_mimetype(file)
 # Returns the MIME type for a file, ensuring proper encoding
 sub clean_mimetype
@@ -901,10 +968,20 @@ my @errors;
 foreach my $fref (@{$files_to_extract}) {
 	my $status = -1;
 
-	my $cwd = $fref->{'path'};
+	my $extract_cwd = &simplify_path($fref->{'path'});
 	my $name = $fref->{'file'};
+	if (!defined($extract_cwd)) {
+		&error(&text('error_invalid_filename',
+			     '<tt>'.&html_escape($fref->{'path'}).'</tt>'));
+		}
+	&check_allowed_path($extract_cwd);
+	my $archive;
+	{
+	local $cwd = $extract_cwd;
+	$archive = &validate_filename_path($name);
+	}
 
-	my $extract_to = $cwd;
+	my $extract_to = $extract_cwd;
 	if (!$in{'overwrite_existing'}) {
 		my ($file_name) = $name =~ /(?|
 			(.*)\.((?|tar|wbm|wbt)\..*) |
@@ -912,26 +989,36 @@ foreach my $fref (@{$files_to_extract}) {
 			(.*)\.(?=(.*)) |
 			(.*)()
 		)/x;
-		if (!-e "$cwd/$file_name") {
-			$extract_to = "$cwd/$file_name";
+		my $candidate;
+		{
+		local $cwd = $extract_cwd;
+		$candidate = &validate_filename_path($file_name);
+		}
+		if (!-e $candidate) {
+			$extract_to = $candidate;
 			}
 		else {
 			my $__ = 1;
 			for (;;) {
 				my $new_dir_name =
 					"$file_name(" . $__++ . ")";
-				if (!-e "$cwd/$new_dir_name") {
-					$extract_to =
-						"$cwd/$new_dir_name";
+				{
+				local $cwd = $extract_cwd;
+				$candidate =
+					&validate_filename_path(
+						$new_dir_name);
+				}
+				if (!-e $candidate) {
+					$extract_to = $candidate;
 					last;
 					}
 				}
 			}
 		}
-	mkdir("$extract_to");
+	mkdir($extract_to);
 
 	my $archive_type =
-		mimetype($cwd . '/' . $name);
+		mimetype($archive);
 
 	if ($archive_type =~ /x-tar/ ||
 	    $archive_type =~ /-compressed-tar/) {
@@ -947,7 +1034,7 @@ foreach my $fref (@{$files_to_extract}) {
 		else {
 			$status = system(
 				"$tar_cmd xpf " .
-				quotemeta("$cwd/$name") .
+				quotemeta($archive) .
 				" -C " .
 				quotemeta($extract_to));
 			}
@@ -965,7 +1052,7 @@ foreach my $fref (@{$files_to_extract}) {
 		else {
 			$status = system(
 				"$tar_cmd xjfp " .
-				quotemeta("$cwd/$name") .
+				quotemeta($archive) .
 				" -C " .
 				quotemeta($extract_to));
 			}
@@ -984,7 +1071,7 @@ foreach my $fref (@{$files_to_extract}) {
 		else {
 			$status = system(
 				"$gz_cmd -d -f -k " .
-				quotemeta("$cwd/$name"));
+				quotemeta($archive));
 			}
 		}
 	elsif ($archive_type =~ /x-xz/) {
@@ -1000,7 +1087,7 @@ foreach my $fref (@{$files_to_extract}) {
 		else {
 			$status = system(
 				"$xz_cmd -d -f -k " .
-				quotemeta("$cwd/$name"));
+				quotemeta($archive));
 			}
 		}
 	elsif ($archive_type =~ /x-7z/ ||
@@ -1018,7 +1105,7 @@ foreach my $fref (@{$files_to_extract}) {
 		else {
 			$status = system(
 				"$x7z_cmd x -aoa " .
-				quotemeta("$cwd/$name") .
+				quotemeta($archive) .
 				" -o" .
 				quotemeta($extract_to));
 			}
@@ -1039,7 +1126,7 @@ foreach my $fref (@{$files_to_extract}) {
 				? '-UU' : undef);
 			$status = system(
 				"$unzip_cmd $uu -q -o " .
-				quotemeta("$cwd/$name") .
+				quotemeta($archive) .
 				" -d " .
 				quotemeta($extract_to));
 			}
@@ -1059,8 +1146,7 @@ foreach my $fref (@{$files_to_extract}) {
 			if ($unrar_cmd =~ /unar$/) {
 				$status = system(
 					"$unrar_cmd " .
-					quotemeta(
-					"$cwd/$name") .
+					quotemeta($archive) .
 					" -o " .
 					quotemeta(
 					$extract_to));
@@ -1069,8 +1155,7 @@ foreach my $fref (@{$files_to_extract}) {
 				$status = system(
 					"$unrar_cmd " .
 					"x -r -y -o+ " .
-					quotemeta(
-					"$cwd/$name") .
+					quotemeta($archive) .
 					" " .
 					quotemeta(
 					$extract_to));
@@ -1100,7 +1185,7 @@ foreach my $fref (@{$files_to_extract}) {
 		else {
 			$status = system(
 				"($rpm2cpio_cmd " .
-				quotemeta("$cwd/$name") .
+				quotemeta($archive) .
 				" | (cd " .
 				quotemeta($extract_to) .
 				"; $cpio_cmd -idmv))");
@@ -1120,14 +1205,14 @@ foreach my $fref (@{$files_to_extract}) {
 		else {
 			$status = system(
 				"$dpkg_cmd -x " .
-				quotemeta("$cwd/$name") .
+				quotemeta($archive) .
 				" " .
 				quotemeta($extract_to));
 			}
 		}
 
 	# Set permissions for all extracted files
-	my @perms = stat("$cwd/$name");
+	my @perms = stat($archive);
 	system("chown -R $perms[4]:$perms[5] " .
 		quotemeta($extract_to));
 
@@ -1136,7 +1221,7 @@ foreach my $fref (@{$files_to_extract}) {
 
 	# Delete if no error
 	if ($delete && $status == 0) {
-		unlink_file("$cwd/$name");
+		unlink_file($archive);
 		}
 	}
 return @errors;

filemin/http_download.cgi

@@ -24,7 +24,7 @@ else {
 	my $file = $page;
 	$file =~ s/^.*\///;
 	$file ||= "index.html";
-	$full = "$cwd/$file";
+	my $full = &validate_filename_path($file);
 
 	if (-e $full) {
 		push @errors,

filemin/lang/en

@@ -82,6 +82,7 @@ dialog_user_name=Remote server username
 dialog_user_pass=Remote server password
 dialog_download=Download
 error_invalid_uri=Error: No valid URL supplied!
+error_invalid_filename=Error: Invalid file name or path $1
 file_already_exists=already exists in
 files_ready_for_upload=View selected files
 errors_occured=Following errors occurred while performing operation:

filemin/paste.cgi

@@ -15,52 +15,61 @@ my $dir = $arr[1];
 chomp($act);
 chomp($dir);
 $from = abs_path($base.$dir);
-if ($cwd eq $from) {
+if (!defined($from)) {
+	print_errors($text{'error_pasting_nonsence'});
+	}
+elsif ($cwd eq $from) {
 	print_errors($text{'error_pasting_nonsence'});
 	}
 else {
+	&check_allowed_path($from);
 	my @errors;
 	for (my $i = 2; $i <= scalar(@arr) - 1; $i++) {
 		chomp($arr[$i]);
+		my $name = $arr[$i];
+		my $source;
+		{
+		local $cwd = $from;
+		$source = &validate_filename_path($name);
+		}
+		my ($target_name) = fileparse($source);
+		my $target = &validate_filename_path($target_name);
 		if ($act eq "copy") {
-			if (-e "$cwd/$arr[$i]") {
+			if (-e $target) {
 				push @errors,
-					"$cwd/$arr[$i] " .
+					"$target " .
 					"$text{'error_exists'}";
 				}
 			else {
 				system("cp -r ".
-					quotemeta(
-					"$from/$arr[$i]").
+					quotemeta($source).
 					" ".quotemeta($cwd)
 					) == 0 ||
 				push @errors,
-					"$from/$arr[$i] " .
+					"$source " .
 					"$text{'error_copy'}" .
 					" $!";
 				}
 			}
 		elsif ($act eq "cut") {
-			if (!can_move("$from/$arr[$i]",
-			    $cwd, $from)) {
+			if (!can_move($source, $from, $cwd)) {
 				push @errors,
-					"$from/$arr[$i]" .
+					"$source" .
 					" - " .
 					"$text{'error_move'}";
 				}
-			elsif (-e "$cwd/$arr[$i]") {
+			elsif (-e $target) {
 				push @errors,
-					"$cwd/$arr[$i] " .
+					"$target " .
 					"$text{'error_exists'}";
 				}
 			else {
 				system("mv ".
-					quotemeta(
-					"$from/$arr[$i]").
+					quotemeta($source).
 					" ".quotemeta($cwd)
 					) == 0 ||
 				push @errors,
-					"$from/$arr[$i] " .
+					"$source " .
 					"$text{'error_cut'}" .
 					" $!";
 				}

filemin/rename.cgi

@@ -8,21 +8,30 @@ if (!$in{'name'}) {
 	}
 
 get_paths();
-if (-e "$cwd/$in{'name'}") {
-	print_errors("$in{'name'} $text{'error_exists'}");
+my $file = $in{'file'};
+my $name = $in{'name'};
+my $from = &validate_filename_path($file);
+my $to = &validate_filename_path($name);
+if (-e $to) {
+	print_errors("$name $text{'error_exists'}");
 	}
 else {
-	if (!can_move("$cwd/$in{'file'}", $cwd)) {
+	my $from_dir = $from;
+	my $to_dir = $to;
+	$from_dir =~ s/\/[^\/]*$//;
+	$to_dir =~ s/\/[^\/]*$//;
+	$from_dir ||= "/";
+	$to_dir ||= "/";
+	if (!can_move($from, $from_dir, $to_dir)) {
 		print_errors(
-			"$in{'file'} - $text{'error_move'}");
+			"$file - $text{'error_move'}");
 		}
-	elsif (&rename_file($cwd.'/'.$in{'file'},
-		$cwd.'/'.$in{'name'})) {
+	elsif (&rename_file($from, $to)) {
 		&redirect("index.cgi?path=".
 			&urlize($path));
 		}
 	else {
 		print_errors(
-			"$text{'error_rename'} $in{'file'}: $!");
+			"$text{'error_rename'} $file: $!");
 		}
 	}

filemin/setfacl.cgi

@@ -56,15 +56,16 @@ my $args = quotemeta($action).
 $args =~ s/\s+/ /g;
 $args = &trim($args);
 foreach my $file (@files) {
-	my $qfile = quotemeta("$cwd/$file");
-	next if (!-r "$cwd/$file");
+	my $full = &validate_filename_path($file);
+	my $qfile = quotemeta($full);
+	next if (!-r $full);
 	my $fullcmd = "$cmd $args $qfile";
 	my $out = &backquote_logged(
 		"$fullcmd 2>&1 >/dev/null </dev/null");
 	if ($?) {
 		$out =~ s/^setfacl: //;
 		&error(&html_escape(
-			"$cmd $args $cwd/$file : $out"));
+			"$cmd $args $full : $out"));
 		}
 	}
 

filemin/upload.cgi

@@ -54,6 +54,7 @@ MAINLOOP: while (index($line, "$boundary--") == -1) {
 		}
 
 	if (defined($file)) {
+		my $full = &upload_full_path($file);
 		my @st = stat($cwd);
 		# If we have a dir, parse it and create a
 		# sub-tree first
@@ -99,18 +100,21 @@ MAINLOOP: while (index($line, "$boundary--") == -1) {
 					}
 				foreach my $updir (@dirs) {
 					$dir .= "$updir/";
-					if (!-e "$cwd$dir") {
-						mkdir("$cwd$dir");
+					my $fulldir =
+						&upload_full_path($dir);
+					if (!-e $fulldir) {
+						mkdir($fulldir);
 						set_ownership_permissions(
 							$st[4], $st[5],
-							undef, "$cwd$dir");
+							undef, $fulldir);
 						}
 					}
 				}
 			}
 		# In case of a regular file check for dupes
+		$full = &upload_full_path($file);
 		if (!$in{'overwrite_existing'}) {
-			if ($file && -e "$cwd/$file") {
+			if ($file && -e $full) {
 				# If the file exists, add a suffix
 				my ($file_name,
 				    $file_extension) =
@@ -138,7 +142,7 @@ MAINLOOP: while (index($line, "$boundary--") == -1) {
 			}
 
 		# OK, we have a file, let's save it
-		my $full = "$cwd/$file";
+		$full = &upload_full_path($file);
 		my $newfile = !-e $full;
 		if (!open(OUTFILE, ">$full")) {
 			push @errors,
@@ -250,3 +254,11 @@ if (scalar(@errors) > 0) {
 else {
 	&redirect("index.cgi?path=" . &urlize($path));
 	}
+
+# upload_full_path(file)
+# Returns a fully resolved upload path, or fails if it leaves allowed paths.
+sub upload_full_path
+{
+my ($file) = @_;
+return &validate_filename_path($file);
+}

grub2/acl_security.pl

@@ -0,0 +1,43 @@
+use strict;
+use warnings;
+no warnings 'redefine';
+no warnings 'uninitialized';
+
+do 'grub2-lib.pl';
+
+our (%in, %text);
+
+# acl_security_form(&options)
+# Outputs HTML for editing security options for the GRUB 2 module.
+sub acl_security_form
+{
+my ($o) = @_;
+# View permissions
+print &ui_table_row($text{'acl_view'},
+		    &ui_yesno_radio("view", $o->{'view'}), 3);
+print &ui_table_hr();
+# Change permissions modify GRUB configuration without granting install rights.
+foreach my $a (qw(edit security apply runtime)) {
+	print &ui_table_row($text{'acl_'.$a},
+			    &ui_yesno_radio($a, $o->{$a}), 3);
+	}
+print &ui_table_hr();
+# Admin permissions expose direct file editing, backup, and boot-loader install.
+foreach my $a (qw(manual install backup)) {
+	print &ui_table_row($text{'acl_'.$a},
+			    &ui_yesno_radio($a, $o->{$a}), 3);
+	}
+}
+
+# acl_security_save(&options)
+# Parses the form for security options for the GRUB 2 module.
+sub acl_security_save
+{
+my ($o) = @_;
+foreach my $a (qw(view edit security apply runtime manual install backup)) {
+	# Missing checkbox/radio values fall back to denied.
+	$o->{$a} = $in{$a} || 0;
+	}
+}
+
+1;

grub2/backup_config.pl

@@ -0,0 +1,13 @@
+use strict;
+use warnings;
+
+do 'grub2-lib.pl';
+
+# backup_config_files()
+# Returns GRUB 2 files and directories that can be backed up.
+sub backup_config_files
+{
+return &grub2_config_files();
+}
+
+1;

grub2/config

@@ -0,0 +1,19 @@
+default_file=/etc/default/grub
+grub_cfg=/boot/grub/grub.cfg
+grub_dir=/etc/grub.d
+custom_file=/etc/grub.d/40_custom
+password_file=/etc/grub.d/01_webmin_password
+color_file=/etc/grub.d/06_webmin_colors
+theme_dir=/boot/grub/themes
+background_dir=/boot/grub/backgrounds
+grubenv_file=/boot/grub/grubenv
+bls_dir=/boot/loader/entries
+mkconfig_cmd=/usr/sbin/grub-mkconfig
+install_cmd=/usr/sbin/grub-install
+set_default_cmd=/usr/sbin/grub-set-default
+reboot_once_cmd=/usr/sbin/grub-reboot
+editenv_cmd=/usr/bin/grub-editenv
+script_check_cmd=/usr/bin/grub-script-check
+mkpasswd_cmd=/usr/bin/grub-mkpasswd-pbkdf2
+grubby_cmd=/usr/sbin/grubby
+shell_cmd=/bin/sh

grub2/config-debian-linux

@@ -0,0 +1,19 @@
+default_file=/etc/default/grub
+grub_cfg=/boot/grub/grub.cfg
+grub_dir=/etc/grub.d
+custom_file=/etc/grub.d/40_custom
+password_file=/etc/grub.d/01_webmin_password
+color_file=/etc/grub.d/06_webmin_colors
+theme_dir=/boot/grub/themes
+background_dir=/boot/grub/backgrounds
+grubenv_file=/boot/grub/grubenv
+bls_dir=/boot/loader/entries
+mkconfig_cmd=/usr/sbin/grub-mkconfig
+install_cmd=/usr/sbin/grub-install
+set_default_cmd=/usr/sbin/grub-set-default
+reboot_once_cmd=/usr/sbin/grub-reboot
+editenv_cmd=/usr/bin/grub-editenv
+script_check_cmd=/usr/bin/grub-script-check
+mkpasswd_cmd=/usr/bin/grub-mkpasswd-pbkdf2
+grubby_cmd=/usr/sbin/grubby
+shell_cmd=/bin/sh

grub2/config-openSUSE-Linux-15.0-ALL

@@ -0,0 +1,19 @@
+default_file=/etc/default/grub
+grub_cfg=/boot/grub2/grub.cfg
+grub_dir=/etc/grub.d
+custom_file=/etc/grub.d/40_custom
+password_file=/etc/grub.d/01_webmin_password
+color_file=/etc/grub.d/06_webmin_colors
+theme_dir=/boot/grub2/themes
+background_dir=/boot/grub2/backgrounds
+grubenv_file=/boot/grub2/grubenv
+bls_dir=/boot/loader/entries
+mkconfig_cmd=/usr/sbin/grub2-mkconfig
+install_cmd=/usr/sbin/grub2-install
+set_default_cmd=/usr/sbin/grub2-set-default
+reboot_once_cmd=/usr/sbin/grub2-reboot
+editenv_cmd=/usr/bin/grub2-editenv
+script_check_cmd=/usr/bin/grub2-script-check
+mkpasswd_cmd=/usr/bin/grub2-mkpasswd-pbkdf2
+grubby_cmd=/usr/sbin/grubby
+shell_cmd=/bin/sh

grub2/config-redhat-linux

@@ -0,0 +1,19 @@
+default_file=/etc/default/grub
+grub_cfg=/boot/grub2/grub.cfg
+grub_dir=/etc/grub.d
+custom_file=/etc/grub.d/40_custom
+password_file=/etc/grub.d/01_webmin_password
+color_file=/etc/grub.d/06_webmin_colors
+theme_dir=/boot/grub2/themes
+background_dir=/boot/grub2/backgrounds
+grubenv_file=/boot/grub2/grubenv
+bls_dir=/boot/loader/entries
+mkconfig_cmd=/usr/sbin/grub2-mkconfig
+install_cmd=/usr/sbin/grub2-install
+set_default_cmd=/usr/sbin/grub2-set-default
+reboot_once_cmd=/usr/sbin/grub2-reboot
+editenv_cmd=/usr/bin/grub2-editenv
+script_check_cmd=/usr/bin/grub2-script-check
+mkpasswd_cmd=/usr/bin/grub2-mkpasswd-pbkdf2
+grubby_cmd=/usr/sbin/grubby
+shell_cmd=/bin/sh

grub2/config-suse-linux

@@ -0,0 +1,19 @@
+default_file=/etc/default/grub
+grub_cfg=/boot/grub2/grub.cfg
+grub_dir=/etc/grub.d
+custom_file=/etc/grub.d/40_custom
+password_file=/etc/grub.d/01_webmin_password
+color_file=/etc/grub.d/06_webmin_colors
+theme_dir=/boot/grub2/themes
+background_dir=/boot/grub2/backgrounds
+grubenv_file=/boot/grub2/grubenv
+bls_dir=/boot/loader/entries
+mkconfig_cmd=/usr/sbin/grub2-mkconfig
+install_cmd=/usr/sbin/grub2-install
+set_default_cmd=/usr/sbin/grub2-set-default
+reboot_once_cmd=/usr/sbin/grub2-reboot
+editenv_cmd=/usr/bin/grub2-editenv
+script_check_cmd=/usr/bin/grub2-script-check
+mkpasswd_cmd=/usr/bin/grub2-mkpasswd-pbkdf2
+grubby_cmd=/usr/sbin/grubby
+shell_cmd=/bin/sh

grub2/config.info

@@ -0,0 +1,21 @@
+line1=Configuration files,11
+default_file=GRUB default settings file,0
+grub_cfg=Generated GRUB menu file,0
+grub_dir=GRUB script directory,0
+custom_file=Custom GRUB menu entries file,3,None
+password_file=Webmin-managed GRUB password script,3,None
+color_file=Webmin-managed GRUB color script,3,None
+theme_dir=GRUB theme installation directory,3,None
+background_dir=GRUB background image installation directory,3,None
+grubenv_file=GRUB environment file,3,None
+bls_dir=Boot Loader Specification entries directory,3,None
+line2=Executables,11
+mkconfig_cmd=Command to generate the GRUB menu file,0
+install_cmd=Command to install the GRUB boot loader,3,None
+set_default_cmd=Command to set the saved default entry,3,None
+reboot_once_cmd=Command to set the next boot entry,3,None
+editenv_cmd=Command to inspect the GRUB environment,3,None
+script_check_cmd=Command to validate GRUB scripts,3,None
+mkpasswd_cmd=Command to generate GRUB PBKDF2 password hashes,3,None
+grubby_cmd=Command to update BLS kernel options,3,None
+shell_cmd=Shell used to validate the default settings file,0

grub2/custom_action.cgi

@@ -0,0 +1,55 @@
+#!/usr/local/bin/perl
+# Apply an action to selected custom GRUB 2 entries.
+
+use strict;
+use warnings;
+require './grub2-lib.pl';    ## no critic
+
+our (%in, %text);
+
+&ReadParse();
+&error_setup($text{'custom_err'});
+my %access = &get_module_acl();
+&error("$text{'eacl_np'} $text{'eacl_pmanual'}") if (!$access{'manual'});
+
+# Per-row up/down links post an index and direction directly.
+if (defined($in{'idx'}) || defined($in{'dir'})) {
+	defined($in{'idx'}) && $in{'idx'} =~ /^\d+\z/ ||
+		&error($text{'custom_eentry'});
+	# Keep movement inside one submenu by leaving it to the library helper.
+	defined($in{'dir'}) && $in{'dir'} =~ /^(up|down)\z/ ||
+		&error($text{'custom_emove'});
+	my $err = &grub2_move_custom_entry($in{'idx'}, $in{'dir'});
+	&error($err) if ($err);
+	&grub2_mark_regenerate_needed();
+	&webmin_log("custom_move", undef, $in{'idx'});
+	&redirect("index.cgi?mode=custom");
+	}
+
+# Checked-table actions can receive duplicate browser values; collapse them.
+my @selected = split(/\0/, defined($in{'d'}) ? $in{'d'} : "");
+my %seen;
+@selected = grep { defined($_) && $_ ne '' && !$seen{$_}++ } @selected;
+
+my $err;
+# Delete accepts multiple selected entries and removes them in one rewrite.
+if ($in{'delete'}) {
+	@selected || &error($text{'delete_enone'});
+	$err = &grub2_delete_custom_entry_indexes(@selected);
+	&error($err) if ($err);
+	&grub2_mark_regenerate_needed();
+	&webmin_log("custom_delete", undef, scalar(@selected));
+	}
+elsif ($in{'move_up'} || $in{'move_down'}) {
+	# Bulk move buttons are only safe for one entry at a time.
+	@selected == 1 || &error($text{'custom_eone'});
+	$err = &grub2_move_custom_entry($selected[0],
+		$in{'move_up'} ? "up" : "down");
+	&error($err) if ($err);
+	&grub2_mark_regenerate_needed();
+	&webmin_log("custom_move", undef, $selected[0]);
+	}
+else {
+	&error($text{'runtime_eaction'});
+	}
+&redirect("index.cgi?mode=custom");

grub2/defaultacl

@@ -0,0 +1,8 @@
+view=1
+edit=1
+security=1
+apply=1
+runtime=1
+manual=1
+install=1
+backup=1

grub2/edit_custom.cgi

@@ -0,0 +1,46 @@
+#!/usr/local/bin/perl
+# Show a form for adding or editing a custom GRUB 2 menu entry.
+
+use strict;
+use warnings;
+require './grub2-lib.pl';    ## no critic
+
+our (%in, %text);
+
+&ReadParse();
+&error_setup($text{'custom_err'});
+my %access = &get_module_acl();
+&error("$text{'eacl_np'} $text{'eacl_pmanual'}") if (!$access{'manual'});
+
+my $is_new = !defined($in{'idx'}) || $in{'idx'} eq '';
+my ($title, $id, $body) =
+	("", "", "echo 'Custom entry not configured'\ntrue\n");
+# Existing entries are looked up by parsed custom-entry index, not line number.
+if (!$is_new) {
+	$in{'idx'} =~ /^\d+\z/ || &error($text{'custom_eentry'});
+	my $entry = &grub2_custom_entry_by_index($in{'idx'});
+	&error($text{'custom_eentry'}) if (!$entry);
+	$title = $entry->{'title'} || "";
+	$id = $entry->{'id'} || "";
+	$body = &grub2_custom_entry_body($entry);
+	}
+
+&ui_print_header(undef, $is_new ? $text{'custom_title_new'} :
+		 $text{'custom_title_edit'}, "");
+
+print &ui_form_start("save_custom.cgi", "post");
+print &ui_hidden("idx", $in{'idx'}) if (!$is_new);
+print &ui_table_start($text{'custom_header'}, "width=100%", 2);
+print &ui_table_row(&hlink($text{'custom_entry_title'}, "custom_title"),
+		    &ui_textbox("title", $title, 60));
+print &ui_table_row(&hlink($text{'custom_entry_id'}, "custom_id"),
+		    &ui_textbox("id", $id, 60).
+		    &ui_tag('div', &ui_note($text{'custom_id_note'}, 0)));
+print &ui_table_hr();
+# The body is stored as GRUB script text inside a generated menuentry wrapper.
+print &ui_table_row(&hlink($text{'custom_entry_body'}, "custom_body"),
+		    &ui_textarea("body", $body, 16, 100), 2);
+print &ui_table_end();
+print &ui_form_end([ [ undef, $text{'save'} ] ]);
+
+&ui_print_footer("index.cgi?mode=custom", $text{'index_return'});

grub2/edit_defaults.cgi

@@ -0,0 +1,156 @@
+#!/usr/local/bin/perl
+# Show a form for editing common GRUB 2 defaults.
+
+use strict;
+use warnings;
+require './grub2-lib.pl';    ## no critic
+
+our (%text);
+
+&ReadParse();
+&error_setup($text{'defaults_err'});
+my %access = &get_module_acl();
+&error("$text{'eacl_np'} $text{'eacl_pedit'}") if (!$access{'edit'});
+
+my $parsed = &read_grub_defaults();
+my $values = $parsed->{'values'};
+my @entries = &grub2_boot_entries();
+
+&ui_print_header(undef, $text{'defaults_title'}, "");
+
+# BLS warnings explain when edits also need grubby or existing entry updates.
+foreach my $warning (&grub2_bls_kernel_option_warnings(\@entries)) {
+	print &ui_alert($warning, 'warning');
+	}
+
+print &ui_form_start("save_defaults.cgi", "post");
+print &ui_table_start($text{'defaults_header'}, "width=100%", 2);
+print &ui_table_row(
+	&hlink($text{'defaults_default'}, "default"),
+	&default_entry_input(&field_value($values->{'GRUB_DEFAULT'}, "0"),
+			     \@entries),
+2, undef, undef, 1);
+print &ui_table_hr();
+print &ui_table_row(
+	&hlink($text{'defaults_timeout_style'}, "timeout_style"),
+	&ui_select("timeout_style", &field_value($values->{'GRUB_TIMEOUT_STYLE'}),
+		[
+			[ "", $text{'defaults_keep'} ],
+			[ "menu", $text{'defaults_menu'} ],
+			[ "hidden", $text{'defaults_hidden'} ],
+			[ "countdown", $text{'defaults_countdown'} ],
+		])
+);
+print &ui_table_row(
+	&hlink($text{'defaults_timeout'}, "timeout"),
+	&ui_textbox("timeout", &field_value($values->{'GRUB_TIMEOUT'}), 8)
+);
+print &ui_table_row(
+	&hlink($text{'defaults_kernelopts_source'}, "kernelopts_source"),
+	&html_escape(&grub2_kernel_options_source_text(\@entries))
+);
+# Recovery is special on BLS systems because rescue entries are separate files.
+print &ui_table_row(
+	&hlink($text{'defaults_disable_recovery'}, "disable_recovery"),
+	&bool_select("disable_recovery", $values->{'GRUB_DISABLE_RECOVERY'}).
+	(&grub2_has_bls_rescue_entries() ?
+		&ui_tag('div', &ui_note($text{'defaults_disable_recovery_bls'}, 0)) :
+		"")
+);
+print &ui_table_row(
+	&hlink($text{'defaults_disable_os_prober'}, "disable_os_prober"),
+	&bool_select("disable_os_prober", $values->{'GRUB_DISABLE_OS_PROBER'})
+);
+print &ui_table_hr();
+print &ui_table_row(
+	&hlink($text{'defaults_cmdline_default'}, "cmdline_default"),
+	&ui_textbox("cmdline_default",
+		    &field_value($values->{'GRUB_CMDLINE_LINUX_DEFAULT'}), 30,
+		    undef, undef, undef, "w-100")
+);
+print &ui_table_row(
+	&hlink($text{'defaults_cmdline'}, "cmdline"),
+	&ui_textbox("cmdline", &field_value($values->{'GRUB_CMDLINE_LINUX'}), 70,
+		    undef, undef, undef, "w-100")
+);
+print &ui_table_end();
+print &ui_form_end([ [ undef, $text{'save'} ] ]);
+
+&ui_print_footer("index.cgi", $text{'index_return'});
+
+# default_entry_input(value, &entries)
+# Returns a selector for known boot entries.
+sub default_entry_input
+{
+my ($value, $entries) = @_;
+my ($select_value, $options) = &default_entry_options($value, $entries);
+return &ui_select("default", $select_value, $options, undef, undef, undef,
+		  undef, 'style="field-sizing: content; max-width: 100%;"');
+}
+
+# default_entry_options(value, &entries)
+# Returns select value and options for the default entry field.
+sub default_entry_options
+{
+my ($current, $entries) = @_;
+$current = '0' if (!defined($current) || $current eq '');
+my @options;
+my %seen;
+my $add = sub {
+	my ($value, $label) = @_;
+	# Avoid duplicate selectors when GRUB_DEFAULT already names an entry.
+	return if (!defined($value) || $value eq '' || $seen{$value}++);
+	push(@options, [ $value, $label ]);
+	};
+$add->('saved', $text{'defaults_default_saved'});
+if ($current =~ /^\d+\z/ && $entries->[$current]) {
+	# Keep numeric defaults meaningful by showing the currently indexed entry.
+	$add->($current, &text('defaults_default_current_entry', $current,
+			       &default_entry_label($entries->[$current])));
+	}
+foreach my $entry (@$entries) {
+	my $selector = &grub2_entry_selector($entry);
+	next if (!defined($selector) || $selector eq '');
+	$add->($selector, &default_entry_label($entry));
+	}
+if ($current ne '' && !$seen{$current}) {
+	# Preserve unusual existing values without allowing arbitrary new input.
+	$add->($current, &text('defaults_default_current', $current));
+	}
+my $select_value = $seen{$current} ? $current : $options[0]->[0];
+return ($select_value, \@options);
+}
+
+# default_entry_label(&entry)
+# Returns a concise label for one parsed generated boot entry.
+sub default_entry_label
+{
+my ($entry) = @_;
+my @path = @{$entry->{'path'} || []};
+my $label = join(' > ', (@path, $entry->{'title'} || ''));
+return &text('defaults_default_entry_id', $label, $entry->{'id'})
+	if (defined($entry->{'id'}) && $entry->{'id'} ne '');
+return $label;
+}
+
+# bool_select(name, value)
+# Returns a tri-state selector for GRUB true/false settings.
+sub bool_select
+{
+my ($name, $value) = @_;
+$value = '' if (!defined($value) || $value !~ /^(true|false)\z/);
+return &ui_select($name, $value,
+	[
+		[ "", $text{'defaults_keep'} ],
+		[ "true", $text{'defaults_true'} ],
+		[ "false", $text{'defaults_false'} ],
+	]);
+}
+
+# field_value(value, [default])
+# Returns a form value without treating the string 0 as empty.
+sub field_value
+{
+my ($value, $default) = @_;
+return defined($value) ? $value : ($default || '');
+}