Update labels for accuracy and clarity

[no-build] [no-review]

CHANGELOG.md

@@ -1,4 +1,36 @@
 ## Changelog
+#### 2.660 (August 20, 2026)
+* Add support for creating `vfsv1` Linux quota files for limits above 4 TiB, while preserving existing quota file formats
+* Add Btrfs subvolume quota management to the Disk Quotas module, with full and simple accounting modes
+* Add support for openSUSE 16 vendor and local Logrotate configuration overlays [#2682](https://github.com/webmin/webmin/issues/2682)
+* Add support for applying multiple patches at once with the `patch` sub-command
+* Add APT package hold management to the Package Updates module
+* Add an option to send scheduled package update email only when new updates are found [forum.virtualmin.com/t/137796](https://forum.virtualmin.com/t/can-we-make-security-updates-email-less-chatty/137796)
+* Add incremental ban time options to the Fail2Ban module
+* Fix Webmin server connections that open but never send a request, preventing them from waiting indefinitely [#2815](https://github.com/webmin/webmin/pull/2815)
+* Fix to ignore failures when adding IPv6 link-local (fe80\:\:) addresses that may already be configured automatically
+* Fixed creation of permissions new log files in the System Logs module (thanks to Kevin Carter)
+* Fix automatic reply message and reply tracking to keep working after a user's home directory changes in Usermin [#126](https://github.com/webmin/usermin/issues/126)
+* Fix custom reply tracking file being reset to the default when editing an automatic reply in Usermin
+* Fix Fail2Ban jail editor to correctly separate actions when one has no parameters [#2718](https://github.com/webmin/webmin/issues/2718)
+* Fix to honor the editable users ACL in the group member chooser in Users and Groups module [#2464](https://github.com/webmin/webmin/issues/2464)
+* Update the Authentic theme to the latest version with various improvements:
+  - Fix change detection and submission for forms using grouped bottom action buttons
+  - Fix login page front side clipping and flip animation for long welcome messages
+  - Fix opening the wrong directory in Terminal for domain owners in File Manager
+  - Fix disallowed entry handling in File Manager [forum.virtualmin.com/t/137654](https://forum.virtualmin.com/t/extra-admin-file-manager-permissions/137654?u=ilia)
+  - Fix inline images not displaying when printing emails in Usermin
+  - Fix various styling issues for ConfigServer Security & Firewall
+  - Fix navigation detection for the new Virtualmin Podman plugin
+  - Fix bottom page action buttons wrapping and alignment
+  - Fix errors for Webmin-only users in File Manager
+
+#### 2.653 (July 26, 2026)
+* Fix to include missing `xmlrpc-lib.pl` file in the package
+* Fix listing partially installed Debian and derivative packages
+* Update the Authentic theme to the latest version with various improvements:
+  - Add improved support for the upcoming Virtualmin Podman plugin
+  - Fix mail compose panel styling and sizing on initial load in Usermin
 
 #### 2.652 (July 16, 2026)
 * Add a global per-user ACL control to block URL downloads from non-public IP addresses in File Manager, Mailboxes, and Upload and Download modules

backup-config/backup.pl

@@ -76,10 +76,15 @@ if (($err || $backup->{'emode'} == 0) && $backup->{'email'}) {
 		       $postmsg;
 		$subject = &text('email_sok', $host);
 		}
+	my $email = $backup->{'email'};
+	if ($email eq '*') {
+		$email = $gconfig{'webmin_email_to'};
+		if ($email && $gconfig{'webmin_email_to_name'}) {
+			$email = "$gconfig{'webmin_email_to_name'} <$email>";
+			}
+		}
 	&mailboxes::send_text_mail(
 		$config{'from_addr'} || &mailboxes::get_from_address(),
-		$backup->{'email'} eq '*' ? $gconfig{'webmin_email_to'}
-					  : $backup->{'email'},
-		undef, $subject, $msg);
+		$email, undef, $subject, $msg);
 	}
 

bacula-backup/bacula-backup-lib.pl

@@ -165,6 +165,15 @@ if (!defined($config_file_cache{$file})) {
 				       'parent' => $parent };
 			push(@{$parent->{'members'}}, $dir);
 
+			# A line like "Include = {" starts a section, rather
+			# than setting the value to a brace. The brace must be
+			# unquoted, so that a real value of "{" is preserved
+			if ($dir->{'value'} eq "{" && $rest !~ /\S/ &&
+			    /=\s*\{\s*$/) {
+				$dir->{'value'} = undef;
+				$rest = "{";
+				}
+
 			if ($rest =~ /\s*{\s*$/) {
 				# Also start of a section!
 				$dir->{'type'} = 2;

bacula-backup/save_fileset.cgi

@@ -72,13 +72,13 @@ else {
 
 	# Save compression level
 	if ($in{'comp'}) {
-		&save_directive($conf, $opts, "Compression", $in{'comp'}, 1);
+		&save_directive($conf, $opts, "Compression", $in{'comp'}, 3);
 		}
 	else {
 		&save_directive($conf, $opts, "Compression", undef);
 		}
 
-	&save_directive($conf, $opts, "OneFS", $in{'onefs'} || undef, 1);
+	&save_directive($conf, $opts, "OneFS", $in{'onefs'} || undef, 3);
 
 	# Create or update
 	if ($in{'new'}) {

bin/passwd

@@ -19,6 +19,8 @@ sub main
                'config|c=s'   => \$opt{'config'},
                'user|u=s'     => \$opt{'user'},
                'password|p=s' => \$opt{'password'},
+               'unix'         => \$opt{'unix'},
+               'webmin-only|webmin' => \$opt{'webmin'},
                'stdout|o!'    => \$opt{'stdout'});
 
     # If username passed as regular param
@@ -135,6 +137,29 @@ sub change_password
             RESET,         "\n");
     }
 
+    # A Webmin user can either authenticate as a Unix user or have a separate
+    # password in miniserv.users. Make this distinction explicit whenever both
+    # accounts exist, as silently setting the latter overrides Unix
+    # authentication and leaves SSH and Webmin with different passwords.
+    my @unix_info = getpwnam($user);
+    my $target = choose_password_target(
+        $optref, $user, scalar(@unix_info));
+    if ($target eq 'unix') {
+        change_unix_password($user);
+
+        # Ensure Webmin uses the newly changed Unix password. No restart is
+        # needed when the account was already configured this way.
+        if (($uinfos{$user}->[0] // '') ne 'x') {
+            $uinfos{$user}->[0] = 'x';
+            map {$ulines{$_} = join(":", @{ $uinfos{$_} })} keys %uinfos;
+            store_webmin_users(
+                $confdif, $minserv_uconf_file, \%ulines);
+        }
+        say "Unix password for user ", BRIGHT_YELLOW, $user, RESET,
+            " updated successfully; Webmin will use Unix authentication";
+        exit 0;
+    }
+
     # Ask for password on stdin
     my $suc_pre_msg = "";
     my $suc_msg     = 'updated successfully';
@@ -171,13 +196,8 @@ sub change_password
     $uinfos{$user}->[5] = time() if ($uinfos{$user}->[5]);
     map {$ulines{$_} = join(":", @{ $uinfos{$_} })} keys %uinfos;
 
-    # Store original file first
-    copy_source_dest($minserv_uconf_file, "$minserv_uconf_file-");
-
-    # Restart Webmin and write new user config file
-    system("$confdif/stop >/dev/null 2>&1");
-    write_file($minserv_uconf_file, \%ulines, ":");
-    system("$confdif/start >/dev/null 2>&1");
+    # Write the new user config and restart Webmin
+    store_webmin_users($confdif, $minserv_uconf_file, \%ulines);
 
     # Print user message
     say "${suc_pre_msg}Password for Webmin user ", BRIGHT_YELLOW, $user, RESET, " $suc_msg";
@@ -185,6 +205,119 @@ sub change_password
     exit 0;
 }
 
+sub choose_password_target
+{
+    my ($optref, $user, $unix_exists, $interactive) = @_;
+
+    die BRIGHT_RED, "Error: ", RESET,
+        "The --unix and --webmin-only options cannot be used together\n"
+        if ($optref->{'unix'} && $optref->{'webmin'});
+    die BRIGHT_RED, "Error: ", RESET,
+        "The --unix and --stdout options cannot be used together\n"
+        if ($optref->{'unix'} && $optref->{'stdout'});
+    die BRIGHT_RED, "Error: ", RESET,
+        "The --unix and --password options cannot be used together; ",
+        "the system passwd command reads the password securely\n"
+        if ($optref->{'unix'} && defined($optref->{'password'}));
+    die BRIGHT_RED, "Error: ", RESET, "Unix user ", BRIGHT_YELLOW,
+        $user, RESET, " doesn't exist\n"
+        if ($optref->{'unix'} && !$unix_exists);
+
+    return 'webmin' if ($optref->{'stdout'} || !$unix_exists);
+    return 'unix' if ($optref->{'unix'});
+    return 'webmin' if ($optref->{'webmin'});
+    if (defined($optref->{'password'})) {
+        print STDERR unix_password_warning($user),
+            " The --password option explicitly sets a separate Webmin-only ",
+            "password; use --unix without --password to change the Unix ",
+            "password instead.\n";
+        return 'webmin';
+    }
+
+    $interactive = -t STDIN if (!defined($interactive));
+    if ($interactive) {
+        return prompt_password_target($user);
+    }
+
+    print STDERR unix_password_warning($user),
+        " Non-interactive input prevents asking which password to change; ",
+        "continuing with a separate Webmin-only password. Pass --unix or ",
+        "--webmin-only to select explicitly.\n";
+    return 'webmin';
+}
+
+sub prompt_password_target
+{
+    my ($user) = @_;
+    say unix_password_warning($user);
+    say "  1. Change the Unix password and use Unix authentication in Webmin",
+        " (recommended)";
+    say "  2. Set a separate Webmin-only password in miniserv.users";
+
+    while (1) {
+        print "Select password type [1]: ";
+        my $choice = <STDIN>;
+        die BRIGHT_RED, "\nError: ", RESET,
+            "No password type was selected\n" if (!defined($choice));
+        chomp $choice;
+        $choice = lc($choice);
+        return 'unix' if ($choice eq '' || $choice eq '1' ||
+                          $choice eq 'u' || $choice eq 'unix');
+        return 'webmin' if ($choice eq '2' || $choice eq 'w' ||
+                            $choice eq 'webmin');
+        say BRIGHT_RED, "Invalid selection.", RESET,
+            " Enter 1 for Unix or 2 for Webmin-only.";
+    }
+}
+
+sub unix_password_warning
+{
+    my ($user) = @_;
+    return BRIGHT_YELLOW . "Warning: " . RESET . "Webmin user " .
+        BRIGHT_YELLOW . $user . RESET .
+        " is also a Unix user. A separate Webmin password overrides Unix " .
+        "authentication, so Webmin and SSH can have different passwords.";
+}
+
+sub change_unix_password
+{
+    my ($user) = @_;
+    my $passwd = has_command('passwd');
+    die BRIGHT_RED, "Error: ", RESET,
+        "The system passwd command could not be found\n" if (!$passwd);
+    die BRIGHT_RED, "Error: ", RESET,
+        "Changing a Unix password requires an interactive terminal. ",
+        "Run ", BRIGHT_YELLOW, "$passwd $user", RESET, " directly instead.\n"
+        if (!-t STDIN);
+
+    my $status = system { $passwd } $passwd, $user;
+    if ($status == -1) {
+        die BRIGHT_RED, "Error: ", RESET,
+            "Failed to run $passwd: $!\n";
+    }
+    elsif ($status & 127) {
+        die BRIGHT_RED, "Error: ", RESET,
+            "The system passwd command was interrupted\n";
+    }
+    elsif ($status >> 8) {
+        die BRIGHT_RED, "Error: ", RESET,
+            "The system passwd command failed\n";
+    }
+}
+
+sub store_webmin_users
+{
+    my ($confdif, $minserv_uconf_file, $ulines) = @_;
+
+    # Store original file first
+    copy_source_dest($minserv_uconf_file, "$minserv_uconf_file-");
+
+    # Restart Webmin and write new user config file
+    system("$confdif/stop >/dev/null 2>&1");
+    write_file($minserv_uconf_file, $ulines, ":");
+    system("$confdif/start >/dev/null 2>&1");
+}
+
 sub root
 {
     my ($config, $conf_check) = @_;
@@ -221,7 +354,9 @@ sub root
 
 =head1 DESCRIPTION
 
- This program allows you to change the password of a user in the Webmin password file
+ This program allows you to change the password used by a Webmin user.
+ When a matching Unix user exists, it can change the Unix password or set a
+ separate password in the Webmin password file.
 
 =head1 SYNOPSIS
 
@@ -238,8 +373,10 @@ sub root
  Examples of usage:
   - webmin passwd root
   - webmin passwd --user root
-  - webmin passwd --user root --password ycwyMQRVAZY
-  - webmin passwd --config /usr/local/etc/webmin --user root --password ycwyMQRVAZY
+  - webmin passwd --user root --unix
+  - webmin passwd --user admin --webmin-only
+  - webmin passwd --user admin --webmin-only --password ycwyMQRVAZY
+  - webmin passwd --config /usr/local/etc/webmin --user admin --webmin-only --password ycwyMQRVAZY
   - webmin passwd --config /usr/local/etc/webmin --user root --password ycwyMQRVAZY --stdout
 
 =item --config, -c
@@ -252,7 +389,19 @@ sub root
 
 =item --password, -p
 
-Set new user password. Using this option may be unsecure.
+Set a new Webmin-only password. Using this option may be insecure because the
+password can be exposed in the process list.
+
+=item --unix
+
+Change the matching Unix user's password with the system C<passwd> command,
+and configure Webmin to use Unix authentication. This is the recommended mode
+when the Webmin username is also a Unix username.
+
+=item --webmin-only, --webmin
+
+Set a separate password in C<miniserv.users>, even if a matching Unix user
+exists. This password overrides Unix authentication for the Webmin user.
 
 =back
 
@@ -261,4 +410,3 @@ Set new user password. Using this option may be unsecure.
  Copyright 2018 Jamie Cameron <jcameron@webmin.com>
                 Joe Cooper <joe@virtualmin.com>
                 Ilia Ross <ilia@virtualmin.com>
-

bin/patch

@@ -1,5 +1,6 @@
 #!/usr/bin/env perl
-# patch - Apply a patch to Webmin core or its modules from GitHub or a local file
+# patch - Apply one or more patches to Webmin core or its modules from
+# GitHub or a local file
 
 use strict;
 use warnings;
@@ -49,20 +50,56 @@ if (!has_command('patch')) {
 		}
 	}
 
-# Get patch URL or file
-my $patch = $ARGV[0];
+# Get patch URLs or files
+my @patches = @ARGV;
 
 # Params check
-if (!$patch) {
+if (!@patches) {
 	pod2usage(0);
 	exit 1;
 	}
 
+# Apply all patches in the given order, stopping at the first failure
+my $orig_cwd = cwd();
+my $applied = 0;
+my $failed = 0;
+foreach my $patch (@patches) {
+	# Show which patch is being applied if there are multiple
+	print "Applying $patch ..\n" if (@patches > 1);
+	# Always start from the original directory, as applying a patch
+	# may change it
+	chdir($orig_cwd);
+	if (!apply_patch($patch)) {
+		$failed = 1;
+		last;
+		}
+	$applied++;
+	}
+
+# Restart Webmin once, if any patches were applied, so that changes to
+# any file, including miniserv.pl itself, take effect
+restart_miniserv() if ($applied);
+
+# Report if some patches were not applied
+if ($failed) {
+	print "Stopped: $applied of ".scalar(@patches)." patches applied\n"
+		if (@patches > 1);
+	exit 1;
+	}
+exit 0;
+
+# apply_patch(patch)
+# Apply a single patch given as URL or local file, printing the outcome
+# and returning 1 on success or 0 on failure
+sub apply_patch
+{
+my ($patch) = @_;
+
 # Patch check
 if ($patch !~ /^https?:\/\//) {
 	if (!-r $patch) {
 		print "Patch file $patch doesn't exist\n";
-		exit 1;
+		return 0;
 		}
 	}
 elsif ($patch =~ /^https?:\/\/(github|gitlab)\.com/ &&
@@ -101,9 +138,9 @@ if ($patch =~ m{
 
 # Check if module exists
 if (!-d "$path/$module") {
-    print "Module '$module' doesn't exist\n";
-    exit 1;
-}
+	print "Module '$module' doesn't exist\n";
+	return 0;
+	}
 
 # Prepare patch command
 my $cmd;
@@ -128,7 +165,7 @@ if ($patch =~ m{^https?://raw\.githubusercontent\.com/} ||
 		}
 	else {
 		print "Patch failed: Can't parse file name from URL\n";
-		exit 1;
+		return 0;
 		}
 	my $cd = "$path/$module/$dir";
 	$cd =~ s|/+|/|g;
@@ -149,26 +186,34 @@ else {
 if ($direct) {
 	$output = `$cmd 2>&1`;
 	if ($output != 200) {
-        	print "Patch failed: Cannot download '$filename'. HTTP status code: $output\n";
-		exit 1;
-    		}
+		print "Patch failed: Cannot download '$filename'. HTTP status code: $output\n";
+		return 0;
+		}
 	}
 # Apply patch using patch command
 elsif (has_command('patch')) {
-	$output = `$cmd 2>&1 | patch -p1 --verbose 2>&1`;
+	# Do not leave .orig backups behind when hunks apply with fuzz or offset
+	$output = `$cmd 2>&1 | patch -p1 --verbose --no-backup-if-mismatch 2>&1`;
 	if ($output !~ /succeeded/i) {
 		print "Patch failed: $output\n";
-		exit 1;
+		return 0;
 		}
 	}
 # Apply patch using git command
 else {
-	$output = `$cmd 2>&1 | git apply --reject --verbose --whitespace=fix 2>&1`;
+	# If the current directory is inside some git repository (e.g. Webmin
+	# root tracked with git), git would treat patch paths as relative to
+	# that repository root and silently skip them, so stop repository
+	# discovery at the parent directory to always apply patch paths
+	# relative to the current directory
+	local $ENV{'GIT_CEILING_DIRECTORIES'} = dirname(cwd());
+	# Allow reduced context, similar to the default fuzz used by patch
+	$output = `$cmd 2>&1 | git apply --reject --verbose -C1 --whitespace=fix 2>&1`;
 	if ($output !~ /applied patch.*?cleanly/i) {
 		print "Patch failed: $output\n";
-		exit 1;
+		return 0;
 		}
-}
+	}
 
 # Print results
 if ($direct) {
@@ -183,11 +228,10 @@ if ($direct) {
 else {
 	print "Patch applied successfully to:\n";
 	print "  $1\n" while $output =~ /^(?|Applied patch\s+(\S+)|patching file\s+(\S+))/mg;
+	}
+return 1;
 }
 
-# Reload Webmin
-reload_miniserv();
-
 =pod
 
 =head1 NAME
@@ -199,9 +243,13 @@ patch
 Apply a patch to Webmin core or its modules from GitHub/GitLab, a local
 file, or by downloading and replacing the entire file from a raw URL.
 
+Multiple patches can be given at once and are applied in the given order,
+stopping at the first failure. Webmin is restarted only once after all
+patches are applied.
+
 =head1 SYNOPSIS
 
-webmin patch patch-url/file
+webmin patch patch-url/file [patch-url/file ...]
 
 =head1 OPTIONS
 
@@ -229,6 +277,11 @@ Examples of usage:
     - cd /usr/libexec/webmin/virtual-server/pro &&
       webmin patch /root/virtualmin-pro/patches/patch-1.patch
 
+  Apply multiple patches at once.
+
+    - webmin patch https://github.com/webmin/webmin/commit/e6a2bb15b0 \
+                   https://github.com/virtualmin/virtualmin-gpl/commit/f4433153d
+
 =back
 
 =head1 LICENSE AND COPYRIGHT

changepass.pl

@@ -10,16 +10,10 @@ $cwd =~ s/(.*)\/.*/$1/;
 usage() if (@ARGV != 3);
 
 my ($config, $user, $pass) = @ARGV;
-my $status = system("$cwd/bin/webmin passwd --config $config --user $user --pass $pass");
-if ($status != 0) {
-	if ($! =~ /no such file/i) {
-		print "Error: Webmin CLI command cannot be found\n";
-		}
-	else {
-		print "Error: $!\n";		
-		}
-	}
-exit $status;
+exec "$cwd/bin/webmin", "passwd", "--webmin-only",
+	"--config", $config, "--user", $user, "--pass", $pass;
+print STDERR "Error: Failed to execute Webmin CLI command: $!\n";
+exit 1;
 
 sub usage
 {

cron/cron-lib.pl

@@ -745,7 +745,7 @@ sub is_run_parts
 local ($cmd) = @_;
 local $rp = $config{'run_parts'};
 $cmd =~ s/\s*#.*$//;
-return $rp && $cmd =~ /$rp(.*)\s+(\-\-\S+\s+)*([a-z0-9\.\-\/_]+)(\s*\))?$/i ? $3 : undef;
+return $rp && $cmd =~ /$rp(.*)\s+(\-\-\S+\s+)*([a-z0-9\.\-\/_]+);?\s*[\)\}]?$/i ? $3 : undef;
 }
 
 =head2 can_edit_user(&access, user)

cron/index.cgi

@@ -205,8 +205,8 @@ foreach $u (@ulist) {
 				"$mover&up=1",
 				"$mover&down=1",
 				$canup, $candown,
-			        ));
-			push(@cols, &ui_up_down_arrows(
+			        )." ".
+				    &ui_up_down_arrows(
 				"$mover&top=1",
 				"$mover&bottom=1",
 				$canup, $candown,
@@ -261,7 +261,7 @@ elsif (@rows) {
 		  ( $text{'index_comment'} ) : ( ),
 		$config{'show_next'} ? ( $text{'index_next'} ) : ( ),
 		$config{'show_run'} ? ( $text{'index_run'} ) : ( ),
-		$access{'move'} ? ( $text{'index_move'}, "" ) : ( ),
+		$access{'move'} ? ( $text{'index_move'} ) : ( ),
 		], 100, 0, \@tds);
 	foreach my $r (@rows) {
 		print &ui_checked_columns_row([ @$r[1..(@$r-2)] ],

dhcpd/edit_keys.cgi

@@ -9,14 +9,11 @@
 require './dhcpd-lib.pl';
 require './params-lib.pl';
 &ReadParse();
+%access = &get_module_acl();
+$access{'global'} || &error($text{'keys_ecannot'});
 $conf = &get_config();
 @keys = ( &find("key", $conf), { } );
 
-# check acls
-# %access = &get_module_acl();
-# &error_setup($text{'eacl_aviol'});
-# &error("$text{'eacl_np'} $text{'eacl_pss'}") if !&can('r',\%access,$sub);
-
 if ($in{'new'}) {
 	&ui_print_header($desc, $text{'keys_create'}, "");
 	}

dhcpd/edit_text.cgi

@@ -6,6 +6,7 @@
 # * Display form to manually edit dhcpd.conf file (pass to save_text.cgi)
 
 require './dhcpd-lib.pl';
+%access = &get_module_acl();
 $access{'noconfig'} && &error($text{'text_ecannot'});
 $conf = &get_config();
 &ui_print_header($text{'text_editor'}, $text{'text_title'}, "");

dhcpd/save_keys.cgi

@@ -8,6 +8,8 @@
 require './dhcpd-lib.pl';
 require './params-lib.pl';
 &ReadParse();
+%access = &get_module_acl();
+$access{'global'} || &error($text{'keys_ecannot'});
 &lock_all_files();
 $conf = &get_config();
 

dhcpd/save_text.cgi

@@ -7,6 +7,7 @@
 
 require './dhcpd-lib.pl';
 &ReadParseMime();
+%access = &get_module_acl();
 $access{'noconfig'} && &error($text{'text_ecannot'});
 $conf = &get_config();
 

fail2ban/edit_jail.cgi

@@ -134,6 +134,60 @@ print &ui_table_row($text{'jail_bantime'},
 	&ui_opt_textbox("bantime", $bantime, 6,
 			$text{'default'}." (".$def_bantime.")"));
 
+# Incremental banning options, supported since Fail2Ban 0.11.1
+if (&supports_bantime_increment()) {
+	print &ui_table_hr();
+	print &ui_table_span("<b>".$text{'jail_increment_header'}."</b><br>".
+		&ui_note($text{'jail_increment_desc'}, 0));
+
+	my $def_increment = &canonical_fail2ban_boolean(
+		&find_value("bantime.increment", $def));
+	my $increment = &canonical_fail2ban_boolean(
+		&find_value("bantime.increment", $jail));
+	my $def_increment_text = $def_increment eq "true" ? $text{'yes'} :
+								  $text{'no'};
+	print &ui_table_row($text{'jail_bantime_increment'},
+		&ui_select("bantime_increment", $increment,
+			[ [ "", $text{'default'}." (".$def_increment_text.")" ],
+			  [ "true", $text{'yes'} ],
+			  [ "false", $text{'no'} ] ], 1, 0, 1));
+
+	my $def_factor = &find_value("bantime.factor", $def) || 1;
+	my $factor = &find_value("bantime.factor", $jail);
+	print &ui_table_row($text{'jail_bantime_factor'},
+		&ui_opt_textbox("bantime_factor", $factor, 8,
+			$text{'default'}." (".&html_escape($def_factor).")"));
+
+	my $def_maxtime = &find_value("bantime.maxtime", $def);
+	my $maxtime = &find_value("bantime.maxtime", $jail);
+	my $def_maxtime_text = $def_maxtime ne "" ?
+		&html_escape($def_maxtime) : $text{'jail_nolimit'};
+	print &ui_table_row($text{'jail_bantime_maxtime'},
+		&ui_opt_textbox("bantime_maxtime", $maxtime, 8,
+			$text{'default'}." (".$def_maxtime_text.")"));
+
+	my $def_overalljails = &canonical_fail2ban_boolean(
+		&find_value("bantime.overalljails", $def));
+	my $overalljails = &canonical_fail2ban_boolean(
+		&find_value("bantime.overalljails", $jail));
+	my $def_overalljails_text = $def_overalljails eq "true" ?
+		$text{'yes'} : $text{'no'};
+	print &ui_table_row($text{'jail_bantime_overalljails'},
+		&ui_select("bantime_overalljails", $overalljails,
+			[ [ "", $text{'default'}." (".$def_overalljails_text.")" ],
+			  [ "true", $text{'yes'} ],
+			  [ "false", $text{'no'} ] ], 1, 0, 1));
+
+	my $def_rndtime = &find_value("bantime.rndtime", $def);
+	my $rndtime = &find_value("bantime.rndtime", $jail);
+	my $def_rndtime_text = $def_rndtime ne "" ?
+		&html_escape($def_rndtime) : $text{'jail_none'};
+	print &ui_table_row($text{'jail_bantime_rndtime'},
+		&ui_opt_textbox("bantime_rndtime", $rndtime, 8,
+			$text{'default'}." (".$def_rndtime_text.")"));
+	print &ui_table_hr();
+	}
+
 # IPs to ignore
 my $def_ignoreip = &find_value("ignoreip", $def) || "127.0.0.1";
 my $ignoreip = &find_value("ignoreip", $jail);

fail2ban/edit_jaildef.cgi

@@ -40,6 +40,45 @@ $bantime = $def_bantime if (!defined($bantime) || $bantime eq "");
 print &ui_table_row($text{'jail_bantime'},
 	&ui_textbox("bantime", $bantime, 5));
 
+# Incremental banning options, supported since Fail2Ban 0.11.1
+if (&supports_bantime_increment()) {
+	print &ui_table_hr();
+	print &ui_table_span("<b>".$text{'jail_increment_header'}."</b><br>".
+		&ui_note($text{'jail_increment_desc'}, 0));
+
+	my $increment = &canonical_fail2ban_boolean(
+		&find_value("bantime.increment", $jail));
+	print &ui_table_row($text{'jail_bantime_increment'},
+		&ui_select("bantime_increment", $increment,
+			[ [ "", $text{'default'}." (".$text{'no'}.")" ],
+			  [ "true", $text{'yes'} ],
+			  [ "false", $text{'no'} ] ], 1, 0, 1));
+
+	my $factor = &find_value("bantime.factor", $jail);
+	print &ui_table_row($text{'jail_bantime_factor'},
+		&ui_opt_textbox("bantime_factor", $factor, 8,
+			$text{'default'}." (1)"));
+
+	my $maxtime = &find_value("bantime.maxtime", $jail);
+	print &ui_table_row($text{'jail_bantime_maxtime'},
+		&ui_opt_textbox("bantime_maxtime", $maxtime, 8,
+			$text{'default'}." (".$text{'jail_nolimit'}.")"));
+
+	my $overalljails = &canonical_fail2ban_boolean(
+		&find_value("bantime.overalljails", $jail));
+	print &ui_table_row($text{'jail_bantime_overalljails'},
+		&ui_select("bantime_overalljails", $overalljails,
+			[ [ "", $text{'default'}." (".$text{'no'}.")" ],
+			  [ "true", $text{'yes'} ],
+			  [ "false", $text{'no'} ] ], 1, 0, 1));
+
+	my $rndtime = &find_value("bantime.rndtime", $jail);
+	print &ui_table_row($text{'jail_bantime_rndtime'},
+		&ui_opt_textbox("bantime_rndtime", $rndtime, 8,
+			$text{'default'}." (".$text{'jail_none'}.")"));
+	print &ui_table_hr();
+	}
+
 # IPs to ignore
 my $def_ignoreip = "127.0.0.1";
 my $ignoreip = &find_value("ignoreip", $jail);

fail2ban/fail2ban-lib.pl

@@ -210,7 +210,7 @@ my @w;
 my $v = $dir->{'value'};
 $v =~ s/\n/ /g;
 while($v =~ /\S/) {
-	if ($v =~ /^([^\[]+\[[^\]]+\])\s*(.*)/) {
+	if ($v =~ /^\s*([^\s\[]+\[[^\]]*\])\s*(.*)/) {
 		push(@w, $1);
 		$v = $2;
 		}
@@ -408,7 +408,9 @@ my @rv;
 my @v = ref($dir->{'value'}) eq 'ARRAY' ? @{$dir->{'value'}}
 					: split(/\n/, $dir->{'value'});
 push(@rv, $dir->{'name'}." = ".shift(@v));
-push(@rv, map { "        ".$_ } @v);	# Continuation
+# Indent continuation lines to align with the first value
+my $indent = " " x (length($dir->{'name'}) + 3);
+push(@rv, map { $indent.$_ } @v);
 return @rv;
 }
 
@@ -671,6 +673,113 @@ my $out = &backquote_command("$config{'client_cmd'} -V 2>/dev/null </dev/null");
 return !$? && $out =~ /v?([0-9\.]+)/ ? $1 : undef;
 }
 
+# supports_bantime_increment([version])
+# Returns 1 if the installed Fail2Ban version supports incremental ban times
+sub supports_bantime_increment
+{
+my ($version) = @_;
+$version = &get_fail2ban_version() if (!defined($version));
+return 0 if (!defined($version) || $version eq "");
+return &compare_version_numbers($version, "0.11.1") >= 0;
+}
+
+# canonical_fail2ban_boolean(value)
+# Converts the boolean spellings accepted by Fail2Ban to true or false
+sub canonical_fail2ban_boolean
+{
+my ($value) = @_;
+return "" if (!defined($value) || $value eq "");
+return "true" if ($value =~ /^(1|on|true|yes)$/i);
+return "false" if ($value =~ /^(0|off|false|no)$/i);
+return $value;
+}
+
+# valid_fail2ban_duration(value, [allow-zero])
+# Returns 1 for a safe subset of Fail2Ban duration expressions
+sub valid_fail2ban_duration
+{
+my ($value, $allow_zero) = @_;
+return 0 if (!defined($value) || $value eq "");
+return 0 if ($value =~ /[\r\n]/);
+my $number = qr/\d+(?:\.\d+)?/;
+my $unit = qr/(?:s|sec(?:ond)?s?|m|min(?:ute)?s?|h|hour(?:s)?|d|day(?:s)?|w|week(?:s)?|mo|mon|month(?:s)?|y|year(?:s)?)/i;
+return 0 if ($value !~ /^\s*(?:$number\s*$unit\s*)+$/ &&
+		   $value !~ /^\s*$number\s*$/);
+return 1 if ($allow_zero);
+my @numbers = $value =~ /(\d+(?:\.\d+)?)/g;
+return scalar(grep { $_ > 0 } @numbers) ? 1 : 0;
+}
+
+# valid_positive_fail2ban_duration(value)
+# Returns 1 for a safe, positive Fail2Ban duration expression
+sub valid_positive_fail2ban_duration
+{
+return &valid_fail2ban_duration($_[0], 0);
+}
+
+# valid_nonnegative_fail2ban_duration(value)
+# Returns 1 for a safe Fail2Ban duration expression, including zero
+sub valid_nonnegative_fail2ban_duration
+{
+return &valid_fail2ban_duration($_[0], 1);
+}
+
+# valid_bantime_factor(value)
+# Returns 1 for a positive numeric incremental-ban growth factor
+sub valid_bantime_factor
+{
+my ($value) = @_;
+return defined($value) &&
+	$value =~ /^(?:\d+(?:\.\d+)?|\.\d+)$/ && $value > 0;
+}
+
+# validate_bantime_increment_inputs(&input)
+# Returns a language key for the first invalid incremental-ban option
+sub validate_bantime_increment_inputs
+{
+my ($input) = @_;
+foreach my $f ("bantime_increment", "bantime_overalljails") {
+	my $value = $input->{$f};
+	return "jail_e".$f if (defined($value) && $value ne "" &&
+					$value !~ /^(true|false)$/);
+	}
+if (!$input->{'bantime_factor_def'} &&
+    !&valid_bantime_factor($input->{'bantime_factor'})) {
+	return "jail_ebantime_factor";
+	}
+if (!$input->{'bantime_maxtime_def'} &&
+    !&valid_positive_fail2ban_duration($input->{'bantime_maxtime'})) {
+	return "jail_ebantime_maxtime";
+	}
+if (!$input->{'bantime_rndtime_def'} &&
+    !&valid_nonnegative_fail2ban_duration($input->{'bantime_rndtime'})) {
+	return "jail_ebantime_rndtime";
+	}
+return undef;
+}
+
+# save_bantime_increment_options(&input, &jail)
+# Saves incremental-ban options using the standard jail directive handling
+sub save_bantime_increment_options
+{
+my ($input, $jail) = @_;
+&save_directive("bantime.increment",
+	$input->{'bantime_increment'} eq "" ? undef :
+		$input->{'bantime_increment'}, $jail);
+&save_directive("bantime.factor",
+	$input->{'bantime_factor_def'} ? undef :
+		$input->{'bantime_factor'}, $jail);
+&save_directive("bantime.maxtime",
+	$input->{'bantime_maxtime_def'} ? undef :
+		$input->{'bantime_maxtime'}, $jail);
+&save_directive("bantime.overalljails",
+	$input->{'bantime_overalljails'} eq "" ? undef :
+		$input->{'bantime_overalljails'}, $jail);
+&save_directive("bantime.rndtime",
+	$input->{'bantime_rndtime_def'} ? undef :
+		$input->{'bantime_rndtime'}, $jail);
+}
+
 # Unblock given IP in given jail
 sub unblock_jailed_ip
 {

fail2ban/lang/en

@@ -101,6 +101,14 @@ jail_others=Other parameters
 jail_maxretry=Matches before applying action
 jail_findtime=Max delay between matches
 jail_bantime=Time to ban IP for
+jail_increment_header=Incremental banning
+jail_increment_desc=Increase ban times for IP addresses that are banned repeatedly. Ban history comes from Fail2Ban's persistent database and is limited by the database purge age in Global Configuration.
+jail_bantime_increment=Increase repeat-offender ban times?
+jail_bantime_factor=Ban time growth factor
+jail_bantime_maxtime=Maximum increased ban time
+jail_bantime_overalljails=Use ban history from all jails?
+jail_bantime_rndtime=Maximum random additional ban time
+jail_nolimit=No limit
 jail_ignoreip=IP addresses to never ban
 jail_err=Failed to save jail
 jail_eclash=A jail with the same name already exists
@@ -115,6 +123,12 @@ jail_elogpath=All log files must be absolute paths or patterns
 jail_emaxretry=Matches before applying action must be a number greater than zero
 jail_efindtime=Delay between matches must be a number greater than zero
 jail_ebantime=Time to ban an IP must be a number greater than zero
+jail_ebantime_increment=Invalid incremental banning selection
+jail_ebantime_factor=Ban time growth factor must be a number greater than zero
+jail_ebantime_maxtime=Maximum increased ban time must be a positive duration, such as 30m, 5h, 7d or 5w
+jail_ebantime_overalljails=Invalid all-jails ban history selection
+jail_ebantime_rndtime=Random additional ban time must be zero or a positive duration, such as 30m, 5h, 7d or 5w
+jail_eincrement_version=Incremental banning requires Fail2Ban version 0.11.1 or later
 jail_backend=Check for log file updates using
 jail_auto=Decide automatically
 jail_systemd=systemd
@@ -235,4 +249,3 @@ status_err_unknownjail=Unknown jail
 syslog_logtarget=Fail2Ban action log
 
 __norefs=1
-

fail2ban/save_jail.cgi

@@ -122,6 +122,19 @@ else {
 			&error($text{'jail_eignoreip'});
 		}
 
+	# Validate incremental banning options when submitted by a supported UI
+	my @increment_fields = ("bantime_increment", "bantime_factor",
+		"bantime_maxtime", "bantime_overalljails", "bantime_rndtime");
+	my $increment_submitted = scalar(grep { exists($in{$_}) }
+		@increment_fields);
+	if ($increment_submitted && !&supports_bantime_increment()) {
+		&error($text{'jail_eincrement_version'});
+		}
+	if ($increment_submitted) {
+		my $err = &validate_bantime_increment_inputs(\%in);
+		&error($text{$err}) if ($err);
+		}
+
 	# Create new section or rename existing if needed
 	&lock_all_config_files();
 	if ($in{'new'}) {
@@ -144,6 +157,8 @@ else {
 		}
 	&save_directive("ignoreip",
 		@ignoreips ? join(" ", @ignoreips) : undef, $jail);
+	&save_bantime_increment_options(\%in, $jail)
+		if ($increment_submitted);
 
 	&unlock_all_config_files();
 	}

fail2ban/save_jaildef.cgi

@@ -30,6 +30,18 @@ foreach my $ip (@ignoreips) {
 		&error($text{'jail_eignoreip'});
 	}
 
+# Validate incremental banning options when submitted by a supported UI
+my @increment_fields = ("bantime_increment", "bantime_factor",
+	"bantime_maxtime", "bantime_overalljails", "bantime_rndtime");
+my $increment_submitted = scalar(grep { exists($in{$_}) } @increment_fields);
+if ($increment_submitted && !&supports_bantime_increment()) {
+	&error($text{'jail_eincrement_version'});
+	}
+if ($increment_submitted) {
+	my $err = &validate_bantime_increment_inputs(\%in);
+	&error($text{$err}) if ($err);
+	}
+
 
 # Update the jail
 &lock_all_config_files();
@@ -47,6 +59,7 @@ foreach my $f ("maxretry", "findtime", "bantime") {
 		$jail);
 &save_directive("banaction", $in{'banaction'} || undef, $jail);
 &save_directive("protocol", $in{'protocol'} || undef, $jail);
+&save_bantime_increment_options(\%in, $jail) if ($increment_submitted);
 &unlock_all_config_files();
 
 &webmin_log("jaildef");

firewall/firewall-lib.pl

@@ -527,7 +527,7 @@ local @oldjumps = grep { $_->{'chain'} eq 'INPUT' &&
 # Get all new fail2ban chain rules and inputs that jump to them
 local @newrules = grep { $_->{'chain'} =~ /^f2b-/ } @$newrules;
 local @newjumps = grep { $_->{'chain'} eq 'INPUT' &&
-			 $_->{'j'}->[1] =~ /^f2b-/ } @newrules;
+			 $_->{'j'}->[1] =~ /^f2b-/ } @$newrules;
 
 # Re-create the chains
 my @oldchains = &unique(map { $_->{'chain'} } @oldrules);

fsdump/backup.pl

@@ -116,12 +116,18 @@ if ($out && $dump->{'email'} && &foreign_check("mailboxes")) {
 		}
 
 	# Send the email
+	my $email = $dump->{'email'};
+	if ($email eq '*') {
+		$email = $gconfig{'webmin_email_to'};
+		if ($email && $gconfig{'webmin_email_to_name'}) {
+			$email = "$gconfig{'webmin_email_to_name'} <$email>";
+			}
+		}
 	if (!$ok || !$config{'error_email'}) {
 		# Only send email upon failure, or it requested always
 		&mailboxes::send_text_mail(
 			&mailboxes::get_from_address(),
-			$dump->{'email'} eq '*' ? $gconfig{'webmin_email_to'}
-						: $dump->{'email'},
+			$email,
 			undef,
 			$subject,
 			$data,

gray-theme/unauthenticated/gray-theme.css

@@ -124,6 +124,7 @@ hr { border: 0;
   color: #D9D9D9;
   background-color: #D9D9D9;
 }
+table.shrinkwrapper table.ui_table td.ui_form_value > table.ui_table,
 table.wrapper, table.shrinkwrapper {
   background-color:#D9D9D9;
   border:1px solid #D9D9D9;
@@ -148,6 +149,14 @@ div.wrapper {
 .tabUnselected {
   background-color:#D9D9D9;
 }
+.tabUnselected sup,
+.tabSelected sup {
+    vertical-align: text-top;
+    margin-top: -4px;
+    font-size: 70%;
+    display: inline-block;
+    margin-right: -3px;
+}
 .goArrow { margin-bottom: -4px; }
 .ui_checked_columns .ui_checked_checkbox {
   min-width: 20px;

htaccess-htpasswd/lang/en

@@ -38,6 +38,8 @@ dir_eclash=This directory is already protected
 dir_edir=Missing or invalid directory
 dir_ecannot=You are not allowed to protect this directory
 dir_ecannotcreate=You are not allow to configure which directories are protected
+dir_ecannotfile=You are not allowed to use a users file in this directory
+dir_ecannotgfile=You are not allowed to use a groups file in this directory
 dir_efile=Missing or invalid users filename
 dir_ehtaccess=Failed to create Apache options file $1 : $2
 dir_ehtpasswd=Failed to create users file $1 : $2

htaccess-htpasswd/save_dir.cgi

@@ -32,6 +32,10 @@ if ($in{'apache'}) {
 	exit;
 	}
 
+# Reject a directory outside the allowed set before taking any root-owned
+# lock or reading the .htaccess file
+&can_access_dir($htaccess) || &error($text{'dir_ecannot'});
+
 &lock_file($htaccess);
 &lock_file($directories_file);
 
@@ -44,11 +48,11 @@ $currfile = &foreign_call($apachemod, "find_directive",
 			  $auf, $conf, 1);
 $currgfile = &foreign_call($apachemod, "find_directive",
 			   $agf, $conf, 1);
-&lock_file($currfile) if ($currfile);
+&lock_file($currfile)
+	if ($currfile && &can_access_dir($currfile));
 
-# Make sure it is allowed, and create new file if needed
+# Create the .htaccess file if it does not exist yet
 &switch_user();
-&can_access_dir($htaccess) || &error($text{'dir_ecannot'});
 $missing = !-r $htaccess;
 &open_tempfile(TEST, ">>$htaccess", 1) || &error(&text('dir_ehtaccess', $htaccess, $!));
 &close_tempfile(TEST);
@@ -60,6 +64,10 @@ if ($missing) {
 if ($in{'delete'} || $in{'remove'}) {
 	if ($in{'remove'}) {
 		# Blow away .htaccess, htpasswd and htgroups
+		!$currfile || &can_access_dir($currfile) ||
+			&error($text{'dir_ecannotfile'});
+		!$currgfile || &can_access_dir($currgfile) ||
+			&error($text{'dir_ecannotgfile'});
 		&unlink_logged($htaccess);
 		&unlink_logged($currfile) if ($currfile && !-d $currfile);
 		&unlink_logged($currgfile) if ($currgfile && !-d $currgfile);
@@ -99,6 +107,7 @@ else {
 			}
 		}
 	-d $file && &error(&text('dir_efiledir', $file));
+	&can_access_dir($file) || &error($text{'dir_ecannotfile'});
 
 	# Parse groups file option
 	if (!$can_htgroups) {
@@ -115,7 +124,7 @@ else {
 		}
 	else {
 		# Groups file was entered by user
-		$in{'file'} || &error($text{'dir_egfile'});
+		$in{'gfile'} || &error($text{'dir_egfile'});
 		if ($in{'gfile'} !~ /^([a-z]:)?\//) {
 			$gfile = "$in{'dir'}/$in{'gfile'}";
 			}
@@ -124,6 +133,8 @@ else {
 			}
 		}
 	-d $gfile && &error(&text('dir_egfiledir', $gfile));
+	!$gfile || &can_access_dir($gfile) ||
+		&error($text{'dir_ecannotgfile'});
 
 	# Parse require option
 	@require = ( $in{'require_mode'} );
@@ -169,6 +180,13 @@ else {
 				      $agf, [ "\"$gfile\"" ], $conf,$conf);
 			}
 
+		# Validate paths imported from existing authentication directives
+		-d $file && &error(&text('dir_efiledir', $file));
+		&can_access_dir($file) || &error($text{'dir_ecannotfile'});
+		-d $gfile && &error(&text('dir_egfiledir', $gfile));
+		!$gfile || &can_access_dir($gfile) ||
+			&error($text{'dir_ecannotgfile'});
+
 		# Add an auth type if needed
 		$currtype = &foreign_call($apachemod, "find_directive",
 					  "AuthType", $conf, 1);

init/updateboot.pl

@@ -41,6 +41,7 @@ if ($product) {
 		&flush_file_lines($temp);
 
 		copy_source_dest($temp, "$systemd_root/$product.service");
+		&set_ownership_permissions(0, 0, 0644, "$systemd_root/$product.service");
 		$reload_daemon->();
 
 		if ($status eq "disabled") {
@@ -70,7 +71,7 @@ if ($product) {
 			}
 		&flush_file_lines($temp);
 		&copy_source_dest($temp, "/etc/init.d/$product");
-		chmod(0755, "/etc/init.d/$product");
+		&set_ownership_permissions(0, 0, 0755, "/etc/init.d/$product");
 		&unlink_file($temp);
 		if ($status == 2 || $want_boot) {
 			&enable_at_boot($product);
@@ -99,6 +100,7 @@ if ($product) {
 		}
 	elsif (-d "/etc/init.d") {
 		copy_source_dest("$root_directory/webmin-init", "/etc/init.d/$product");
+		&set_ownership_permissions(0, 0, 0755, "/etc/init.d/$product");
 		system("chkconfig --add $product >/dev/null 2>&1");
 		}
 	}

lang/en

@@ -195,6 +195,7 @@ pam_restart=Restart
 
 login_notsecure=Not Secure
 login_notsecure_desc=This connection is not secure and could let a man-in-the-middle attack intercept your password or session cookie. Click here to switch to an HTTPS connection, unless you are on a trusted local network or behind a secure reverse proxy.
+login_notsecure_http_desc=This connection is not encrypted and could let a man-in-the-middle attack intercept your password or session cookie. HTTPS is not enabled in Webmin; enable it unless you are on a trusted local network or behind a secure reverse proxy.
 
 acl_root=Root directory for file chooser
 acl_otherdirs=Other visible directories in file chooser

login-lib.pl

@@ -0,0 +1,27 @@
+# login-lib.pl
+# Common functions for the built-in login pages.
+
+# get_login_http_warning(&miniserv-config)
+# Returns the insecure-login warning HTML, or undef if none is needed
+sub get_login_http_warning
+{
+my ($miniserv) = @_;
+return undef if ($ENV{'HTTPS'} eq 'ON' ||
+		 (!$miniserv->{'ssl'} && $miniserv->{'no_ssl_warn'}));
+
+my $warning = "⚠ $text{'login_notsecure'}";
+my $description = $text{'login_notsecure_http_desc'};
+if ($miniserv->{'ssl'}) {
+	$warning = ui_tag('a', $warning,
+		{ 'href' => "javascript:void(0);",
+		  'class' => 'inherit-color',
+		  'onclick' => "window.location.href = ".
+		    "window.location.href.replace(/^http:/, 'https:'); return false;",
+		});
+	$description = $text{'login_notsecure_desc'};
+	}
+return ui_tag('span', $warning,
+	{ class => 'not-secure', title => $description });
+}
+
+1;

logrotate/backup_config.pl

@@ -5,8 +5,18 @@ do 'logrotate-lib.pl';
 # Returns files and directories that can be backed up
 sub backup_config_files
 {
-local $conf = &get_config();
-return &unique(map { $_->{'file'} } @$conf);
+# Keep backup behavior unchanged on systems without the vendor overlay.
+if (!$config{'vendor_logrotate_conf'} && !$config{'vendor_add_file'}) {
+	local $conf = &get_config();
+	return &unique(map { $_->{'file'} } @$conf);
+	}
+
+# Back up only writable files.  Use the complete effective file list so an
+# empty local file that intentionally shadows a vendor file is preserved.
+local ($conf, $lnum, $files) = &get_config();
+return &unique(grep { !&is_vendor_main_config($_) &&
+		      !&is_vendor_config_file($_) }
+	       @$files);
 }
 
 # pre_backup(&files)

logrotate/config-openSUSE-Linux-16.0-ALL

@@ -0,0 +1,8 @@
+sort_mode=0
+logrotate_conf=/etc/logrotate.conf
+vendor_logrotate_conf=/usr/etc/logrotate.conf
+add_file=/etc/logrotate.d
+vendor_add_file=/usr/etc/logrotate.d
+scan_add_file=1
+logrotate=logrotate
+logrotate_all=/usr/sbin/logrotate-all

logrotate/delete_logs.cgi

@@ -12,6 +12,19 @@ require './logrotate-lib.pl';
 # Delete the sections
 $parent = &get_config_parent();
 $conf = $parent->{'members'};
+
+# Copy each selected vendor file to the local override tree before changing
+# it.  Reload the parsed configuration after copying so all line references
+# point at the writable files.
+%vendor_files = map { $conf->[$_]->{'file'}, 1 }
+		grep { &is_vendor_config_file($conf->[$_]->{'file'}) } @d;
+if (%vendor_files) {
+	foreach $f (keys %vendor_files) {
+		&ensure_local_config_override($f);
+		}
+	$parent = &get_config_parent();
+	$conf = $parent->{'members'};
+	}
 foreach $d (sort { $b <=> $a } @d) {
 	$log = $conf->[$d];
 	&lock_file($log->{'file'});

logrotate/edit_log.cgi

@@ -20,6 +20,23 @@ else {
 	$lconf = $log->{'members'};
 	}
 
+# Explain which side of the vendor/local overlay is displayed and where a
+# copy-on-write edit will be saved before presenting the form.
+if ($in{'global'} && &is_vendor_main_config(&get_main_config_file())) {
+	print &ui_alert_box(&text('global_vendor',
+		"<tt>".&html_escape($config{'logrotate_conf'})."</tt>"),
+		'info');
+	}
+elsif ($log && &is_vendor_config_file($log->{'file'})) {
+	print &ui_alert_box(&text('edit_vendor',
+		"<tt>".&html_escape(&get_local_override_file(
+			$log->{'file'}))."</tt>"), 'info');
+	}
+elsif ($log && (my $vendor = &get_vendor_config_file($log->{'file'}))) {
+	print &ui_alert_box(&text('edit_override',
+		"<tt>".&html_escape($vendor)."</tt>"), 'info');
+	}
+
 print &ui_form_start("save_log.cgi", "post", undef, "id='edit_log_form'");
 print &ui_hidden("new", $in{'new'}),"\n";
 print &ui_hidden("idx", $in{'idx'}),"\n";

logrotate/edit_sched.cgi

@@ -5,7 +5,13 @@
 require './logrotate-lib.pl';
 &ui_print_header(undef, $text{'sched_title'}, "");
 
-print "<p>",&text('sched_desc', "<tt>$config{'logrotate'}</tt>"),"<p>\n";
+# Show the wrapper or fallback command on vendor-overlay systems, while
+# retaining the original short program name everywhere else.
+my $sched_command = ($config{'logrotate_all'} ||
+	$config{'vendor_logrotate_conf'} || $config{'vendor_add_file'}) ?
+		&get_scheduled_logrotate_command() : $config{'logrotate'};
+print "<p>",&text('sched_desc', "<tt>".
+	&html_escape($sched_command)."</tt>"),"<p>\n";
 
 # Find the job, looking in daily directories too
 &foreign_require("cron", "cron-lib.pl");

logrotate/force.cgi

@@ -10,7 +10,14 @@ $SIG{'TERM'} = 'IGNORE';
 
 print $text{'force_doing'},"\n";
 &clean_environment();
-$out = &backquote_logged("$config{'logrotate'} -f $config{'logrotate_conf'} 2>&1");
+
+# Force the same effective main and drop-in configs selected by the distro
+# wrapper, while avoiding duplicate files already reached through includes.
+my $main = &get_main_config_file();
+my (undef, undef, $files) = &get_config($main);
+my @configs = ($main, &get_add_file_configs($files));
+my $configs = join(" ", map { &quote_path($_) } @configs);
+$out = &backquote_logged("$config{'logrotate'} -f $configs 2>&1");
 &reset_environment();
 if ($out) {
 	print "<pre>$out</pre>";

logrotate/index.cgi

@@ -19,11 +19,12 @@ if (!&has_command($config{'logrotate'})) {
 	&ui_print_footer("/", $text{'index'});
 	exit;
 	}
-if (!-r $config{'logrotate_conf'}) {
+my $main_config = &get_main_config_file();
+if (!-r $main_config) {
 	&ui_print_header(undef, $text{'index_title'}, "", "intro", 1, 1);
 	&ui_print_endpage(
 		&ui_config_link('index_econf',
-			[ "<tt>$config{'logrotate_conf'}</tt>", undef ]));
+			[ "<tt>$main_config</tt>", undef ]));
 	}
 
 # Get the version
@@ -52,9 +53,19 @@ foreach $c ($config{'sort_mode'} ?
 		local $p = &get_period($c->{'members'}) || $defp;
 		local $r = &find_value("postrotate", $c->{'members'});
 		$r =~ s/\n/<br>\n/g;
+		local $label = join(" ", map { "<tt>$_</tt><br>" }
+					      @{$c->{'name'}});
+
+		# Distinguish read-only vendor entries from writable local files
+		# that shadow a vendor entry at the same relative path.
+		if (&is_vendor_config_file($c->{'file'})) {
+			$label .= "<i>$text{'index_vendor'}</i>";
+			}
+		elsif (&get_vendor_config_file($c->{'file'})) {
+			$label .= "<i>$text{'index_override'}</i>";
+			}
 		push(@table, [ &ui_link("edit_log.cgi?idx=".$c->{'index'},
-			       join(" ", map { "<tt>$_</tt><br>" }
-					     @{$c->{'name'}}) ),
+			       $label),
 			       $text{'period_'.$p} ||
 				"<i>$text{'index_notset'}</i>",
 			       $r ? "<tt><font size=-1>$r</font></tt>"

logrotate/install_check.pl

@@ -6,7 +6,9 @@ do 'logrotate-lib.pl';
 # For mode 0, returns 1 if installed, 0 if not.
 sub is_installed
 {
-return 0 if (!-r $config{'logrotate_conf'} && !-r $config{'sample_conf'});
+# Accept the vendor main config when the optional local override is absent.
+my $main = &get_main_config_file();
+return 0 if (!-r $main && !-r $config{'sample_conf'});
 return 0 if (!&has_command($config{'logrotate'}));
 return $_[0] ? 2 : 1;
 }

logrotate/lang/en

@@ -19,6 +19,8 @@ index_force=Force Log Rotation
 index_forcedesc=Force the immediate rotation of all log files, even if it is not yet time.
 index_logrotate=Logrotate
 index_delete=Delete Selected Log Rotations
+index_vendor=Vendor configuration
+index_override=Local vendor override
 
 period_daily=Daily
 period_weekly=Weekly
@@ -65,11 +67,17 @@ edit_default=Default ($1)
 edit_sharedscripts=Only run scripts once for all files?
 edit_now=Rotate Now
 edit_clone=Clone
+edit_vendor=This is a vendor-provided configuration. Saving or deleting it will first create the local override $1; the file under <tt>/usr/etc</tt> will not be changed.
+edit_override=This local configuration overrides the vendor file $1.
 
 global_title=Global Options
 global_header=Default options for all log files
+global_vendor=These defaults currently come from the vendor configuration. Saving will first create the writable local configuration $1; the file under <tt>/usr/etc</tt> will not be changed.
 
 save_err=Failed to save log
+save_eoverride=Cannot create local override $1 because that path already exists and is not a regular file.
+save_ecopy=Failed to create local override $1: $2
+save_evendorwrite=Refusing to modify vendor configuration $1 without first creating a local override.
 save_efile=Missing or invalid log filename
 save_esize=Missing or invalid maximum size
 save_eminsize=Missing or invalid minimum size

logrotate/logrotate-lib.pl

@@ -15,10 +15,15 @@ if (!-r $config{'logrotate_conf'} && -r $config{'sample_conf'}) {
 	&copy_source_dest($config{'sample_conf'}, $config{'logrotate_conf'});
 	}
 
+# get_config_parent()
+# Returns the parsed global config while keeping the writable local file as
+# its save target.  Callers must materialize that file before global writes.
 sub get_config_parent
 {
 if (!$get_config_parent_cache) {
 	local ($conf, $lines) = &get_config();
+	# Even when members came from the vendor config, never make /usr the
+	# destination for newly-added global directives.
 	$get_config_parent_cache = { 'members' => $conf,
 		 		     'file' => $config{'logrotate_conf'},
 		 		     'line' => 0,
@@ -28,30 +33,254 @@ if (!$get_config_parent_cache) {
 return $get_config_parent_cache;
 }
 
+# get_main_config_file()
+# Returns the local main config, or the vendor default if no local one exists
+sub get_main_config_file
+{
+return $config{'logrotate_conf'} if (-e $config{'logrotate_conf'});
+return $config{'vendor_logrotate_conf'}
+	if ($config{'vendor_logrotate_conf'});
+return $config{'logrotate_conf'};
+}
+
+# is_vendor_main_config(file)
+# Returns 1 if a file is the vendor-provided main config
+sub is_vendor_main_config
+{
+my ($file) = @_;
+return $config{'vendor_logrotate_conf'} &&
+	&same_file($file, $config{'vendor_logrotate_conf'});
+}
+
+# relative_config_path(file, directory)
+# Returns a file's path relative to a config directory
+sub relative_config_path
+{
+my ($file, $dir) = @_;
+return undef if (!$file || !$dir);
+$dir =~ s/\/+$//;
+$dir .= '/';
+return $file =~ /^\Q$dir\E(.+)$/ ? $1 : undef;
+}
+
+# is_vendor_config_file(file)
+# Returns 1 if a drop-in comes from the vendor directory
+sub is_vendor_config_file
+{
+my ($file) = @_;
+return defined(&relative_config_path(
+	$file, $config{'vendor_add_file'}));
+}
+
+# get_local_override_file(vendor-file)
+# Returns the local path that overrides a vendor drop-in
+sub get_local_override_file
+{
+my ($file) = @_;
+my $rel = &relative_config_path($file, $config{'vendor_add_file'});
+return undef if (!defined($rel) || !$config{'add_file'});
+return $config{'add_file'}.'/'.$rel;
+}
+
+# get_vendor_config_file(local-file)
+# Returns the vendor file shadowed by a local drop-in, if any
+sub get_vendor_config_file
+{
+my ($file) = @_;
+my $rel = &relative_config_path($file, $config{'add_file'});
+return undef if (!defined($rel) || !$config{'vendor_add_file'});
+my $vendor = $config{'vendor_add_file'}.'/'.$rel;
+return -f $vendor ? $vendor : undef;
+}
+
+# flush_logrotate_config_cache()
+# Clears parsed config state after creating a local override
+sub flush_logrotate_config_cache
+{
+%get_config_cache = ( );
+%get_config_lnum_cache = ( );
+%get_config_files_cache = ( );
+$get_config_parent_cache = undef;
+}
+
+# copy_vendor_config(source, destination)
+# Copies a vendor config to the writable local tree
+sub copy_vendor_config
+{
+my ($source, $dest) = @_;
+
+# An existing independent regular destination is already a usable override.
+# Refuse links to the vendor file, symlinks, and other non-regular file types
+# so the local path cannot redirect writes back into the read-only tree.
+if (-e $dest || -l $dest) {
+	if (-f $dest && !-l $dest) {
+		if (&same_file($source, $dest)) {
+			&error(&text('save_evendorwrite', "<tt>".
+				&html_escape($source)."</tt>"));
+			}
+		else {
+			&flush_logrotate_config_cache();
+			return $dest;
+			}
+		}
+	&error(&text('save_eoverride', "<tt>".
+		&html_escape($dest)."</tt>"));
+	}
+
+# Create missing subdirectories before copying the complete vendor file.
+# Following a source symlink produces an editable snapshot, not another link.
+my $dir = $dest;
+$dir =~ s/\/[^\/]+$//;
+&make_dir_recursive($dir, 0755) if (!-d $dir);
+my ($ok, $err) = &copy_source_dest($source, $dest, 1);
+
+# Do not leave a partial override behind after a copy or chmod failure, since
+# even an incomplete local file would hide the valid vendor configuration.
+if (!$ok || !&set_ownership_permissions(undef, undef, 0644, $dest)) {
+	$err ||= $!;
+	&unlink_file($dest) if (-e $dest || -l $dest);
+	&error(&text('save_ecopy', "<tt>".&html_escape($dest)."</tt>",
+		&html_escape($err)));
+	}
+
+# Force the next read to select and parse the newly-created local file.
+&flush_logrotate_config_cache();
+return $dest;
+}
+
+# ensure_local_main_config()
+# Creates a writable local main config when only the vendor default exists
+sub ensure_local_main_config
+{
+my $main = &get_main_config_file();
+return $config{'logrotate_conf'}
+	if (!&is_vendor_main_config($main));
+return &copy_vendor_config($main, $config{'logrotate_conf'});
+}
+
+# ensure_local_config_override(vendor-file)
+# Creates a writable local copy that shadows a vendor drop-in
+sub ensure_local_config_override
+{
+my ($file) = @_;
+my $local = &get_local_override_file($file);
+return $file if (!$local);
+return &copy_vendor_config($file, $local);
+}
+
+# list_config_dir_files(directory, [relative-subdirectory])
+# Returns relative and absolute paths for regular files below a directory
+sub list_config_dir_files
+{
+my ($dir, $subdir) = @_;
+my $path = $subdir ? $dir.'/'.$subdir : $dir;
+opendir(my $dh, $path) || return ( );
+my @names = sort { $a cmp $b } readdir($dh);
+closedir($dh);
+my @rv;
+foreach my $name (@names) {
+	next if ($name eq '.' || $name eq '..');
+	my $rel = $subdir ? $subdir.'/'.$name : $name;
+	my $file = $dir.'/'.$rel;
+
+	# Match find without -L: ignore symlinks, recurse into real directories,
+	# and return only regular files with paths relative to the scanned root.
+	next if (-l $file);
+	if (-d $file) {
+		push(@rv, &list_config_dir_files($dir, $rel));
+		}
+	elsif (-f $file) {
+		push(@rv, [ $rel, $file ]);
+		}
+	}
+return @rv;
+}
+
+# get_add_file_configs([&already-loaded-files])
+# Returns the effective vendor and local configs loaded by logrotate-all
+sub get_add_file_configs
+{
+my ($files) = @_;
+return ( ) if (!$config{'scan_add_file'});
+
+# Collect the same relative names produced by the wrapper's recursive find.
+# Processing the local tree last records its regular files directly.
+my %effective;
+foreach my $dir ($config{'vendor_add_file'}, $config{'add_file'}) {
+	next if (!$dir || !-d $dir);
+	foreach my $entry (&list_config_dir_files($dir)) {
+		$effective{$entry->[0]} = $entry->[1];
+		}
+	}
+
+# Match the wrapper's stable lexical order and omit files already reached by
+# an explicit include in the main configuration.  The existence check also
+# honors a local non-regular counterpart exactly as the wrapper does.
+my @rv;
+foreach my $name (sort { $a cmp $b } keys %effective) {
+	my $local = $config{'add_file'} ?
+		$config{'add_file'}.'/'.$name : undef;
+	my $f = $local && -e $local ? $local : $effective{$name};
+	next if ($files &&
+		 grep { &same_file($_, $f) } @$files);
+	push(@rv, $f);
+	}
+return @rv;
+}
+
+# get_scheduled_logrotate_command()
+# Returns the distro wrapper, or a command for the effective config files
+sub get_scheduled_logrotate_command
+{
+# The distro wrapper discovers the effective drop-in set on every run, so it
+# remains correct when packages or administrators add files later.
+if ($config{'logrotate_all'} && -x $config{'logrotate_all'}) {
+	return &quote_path($config{'logrotate_all'});
+	}
+
+# Preserve the historical command exactly on systems that do not opt into
+# external or vendor configuration discovery.
+if (!$config{'vendor_logrotate_conf'} && !$config{'vendor_add_file'} &&
+    !$config{'scan_add_file'}) {
+	return &has_command($config{'logrotate'})." ".
+		$config{'logrotate_conf'};
+	}
+
+# If the configured wrapper is unavailable, build a usable command from the
+# effective main config and the drop-ins visible at schedule creation time.
+my $main = &get_main_config_file();
+my (undef, undef, $files) = &get_config($main);
+my @configs = ($main, &get_add_file_configs($files));
+my $program = &has_command($config{'logrotate'}) || $config{'logrotate'};
+return &quote_path($program).' '.
+	join(' ', map { &quote_path($_) } @configs);
+}
+
 # get_config([file])
 # Returns a list of logrotate config file entries
 sub get_config
 {
-local $file = $_[0] || $config{'logrotate_conf'};
-if (!$_[0] && $get_config_cache{$file}) {
+my ($argfile) = @_;
+my $file = $argfile || &get_main_config_file();
+if (!$argfile && $get_config_cache{$file}) {
 	return wantarray ? ( $get_config_cache{$file},
 			     $get_config_lnum_cache{$file},
 			     $get_config_files_cache{$file} )
 			 : $get_config_cache{$file};
 	}
-local @files = ( $file );
-local @rv;
-local $addto = \@rv;
-local $section = undef;
-local $lnum = 0;
-local $fh = "FILE".$file_count++;
+my @files = ( $file );
+my @rv;
+my $addto = \@rv;
+my $section;
+my $lnum = 0;
+my $fh = "FILE".$file_count++;
 open($fh, "<".$file);
 while(<$fh>) {
 	s/\r|\n//g;
 	s/#.*$//;
 	if (/^\s*(.*)\{\s*$/) {
 		# Start of a section
-		push(@name, &split_words($1));
+		push(@name, &split_quoted_string($1));
 		$section = { 'name' => [ @name ],
 			     'members' => [ ],
 			     'index' => scalar(@$addto),
@@ -66,7 +295,7 @@ while(<$fh>) {
 	elsif ((/^\s*\// || /^\s*"\//) && !$section) {
 		# A path before a section
 		$namestart = $lnum if (!@name);
-		push(@name, &split_words($_));
+		push(@name, &split_quoted_string($_));
 		}
 	elsif (/^\s*}\s*$/) {
 		# End of a section
@@ -76,12 +305,12 @@ while(<$fh>) {
 		}
 	elsif (/^\s*include\s+(.*)$/i) {
 		# Including other directives files
-		local $incfile = $1;
+		my $incfile = $1;
 		if (-d $incfile) {
 			# Multiple files!
-			local $f;
+			my $f;
 			opendir(DIR, $incfile);
-			local @dirs = sort { $a cmp $b } readdir(DIR);
+			my @dirs = sort { $a cmp $b } readdir(DIR);
 			closedir(DIR);
 			foreach $f (@dirs) {
 				next if ($f =~ /^\./ ||
@@ -90,7 +319,7 @@ while(<$fh>) {
 					 $f =~ /,v$/ ||
 					 $f =~ /\.swp$/ ||
 					 $f =~ /\.lock$/);
-				local ($inc, $ilnum, $ifiles) =
+				my ($inc, $ilnum, $ifiles) =
 					&get_config("$incfile/$f");
 				push(@files, @$ifiles);
 				map { $_->{'index'} += @$addto } @$inc;
@@ -99,7 +328,7 @@ while(<$fh>) {
 			}
 		else {
 			# A single file
-			local ($inc, $ilnum, $ifiles) = &get_config($incfile);
+			my ($inc, $ilnum, $ifiles) = &get_config($incfile);
 			push(@files, @$ifiles);
 			map { $_->{'index'} += @$addto } @$inc;
 			push(@$addto, @$inc);
@@ -107,12 +336,12 @@ while(<$fh>) {
 		}
 	elsif (/^\s*(\S+)\s*(.*)$/) {
 		# Single directive
-		local $dir =  { 'name' => $1,
-				'value' => $2,
-			        'index' => scalar(@$addto),
-				'line' => $lnum,
-				'eline' => $lnum,
-				'file' => $file };
+		my $dir =  { 'name' => $1,
+			     'value' => $2,
+			     'index' => scalar(@$addto),
+			     'line' => $lnum,
+			     'eline' => $lnum,
+			     'file' => $file };
 		push(@$addto, $dir);
 		if ($1 eq 'postrotate' || $1 eq 'prerotate') {
 			# Followed by a multi-line script!
@@ -129,7 +358,13 @@ while(<$fh>) {
 	$lnum++;
 	}
 close($fh);
-if (!$_[0]) {
+if (!$argfile) {
+	foreach my $f (&get_add_file_configs(\@files)) {
+		my ($inc, undef, $ifiles) = &get_config($f);
+		map { $_->{'index'} += @rv } @$inc;
+		push(@rv, @$inc);
+		push(@files, @$ifiles);
+		}
 	$get_config_cache{$file} = \@rv;
 	$get_config_lnum_cache{$file} = $lnum;
 	$get_config_files_cache{$file} = \@files;
@@ -137,70 +372,112 @@ if (!$_[0]) {
 return wantarray ? (\@rv, $lnum, \@files) : \@rv;
 }
 
-sub split_words
-{
-local @rv;
-local $str = $_[0];
-while($str =~ /^\s*"(.*)"(.*)$/ || $str =~ /^\s*(\S+)(.*)$/) {
-	push(@rv, $1);
-	$str = $2;
-	}
-return @rv;
-}
-
+# join_words(word, ...)
+# Joins an array of words into a string, with quotes if needed
 sub join_words
 {
 return join(" ", map { /\s/ ? "\"$_\"" : $_ } @_);
 }
 
 # find(name, &config)
+# Returns an object or objects from the config with some name
 sub find
 {
-local @rv = grep { lc($_->{'name'}) eq lc($_[0]) } @{$_[1]};
+my ($name, $conf) = @_;
+my @rv = grep { lc($_->{'name'}) eq lc($name) } @$conf;
 return wantarray ? @rv : $rv[0];
 }
 
 # find_value(name, &config)
+# Returns a value or values from the config with some name
 sub find_value
 {
-local @rv = map { defined($_->{'script'}) ? $_->{'script'} : $_->{'value'} }
-		grep { lc($_->{'name'}) eq lc($_[0]) } @{$_[1]};
+my ($name, $conf) = @_;
+my @rv = map { defined($_->{'script'}) ? $_->{'script'} : $_->{'value'} }
+	     grep { lc($_->{'name'}) eq lc($name) } @$conf;
 return wantarray ? @rv : $rv[0];
 }
 
-# get_logrotate_version(&out)
+# get_logrotate_version([&out])
+# Returns the version number, and saves the full -v output to the out param
 sub get_logrotate_version
 {
-local $out = &backquote_command("$config{'logrotate'} -v 2>&1", 1);
-${$_[0]} = $out if ($_[0]);
+my ($rv) = @_;
+my $out = &backquote_command("$config{'logrotate'} -v 2>&1", 1);
+$$rv = $out if ($rv);
 return $out =~ /logrotate\s+([0-9\.]+)\s/ ||
        $out =~ /logrotate\-([0-9\.]+)\s/ ? $1 : undef;
 }
 
 # get_period(&conf)
+# Returns the rotation time period set in the config
 sub get_period
 {
-foreach $p ("daily", "weekly", "monthly") {
-	local $ex = &find($p, $_[0]);
+my ($conf) = @_;
+foreach my $p ("daily", "weekly", "monthly") {
+	my $ex = &find($p, $conf);
 	return $p if ($ex);
 	}
 return undef;
 }
 
 # save_directive(&parent, &old|name, &new, [indent])
+# Updates one entry identified by either its name or parsed object
 sub save_directive
 {
-local $conf = $_[0]->{'members'};
-local $old = !defined($_[1]) ? undef : ref($_[1]) ? $_[1] : &find($_[1], $conf);
-local $lref = &read_file_lines($old ? $old->{'file'} : $_[0]->{'file'});
-local $new = !defined($_[2]) ? undef : ref($_[2]) ? $_[2] :
-			{ 'name' => $old ? $old->{'name'} : $_[1],
-		     	  'value' => $_[2] };
-local @lines = &directive_lines($new, $_[3]) if ($new);
-local $gparent = &get_config_parent();
+my ($parent, $oldv, $newv, $indent) = @_;
+my $conf = $parent->{'members'};
+my $old = !defined($oldv) ? undef : ref($oldv) ? $oldv : &find($oldv, $conf);
+my $new = !defined($newv) ? undef : ref($newv) ? $newv :
+			{ 'name' => $old ? $old->{'name'} : $oldv,
+		     	  'value' => $newv };
+
+# Deleting an entry that is already absent is a true no-op. In particular,
+# do not put a missing local main config into the writable line cache.
+return if (!$old && !$new);
+
+# Find the file behind this write. Existing directives use their own file,
+# new sections may name a separate file, and other additions use the parent
+# section or effective main config.
+my $vendor_file;
+my $write_file = $parent->{'file'};
+if ($old) {
+	$write_file = $old->{'file'};
+	}
+elsif ($new && $new->{'file'} &&
+       !($parent->{'global'} && !$new->{'members'})) {
+	$write_file = $new->{'file'};
+	}
+if ($write_file) {
+	my $shadowed_vendor = &get_vendor_config_file($write_file);
+	if (&is_vendor_main_config($write_file) ||
+	    &is_vendor_config_file($write_file)) {
+		$vendor_file = $write_file;
+		}
+	elsif ($shadowed_vendor &&
+	       (!-f $write_file || -l $write_file ||
+		&same_file($write_file, $shadowed_vendor))) {
+		$vendor_file = $shadowed_vendor;
+		}
+	}
+if (!$vendor_file && !$old && $parent->{'global'} &&
+	&same_file($write_file, $parent->{'file'}) &&
+	&is_vendor_main_config(&get_main_config_file())) {
+	$vendor_file = &get_main_config_file();
+	}
+
+# Copying changes which file owns the parsed objects, so callers must create
+# and reload a local override before editing.  Never write through a stale
+# object that still points at the vendor tree.
+&error(&text('save_evendorwrite',
+	"<tt>".&html_escape($vendor_file)."</tt>")) if ($vendor_file);
+
+my $lref = &read_file_lines($write_file);
+my @lines = &directive_lines($new, $indent) if ($new);
+my $gparent = &get_config_parent();
 if ($old && $new) {
 	# Update
-	local $oldlines = $old->{'eline'} - $old->{'line'} + 1;
+	my $oldlines = $old->{'eline'} - $old->{'line'} + 1;
 	splice(@$lref, $old->{'line'}, $oldlines, @lines);
 	$new->{'line'} = $old->{'line'};
 	$new->{'index'} = $old->{'index'};
@@ -212,18 +489,18 @@ if ($old && $new) {
 	}
 elsif ($old && !$new) {
 	# Delete
-	local $oldlines = $old->{'eline'} - $old->{'line'} + 1;
+	my $oldlines = $old->{'eline'} - $old->{'line'} + 1;
 	splice(@$lref, $old->{'line'}, $old->{'eline'} - $old->{'line'} + 1);
 	splice(@$conf, $old->{'index'}, 1);
 	&renumber($gparent, $old->{'file'}, $old->{'line'}, -$oldlines);
 	}
-elsif (!$old && $new && $_[0]->{'global'} && !$new->{'members'}) {
+elsif (!$old && $new && $parent->{'global'} && !$new->{'members'}) {
 	# Add at the start of the file
-	if (defined($_[0]->{'line'})) {
+	if (defined($parent->{'line'})) {
 		splice(@$lref, 0, 0, @lines);
 		$new->{'line'} = 0;
 		$new->{'eline'} = $new->{'line'} + scalar(@lines) - 1;
-		$new->{'file'} = $_[0]->{'file'};
+		$new->{'file'} = $parent->{'file'};
 		&renumber($gparent, $new->{'file'}, $new->{'line'}-1, scalar(@lines));
 		}
 	$new->{'index'} = 0;
@@ -231,18 +508,18 @@ elsif (!$old && $new && $_[0]->{'global'} && !$new->{'members'}) {
 	}
 elsif (!$old && $new) {
 	# Add (to end of section)
-	if (defined($_[0]->{'line'})) {
-		if (!$new->{'file'} || $_[0]->{'file'} eq $new->{'file'}) {
+	if (defined($parent->{'line'})) {
+		if (!$new->{'file'} || $parent->{'file'} eq $new->{'file'}) {
 			# Adding to parent file
-			splice(@$lref, $_[0]->{'eline'}, 0, @lines);
-			$new->{'line'} = $_[0]->{'eline'};
+			splice(@$lref, $parent->{'eline'}, 0, @lines);
+			$new->{'line'} = $parent->{'eline'};
 			$new->{'eline'} = $new->{'line'} + scalar(@lines) - 1;
-			$new->{'file'} = $_[0]->{'file'};
+			$new->{'file'} = $parent->{'file'};
 			&renumber($gparent, $new->{'file'}, $new->{'line'}-1, scalar(@lines));
 			}
 		else {
 			# Adding to another file
-			local $lref2 = &read_file_lines($new->{'file'});
+			my $lref2 = &read_file_lines($new->{'file'});
 			$new->{'line'} = scalar(@$lref2);
 			$new->{'eline'} = $new->{'line'} + scalar(@lines) - 1;
 			push(@$lref2, @lines);
@@ -254,52 +531,60 @@ elsif (!$old && $new) {
 }
 
 # renumber(&object, file, startline, count, [&skip])
+# Update line numbers in the config that are in some file and after
+# some line
 sub renumber
 {
-return if (!$_[3]);
-if ($_[0]->{'file'} eq $_[1] && $_[0] ne $_[4]) {
-	$_[0]->{'line'} += $_[3] if ($_[0]->{'line'} > $_[2]);
-	$_[0]->{'eline'} += $_[3] if ($_[0]->{'eline'} > $_[2]);
+my ($conf, $file, $start, $count, $skip) = @_;
+return if (!$count);
+if ($conf->{'file'} eq $file && $conf ne $skip) {
+	$conf->{'line'} += $count if ($conf->{'line'} > $start);
+	$conf->{'eline'} += $count if ($conf->{'eline'} > $start);
 	}
-if ($_[0]->{'members'}) {
-	local $c;
-	foreach $c (@{$_[0]->{'members'}}) {
-		&renumber($c, $_[1], $_[2], $_[3], $_[4]);
+if ($conf->{'members'}) {
+	foreach my $c (@{$conf->{'members'}}) {
+		&renumber($c, $file, $start, $count, $skip);
 		}
 	}
 }
 
 # directive_lines(&dir, indent)
+# Returns an array of lines to add to the config file for some directive
 sub directive_lines
 {
-local @rv;
-if ($_[0]->{'members'}) {
-	push(@rv, $_[1].&join_words(@{$_[0]->{'name'}})." {");
-	foreach $m (@{$_[0]->{'members'}}) {
-		push(@rv, &directive_lines($m, $_[1]."\t"));
+my ($dir, $indent) = @_;
+my @rv;
+if ($dir->{'members'}) {
+	push(@rv, $indent.&join_words(@{$dir->{'name'}})." {");
+	foreach my $m (@{$dir->{'members'}}) {
+		push(@rv, &directive_lines($m, $indent."\t"));
 		}
-	push(@rv, $_[1]."}");
+	push(@rv, $indent."}");
 	}
-elsif ($_[0]->{'script'}) {
-	push(@rv, $_[1].$_[0]->{'name'});
-	foreach $s (split(/\n/, $_[0]->{'script'})) {
-		push(@rv, $_[1].$s);
+elsif ($dir->{'script'}) {
+	push(@rv, $indent.$dir->{'name'});
+	foreach my $s (split(/\n/, $dir->{'script'})) {
+		push(@rv, $indent.$s);
 		}
-	push(@rv, $_[1]."endscript");
+	push(@rv, $indent."endscript");
 	}
 else {
-	push(@rv, $_[1].$_[0]->{'name'}.
-		  ($_[0]->{'value'} eq "" ? "" : " ".$_[0]->{'value'}));
+	push(@rv, $indent.$dir->{'name'}.
+		  ($dir->{'value'} eq "" ? "" : " ".$dir->{'value'}));
 	}
 return @rv;
 }
 
 # delete_if_empty(file)
+# Removes a file if it has no more parsed entries, unless it is a local
+# override whose continued existence is needed to hide a vendor file
 sub delete_if_empty
 {
-local $conf = &get_config();
-local %files = map { $_, 1 } &unique(map { $_->{'file'} } @$conf);
-&unlink_file($_[0]) if (!$files{$_[0]});
+my ($file) = @_;
+return if (&get_vendor_config_file($file));
+my $conf = &get_config();
+my %files = map { $_, 1 } &unique(map { $_->{'file'} } @$conf);
+&unlink_file($file) if (!$files{$file});
 }
 
 %global_default = ( "nocompress" => "",
@@ -333,19 +618,19 @@ local %files = map { $_, 1 } &unique(map { $_->{'file'} } @$conf);
 # immediately.
 sub rotate_log_now
 {
-local $conf = &get_config();
-local $temp = &transname();
+my ($dir) = @_;
+my $conf = &get_config();
+my $temp = &transname();
 open(TEMP, ">$temp");
-local $c;
-foreach $c (@$conf) {
+foreach my $c (@$conf) {
 	if (!$c->{'members'}) {
 		print TEMP map { "$_\n" } &directive_lines($c);
 		}
 	}
-print TEMP map { "$_\n" } &directive_lines($_[0]);
+print TEMP map { "$_\n" } &directive_lines($dir);
 close(TEMP);
 &set_ownership_permissions(undef, undef, 0644, $temp);
-local $out = &backquote_logged("$config{'logrotate'} -f $temp 2>&1");
+my $out = &backquote_logged("$config{'logrotate'} -f $temp 2>&1");
 return ($?, $out);
 }
 
@@ -353,7 +638,7 @@ return ($?, $out);
 # Returns the file to which new logrotate sections should be added
 sub get_add_file
 {
-local ($filename) = @_;
+my ($filename) = @_;
 $filename =~ s/\*/ALL/g;
 if ($config{'add_file'} && -d $config{'add_file'} && $filename) {
 	# Adding to a new file in a directory
@@ -361,7 +646,7 @@ if ($config{'add_file'} && -d $config{'add_file'} && $filename) {
 	}
 elsif ($config{'add_file'} && !-d $config{'add_file'}) {
 	# Make sure file is valid
-	local ($conf, $lnum, $files) = &get_config();
+	my ($conf, $lnum, $files) = &get_config();
 	if (&indexof($config{'add_file'}, @$files) >= 0) {
 		return $config{'add_file'};
 		}
@@ -370,4 +655,3 @@ return $config{'logrotate_conf'};
 }
 
 1;
-

logrotate/save_log.cgi

@@ -4,18 +4,56 @@
 
 require './logrotate-lib.pl';
 &ReadParse();
+
+# Resolve a new section's destination before loading any parsed objects. If
+# its relative name already exists in the vendor tree, materialize the whole
+# local override before appending the new section.
+@files = split(/\s+/, $in{'file'});
+if ($in{'new'} ||
+    (!$in{'global'} && !$in{'delete'} && !$in{'now'})) {
+	&error_setup($text{'save_err'});
+	foreach $f (@files) {
+		$f =~ /^\/\S+$/ || &error($text{'save_efile'});
+		}
+	@files || &error($text{'save_enofiles'});
+	$in{'file'} =~ s/\r//g;
+	}
+if ($in{'new'}) {
+	$cfilename = $files[0] =~ /\/([^\/]+)$/ ? $1 : undef;
+	$new_config_file = &get_add_file($cfilename);
+	$vendor_file = &get_vendor_config_file($new_config_file);
+	if ($vendor_file) {
+		&ensure_local_config_override($vendor_file);
+		}
+	elsif (&same_file($new_config_file, $config{'logrotate_conf'}) &&
+	       &is_vendor_main_config(&get_main_config_file())) {
+		&ensure_local_main_config();
+		}
+	}
+
+# On systems with vendor configuration below /usr, create the writable local
+# main config before changing global options.  The parent object intentionally
+# keeps this local path as its write destination.
+&ensure_local_main_config() if ($in{'global'});
 $parent = &get_config_parent();
 $conf = $parent->{'members'};
-@files = split(/\s+/, $in{'file'});
+
+# A local drop-in shadows the whole vendor file, so copy it intact before
+# editing or deleting one section.  Rotate Now is read-only and needs no copy.
+if (!$in{'global'} && !$in{'new'} && !$in{'now'} &&
+    &is_vendor_config_file($conf->[$in{'idx'}]->{'file'})) {
+	&ensure_local_config_override($conf->[$in{'idx'}]->{'file'});
+	$parent = &get_config_parent();
+	$conf = $parent->{'members'};
+	}
 if ($in{'global'}) {
 	# Editing the global options
 	$log = $parent;
 	}
 elsif ($in{'new'}) {
 	# Adding a new section
-	$cfilename = $files[0] =~ /\/([^\/]+)$/ ? $1 : undef;
 	$log = { 'members' => [ ],
-		 'file' => &get_add_file($cfilename) };
+		 'file' => $new_config_file };
 	$logfile = $in{'file'};
 	}
 else {
@@ -35,8 +73,13 @@ elsif ($in{'now'}) {
 
 	print $text{'force_doingone'},"\n";
 	($ex, $out) = &rotate_log_now($log);
-	print "<pre>$out</pre>";
-	if ($?) {
+	if ($out =~ /\S/) {
+		print "<pre>",&html_escape($out),"</pre>";
+		}
+	else {
+		print "<br>\n";
+		}
+	if ($ex) {
 		print $text{'force_failed'},"<br>\n";
 		}
 	else {
@@ -52,11 +95,6 @@ else {
 	&lock_file($log->{'file'});
 	&error_setup($text{'save_err'});
 	if (!$in{'global'}) {
-		foreach $f (@files) {
-			$f =~ /^\/\S+$/ || &error($text{'save_efile'});
-			}
-		@files || &error($text{'save_enofiles'});
-		$in{'file'} =~ s/\r//g;
 		$log->{'name'} = [ split(/\n/, $in{'file'}) ];
 		}
 

logrotate/save_sched.cgi

@@ -11,9 +11,10 @@ if ($in{'idx'} ne "") {
 	$oldjob = $job = $jobs[$in{'idx'}];
 	}
 else {
+	# Prefer the distro wrapper, when available, so future runs discover the
+	# then-current vendor and local drop-in set.
 	$job = { 'user' => 'root',
-		 'command' => &has_command($config{'logrotate'})." ".
-			      $config{'logrotate_conf'},
+		 'command' => &get_scheduled_logrotate_command(),
 		 'active' => 1 };
 	}
 &lock_file(&cron::cron_file($job));

logrotate/t/run-tests.t

@@ -0,0 +1,379 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Test::More;
+use Cwd qw(abs_path);
+use File::Basename qw(dirname);
+use File::Path qw(make_path);
+use File::Temp qw(tempdir);
+
+# Locate the repository and load its common test helpers.
+my $test_dir = dirname(abs_path($0));
+my $module_dir = abs_path("$test_dir/..");
+my $root_dir = abs_path("$module_dir/..");
+require "$root_dir/t/test-lib.pl";
+
+# Build an isolated openSUSE-style /etc and /usr/etc configuration layout.
+my $config_dir = tempdir(CLEANUP => 1);
+my $var_dir = tempdir(CLEANUP => 1);
+my $fixture_dir = tempdir(CLEANUP => 1);
+my $local_add_dir = "$fixture_dir/etc/logrotate.d";
+my $vendor_add_dir = "$fixture_dir/usr/etc/logrotate.d";
+my $local_main_file = "$fixture_dir/etc/logrotate.conf";
+my $vendor_main_file = "$fixture_dir/usr/etc/logrotate.conf";
+my $wrapper = "$fixture_dir/usr/sbin/logrotate-all";
+make_path("$config_dir/logrotate", $local_add_dir,
+	  "$local_add_dir/nested", "$vendor_add_dir/deep",
+	  "$vendor_add_dir/nested", dirname($wrapper));
+
+# Populate both trees with vendor-only, local-only, nested, and overridden
+# files so the fixture exercises the wrapper's key overlay rules.
+my $vendor_main_text =
+	"weekly\n/var/log/vendor-main.log {\n\trotate 4\n}\n";
+write_text("$config_dir/config", "os_type=linux\nos_version=0\n");
+write_text("$config_dir/logrotate/config",
+	"sort_mode=0\n".
+	"logrotate_conf=$local_main_file\n".
+	"vendor_logrotate_conf=$vendor_main_file\n".
+	"add_file=$local_add_dir\n".
+	"vendor_add_file=$vendor_add_dir\n".
+	"scan_add_file=1\n".
+	"logrotate=/bin/echo\n".
+	"logrotate_all=$wrapper\n");
+write_text($vendor_main_file, $vendor_main_text);
+write_text("$vendor_add_dir/one", "/var/log/vendor-one.log {\n\tdaily\n}\n");
+write_text("$vendor_add_dir/shared",
+	"/var/log/vendor-shared.log {\n\tdaily\n}\n");
+write_text("$vendor_add_dir/deep/vendor",
+	"/var/log/deep-vendor.log {\n\tmonthly\n}\n");
+write_text("$local_add_dir/local-only",
+	"/var/log/local-only.log {\n\tweekly\n}\n");
+write_text("$local_add_dir/shared",
+	"/var/log/local-shared.log {\n\tweekly\n}\n");
+write_text("$local_add_dir/nested/local",
+	"/var/log/nested-local.log {\n\tweekly\n}\n");
+write_text($wrapper, "#!/bin/sh\nexit 0\n");
+chmod(0755, $wrapper) or die "chmod $wrapper: $!";
+
+# Point Webmin at the isolated fixture before loading the module library.
+$ENV{'WEBMIN_CONFIG'} = $config_dir;
+$ENV{'WEBMIN_VAR'} = $var_dir;
+$ENV{'FOREIGN_MODULE_NAME'} = 'logrotate';
+$ENV{'FOREIGN_ROOT_DIRECTORY'} = $root_dir;
+chdir($module_dir) or die "chdir $module_dir: $!";
+require "$module_dir/logrotate-lib.pl";
+
+# clear_config_cache()
+# Forces each test phase to parse the configuration from disk again
+sub clear_config_cache
+{
+no warnings 'once';
+%main::get_config_cache = ( );
+%main::get_config_lnum_cache = ( );
+%main::get_config_files_cache = ( );
+$main::get_config_parent_cache = undef;
+}
+
+# log_names(config)
+# Returns only the log path names from parsed rotation sections
+sub log_names
+{
+my ($config) = @_;
+return [ map { $_->{'name'}->[0] }
+	 grep { $_->{'members'} } @$config ];
+}
+
+# The vendor main file is the initial fallback because no local main exists.
+is(main::get_main_config_file(), $vendor_main_file,
+	'vendor main config is used when no local main config exists');
+ok(main::is_vendor_main_config($vendor_main_file),
+	'vendor main config is recognized');
+
+# Match the wrapper's existence test rather than requiring a regular file.
+my $nonregular_main = "$fixture_dir/etc/nonregular-main";
+make_path($nonregular_main);
+{
+local $main::config{'logrotate_conf'} = $nonregular_main;
+is(main::get_main_config_file(), $nonregular_main,
+	'local main path wins whenever it exists');
+}
+{
+local $main::config{'logrotate_conf'} = "$fixture_dir/etc/missing-main";
+local $main::config{'vendor_logrotate_conf'} =
+	"$fixture_dir/usr/etc/missing-main";
+is(main::get_main_config_file(), $main::config{'vendor_logrotate_conf'},
+	'configured vendor main path is used whenever the local path is absent');
+}
+
+# The effective list is sorted by relative path, with local files replacing
+# vendor files that have the same relative path.
+my @effective_add_files = (
+	"$vendor_add_dir/deep/vendor",
+	"$local_add_dir/local-only",
+	"$local_add_dir/nested/local",
+	"$vendor_add_dir/one",
+	"$local_add_dir/shared",
+	);
+my ($config, undef, $files) = main::get_config();
+is_deeply(log_names($config),
+	[ '/var/log/vendor-main.log', '/var/log/deep-vendor.log',
+	  '/var/log/local-only.log', '/var/log/nested-local.log',
+	  '/var/log/vendor-one.log', '/var/log/local-shared.log' ],
+	'vendor and local trees are recursively merged with local precedence');
+is_deeply([ map { $_->{'index'} } grep { $_->{'members'} } @$config ],
+	[ 1, 2, 3, 4, 5, 6 ],
+	'effective sections keep stable top-level indexes');
+is_deeply($files, [ $vendor_main_file, @effective_add_files ],
+	'file cache contains the effective main and merged drop-ins');
+ok(!grep({ $_ eq "$vendor_add_dir/shared" } @$files),
+	'local file hides the same relative vendor file');
+
+my (undef, undef, $primary_files) = main::get_config($vendor_main_file);
+is_deeply([ main::get_add_file_configs($primary_files) ],
+	\@effective_add_files,
+	'externally loaded configuration files match the effective overlay');
+is(main::get_scheduled_logrotate_command(), main::quote_path($wrapper),
+	'scheduled rotations use the distribution wrapper');
+
+# Disabling the opt-in must restore the behavior used by other distributions.
+$main::config{'scan_add_file'} = 0;
+clear_config_cache();
+($config, undef, $files) = main::get_config();
+is_deeply(log_names($config), [ '/var/log/vendor-main.log' ],
+	'vendor and local trees are not scanned without explicit opt-in');
+is_deeply($files, [ $vendor_main_file ],
+	'file cache excludes external directories when scanning is disabled');
+
+# The low-level writer must fail closed if a caller skips copy-on-write.
+{
+no warnings qw(once redefine);
+local *main::error = sub { die $_[0]; };
+eval {
+	main::save_directive(main::get_config_parent(), 'weekly', '');
+	};
+like($@, qr/Refusing to modify vendor configuration/,
+	'direct writes to the vendor main configuration are rejected');
+}
+
+# Deleting an already-absent option is a no-op and must not cache an empty
+# local main file that a later unscoped flush could accidentally create.
+main::save_directive(main::get_config_parent(),
+	'missing-vendor-option', undef);
+main::flush_file_lines();
+ok(!-e $local_main_file,
+	'missing global option deletion leaves the local main config absent');
+
+# A new section with an explicit vendor destination must also fail closed.
+my $vendor_target = "$vendor_add_dir/one";
+my $vendor_target_text = read_text($vendor_target);
+{
+no warnings qw(once redefine);
+local *main::error = sub { die $_[0]; };
+eval {
+	main::save_directive(main::get_config_parent(), undef,
+		{ 'file' => $vendor_target,
+		  'name' => [ '/var/log/unsafe-vendor-write.log' ],
+		  'members' => [ ] });
+	};
+like($@, qr/Refusing to modify vendor configuration/,
+	'new sections cannot target a vendor drop-in directly');
+}
+is(read_text($vendor_target), $vendor_target_text,
+	'rejecting a new vendor section leaves its destination unchanged');
+
+# A section without its own file would create an incomplete local main config.
+{
+no warnings qw(once redefine);
+local *main::error = sub { die $_[0]; };
+eval {
+	main::save_directive(main::get_config_parent(), undef,
+		{ 'name' => [ '/var/log/unsafe-main-write.log' ],
+		  'members' => [ ] });
+	};
+like($@, qr/Refusing to modify vendor configuration/,
+	'new sections cannot replace the vendor main config implicitly');
+}
+ok(!-e $local_main_file,
+	'rejecting an implicit main write does not create a partial override');
+
+# Adding a fresh local drop-in must not put the absent local main in the line
+# cache, because the normal unscoped flush would then create it as an empty
+# file and hide the complete vendor main configuration.
+my $new_local_dropin = "$local_add_dir/new-local";
+main::save_directive(main::get_config_parent(), undef,
+	{ 'file' => $new_local_dropin,
+	  'name' => [ '/var/log/new-local.log' ],
+	  'members' => [ { 'name' => 'weekly' } ] });
+main::flush_file_lines();
+ok(-f $new_local_dropin,
+	'new sections are written to their explicit local drop-in');
+ok(!-e $local_main_file,
+	'adding a local drop-in does not create an empty local main config');
+is(read_text($vendor_main_file), $vendor_main_text,
+	'adding a local drop-in leaves the vendor main config unchanged');
+
+# A missing local file cannot safely replace a whole same-named vendor file.
+my $missing_local_override = "$local_add_dir/one";
+{
+no warnings qw(once redefine);
+local *main::error = sub { die $_[0]; };
+eval {
+	main::save_directive(main::get_config_parent(), undef,
+		{ 'file' => $missing_local_override,
+		  'name' => [ '/var/log/incomplete-override.log' ],
+		  'members' => [ ] });
+	};
+like($@, qr/Refusing to modify vendor configuration/,
+	'new sections cannot create incomplete vendor overrides');
+}
+ok(!-e $missing_local_override,
+	'rejecting an incomplete override leaves its local path absent');
+
+# Editing global options materializes an exact local copy before parsing.
+$main::config{'scan_add_file'} = 1;
+clear_config_cache();
+is(main::ensure_local_main_config(), $local_main_file,
+	'editing the vendor main config creates a local main config');
+is(read_text($local_main_file), $vendor_main_text,
+	'local main config starts as an exact vendor copy');
+is(read_text($vendor_main_file), $vendor_main_text,
+	'copying the main config does not alter the vendor file');
+is(main::get_main_config_file(), $local_main_file,
+	'local main config takes precedence after it is created');
+
+# A new section may be appended after the same-named vendor file has been
+# copied in full, which is the preflight performed by save_log.cgi.
+is(main::ensure_local_config_override($vendor_target),
+	$missing_local_override,
+	'new-section preflight creates the complete local override');
+my $prepared_parent = main::get_config_parent();
+main::save_directive($prepared_parent, undef,
+	{ 'file' => $missing_local_override,
+	  'name' => [ '/var/log/appended-local.log' ],
+	  'members' => [ { 'name' => 'weekly' } ] });
+main::flush_file_lines($missing_local_override);
+like(read_text($missing_local_override), qr{/var/log/vendor-one\.log},
+	'prepared override retains the original vendor section');
+like(read_text($missing_local_override), qr{/var/log/appended-local\.log},
+	'prepared override receives the new local section');
+is(read_text($vendor_target), $vendor_target_text,
+	'appending locally leaves the same-named vendor file unchanged');
+
+# Editing a vendor drop-in must also be prepared before parsed objects change.
+my $vendor_dropin = "$vendor_add_dir/deep/vendor";
+my $local_dropin = "$local_add_dir/deep/vendor";
+($config, undef, $files) = main::get_config();
+my ($deep_log) = grep { $_->{'members'} &&
+			       $_->{'name'}->[0] eq '/var/log/deep-vendor.log' }
+			 @$config;
+{
+no warnings qw(once redefine);
+local *main::error = sub { die $_[0]; };
+eval { main::save_directive($deep_log, 'monthly', '', "\t"); };
+like($@, qr/Refusing to modify vendor configuration/,
+	'direct writes to a vendor drop-in are rejected');
+}
+is(main::ensure_local_config_override($vendor_dropin), $local_dropin,
+	'editing a vendor drop-in creates its matching local override');
+is(read_text($local_dropin), read_text($vendor_dropin),
+	'local drop-in starts as an exact copy of the whole vendor file');
+is(main::get_local_override_file($vendor_dropin), $local_dropin,
+	'vendor drop-in maps to the correct writable path');
+is(main::get_vendor_config_file($local_dropin), $vendor_dropin,
+	'local override maps back to the shadowed vendor file');
+
+($config, undef, $files) = main::get_config();
+($deep_log) = grep { $_->{'members'} &&
+			    $_->{'name'}->[0] eq '/var/log/deep-vendor.log' }
+		      @$config;
+is($deep_log->{'file'}, $local_dropin,
+	'parser switches to the local copy after an override is created');
+main::save_directive($deep_log, 'monthly', undef, "\t");
+main::flush_file_lines($local_dropin);
+unlike(read_text($local_dropin), qr/^\s*monthly\s*$/m,
+	'prepared drop-in can be changed through its local override');
+like(read_text($vendor_dropin), qr/^\s*monthly\s*$/m,
+	'changing the local override leaves the vendor drop-in unchanged');
+
+# An empty local file must remain both effective and backup-visible because
+# its existence is what prevents the vendor file from becoming active again.
+write_text($local_dropin, '');
+clear_config_cache();
+main::delete_if_empty($local_dropin);
+ok(-e $local_dropin,
+	'empty local override is retained so the vendor file stays disabled');
+(undef, undef, $files) = main::get_config();
+ok(grep({ $_ eq $local_dropin } @$files),
+	'empty local override remains in the effective file cache for backups');
+ok(!grep({ $_ eq $vendor_dropin } @$files),
+	'empty local override continues to hide the vendor file');
+
+# Explicit includes and external discovery must not parse the same file twice.
+write_text($local_main_file,
+	"weekly\ninclude $local_add_dir\n".
+	"/var/log/main.log {\n\trotate 4\n}\n");
+clear_config_cache();
+($config, undef, $files) = main::get_config();
+is(scalar(grep { $_->{'members'} &&
+			 $_->{'name'}->[0] eq '/var/log/local-only.log' }
+		 @$config), 1,
+	'explicitly included files are not parsed a second time');
+is(scalar(grep { main::same_file($_, "$local_add_dir/local-only") }
+		 @$files), 1,
+	'explicit include is represented once in the file cache');
+
+# A local path selected by the wrapper's existence check wins even when find
+# discovers the relative name only from the regular vendor file.
+my $edge_dir = tempdir(CLEANUP => 1);
+my $edge_local_dir = "$edge_dir/etc/logrotate.d";
+my $edge_vendor_dir = "$edge_dir/usr/etc/logrotate.d";
+my $edge_target = "$edge_dir/local-target";
+make_path($edge_local_dir, $edge_vendor_dir);
+write_text("$edge_vendor_dir/linked", "vendor\n");
+write_text($edge_target, "local\n");
+symlink($edge_target, "$edge_local_dir/linked") or
+	die "symlink $edge_local_dir/linked: $!";
+{
+local $main::config{'add_file'} = $edge_local_dir;
+local $main::config{'vendor_add_file'} = $edge_vendor_dir;
+is_deeply([ main::get_add_file_configs() ], [ "$edge_local_dir/linked" ],
+	'local existing path overrides the matching vendor file');
+
+# Discovery follows the wrapper's existence rule, but editing must not follow
+# a local symlink when it shadows a same-named vendor configuration.
+{
+no warnings qw(once redefine);
+local *main::error = sub { die $_[0]; };
+eval {
+	main::save_directive(
+		{ 'members' => [ ], 'file' => "$edge_dir/parent" },
+		undef,
+		{ 'file' => "$edge_local_dir/linked",
+		  'name' => [ '/var/log/symlink-write.log' ],
+		  'members' => [ ] });
+	};
+like($@, qr/Refusing to modify vendor configuration/,
+	'local symlink overrides are rejected for editing');
+}
+is(read_text($edge_target), "local\n",
+	'rejecting a symlink override leaves its target unchanged');
+}
+
+# A regular local path must still be rejected when it is a hard link to its
+# vendor source, because otherwise an apparently local write would alter /usr.
+my $hardlink_dir = tempdir(CLEANUP => 1);
+my $hardlink_vendor = "$hardlink_dir/vendor";
+my $hardlink_local = "$hardlink_dir/local";
+write_text($hardlink_vendor, "vendor\n");
+link($hardlink_vendor, $hardlink_local) or
+	die "link $hardlink_local: $!";
+{
+no warnings qw(once redefine);
+local *main::error = sub { die $_[0]; };
+eval { main::copy_vendor_config($hardlink_vendor, $hardlink_local); };
+ok($@, 'a hard-linked local override is rejected');
+}
+is(read_text($hardlink_vendor), "vendor\n",
+	'rejecting a hard-linked override leaves the vendor source unchanged');
+
+done_testing();

makedist.pl

@@ -30,7 +30,7 @@ $vers || usage();
 	  "miniserv.pl", "miniserv-lib.pl", "os_list.txt", "perlpath.pl",
 	  "setup.sh", "setup.pl", "setup.bat",
 	  "setup-repos.sh", "version", "web-lib.pl", "web-lib-funcs.pl",
-	  "config_save.cgi", "chooser.cgi", "miniserv.pem",
+	  "config_save.cgi", "chooser.cgi",
 	  "config-aix", "update-from-repo.sh", "README.md",
 	  "newmods.pl", "copyconfig.pl", "config-hpux", "config-freebsd",
 	  "changepass.pl", "help.cgi", "user_chooser.cgi",
@@ -40,7 +40,7 @@ $vers || usage();
 	  "webmin-systemd", "webmin-init", "webmin-daemon",
 	  "config-openbsd",
 	  "config-macos", "LICENCE",
-	  "session_login.cgi", "acl_security.pl",
+	  "session_login.cgi", "login-lib.pl", "acl_security.pl",
 	  "defaultacl", "rpc.cgi", "date_chooser.cgi",
 	  "safeacl", "install-module.pl", "LICENCE.ja", 
 	  "favicon.ico", "config-netbsd", "fastrpc.cgi",
@@ -50,7 +50,7 @@ $vers || usage();
 	  "webmin-openrc-init", "run-postinstalls.pl",
 	  "config-lib.pl", "entities_map.txt", "ui-lib.pl",
 	  "password_form.cgi", "password_change.cgi", "pam_login.cgi",
-	  "module_chooser.cgi", "config-windows", "xmlrpc.cgi",
+	  "module_chooser.cgi", "config-windows", "xmlrpc.cgi", "xmlrpc-lib.pl",
 	  "uptracker.cgi", "create-module.pl", "webmin_search.cgi",
 	  "webmin-search-lib.pl", "WebminCore.pm",
 	  "record-login.pl", "record-logout.pl", "record-failed.pl",

miniserv.pem

@@ -1,49 +0,0 @@
------BEGIN CERTIFICATE-----
-MIIDejCCAmKgAwIBAgIUI7oycX7XtLsNCJb1v2GGl1pZS28wDQYJKoZIhvcNAQEL
-BQAwNzESMBAGA1UEAwwJbG9jYWxob3N0MQswCQYDVQQGEwJVUzEUMBIGA1UEBwwL
-U2FudGEgQ2xhcmEwHhcNMjIxMDEwMjEyNzI4WhcNMzIxMDA3MjEyNzI4WjA3MRIw
-EAYDVQQDDAlsb2NhbGhvc3QxCzAJBgNVBAYTAlVTMRQwEgYDVQQHDAtTYW50YSBD
-bGFyYTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBANSUOgVKjclwwmdL
-OD3jSKHjuS9YqmfVqB+AyUfE97Lq9qvmydbSrpaEvXgmcG8Qlh6PwtIH9dSmCYl8
-obftWC4ReN4ubl5meyEc0BRZmEPxC8j6s18S8ICTEQ7ZiNxoDwAciXA2Op6sAuS4
-42HxcArHFpRXYMrgwGP4mes4j3L6ugWivvpz0zGDMNG+zWlMnlx9NJ4klSVvDueW
-bsAd+KPuzF5S4QaTJ0oASu5UCK/JmHpDtXFGDwm72fWNdfspRYblSrmxFFiZUNoQ
-t9iggMMaPlxIwajLTvrDi/Jzp0OXKdu5fRRsgPmzvgq/SWH9kDidZwpxw67BC1rm
-g/EDtmMCAwEAAaN+MHwwHQYDVR0OBBYEFCjRwPscxpufLiIXn8nPb5S8ruIMMB8G
-A1UdIwQYMBaAFCjRwPscxpufLiIXn8nPb5S8ruIMMA8GA1UdEwEB/wQFMAMBAf8w
-FAYDVR0RBA0wC4IJbG9jYWxob3N0MBMGA1UdJQQMMAoGCCsGAQUFBwMBMA0GCSqG
-SIb3DQEBCwUAA4IBAQAAMHPYjlF++zsrpVU44HqfwkQ6Y123eqGWw6HXDF9ga+oW
-aAD6iHIf06rmpFQ/GnU5QzIAR0QkhCCcnpCFIX5Quluv5aQ1pxBtLuRW8QB7jugg
-m/Bk204Ck4dj5EgJ5CGOj5yVjKanaMXa3hLp1dYMkas6VQyYBdMAJosrGWdFczvQ
-/bpfgPWF0DZhzskTdTWce3rv6VHc6biDGUHNaCH7dtTJfenUZfgtNXMNl4raBQMC
-83mEfJYhe1pqJRvzoC0dTeYeF/66Q5CfIxSpb2cMCtNl6wWqS4WJtQCOBCoKqQtH
-9qDGxQCiISyMTqiTUU9GYYWsTZ9do8ZSc5VvO6uf
------END CERTIFICATE-----
------BEGIN PRIVATE KEY-----
-MIIEvgIBADANBgkqhkiG9w0BAQEFAASCBKgwggSkAgEAAoIBAQDUlDoFSo3JcMJn
-Szg940ih47kvWKpn1agfgMlHxPey6var5snW0q6WhL14JnBvEJYej8LSB/XUpgmJ
-fKG37VguEXjeLm5eZnshHNAUWZhD8QvI+rNfEvCAkxEO2YjcaA8AHIlwNjqerALk
-uONh8XAKxxaUV2DK4MBj+JnrOI9y+roFor76c9MxgzDRvs1pTJ5cfTSeJJUlbw7n
-lm7AHfij7sxeUuEGkydKAEruVAivyZh6Q7VxRg8Ju9n1jXX7KUWG5Uq5sRRYmVDa
-ELfYoIDDGj5cSMGoy076w4vyc6dDlynbuX0UbID5s74Kv0lh/ZA4nWcKccOuwQta
-5oPxA7ZjAgMBAAECggEBAMeftmiXnVRIblafvV3onKFh/tnmUoeVjP6gauPZpJ3A
-pgnBfVMdn1O7rU0yE61IjyB98f5X+VNK5HPWtOrKmF8Si0VhpsVBSWlL7F7fz+wl
-ZOLEAkNKvsyOzpr6TtpjYYrCQZI9aojskP8GXIjyODv2v05oS33Y1vJKVwgboiHe
-d3CbRn9nbarNdJ5FHrv6qbz9xiRREdsNeYTafzPNzKXnkLrJ9T0lsOItichwXk+e
-e47fYi7cqmPc8mZ+cx3ct8z4RF/iGmdLc/nVd9k68/ola7DEtNVGGCw/1zAgAiJG
-vKbVK/rWJ0qWKXjW2Vf0Uc7M4gmhU9tmq9wYXmYUKrkCgYEA/5f+VmpdDUAu75el
-D8D7L6LvJDH4NoClpbHJ3srJ1gpGniL2mWR9xplRe7Sth9rWMziPo2vcpb0n8CKB
-799sTLyY/F4/pjlnQrLGhs6ZipdCnx0Wp6cCcNTchJV7fsvJWQi96z69m9z4aOCY
-ls5J0lgostgGmqJ0tUTLAJn4af0CgYEA1Oq6wx/2+NkaQSL3JhlBmybbaK/L7B5X
-Bn2uwxaIBGKsWaH02VNx3kv7tbsEJ9bj2Zsf47CAJaw8ojNyT754YDBjnqawoI+G
-RGP5Rjz7+IiW3EgACHQBhmxASjBTpCFcpszxjLwhL6i/0yyaosIq0459iz4dN9he
-27nNjM48398CgYA8zQVdvTOhgVEpAaPsWXXnYRUOQSzQmk3NWruw2gClgBBIcfzD
-hJo+8h3mFZbqKG6oBJ52u6PjcVncz/ik/TsgDgU+k5UEj8c2oJyFWQRBabYZb6wB
-+cKk4J4MlBqqkQO2wFOdcHFecHRPTo494ZjCBuK3mJgJlPe6X0EDRZ1IaQKBgACF
-Ei+nxFKXNRkznKbbKO3YCnEW/Mh2yn+ZjvOq+moIU6NkYdSl/4ErblHjQv9V5viB
-CHLl22o8IWnD9mN7c4/IjnW0snmx4AIKvHEPdQ4GR1gCVP2wStCpMv77XzjnW/KM
-TYqqaupS3yUE1tvO3YvmrSfJ3whj3tdqfLX7SurBAoGBAOW8Pn8/kIB0l5Hm5lKm
-lh52bhoBzptiPfnddwXROl2IGieALZU/lKUvZv79aVJuoY86+qOfSZqiUypGiIPR
-+VWa7deV7Stugf6KmnRzOp0ZdS/SCX9rppoJmdwORW58cfIhmdQV+vKlCL9ZO0HF
-QqbKXdpb8BfqgsmIwTV+7zbF
------END PRIVATE KEY-----

miniserv.pl

@@ -915,6 +915,13 @@ while(1) {
 				# Initialize SSL for this connection
 				if ($use_ssl) {
 					my $byte = '';
+					# Don't wait forever for a client that
+					# connects but never sends anything
+					my $pmask;
+					vec($pmask, fileno(SOCK), 1) = 1;
+					select($pmask, undef, undef,
+					       $config{'peek_timeout'} || 60)
+						|| exit;
 					# Look at the first byte of the socket
 					# buffer but don't consume it
 					recv(SOCK, $byte, 1, MSG_PEEK);

mount/linux-lib.pl

@@ -1924,7 +1924,30 @@ elsif ($_[0] =~ /^ext\d+$/) {
 		($u, $g) = ("usrjquota", "grpjquota");
 		$jufile ||= "aquota.user";
 		$jgfile ||= "aquota.group";
-		$options{"jqfmt"} = "vfsv0";
+		if (!$options{"jqfmt"}) {
+			# Keep the format of existing external quota files when
+			# switching them to journaled quotas.
+			my $jqfmt;
+			foreach my $qfile ($jufile, $jgfile) {
+				next if (!-s "$_[2]/$qfile");
+				if (open(my $qfh, "<", "$_[2]/$qfile")) {
+					my $header;
+					if (read($qfh, $header, 8) == 8) {
+						my (undef, $version) = unpack("V2", $header);
+						$jqfmt = $version == 0 ? "vfsv0" :
+							 $version == 1 ? "vfsv1" : undef;
+						}
+					close($qfh);
+					}
+				last if ($jqfmt);
+				}
+			if (!$jqfmt) {
+				my $qver = &backquote_command("quota -V 2>&1");
+				$jqfmt = $qver =~ /\s(\d+)\.\d+/ && $1 >= 4 ?
+					"vfsv1" : "vfsv0";
+				}
+			$options{"jqfmt"} = $jqfmt;
+			}
 		}
 	else {
 		$jufile = "";

mysql/lang/en

@@ -919,4 +919,6 @@ ssl_eca=Missing or non-existent SSL CA file
 ssl_ecertexists=SSL certificate file $1 already exists!
 ssl_ekeyexists=SSL key file $1 already exists!
 
+stop_ecannot=You are not allowed to stop or start the MySQL server
+
 __norefs=1

mysql/restart.cgi

@@ -3,6 +3,7 @@
 
 require './mysql-lib.pl';
 &error_setup($text{'restart_err'});
+$access{'stop'} || &error($text{'stop_ecannot'});
 $err = &stop_mysql();
 &error($err) if ($err);
 $err = &start_mysql();

mysql/start.cgi

@@ -4,6 +4,7 @@
 
 require './mysql-lib.pl';
 &error_setup($text{'start_err'});
+$access{'stop'} || &error($text{'stop_ecannot'});
 $err = &start_mysql();
 &error($err) if ($err);
 sleep(3);

mysql/stop.cgi

@@ -4,6 +4,7 @@
 
 require './mysql-lib.pl';
 &error_setup($text{'stop_err'});
+$access{'stop'} || &error($text{'stop_ecannot'});
 $err = &stop_mysql();
 &error($err) if ($err);
 &webmin_log("stop");

net/debian-linux-lib.pl

@@ -72,6 +72,8 @@ foreach $iface (@ifaces) {
 				$cfg->{'ether'} = $v[1];
 				}
 			elsif ($param eq 'bridge_ports') {
+				# An interface with bridge ports is a bridge
+				$cfg->{'bridge'} = 1;
 				$cfg->{'bridgeto'} = $value;
 				}
 			elsif ($param eq 'bridge_stp') {
@@ -230,12 +232,12 @@ if ($cfg->{'bridge'}) {
 
 # Set bonding parameters
 if(($cfg->{'bond'} == 1) && ($gconfig{'os_version'} >= 5)) {
-	push(@options, [&bonding_option('mode').' '.$cfg->{'mode'}]);
-	push(@options, [&bonding_option('miimon').' '.$cfg->{'miimon'}]) if ($cfg->{'miimon'});
-	push(@options, [&bonding_option('updelay').' '.$cfg->{'updelay'}]) if ($cfg->{'updelay'});
-	push(@options, [&bonding_option('downdelay').' '.$cfg->{'downdelay'}]) if ($cfg->{'downdelay'});
-	push(@options, [&bonding_option('primary').' '.$cfg->{'primary'}]) if ($cfg->{'primary'});
-	push(@options, ['slaves '.$cfg->{'partner'}]);
+	push(@options, [&bonding_option('mode'), $cfg->{'mode'}]);
+	push(@options, [&bonding_option('miimon'), $cfg->{'miimon'}]) if ($cfg->{'miimon'});
+	push(@options, [&bonding_option('updelay'), $cfg->{'updelay'}]) if ($cfg->{'updelay'});
+	push(@options, [&bonding_option('downdelay'), $cfg->{'downdelay'}]) if ($cfg->{'downdelay'});
+	push(@options, [&bonding_option('primary'), $cfg->{'primary'}]) if ($cfg->{'primary'});
+	push(@options, ['slaves', $cfg->{'partner'}]);
 	}
 elsif ($cfg->{'bond'} == 1) {
 	push(@options, ['up', '/sbin/ifenslave '.$cfg->{'name'}." ".
@@ -860,6 +862,8 @@ sub modify_interface_def
 {
 my ($name, $addrfam, $method, $options, $mode, $file) = @_;
 $file ||= $network_interfaces_config;
+&validate_interface_options($options);
+
 # make a backup copy
 &copy_source_dest($file, $file."~");
 local *OLDCFGFILE, *NEWCFGFILE;
@@ -907,7 +911,7 @@ while (defined ($line=<OLDCFGFILE>)) {
                # write only upon first entrance here
                if ($mode == 0 && $new_options_wrote == 0) {
                        $new_options_wrote = 1;
-                       foreach $option (@$options) {
+                       foreach my $option (@$options) {
 				my ($param, $value) = @$option;
 				&print_tempfile(NEWCFGFILE,"\t$param $value\n");
 				}
@@ -928,12 +932,13 @@ close(OLDCFGFILE);
 sub new_interface_def
 {
 local ($name, $addrfam, $method, $options, $file) = @_;
+&validate_interface_options($options);
 $file ||= $network_interfaces_config;
 local *CFGFILE;
 &open_lock_tempfile(CFGFILE, ">>$file") ||
 	error("Unable to open $file");
 &print_tempfile(CFGFILE, "\niface $name $addrfam $method\n");
-foreach $option (@$options) {
+foreach my $option (@$options) {
 	my ($param, $value) = @$option;
 	&print_tempfile(CFGFILE, "\t$param $value\n");
 	}
@@ -941,6 +946,21 @@ foreach $option (@$options) {
 &unlock_file($file);
 }
 
+# validate_interface_options(&options)
+# Call error if any interface option name or valid is not suitable
+# for the config file
+sub validate_interface_options
+{
+my ($options) = @_;
+foreach my $option (@$options) {
+	my ($param, $value) = @$option;
+	$param =~ /\r|\n/ && &error("Invalid interface parameter name ".
+				    &html_escape($param));
+	$value =~ /\r|\n/ && &error("Invalid interface parameter value ".
+				    &html_escape($value));
+	}
+}
+
 # delete an already defined interface
 # the parameters should be (name, addrfam, file)
 sub delete_interface_def

net/delete_bifcs.cgi

@@ -51,6 +51,10 @@ foreach $d (reverse(@d)) {
 					else {&unload_module($b->{'name'});}
 					}
 				}
+			# Remove the virtual device after deactivation
+			if (defined(&destroy_interface_device)) {
+				&destroy_interface_device($b);
+				}
 			}
 
 		# Delete config

net/lang/en

@@ -136,8 +136,14 @@ bonding_primary=Primary Interface
 bonding_primarydesc=Only applicable with activebackup, balance-tlb or balance-alb teaming modes
 bonding_miimon=Mii-Monitoring Interval
 bonding_miimondesc=(Leave blank to disable link monitoring)
+bonding_epartner=Teaming partner must be a space-separated list of interface names
 bonding_updelay=Updelay
 bonding_downdelay=Downdelay
+bonding_ebondmode=Teaming mode must be an integer
+bonding_eprimary=Primary interface must be an interface name
+bonding_emiimon=Mii-Monitoring interval must be an integer
+bonding_eupdelay=Updelay must be an integer
+bonding_edowndelay=Downdelay must be an integer
 
 vlan_add=Add Vlan Tagged Interface
 vlan_physical=Physical Device

net/linux-lib.pl

@@ -329,9 +329,22 @@ if (&has_command("ip") && $a->{'bond'} && $a->{'up'} && !$old) {
 		}
 	}
 
-if (($a->{'bond'} || $a->{'vlan'} || !&has_command("ifconfig")) &&
-    &has_command("ip")) {
-	# For a real interface, activate or de-activate the link
+if (&has_command("ip") && $a->{'bridge'} && $a->{'up'} && !$old) {
+	# Create the bridge before assigning addresses to it.
+	my $cmd = "ip link add ".quotemeta($a->{'name'})." type bridge";
+	my $out = &backquote_logged("$cmd 2>&1");
+	&error("Failed to create bridge device : $out") if ($?);
+	if ($a->{'bridgeto'}) {
+		$cmd = "ip link set dev ".quotemeta($a->{'bridgeto'}).
+			" master ".quotemeta($a->{'name'});
+		$out = &backquote_logged("$cmd 2>&1");
+		&error("Failed to add interface to bridge : $out") if ($?);
+		}
+	}
+
+if (&has_command("ip")) {
+	# Manage link state for all interfaces when ip is used, since ip is also
+	# used for address assignment below regardless of ifconfig availability.
 	if ($a->{'virtual'} eq '' && $a->{'up'} && (!$old || !$old->{'up'})) {
 		# Bring up
 		my $cmd = "ip link set dev ".quotemeta($devname)." up";
@@ -486,7 +499,8 @@ if ($a->{'virtual'} eq '' && &has_command("ifconfig")) {
 			  quotemeta($a->{'address6'}->[$i])."/".
 			  quotemeta($a->{'netmask6'}->[$i])." 2>&1";
 		$out = &backquote_logged($cmd);
-		&error("Failed to add IPv6 address with $cmd : $out") if ($?);
+		&error("Failed to add IPv6 address with $cmd : $out")
+			if ($? && $a->{'address6'}->[$i] !~ /^fe80:/);
 		}
 	}
 elsif ($a->{'virtual'} eq '' && &has_command("ip")) {
@@ -509,7 +523,8 @@ elsif ($a->{'virtual'} eq '' && &has_command("ip")) {
 			  quotemeta($a->{'netmask6'}->[$i])." dev ".
 			  quotemeta($devname);
 		$out = &backquote_logged("$cmd 2>&1");
-		&error("Failed to add IPv6 address with $cmd : $out") if ($?);
+		&error("Failed to add IPv6 address with $cmd : $out")
+			if ($? && $a->{'address6'}->[$i] !~ /^fe80:/);
 		}
 	}
 
@@ -595,6 +610,24 @@ else {
 	}
 }
 
+# destroy_interface_device(&details)
+# Remove a virtual network device (bond, VLAN, bridge) from the kernel.
+# Should be called after deactivate_interface when deleting, not just
+# deactivating, a virtual interface.
+sub destroy_interface_device
+{
+my ($a) = @_;
+my $name = $a->{'fullname'} || $a->{'name'};
+# Check the bridge flag too, as bridges can have arbitrary names
+if (&has_command("ip") && $a->{'virtual'} eq '' &&
+    ($a->{'bridge'} ||
+     &iface_type($name) =~ /(?:Bonded|VLAN|Bridge)$/)) {
+	my $out = &backquote_logged(
+		"ip link delete ".quotemeta($name)." 2>&1");
+	&error("Failed to delete virtual interface : $out") if ($?);
+	}
+}
+
 # use_ifup_command(&iface)
 # Returns 1 if the ifup command must be used to bring up some interface.
 # True on Debian 5.0+ for non-ethernet, typically bonding and VLAN tagged interfaces.

net/save_bifc.cgi

@@ -32,6 +32,10 @@ if ($in{'delete'} || $in{'unapply'}) {
 			else {
 				&deactivate_interface($act);
 				}
+			# Remove the virtual device after deactivation
+			if (defined(&destroy_interface_device)) {
+				&destroy_interface_device($b);
+				}
 			}
 
 		}
@@ -292,11 +296,17 @@ else {
 	# Save bonding settings
 	if ($in{'bond'}) {
 		$b->{'bond'} = 1;
+		$in{'partner'} =~ /^\S+( +\S+)*$/ || &error($text{'bonding_epartner'});
 		$b->{'partner'} = $in{'partner'};
+		$in{'bondmode'} =~ /^[0-6]$/ || &error($text{'bonding_ebondmode'});
 		$b->{'mode'} = $in{'bondmode'};
+		$in{'primary'} =~ /^\S*$/ || &error($text{'bonding_eprimary'});
 		$b->{'primary'} = $in{'primary'};
+		$in{'miimon'} =~ /^\d*$/ || &error($text{'bonding_emiimon'});
 		$b->{'miimon'} = $in{'miimon'};
+		$in{'updelay'} =~ /^\d*$/ || &error($text{'bonding_eupdelay'});
 		$b->{'updelay'} = $in{'updelay'};
+		$in{'downdelay'} =~ /^\d*$/ || &error($text{'bonding_edowndelay'});
 		$b->{'downdelay'} = $in{'downdelay'};
 		}
 	else {

net/t/run-tests.t

@@ -964,4 +964,89 @@ is_deeply(\@commands,
 	    "cd / ; ifconfig eth0.10 10\\.0\\.0\\.2 netmask 255\\.255\\.255\\.0 up 2>&1" ],
 	  "Linux VLAN interface falls back to vconfig without ip");
 
+# Test: Bond deactivation only brings it down, does not delete device
+@commands = ( );
+{
+no warnings 'redefine';
+local *main::has_command = sub {
+	return $_[0] eq "ip" ? "/sbin/ip" : undef;
+	};
+main::deactivate_interface({
+	'name' => 'bond0',
+	'fullname' => 'bond0',
+	'virtual' => '',
+	'address' => '10.0.0.2',
+	'netmask' => '255.255.255.0',
+	'address6' => [ ],
+	'netmask6' => [ ],
+	'up' => 1
+	});
+}
+is_deeply(\@commands, [
+	"ip addr del 10\\.0\\.0\\.2\\/24 dev bond0 2>&1",
+	"ip link set dev bond0 down 2>&1"
+	], "Linux bond deactivation removes address and brings link down");
+
+# Test: Bond deletion removes virtual device after deactivation
+@commands = ( );
+{
+no warnings 'redefine';
+no warnings 'once';
+local $main::gconfig{'os_type'} = 'debian-linux';
+local $main::gconfig{'os_version'} = 12;
+local *main::has_command = sub {
+	return $_[0] eq "ip" ? "/sbin/ip" :
+	       $_[0] eq "ifup" ? "/sbin/ifup" : undef;
+	};
+main::deactivate_interface({
+	'name' => 'bond0',
+	'fullname' => 'bond0',
+	'virtual' => '',
+	'address' => '10.0.0.2',
+	'netmask' => '255.255.255.0',
+	'address6' => [ ],
+	'netmask6' => [ ],
+	'up' => 1
+	});
+# Simulate delete path: destroy_interface_device after deactivation
+my $b = { 'name' => 'bond0', 'fullname' => 'bond0', 'virtual' => '' };
+main::destroy_interface_device($b);
+}
+is_deeply(\@commands, [
+	"ip addr del 10\\.0\\.0\\.2\\/24 dev bond0 2>&1",
+	"ip link set dev bond0 down 2>&1",
+	"ip link delete bond0 2>&1"
+	], "Linux bond deletion removes device after deactivation");
+
+# Test: VLAN deletion removes virtual device after deactivation
+@commands = ( );
+{
+no warnings 'redefine';
+no warnings 'once';
+local $main::gconfig{'os_type'} = 'debian-linux';
+local $main::gconfig{'os_version'} = 12;
+local *main::has_command = sub {
+	return $_[0] eq "ip" ? "/sbin/ip" :
+	       $_[0] eq "ifup" ? "/sbin/ifup" : undef;
+	};
+main::deactivate_interface({
+	'name' => 'eth0.10',
+	'fullname' => 'eth0.10',
+	'virtual' => '',
+	'address' => '10.0.10.2',
+	'netmask' => '255.255.255.0',
+	'address6' => [ ],
+	'netmask6' => [ ],
+	'up' => 1
+	});
+# Simulate delete path: destroy_interface_device after deactivation
+my $b = { 'name' => 'eth0.10', 'fullname' => 'eth0.10', 'virtual' => '' };
+main::destroy_interface_device($b);
+}
+is_deeply(\@commands, [
+	"ip addr del 10\\.0\\.10\\.2\\/24 dev eth0\\.10 2>&1",
+	"ip link set dev eth0\\.10 down 2>&1",
+	"ip link delete eth0\\.10 2>&1"
+	], "Linux VLAN deletion removes device after deactivation");
+
 done_testing();

nginx/edit_user.cgi

@@ -8,6 +8,9 @@ require './nginx-lib.pl';
 our (%text, %in, %access);
 &ReadParse();
 $in{'file'} || &error($text{'users_efile'});
+&can_directory($in{'file'}) || &error(&text('access_ecannot',
+		"<tt>".&html_escape($in{'file'})."</tt>",
+		"<tt>".&html_escape($access{'root'})."</tt>"));
 
 &switch_write_user(1);
 my $users = &htaccess_htpasswd::list_users($in{'file'});

nginx/lang/en

@@ -386,6 +386,7 @@ log_delete_user=Deleted user $1 in $2
 
 stop_err=Failed to stop Nginx
 stop_ecannot=You are not allowed to stop the webserver
+restart_ecannot=You are not allowed to apply the webserver configuration
 
 start_err=Failed to start Nginx
 start_ecannot=You are not allowed to start the webserver

nginx/list_users.cgi

@@ -8,6 +8,9 @@ require './nginx-lib.pl';
 our (%text, %in, %access);
 &ReadParse();
 $in{'file'} || &error($text{'users_efile'});
+&can_directory($in{'file'}) || &error(&text('access_ecannot',
+		"<tt>".&html_escape($in{'file'})."</tt>",
+		"<tt>".&html_escape($access{'root'})."</tt>"));
 
 &ui_print_header("<tt>".&html_escape($in{'file'})."</tt>",
 		 $text{'users_title'}, "");

nginx/restart.cgi

@@ -7,6 +7,7 @@ require './nginx-lib.pl';
 our (%text, %in, %access);
 &ReadParse();
 &error_setup($text{'restart_err'});
+$access{'stop'} || &error($text{'restart_ecannot'});
 
 my $test = &test_config();
 $test && &error(&text('restart_etest',

nginx/save_user.cgi

@@ -9,6 +9,9 @@ our (%text, %in, %access);
 &ReadParse();
 &error_setup($text{'user_err'});
 $in{'file'} || &error($text{'users_efile'});
+&can_directory($in{'file'}) || &error(&text('access_ecannot',
+		"<tt>".&html_escape($in{'file'})."</tt>",
+		"<tt>".&html_escape($access{'root'})."</tt>"));
 
 # Get the user being edited
 &lock_file($in{'file'});

package-updates/CHANGELOG

@@ -1,3 +1,7 @@
+---- Changes since 2.660 ----
+Added a "New updates are found" choice to the "Send email when" option that sends a complete report only when new updates become available, so notify-only schedules no longer repeat the same message every run.
+---- Changes since 2.641 ----
+Added a Held updates view with controls to hold, unhold or explicitly update APT-held packages.
 ---- Changes since 1.490 ----
 First version of this module.
 ---- Changes since 1.500 ----

package-updates/index.cgi

@@ -9,6 +9,7 @@ if ($in{'clear'}) {
 	$in{'search'} = '';
 	}
 $has_repos = defined(&software::list_package_repos);
+$has_holds = &supports_package_holds();
 
 # Start of mode tabs
 print &ui_tabs_start([ [ 'pkgs', $text{'index_tabpkgs'} ],
@@ -23,7 +24,10 @@ $in{'mode'} ||= 'updates';
 
 # Show mode selector (all, updates only, updates and new)
 @grid = ( );
-foreach $m ('current', 'updates', 'security', 'new') {
+@modes = ('current', 'updates');
+push(@modes, 'held') if ($has_holds);
+push(@modes, 'security', 'new');
+foreach $m (@modes) {
 	$mmsg = $text{'index_mode_'.$m};
 	if ($in{'mode'} eq $m) {
 		push(@mlinks, "<b>$mmsg</b>");
@@ -68,15 +72,21 @@ foreach $p (sort { $a->{'name'} cmp $b->{'name'} } (@current, @avail)) {
 	$c = $current{$p->{'name'}."/".$p->{'system'}};
 	$a = $avail{$p->{'name'}."/".$p->{'system'}};
 
-	if ($a && $c && (&compare_versions($a, $c) > 0 || $upmode)) {
+	if ($a && $c && (&compare_versions($a, $c) > 0 || $upmode ||
+			 $in{'mode'} eq 'held')) {
 		# An update is available
-		$msg = "<b><font color=#00aa00>".
-		       &text('index_new', $a->{'version'})."</font></b>";
-		$need = 1;
+		$msg = $a->{'held'} ?
+			"<b><font color=#ffaa00>".
+			&text('index_held', $c->{'version'}, $a->{'version'}).
+			"</font></b>" :
+			"<b><font color=#00aa00>".
+			&text('index_new', $a->{'version'})."</font></b>";
+		$need = $a->{'held'} ? 0 : 1;
 		next if ($in{'mode'} eq 'security' && !$a->{'security'});
 		next if ($in{'mode'} ne 'updates' &&
 			 $in{'mode'} ne 'current' &&
-			 $in{'mode'} ne 'security');
+			 $in{'mode'} ne 'security' &&
+			 $in{'mode'} ne 'held');
 		}
 	elsif ($a && !$c) {
 		# Could be installed, but isn't currently
@@ -143,18 +153,20 @@ if ($in{'mode'} eq 'new' && !$in{'search'}) {
 	}
 else {
 	# Show the packages, if any
+	$update_label = $in{'mode'} eq 'new' ? $text{'index_install'} :
+			$in{'mode'} eq 'held' ? $text{'index_updateheld'} :
+					    $text{'index_update'};
 	if (@rows) {
 		print &text('index_count', scalar(@rows)),"<br>\n";
 		print &ui_form_start("update.cgi", "post");
-		print &ui_submit($in{'mode'} eq 'new' ? $text{'index_install'}
-		                           : $text{'index_update'}, "ok_top" );
+		print &ui_submit($update_label, "ok_top" );
 		print &ui_submit($text{'index_refresh'}, "refresh_top"), "<br>";
 		}
+	@buttons = ( [ "ok", $update_label ] );
+	push(@buttons, [ "refresh", $text{'index_refresh'} ]);
 	print &ui_form_columns_table(
 		"",
-		[ [ "ok", $in{'mode'} eq 'new' ? $text{'index_install'}
-					       : $text{'index_update'} ],
-		  [ "refresh", $text{'index_refresh'} ] ],
+		\@buttons,
 		1,
 		undef,
 		[ [ "mode", $in{'mode'} ],
@@ -220,10 +232,14 @@ else {
 	}
 print &ui_table_row($text{'index_email'}, $efield);
 
-# When to send email
+# When to send email. If never saved, keep the old behavior for an existing
+# schedule, but default new setups to only report new updates
+$when = $config{'sched_when'} ne '' ? int($config{'sched_when'}) :
+	$job ? 0 : 3;
 print &ui_table_row($text{'index_ewhen'},
-	&ui_radio("when", int($config{'sched_when'}),
+	&ui_select("when", $when,
 		  [ [ 0, $text{'index_ewhen0'} ],
+		    [ 3, $text{'index_ewhen3'} ],
 		    [ 1, $text{'index_ewhen1'} ],
 		    [ 2, $text{'index_ewhen2'} ] ]));
 
@@ -296,4 +312,3 @@ if ($has_repos) {
 print &ui_tabs_end(1);
 
 &ui_print_footer("/", $text{'index'});
-

package-updates/lang/en

@@ -6,8 +6,10 @@ index_source=Source
 index_bad2=Update to version $1 not yet available : $1
 index_bad=Update to version $1 advised : $2
 index_new=New version $1
+index_held=Held at version $1; version $2 is available
 index_ok=Running latest $1
 index_update=Update Selected Packages
+index_updateheld=Update Selected Held Packages
 index_install=Install Selected Packages
 index_return=package list
 index_header=Scheduled checking options
@@ -20,7 +22,8 @@ index_schedw=week
 index_email=Email updates report to
 index_email_def=Webmin default ($1)
 index_ewhen=Send email when
-index_ewhen0=As required, when an update action is performed
+index_ewhen0=Any updates are available or an update action is performed
+index_ewhen3=New updates are found or an update action is performed
 index_ewhen1=Any update fails
 index_ewhen2=Never
 index_action=Action when update needed
@@ -39,6 +42,7 @@ index_webmintheme=Webmin theme $1
 index_mode=States to display:
 index_mode_current=Installed
 index_mode_updates=Only updates
+index_mode_held=Held updates
 index_mode_new=Only new
 index_mode_security=Only security updates
 index_allsel=Packages to show:
@@ -46,6 +50,7 @@ index_all_0=Only Virtualmin related
 index_all_1=All packages
 index_none_all=No packages managed by an update system were found on your system!
 index_none_updates=No packages available to be updated were found.
+index_none_held=No held packages with available updates were found.
 index_none_both=No new packages or packages available to be updated were found.
 index_none_new=No new packages for installation were found.
 index_none_security=No packages available for security updates were found.
@@ -100,6 +105,10 @@ update_rusure=Are you sure you wish to install the $1 packages listed below? Thi
 update_oldver=Current version
 update_newver=New version
 update_confirm=Install Now
+update_confirmheld=Update Held Packages
+update_heldnote=These packages are held. This action explicitly updates them once, and leaves them held for future updates.
+update_enotheld=Package $1 is not currently held by APT
+update_enoheldops=No update operation was found for the selected held packages. Refresh the package list and try again.
 update_none=None
 update_ops=Building complete list of packages ..
 update_rebootdesc=One of the installed packages requires a reboot to be fully applied.
@@ -114,6 +123,8 @@ log_schedup=Background installed $1 updated packages
 log_sched=Enabled scheduled updates
 log_unsched=Disabled scheduled updates
 log_refresh=Refreshed available packages
+log_hold=Held updates for $1 packages
+log_unhold=Unheld updates for $1 packages
 log_enable_repos=Enabled $1 package repositories
 log_disable_repos=Disabled $1 package repositories
 log_delete_repos=Deleted $1 package repositories
@@ -140,6 +151,10 @@ view_source=Installation source
 view_changelog=Changelog for available version
 view_software=Manage Package
 view_update=Update Package
+view_updateheld=Update Held Package
+view_hold=Hold Package
+view_unhold=Unhold Package
+view_held=Held at version $1
 view_install=Install Package
 
 system_yum=YUM
@@ -159,4 +174,12 @@ repos_title=Delete Repositories
 repos_rusure=Are you sure you want to delete the $1 selected package repositories? Packages installed from them will still be available, but may not be updatable.
 repos_ok=Delete Now
 
+hold_enotsupported=The active package update system does not support package holds
+hold_enone=No packages were selected
+hold_enotinstalled=Package $1 is not installed
+hold_enotheld=Package $1 is not currently held
+hold_esystem=Package $1 is not managed by the active package update system
+hold_efailed=Failed to hold packages: $1
+unhold_efailed=Failed to unhold packages: $1
+
 __norefs=1

package-updates/log_parser.pl

@@ -21,6 +21,9 @@ elsif ($action eq 'update') {
 elsif ($action eq 'schedup') {
 	return &text('log_schedup', $object);
 	}
+elsif ($action eq 'hold' || $action eq 'unhold') {
+	return &text('log_'.$action, $object);
+	}
 elsif ($action eq 'sched') {
 	return $text{$object ? 'log_sched' : 'log_unsched'};
 	}

package-updates/package-updates-lib.pl

@@ -21,6 +21,7 @@ eval "use WebminCore;";
 $available_cache_file = &cache_file_path("available.cache");
 $current_cache_file = &cache_file_path("current.cache");
 $updates_cache_file = &cache_file_path("updates.cache");
+$held_updates_cache_file = &cache_file_path("held-updates.cache");
 $cron_cmd = "$module_config_directory/update.pl";
 
 $yum_cache_file = &cache_file_path("yumcache");
@@ -28,6 +29,7 @@ $apt_cache_file = &cache_file_path("aptcache");
 $yum_changelog_cache_dir = &cache_file_path("yumchangelog");
 
 $update_progress_dir = "$module_var_directory/progress";
+$notified_file = "$module_var_directory/notified";
 
 # list_enabled_auto_update_services()
 # Returns known OS-level auto-update services that are currently enabled.
@@ -308,30 +310,74 @@ sub supports_updates_available
 return defined(&software::update_system_updates);
 }
 
-# updates_available(no-cache)
+# supports_package_holds()
+# Returns true if the current update system can list and change package holds.
+sub supports_package_holds
+{
+return defined(&software::list_update_system_holds) &&
+       defined(&software::update_system_hold);
+}
+
+# list_package_holds()
+# Returns the package names currently held by the update system.
+sub list_package_holds
+{
+return ( ) if (!&supports_package_holds());
+return &software::list_update_system_holds();
+}
+
+# package_is_held(package, [holds])
+# Returns true if a package is in a supplied or freshly-read list of holds.
+sub package_is_held
+{
+my ($name, $holds) = @_;
+my @holds = $holds ? @$holds : &list_package_holds();
+return 1 if (grep { $_ eq $name } @holds);
+if ($software::update_system eq 'apt' &&
+    defined(&software::strip_apt_package_arch)) {
+	my $base = &software::strip_apt_package_arch($name);
+	return 1 if (grep {
+		&software::strip_apt_package_arch($_) eq $base
+		} @holds);
+	}
+return 0;
+}
+
+# update_package_holds(&packages, hold)
+# Holds or unholds packages. Returns undef on success, or an error message.
+sub update_package_holds
+{
+my ($packages, $hold) = @_;
+return $text{'hold_enotsupported'} if (!&supports_package_holds());
+return &software::update_system_hold($packages, $hold);
+}
+
+# updates_available(no-cache, [include-held])
 # Returns an array of hash refs of package updates available, according to
 # the update system, with caching.
 sub updates_available
 {
-my ($nocache) = @_;
-if (!scalar(@updates_available_cache)) {
-	if ($nocache || &cache_expired($updates_cache_file)) {
+my ($nocache, $include_held) = @_;
+my $cache_file = $include_held ? $held_updates_cache_file :
+				$updates_cache_file;
+my $cache = $include_held ? \@held_updates_available_cache :
+				\@updates_available_cache;
+if (!scalar(@$cache)) {
+	if ($nocache || &cache_expired($cache_file)) {
 		# Get from original source
-		@updates_available_cache = &software::update_system_updates();
-		foreach my $a (@updates_available_cache) {
+		@$cache = &software::update_system_updates($include_held);
+		foreach my $a (@$cache) {
 			$a->{'update'} = $a->{'name'};
 			$a->{'system'} = $software::update_system;
 			}
-		&write_cache_file($updates_cache_file,
-				  \@updates_available_cache);
+		&write_cache_file($cache_file, $cache);
 		}
 	else {
 		# Use on-disk cache
-		@updates_available_cache =
-			&read_cache_file($updates_cache_file);
+		@$cache = &read_cache_file($cache_file);
 		}
 	}
-return @updates_available_cache;
+return @$cache;
 }
 
 # package_install(package-name, [system], [new-install], [flags])
@@ -343,12 +389,14 @@ my ($name, $system, $install, $flags) = @_;
 $system ||= $software::update_system;
 my @rv;
 my $pkg;
+my $include_held = $system eq 'apt' && defined($flags) &&
+		   $flags eq '--allow-change-held-packages';
 
 # First get from list of updates
 ($pkg) = grep { $_->{'update'} eq $name &&
 		($_->{'system'} eq $system || !$system) }
 	      sort { &compare_versions($b, $a) }
-		   &list_possible_updates(0);
+	           &list_possible_updates(0, 0, $include_held);
 if (!$pkg) {
 	# Then try list of all available packages
 	($pkg) = grep { $_->{'update'} eq $name &&
@@ -458,14 +506,14 @@ if (defined(&software::update_system_operations)) {
 return ( );
 }
 
-# list_possible_updates([nocache], [nocache-no-data])
+# list_possible_updates([nocache], [nocache-no-data], [include-held])
 # Returns a list of updates that are available. Each element in the array
 # is a hash ref containing a name, version, description and severity flag.
 # Intended for calling from themes. Nocache 0=cache everything, 1=flush all
 # caches, 2=flush only current. Nocache-no-data prohibits collecting data
 sub list_possible_updates
 {
-my ($nocache, $nocache_no_data) = @_;
+my ($nocache, $nocache_no_data, $include_held) = @_;
 my @rv;
 return @rv if ($nocache_no_data);
 my @current = &list_current($nocache);
@@ -476,9 +524,10 @@ if (&supports_updates_available()) {
 	foreach my $c (@current) {
 		$currentmap{$c->{'name'},$c->{'system'}} ||= $c;
 		}
-	foreach my $a (&updates_available($nocache == 1)) {
+	foreach my $a (&updates_available($nocache == 1, $include_held)) {
 		my $c = $currentmap{$a->{'name'},$a->{'system'}};
 		next if (!$c);
+		next if ($a->{'held'} && !$include_held);
 		next if ($a->{'version'} eq $c->{'version'} &&
 			 $a->{'epoch'} eq $c->{'epoch'});
 		push(@rv, { 'name' => $a->{'name'},
@@ -489,6 +538,7 @@ if (&supports_updates_available()) {
 			    'epoch' => $a->{'epoch'},
 			    'oldepoch' => $c->{'epoch'},
 			    'security' => $a->{'security'},
+			    'held' => $a->{'held'},
 			    'source' => $a->{'source'},
 			    'desc' => $c->{'desc'} || $a->{'desc'} });
 		}
@@ -700,10 +750,13 @@ sub flush_package_caches
 {
 unlink($current_cache_file);
 unlink($updates_cache_file);
+unlink($held_updates_cache_file);
 unlink($available_cache_file);
 unlink($available_cache_file.'0');
 unlink($available_cache_file.'1');
 @packages_available_cache = ( );
+@updates_available_cache = ( );
+@held_updates_available_cache = ( );
 %read_cache_file_cache = ( );
 }
 
@@ -713,6 +766,8 @@ unlink($available_cache_file.'1');
 sub list_for_mode
 {
 my ($mode, $nocache) = @_;
+return grep { $_->{'held'} }
+	&list_possible_updates($nocache, 0, 1) if ($mode eq 'held');
 return $mode eq 'updates' || $mode eq 'security' ?
 	&list_possible_updates($nocache) : &list_available($nocache);
 }

package-updates/save_view.cgi

@@ -8,8 +8,14 @@ if ($in{'software'}) {
 	&redirect("../software/edit_pack.cgi?package=".&urlize($in{'name'}).
 		  "&version=".&urlize($in{'version'}));
 	}
-else {
+elsif ($in{'hold'} || $in{'unhold'}) {
+	$action = $in{'hold'} ? "hold" : "unhold";
 	&redirect("update.cgi?u=".&urlize($in{'name'}."/".$in{'system'}).
-		  "&all=$in{'all'}&mode=$in{'mode'}");
+		  "&$action=1&mode=".&urlize($in{'mode'}));
+	}
+else {
+	$mode = $in{'held'} ? "held" : $in{'mode'};
+	&redirect("update.cgi?u=".&urlize($in{'name'}."/".$in{'system'}).
+		  "&all=$in{'all'}&mode=".&urlize($mode));
 	}
 

package-updates/update.cgi

@@ -19,7 +19,38 @@ else {
 		$redir =~ /\?/ ? "$redir&tab=pkgs" : "$redir?tab=pkgs";
 	}
 
-if ($in{'refresh'} || $in{'refresh_top'}) {
+$hold_action = $in{'hold'} ? 1 : $in{'unhold'} ? 0 : undef;
+if (defined($hold_action)) {
+	# Hold or unhold selected packages
+	&supports_package_holds() || &error($text{'hold_enotsupported'});
+	@holdpkgs = split(/\0/, $in{'u'});
+	@holdpkgs || &error($text{'hold_enone'});
+	@current = &list_current(1);
+	%current = map { $_->{'name'}."/".$_->{'system'}, 1 } @current;
+	@held = &list_package_holds();
+	@holdnames = ( );
+	foreach $ps (@holdpkgs) {
+		($p, $s) = split(/\//, $ps, 2);
+		$current{$p."/".$s} || &error(&text('hold_enotinstalled', $p));
+		$s eq $software::update_system ||
+			&error(&text('hold_esystem', $p));
+		if (!$hold_action && !&package_is_held($p, \@held)) {
+			&error(&text('hold_enotheld', $p));
+			}
+		push(@holdnames, $p);
+		}
+	@holdnames = &unique(@holdnames);
+	$err = &update_package_holds(\@holdnames, $hold_action);
+	&error(&text($hold_action ? 'hold_efailed' : 'unhold_efailed', $err))
+		if ($err);
+	&flush_package_caches();
+	$logaction = $hold_action ? 'hold' : 'unhold';
+	&webmin_log($logaction, "packages", scalar(@holdnames),
+		    { 'packages' => \@holdnames });
+	&redirect("index.cgi?mode=".&urlize($in{'mode'}).
+		  "&search=".&urlize($in{'search'}));
+	}
+elsif ($in{'refresh'} || $in{'refresh_top'}) {
 	&ui_print_unbuffered_header(undef, $text{'refresh_title'}, "");
 
 	# Clear all caches
@@ -40,6 +71,21 @@ else {
 	# Upgrade some packages
 	my @pkgs = split(/\0/, $in{'u'});
 	@pkgs || &error($text{'update_enone'});
+	$allow_held = 0;
+	if ($in{'mode'} eq 'held') {
+		# The held-updates page is the only UI that can explicitly
+		# override an APT hold for a single update transaction.
+		&supports_package_holds() || &error($text{'hold_enotsupported'});
+		@held = &list_package_holds();
+		foreach $ps (@pkgs) {
+			($p, $s) = split(/\//, $ps, 2);
+			$s eq 'apt' && &package_is_held($p, \@held) ||
+				&error(&text('update_enotheld', $p));
+			}
+		$allow_held = 1;
+		}
+	$install_flags = $allow_held ? '--allow-change-held-packages' :
+					$in{'flags'};
 	&ui_print_unbuffered_header(undef,
 	    $in{'mode'} eq 'new' ? $text{'update_title2'} : $text{'update_title'}, "");
 
@@ -57,6 +103,7 @@ else {
 			push(@pkgnames, $p);
 			}
 		@ops = &list_package_operations(join(" ", @pkgnames), $s);
+		&error($text{'update_enoheldops'}) if (!@ops && $allow_held);
 		}
 
 	if (@ops) {
@@ -74,9 +121,14 @@ else {
 			foreach $ps (@pkgs) {
 				$confform .= &ui_hidden("u", $ps);
 				}
+			$confform .= &ui_alert_box($text{'update_heldnote'}, 
+						   'warn', undef, undef, '')
+					if ($allow_held && !$bottom);
 			$confform .= &text('update_rusure', scalar(@ops)),"<p>\n"
 				if (!$bottom);
-			$confform .= &ui_form_end([ [ "confirm", $text{'update_confirm'} ] ]);
+			$confform .= &ui_form_end([ [ "confirm",
+				$allow_held ? $text{'update_confirmheld'} :
+					      $text{'update_confirm'} ] ]);
 			};
 		print &$getconfform();
 
@@ -127,7 +179,7 @@ else {
 			      "<br>\n";
 			print "<ul data-package-updates='1'>\n";
 			@got = &package_install_multiple(
-				\@pkgnames, $pkgsystem, $in{'mode'} eq 'new', $in{'flags'});
+				\@pkgnames, $pkgsystem, $in{'mode'} eq 'new', $install_flags);
 			print "</ul><br>\n";
 			}
 		else {
@@ -138,7 +190,7 @@ else {
 				print &text($msg, "<tt>@{[&html_escape($p)]}</tt>"),"<br>\n";
 				print "<ul data-package-updates='2'>\n";
 				@pgot = &package_install(
-					$p, $s, $in{'mode'} eq 'new', $in{'flags'});
+					$p, $s, $in{'mode'} eq 'new', $install_flags);
 				foreach $g (@pgot) {
 					$donedep{$g}++;
 					}

package-updates/update.pl

@@ -34,6 +34,13 @@ else {
 &start_update_progress([ map { $_->{'name'} } @todo ]);
 $icount = 0;
 $fcount = 0;
+
+# Track the updates that may need to be reported
+$newonly = $config{'sched_when'} == 3;
+$newcount = 0;
+$tellbody = "";
+%notified = ( );
+%pending = ( );
 foreach $t (@todo) {
 	next if ($already{$t->{'update'}});
 	my $umsg = $t->{'security'} ? "security update" : "update";
@@ -67,14 +74,36 @@ foreach $t (@todo) {
 	elsif ($config{'sched_action'} == 1 ||
 	       $config{'sched_action'} == 0 ||
 	       $config{'sched_action'} == -1 && $t->{'security'}) {
-		# Just tell the user about it
-		$body .= "$upfx $umsg to $t->{'name'} from $t->{'oldversion'} ".
-			 "to $t->{'version'} is available.\n\n";
+		# Add this update to the complete pending report
+		my $key = $t->{'system'}."/".$t->{'name'};
+		$pending{$key} = $t->{'version'};
+		$tellbody .= "$upfx $umsg to $t->{'name'} from ".
+			     "$t->{'oldversion'} to $t->{'version'} is ".
+			     "available.\n\n";
 		$tellcount++;
 		}
 	}
 &end_update_progress();
 
+# Serialize the notification decision with the state update, so overlapping
+# runs cannot both report the same new updates
+if ($newonly) {
+	&lock_file($notified_file);
+	&read_file($notified_file, \%notified);
+	foreach my $key (keys %pending) {
+		$newcount++ if ($notified{$key} ne $pending{$key});
+		}
+	}
+
+# In new-only mode, skip the list entirely if nothing changed. If something is
+# new, still include everything pending so the email is complete
+if ($newonly && !$newcount) {
+	$tellcount = 0;
+	}
+else {
+	$body .= $tellbody;
+	}
+
 if (@updated && $config{'sched_post_script'}) {
 	my @unique_updated = &unique(@updated);
 	my ($post_ok, $post_body) = &run_update_script(
@@ -89,10 +118,15 @@ if ($tellcount) {
 	}
 
 # Email the admin
-$emailto = $config{'sched_email'} eq '*' ? $gconfig{'webmin_email_to'}
-					 : $config{'sched_email'};
+$emailto = $config{'sched_email'};
+if ($emailto eq '*') {
+	$emailto = $gconfig{'webmin_email_to'};
+	if ($emailto && $gconfig{'webmin_email_to_name'}) {
+		$emailto = "$gconfig{'webmin_email_to_name'} <$emailto>";
+		}
+	}
 if ($emailto && $body &&
-    ($config{'sched_when'} == 0 ||
+    ($config{'sched_when'} == 0 || $newonly ||
      $config{'sched_when'} == 1 && $fcount)) {
 	&foreign_require("mailboxes", "mailboxes-lib.pl");
 	my $from = &mailboxes::get_from_address();
@@ -105,11 +139,20 @@ if ($emailto && $body &&
 			[ { 'headers' => [ [ 'Content-type', 'text/plain' ] ],
 			    'data' => $body } ] };
 	&mailboxes::send_mail($mail, undef, 1, 0);
+	$sent = 1;
 	if ($debug) {
 		print STDERR $body;
 		}
 	}
 
+# Remember what was reported, but only if the email was actually sent
+if ($newonly && ($sent || !%pending)) {
+	&write_file($notified_file, \%pending);
+	}
+if ($newonly) {
+	&unlock_file($notified_file);
+	}
+
 # Log the update, if anything was installed
 if ($icount) {
 	&webmin_log("schedup", "packages", $icount);

package-updates/view.cgi

@@ -13,12 +13,17 @@ require './package-updates-lib.pl';
 ($c) = grep { $_->{'name'} eq $in{'name'} &&
               $_->{'system'} eq $in{'system'} } @current;
 $p = $a || $c;
+$has_holds = &supports_package_holds();
+$held = $has_holds && $c &&
+	$c->{'system'} eq $software::update_system &&
+	&package_is_held($p->{'name'});
 
 print &ui_form_start("save_view.cgi");
 print &ui_hidden("name", $p->{'name'});
 print &ui_hidden("system", $p->{'system'});
 print &ui_hidden("version", $p->{'version'});
 print &ui_hidden("mode", $in{'mode'});
+print &ui_hidden("held", $held);
 print &ui_table_start($text{'view_header'}, undef, 2);
 
 # Package name and type
@@ -29,6 +34,11 @@ print &ui_table_row($text{'view_desc'}, $p->{'desc'});
 
 # Current state
 print &ui_table_row($text{'view_state'},
+	$held && $a && $c && &compare_versions($a, $c) > 0 ?
+		"<font color=#ffaa00>".
+		&text('index_held', $c->{'version'}, $a->{'version'})."</font>" :
+	$held && $c ? "<font color=#ffaa00>".
+		&text('view_held', $c->{'version'})."</font>" :
 	$a && !$c ? "<font color=#00aa00>$text{'index_caninstall'}</font>" :
 	!$a && $c ? "<font color=#ffaa00>".
                      &text('index_noupdate', $c->{'version'})."</font>" :
@@ -69,11 +79,16 @@ if ($c && &foreign_available("software") && $c->{'software'}) {
 	push(@buts, [ "software", $text{'view_software'} ]);
 	}
 if ($a && $c && &compare_versions($a, $c) > 0) {
-	push(@buts, [ "update", $text{'view_update'} ]);
+	push(@buts, [ "update", $held ? $text{'view_updateheld'} :
+							   $text{'view_update'} ]);
 	}
 elsif ($a && !$c) {
 	push(@buts, [ "update", $text{'view_install'} ]);
 	}
+if ($c && $has_holds && $c->{'system'} eq $software::update_system) {
+	push(@buts, [ $held ? "unhold" : "hold",
+			$held ? $text{'view_unhold'} : $text{'view_hold'} ]);
+	}
 print &ui_form_end(\@buts);
 
 &ui_print_footer("index.cgi?mode=$in{'mode'}&search=".

pam_login.cgi

@@ -3,6 +3,7 @@
 
 BEGIN { push(@INC, "."); };
 use WebminCore;
+require './login-lib.pl';
 
 $pragma_no_cache = 1;
 #$ENV{'MINISERV_INTERNAL'} || die "Can only be called by miniserv.pl";
@@ -73,17 +74,7 @@ print "$text{'pam_prefix'}\n";
 print &ui_form_start("@{[&get_webprefix()]}/pam_login.cgi", "post");
 print &ui_hidden("cid", $in{'cid'});
 
-my $not_secure;
-if ($ENV{'HTTPS'} ne 'ON' && $miniserv{'ssl'}) {
-	my $link = ui_tag('a', "⚠ $text{'login_notsecure'}",
-		{ 'href' => "javascript:void(0);",
-		  'class' => 'inherit-color',
-		  'onclick' => "window.location.href = ".
-		    "window.location.href.replace(/^http:/, 'https:'); return false;",
-		});
-	$not_secure = ui_tag('span', $link,
-		{ class => 'not-secure', title => $text{'login_notsecure_desc'} });
-	}
+my $not_secure = &get_login_http_warning(\%miniserv);
 
 print &ui_table_start($text{'pam_header'} . $not_secure,
 		      "width=40% class='loginform'", 2);
@@ -153,4 +144,3 @@ EOF
 	}
 
 &ui_print_footer();
-

postgresql/edit_host.cgi

@@ -4,6 +4,7 @@
 
 require './postgresql-lib.pl';
 &ReadParse();
+$access{'users'} || &error($text{'host_ecannot'});
 $v = &get_postgresql_version();
 if ($in{'new'}) {
 	$type = $in{'new'};

postgresql/save_host.cgi

@@ -4,11 +4,12 @@
 
 require './postgresql-lib.pl';
 &ReadParse();
+&error_setup($text{'host_err'});
+$access{'users'} || &error($text{'host_ecannot'});
 &lock_file($hba_conf_file);
 $v = &get_postgresql_version();
 @all = &get_hba_config($v);
 $host = $all[$in{'idx'}] if (!$in{'new'});
-&error_setup($text{'host_err'});
 
 if ($in{'delete'}) {
 	# delete one host

postgresql/save_manual.cgi

@@ -4,6 +4,7 @@
 require './postgresql-lib.pl';
 &ReadParseMime();
 &error_setup($text{'manual_err'});
+$access{'users'} || &error($text{'host_ecannot'});
 
 # Write the file
 $in{'data'} =~ s/\r//g;

proftpd/proftpd-lib.pl

@@ -7,9 +7,11 @@ use WebminCore;
 
 # Check if a list of supported modules needs to be built. This is done
 # if the ProFTPd binary changes, when Webmin is upgraded
+sub refresh_site_cache
+{
 my @st = stat($config{'proftpd_path'});
 my %oldsite;
-&read_file("$module_config_directory/site", \%site);
+&read_file("$module_config_directory/site", \%oldsite);
 if ($oldsite{'size'} != $st[7] ||
     !$oldsite{'version'} ||
     !$oldsite{'fullversion'} ||
@@ -18,11 +20,11 @@ if ($oldsite{'size'} != $st[7] ||
 	my ($ver, $fullver) = &get_proftpd_version(\$out);
 	if ($ver) {
 		# Store the detected versions
-		my %site;
-		$site{'size'} = $st[7];
-		$site{'version'} = $ver;
-		$site{'fullversion'} = $fullver;
-		$site{'webmin'} = &get_webmin_version();
+		my %newsite;
+		$newsite{'size'} = $st[7];
+		$newsite{'version'} = $ver;
+		$newsite{'fullversion'} = $fullver;
+		$newsite{'webmin'} = &get_webmin_version();
 
 		# Get the list of modules
 		my @mods;
@@ -35,14 +37,27 @@ if ($oldsite{'size'} != $st[7] ||
 			}
 		close(MODS);
 		if (!$? || !-r "$module_config_directory/site") {
-			$site{'modules'} = join(" ", @mods);
-			&write_file("$module_config_directory/site", \%site);
+			$newsite{'modules'} = join(" ", @mods);
+			&write_file("$module_config_directory/site", \%newsite);
 			}
 		}
 	}
+&read_site_cache();
+}
+
+# read_site_cache()
+# Put site-specific information into the global %site hash
+sub read_site_cache
+{
+%site = ();
+&read_file("$module_config_directory/site", \%site);
+}
 
 # Load the site-specific information on the server executable
-&read_file("$module_config_directory/site", \%site);
+if (!-r "$module_config_directory/site") {
+	&refresh_site_cache();
+	}
+&read_site_cache();
 @ftpaccess_files = split(/\s+/, $site{'ftpaccess'});
 opendir(DIR, ".");
 foreach $f (readdir(DIR)) {
@@ -319,6 +334,7 @@ return @rv;
 sub editable_directives
 {
 local($m, $func, @rv);
+&refresh_site_cache();
 local @mods = split(/\s+/, $site{'modules'});
 foreach $m (@module_files) {
 	if (&indexof($m, @mods) != -1) {
@@ -470,6 +486,7 @@ return &parse_choice(@_);
 sub config_icons
 {
 local($m, $func, $e, %etype, $i, $c);
+&refresh_site_cache();
 local @mods = split(/\s+/, $site{'modules'});
 local @ctx = split(/\s+/, $_[0]);
 foreach $m (sort { $a cmp $b } (@module_files)) {
@@ -675,6 +692,7 @@ else {
 # or undef.
 sub test_config
 {
+&refresh_site_cache();
 if ($site{'version'} >= 1.2) {
 	# Test the configuration with -t flag
 	local $cmd = "$config{'proftpd_path'} -t -c $config{'proftpd_conf'}";
@@ -843,6 +861,7 @@ local $st = &find_directive("ServerType", $conf);
 if ($st eq 'inetd') {
 	return $text{'stop_einetd'};
 	}
+&refresh_site_cache();
 my $ver = $site{'version'} || &get_proftpd_version();
 if ($ver > 1.22) {
 	# Stop and re-start

quota/btrfs_action.cgi

@@ -0,0 +1,61 @@
+#!/usr/local/bin/perl
+# Enable, disable or rescan Btrfs quotas
+
+require './quota-lib.pl';
+&ReadParse();
+$dir = $in{'dir'};
+
+# Require quota activation access and a valid mounted Btrfs filesystem before
+# running any command that can change filesystem quota state.
+&can_edit_btrfs_filesys($dir) && $access{'enable'} && !$access{'ro'} ||
+	&error($text{'btrfs_eenable'});
+defined(&btrfs_quota_status) && &is_btrfs_fs($dir) ||
+	&error($text{'btrfs_enotbtrfs'});
+
+# Accept only the three operations implemented by this handler.
+$in{'action'} =~ /^(enable|disable|rescan)$/ ||
+	&error($text{'btrfs_eaction'});
+
+# Disabling Btrfs quotas removes every qgroup and limit, so require an explicit
+# confirmation before performing this destructive operation.
+if ($in{'action'} eq "disable" && !$in{'confirm'}) {
+	# Mark the filesystem and qgroup terms as literal technical values.
+	my $dir_label = &ui_tag("tt", &html_escape($dir));
+	my $qgroup_label = &ui_tag("tt", "qgroup");
+	chomp($dir_label);
+	chomp($qgroup_label);
+
+	# Display the destructive warning inside the confirmation form.
+	&ui_print_header(undef, $text{'btrfs_disable'}, "", "btrfs");
+	print &ui_confirmation_form(
+		"btrfs_action.cgi",
+		&text('btrfs_disable_confirm', $dir_label),
+		[ [ "dir", $dir ], [ "action", "disable" ] ],
+		[ [ "confirm", $text{'btrfs_disable'} ] ],
+		&ui_alert_box(&text('btrfs_disable_warning', $qgroup_label), "warn",
+			      undef, undef, ""));
+	&ui_print_footer("", $text{'index_return'});
+	exit;
+	}
+
+&error_setup($text{'btrfs_efailed'});
+# Enable quotas using the accounting mode selected in the module configuration.
+if ($in{'action'} eq "enable") {
+	$err = &enable_btrfs_quotas($dir,
+		$config{'btrfs_mode'} eq "simple" ? 1 : 0);
+	}
+# Disable quotas after the confirmation branch above has been completed.
+elsif ($in{'action'} eq "disable") {
+	$err = &disable_btrfs_quotas($dir);
+	}
+# The remaining valid action starts a full-accounting quota rescan.
+else {
+	$err = &rescan_btrfs_quotas($dir, 0);
+	}
+
+# Report command failures, record successful changes, and return to the most
+# relevant page for the completed action.
+&error($err) if ($err);
+&webmin_log($in{'action'}, "btrfs", $dir, \%in);
+&redirect($in{'action'} eq "rescan" ?
+	"list_btrfs.cgi?dir=".&urlize($dir) : "");

quota/config-ALL-linux

@@ -23,3 +23,4 @@ show_grace=1
 email_msg=Disk usage for user ${USER} on filesystem ${FS} has reached ${PERCENT}% of the	allowed quota.		${USED} of disk space is being used, out of a maximum of ${QUOTA}.
 pc_show=1
 hide_uids=0
+btrfs_mode=full

quota/config.info

@@ -5,6 +5,7 @@ pc_show=Usage percentages to show,1,2-Hard and soft,1-Hard only,0-Soft only
 sort_mode=Sort users and groups by,1,0-Blocks used,2-Name,1-Order from repquota,3-Hard block quota,4-Soft block quota,5-Percent of hard quota used,6-Percent of soft quota used
 block_mode=Show quotas in,1,1-Kilobytes (where possible),0-Blocks
 hide_uids=Show deleted users?,1,0-Yes,1-No
+btrfs_mode=Btrfs accounting mode when enabling quotas,4,full-Full accounting, recommended for shared space and snapshots,simple-Simple accounting, lower overhead with original ownership tracking
 line1.1=Quota email messages,11
 email_msg=Email message for users over quota,9,80,5,\t
 email_subject=Subject for email message to users,3,Default

quota/config_info.pl

@@ -0,0 +1,18 @@
+# Hide Btrfs-specific configuration when it cannot be used.
+require './quota-lib.pl';
+
+# config_pre_load(info, [order])
+# Hide Btrfs-specific settings unless both a mounted Btrfs filesystem and the
+# command-line tool needed to manage it are available.
+sub config_pre_load
+{
+my ($info, $order) = @_;
+my @btrfs = &list_btrfs_filesystems();
+return if (@btrfs && &has_command("btrfs"));
+
+# Remove the field from both the configuration metadata and display order.
+delete($info->{'btrfs_mode'});
+@$order = grep { $_ ne "btrfs_mode" } @$order if ($order);
+}
+
+1;

quota/edit_btrfs.cgi

@@ -0,0 +1,54 @@
+#!/usr/local/bin/perl
+# Edit the limits for a Btrfs qgroup
+
+require './quota-lib.pl';
+&ReadParse();
+$dir = $in{'dir'};
+
+# Limit editing requires write access to an allowed mounted Btrfs filesystem
+# and a syntactically valid qgroup ID.
+$access{'ro'} && &error($text{'btrfs_eedit'});
+&can_edit_btrfs_filesys($dir) || &error($text{'btrfs_eallow'});
+defined(&btrfs_quota_status) && &is_btrfs_fs($dir) ||
+	&error($text{'btrfs_enotbtrfs'});
+&valid_btrfs_qgroup_id($in{'qgroup'}) || &error($text{'btrfs_eqgroup'});
+$in{'qgroup'} eq "0/5" && &error($text{'btrfs_etoplevel'});
+
+# Load the current qgroups and ensure the requested ID still exists.
+$qgroups = &list_btrfs_qgroups($dir, 0, \$listerr);
+&error($listerr) if (!$qgroups);
+($qgroup) = grep { $_->{'id'} eq $in{'qgroup'} } @$qgroups;
+$qgroup || &error($text{'btrfs_eqgroup'});
+
+# Start a form bound to the selected filesystem and qgroup.
+&ui_print_header(undef, $text{'btrfs_edit_title'}, "", "btrfs");
+print "<p>$text{'btrfs_edit_info'}</p>\n";
+print &ui_form_start("save_btrfs.cgi", "post");
+print &ui_hidden("dir", $dir);
+print &ui_hidden("qgroup", $qgroup->{'id'});
+print &ui_table_start(&text('btrfs_edit_header',
+	&html_escape($qgroup->{'id'}), &html_escape($dir)), "width=100%", 2);
+
+# Show the current path and accounted usage as read-only values.
+print &ui_table_row($text{'btrfs_path'},
+	$qgroup->{'path'} ne "" ? &html_escape($qgroup->{'path'}) : "-");
+print &ui_table_row($text{'btrfs_referenced'},
+	&nice_size($qgroup->{'referenced'}));
+print &ui_table_row($text{'btrfs_exclusive'},
+	&nice_size($qgroup->{'exclusive'}));
+print &ui_table_hr();
+
+# Allow referenced and exclusive limits to be changed independently.
+print &ui_table_row($text{'btrfs_max_referenced'},
+	&quota_input("max_referenced",
+		defined($qgroup->{'max_referenced'}) ?
+			$qgroup->{'max_referenced'} : 0, 1));
+print &ui_table_row($text{'btrfs_max_exclusive'},
+	&quota_input("max_exclusive",
+		defined($qgroup->{'max_exclusive'}) ?
+			$qgroup->{'max_exclusive'} : 0, 1));
+print &ui_table_end();
+print &ui_form_end([ [ undef, $text{'btrfs_update'} ] ]);
+
+# Return to the qgroup list for this filesystem.
+&ui_print_footer("list_btrfs.cgi?dir=".&urlize($dir), $text{'btrfs_title'});

quota/help/btrfs.html

@@ -0,0 +1,57 @@
+<header>Btrfs Subvolume Quotas</header>
+
+<h3>Introduction</h3>
+Btrfs quotas control disk usage for subvolumes through quota groups, usually
+called <tt>qgroups</tt>. Unlike traditional Unix quotas, they do not limit an
+individual user or group and do not provide soft limits, grace periods, or
+file-count limits. <p>
+
+Each Btrfs subvolume has a level-0 <tt>qgroup</tt>. The module displays the
+following usage and limit values for each <tt>qgroup</tt> :
+<dl>
+<dt><b>Referenced</b>
+<dd>All data reachable from the subvolume, including data shared with other
+subvolumes or snapshots.
+<dt><b>Exclusive</b>
+<dd>Data used only by the subvolume, which would be freed if it were deleted.
+<dt><b>Referenced limit</b>
+<dd>The maximum referenced space that the <tt>qgroup</tt> may use.
+<dt><b>Exclusive limit</b>
+<dd>The maximum exclusive space that the <tt>qgroup</tt> may use.
+</dl>
+
+<h3>Accounting Modes</h3>
+When Btrfs quotas are enabled, the accounting mode configured in the module
+settings is used :
+<dl>
+<dt><b>Full accounting</b>
+<dd>Tracks shared space between subvolumes and snapshots. This is the
+recommended mode when accurate referenced and exclusive usage is required.
+<dt><b>Simple accounting</b>
+<dd>Tracks original ownership with lower overhead, but does not fully track
+space shared between subvolumes and snapshots.
+</dl>
+In simple accounting mode, both values show space assigned to the subvolume
+that first wrote the data. <p>
+Changing the module setting does not convert an already-enabled filesystem.
+The selected mode is used the next time quotas are enabled. <p>
+
+<h3>Managing Btrfs Quotas</h3>
+The main module page shows each mounted Btrfs filesystem, its accounting mode,
+consistency state, and an action to enable or disable quotas. Click a filesystem
+path to view its <tt>qgroups</tt>, usage, and limits. Click a <tt>qgroup</tt> ID
+to edit its referenced and exclusive limits. The top-level <tt>qgroup</tt>
+<tt>0/5</tt> is shown for information only because limiting it could stop
+filesystem changes. <p>
+
+Because quota state and <tt>qgroup</tt> IDs apply to the whole underlying Btrfs
+filesystem, delegated Webmin users must be allowed to manage all filesystems to
+access these controls. A permission scoped to one mounted subvolume is not
+sufficient. <p>
+
+Full accounting also provides a rescan action for rebuilding <tt>qgroup</tt>
+accounting in the background. Disabling Btrfs quotas removes all
+<tt>qgroup</tt> configuration and limits on the filesystem, so the module
+always requests confirmation first. <p>
+
+<hr>

quota/index.cgi

@@ -1,21 +1,31 @@
 #!/usr/local/bin/perl
 # index.cgi
 # Display a list of all local filesystems, and allow editing of quotas
-# on those which have quotas turned on. The actual turning on of quotas must
-# be done in the mount module first.
+# on those which have quotas turned on. Traditional quota mount options are
+# configured in the mount module, while Btrfs quotas are managed here.
 
 require './quota-lib.pl';
-&ui_print_header(undef, $text{'index_title'}, "", "intro", 1, 1, 0,
+
+# Discover allowed Btrfs mounts independently of the traditional quota tools.
+@btrfs = grep { &can_edit_btrfs_filesys($_->[0]) } &list_btrfs_filesystems();
+$err = &quotas_init();
+
+# Traditional filesystems are unavailable when quota-tools initialization fails.
+@list = $err ? ( ) : &list_filesystems();
+
+# Use focused Btrfs help when it is the only quota model shown on this page.
+$help = @btrfs && !@list ? "btrfs" : "intro";
+&ui_print_header(undef, $text{'index_title'}, "", $help, 1, 1, 0,
 	&help_search_link("quota", "man", "howto"));
 
-$err = &quotas_init();
-if ($err) {
+# Stop only when neither traditional quota tools nor Btrfs tools can provide a
+# usable filesystem list.
+if ($err && (!@btrfs || !&has_command("btrfs"))) {
 	print "<p><b>$err</b><p>\n";
 	&ui_print_footer("/", $text{'index_return'});
 	exit;
 	}
 
-@list = &list_filesystems();
 if (@list) {
 	print &ui_columns_start([
 		$text{'index_fs'},
@@ -97,13 +107,84 @@ if (@list) {
 		}
 	print &ui_columns_end();
 	}
-else {
+# Report no support only when neither traditional nor Btrfs filesystems exist.
+elsif (!@btrfs) {
 	print "<b>$text{'index_nosupport'}</b><p>\n";
 	if (&foreign_available("mount")) {
 		print &text('index_mountmod', "../mount/"),"<p>\n";
 		}
 	}
 
+# Btrfs subvolume quotas use qgroups instead of Unix users and groups, so they
+# are shown separately from the traditional quota filesystems above.
+if (@btrfs) {
+	# Activation controls require both enable permission and write access.
+	$btrfs_canactivate = $access{'enable'} && !$access{'ro'};
+
+	# Start a table with an action column only for users who can change state.
+	print &ui_columns_start([
+		$text{'index_fs'},
+		$text{'index_type'},
+		$text{'index_mount'},
+		$text{'index_status'},
+		$btrfs_canactivate ? ( $text{'index_action'} ) : (),
+		], 100, 0, undef, &hlink($text{'index_btrfs_title'}, "btrfs"));
+	foreach $f (@btrfs) {
+		# Query each mount independently so failures remain visible per row.
+		undef($action);
+		$status = &btrfs_quota_status($f->[0]);
+
+		# The OS library could not identify this path as manageable Btrfs.
+		if (!$status) {
+			$msg = $text{'index_btrfs_unavailable'};
+			}
+		# Surface command or parsing errors without offering a state change.
+		elsif ($status->{'error'}) {
+			$msg = &text('index_btrfs_error',
+					&html_escape($status->{'error'}));
+			}
+		# Disabled filesystems can be enabled using the configured mode.
+		elsif (!$status->{'enabled'}) {
+			$msg = $text{'index_btrfs_disabled'};
+			$action = "enable";
+			}
+		# Enabled filesystems expose their accounting and consistency state.
+		else {
+			$mode = $status->{'mode'} eq "squota" ?
+				$text{'index_btrfs_simple'} :
+				$status->{'mode'} eq "qgroup" ?
+				$text{'index_btrfs_full'} :
+				$text{'index_btrfs_unknown'};
+			$msg = &text('index_btrfs_enabled', $mode);
+			$msg .= ", $text{'index_btrfs_inconsistent'}"
+				if ($status->{'inconsistent'});
+			$action = "disable";
+			}
+
+		# Build the common filesystem, type, source and status columns.
+		local @cols = (
+			&ui_link("list_btrfs.cgi?dir=".&urlize($f->[0]),
+				 &html_escape($f->[0])),
+			&foreign_call("mount", "fstype_name", $f->[2]),
+			&foreign_call("mount", "device_name", $f->[1]),
+			$msg,
+			);
+
+		# Add the state-changing link only when the ACL allows it.
+		if ($btrfs_canactivate) {
+			push(@cols, $action ?
+				&ui_link("btrfs_action.cgi?dir=".&urlize($f->[0]).
+					 "&action=$action",
+					 $action eq "enable" ? $text{'index_enable'} :
+							       $text{'index_disable'}) : "-");
+			}
+		print &ui_columns_row(\@cols);
+		}
+
+	# Close the separately titled Btrfs filesystem table.
+	print &ui_columns_end();
+	}
+
 # Buttons to edit and specific user or group
 if ($useractive || $groupactive) {
 	print &ui_hr();

quota/install_check.pl

@@ -8,9 +8,15 @@ do 'quota-lib.pl';
 # For mode 0, returns 1 if installed, 0 if not
 sub is_installed
 {
+# Check the traditional quota-tools dependency when this OS implements it.
 if (defined(&quotas_init)) {
 	local $err = &quotas_init();
-	return 0 if ($err);
+	# A usable Btrfs mount and command provide an alternative when the
+	# traditional quota-tools package is not installed.
+	if ($err) {
+		local @btrfs = &list_btrfs_filesystems();
+		return 0 if (!@btrfs || !&has_command("btrfs"));
+		}
 	}
 return $_[0] ? 2 : 1;
 }

quota/lang/en

@@ -167,6 +167,56 @@ index_egroup=Edit Group Quotas:
 index_egroupdesc=Enter or select a group, and click this button to view its quotas on all filesystems.
 index_nosupport=No local filesystems can support quotas.
 index_mountmod=You can enable quotas for a filesystem in the <a href='$1'>Disk and Network Filesystems</a> module.
+index_btrfs_title=Btrfs Subvolume Quotas
+index_btrfs_enabled=Enabled, $1
+index_btrfs_disabled=Disabled
+index_btrfs_full=full accounting
+index_btrfs_simple=simple accounting
+index_btrfs_unknown=accounting mode unavailable
+index_btrfs_inconsistent=inconsistent
+index_btrfs_unavailable=Unavailable
+index_btrfs_error=Error: $1
+
+btrfs_title=Btrfs Subvolume Quotas
+btrfs_return=filesystem list
+btrfs_status_header=Quota status for $1
+btrfs_status=Status
+btrfs_enabled=Enabled
+btrfs_disabled=Disabled
+btrfs_mode=Accounting mode
+btrfs_full=Full accounting
+btrfs_simple=Simple accounting
+btrfs_unknown=Unavailable from this version of <tt>btrfs-progs</tt>
+btrfs_consistency=Accounting state
+btrfs_consistent=Consistent
+btrfs_inconsistent=Inconsistent - a rescan is recommended
+btrfs_qgroups=Subvolume quota groups
+btrfs_qgroup=<tt>qgroup</tt>
+btrfs_path=Subvolume path
+btrfs_referenced=Referenced usage
+btrfs_exclusive=Exclusive usage
+btrfs_max_referenced=Referenced limit
+btrfs_max_exclusive=Exclusive limit
+btrfs_disable=Disable quotas
+btrfs_disable_confirm=Disable Btrfs quotas on $1?
+btrfs_disable_warning=All $1 configuration and limits on this filesystem will be removed!
+btrfs_rescan=Rescan quotas
+btrfs_rescan_desc=Rebuild full <tt>qgroup</tt> accounting in the background.
+btrfs_edit_title=Edit Btrfs Quota
+btrfs_edit_header=Limits for <tt>qgroup</tt> <tt>$1</tt> on <tt>$2</tt>
+btrfs_edit_info=Full accounting shows space reachable from the subvolume and space freed by deleting it. Simple accounting shows space assigned to the subvolume that first wrote the data.
+btrfs_update=Update
+btrfs_eallow=Btrfs quota management requires permission to manage all filesystems because qgroups apply to the whole underlying filesystem
+btrfs_eenable=You are not allowed to enable or disable quotas on this filesystem
+btrfs_eedit=You are not allowed to edit Btrfs quota limits
+btrfs_enotbtrfs=The selected path is not on a mounted Btrfs filesystem
+btrfs_eqgroup=The selected Btrfs <tt>qgroup</tt> does not exist
+btrfs_etoplevel=The top-level Btrfs <tt>qgroup</tt> cannot be limited because doing so can block the entire filesystem
+btrfs_eaction=Invalid Btrfs quota action
+btrfs_efailed=Failed to manage Btrfs quotas
+btrfs_esave=Failed to save the Btrfs quota
+btrfs_elimit=Quota limits must be positive numbers
+btrfs_emax=You are not allowed to grant limits above $1
 
 lgroups_failed=Failed to list groups
 lgroups_tablist=Group list

quota/linux-lib.pl

@@ -82,6 +82,12 @@ the following :
 =cut
 sub quota_can
 {
+my ($mnttab) = @_;
+
+# The quota-tools commands used by this module cannot reliably manage tmpfs
+# mounts, even when they expose usrquota or grpquota mount options.
+return 0 if ($mnttab->[2] eq "tmpfs");
+
 my %exclude_mounts;
 if (&has_command("findmnt")) {
 	%exclude_mounts = map { $_ => 1 } split( /\n/m, backquote_command('findmnt -r | grep -oP \'^(\S+)(?=.*\[\/)\'') );
@@ -289,15 +295,22 @@ if ($out =~ /\s(\d+\.\d+)/) {
 # Force load of quota kernel modules
 &system_logged("modprobe quota_v2 >/dev/null 2>&1");
 
-local $fmt = $version >= 2 ? "vfsv0" : "vfsold";
+# Quota tools 4 and later support 64-bit limits in vfsv1 files
+local $fmt = $version >= 4 ? "vfsv1" :
+	     $version >= 2 ? "vfsv0" : "vfsold";
 local $hidden = &hidden_ext_quota_mode($_[0]);
 if ($_[1]%2 == 1) {
 	# turn on user quotas
 	local $qf = $version >= 2 ? "aquota.user" : "quota.user";
-	if (!-s "$_[0]/$qf" && !($hidden & 1)) {
+	local $legacy = $version >= 4 && !($hidden & 1) &&
+			$qf ne "quota.user" &&
+			!-s "$_[0]/$qf" &&
+			-s "$_[0]/quota.user";
+	if (!-s "$_[0]/$qf" && !$legacy && !($hidden & 1)) {
 		# Setting up for the first time
 		local $ok = 0;
-		if (&has_command("convertquota") && $version >= 2) {
+		if (&has_command("convertquota") && $version >= 2 &&
+		    $version < 4) {
 			# Try creating a quota.user file and converting it
 			&open_tempfile(QUOTAFILE, ">>$_[0]/quota.user", 0, 1);
 			&close_tempfile(QUOTAFILE);
@@ -315,24 +328,32 @@ if ($_[1]%2 == 1) {
 				&set_ownership_permissions(undef, undef, 0600,
 							   "$_[0]/$qf");
 				}
-			&run_quotacheck($_[0]) ||
-				&run_quotacheck($_[0], "-u -f") ||
-				&run_quotacheck($_[0], "-u -f -m") ||
-				&run_quotacheck($_[0], "-u -f -m -c") ||
-				&run_quotacheck($_[0], "-u -f -m -c -F $fmt");
+			local $fflag = $fmt eq "vfsv1" ? " -F $fmt" : "";
+			$ok = &run_quotacheck($_[0], "-u$fflag") ||
+				&run_quotacheck($_[0], "-u -f$fflag") ||
+				&run_quotacheck($_[0], "-u -f -m$fflag") ||
+				&run_quotacheck($_[0], "-u -f -m -c$fflag");
+			&run_quotacheck($_[0], "-u -f -m -c -F ".
+				($fmt eq "vfsv1" ? "vfsv0" : $fmt)) if (!$ok);
 			}
 		}
-	$out = &backquote_logged(
-			"$config{'user_quotaon_command'} ".quotemeta($_[0])." 2>&1");
+	local $fflag = $legacy ? " -F vfsold" : "";
+	$out = &backquote_logged("$config{'user_quotaon_command'}$fflag ".
+			quotemeta($_[0])." 2>&1");
 	if ($?) { return $out; }
 	}
 if ($_[1] > 1) {
 	# turn on group quotas
 	local $qf = $version >= 2 ? "aquota.group" : "quota.group";
-	if (!-s "$_[0]/$qf" && !($hidden & 2)) {
+	local $legacy = $version >= 4 && !($hidden & 2) &&
+			$qf ne "quota.group" &&
+			!-s "$_[0]/$qf" &&
+			-s "$_[0]/quota.group";
+	if (!-s "$_[0]/$qf" && !$legacy && !($hidden & 2)) {
 		# Setting up for the first time
 		local $ok = 0;
-		if (!$ok && &has_command("convertquota") && $version >= 2) {
+		if (!$ok && &has_command("convertquota") && $version >= 2 &&
+		    $version < 4) {
 			# Try creating a quota.group file and converting it
 			&open_tempfile(QUOTAFILE, ">>$_[0]/quota.group", 0, 1);
 			&close_tempfile(QUOTAFILE);
@@ -350,15 +371,18 @@ if ($_[1] > 1) {
 				&set_ownership_permissions(undef, undef, 0600,
 							   "$_[0]/$qf");
 				}
-			&run_quotacheck($_[0]) ||
-				&run_quotacheck($_[0], "-g -f") ||
-				&run_quotacheck($_[0], "-g -f -m") ||
-				&run_quotacheck($_[0], "-g -f -m -c") ||
-				&run_quotacheck($_[0], "-g -f -m -c -F $fmt");
+			local $fflag = $fmt eq "vfsv1" ? " -F $fmt" : "";
+			$ok = &run_quotacheck($_[0], "-g$fflag") ||
+				&run_quotacheck($_[0], "-g -f$fflag") ||
+				&run_quotacheck($_[0], "-g -f -m$fflag") ||
+				&run_quotacheck($_[0], "-g -f -m -c$fflag");
+			&run_quotacheck($_[0], "-g -f -m -c -F ".
+				($fmt eq "vfsv1" ? "vfsv0" : $fmt)) if (!$ok);
 			}
 		}
-	$out = &backquote_logged(
-			"$config{'group_quotaon_command'} ".quotemeta($_[0])." 2>&1");
+	local $fflag = $legacy ? " -F vfsold" : "";
+	$out = &backquote_logged("$config{'group_quotaon_command'}$fflag ".
+			quotemeta($_[0])." 2>&1");
 	if ($?) { return $out; }
 	}
 return undef;
@@ -373,8 +397,10 @@ Runs the quotacheck command on some filesystem, and returns 1 on success or
 sub run_quotacheck
 {
 &clean_language();
+local $cmd = $config{'quotacheck_command'};
+$cmd =~ s/\s+-[ug]+(?=\s|$)//g;
 local $out = &backquote_logged(
-	"$config{'quotacheck_command'} $_[1] ".quotemeta($_[0])." 2>&1");
+	"$cmd $_[1] ".quotemeta($_[0])." 2>&1");
 &reset_environment();
 return $? || $out =~ /cannot guess|cannot remount|cannot find|please stop/i ? 0 : 1;
 }
@@ -767,18 +793,28 @@ if ($_[1] == 0 || $_[1] == 2) {
 	&unlink_file("$_[0]/aquota.group.new");
 	}
 local $cmd = $config{'quotacheck_command'};
-$cmd =~ s/\s+-[ug]//g;
+$cmd =~ s/\s+-[ug]+(?=\s|$)//g;
 local $flag = $_[1] == 1 ? "-u" : $_[1] == 2 ? "-g" : "-u -g";
-$out = &backquote_logged("$cmd $flag ".quotemeta($_[0])." 2>&1");
+local $new = $_[1] == 1 ?
+	     !-s "$_[0]/aquota.user" && !-s "$_[0]/quota.user" :
+	     $_[1] == 2 ?
+	     !-s "$_[0]/aquota.group" && !-s "$_[0]/quota.group" :
+	     !-s "$_[0]/aquota.user" && !-s "$_[0]/quota.user" &&
+	     !-s "$_[0]/aquota.group" && !-s "$_[0]/quota.group";
+local $qver = $new ? &backquote_command("quota -V 2>&1") : "";
+local $fmt = $new && $qver =~ /\s(\d+)\.\d+/ && $1 >= 4 ? "vfsv1" : undef;
+local $fflag = $fmt ? " -F $fmt" : "";
+$out = &backquote_logged("$cmd $flag$fflag ".quotemeta($_[0])." 2>&1");
 if ($?) {
 	# Try with the -f and -m options
 	$out = &backquote_logged(
-		"$cmd $flag -f -m ".quotemeta($_[0])." 2>&1");
+		"$cmd $flag -f -m$fflag ".quotemeta($_[0])." 2>&1");
 	if ($?) {
 		# Try with the -F option
-		foreach my $fmt ("vfsv1", "vfsv0", "vfsold") {
+		foreach my $tryfmt ($fmt ? ("vfsv0", "vfsold") :
+					 ("vfsv1", "vfsv0", "vfsold")) {
 			$out = &backquote_logged(
-				"$cmd $flag -f -m -F $fmt ".quotemeta($_[0])." 2>&1");
+				"$cmd $flag -f -m -F $tryfmt ".quotemeta($_[0])." 2>&1");
 			last if (!$?);
 			}
 		}
@@ -1084,6 +1120,567 @@ my $out = &backquote_logged(
 &error($out) if ($?);
 }
 
+=head2 is_btrfs_fs(path)
+
+Returns 1 if a path is on a mounted Btrfs filesystem, 0 otherwise.
+
+=cut
+sub is_btrfs_fs
+{
+my ($path) = @_;
+return 0 if (!&valid_btrfs_path($path));
+
+# Btrfs subvolumes can have a different st_dev from the filesystem mount, so
+# select the longest containing mount path instead of comparing device numbers.
+my $best;
+foreach my $m (&mount::list_mounted()) {
+	next if (!defined($m->[0]) || !defined($m->[2]));
+	next if (!&is_under_directory($m->[0], $path));
+	$best = $m if (!$best || length($m->[0]) > length($best->[0]));
+	}
+return $best && $best->[2] eq "btrfs" ? 1 : 0;
+}
+
+# decode_btrfs_mount_path(path)
+# Decodes the octal escapes used by /proc/self/mountinfo.
+sub decode_btrfs_mount_path
+{
+my ($path) = @_;
+$path =~ s/\\([0-7]{3})/chr(oct($1))/eg;
+return $path;
+}
+
+# parse_btrfs_mountinfo(text, path)
+# Returns the deepest Btrfs mount point containing path and its filesystem root.
+sub parse_btrfs_mountinfo
+{
+my ($text, $path) = @_;
+my ($best_mount, $best_root);
+# Parse only Btrfs mountinfo records that can contain the requested path.
+foreach my $line (split(/\r?\n/, $text)) {
+	my ($left, $right) = split(/\s+-\s+/, $line, 2);
+	next if (!defined($right));
+	my @right = split(/\s+/, $right);
+	next if ($right[0] ne "btrfs");
+	my @left = split(/\s+/, $left);
+	next if (@left < 5);
+	my $root = &decode_btrfs_mount_path($left[3]);
+	my $mount = &decode_btrfs_mount_path($left[4]);
+	next if (!&is_under_directory($mount, $path));
+	# Prefer the deepest match when nested Btrfs subvolumes are mounted.
+	if (!defined($best_mount) || length($mount) > length($best_mount)) {
+		$best_mount = $mount;
+		$best_root = $root;
+		}
+	}
+return defined($best_mount) ? ($best_mount, $best_root) : ( );
+}
+
+=head2 btrfs_mountinfo(path)
+
+Returns the visible Btrfs mount point containing a path and its filesystem
+root, or an empty list when no containing Btrfs mount can be found.
+
+=cut
+sub btrfs_mountinfo
+{
+my ($path) = @_;
+open(my $fh, "<", "/proc/self/mountinfo") || return ( );
+local $/ = undef;
+my $text = <$fh>;
+close($fh);
+return &parse_btrfs_mountinfo($text, $path);
+}
+
+=head2 btrfs_qgroup_absolute_path(mount, filesystem-root, qgroup-path)
+
+Converts the filesystem-relative path reported by C<btrfs qgroup show> to a
+visible absolute path, or returns undef when it is outside the mounted root.
+
+=cut
+sub btrfs_qgroup_absolute_path
+{
+my ($mount, $root, $path) = @_;
+return undef if (!defined($path) || $path eq "" || $path =~ /^</);
+$root ||= "/";
+$root =~ s/^\/+//;
+$root =~ s/\/+\z//;
+$path =~ s/^\/+//;
+# Strip the mounted subvolume root from the filesystem-relative qgroup path.
+if ($root ne "") {
+	return undef if ($path ne $root && index($path, "$root/") != 0);
+	$path = substr($path, length($root));
+	$path =~ s/^\/+//;
+	}
+$mount =~ s/\/+\z// if ($mount ne "/");
+my $absolute = $path eq "" ? ($mount || "/") :
+		       ($mount eq "/" ? "/$path" : "$mount/$path");
+$absolute =~ s{//+}{/}g;
+return $absolute;
+}
+
+# valid_btrfs_path(path)
+# Returns 1 for an absolute path that is safe to pass to Btrfs tools.
+sub valid_btrfs_path
+{
+my ($path) = @_;
+return defined($path) && $path =~ /^\// && $path !~ /[\r\n\0]/ ? 1 : 0;
+}
+
+# run_btrfs_command(logged, arg, ...)
+# Runs a Btrfs command with a clean locale. Returns the output and undef on
+# success, or undef and an error message on failure.
+sub run_btrfs_command
+{
+my ($logged, @args) = @_;
+my $btrfs = &has_command("btrfs");
+return (undef, "The btrfs command was not found") if (!$btrfs);
+my $cmd = quotemeta($btrfs)." ".
+	  join(" ", map { quotemeta($_) } @args)." 2>&1";
+&clean_language();
+my $out = $logged ? &backquote_logged($cmd) : &backquote_command($cmd);
+my $ex = $?;
+&reset_environment();
+$out =~ s/\s+$//;
+return $ex ? (undef, $out || "The btrfs command failed") : ($out, undef);
+}
+
+=head2 parse_btrfs_quota_status(output)
+
+Parses output from C<btrfs quota status> and returns a hash reference with
+enabled, mode, inconsistent and other status fields, or undef for invalid
+output. This function is mainly intended for internal use.
+
+=cut
+sub parse_btrfs_quota_status
+{
+my ($out) = @_;
+my %rv;
+return undef if ($out !~ /^\s*Enabled:\s*(yes|no)\s*$/mi);
+$rv{'enabled'} = lc($1) eq "yes" ? 1 : 0;
+if ($out =~ /^\s*Mode:\s*(\S+)(?:\s+\(([^\)]*)\))?\s*$/mi) {
+	$rv{'mode'} = lc($1);
+	$rv{'mode_description'} = $2 if (defined($2));
+	}
+if ($out =~ /^\s*Inconsistent:\s*(yes|no)\s*$/mi) {
+	$rv{'inconsistent'} = lc($1) eq "yes" ? 1 : 0;
+	}
+if ($out =~ /^\s*Override limits:\s*(yes|no)\s*$/mi) {
+	$rv{'override_limits'} = lc($1) eq "yes" ? 1 : 0;
+	}
+if ($out =~ /^\s*Drop subtree threshold:\s*(\d+)\s*$/mi) {
+	$rv{'drop_subtree_threshold'} = int($1);
+	}
+if ($out =~ /^\s*Total count:\s*(\d+)\s*$/mi) {
+	$rv{'total_count'} = int($1);
+	}
+my %levels;
+while($out =~ /^\s*Level\s+(\d+):\s*(\d+)\s*$/gmi) {
+	$levels{$1} = int($2);
+	}
+$rv{'levels'} = \%levels if (%levels);
+return \%rv;
+}
+
+# btrfs_filesystem_uuid(path)
+# Returns the UUID of the Btrfs filesystem containing a path.
+sub btrfs_filesystem_uuid
+{
+my ($path) = @_;
+my ($out, $err) = &run_btrfs_command(
+	0, "filesystem", "show", "--raw", $path);
+return undef if (!defined($out) ||
+		 $out !~ /^\s*Label:.*\buuid:\s*([0-9a-f]{8}(?:-[0-9a-f]{4}){3}-[0-9a-f]{12})\s*$/mi);
+return lc($1);
+}
+
+# btrfs_sysfs_quota_status(path)
+# Reads quota state exported by the kernel. This preserves accounting mode and
+# consistency information on btrfs-progs releases older than `quota status`.
+sub btrfs_sysfs_quota_status
+{
+my ($path) = @_;
+my $uuid = &btrfs_filesystem_uuid($path);
+return undef if (!$uuid);
+my $sysfs = $btrfs_sysfs_root || "/sys/fs/btrfs";
+my $qdir = "$sysfs/$uuid/qgroups";
+return undef if (!-d $qdir);
+
+my %rv = ( 'supported' => 1, 'enabled' => 1 );
+foreach my $field (qw(enabled mode inconsistent)) {
+	my $file = "$qdir/$field";
+	next if (!-r $file);
+	open(my $fh, "<", $file) || next;
+	my $value = <$fh>;
+	close($fh);
+	next if (!defined($value));
+	$value =~ s/^\s+|\s+$//g;
+	if ($field eq "mode" && $value =~ /^(qgroup|squota)$/) {
+		$rv{$field} = $value;
+		}
+	elsif ($field ne "mode" && $value =~ /^([01])$/) {
+		$rv{$field} = int($1);
+		}
+	}
+
+# Kernels predating simple quotas expose the qgroups directory without a mode
+# file. Their only possible accounting mode is full qgroups.
+$rv{'mode'} = "qgroup" if (!defined($rv{'mode'}) && !-e "$qdir/mode");
+return \%rv;
+}
+
+=head2 btrfs_quota_status(path)
+
+Returns a hash reference describing the Btrfs quota status for a path. The
+hash always contains C<supported>, and may contain C<enabled>, C<mode>,
+C<inconsistent> and C<error>. Returns undef when the path is not on Btrfs.
+Older btrfs-progs releases without C<btrfs quota status> are supported using
+C<btrfs qgroup show> as a fallback.
+
+=cut
+sub btrfs_quota_status
+{
+my ($path) = @_;
+return undef if (!&is_btrfs_fs($path));
+my ($out, $err) = &run_btrfs_command(0, "quota", "status", $path);
+if (defined($out)) {
+	my $rv = &parse_btrfs_quota_status($out);
+	if ($rv) {
+		$rv->{'supported'} = 1;
+		return $rv;
+		}
+	}
+
+# Older versions have no quota status command. qgroup show succeeds when
+# quotas are enabled, and reports a missing quota root when disabled.
+my ($qout, $qerr) = &run_btrfs_command(0, "qgroup", "show", "--raw", $path);
+if (defined($qout)) {
+	my $rv = &btrfs_sysfs_quota_status($path) ||
+		 { 'supported' => 1, 'enabled' => 1 };
+	# Old qgroup-show versions warn on stdout when the counters are
+	# inconsistent. Retain that signal if sysfs did not provide the flag.
+	if (!defined($rv->{'inconsistent'})) {
+		$rv->{'inconsistent'} =
+			$qout =~ /^\s*(?:warning|error):.*qgroup.*inconsistent/mi ?
+			1 : 0;
+		}
+	# A simple-quota space holder is definitive even when sysfs is unavailable.
+	$rv->{'mode'} = "squota"
+		if (!defined($rv->{'mode'}) &&
+		    $qout =~ /<squota space holder>/i);
+	return $rv;
+	}
+elsif ($qerr =~ /(?:quota root does not exist|quotas? (?:are |is )?not enabled)/i) {
+	return { 'supported' => 1,
+		 'enabled' => 0 };
+	}
+return { 'supported' => 1,
+	 'error' => $qerr || $err || "Unable to read Btrfs quota status" };
+}
+
+=head2 parse_btrfs_qgroup_output(output)
+
+Parses raw output from C<btrfs qgroup show -repc> and returns an array
+reference of qgroup hashes. Numeric sizes are returned in bytes, missing
+limits are undef, and parent and child qgroups are returned as array refs.
+This function is mainly intended for internal use.
+
+=cut
+sub parse_btrfs_qgroup_output
+{
+my ($out) = @_;
+my @rv;
+foreach my $line (split(/\r?\n/, $out)) {
+	$line =~ s/^\s+//;
+	$line =~ s/\s+$//;
+	next if ($line !~ /^(\d+\/\d+)\s+/);
+	my @cols = split(/\s+/, $line, 8);
+	next if (@cols < 7);
+	my ($id, $referenced, $exclusive, $max_referenced, $max_exclusive,
+	    $parents, $children, $path) = @cols;
+	push(@rv, {
+		'id' => $id,
+		'referenced' => int($referenced),
+		'exclusive' => int($exclusive),
+		'max_referenced' => $max_referenced eq "none" ? undef :
+				    int($max_referenced),
+		'max_exclusive' => $max_exclusive eq "none" ? undef :
+				   int($max_exclusive),
+		'parents' => $parents =~ /^-+$/ ? [ ] :
+			     [ split(/,/, $parents) ],
+		'children' => $children =~ /^-+$/ ? [ ] :
+			      [ split(/,/, $children) ],
+		'path' => defined($path) ? $path : "",
+		});
+	}
+return \@rv;
+}
+
+=head2 parse_btrfs_subvolume_list_output(output)
+
+Parses raw output from C<btrfs subvolume list> and returns a hash reference
+mapping numeric subvolume IDs to filesystem-relative paths. This is used to
+fill qgroup paths on btrfs-progs versions older than 6.0.1.
+
+=cut
+sub parse_btrfs_subvolume_list_output
+{
+my ($out) = @_;
+my %rv;
+foreach my $line (split(/\r?\n/, $out)) {
+	# The default output ends in "path <path relative to top level>".
+	# Keep the final field intact because Btrfs paths may contain spaces.
+	if ($line =~ /^ID\s+(\d+)\s+.*?\s+path\s+(.*)$/) {
+		$rv{int($1)} = $2;
+		}
+	}
+return \%rv;
+}
+
+=head2 list_btrfs_qgroups(path, [sync], [&error])
+
+Returns an array reference containing all Btrfs qgroups on the filesystem
+that contains path. Each entry contains id, referenced and exclusive usage,
+limits, parents, children and path. Returns undef on failure and optionally
+saves the error message to the final scalar reference. If sync is true, the
+filesystem is synchronized before usage is read.
+
+=cut
+sub list_btrfs_qgroups
+{
+my ($path, $sync, $errref) = @_;
+if (!&valid_btrfs_path($path)) {
+	$$errref = "Invalid Btrfs path" if ($errref);
+	return undef;
+	}
+my @args = ( "qgroup", "show", "--raw", "-r", "-e", "-p", "-c" );
+push(@args, "--sync") if ($sync);
+push(@args, $path);
+my ($out, $err) = &run_btrfs_command(0, @args);
+if (!defined($out)) {
+	$$errref = $err if ($errref);
+	return undef;
+	}
+my $rv = &parse_btrfs_qgroup_output($out);
+if (!@$rv && $out =~ /\S/) {
+	$$errref = "Unable to parse Btrfs qgroup output" if ($errref);
+	return undef;
+	}
+# qgroup paths were not printed by default until btrfs-progs 6.0.1. Populate
+# missing level-0 paths from the long-established subvolume-list output so
+# callers can keep identifying subvolumes by path on supported older systems.
+if (grep { $_->{'id'} =~ /^0\/(\d+)$/ && $_->{'path'} eq '' } @$rv) {
+	my ($subvolout) = &run_btrfs_command(
+		0, "subvolume", "list", $path);
+	if (defined($subvolout)) {
+		my $paths = &parse_btrfs_subvolume_list_output($subvolout);
+		foreach my $q (@$rv) {
+			if ($q->{'id'} =~ /^0\/(\d+)$/ && $q->{'path'} eq '' &&
+			    defined($paths->{$1})) {
+				$q->{'path'} = $paths->{$1};
+				}
+			}
+		}
+	}
+$$errref = undef if ($errref);
+return $rv;
+}
+
+=head2 btrfs_subvolume_id(path, [&error])
+
+Returns the numeric Btrfs subvolume ID for path, or undef if the path is not
+a subvolume or the ID cannot be read. The optional scalar reference receives
+the command error.
+
+=cut
+sub btrfs_subvolume_id
+{
+my ($path, $errref) = @_;
+if (!&valid_btrfs_path($path)) {
+	$$errref = "Invalid Btrfs path" if ($errref);
+	return undef;
+	}
+my ($out, $err) = &run_btrfs_command(0, "subvolume", "show", $path);
+if (defined($out) && $out =~ /^\s*Subvolume ID:\s*(\d+)\s*$/mi) {
+	$$errref = undef if ($errref);
+	return int($1);
+	}
+$$errref = $err || "Unable to read the Btrfs subvolume ID" if ($errref);
+return undef;
+}
+
+=head2 get_btrfs_qgroup(path, [sync], [&error])
+
+Returns the level-0 qgroup for a Btrfs subvolume path, or undef on failure.
+The returned hash has the same fields as entries from list_btrfs_qgroups.
+
+=cut
+sub get_btrfs_qgroup
+{
+my ($path, $sync, $errref) = @_;
+my $id = &btrfs_subvolume_id($path, $errref);
+return undef if (!defined($id));
+my $qgroups = &list_btrfs_qgroups($path, $sync, $errref);
+return undef if (!$qgroups);
+foreach my $q (@$qgroups) {
+	return $q if ($q->{'id'} eq "0/$id");
+	}
+$$errref = "No Btrfs qgroup exists for subvolume $id" if ($errref);
+return undef;
+}
+
+=head2 enable_btrfs_quotas(path, [simple])
+
+Enables Btrfs quotas on the filesystem containing path. If simple is true,
+simple quotas (squotas) are requested. Returns undef on success or an error
+message on failure.
+
+=cut
+sub enable_btrfs_quotas
+{
+my ($path, $simple) = @_;
+return "Invalid Btrfs path" if (!&valid_btrfs_path($path));
+my @args = ( "quota", "enable" );
+push(@args, "--simple") if ($simple);
+push(@args, $path);
+my ($out, $err) = &run_btrfs_command(1, @args);
+return $err;
+}
+
+=head2 disable_btrfs_quotas(path)
+
+Disables Btrfs quotas on the filesystem containing path. This removes all
+qgroup configuration. Returns undef on success or an error message on
+failure.
+
+=cut
+sub disable_btrfs_quotas
+{
+my ($path) = @_;
+return "Invalid Btrfs path" if (!&valid_btrfs_path($path));
+my ($out, $err) = &run_btrfs_command(1, "quota", "disable", $path);
+return $err;
+}
+
+=head2 rescan_btrfs_quotas(path, [wait])
+
+Starts a Btrfs quota rescan. If wait is true, waits for the rescan to finish.
+Returns undef on success or an error message on failure.
+
+=cut
+sub rescan_btrfs_quotas
+{
+my ($path, $wait) = @_;
+return "Invalid Btrfs path" if (!&valid_btrfs_path($path));
+my @args = ( "quota", "rescan" );
+push(@args, "-w") if ($wait);
+push(@args, $path);
+my ($out, $err) = &run_btrfs_command(1, @args);
+return $err;
+}
+
+# valid_btrfs_qgroup_id(id)
+# Returns 1 for a syntactically valid qgroup ID.
+sub valid_btrfs_qgroup_id
+{
+return defined($_[0]) && $_[0] =~ /^\d+\/\d+$/ ? 1 : 0;
+}
+
+=head2 set_btrfs_qgroup_limit(path, [qgroup], [bytes], [exclusive])
+
+Sets the referenced or exclusive byte limit for a Btrfs qgroup. If qgroup is
+undef, path must be a subvolume and its level-0 qgroup is changed. If bytes
+is undef, the limit is removed. Returns undef on success or an error message
+on failure.
+
+=cut
+sub set_btrfs_qgroup_limit
+{
+my ($path, $qgroup, $bytes, $exclusive) = @_;
+return "Invalid Btrfs path" if (!&valid_btrfs_path($path));
+return "Invalid Btrfs qgroup ID"
+	if (defined($qgroup) && !&valid_btrfs_qgroup_id($qgroup));
+return "Invalid Btrfs qgroup limit"
+	if (defined($bytes) && $bytes !~ /^\d+$/);
+my @args = ( "qgroup", "limit" );
+push(@args, "-e") if ($exclusive);
+push(@args, defined($bytes) ? $bytes : "none");
+push(@args, $qgroup) if (defined($qgroup));
+push(@args, $path);
+my ($out, $err) = &run_btrfs_command(1, @args);
+return $err;
+}
+
+=head2 create_btrfs_qgroup(path, qgroup)
+
+Creates a Btrfs qgroup on the filesystem containing path. Returns undef on
+success or an error message on failure.
+
+=cut
+sub create_btrfs_qgroup
+{
+my ($path, $qgroup) = @_;
+return "Invalid Btrfs path" if (!&valid_btrfs_path($path));
+return "Invalid Btrfs qgroup ID" if (!&valid_btrfs_qgroup_id($qgroup));
+my ($out, $err) = &run_btrfs_command(
+	1, "qgroup", "create", $qgroup, $path);
+return $err;
+}
+
+=head2 delete_btrfs_qgroup(path, qgroup)
+
+Deletes an unassigned Btrfs qgroup. Returns undef on success or an error
+message on failure.
+
+=cut
+sub delete_btrfs_qgroup
+{
+my ($path, $qgroup) = @_;
+return "Invalid Btrfs path" if (!&valid_btrfs_path($path));
+return "Invalid Btrfs qgroup ID" if (!&valid_btrfs_qgroup_id($qgroup));
+my ($out, $err) = &run_btrfs_command(
+	1, "qgroup", "destroy", $qgroup, $path);
+return $err;
+}
+
+=head2 assign_btrfs_qgroup(path, child, parent)
+
+Assigns a child Btrfs qgroup to a parent qgroup. Returns undef on success or
+an error message on failure.
+
+=cut
+sub assign_btrfs_qgroup
+{
+my ($path, $child, $parent) = @_;
+return "Invalid Btrfs path" if (!&valid_btrfs_path($path));
+return "Invalid child Btrfs qgroup ID"
+	if (!&valid_btrfs_qgroup_id($child));
+return "Invalid parent Btrfs qgroup ID"
+	if (!&valid_btrfs_qgroup_id($parent));
+my ($out, $err) = &run_btrfs_command(
+	1, "qgroup", "assign", $child, $parent, $path);
+return $err;
+}
+
+=head2 unassign_btrfs_qgroup(path, child, parent)
+
+Removes a child Btrfs qgroup from a parent qgroup. Returns undef on success
+or an error message on failure.
+
+=cut
+sub unassign_btrfs_qgroup
+{
+my ($path, $child, $parent) = @_;
+return "Invalid Btrfs path" if (!&valid_btrfs_path($path));
+return "Invalid child Btrfs qgroup ID"
+	if (!&valid_btrfs_qgroup_id($child));
+return "Invalid parent Btrfs qgroup ID"
+	if (!&valid_btrfs_qgroup_id($parent));
+my ($out, $err) = &run_btrfs_command(
+	1, "qgroup", "remove", $child, $parent, $path);
+return $err;
+}
+
 =head2 can_quotacheck(fs)
 
 Returns 1 if some FS supports quota checking

quota/list_btrfs.cgi

@@ -0,0 +1,91 @@
+#!/usr/local/bin/perl
+# Display Btrfs quota status and subvolume qgroups
+
+require './quota-lib.pl';
+&ReadParse();
+$dir = $in{'dir'};
+
+# Restrict the page to allowed paths on mounted Btrfs filesystems.
+&can_edit_btrfs_filesys($dir) || &error($text{'btrfs_eallow'});
+defined(&btrfs_quota_status) && &is_btrfs_fs($dir) ||
+	&error($text{'btrfs_enotbtrfs'});
+&error_setup($text{'btrfs_efailed'});
+
+# Read quota status before building the status and qgroup tables.
+$status = &btrfs_quota_status($dir);
+$status || &error($text{'btrfs_enotbtrfs'});
+&error($status->{'error'}) if ($status->{'error'});
+
+&ui_print_header(undef, $text{'btrfs_title'}, "", "btrfs");
+
+# Map the command's accounting mode to a user-facing label.
+$mode = $status->{'mode'} eq "squota" ? $text{'btrfs_simple'} :
+	$status->{'mode'} eq "qgroup" ? $text{'btrfs_full'} :
+	$text{'btrfs_unknown'};
+
+# Display the current enablement, accounting mode and consistency state.
+print &ui_table_start(&text('btrfs_status_header', &html_escape($dir)),
+			      "width=100%", 2);
+print &ui_table_row($text{'btrfs_status'},
+	$status->{'enabled'} ? $text{'btrfs_enabled'} : $text{'btrfs_disabled'});
+print &ui_table_row($text{'btrfs_mode'}, $mode) if ($status->{'enabled'});
+# Show consistency only when btrfs-progs or the kernel reports it.
+if (defined($status->{'inconsistent'})) {
+	print &ui_table_row($text{'btrfs_consistency'},
+		$status->{'inconsistent'} ? $text{'btrfs_inconsistent'} :
+					    $text{'btrfs_consistent'});
+	}
+print &ui_table_end();
+
+# A disabled filesystem has no qgroups to list or edit.
+if (!$status->{'enabled'}) {
+	&ui_print_footer("", $text{'btrfs_return'});
+	exit;
+	}
+
+# Load all qgroups and start the usage and limit table.
+$qgroups = &list_btrfs_qgroups($dir, 0, \$listerr);
+&error($listerr) if (!$qgroups);
+print &ui_columns_start([
+	$text{'btrfs_qgroup'},
+	$text{'btrfs_path'},
+	$text{'btrfs_referenced'},
+	$text{'btrfs_exclusive'},
+	$text{'btrfs_max_referenced'},
+	$text{'btrfs_max_exclusive'},
+	], 100, 0, undef, $text{'btrfs_qgroups'});
+foreach $q (@$qgroups) {
+	# Read-only users and the filesystem-wide top-level qgroup get no edit
+	# link. Limiting 0/5 can block Webmin from changing the limit back.
+	$qid = &ui_tag("tt", &html_escape($q->{'id'}));
+	chomp($qid);
+	if (!$access{'ro'} && $q->{'id'} ne "0/5") {
+		$qid = &ui_link("edit_btrfs.cgi?dir=".&urlize($dir).
+				"&qgroup=".&urlize($q->{'id'}), $qid);
+		}
+
+	# Display usage and use the standard unlimited label for missing limits.
+	print &ui_columns_row([
+		$qid,
+		$q->{'path'} ne "" ? &html_escape($q->{'path'}) : "-",
+		&nice_size($q->{'referenced'}),
+		&nice_size($q->{'exclusive'}),
+		defined($q->{'max_referenced'}) ?
+			&nice_size($q->{'max_referenced'}) : $text{'quota_unlimited'},
+		defined($q->{'max_exclusive'}) ?
+			&nice_size($q->{'max_exclusive'}) : $text{'quota_unlimited'},
+		]);
+	}
+print &ui_columns_end();
+
+# Full accounting supports rescanning; simple accounting deliberately hides it.
+if (!$access{'ro'} && $access{'enable'} && $status->{'mode'} ne "squota") {
+	print &ui_hr();
+	print &ui_buttons_start();
+	print &ui_buttons_row("btrfs_action.cgi", $text{'btrfs_rescan'},
+		$text{'btrfs_rescan_desc'},
+		[ [ "dir", $dir ], [ "action", "rescan" ] ]);
+	print &ui_buttons_end();
+	}
+
+&ui_print_footer("", $text{'btrfs_return'});

quota/module.info

@@ -3,5 +3,5 @@ category=system
 os_support=solaris *-linux hpux freebsd unixware openbsd irix netbsd macos 
 desc=Disk Quotas
 depends=mount
-longdesc=Setup and edit user or group disk quotas for local filesystems.
+longdesc=Setup and edit user, group and Btrfs subvolume quotas for local filesystems.
 readonly=1

quota/quota-lib.pl

@@ -82,6 +82,32 @@ if (defined(&quota_possible)) {
 return grep { $_->[4] || $_->[6] } @mtab;
 }
 
+=head2 list_btrfs_filesystems
+
+Returns one entry for each mounted Btrfs filesystem when the OS library
+provides the Btrfs quota API. Command availability and quota status are checked
+separately by callers; on systems without the API, this function returns an
+empty list.
+
+=cut
+sub list_btrfs_filesystems
+{
+# The OS-specific library determines whether Btrfs quota operations exist.
+return ( ) if (!defined(&btrfs_quota_status));
+
+# Separately mounted subvolumes share quota state, so keep only the first mount
+# for each underlying source while preserving the original display order.
+my %seen;
+my @filesystems;
+foreach my $fs (&mount::list_mounted()) {
+	next if ($fs->[2] ne "btrfs");
+	(my $source = $fs->[1]) =~ s/\[[^\]]*\]$//;
+	next if ($seen{$source}++);
+	push(@filesystems, $fs);
+	}
+return @filesystems;
+}
+
 =head2 parse_options(type, options)
 
 Convert an options string for some filesystem into the global hash %options.
@@ -412,6 +438,20 @@ foreach $fs (split(/\s+/, $access{'filesys'})) {
 return 0;
 }
 
+=head2 can_edit_btrfs_filesys(filesys)
+
+Returns 1 if the current Webmin user can manage Btrfs quotas. Btrfs quota state
+and qgroup IDs belong to the whole underlying filesystem, so a mount-path ACL
+cannot safely confine access to one separately mounted subvolume.
+
+=cut
+sub can_edit_btrfs_filesys
+{
+my ($filesys) = @_;
+return 0 if (!&can_edit_filesys($filesys));
+return scalar(grep { $_ eq "*" } split(/\s+/, $access{'filesys'})) ? 1 : 0;
+}
+
 =head2 can_edit_user(user)
 
 Returns 1 if the current Webmin user can manage quotas for some Unix user.

quota/save_btrfs.cgi

@@ -0,0 +1,86 @@
+#!/usr/local/bin/perl
+# Save the limits for a Btrfs qgroup
+
+require './quota-lib.pl';
+&ReadParse();
+$dir = $in{'dir'};
+
+# Require write access to an allowed mounted Btrfs filesystem and reject
+# malformed qgroup IDs before parsing or applying limits.
+$access{'ro'} && &error($text{'btrfs_eedit'});
+&can_edit_btrfs_filesys($dir) || &error($text{'btrfs_eallow'});
+defined(&btrfs_quota_status) && &is_btrfs_fs($dir) ||
+	&error($text{'btrfs_enotbtrfs'});
+&valid_btrfs_qgroup_id($in{'qgroup'}) || &error($text{'btrfs_eqgroup'});
+$in{'qgroup'} eq "0/5" && &error($text{'btrfs_etoplevel'});
+&error_setup($text{'btrfs_esave'});
+
+# parse_limit(name)
+# Parse one optional byte limit from quota_input and validate its unit factor.
+sub parse_limit
+{
+my ($name) = @_;
+
+# A selected default means that this limit should be removed.
+return undef if ($in{$name."_def"});
+
+# Accept only positive decimal values and units offered by ui_bytesbox.
+$in{$name} =~ /^\d+(?:\.\d+)?$/ && $in{$name} > 0 ||
+	&error($text{'btrfs_elimit'});
+local %units = map { $_, 1 } ( 1, 1024, 1024**2, 1024**3,
+				     1024**4, 1024**5 );
+$units{$in{$name."_units"}} || &error($text{'btrfs_elimit'});
+return int($in{$name} * $in{$name."_units"});
+}
+
+# Parse both limits completely before making either filesystem change.
+$max_referenced = &parse_limit("max_referenced");
+$max_exclusive = &parse_limit("max_exclusive");
+
+# Apply the existing ACL ceiling, converting its KiB value to bytes.
+if ($access{'maxblocks'}) {
+	$maxbytes = $access{'maxblocks'} * 1024;
+	defined($max_referenced) && $max_referenced <= $maxbytes &&
+	defined($max_exclusive) && $max_exclusive <= $maxbytes ||
+		&error(&text('btrfs_emax', &nice_size($maxbytes)));
+	}
+
+# Refresh the selected qgroup so unchanged limits are not re-applied. This
+# lookup only needs the stored limit values, so no filesystem sync is needed.
+$qgroups = &list_btrfs_qgroups($dir, 0, \$listerr);
+&error($listerr) if (!$qgroups);
+($qgroup) = grep { $_->{'id'} eq $in{'qgroup'} } @$qgroups;
+$qgroup || &error($text{'btrfs_eqgroup'});
+
+# same_limit(first, second)
+# Returns true when two optional byte limits are identical.
+sub same_limit
+{
+my ($first, $second) = @_;
+return !defined($first) && !defined($second) ||
+	defined($first) && defined($second) && $first == $second;
+}
+
+# Compare the submitted referenced and exclusive limits with their current
+# values before running either Btrfs command.
+$same_referenced = &same_limit(
+	$max_referenced, $qgroup->{'max_referenced'});
+$same_exclusive = &same_limit(
+	$max_exclusive, $qgroup->{'max_exclusive'});
+
+# Apply only changed limits so each independent setting is left untouched when
+# the submitted value already matches it.
+if (!$same_referenced) {
+	$err = &set_btrfs_qgroup_limit(
+		$dir, $in{'qgroup'}, $max_referenced, 0);
+	&error($err) if ($err);
+	}
+if (!$same_exclusive) {
+	$err = &set_btrfs_qgroup_limit(
+		$dir, $in{'qgroup'}, $max_exclusive, 1);
+	&error($err) if ($err);
+	}
+
+# Log the completed update and return to the qgroup list.
+&webmin_log("save", "btrfs", $in{'qgroup'}, \%in);
+&redirect("list_btrfs.cgi?dir=".&urlize($dir));

quota/t/run-tests.t

@@ -0,0 +1,449 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+no warnings 'once';
+use Test::More;
+use Cwd qw(abs_path);
+use File::Basename qw(dirname);
+use File::Path qw(make_path);
+use File::Temp qw(tempdir);
+
+my $root = abs_path(dirname(__FILE__)."/../..") or die "rootdir: $!";
+my @commands;
+my @responses;
+our @mounted = (
+	[ "/", "/dev/root", "ext4", "rw" ],
+	[ "/srv/btrfs", "/dev/loop0", "btrfs", "rw" ],
+	[ "/srv/btrfs/external", "/dev/loop1", "ext4", "rw" ],
+	);
+
+sub has_command
+{
+return $_[0] eq "btrfs" ? "/usr/bin/btrfs" : undef;
+}
+
+sub clean_language { }
+sub reset_environment { }
+sub is_readonly_mode { return 0; }
+sub system_logged { return 0; }
+sub unlink_file { return unlink($_[0]); }
+
+sub is_under_directory
+{
+my ($dir, $path) = @_;
+return 1 if ($dir eq "/");
+$dir =~ s/\/*$/\//;
+return $path eq substr($dir, 0, -1) || index($path, $dir) == 0;
+}
+
+sub next_response
+{
+my ($cmd) = @_;
+push(@commands, $cmd);
+my $response = shift(@responses) || { 'out' => "", 'status' => 0 };
+$? = $response->{'status'};
+return $response->{'out'};
+}
+
+sub backquote_command
+{
+return &next_response($_[0]);
+}
+
+sub backquote_logged
+{
+return &next_response($_[0]);
+}
+
+sub error
+{
+die join("", @_);
+}
+
+{
+package mount;
+sub list_mounted
+{
+return @main::mounted;
+}
+sub filesystem_for_dir
+{
+# Btrfs subvolumes can have a different st_dev from their containing mount,
+# which prevents filesystem_for_dir from finding the mount by device number.
+return @{$main::mounted[0]};
+}
+}
+
+do "$root/quota/linux-lib.pl" or die "linux-lib.pl: $@ $!";
+
+$main::config{'quotacheck_command'} = "quotacheck -ug";
+$main::config{'user_quotaon_command'} = "quotaon -u";
+$main::config{'group_quotaon_command'} = "quotaon -g";
+
+my $newquota = tempdir(CLEANUP => 1);
+@commands = ( );
+@responses = (
+	{ 'out' => "Quota utilities version 4.06.\n", 'status' => 0 },
+	{ 'out' => "", 'status' => 0 },
+	);
+is(main::quotacheck($newquota, 1), undef,
+   "new user quota file can be checked");
+like($commands[1], qr/quotacheck -u -F vfsv1 /,
+     "combined configured flags are replaced and new files prefer vfsv1");
+unlike($commands[1], qr/ -g(?: |$)/,
+       "user quota check does not also create group quotas");
+
+my $oldquota = tempdir(CLEANUP => 1);
+open(my $oldfh, '>', "$oldquota/aquota.user") or die $!;
+print {$oldfh} "existing\n";
+close($oldfh);
+@commands = ( );
+@responses = ({ 'out' => "", 'status' => 0 });
+is(main::quotacheck($oldquota, 1), undef,
+   "existing user quota file can be checked");
+is(scalar(@commands), 1,
+   "existing quota check does not probe the quota tools version");
+unlike($commands[0], qr/ -F /,
+       "existing quota file format is auto-detected");
+
+my $groupquota = tempdir(CLEANUP => 1);
+@commands = ( );
+@responses = (
+	{ 'out' => "Quota utilities version 4.06.\n", 'status' => 0 },
+	{ 'out' => "", 'status' => 0 },
+	);
+is(main::quotacheck($groupquota, 2), undef,
+   "new group quota file can be checked");
+like($commands[1], qr/quotacheck -g -F vfsv1 /,
+     "group-only creation also prefers vfsv1");
+
+my $legacyquota = tempdir(CLEANUP => 1);
+@commands = ( );
+@responses = (
+	{ 'out' => "Quota utilities version 3.17.\n", 'status' => 0 },
+	{ 'out' => "", 'status' => 0 },
+	);
+is(main::quotacheck($legacyquota, 1), undef,
+   "legacy quota tools can create quota files");
+unlike($commands[1], qr/ -F vfsv1 /,
+       "legacy quota tools retain their default format");
+
+my $fallbackquota = tempdir(CLEANUP => 1);
+@commands = ( );
+@responses = (
+	{ 'out' => "Quota utilities version 4.06.\n", 'status' => 0 },
+	{ 'out' => "failed\n", 'status' => 1 },
+	{ 'out' => "failed\n", 'status' => 1 },
+	{ 'out' => "", 'status' => 0 },
+	);
+is(main::quotacheck($fallbackquota, 1), undef,
+   "quota check falls back when vfsv1 creation fails");
+like($commands[3], qr/ -F vfsv0 /,
+     "vfsv0 is the first creation fallback");
+
+my $activatequota = tempdir(CLEANUP => 1);
+@commands = ( );
+@responses = (
+	{ 'out' => "Quota utilities version 4.06.\n", 'status' => 0 },
+	{ 'out' => "", 'status' => 0 },
+	{ 'out' => "", 'status' => 0 },
+	);
+is(main::quotaon($activatequota, 1), undef,
+   "new user quotas can be activated");
+like($commands[1], qr/quotacheck -u -F vfsv1 /,
+     "quota activation creates vfsv1 files");
+unlike($commands[1], qr/ -g(?: |$)/,
+       "user quota activation does not also create group quotas");
+
+my $legacyfile = tempdir(CLEANUP => 1);
+open(my $legacyfh, '>', "$legacyfile/quota.user") or die $!;
+print {$legacyfh} "existing legacy quotas\n";
+close($legacyfh);
+@commands = ( );
+@responses = (
+	{ 'out' => "Quota utilities version 4.06.\n", 'status' => 0 },
+	{ 'out' => "", 'status' => 0 },
+	);
+is(main::quotaon($legacyfile, 1), undef,
+   "legacy user quota files can be activated");
+like($commands[1], qr/^quotaon -u -F vfsold /,
+     "legacy user quota files are activated without conversion");
+ok(-s "$legacyfile/quota.user",
+   "legacy user quota files are preserved");
+
+my $legacygroup = tempdir(CLEANUP => 1);
+open(my $legacygfh, '>', "$legacygroup/quota.group") or die $!;
+print {$legacygfh} "existing legacy quotas\n";
+close($legacygfh);
+@commands = ( );
+@responses = (
+	{ 'out' => "Quota utilities version 4.06.\n", 'status' => 0 },
+	{ 'out' => "", 'status' => 0 },
+	);
+is(main::quotaon($legacygroup, 2), undef,
+   "legacy group quota files can be activated");
+like($commands[1], qr/^quotaon -g -F vfsold /,
+     "legacy group quota files are activated without conversion");
+ok(-s "$legacygroup/quota.group",
+   "legacy group quota files are preserved");
+
+my $mixedquota = tempdir(CLEANUP => 1);
+foreach my $file (qw(aquota.user quota.user aquota.group quota.group)) {
+	open(my $mixedfh, '>', "$mixedquota/$file") or die $!;
+	print {$mixedfh} "existing quotas\n";
+	close($mixedfh);
+	}
+@commands = ( );
+@responses = (
+	{ 'out' => "Quota utilities version 4.06.\n", 'status' => 0 },
+	{ 'out' => "", 'status' => 0 },
+	{ 'out' => "", 'status' => 0 },
+	);
+is(main::quotaon($mixedquota, 3), undef,
+   "modern quota files take precedence over stale legacy files");
+unlike(join("\n", @commands), qr/ -F vfsold /,
+       "stale legacy files do not override modern quota formats");
+
+# Device-less tmpfs quota options must not create unusable filesystem rows.
+is(main::quota_can([ "/tmp", "tmpfs", "tmpfs", "rw,usrquota" ], undef),
+   0, "tmpfs quota mount options are ignored");
+ok(main::is_btrfs_fs("/srv/btrfs"),
+   "Btrfs mount point is detected");
+ok(main::is_btrfs_fs("/srv/btrfs/domain1"),
+   "path inside Btrfs is detected");
+ok(!main::is_btrfs_fs("/srv/btrfs/external/file"),
+   "nested non-Btrfs mount takes precedence");
+ok(!main::is_btrfs_fs("/"),
+   "non-Btrfs path is rejected");
+ok(!defined(main::btrfs_quota_status("/")),
+   "quota status is unavailable for non-Btrfs paths");
+
+my $mountinfo = <<'EOF';
+24 1 0:20 / / rw,relatime - ext4 /dev/root rw
+31 24 0:42 /@home /home rw,relatime - btrfs /dev/vdb rw,compress=zstd
+32 31 0:42 /@home/example/homes/bob /srv/bob rw,relatime - btrfs /dev/vdb rw,compress=zstd
+EOF
+my ($mount, $fsroot) = main::parse_btrfs_mountinfo(
+	$mountinfo, "/home/example/homes/alice");
+is($mount, "/home", "containing Btrfs mount is selected");
+is($fsroot, '/@home', "mounted Btrfs filesystem root is returned");
+is(main::btrfs_qgroup_absolute_path(
+	$mount, $fsroot, '@home/example/homes/alice'),
+	"/home/example/homes/alice",
+	"qgroup path is translated through a mounted subvolume root");
+ok(!defined(main::btrfs_qgroup_absolute_path(
+	$mount, $fsroot, '@var/lib/mysql')),
+	"qgroups outside the mounted filesystem root are ignored");
+
+my $status_text = <<'EOF';
+Quotas on /srv/btrfs:
+  Enabled:                 yes
+  Mode:                    qgroup (full accounting)
+  Inconsistent:            no
+  Override limits:         no
+  Drop subtree threshold:  3
+  Total count:             4
+  Level 0:                 3
+  Level 1:                 1
+EOF
+my $status = main::parse_btrfs_quota_status($status_text);
+is_deeply($status, {
+	'enabled' => 1,
+	'mode' => 'qgroup',
+	'mode_description' => 'full accounting',
+	'inconsistent' => 0,
+	'override_limits' => 0,
+	'drop_subtree_threshold' => 3,
+	'total_count' => 4,
+	'levels' => { 0 => 3, 1 => 1 },
+	}, "full Btrfs quota status is parsed");
+
+my $simple_status = main::parse_btrfs_quota_status(<<'EOF');
+Quotas on /srv/btrfs:
+  Enabled:                 yes
+  Mode:                    squota (simple accounting)
+  Inconsistent:            yes
+EOF
+is($simple_status->{'mode'}, "squota", "simple quota mode is parsed");
+ok($simple_status->{'inconsistent'}, "inconsistent status is parsed");
+is_deeply(main::parse_btrfs_quota_status("  Enabled: no\n"),
+	  { 'enabled' => 0 }, "disabled status is parsed");
+ok(!defined(main::parse_btrfs_quota_status("invalid output\n")),
+   "invalid status output is rejected");
+
+@commands = ( );
+@responses = ({ 'out' => $status_text, 'status' => 0 });
+$status = main::btrfs_quota_status("/srv/btrfs");
+ok($status->{'supported'} && $status->{'enabled'},
+   "status command reports enabled quotas");
+is(scalar(@commands), 1, "successful status does not run fallback");
+
+@responses = (
+	{ 'out' => "ERROR: unknown token 'status'\n", 'status' => 1 },
+	{ 'out' => "qgroupid rfer excl\n0/5 16384 16384\n", 'status' => 0 },
+	);
+$status = main::btrfs_quota_status("/srv/btrfs");
+ok($status->{'enabled'}, "legacy qgroup fallback detects enabled quotas");
+
+my $sysfs = tempdir(CLEANUP => 1);
+my $fsuuid = "12345678-1234-1234-1234-123456789abc";
+make_path("$sysfs/$fsuuid/qgroups");
+foreach my $pair ([ 'enabled', 1 ], [ 'mode', 'squota' ],
+		  [ 'inconsistent', 1 ]) {
+	open(my $fh, '>', "$sysfs/$fsuuid/qgroups/$pair->[0]") or die $!;
+	print {$fh} "$pair->[1]\n";
+	close($fh);
+	}
+local $main::btrfs_sysfs_root = $sysfs;
+@responses = (
+	{ 'out' => "ERROR: unknown token 'status'\n", 'status' => 1 },
+	{ 'out' => "qgroupid rfer excl\n0/5 16384 16384\n", 'status' => 0 },
+	{ 'out' => "Label: none  uuid: $fsuuid\n", 'status' => 0 },
+	);
+$status = main::btrfs_quota_status("/srv/btrfs");
+is($status->{'mode'}, 'squota',
+   "legacy fallback reads simple-quota mode from sysfs");
+ok($status->{'inconsistent'},
+   "legacy fallback reads inconsistent accounting from sysfs");
+
+@responses = (
+	{ 'out' => "ERROR: unknown token 'status'\n", 'status' => 1 },
+	{ 'out' => "ERROR: quota root does not exist\n", 'status' => 1 },
+	);
+$status = main::btrfs_quota_status("/srv/btrfs");
+is($status->{'enabled'}, 0, "legacy fallback detects disabled quotas");
+
+my $qgroup_text = <<'EOF';
+Qgroupid    Referenced    Exclusive  Max referenced  Max exclusive Parent   Child         Path
+--------    ----------    ---------  --------------  ------------- ------   -----         ----
+0/5              16384        16384            none           none ---      ---           <toplevel>
+0/256            16384        16384        67108864           none 1/100    -             domain1
+0/257                0            0            none       33554432 1/100    -             domain two
+1/100            16384        16384       100663296           none -        0/256,0/257   <0 member qgroups>
+EOF
+my $qgroups = main::parse_btrfs_qgroup_output($qgroup_text);
+is(scalar(@$qgroups), 4, "all qgroups are parsed");
+is_deeply($qgroups->[0]->{'parents'}, [ ],
+	  "legacy empty parent marker is parsed");
+is_deeply($qgroups->[0]->{'children'}, [ ],
+	  "legacy empty child marker is parsed");
+is($qgroups->[1]->{'max_referenced'}, 67108864,
+   "referenced limit is parsed as bytes");
+ok(!defined($qgroups->[1]->{'max_exclusive'}),
+   "missing exclusive limit is undef");
+is_deeply($qgroups->[1]->{'parents'}, [ "1/100" ],
+          "parent qgroup is parsed");
+is($qgroups->[2]->{'path'}, "domain two",
+   "subvolume paths containing spaces are preserved");
+is_deeply($qgroups->[3]->{'children'}, [ "0/256", "0/257" ],
+          "multiple child qgroups are parsed");
+
+@commands = ( );
+@responses = ({ 'out' => $qgroup_text, 'status' => 0 });
+my $list_error;
+$qgroups = main::list_btrfs_qgroups("/srv/btrfs", 1, \$list_error);
+is(scalar(@$qgroups), 4, "qgroup list command output is returned");
+ok(!defined($list_error), "successful qgroup list clears the error");
+like($commands[0], qr/qgroup show .*\\-\\-sync .*srv.*btrfs/,
+     "synchronized qgroup listing requests --sync");
+
+my $legacy_qgroup_text = <<'EOF';
+Qgroupid Referenced Exclusive Max_referenced Max_exclusive Parent Child
+0/256 16384 16384 67108864 none 1/100 -
+0/257 0 0 none 33554432 1/100 -
+1/100 16384 16384 100663296 none - 0/256,0/257
+EOF
+@commands = ( );
+@responses = (
+	{ 'out' => $legacy_qgroup_text, 'status' => 0 },
+	{ 'out' => "ID 256 gen 10 top level 5 path domain1\n".
+		   "ID 257 gen 11 top level 5 path domain path two\n",
+	  'status' => 0 },
+	);
+$qgroups = main::list_btrfs_qgroups("/srv/btrfs", 0, \$list_error);
+is($qgroups->[0]->{'path'}, "domain1",
+   "legacy qgroup rows gain paths from the subvolume list");
+is($qgroups->[1]->{'path'}, "domain path two",
+   "legacy subvolume paths containing spaces and path are preserved");
+like($commands[1], qr/subvolume list .*srv.*btrfs/,
+     "legacy qgroup output triggers one compatibility lookup");
+
+@responses = ({ 'out' => "ERROR: quotas not enabled\n", 'status' => 1 });
+$qgroups = main::list_btrfs_qgroups("/srv/btrfs", 0, \$list_error);
+ok(!defined($qgroups), "failed qgroup listing returns undef");
+like($list_error, qr/quotas not enabled/,
+     "failed qgroup listing returns the command error");
+@responses = ({ 'out' => "unexpected output\n", 'status' => 0 });
+$qgroups = main::list_btrfs_qgroups("/srv/btrfs", 0, \$list_error);
+ok(!defined($qgroups), "unparseable qgroup listing returns undef");
+is($list_error, "Unable to parse Btrfs qgroup output",
+   "unparseable qgroup output is reported");
+
+@responses = ({
+	'out' => "domain1\n\tSubvolume ID:\t\t256\n",
+	'status' => 0,
+	});
+is(main::btrfs_subvolume_id("/srv/btrfs/domain1"), 256,
+   "subvolume ID is parsed");
+
+@responses = (
+	{ 'out' => "domain1\n\tSubvolume ID:\t\t256\n", 'status' => 0 },
+	{ 'out' => $qgroup_text, 'status' => 0 },
+	);
+my $qgroup = main::get_btrfs_qgroup("/srv/btrfs/domain1", 0);
+is($qgroup->{'id'}, "0/256", "subvolume qgroup is selected by ID");
+
+@commands = ( );
+@responses = map { { 'out' => "", 'status' => 0 } } 1 .. 9;
+is(main::enable_btrfs_quotas("/srv/btrfs", 1), undef,
+   "simple quotas can be enabled");
+is(main::set_btrfs_qgroup_limit("/srv/btrfs", "1/100", 1048576, 0),
+   undef, "referenced qgroup limit can be set");
+is(main::set_btrfs_qgroup_limit("/srv/btrfs/domain1", undef, undef, 1),
+   undef, "exclusive subvolume limit can be removed");
+is(main::create_btrfs_qgroup("/srv/btrfs", "1/101"), undef,
+   "parent qgroup can be created");
+is(main::assign_btrfs_qgroup("/srv/btrfs", "0/256", "1/101"), undef,
+   "child qgroup can be assigned");
+is(main::unassign_btrfs_qgroup("/srv/btrfs", "0/256", "1/101"), undef,
+   "child qgroup can be unassigned");
+is(main::delete_btrfs_qgroup("/srv/btrfs", "1/101"), undef,
+   "parent qgroup can be deleted");
+is(main::rescan_btrfs_quotas("/srv/btrfs", 1), undef,
+   "quota rescan can run and wait");
+is(main::disable_btrfs_quotas("/srv/btrfs"), undef,
+   "Btrfs quotas can be disabled");
+like($commands[0], qr/quota enable .*\\-\\-simple/,
+     "simple enable command uses supported long option");
+like($commands[1], qr/qgroup limit .*1048576 .*1\\\/100/,
+     "referenced limit command contains size and qgroup");
+like($commands[2], qr/qgroup limit .*\-e .*none/,
+     "exclusive limit removal uses -e and none");
+like($commands[7], qr/quota rescan .*\\-w/,
+     "quota rescan uses the portable short wait option");
+
+is(main::set_btrfs_qgroup_limit("/srv/btrfs", "bad", 1024),
+   "Invalid Btrfs qgroup ID", "invalid qgroup IDs are rejected");
+is(main::disable_btrfs_quotas("relative/path"),
+   "Invalid Btrfs path", "relative paths are rejected");
+is(main::disable_btrfs_quotas("/srv/btrfs\n/etc"),
+   "Invalid Btrfs path", "paths with control characters are rejected");
+ok(!main::is_btrfs_fs("/srv/btrfs\n/etc"),
+   "paths with control characters are not detected as Btrfs");
+is(main::set_btrfs_qgroup_limit("/srv/btrfs", "1/100", "1M"),
+   "Invalid Btrfs qgroup limit", "non-byte limits are rejected");
+is(main::assign_btrfs_qgroup("/srv/btrfs", "bad", "1/100"),
+   "Invalid child Btrfs qgroup ID", "invalid child assignment is rejected");
+
+@commands = ( );
+@responses = ({ 'out' => "ERROR: unable to limit requested quota group: ".
+			 "Disk quota exceeded\n", 'status' => 1 });
+like(main::set_btrfs_qgroup_limit("/srv/btrfs", "1/100", 2097152),
+     qr/Disk quota exceeded/, "qgroup limit errors are returned without retry");
+is(scalar(@commands), 1, "a failed qgroup limit command is not retried");
+
+@responses = ({ 'out' => "ERROR: qgroup exists\n", 'status' => 1 });
+is(main::create_btrfs_qgroup("/srv/btrfs", "1/100"),
+   "ERROR: qgroup exists", "Btrfs command errors are returned to callers");
+
+done_testing();

samba/edit_manual.cgi

@@ -3,6 +3,7 @@
 
 require './samba-lib.pl';
 &ReadParse();
+$access{'manual'} || &error($text{'manual_ecannot'});
 &ui_print_header(undef, $text{'manual_title'}, "");
 
 # Show the file contents

samba/lang/en

@@ -665,4 +665,7 @@ manual_edata=Nothing entered!
 
 delete_err=Failed to delete shares
 delete_enone=None selected
+
+manual_ecannot=You are not allowed to manually edit the config file
+
 __norefs=1

samba/save_manual.cgi

@@ -3,6 +3,7 @@
 
 require './samba-lib.pl';
 &ReadParseMime();
+$access{'manual'} || &error($text{'manual_ecannot'});
 &error_setup($text{'manual_err'});
 
 $in{'data'} =~ s/\r//g;

sendmail/delete_domains.cgi

@@ -5,6 +5,7 @@ require './sendmail-lib.pl';
 require './domain-lib.pl';
 &ReadParse();
 &error_setup($text{'ddelete_err'});
+$access{'domains'} || &error($text{'domains_ecannot'});
 $conf = &get_sendmailcf();
 $vfile = &domains_file($conf);
 ($vdbm, $vdbmtype) = &domains_dbm($conf);

sendmail/delete_mailers.cgi

@@ -5,6 +5,7 @@ require './sendmail-lib.pl';
 require './mailers-lib.pl';
 &ReadParse();
 &error_setup($text{'mdelete_err'});
+$access{'mailers'} || &error($text{'mailers_cannot'});
 $conf = &get_sendmailcf();
 $vfile = &mailers_file($conf);
 ($vdbm, $vdbmtype) = &mailers_dbm($conf);

session_login.cgi

@@ -4,6 +4,7 @@
 
 BEGIN { push(@INC, "."); };
 use WebminCore;
+require './login-lib.pl';
 
 $pragma_no_cache = 1;
 #$ENV{'MINISERV_INTERNAL'} || die "Can only be called by miniserv.pl";
@@ -93,17 +94,7 @@ print "$text{'session_prefix'}\n";
 print &ui_form_start("@{[&get_webprefix()]}/session_login.cgi", "post");
 print &ui_hidden("page", $in{'page'});
 
-my $not_secure;
-if ($ENV{'HTTPS'} ne 'ON' && $miniserv{'ssl'}) {
-	my $link = ui_tag('a', "⚠ $text{'login_notsecure'}",
-		{ 'href' => "javascript:void(0);",
-		  'class' => 'inherit-color',
-		  'onclick' => "window.location.href = ".
-		    "window.location.href.replace(/^http:/, 'https:'); return false;",
-		});
-	$not_secure = ui_tag('span', $link,
-		{ class => 'not-secure', title => $text{'login_notsecure_desc'} });
-	}
+my $not_secure = &get_login_http_warning(\%miniserv);
 
 print &ui_table_start($text{'session_header'} . $not_secure,
 		      "width=40% class='loginform'", 2);

setup.pl

@@ -66,7 +66,7 @@ if ($ENV{'perllib'}) {
 # Validate source directory
 @allmods = map { s/\/module.info$//; $_ } glob("*/module.info");
 if (!@allmods) {
-	&errorexit("ERROR: Failed to get module list");
+	&errorexit("Failed to get module list");
 	}
 $allmods = join(" ", @allmods);
 print "\n";
@@ -341,6 +341,7 @@ else {
 	# Ask the user if SSL should be used
 	if ($ENV{'ssl'} ne '') {
 		$ssl = $ENV{'ssl'};
+		$no_ssl_warn = 1 if (!$ssl);
 		}
 	else {
 		$ssl = 0;
@@ -351,6 +352,9 @@ else {
 			if ($sslyn =~ /^y/i) {
 				$ssl = 1;
 				}
+			else {
+				$no_ssl_warn = 1;
+				}
 			}
 		else {
 			print "The Perl SSLeay library is not installed. SSL not available.\n"
@@ -431,6 +435,7 @@ else {
 	if ($ENV{'allow'}) {
 		$miniserv{'allow'} = $ENV{'allow'};
 		}
+	$miniserv{'no_ssl_warn'} = 1 if ($no_ssl_warn);
 	if ($ENV{'session'} eq '') {
 		$miniserv{'session'} = $os_type eq 'windows' ? 0 : 1;
 		}
@@ -488,7 +493,8 @@ else {
 	chmod(0600, $ufile);
 
 	# Generate cert
-	if (system("openssl version >/dev/null 2>&1") == 0) {
+	$openssl_available = system("openssl version >/dev/null 2>&1") == 0;
+	if ($openssl_available) {
 		# We can generate a new SSL key for this host
 		$host = &get_system_hostname();
 		$cert = &tempname();
@@ -519,11 +525,27 @@ else {
 			}
 		unlink($cert, $key);
 		}
-	if (!-r $kfile) {
-		# Fall back to the built-in key
-		&copy_source_dest("$wadir/miniserv.pem", $kfile);
+	if (-r $kfile) {
+		chmod(0600, $kfile);
+		}
+	else {
+		delete($miniserv{'keyfile'});
+		if ($ssl) {
+			print "\n";
+			if ($openssl_available) {
+				print "ERROR: Failed to generate or install a unique TLS certificate for this host.\n";
+				}
+			else {
+				print "ERROR: OpenSSL is not available, so a unique TLS certificate could not be generated.\n";
+				}
+			print "WARNING: Webmin will be configured to use HTTP only.\n";
+			print "Login credentials and sessions will not be encrypted until SSL is enabled\n";
+			print "with a valid certificate. See https://webmin.com/docs/modules/webmin-configuration/#ssl-encryption for help.\n\n";
+			$ssl = 0;
+			$miniserv{'ssl'} = 0;
+			}
+		&put_miniserv_config(\%miniserv);
 		}
-	chmod(0600, $kfile);
 	print ".. done\n";
 	print "\n";
 

setup.sh

@@ -458,6 +458,9 @@ else
 	fi
 
 	# Ask the user if SSL should be used
+	if [ "$ssl" = "0" ]; then
+		no_ssl_warn=1
+	fi
 	if [ "$ssl" = "" ]; then
 		ssl=0
 		$perl -e 'use Net::SSLeay' >/dev/null 2>/dev/null
@@ -466,6 +469,8 @@ else
 			read sslyn
 			if [ "$sslyn" = "y" -o "$sslyn" = "Y" ]; then
 				ssl=1
+			else
+				no_ssl_warn=1
 			fi
 		else
 			echo "The Perl SSLeay library is not installed. SSL not available."
@@ -528,6 +533,9 @@ else
 	echo "pidfile=$var_dir/miniserv.pid" >> $cfile
 	echo "logtime=168" >> $cfile
 	echo "ssl=$ssl" >> $cfile
+	if [ "$no_ssl_warn" = "1" ]; then
+		echo "no_ssl_warn=1" >> $cfile
+	fi
 	echo "no_ssl2=1" >> $cfile
 	echo "no_ssl3=1" >> $cfile
 	openssl version 2>&1 | grep "OpenSSL 1" >/dev/null
@@ -598,8 +606,10 @@ else
 	echo "userfile=$ufile" >> $cfile
 
 	kfile=$config_dir/miniserv.pem
+	openssl_available=0
 	openssl version >/dev/null 2>&1
 	if [ "$?" = "0" ]; then
+		openssl_available=1
 		# OpenSSL support `-addext` flag?
 		addtextsup="-addext subjectAltName=DNS:$host,DNS:localhost -addext extendedKeyUsage=serverAuth"
 		openssl version 2>&1 | grep "OpenSSL 1.0" >/dev/null
@@ -621,12 +631,28 @@ EOF
 		fi
 		rm -f $tempdir/cert $tempdir/key
 	fi
-	if [ ! -r $kfile ]; then
-		# Fall back to the built-in key
-		cp "$wadir/miniserv.pem" $kfile
+	if [ -r "$kfile" ]; then
+		chmod 600 "$kfile"
+		echo "keyfile=$config_dir/miniserv.pem" >> $cfile
+	elif [ "$ssl" = "1" ]; then
+		echo ""
+		if [ "$openssl_available" = "1" ]; then
+			echo "ERROR: Failed to generate or install a unique TLS certificate for this host."
+		else
+			echo "ERROR: OpenSSL is not available, so a unique TLS certificate could not be generated."
+		fi
+		echo "WARNING: Webmin will be configured to use HTTP only."
+		echo "Login credentials and sessions will not be encrypted until SSL is enabled"
+		echo "with a valid certificate. See https://webmin.com/docs/modules/webmin-configuration/#ssl-encryption for help."
+		echo ""
+		ssl=0
+		new_cfile=$tempdir/$$.miniserv.conf
+		if ! sed 's/^ssl=.*/ssl=0/' "$cfile" >"$new_cfile" ||
+		   ! mv "$new_cfile" "$cfile"; then
+			echo "ERROR: Failed to switch Webmin to HTTP-only mode."
+			exit 1
+		fi
 	fi
-	chmod 600 $kfile
-	echo "keyfile=$config_dir/miniserv.pem" >> $cfile
 
 	chmod 600 $cfile
 	echo ".. done"
@@ -980,9 +1006,11 @@ for m in $newmods; do
 done
 # Make miniserv config files non-world-readable
 for f in miniserv.conf miniserv.pem miniserv.users; do
-	chown -R root $config_dir/$f
-	chgrp -R bin $config_dir/$f
-	chmod -R og-rw $config_dir/$f
+	if [ -e "$config_dir/$f" ]; then
+		chown -R root $config_dir/$f
+		chgrp -R bin $config_dir/$f
+		chmod -R og-rw $config_dir/$f
+	fi
 done
 chmod +r $config_dir/version
 if [ "$nochown" = "" ]; then

shorewall/check.cgi

@@ -2,21 +2,26 @@
 # check.cgi
 # Check if the firewall is valid
 
+use strict;
+use warnings;
+our (%text, %config);
 require './shorewall-lib.pl';
 &ui_print_header(undef, $text{'check_title'}, "");
+
 print "<b>$text{'check_cmd'}</b><br>\n";
-print "<font size=-1><pre>";
+print "<pre>";
 open(STATUS, "$config{'shorewall'} check 2>&1 |");
 while(<STATUS>) {
 	print &html_escape($_);
 	}
 close(STATUS);
-print "</pre></font>\n";
+print "</pre>\n";
 if ($?) {
 	print "<b>$text{'check_failed'}</b><p>\n";
 	}
 else {
 	print "<b>$text{'check_ok'}</b><p>\n";
 	}
+
 &ui_print_footer("", $text{'index_return'});
 

shorewall/clear.cgi

@@ -2,14 +2,18 @@
 # clear.cgi
 # Clear out all rules
 
+use strict;
+use warnings;
+our (%config, %text, %access);
 require './shorewall-lib.pl';
+
 if ($access{'nochange'}) {
   &redirect("/");
   exit 0;
 }
 
 &error_setup($text{'clear_err'});
-$out = &backquote_logged("$config{'shorewall'} clear 2>&1");
+my $out = &backquote_logged("$config{'shorewall'} clear 2>&1");
 if ($?) {
 	&error("<pre>$out</pre>");
 	}

shorewall/delete.cgi

@@ -1,16 +1,19 @@
 #!/usr/bin/perl
 # Delete a bunch of table rows
 
+use strict;
+use warnings;
+our (%in, %text);
 require './shorewall-lib.pl';
 &ReadParse();
 &can_access($in{'table'}) || &error($text{'list_ecannot'});
-$pfunc = &get_parser_func(\%in);
+my $pfunc = &get_parser_func(\%in);
 &error_setup($text{'delete_err'});
-@d = split(/\0/, $in{'d'});
+my @d = split(/\0/, $in{'d'});
 scalar(@d) || &error($text{'delete_enone'});
 
 &lock_table($in{'table'});
-foreach $idx (sort { $b <=> $a } @d) {
+foreach my $idx (sort { $b <=> $a } @d) {
 	&delete_table_row($in{'table'}, $pfunc, $idx);
 	}
 &unlock_table($in{'table'});

shorewall/dump.cgi

@@ -4,12 +4,14 @@
 
 require './shorewall-lib.pl';
 &ui_print_header(undef, $text{'dump_title'}, "");
-print "<font size=-1><pre>";
+
+print "<pre>";
 open(DUMP, "$config{'shorewall'} dump 2>&1 |");
 while(<DUMP>) {
 	print &html_escape($_);
 	}
 close(DUMP);
-print "</pre></font>\n";
+print "</pre>\n";
+
 &ui_print_footer("", $text{'index_return'});