From b050127ded8e861b22b7aa976f28f198ad51afc2 Mon Sep 17 00:00:00 2001 From: Mike Steinmetz Date: Thu, 16 Jul 2026 15:01:51 +0200 Subject: [PATCH 01/24] MM-12032 Fix bond/VLAN/bridge not removed from active list on delete delete_bifcs.cgi and save_bifc.cgi only called deactivate_interface() which brings the link down but never removes the virtual device. Added destroy_interface_device() that does ip link delete for these. Also had to add bridge creation (ip link add type bridge) because unlike bond (81d44f8) and VLAN (7761066) that was still missing. Other fixes in this commit: debian-linux-lib.pl: bonding opts were single-element arrays causing trailing spaces in /etc/network/interfaces on every save. linux-lib.pl: ip link set up/down was gated behind a bond/vlan/no-ifconfig check but ip addr add runs unconditionally - so interfaces got an IP but stayed DOWN. Dropped the unnecessary guard. --- net/debian-linux-lib.pl | 12 +++--- net/delete_bifcs.cgi | 4 ++ net/linux-lib.pl | 33 ++++++++++++++-- net/save_bifc.cgi | 4 ++ net/t/run-tests.t | 85 +++++++++++++++++++++++++++++++++++++++++ 5 files changed, 129 insertions(+), 9 deletions(-) diff --git a/net/debian-linux-lib.pl b/net/debian-linux-lib.pl index f488d033f..63dda1904 100755 --- a/net/debian-linux-lib.pl +++ b/net/debian-linux-lib.pl @@ -230,12 +230,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'}." ". diff --git a/net/delete_bifcs.cgi b/net/delete_bifcs.cgi index bd60b7d65..a8598d7f1 100755 --- a/net/delete_bifcs.cgi +++ b/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 diff --git a/net/linux-lib.pl b/net/linux-lib.pl index 54cb43877..33e9fbb27 100755 --- a/net/linux-lib.pl +++ b/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"; @@ -595,6 +608,20 @@ 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) = @_; +if (&has_command("ip") && $a->{'virtual'} eq '' && + (&use_ifup_command($a) || $a->{'bridge'})) { + &backquote_logged("ip link delete ". + quotemeta($a->{'fullname'} || $a->{'name'})." 2>&1"); + } +} + # 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. diff --git a/net/save_bifc.cgi b/net/save_bifc.cgi index ae2fc7fa4..2b130dcb0 100755 --- a/net/save_bifc.cgi +++ b/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); + } } } diff --git a/net/t/run-tests.t b/net/t/run-tests.t index d0c6f4ae4..8aeb2f6ac 100644 --- a/net/t/run-tests.t +++ b/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(); From 466f499e65a9f2349c6cc3f4927b54b2f21f87fa Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Mon, 3 Aug 2026 02:36:05 +0200 Subject: [PATCH 02/24] Fix openSUSE logrotate vendor overlay handling This PR updates the Log File Rotation module for openSUSE Leap 16's split `/usr/etc` and `/etc` configuration model. - Select the local main configuration when present, otherwise use the vendor configuration. - Recursively merge vendor and local drop-ins using the same precedence as `logrotate-all`. - Display vendor configurations while keeping `/usr/etc` read-only. - Copy vendor files into matching `/etc` overrides before editing or deleting them. - Preserve empty overrides so deleted vendor rotations remain disabled. - Use the openSUSE wrapper for scheduled rotation and the effective configuration set for forced rotation. - Keep behavior unchanged on distributions that do not enable the vendor overlay. Includes regression coverage for selection, precedence, copy-on-write, deletion, scheduling, backups, and protection against direct vendor writes. Closes [#2682](https://github.com/webmin/webmin/issues/2682). --- logrotate/backup_config.pl | 14 +- logrotate/config-openSUSE-Linux-16.0-ALL | 3 + logrotate/delete_logs.cgi | 13 ++ logrotate/edit_log.cgi | 17 ++ logrotate/edit_sched.cgi | 8 +- logrotate/force.cgi | 8 +- logrotate/index.cgi | 19 +- logrotate/install_check.pl | 4 +- logrotate/lang/en | 8 + logrotate/logrotate-lib.pl | 246 ++++++++++++++++++++++- logrotate/save_log.cgi | 14 ++ logrotate/save_sched.cgi | 5 +- logrotate/t/run-tests.t | 220 +++++++++++++++++--- 13 files changed, 527 insertions(+), 52 deletions(-) diff --git a/logrotate/backup_config.pl b/logrotate/backup_config.pl index 9a8c1be45..d25f2f837 100755 --- a/logrotate/backup_config.pl +++ b/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) diff --git a/logrotate/config-openSUSE-Linux-16.0-ALL b/logrotate/config-openSUSE-Linux-16.0-ALL index 6ddca8e5c..af724fb7f 100644 --- a/logrotate/config-openSUSE-Linux-16.0-ALL +++ b/logrotate/config-openSUSE-Linux-16.0-ALL @@ -1,5 +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 diff --git a/logrotate/delete_logs.cgi b/logrotate/delete_logs.cgi index ea0af75f2..bf6477aaf 100755 --- a/logrotate/delete_logs.cgi +++ b/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'}); diff --git a/logrotate/edit_log.cgi b/logrotate/edit_log.cgi index 5124ec254..6ef61531d 100755 --- a/logrotate/edit_log.cgi +++ b/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', + "".&html_escape($config{'logrotate_conf'}).""), + 'info'); + } +elsif ($log && &is_vendor_config_file($log->{'file'})) { + print &ui_alert_box(&text('edit_vendor', + "".&html_escape(&get_local_override_file( + $log->{'file'})).""), 'info'); + } +elsif ($log && (my $vendor = &get_vendor_config_file($log->{'file'}))) { + print &ui_alert_box(&text('edit_override', + "".&html_escape($vendor).""), '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"; diff --git a/logrotate/edit_sched.cgi b/logrotate/edit_sched.cgi index 97bfb8d02..61d64d9dd 100755 --- a/logrotate/edit_sched.cgi +++ b/logrotate/edit_sched.cgi @@ -5,7 +5,13 @@ require './logrotate-lib.pl'; &ui_print_header(undef, $text{'sched_title'}, ""); -print "

",&text('sched_desc', "$config{'logrotate'}"),"

\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 "

",&text('sched_desc', "". + &html_escape($sched_command).""),"

\n"; # Find the job, looking in daily directories too &foreign_require("cron", "cron-lib.pl"); diff --git a/logrotate/force.cgi b/logrotate/force.cgi index 0a8bbf2d1..c1fde6870 100755 --- a/logrotate/force.cgi +++ b/logrotate/force.cgi @@ -10,8 +10,12 @@ $SIG{'TERM'} = 'IGNORE'; print $text{'force_doing'},"\n"; &clean_environment(); -my (undef, undef, $files) = &get_config($config{'logrotate_conf'}); -my @configs = ($config{'logrotate_conf'}, &get_add_file_configs($files)); + +# 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 { "e_path($_) } @configs); $out = &backquote_logged("$config{'logrotate'} -f $configs 2>&1"); &reset_environment(); diff --git a/logrotate/index.cgi b/logrotate/index.cgi index 7ee559eb6..802205c62 100755 --- a/logrotate/index.cgi +++ b/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', - [ "$config{'logrotate_conf'}", undef ])); + [ "$main_config", 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/
\n/g; + local $label = join(" ", map { "$_
" } + @{$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 .= "$text{'index_vendor'}"; + } + elsif (&get_vendor_config_file($c->{'file'})) { + $label .= "$text{'index_override'}"; + } push(@table, [ &ui_link("edit_log.cgi?idx=".$c->{'index'}, - join(" ", map { "$_
" } - @{$c->{'name'}}) ), + $label), $text{'period_'.$p} || "$text{'index_notset'}", $r ? "$r" diff --git a/logrotate/install_check.pl b/logrotate/install_check.pl index 60a66a796..0d5ca01c0 100755 --- a/logrotate/install_check.pl +++ b/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; } diff --git a/logrotate/lang/en b/logrotate/lang/en index 8d57c99be..9cc0c7d95 100644 --- a/logrotate/lang/en +++ b/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 /usr/etc 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 /usr/etc 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 diff --git a/logrotate/logrotate-lib.pl b/logrotate/logrotate-lib.pl index 38a09fa23..f1a2d1c60 100755 --- a/logrotate/logrotate-lib.pl +++ b/logrotate/logrotate-lib.pl @@ -15,10 +15,15 @@ if (!-r $config{'logrotate_conf'} && -r $config{'sample_conf'}) { ©_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,28 +33,228 @@ 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 regular destination is already a usable override. Refuse a +# destination symlink or other file type so it cannot redirect this write. +if (-e $dest || -l $dest) { + if (-f $dest && !-l $dest) { + &flush_logrotate_config_cache(); + return $dest; + } + &error(&text('save_eoverride', "". + &html_escape($dest)."")); + } + +# 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) = ©_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', "".&html_escape($dest)."", + &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 ©_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 ©_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 configs loaded externally from the add-file directory +# Returns the effective vendor and local configs loaded by logrotate-all sub get_add_file_configs { my ($files) = @_; -return ( ) if (!$config{'scan_add_file'} || !$config{'add_file'} || - !-d $config{'add_file'}); +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 $f (glob("$config{'add_file'}/*")) { - next if (!-f $f || $files && +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 "e_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 "e_path($program).' '. + join(' ', map { "e_path($_) } @configs); +} + # get_config([file]) # Returns a list of logrotate config file entries sub get_config { my ($argfile) = @_; -my $file = $argfile || $config{'logrotate_conf'}; +my $file = $argfile || &get_main_config_file(); if (!$argfile && $get_config_cache{$file}) { return wantarray ? ( $get_config_cache{$file}, $get_config_lnum_cache{$file}, @@ -230,10 +435,33 @@ sub save_directive my ($parent, $oldv, $newv, $indent) = @_; my $conf = $parent->{'members'}; my $old = !defined($oldv) ? undef : ref($oldv) ? $oldv : &find($oldv, $conf); -my $lref = &read_file_lines($old ? $old->{'file'} : $parent->{'file'}); my $new = !defined($newv) ? undef : ref($newv) ? $newv : { 'name' => $old ? $old->{'name'} : $oldv, 'value' => $newv }; + +# Refuse direct vendor writes even if a caller forgets to materialize the +# local copy first. New log sections may still be written to their explicit +# local file while the global defaults continue to come from the vendor file. +my $vendor_file; +if ($old) { + my $shadowed_vendor = &get_vendor_config_file($old->{'file'}); + if (&is_vendor_main_config($old->{'file'}) || + &is_vendor_config_file($old->{'file'})) { + $vendor_file = $old->{'file'}; + } + elsif ($shadowed_vendor && + &same_file($old->{'file'}, $shadowed_vendor)) { + $vendor_file = $shadowed_vendor; + } + } +elsif (!$old && $new && !$new->{'members'} && $parent->{'global'} && + &is_vendor_main_config(&get_main_config_file())) { + $vendor_file = &get_main_config_file(); + } +&error(&text('save_evendorwrite', + "".&html_escape($vendor_file)."")) if ($vendor_file); + +my $lref = &read_file_lines($old ? $old->{'file'} : $parent->{'file'}); my @lines = &directive_lines($new, $indent) if ($new); my $gparent = &get_config_parent(); if ($old && $new) { @@ -337,10 +565,12 @@ return @rv; } # delete_if_empty(file) -# Remove a file if it has no more lines in the config +# 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 { 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}); diff --git a/logrotate/save_log.cgi b/logrotate/save_log.cgi index ad3a194b9..f3691bdee 100755 --- a/logrotate/save_log.cgi +++ b/logrotate/save_log.cgi @@ -4,8 +4,22 @@ require './logrotate-lib.pl'; &ReadParse(); + +# 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'}; + +# 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'}; + } @files = split(/\s+/, $in{'file'}); if ($in{'global'}) { # Editing the global options diff --git a/logrotate/save_sched.cgi b/logrotate/save_sched.cgi index 23a6b027f..c1688eed5 100755 --- a/logrotate/save_sched.cgi +++ b/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)); diff --git a/logrotate/t/run-tests.t b/logrotate/t/run-tests.t index e5efba992..11b0bcc2d 100644 --- a/logrotate/t/run-tests.t +++ b/logrotate/t/run-tests.t @@ -7,15 +7,23 @@ use File::Basename qw(dirname); use File::Path qw(make_path); use File::Temp qw(tempdir); +# Build an isolated openSUSE-style /etc and /usr/etc configuration layout. my $module_dir = abs_path(dirname(abs_path($0))."/.."); my $root_dir = abs_path("$module_dir/.."); my $config_dir = tempdir(CLEANUP => 1); my $var_dir = tempdir(CLEANUP => 1); my $fixture_dir = tempdir(CLEANUP => 1); -my $add_dir = "$fixture_dir/logrotate.d"; -my $main_file = "$fixture_dir/logrotate.conf"; -make_path("$config_dir/logrotate", $add_dir); +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)); +# write_text(file, contents) +# Writes a text fixture and fails the test immediately on an I/O error sub write_text { my ($file, $text) = @_; @@ -24,17 +32,48 @@ print $fh $text; close($fh) or die "close $file: $!"; } +# read_text(file) +# Returns the complete contents of a text fixture +sub read_text +{ +my ($file) = @_; +open(my $fh, "<", $file) or die "open $file: $!"; +local $/; +my $text = <$fh>; +close($fh) or die "close $file: $!"; +return $text; +} + +# 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=$main_file\n". - "add_file=$add_dir\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=logrotate\n"); -write_text($main_file, "weekly\n/var/log/main.log {\n\trotate 4\n}\n"); -write_text("$add_dir/one", "/var/log/one.log {\n\tdaily\n}\n"); -write_text("$add_dir/two", "/var/log/two.log {\n\tmonthly\n}\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'; @@ -42,6 +81,8 @@ $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'; @@ -51,6 +92,8 @@ no warnings 'once'; $main::get_config_parent_cache = undef; } +# log_names(config) +# Returns only the log path names from parsed rotation sections sub log_names { my ($config) = @_; @@ -58,40 +101,153 @@ 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/main.log', '/var/log/one.log', '/var/log/two.log' ], - 'opt-in scan loads sections from add_file directory'); + [ '/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 ], 'scanned sections keep stable top-level indexes'); -is_deeply($files, - [ $main_file, "$add_dir/one", "$add_dir/two" ], - 'file cache contains the primary and scanned configuration files'); -my (undef, undef, $primary_files) = main::get_config($main_file); -is_deeply([ main::get_add_file_configs($primary_files) ], - [ "$add_dir/one", "$add_dir/two" ], - 'force rotation adds externally loaded configuration files'); + [ 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/main.log' ], - 'add_file is not scanned without explicit opt-in'); -is_deeply($files, [ $main_file ], - 'file cache excludes add_file directory when scanning is disabled'); +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 vendor configuration are rejected'); +} + +# Editing global options materializes an exact local copy of the vendor main. $main::config{'scan_add_file'} = 1; -write_text($main_file, - "weekly\ninclude $add_dir\n/var/log/main.log {\n\trotate 4\n}\n"); +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'); + +# Editing a nested vendor drop-in copies the whole source file to the same +# relative path in the local tree and immediately switches parser ownership. +my $vendor_dropin = "$vendor_add_dir/deep/vendor"; +my $local_dropin = "$local_add_dir/deep/vendor"; +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(); +my ($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'); + +# 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_deeply(log_names($config), - [ '/var/log/one.log', '/var/log/two.log', '/var/log/main.log' ], - 'explicitly included files are not loaded a second time'); -is(scalar(grep { main::same_file($_, "$add_dir/one") } @$files), 1, +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'); -(undef, undef, $primary_files) = main::get_config($main_file); -is_deeply([ main::get_add_file_configs($primary_files) ], [ ], - 'force rotation does not repeat explicitly included files'); + +# 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'); +} done_testing(); From 9be5dc31ebc083feaeb6188670612c4e6b464e7b Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Tue, 4 Aug 2026 01:19:45 +0200 Subject: [PATCH 03/24] Add Btrfs subvolume quota management Add Btrfs subvolume quota support to the Disk Quotas module, including full and simple accounting modes, quota lifecycle actions, and qgroup usage and limit management. Includes ACL enforcement, compatibility with older btrfs-progs versions, destructive-action confirmation, top-level qgroup protection, help, and tests. --- CHANGELOG.md | 1 + quota/btrfs_action.cgi | 61 +++++++++++++++++ quota/config-ALL-linux | 1 + quota/config.info | 1 + quota/config_info.pl | 36 ++++++++++ quota/edit_btrfs.cgi | 54 +++++++++++++++ quota/help/btrfs.html | 53 +++++++++++++++ quota/index.cgi | 95 ++++++++++++++++++++++++-- quota/install_check.pl | 8 ++- quota/lang/en | 53 +++++++++++++++ quota/linux-lib.pl | 148 +++++++++++++++++++++++++++++++++++++++-- quota/list_btrfs.cgi | 91 +++++++++++++++++++++++++ quota/module.info | 2 +- quota/quota-lib.pl | 40 +++++++++++ quota/save_btrfs.cgi | 86 ++++++++++++++++++++++++ quota/t/run-tests.t | 72 ++++++++++++++++++++ 16 files changed, 789 insertions(+), 13 deletions(-) create mode 100755 quota/btrfs_action.cgi create mode 100755 quota/config_info.pl create mode 100755 quota/edit_btrfs.cgi create mode 100644 quota/help/btrfs.html create mode 100755 quota/list_btrfs.cgi create mode 100755 quota/save_btrfs.cgi diff --git a/CHANGELOG.md b/CHANGELOG.md index f0229ec35..ea3bd23be 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,7 @@ ## Changelog #### 2.654 (August, 2026) * Add incremental ban time options to the Fail2Ban module +* Add Btrfs subvolume quota management to the Disk Quotas module, with full and simple accounting modes * Fix to ignore failures when adding IPv6 link-local (fe80::) addresses that may already be configured automatically * Update the Authentic theme to the latest version with various improvements: - 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) diff --git a/quota/btrfs_action.cgi b/quota/btrfs_action.cgi new file mode 100755 index 000000000..099e8431c --- /dev/null +++ b/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) : ""); diff --git a/quota/config-ALL-linux b/quota/config-ALL-linux index 370c3c8c2..c6658128a 100644 --- a/quota/config-ALL-linux +++ b/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 diff --git a/quota/config.info b/quota/config.info index 0f5dfcae4..28e1456d8 100644 --- a/quota/config.info +++ b/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,15,btrfs_mode 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 diff --git a/quota/config_info.pl b/quota/config_info.pl new file mode 100755 index 000000000..e879f6d35 --- /dev/null +++ b/quota/config_info.pl @@ -0,0 +1,36 @@ +# Build and parse the Btrfs-specific module configuration field. +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); +} + +# show_btrfs_mode(mode) +# Display the accounting mode selector, defaulting unknown values to full mode. +sub show_btrfs_mode +{ +my ($mode) = @_; +$mode = "full" if ($mode ne "simple"); +return &ui_radio("btrfs_mode", $mode, + [ [ "full", $text{'config_btrfs_full'} ], + [ "simple", $text{'config_btrfs_simple'} ] ]); +} + +# parse_btrfs_mode() +# Store only a supported mode and fall back to full accounting otherwise. +sub parse_btrfs_mode +{ +return $in{'btrfs_mode'} eq "simple" ? "simple" : "full"; +} + +1; diff --git a/quota/edit_btrfs.cgi b/quota/edit_btrfs.cgi new file mode 100755 index 000000000..972868c76 --- /dev/null +++ b/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 "

$text{'btrfs_edit_info'}

\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'}, + "a_input("max_referenced", + defined($qgroup->{'max_referenced'}) ? + $qgroup->{'max_referenced'} : 0, 1)); +print &ui_table_row($text{'btrfs_max_exclusive'}, + "a_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'}); diff --git a/quota/help/btrfs.html b/quota/help/btrfs.html new file mode 100644 index 000000000..0e80eb9c9 --- /dev/null +++ b/quota/help/btrfs.html @@ -0,0 +1,53 @@ +
Btrfs Subvolume Quotas
+ +

Introduction

+Btrfs quotas control disk usage for subvolumes through quota groups, usually +called qgroups. 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.

+ +Each Btrfs subvolume has a level-0 qgroup. The module displays the +following usage and limit values for each qgroup : +

+
Referenced +
All data reachable from the subvolume, including data shared with other +subvolumes or snapshots. +
Exclusive +
Data used only by the subvolume, which would be freed if it were deleted. +
Referenced limit +
The maximum referenced space that the qgroup may use. +
Exclusive limit +
The maximum exclusive space that the qgroup may use. +
+ +

Accounting Modes

+When Btrfs quotas are enabled, the accounting mode configured in the module +settings is used : +
+
Full accounting +
Tracks shared space between subvolumes and snapshots. This is the +recommended mode when accurate referenced and exclusive usage is required. +
Simple accounting +
Tracks original ownership with lower overhead, but does not fully track +space shared between subvolumes and snapshots. +
+Changing the module setting does not convert an already-enabled filesystem. +The selected mode is used the next time quotas are enabled.

+ +

Managing Btrfs Quotas

+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 qgroups, usage, and limits. Click a qgroup ID +to edit its referenced and exclusive limits.

+ +Because quota state and qgroup 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.

+ +Full accounting also provides a rescan action for rebuilding qgroup +accounting in the background. Disabling Btrfs quotas removes all +qgroup configuration and limits on the filesystem, so the module +always requests confirmation first.

+ +

diff --git a/quota/index.cgi b/quota/index.cgi index 69cdb8139..b599dafe3 100755 --- a/quota/index.cgi +++ b/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 = "as_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 = "as_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 "

$err

\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 "$text{'index_nosupport'}

\n"; if (&foreign_available("mount")) { print &text('index_mountmod', "../mount/"),"

\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(); diff --git a/quota/install_check.pl b/quota/install_check.pl index 9e5911d7d..d031ce62e 100755 --- a/quota/install_check.pl +++ b/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("as_init)) { local $err = "as_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; } diff --git a/quota/lang/en b/quota/lang/en index 17aa8497b..ba00c51f2 100644 --- a/quota/lang/en +++ b/quota/lang/en @@ -167,6 +167,59 @@ 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 Disk and Network Filesystems 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 + +config_btrfs_full=Full accounting (recommended; tracks shared space and snapshots) +config_btrfs_simple=Simple accounting (lower overhead; tracks original ownership only) + +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 btrfs-progs +btrfs_consistency=Accounting state +btrfs_consistent=Consistent +btrfs_inconsistent=Inconsistent - a rescan is recommended +btrfs_qgroups=Subvolume quota groups +btrfs_qgroup=qgroup +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 qgroup accounting in the background. +btrfs_edit_title=Edit Btrfs Quota +btrfs_edit_header=Limits for qgroup $1 on $2 +btrfs_edit_info=Referenced usage includes shared data reachable from the subvolume. Exclusive usage is the space that would be freed with it. +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 qgroup does not exist +btrfs_etoplevel=The top-level Btrfs qgroup 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 diff --git a/quota/linux-lib.pl b/quota/linux-lib.pl index c9a3a3bc5..188c0fb05 100755 --- a/quota/linux-lib.pl +++ b/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+)(?=.*\[\/)\'') ); @@ -1168,6 +1174,53 @@ $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 @@ -1194,8 +1247,20 @@ if (defined($out)) { # 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)) { - return { 'supported' => 1, - 'enabled' => 1 }; + 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 =~ //i); + return $rv; } elsif ($qerr =~ /(?:quota root does not exist|quotas? (?:are |is )?not enabled)/i) { return { 'supported' => 1, @@ -1243,6 +1308,27 @@ foreach my $line (split(/\r?\n/, $out)) { return \@rv; } +=head2 parse_btrfs_subvolume_list_output(output) + +Parses raw output from C 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 ". + # 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 @@ -1272,6 +1358,22 @@ 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; } @@ -1380,8 +1482,9 @@ return defined($_[0]) && $_[0] =~ /^\d+\/\d+$/ ? 1 : 0; 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. +is undef, the limit is removed. If an exceeded limit blocks the update, quota +enforcement is temporarily overridden for one retry. Returns undef on success +or an error message on failure. =cut sub set_btrfs_qgroup_limit @@ -1398,6 +1501,43 @@ push(@args, defined($bytes) ? $bytes : "none"); push(@args, $qgroup) if (defined($qgroup)); push(@args, $path); my ($out, $err) = &run_btrfs_command(1, @args); + +# An exceeded qgroup can block the metadata write needed to raise or remove its +# own limit. Retry once with the kernel's administrative override, preserving +# the previous state and restoring enforcement immediately after the command. +if ($err && $err =~ /disk quota exceeded/i) { + my $uuid = &btrfs_filesystem_uuid($path); + my $sysfs = $btrfs_sysfs_root || "/sys/fs/btrfs"; + my $override = $uuid ? "$sysfs/$uuid/quota_override" : undef; + my $current; + if ($override && open(my $fh, "<", $override)) { + $current = <$fh>; + close($fh); + $current =~ s/\s+//g if (defined($current)); + } + + # Only change a known disabled override; an active or unreadable setting + # belongs to the administrator and must not be altered here. + if (defined($current) && $current eq "0") { + my $enabled; + if (open(my $fh, ">", $override)) { + my $written = syswrite($fh, "1\n"); + $enabled = defined($written) && $written == 2; + close($fh); + } + if ($enabled) { + ($out, $err) = &run_btrfs_command(1, @args); + my $restored; + if (open(my $fh, ">", $override)) { + my $written = syswrite($fh, "0\n"); + $restored = defined($written) && $written == 2; + close($fh); + } + return "Failed to restore Btrfs quota enforcement" + if (!$restored); + } + } + } return $err; } diff --git a/quota/list_btrfs.cgi b/quota/list_btrfs.cgi new file mode 100755 index 000000000..06515d7b4 --- /dev/null +++ b/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'}); diff --git a/quota/module.info b/quota/module.info index 13275131e..c87a541bf 100644 --- a/quota/module.info +++ b/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 diff --git a/quota/quota-lib.pl b/quota/quota-lib.pl index 265c8e7b3..78e79e288 100755 --- a/quota/quota-lib.pl +++ b/quota/quota-lib.pl @@ -82,6 +82,32 @@ if (defined("a_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. diff --git a/quota/save_btrfs.cgi b/quota/save_btrfs.cgi new file mode 100755 index 000000000..7ec2ef454 --- /dev/null +++ b/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, keeping an unrelated existing over-limit setting +# from causing Btrfs to reject an otherwise valid update. +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)); diff --git a/quota/t/run-tests.t b/quota/t/run-tests.t index 361fd30fb..5939a9bda 100644 --- a/quota/t/run-tests.t +++ b/quota/t/run-tests.t @@ -5,6 +5,8 @@ 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; @@ -71,6 +73,9 @@ return @{$main::mounted[0]}; do "$root/quota/linux-lib.pl" or die "linux-lib.pl: $@ $!"; +# 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"), @@ -132,6 +137,27 @@ is(scalar(@commands), 1, "successful status does not run fallback"); $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 }, @@ -173,6 +199,27 @@ 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"); @@ -240,6 +287,31 @@ is(main::set_btrfs_qgroup_limit("/srv/btrfs", "1/100", "1M"), is(main::assign_btrfs_qgroup("/srv/btrfs", "bad", "1/100"), "Invalid child Btrfs qgroup ID", "invalid child assignment is rejected"); +# An existing over-limit qgroup must not prevent an administrator from raising +# or removing its limit. The kernel override is restored after the retry. +my $override_root = tempdir(CLEANUP => 1); +my $override_uuid = "abcdef01-2345-6789-abcd-ef0123456789"; +make_path("$override_root/$override_uuid"); +open(my $override_fh, '>', + "$override_root/$override_uuid/quota_override") or die $!; +print {$override_fh} "0\n"; +close($override_fh); +local $main::btrfs_sysfs_root = $override_root; +@commands = ( ); +@responses = ( + { 'out' => "ERROR: unable to limit requested quota group: ". + "Disk quota exceeded\n", 'status' => 1 }, + { 'out' => "Label: none uuid: $override_uuid\n", 'status' => 0 }, + { 'out' => "", 'status' => 0 }, + ); +is(main::set_btrfs_qgroup_limit("/srv/btrfs", "1/100", 2097152), + undef, "over-limit qgroup updates retry with the administrative override"); +open($override_fh, '<', "$override_root/$override_uuid/quota_override") + or die $!; +is(<$override_fh>, "0\n", "quota enforcement is restored after the retry"); +close($override_fh); +is(scalar(@commands), 3, "one status lookup and one limit retry are run"); + @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"); From 65e171a92ff46cc752617d39fbbc467acd918f65 Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Tue, 4 Aug 2026 01:58:27 +0200 Subject: [PATCH 04/24] Fix to use module config https://github.com/webmin/webmin/pull/2807#pullrequestreview-4849404584 --- quota/config.info | 2 +- quota/config_info.pl | 20 +------------------- quota/lang/en | 3 --- 3 files changed, 2 insertions(+), 23 deletions(-) diff --git a/quota/config.info b/quota/config.info index 28e1456d8..df6bcdd03 100644 --- a/quota/config.info +++ b/quota/config.info @@ -5,7 +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,15,btrfs_mode +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 diff --git a/quota/config_info.pl b/quota/config_info.pl index e879f6d35..b9abbf0d0 100755 --- a/quota/config_info.pl +++ b/quota/config_info.pl @@ -1,4 +1,4 @@ -# Build and parse the Btrfs-specific module configuration field. +# Hide Btrfs-specific configuration when it cannot be used. require './quota-lib.pl'; # config_pre_load(info, [order]) @@ -15,22 +15,4 @@ delete($info->{'btrfs_mode'}); @$order = grep { $_ ne "btrfs_mode" } @$order if ($order); } -# show_btrfs_mode(mode) -# Display the accounting mode selector, defaulting unknown values to full mode. -sub show_btrfs_mode -{ -my ($mode) = @_; -$mode = "full" if ($mode ne "simple"); -return &ui_radio("btrfs_mode", $mode, - [ [ "full", $text{'config_btrfs_full'} ], - [ "simple", $text{'config_btrfs_simple'} ] ]); -} - -# parse_btrfs_mode() -# Store only a supported mode and fall back to full accounting otherwise. -sub parse_btrfs_mode -{ -return $in{'btrfs_mode'} eq "simple" ? "simple" : "full"; -} - 1; diff --git a/quota/lang/en b/quota/lang/en index ba00c51f2..6ed06c337 100644 --- a/quota/lang/en +++ b/quota/lang/en @@ -177,9 +177,6 @@ index_btrfs_inconsistent=inconsistent index_btrfs_unavailable=Unavailable index_btrfs_error=Error: $1 -config_btrfs_full=Full accounting (recommended; tracks shared space and snapshots) -config_btrfs_simple=Simple accounting (lower overhead; tracks original ownership only) - btrfs_title=Btrfs Subvolume Quotas btrfs_return=filesystem list btrfs_status_header=Quota status for $1 From b433cdd810d7065b1f25eb3366b6b219ebcbdf90 Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Tue, 4 Aug 2026 02:04:59 +0200 Subject: [PATCH 05/24] Fix to clarify Btrfs qgroup limit retry behavior https://github.com/webmin/webmin/pull/2807#discussion_r3708456970 --- quota/linux-lib.pl | 13 +++++++------ quota/save_btrfs.cgi | 4 ++-- quota/t/run-tests.t | 8 ++++---- 3 files changed, 13 insertions(+), 12 deletions(-) diff --git a/quota/linux-lib.pl b/quota/linux-lib.pl index 188c0fb05..f37bf804e 100755 --- a/quota/linux-lib.pl +++ b/quota/linux-lib.pl @@ -1482,9 +1482,9 @@ return defined($_[0]) && $_[0] =~ /^\d+\/\d+$/ ? 1 : 0; 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. If an exceeded limit blocks the update, quota -enforcement is temporarily overridden for one retry. Returns undef on success -or an error message on failure. +is undef, the limit is removed. If quota enforcement on path or one of its +parent qgroups blocks the transaction, it is temporarily overridden for one +retry. Returns undef on success or an error message on failure. =cut sub set_btrfs_qgroup_limit @@ -1502,9 +1502,10 @@ push(@args, $qgroup) if (defined($qgroup)); push(@args, $path); my ($out, $err) = &run_btrfs_command(1, @args); -# An exceeded qgroup can block the metadata write needed to raise or remove its -# own limit. Retry once with the kernel's administrative override, preserving -# the previous state and restoring enforcement immediately after the command. +# A limit on the command path or one of its parent qgroups can block the +# transaction needed to update any qgroup limit. Retry once with the kernel's +# administrative override, preserving the previous state and restoring +# enforcement immediately after the command. if ($err && $err =~ /disk quota exceeded/i) { my $uuid = &btrfs_filesystem_uuid($path); my $sysfs = $btrfs_sysfs_root || "/sys/fs/btrfs"; diff --git a/quota/save_btrfs.cgi b/quota/save_btrfs.cgi index 7ec2ef454..f49a7b97e 100755 --- a/quota/save_btrfs.cgi +++ b/quota/save_btrfs.cgi @@ -68,8 +68,8 @@ $same_referenced = &same_limit( $same_exclusive = &same_limit( $max_exclusive, $qgroup->{'max_exclusive'}); -# Apply only changed limits, keeping an unrelated existing over-limit setting -# from causing Btrfs to reject an otherwise valid update. +# 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); diff --git a/quota/t/run-tests.t b/quota/t/run-tests.t index 5939a9bda..3485f61f4 100644 --- a/quota/t/run-tests.t +++ b/quota/t/run-tests.t @@ -287,8 +287,8 @@ is(main::set_btrfs_qgroup_limit("/srv/btrfs", "1/100", "1M"), is(main::assign_btrfs_qgroup("/srv/btrfs", "bad", "1/100"), "Invalid child Btrfs qgroup ID", "invalid child assignment is rejected"); -# An existing over-limit qgroup must not prevent an administrator from raising -# or removing its limit. The kernel override is restored after the retry. +# A qgroup-limit transaction rejected by quota enforcement is retried once, +# and the kernel override is restored immediately afterward. my $override_root = tempdir(CLEANUP => 1); my $override_uuid = "abcdef01-2345-6789-abcd-ef0123456789"; make_path("$override_root/$override_uuid"); @@ -305,12 +305,12 @@ local $main::btrfs_sysfs_root = $override_root; { 'out' => "", 'status' => 0 }, ); is(main::set_btrfs_qgroup_limit("/srv/btrfs", "1/100", 2097152), - undef, "over-limit qgroup updates retry with the administrative override"); + undef, "an EDQUOT limit update retries with the administrative override"); open($override_fh, '<', "$override_root/$override_uuid/quota_override") or die $!; is(<$override_fh>, "0\n", "quota enforcement is restored after the retry"); close($override_fh); -is(scalar(@commands), 3, "one status lookup and one limit retry are run"); +is(scalar(@commands), 3, "one UUID lookup and one limit retry are run"); @responses = ({ 'out' => "ERROR: qgroup exists\n", 'status' => 1 }); is(main::create_btrfs_qgroup("/srv/btrfs", "1/100"), From 2918ac42040c8e85fa4d6a261c25f24d4a79abbb Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Wed, 5 Aug 2026 01:25:58 +0200 Subject: [PATCH 06/24] Add missing API --- quota/linux-lib.pl | 78 +++++++++++++++++++++++++++++++++++++++++++++ quota/t/run-tests.t | 17 ++++++++++ 2 files changed, 95 insertions(+) diff --git a/quota/linux-lib.pl b/quota/linux-lib.pl index f37bf804e..1b7245ef6 100755 --- a/quota/linux-lib.pl +++ b/quota/linux-lib.pl @@ -1111,6 +1111,84 @@ foreach my $m (&mount::list_mounted()) { 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 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 =~ /^ Date: Fri, 7 Aug 2026 02:29:36 +0200 Subject: [PATCH 07/24] Fix comments --- quota/linux-lib.pl | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/quota/linux-lib.pl b/quota/linux-lib.pl index 1b7245ef6..8c9564375 100755 --- a/quota/linux-lib.pl +++ b/quota/linux-lib.pl @@ -1560,9 +1560,10 @@ return defined($_[0]) && $_[0] =~ /^\d+\/\d+$/ ? 1 : 0; 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. If quota enforcement on path or one of its -parent qgroups blocks the transaction, it is temporarily overridden for one -retry. Returns undef on success or an error message on failure. +is undef, the limit is removed. If the qgroup for the subvolume containing +path, or one of its parent qgroups, blocks the transaction, quota enforcement +is temporarily overridden for one retry. Returns undef on success or an error +message on failure. =cut sub set_btrfs_qgroup_limit @@ -1580,10 +1581,11 @@ push(@args, $qgroup) if (defined($qgroup)); push(@args, $path); my ($out, $err) = &run_btrfs_command(1, @args); -# A limit on the command path or one of its parent qgroups can block the -# transaction needed to update any qgroup limit. Retry once with the kernel's -# administrative override, preserving the previous state and restoring -# enforcement immediately after the command. +# If the qgroup for the subvolume containing $path, or one of its parent +# qgroups, is over quota, Btrfs can reject the transaction needed to update any +# qgroup limit. Retry once with the kernel's administrative override, +# preserving the previous state and restoring enforcement immediately after +# the command. if ($err && $err =~ /disk quota exceeded/i) { my $uuid = &btrfs_filesystem_uuid($path); my $sysfs = $btrfs_sysfs_root || "/sys/fs/btrfs"; From b8291f206c4d9a1a6fbc99013ab6206052e33a6b Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Fri, 7 Aug 2026 02:35:28 +0200 Subject: [PATCH 08/24] Fix to clarify Btrfs quota accounting behavior --- quota/help/btrfs.html | 6 +++++- quota/lang/en | 2 +- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/quota/help/btrfs.html b/quota/help/btrfs.html index 0e80eb9c9..f02a26ca3 100644 --- a/quota/help/btrfs.html +++ b/quota/help/btrfs.html @@ -31,6 +31,8 @@ recommended mode when accurate referenced and exclusive usage is required.

Tracks original ownership with lower overhead, but does not fully track space shared between subvolumes and snapshots. +In simple accounting mode, both values show space assigned to the subvolume +that first wrote the data.

Changing the module setting does not convert an already-enabled filesystem. The selected mode is used the next time quotas are enabled.

@@ -38,7 +40,9 @@ The selected mode is used the next time quotas are enabled.

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 qgroups, usage, and limits. Click a qgroup ID -to edit its referenced and exclusive limits.

+to edit its referenced and exclusive limits. The top-level qgroup +0/5 is shown for information only because limiting it could stop +filesystem changes.

Because quota state and qgroup IDs apply to the whole underlying Btrfs filesystem, delegated Webmin users must be allowed to manage all filesystems to diff --git a/quota/lang/en b/quota/lang/en index 6ed06c337..1ef3573b2 100644 --- a/quota/lang/en +++ b/quota/lang/en @@ -204,7 +204,7 @@ btrfs_rescan=Rescan quotas btrfs_rescan_desc=Rebuild full qgroup accounting in the background. btrfs_edit_title=Edit Btrfs Quota btrfs_edit_header=Limits for qgroup $1 on $2 -btrfs_edit_info=Referenced usage includes shared data reachable from the subvolume. Exclusive usage is the space that would be freed with it. +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 From b6db862133c91622332268fcf90ed3214d6bde85 Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Fri, 7 Aug 2026 04:04:02 +0200 Subject: [PATCH 09/24] Fix to restrict bonding mode to valid values --- net/save_bifc.cgi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/net/save_bifc.cgi b/net/save_bifc.cgi index 1006669a5..1999130a6 100755 --- a/net/save_bifc.cgi +++ b/net/save_bifc.cgi @@ -294,7 +294,7 @@ else { $b->{'bond'} = 1; $in{'partner'} =~ /^\S+( +\S+)*$/ || &error($text{'bonding_epartner'}); $b->{'partner'} = $in{'partner'}; - $in{'bondmode'} =~ /^\d*$/ || &error($text{'bonding_ebondmode'}); + $in{'bondmode'} =~ /^[0-6]$/ || &error($text{'bonding_ebondmode'}); $b->{'mode'} = $in{'bondmode'}; $in{'primary'} =~ /^\S*$/ || &error($text{'bonding_eprimary'}); $b->{'primary'} = $in{'primary'}; From 29b299c8817bf5766c6f39df58c00f8a6bceb626 Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Sat, 8 Aug 2026 14:40:03 +0200 Subject: [PATCH 10/24] Fix to avoid overriding Btrfs quota enforcement --- quota/linux-lib.pl | 45 ++------------------------------------------- quota/t/run-tests.t | 28 +++++----------------------- 2 files changed, 7 insertions(+), 66 deletions(-) diff --git a/quota/linux-lib.pl b/quota/linux-lib.pl index 8c9564375..12e4d1d48 100755 --- a/quota/linux-lib.pl +++ b/quota/linux-lib.pl @@ -1560,10 +1560,8 @@ return defined($_[0]) && $_[0] =~ /^\d+\/\d+$/ ? 1 : 0; 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. If the qgroup for the subvolume containing -path, or one of its parent qgroups, blocks the transaction, quota enforcement -is temporarily overridden for one retry. Returns undef on success or an error -message on failure. +is undef, the limit is removed. Returns undef on success or an error message +on failure. =cut sub set_btrfs_qgroup_limit @@ -1580,45 +1578,6 @@ push(@args, defined($bytes) ? $bytes : "none"); push(@args, $qgroup) if (defined($qgroup)); push(@args, $path); my ($out, $err) = &run_btrfs_command(1, @args); - -# If the qgroup for the subvolume containing $path, or one of its parent -# qgroups, is over quota, Btrfs can reject the transaction needed to update any -# qgroup limit. Retry once with the kernel's administrative override, -# preserving the previous state and restoring enforcement immediately after -# the command. -if ($err && $err =~ /disk quota exceeded/i) { - my $uuid = &btrfs_filesystem_uuid($path); - my $sysfs = $btrfs_sysfs_root || "/sys/fs/btrfs"; - my $override = $uuid ? "$sysfs/$uuid/quota_override" : undef; - my $current; - if ($override && open(my $fh, "<", $override)) { - $current = <$fh>; - close($fh); - $current =~ s/\s+//g if (defined($current)); - } - - # Only change a known disabled override; an active or unreadable setting - # belongs to the administrator and must not be altered here. - if (defined($current) && $current eq "0") { - my $enabled; - if (open(my $fh, ">", $override)) { - my $written = syswrite($fh, "1\n"); - $enabled = defined($written) && $written == 2; - close($fh); - } - if ($enabled) { - ($out, $err) = &run_btrfs_command(1, @args); - my $restored; - if (open(my $fh, ">", $override)) { - my $written = syswrite($fh, "0\n"); - $restored = defined($written) && $written == 2; - close($fh); - } - return "Failed to restore Btrfs quota enforcement" - if (!$restored); - } - } - } return $err; } diff --git a/quota/t/run-tests.t b/quota/t/run-tests.t index e0512e8f0..cc86becfe 100644 --- a/quota/t/run-tests.t +++ b/quota/t/run-tests.t @@ -304,30 +304,12 @@ is(main::set_btrfs_qgroup_limit("/srv/btrfs", "1/100", "1M"), is(main::assign_btrfs_qgroup("/srv/btrfs", "bad", "1/100"), "Invalid child Btrfs qgroup ID", "invalid child assignment is rejected"); -# A qgroup-limit transaction rejected by quota enforcement is retried once, -# and the kernel override is restored immediately afterward. -my $override_root = tempdir(CLEANUP => 1); -my $override_uuid = "abcdef01-2345-6789-abcd-ef0123456789"; -make_path("$override_root/$override_uuid"); -open(my $override_fh, '>', - "$override_root/$override_uuid/quota_override") or die $!; -print {$override_fh} "0\n"; -close($override_fh); -local $main::btrfs_sysfs_root = $override_root; @commands = ( ); -@responses = ( - { 'out' => "ERROR: unable to limit requested quota group: ". - "Disk quota exceeded\n", 'status' => 1 }, - { 'out' => "Label: none uuid: $override_uuid\n", 'status' => 0 }, - { 'out' => "", 'status' => 0 }, - ); -is(main::set_btrfs_qgroup_limit("/srv/btrfs", "1/100", 2097152), - undef, "an EDQUOT limit update retries with the administrative override"); -open($override_fh, '<', "$override_root/$override_uuid/quota_override") - or die $!; -is(<$override_fh>, "0\n", "quota enforcement is restored after the retry"); -close($override_fh); -is(scalar(@commands), 3, "one UUID lookup and one limit retry are run"); +@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"), From a9b4b4ac3d6a0c2bd0705ff72c9c97cea43c280d Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Sun, 9 Aug 2026 03:32:05 +0200 Subject: [PATCH 11/24] Bundle Text::ASCIITable --- vendor_perl/Text/ASCIITable.pm | 1092 +++++++++++++++++++++++++++ vendor_perl/Text/ASCIITable/Wrap.pm | 99 +++ 2 files changed, 1191 insertions(+) create mode 100644 vendor_perl/Text/ASCIITable.pm create mode 100644 vendor_perl/Text/ASCIITable/Wrap.pm diff --git a/vendor_perl/Text/ASCIITable.pm b/vendor_perl/Text/ASCIITable.pm new file mode 100644 index 000000000..2fc85a11a --- /dev/null +++ b/vendor_perl/Text/ASCIITable.pm @@ -0,0 +1,1092 @@ +package Text::ASCIITable; +# by Håkon Nessjøen + +@ISA=qw(Exporter); +@EXPORT = qw(); +@EXPORT_OK = qw(); +$VERSION = '0.22'; +use Exporter; +use strict; +use Carp; +use Text::ASCIITable::Wrap qw{ wrap }; +use overload '@{}' => 'addrow_overload', '""' => 'drawit'; +use utf8; +use List::Util qw(reduce max sum); + +=encoding utf8 + +=head1 NAME + +Text::ASCIITable - Create a nice formatted table using ASCII characters. + +=head1 SHORT DESCRIPTION + +Pretty nifty if you want to output dynamic text to your console or other +fixed-size-font displays, and at the same time it will display it in a +nice human-readable, or "cool" way. + +=head1 SYNOPSIS + + use Text::ASCIITable; + $t = Text::ASCIITable->new({ headingText => 'Basket' }); + + $t->setCols('Id','Name','Price'); + $t->addRow(1,'Dummy product 1',24.4); + $t->addRow(2,'Dummy product 2',21.2); + $t->addRow(3,'Dummy product 3',12.3); + $t->addRowLine(); + $t->addRow('','Total',57.9); + print $t; + + # Result: + .------------------------------. + | Basket | + +----+-----------------+-------+ + | Id | Name | Price | + +----+-----------------+-------+ + | 1 | Dummy product 1 | 24.4 | + | 2 | Dummy product 2 | 21.2 | + | 3 | Dummy product 3 | 12.3 | + +----+-----------------+-------+ + | | Total | 57.9 | + '----+-----------------+-------' + +=head1 FUNCTIONS + +=head2 new(options) + +Initialize a new table. You can specify output-options. For more options, check out the usage for setOptions() + + Usage: + $t = Text::ASCIITable->new(); + + Or with options: + $t = Text::ASCIITable->new({ hide_Lastline => 1, reportErrors => 0}); + +=cut + +sub new { + my $self = { + tbl_cols => [], + tbl_rows => [], + tbl_cuts => [], + tbl_align => {}, + tbl_lines => {}, + + des_top => ['.','.','-','-'], + des_middle => ['+','+','-','+'], + des_bottom => ["'","'",'-','+'], + des_rowline => ['+','+','-','+'], + + des_toprow => ['|','|','|'], + des_middlerow => ['|','|','|'], + + cache_width => {}, + + options => $_[1] || { } + }; + + $self->{options}{reportErrors} = defined($self->{options}{reportErrors}) ? $self->{options}{reportErrors} : 1; # default setting + $self->{options}{alignHeadRow} = $self->{options}{alignHeadRow} || 'auto'; # default setting + $self->{options}{undef_as} = $self->{options}{undef_as} || ''; # default setting + $self->{options}{chaining} = $self->{options}{chaining} || 0; # default setting + + bless $self; + + return $self; +} + +=head2 setCols(@cols) + +Define the columns for the table(compare with in HTML). For example C. +B that you cannot add Cols after you have added a row. Multiline columnnames are allowed. + +=cut + +sub setCols { + my $self = shift; + do { $self->reperror("setCols needs an array"); return $self->{options}{chaining} ? $self : 1; } unless defined($_[0]); + @_ = @{$_[0]} if (ref($_[0]) eq 'ARRAY'); + do { $self->reperror("setCols needs an array"); return $self->{options}{chaining} ? $self : 1; } unless scalar(@_) != 0; + do { $self->reperror("Cannot edit cols at this state"); return $self->{options}{chaining} ? $self : 1; } unless scalar(@{$self->{tbl_rows}}) == 0; + + my @lines = map { [ split(/\n/,$_) ] } @_; + + # Multiline support + my $max=0; + my @out; + grep {$max = scalar(@{$_}) if scalar(@{$_}) > $max} @lines; + foreach my $num (0..($max-1)) { + my @tmp = map defined $$_[$num] && $$_[$num], @lines; + push @out, \@tmp; + } + + @{$self->{tbl_cols}} = @_; + @{$self->{tbl_multilinecols}} = @out if ($max); + $self->{tbl_colsismultiline} = $max; + + return $self->{options}{chaining} ? $self : undef; +} + +=head2 addRow(@collist) + +Adds one row to the table. This must be an array of strings. If you defined 3 columns. This array must +have 3 items in it. And so on. Should be self explanatory. The strings can contain newlines. + + Note: It does not require argument to be an array, thus; + $t->addRow(['id','name']) and $t->addRow('id','name') does the same thing. + +This module is also overloaded to accept push. To construct a table with the use of overloading you might do the following: + + $t = Text::ASCIITable->new(); + $t->setCols('one','two','three','four'); + push @$t, ( "one\ntwo" ) x 4; # Replaces $t->addrow(); + print $t; # Replaces print $t->draw(); + + Which would construct: + .-----+-----+-------+------. + | one | two | three | four | + |=----+-----+-------+-----=| + | one | one | one | one | # Note that theese two lines + | two | two | two | two | # with text are one singe row. + '-----+-----+-------+------' + +There is also possible to give this function an array of arrayrefs and hence support the output from +DBI::selectall_arrayref($sql) without changes. + + Example of multiple-rows pushing: + $t->addRow([ + [ 1, 2, 3 ], + [ 4, 5, 6 ], + [ 7, 8, 9 ], + ]); + +=cut + +sub addRow { + my $self = shift; + @_ = @{$_[0]} if (ref($_[0]) eq 'ARRAY'); + do { $self->reperror("Received too many columns"); return $self->{options}{chaining} ? $self : 1; } if scalar(@_) > scalar(@{$self->{tbl_cols}}) && ref($_[0]) ne 'ARRAY'; + my (@in,@out,@lines,$max); + + if (scalar(@_) > 0 && ref($_[0]) eq 'ARRAY') { + foreach my $row (@_) { + $self->addRow($row); + } + return $self->{options}{chaining} ? $self : undef; + } + + # Fill out row, if columns are missing (requested) Mar 21 2004 by a anonymous person + while (scalar(@_) < scalar(@{$self->{tbl_cols}})) { + push @_, ' '; + } + + # Word wrapping & undef-replacing + foreach my $c (0..$#_) { + $_[$c] = $self->{options}{undef_as} unless defined $_[$c]; # requested by david@landgren.net/dland@cpan.org - https://rt.cpan.org/NoAuth/Bugs.html?Dist=Text-ASCIITable + my $colname = $self->{tbl_cols}[$c]; + my $width = $self->{tbl_width}{$colname} || 0; + if ($width > 0) { + $in[$c] = wrap($_[$c],$width); + } else { + $in[$c] = $_[$c]; + } + } + + # Multiline support: + @lines = map { [ split /\n/ ] } @in; + $max = max map {scalar @$_} @lines; + foreach my $num (0..($max-1)) { + my @tmp = map { defined(@{$_}[$num]) && $self->count(@{$_}[$num]) ? @{$_}[$num] : '' } @lines; + push @out, [ @tmp ]; + } + + # Add row(s) + push @{$self->{tbl_rows}}, @out; + + # Rowlinesupport: + $self->{tbl_rowline}{scalar(@{$self->{tbl_rows}})} = 1; + + return $self->{options}{chaining} ? $self : undef; +} + +sub addrow_overload { + my $self = shift; + my @arr; + tie @arr, $self; + return \@arr; +} + +=head2 addRowLine([$row]) + +Will add a line after the current row. As an argument, you may specify after which row you want a line (first row is 1) +or an array of row numbers. (HINT: If you want a line after every row, read about the drawRowLine option in setOptions()) + +Example without arguments: + $t->addRow('one','two','three'); + $t->addRowLine(); + $t->addRow('one','two','three'); + +Example with argument: + $t->addRow('one','two','three'); + $t->addRow('one','two','three'); + $t->addRow('one','two','three'); + $t->addRow('one','two','three'); + $t->addRowLine(1); # or multiple: $t->addRowLine([2,3]); + +=cut + +sub addRowLine { + my ($self,$row) = @_; + do { $self->reperror("rows not added yet"); return $self->{options}{chaining} ? $self : 1; } unless scalar(@{$self->{tbl_rows}}) > 0; + + if (defined($row) && ref($row) eq 'ARRAY') { + foreach (@$row) { + $_=int($_); + $self->{tbl_lines}{$_} = 1; + } + } + elsif (defined($row)) { + $row = int($row); + do { $self->reperror("$row is higher than number of rows added"); return $self->{options}{chaining} ? $self : 1; } if ($row < 0 || $row > scalar(@{$self->{tbl_rows}})); + $self->{tbl_lines}{$row} = 1; + } else { + $self->{tbl_lines}{scalar(@{$self->{tbl_rows}})} = 1; + } + + return $self->{options}{chaining} ? $self : undef; +} + +# backwardscompatibility, deprecated +sub alignColRight { + my ($self,$col) = @_; + do { $self->reperror("alignColRight is missing parameter(s)"); return $self->{options}{chaining} ? $self : 1; } unless defined($col); + return $self->alignCol($col,'right'); +} + +=head2 alignCol($col,$direction) or alignCol({col1 => direction1, col2 => direction2, ... }) + +Given a columnname, it aligns all data to the given direction in the table. This looks nice on numerical displays +in a column. The column names in the table will be unaffected by the alignment. Possible directions is: left, +center, right, justify, auto or your own subroutine. (Hint: Using auto(default), aligns numbers right and text left) + +=cut + +sub alignCol { + my ($self,$col,$direction) = @_; + do { $self->reperror("alignCol is missing parameter(s)"); return $self->{options}{chaining} ? $self : 1; } unless defined($col) && defined($direction) || (defined($col) && ref($col) eq 'HASH'); + do { $self->reperror("Could not find '$col' in columnlist"); return $self->{options}{chaining} ? $self : 1; } unless defined(&find($col,$self->{tbl_cols})) || (defined($col) && ref($col) eq 'HASH'); + + if (ref($col) eq 'HASH') { + for (keys %{$col}) { + do { $self->reperror("Could not find '$_' in columnlist"); return $self->{options}{chaining} ? $self : 1; } unless defined(&find($_,$self->{tbl_cols})); + $self->{tbl_align}{$_} = $col->{$_}; + } + } else { + $self->{tbl_align}{$col} = $direction; + } + return $self->{options}{chaining} ? $self : undef; +} + +=head2 alignColName($col,$direction) + +Given a columnname, it aligns the columnname in the row explaining columnnames, to the given direction. (auto,left,right,center,justify +or a subroutine) (Hint: Overrides the 'alignHeadRow' option for the specified column.) + +=cut + +sub alignColName { + my ($self,$col,$direction) = @_; + do { $self->reperror("alignColName is missing parameter(s)"); return $self->{options}{chaining} ? $self : 1; } unless defined($col) && defined($direction); + do { $self->reperror("Could not find '$col' in columnlist"); return $self->{options}{chaining} ? $self : 1; } unless defined(&find($col,$self->{tbl_cols})); + + $self->{tbl_colalign}{$col} = $direction; + return $self->{options}{chaining} ? $self : undef; +} + +=head2 setColWidth($col,$width,$strict) + +Wordwrapping/strict size. Set a max-width(in chars) for a column. +If last parameter is 1, the column will be set to the specified width, even if no text is that long. + + Usage: + $t->setColWidth('Description',30); + +=cut + +sub setColWidth { + my ($self,$col,$width,$strict) = @_; + do { $self->reperror("setColWidth is missing parameter(s)"); return $self->{options}{chaining} ? $self : 1; } unless defined($col) && defined($width); + do { $self->reperror("Could not find '$col' in columnlist"); return $self->{options}{chaining} ? $self : 1; } unless defined(&find($col,$self->{tbl_cols})); + do { $self->reperror("Cannot change width at this state"); return $self->{options}{chaining} ? $self : 1; } unless scalar(@{$self->{tbl_rows}}) == 0; + + $self->{tbl_width}{$col} = int($width); + $self->{tbl_width_strict}{$col} = $strict ? 1 : 0; + + return $self->{options}{chaining} ? $self : undef; +} + +sub headingWidth { + my $self = shift; + my $title = $self->{options}{headingText}; + return max map {$self->count($_)} split /\r?\n/, $self->{options}{headingText}; +} + +# drawing etc, below +sub getColWidth { + my ($self,$colname) = @_; + $self->reperror("Could not find '$colname' in columnlist") unless defined find($colname, $self->{tbl_cols}); + + return $self->{cache_width}{$colname}; +} + +# Width-calculating functions rewritten for more speed by Alexey Sheynuk +# Thanks :) +sub calculateColWidths { + my ($self) = @_; + $self->{cache_width} = undef; + my $cols = $self->{tbl_cols}; + foreach my $c (0..$#{$cols}) { + my $colname = $cols->[$c]; + if (defined($self->{tbl_width_strict}{$colname}) && ($self->{tbl_width_strict}{$colname} == 1) && int($self->{tbl_width}{$colname}) > 0) { + # maxsize plus the spaces on each side + $self->{cache_width}{$colname} = $self->{tbl_width}{$colname} + 2; + } else { + my $colwidth = max((map {$self->count($_)} split(/\n/,$colname)), (map {$self->count($_->[$c])} @{$self->{tbl_rows}})); + $self->{cache_width}{$colname} = $colwidth + 2; + } + } + $self->addExtraHeadingWidth; +} + +sub addExtraHeadingWidth { + my ($self) = @_; + return unless defined $self->{options}{headingText}; + my $tablewidth = -3 + sum map {$_ + 1} values %{$self->{cache_width}}; + my $headingwidth = $self->headingWidth(); + if ($headingwidth > $tablewidth) { + my $extra = $headingwidth - $tablewidth; + my $cols = scalar(@{$self->{tbl_cols}}); + my $extra_for_all = int($extra/$cols); + my $extrasome = $extra % $cols; + my $antall = 0; + foreach my $col (@{$self->{tbl_cols}}) { + my $extrawidth = $extra_for_all; + if ($antall < $extrasome) { + $antall++; + $extrawidth++; + } + $self->{cache_width}{$col} += $extrawidth; + } + } +} + +=head2 getTableWidth() + +If you need to know how wide your table will be before you draw it. Use this function. + +=cut + +sub getTableWidth { + my $self = shift; + my $totalsize = 1; + if (!defined($self->{cache_TableWidth})) { + $self->calculateColWidths; + grep {$totalsize += $self->getColWidth($_,undef) + 1} @{$self->{tbl_cols}}; + $self->{cache_TableWidth} = $totalsize; + } + return $self->{cache_TableWidth}; +} + +sub drawLine { + my ($self,$start,$stop,$line,$delim) = @_; + do { $self->reperror("Missing reqired parameters"); return 1; } unless defined($stop); + $line = defined($line) ? $line : '-'; + $delim = defined($delim) ? $delim : '+'; + + my $contents; + + $contents = $start; + + for (my $i=0;$i < scalar(@{$self->{tbl_cols}});$i++) { + my $offset = 0; + $offset = $self->count($start) - 1 if ($i == 0); + $offset = $self->count($stop) - 1 if ($i == scalar(@{$self->{tbl_cols}}) -1); + + $contents .= $line x ($self->getColWidth(@{$self->{tbl_cols}}[$i]) - $offset); + + $contents .= $delim if ($i != scalar(@{$self->{tbl_cols}}) - 1); + } + return $contents.$stop."\n"; +} + +=head2 setOptions(name,value) or setOptions({ option1 => value1, option2 => value2, ... }) + +Use this to set options like: hide_FirstLine,reportErrors, etc. + + Usage: + $t->setOptions('hide_HeadLine',1); + + Or set more than one option on the fly: + $t->setOptions({ hide_HeadLine => 1, hide_HeadRow => 1 }); + +B + +=over 4 + +=item hide_HeadRow + +Hides output of the columnlisting. Together with hide_HeadLine, this makes a table only show the rows. (However, even though +the column-names will not be shown, they will affect the output if they have for example ridiculoustly long +names, and the rows contains small amount of info. You would end up with a lot of whitespace) + +=item reportErrors + +Set to 0 to disable error reporting. Though if a function encounters an error, it will still return the value 1, to +tell you that things didn't go exactly as they should. + +=item allowHTML + +If you are going to use Text::ASCIITable to be shown on HTML pages, you should set this option to 1 when you are going +to use HTML tags to for example color the text inside the rows, and you want the browser to handle the table correct. + +=item allowANSI + +If you use ANSI codes like [1mHi this is bold[m or similar. This option will make the table to be +displayed correct when showed in a ANSI compliant terminal. Set this to 1 to enable. There is an example of ANSI support +in this package, named ansi-example.pl. + +=item alignHeadRow + +Set wich direction the Column-names(in the headrow) are supposed to point. Must be left, right, center, justify, auto or a user-defined subroutine. + +=item hide_FirstLine, hide_HeadLine, hide_LastLine + +Speaks for it self? + +=item drawRowLine + +Set this to 1 to print a line between each row. You can also define the outputstyle +of this line in the draw() function. + +=item headingText + +Add a heading above the columnnames/rows wich uses the whole width of the table to output +a heading/title to the table. The heading-part of the table is automatically shown when +the headingText option contains text. B If this text is so long that it makes the +table wider, it will not hesitate to change width of columns that have "strict width". + +It supports multiline, and with Text::ASCIITable::Wrap you may wrap your text before entering +it, to prevent the title from expanding the table. Internal wrapping-support for headingText +might come in the future. + +=item headingAlign + +Align the heading(as mentioned above) to left, right, center, auto or using a subroutine. + +=item headingStartChar, headingStopChar + +Choose the startingchar and endingchar of the row where the title is. The default is +'|' on both. If you didn't understand this, try reading about the draw() function. + +=item cb_count + +Set the callback subroutine to use when counting characters inside the table. This is useful +to make support for having characters or codes inside the table that are not shown on the +screen to the user, so the table should not count these characters. This could be for example +HTML tags, or ANSI codes. Though those two examples are alredy supported internally with the +allowHTML and allowANSI, options. This option expects a CODE reference. (\&callback_function) + +=item undef_as + +Sets the replacing string that replaces an undef value sent to addRow() (or even the overloaded +push version of addRow()). The default value is an empty string ''. An example of use would be +to set it to '(undef)', to show that the input really was undefined. + + +=item chaining + +Set this to 1 to support chainging of methods. The default is 0, where the methods return 1 if +they come upon an error as mentioned in the reportErrors option description. + + Usage example: + print Text::ASCIITable->new({ chaining => 1 }) + ->setCols('One','Two','Three') + ->addRow([ + [ 1, 2, 3 ], + [ 4, 5, 6 ], + [ 7, 8, 9 ], + ]) + ->draw(); + +Note that ->draw() can be omitted, since Text::ASCIITable is overloaded to print the table by default. + +=back + +=cut + +sub setOptions { + my ($self,$name,$value) = @_; + my $old; + if (ref($name) eq 'HASH') { + for (keys %{$name}) { + $self->{options}{$_} = $name->{$_}; + } + } else { + $old = $self->{options}{$name} || undef; + $self->{options}{$name} = $value; + } + return $old; +} + +# Thanks to Khemir Nadim ibn Hamouda +# Original code from Spreadsheet::Perl::ASCIITable +sub prepareParts { + my ($self)=@_; + my $running_width = 1 ; + + $self->{tbl_cuts} = []; + foreach my $column (@{$self->{tbl_cols}}) { + my $column_width = $self->getColWidth($column,undef); + if ($running_width + $column_width >= $self->{options}{outputWidth}) { + push @{$self->{tbl_cuts}}, $running_width; + $running_width = $column_width + 2; + } else { + $running_width += $column_width + 1 ; + } + } + push @{$self->{tbl_cuts}}, $self->getTableWidth() ; +} + +sub pageCount { + my $self = shift; + do { $self->reperror("Table has no max output-width set"); return 1; } unless defined($self->{options}{outputWidth}); + + return 1 if ($self->getTableWidth() < $self->{options}{outputWidth}); + $self->prepareParts() if (scalar(@{$self->{tbl_cuts}}) < 1); + + return scalar(@{$self->{tbl_cuts}}); +} + +sub drawSingleColumnRow { + my ($self,$text,$start,$stop,$align,$opt) = @_; + do { $self->reperror("Missing reqired parameters"); return 1; } unless defined($text); + + my $contents = $start; + my $width = 0; + my $tablewidth = $self->getTableWidth(); + # ok this is a bad shortcut, but 'till i get up with a better one, I use this. + if (($tablewidth - 4) < $self->count($text) && $opt eq 'title') { + $width = $self->count($text); + } + else { + $width = $tablewidth - 4; + } + $contents .= ' '.$self->align( + $text, + $align || 'left', + $width, + ($self->{options}{allowHTML} || $self->{options}{allowANSI} || $self->{options}{cb_count} ?0:1) + ).' '; + return $contents.$stop."\n"; +} + +sub drawRow { + my ($self,$row,$isheader,$start,$stop,$delim) = @_; + do { $self->reperror("Missing reqired parameters"); return 1; } unless defined($row); + $isheader = $isheader || 0; + $delim = $delim || '|'; + + my $contents = $start; + for (my $i=0;$igetColWidth(@{$self->{tbl_cols}}[$i]); + my $text = @{$row}[$i]; + + if ($isheader != 1 && defined($self->{tbl_align}{@{$self->{tbl_cols}}[$i]})) { + $contents .= ' '.$self->align( + $text, + $self->{tbl_align}{@{$self->{tbl_cols}}[$i]} || 'auto', + $colwidth-2, + ($self->{options}{allowHTML} || $self->{options}{allowANSI} || $self->{options}{cb_count}?0:1) + ).' '; + } elsif ($isheader == 1) { + + $contents .= ' '.$self->align( + $text, + $self->{tbl_colalign}{@{$self->{tbl_cols}}[$i]} || $self->{options}{alignHeadRow} || 'left', + $colwidth-2, + ($self->{options}{allowHTML} || $self->{options}{allowANSI} || $self->{options}{cb_count}?0:1) + ).' '; + } else { + $contents .= ' '.$self->align( + $text, + 'auto', + $colwidth-2, + ($self->{options}{allowHTML} || $self->{options}{allowANSI} || $self->{options}{cb_count}?0:1) + ).' '; + } + $contents .= $delim if ($i != scalar(@{$row}) - 1); + } + return $contents.$stop."\n"; +} + +=head2 draw([@topdesign,@toprow,@middle,@middlerow,@bottom,@rowline]) + +All the arrays containing the layout is optional. If you want to make your own "design" to the table, you +can do that by giving this method these arrays containing information about which characters to use +where. + +B + +The draw method takes C<6> arrays of strings to define the layout. The first, third, fifth and sixth is B +layout and the second and fourth is B layout. The C parameter is repeated for each row in the table. +The sixth parameter is only used if drawRowLine is enabled. + + $t->draw(,,,,,[]) + +=over 4 + +=item LINE + +Takes an array of C<4> strings. For example C<['|','|','-','+']> + +=over 4 + +=item * + +LEFT - Defines the left chars. May be more than one char. + +=item * + +RIGHT - Defines the right chars. May be more then one char. + +=item * + +LINE - Defines the char used for the line. B. + +=item * + +DELIMETER - Defines the char used for the delimeters. B. + +=back + +=item ROW + +Takes an array of C<3> strings. You should not give more than one char to any of these parameters, +if you do.. it will probably destroy the output.. Unless you do it with the knowledge +of how it will end up. An example: C<['|','|','+']> + +=over 4 + +=item * + +LEFT - Define the char used for the left side of the table. + +=item * + +RIGHT - Define the char used for the right side of the table. + +=item * + +DELIMETER - Defines the char used for the delimeters. + +=back + +=back + +Examples: + +The easiest way: + + print $t; + +Explanatory example: + + print $t->draw( ['L','R','l','D'], # LllllllDllllllR + ['L','R','D'], # L info D info R + ['L','R','l','D'], # LllllllDllllllR + ['L','R','D'], # L info D info R + ['L','R','l','D'] # LllllllDllllllR + ); + +Nice example: + + print $t->draw( ['.','.','-','-'], # .-------------. + ['|','|','|'], # | info | info | + ['|','|','-','-'], # |-------------| + ['|','|','|'], # | info | info | + [' \\','/ ','_','|'] # \_____|_____/ + ); + +Nice example2: + + print $t->draw( ['.=','=.','-','-'], # .=-----------=. + ['|','|','|'], # | info | info | + ['|=','=|','-','+'], # |=-----+-----=| + ['|','|','|'], # | info | info | + ["'=","='",'-','-'] # '=-----------=' + ); + +With Options: + + $t->setOptions('drawRowLine',1); + print $t->draw( ['.=','=.','-','-'], # .=-----------=. + ['|','|','|'], # | info | info | + ['|-','-|','=','='], # |-===========-| + ['|','|','|'], # | info | info | + ["'=","='",'-','-'], # '=-----------=' + ['|=','=|','-','+'] # rowseperator + ); + Which makes this output: + .=-----------=. + | col1 | col2 | + |-===========-| + | info | info | + |=-----+-----=| <-- rowseperator between each row + | info | info | + '=-----------=' + +A tips is to enable allowANSI, and use the extra charset in your terminal to create +a beautiful table. But don't expect to get good results if you use ANSI-formatted table +with $t->drawPage. + +B + +If you want to format your text more throughoutly than "auto", or think you +have a better way of aligning text; you can make your own subroutine. + + Here's a exampleroutine that aligns the text to the right. + + sub myownalign_cb { + my ($text,$length,$count,$strict) = @_; + $text = (" " x ($length - $count)) . $text; + return substr($text,0,$length) if ($strict); + return $text; + } + + $t->alignCol('Info',\&myownalign_cb); + +B + +This is a feature to use if you are not happy with the internal allowHTML or allowANSI +support. Given is an example of how you make a count-callback that makes ASCIITable support +ANSI codes inside the table. (would make the same result as setting allowANSI to 1) + + $t->setOptions('cb_count',\&myallowansi_cb); + sub myallowansi_cb { + $_=shift; + s/\33\[(\d+(;\d+)?)?[musfwhojBCDHRJK]//g; + return length($_); + } + +=cut + +sub drawit {scalar shift()->draw()} + +=head2 drawPage($page,@topdesign,@toprow,@middle,@middlerow,@bottom,@rowline) + +If you don't want your table to be wider than your screen you can use this +with $t->setOptions('outputWidth',40) to set the max size of the output. + +Example: + + $t->setOptions('outputWidth',80); + for my $page (1..$t->pageCount()) { + print $t->drawPage($page)."\n"; + print "continued..\n\n"; + } + +=cut + +sub drawPage { + my $self = shift; + my ($pagenum,$top,$toprow,$middle,$middlerow,$bottom,$rowline) = @_; + return $self->draw($top,$toprow,$middle,$middlerow,$bottom,$rowline,$pagenum); +} + +# Thanks to Khemir Nadim ibn Hamouda for code and idea. +sub getPart { + my ($self,$page,$text) = @_; + my $offset=0; + + return $text unless $page > 0; + $text =~ s/\n$//; + + $self->prepareParts() if (scalar(@{$self->{tbl_cuts}}) < 1); + $offset += (@{$self->{tbl_cuts}}[$_] - 1) for(0..$page-2); + + return substr($text, $offset, @{$self->{tbl_cuts}}[$page-1]) . "\n" ; +} + +sub draw { + my $self = shift; + my ($top,$toprow,$middle,$middlerow,$bottom,$rowline,$page) = @_; + my ($tstart,$tstop,$tline,$tdelim) = defined($top) ? @{$top} : @{$self->{des_top}}; + my ($trstart,$trstop,$trdelim) = defined($toprow) ? @{$toprow} : @{$self->{des_toprow}}; + my ($mstart,$mstop,$mline,$mdelim) = defined($middle) ? @{$middle} : @{$self->{des_middle}}; + my ($mrstart,$mrstop,$mrdelim) = defined($middlerow) ? @{$middlerow} : @{$self->{des_middlerow}}; + my ($bstart,$bstop,$bline,$bdelim) = defined($bottom) ? @{$bottom} : @{$self->{des_bottom}}; + my ($rstart,$rstop,$rline,$rdelim) = defined($rowline) ? @{$rowline} : @{$self->{des_rowline}}; + my $contents=""; $page = defined($page) ? $page : 0; + + delete $self->{cache_TableWidth}; # Clear cache + $self->calculateColWidths; + + $contents .= $self->getPart($page,$self->drawLine($tstart,$tstop,$tline,$tdelim)) unless $self->{options}{hide_FirstLine}; + if (defined($self->{options}{headingText})) { + my $title = $self->{options}{headingText}; + if ($title =~ m/\n/) { # Multiline title-support + my @lines = split(/\r?\n/,$title); + foreach my $line (@lines) { + $contents .= $self->getPart($page,$self->drawSingleColumnRow($line,$self->{options}{headingStartChar} || '|',$self->{options}{headingStopChar} || '|',$self->{options}{headingAlign} || 'center','title')); + } + } else { + $contents .= $self->getPart($page,$self->drawSingleColumnRow($self->{options}{headingText},$self->{options}{headingStartChar} || '|',$self->{options}{headingStopChar} || '|',$self->{options}{headingAlign} || 'center','title')); + } + $contents .= $self->getPart($page,$self->drawLine($mstart,$mstop,$mline,$mdelim)) unless $self->{options}{hide_HeadLine}; + } + + unless ($self->{options}{hide_HeadRow}) { + # multiline-column-support + foreach my $row (@{$self->{tbl_multilinecols}}) { + $contents .= $self->getPart($page,$self->drawRow($row,1,$trstart,$trstop,$trdelim)); + } + } + $contents .= $self->getPart($page,$self->drawLine($mstart,$mstop,$mline,$mdelim)) unless $self->{options}{hide_HeadLine}; + my $i=0; + for (@{$self->{tbl_rows}}) { + $i++; + $contents .= $self->getPart($page,$self->drawRow($_,0,$mrstart,$mrstop,$mrdelim)); + if (($self->{options}{drawRowLine} && $self->{tbl_rowline}{$i} && ($i != scalar(@{$self->{tbl_rows}}))) || + (defined($self->{tbl_lines}{$i}) && $self->{tbl_lines}{$i} && ($i != scalar(@{$self->{tbl_rows}})) && ($i != scalar(@{$self->{tbl_rows}})))) { + $contents .= $self->getPart($page,$self->drawLine($rstart,$rstop,$rline,$rdelim)) + } + } + $contents .= $self->getPart($page,$self->drawLine($bstart,$bstop,$bline,$bdelim)) unless $self->{options}{hide_LastLine}; + + return $contents; +} + +# nifty subs + +# Replaces length() because of optional HTML and ANSI stripping +sub count { + my ($self,$str) = @_; + + if (defined($self->{options}{cb_count}) && ref($self->{options}{cb_count}) eq 'CODE') { + my $ret = eval { return &{$self->{options}{cb_count}}($str); }; + return $ret if (!$@); + do { $self->reperror("Error: 'cb_count' callback returned error, ".$@); return 1; } if ($@); + } + elsif (defined($self->{options}{cb_count}) && ref($self->{options}{cb_count}) ne 'CODE') { + $self->reperror("Error: 'cb_count' set but no valid callback found, found ".ref($self->{options}{cb_count})); + return length($str); + } + $str =~ s/<.+?>//g if $self->{options}{allowHTML}; + $str =~ s/\33\[(\d+(;\d+)?)?[musfwhojBCDHRJK]//g if $self->{options}{allowANSI}; # maybe i should only have allowed ESC[#;#m and not things not related to + $str =~ s/\33\([0B]//g if $self->{options}{allowANSI}; # color/bold/underline.. But I want to give people as much room as they need. + + return length($str); +} + +sub align { + + my ($self,$text,$dir,$length,$strict) = @_; + + if ($dir =~ /auto/i) { + if ($text =~ /^-?\d+([.,]\d+)*[%\w]?$/) { + $dir = 'right'; + } else { + $dir = 'left'; + } + } + if (ref($dir) eq 'CODE') { + my $ret = eval { return &{$dir}($text,$length,$self->count($text),$strict); }; + return 'CB-ERR' if ($@); + # Removed in v0.14 # return 'CB-LEN-ERR' if ($self->count($ret) != $length); + return $ret; + } elsif ($dir =~ /right/i) { + my $visuallen = $self->count($text); + my $reallen = length($text); + if ($length - $visuallen > 0) { + $text = (" " x ($length - $visuallen)).$text; + } + return substr($text,0,$length - ($visuallen-$reallen)) if ($strict); + return $text; + } elsif ($dir =~ /left/i) { + my $visuallen = $self->count($text); + my $reallen = length($text); + if ($length - $visuallen > 0) { + $text = $text.(" " x ($length - $visuallen)); + } + return substr($text,0,$length - ($visuallen-$reallen)) if ($strict); + return $text; + } elsif ($dir =~ /justify/i) { + my $visuallen = $self->count($text); + my $reallen = length($text); + $text = substr($text,0,$length - ($visuallen-$reallen)) if ($strict); + if ($self->count($text) < $length - ($visuallen-$reallen)) { + $text =~ s/^\s+//; # trailing whitespace + $text =~ s/\s+$//; # tailing whitespace + + my @tmp = split(/\s+/,$text); # split them words + + if (scalar(@tmp)) { + my $extra = $length - $self->count(join('',@tmp)); # Length of text without spaces + + my $modulus = $extra % (scalar(@tmp)); # modulus + $extra = int($extra / (scalar(@tmp))); # for each word + + $text = ''; + foreach my $word (@tmp) { + $text .= $word . (' ' x $extra); # each word + if ($modulus) { + $modulus--; + $text .= ' '; # the first $modulus words, to even out + } + } + } + } + return $text; # either way, output text + } elsif ($dir =~ /center/i) { + my $visuallen = $self->count($text); + my $reallen = length($text); + my $left = ( $length - $visuallen ) / 2; + # Someone tell me if this is matematecally totally wrong. :P + $left = int($left) + 1 if ($left != int($left) && $left > 0.4); + my $right = int(( $length - $visuallen ) / 2); + $text = ($left > 0 ? " " x $left : '').$text.($right > 0 ? " " x $right : ''); + return substr($text,0,$length) if ($strict); + return $text; + } else { + return $self->align($text,'auto',$length,$strict); + } +} + +sub TIEARRAY { + my $self = shift; + + return bless { workaround => $self } , ref $self; +} +sub FETCH { + shift->{workaround}->reperror('usage: push @$t,qw{ one more row };'); + return undef; +} +sub STORE { + my $self = shift->{workaround}; + my ($index, $value) = @_; + + $self->reperror('usage: push @$t,qw{ one more row };'); +} +sub FETCHSIZE {return 0;} +sub STORESIZE {return;} + +# PodMaster should be really happy now, since this was in his wishlist. (ref: http://perlmonks.thepen.com/338456.html) +sub PUSH { + my $self = shift->{workaround}; + my @list = @_; + + if (scalar(@list) > scalar(@{$self->{tbl_cols}})) { + $self->reperror("too many elements added"); + return; + } + + $self->addRow(@list); +} + +sub reperror { + my $self = shift; + print STDERR Carp::shortmess(shift) if $self->{options}{reportErrors}; +} + +# Best way I could think of, to search the array.. Please tell me if you got a better way. +sub find { + return undef unless defined $_[1]; + grep {return $_ if @{$_[1]}[$_] eq $_[0];} (0..scalar(@{$_[1]})-1); + return undef; +} + +1; + +__END__ + +=head1 FEATURES + +In case you need to know if this module has what you need, I have made this list +of features included in Text::ASCIITable. + +=over 4 + +=item Configurable layout + +You can easily alter how the table should look, in many ways. There are a few examples +in the draw() section of this documentation. And you can remove parts of the layout +or even add a heading-part to the table. + +=item Text Aligning + +Align the text in a column auto(matically), left, right, center or justify. Usually you want to align text +to right if you only have numbers in that row. The 'auto' direction aligns text to left, and numbers +to the right. The 'justify' alignment evens out your text on each line, so the first and the last word +always are at the beginning and the end of the current line. This gives you the newspaper paragraph look. +You can also use your own subroutine as a callback-function to align your text. + +=item Multiline support in rows + +With the \n(ewline) character you can have rows use more than just one line on +the output. (This looks nice with the drawRowLine option enabled) + +=item Wordwrap support + +You can set a column to not be wider than a set amount of characters. If a line exceedes +for example 30 characters, the line will be broken up in several lines. + +=item HTML support + +If you put in tags inside the rows, the output would usually be broken when +viewed in a browser, since the browser "execute" the tags instead of displaying it. +But if you enable allowHTML. You are able to write html tags inside the rows without the +output being broken if you display it in a browser. But you should not mix this with +wordwrap, since this could make undesirable results. + +=item ANSI support + +Allows you to decorate your tables with colors or bold/underline when you display +your tables to a terminal window. + +=item Page-flipping support + +If you don't want the table to get wider than your terminal-width. + +=item Errorreporting + +If you write a script in perl, and don't want users to be notified of the errormessages +from Text::ASCIITable. You can easily turn of error reporting by setting reportErrors to 0. +You will still get an 1 instead of undef returned from the function. + +=back + +=head1 REQUIRES + +Exporter, Carp + +=head1 AUTHOR + +Håkon Nessjøen, + +=head1 VERSION + +Current version is 0.22. + +=head1 COPYRIGHT + +Copyright 2002-2011 by Håkon Nessjøen. +All rights reserved. +This module is free software; +you can redistribute it and/or modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +Text::FormatTable, Text::Table, Text::SimpleTable + +=cut diff --git a/vendor_perl/Text/ASCIITable/Wrap.pm b/vendor_perl/Text/ASCIITable/Wrap.pm new file mode 100644 index 000000000..9080f5981 --- /dev/null +++ b/vendor_perl/Text/ASCIITable/Wrap.pm @@ -0,0 +1,99 @@ +package Text::ASCIITable::Wrap; + +@ISA=qw(Exporter); +@EXPORT = qw(); +@EXPORT_OK = qw(wrap); +$VERSION = '0.2'; +use Exporter; +use strict; +use Carp; + +=encoding utf8 + +=head1 NAME + +Text::ASCIITable::Wrap - Wrap text + +=head1 SHORT DESCRIPTION + +Make sure a text never gets wider than the specified width using wordwrap. + +=head1 SYNOPSIS + + use Text::ASCIITable::Wrap qw{ wrap }; + print wrap('This is a long line which will be cut down to several lines',10); + +=head1 FUNCTIONS + +=head2 wrap($text,$width[,$nostrict]) (exportable) + +Wraps text at the specified width. Unless the $nostrict parameter is set, it +will cut down the word if a word is wider than $width. Also supports text with linebreaks. + +=cut + +sub wrap { + my ($text,$width,$nostrict) = @_; + Carp::shortmess('Missing required text or width parameter.') if (!defined($text) || !defined($width)); + my $result=''; + for (split(/\n/,$text)) { + $result .= _wrap($_,$width,$nostrict)."\n"; + } + chop($result); + return $result; +} + +sub _wrap { + my ($text,$width,$nostrict) = @_; + my @result; + my $line=''; + $nostrict = defined($nostrict) && $nostrict == 1 ? 1 : 0; + for (split(/ /,$text)) { + my $spc = $line eq '' ? 0 : 1; + my $len = length($line); + my $newlen = $len + $spc + length($_); + if ($len == 0 && $newlen > $width) { + push @result, $nostrict == 1 ? $_ : substr($_,0,$width); # kutt ned bredden + $line=''; + } + elsif ($len != 0 && $newlen > $width) { + push @result, $nostrict == 1 ? $line : substr($line,0,$width); + $line = $_; + } else { + $line .= (' ' x $spc).$_; + } + } + push @result,$nostrict == 1 ? $line : substr($line,0,$width) if $line ne ''; + return join("\n",@result); +} + + +1; + +__END__ + +=head1 REQUIRES + +Exporter, Carp + +=head1 AUTHOR + +Hkon Nessjen, lunatic@cpan.org + +=head1 VERSION + +Current version is 0.2. + +=head1 COPYRIGHT + +Copyright 2002-2003 by Hkon Nessjen. +All rights reserved. +This module is free software; +you can redistribute it and/or modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +Text::ASCIITable, Text::Wrap + +=cut + From 7059e04c92d00cc44107f746a06c93faa88eff94 Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Sun, 9 Aug 2026 14:39:03 +0200 Subject: [PATCH 12/24] Fix not to print double error --- setup.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/setup.pl b/setup.pl index 274f14840..7ed68e1b3 100755 --- a/setup.pl +++ b/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"; From 199dae256268a1409a7da9fc5ca4a269e776c33b Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Sun, 9 Aug 2026 15:27:13 +0200 Subject: [PATCH 13/24] Remove bundled Miniserv certificate and safely fall back to HTTP --- lang/en | 1 + makedist.pl | 2 +- miniserv.pem | 49 ---------------------------------- pam_login.cgi | 24 ++++++++++------- session_login.cgi | 24 ++++++++++------- setup.pl | 32 ++++++++++++++++++---- setup.sh | 44 ++++++++++++++++++++++++------ t/web-lib-funcs-default-cert.t | 42 +++++++++++++++++++++++++++++ usermin/edit_ssl.cgi | 4 +-- web-lib-funcs.pl | 14 +++++----- webmin/edit_ssl.cgi | 5 +--- 11 files changed, 146 insertions(+), 95 deletions(-) delete mode 100644 miniserv.pem create mode 100644 t/web-lib-funcs-default-cert.t diff --git a/lang/en b/lang/en index be1fa3b29..2247b5102 100644 --- a/lang/en +++ b/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 diff --git a/makedist.pl b/makedist.pl index 5b6040e3a..b12249254 100755 --- a/makedist.pl +++ b/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", diff --git a/miniserv.pem b/miniserv.pem deleted file mode 100644 index 16ef412af..000000000 --- a/miniserv.pem +++ /dev/null @@ -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----- diff --git a/pam_login.cgi b/pam_login.cgi index e0d139021..139c29007 100755 --- a/pam_login.cgi +++ b/pam_login.cgi @@ -74,15 +74,21 @@ 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'} }); +if ($ENV{'HTTPS'} ne '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'}; + } + $not_secure = ui_tag('span', $warning, + { class => 'not-secure', title => $description }); } print &ui_table_start($text{'pam_header'} . $not_secure, diff --git a/session_login.cgi b/session_login.cgi index ec7851bdf..ba4df2edf 100755 --- a/session_login.cgi +++ b/session_login.cgi @@ -94,15 +94,21 @@ 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'} }); +if ($ENV{'HTTPS'} ne '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'}; + } + $not_secure = ui_tag('span', $warning, + { class => 'not-secure', title => $description }); } print &ui_table_start($text{'session_header'} . $not_secure, diff --git a/setup.pl b/setup.pl index 7ed68e1b3..22edd1ca7 100755 --- a/setup.pl +++ b/setup.pl @@ -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 - ©_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"; diff --git a/setup.sh b/setup.sh index d235621c6..1cfbcee7c 100755 --- a/setup.sh +++ b/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 diff --git a/t/web-lib-funcs-default-cert.t b/t/web-lib-funcs-default-cert.t new file mode 100644 index 000000000..12aaed5a9 --- /dev/null +++ b/t/web-lib-funcs-default-cert.t @@ -0,0 +1,42 @@ +#!/usr/bin/perl +# Regression tests for detection of certificates bundled by older releases. + +use strict; +use warnings; +use Test::More; +use File::Basename qw(dirname); +use File::Spec; +use File::Temp qw(tempdir); + +my $script = File::Spec->rel2abs( + File::Spec->catfile(dirname(__FILE__), '..', 'web-lib-funcs.pl')); +require $script; + +my $cert = File::Spec->catfile(tempdir(CLEANUP => 1), 'miniserv.pem'); +open(my $fh, '>', $cert) or die "open($cert): $!"; +print {$fh} "legacy certificate fixture\n"; +close($fh) or die "close($cert): $!"; + +no warnings qw(redefine once); +my $digest = 'fcc4fc2ba3c00ede7008725668ff3af9'; +local *main::execute_command = sub { + my (undef, undef, $output) = @_; + ${$output} = "$digest $cert\n"; + $? = 0; + }; + +local $ENV{'HTTPS'} = 'OFF'; +ok(main::miniserv_using_default_cert($cert), + 'a formerly bundled certificate remains detectable without a bundled file'); + +$digest = '0123456789abcdef0123456789abcdef'; +ok(!main::miniserv_using_default_cert($cert), + 'a machine-generated certificate is not flagged'); + +local $ENV{'MINISERV_KEYFILE'} = $cert; +local $ENV{'HTTPS'} = 'ON'; +$digest = '2bb1926297df3d0429be3a4cd00b43ce'; +ok(main::miniserv_using_default_cert(), + 'HTTPS login detects the other legacy certificate'); + +done_testing(); diff --git a/usermin/edit_ssl.cgi b/usermin/edit_ssl.cgi index dbcb73df7..70212e50b 100755 --- a/usermin/edit_ssl.cgi +++ b/usermin/edit_ssl.cgi @@ -125,9 +125,7 @@ print &ui_tabs_end_tab(); # SSL key generation form print &ui_tabs_start_tab("mode", "create"); print "$text{'ssl_newkey'}

\n"; -my $curkey = &read_file_contents($miniserv{'keyfile'}); -my $origkey = &read_file_contents("$root_directory/miniserv.pem"); -if ($curkey eq $origkey) { +if (&miniserv_using_default_cert($miniserv{'keyfile'})) { # System is using the original (insecure) Webmin key! print "$text{'ssl_hole'}

\n"; } diff --git a/web-lib-funcs.pl b/web-lib-funcs.pl index 97f0d4571..2285cb49b 100755 --- a/web-lib-funcs.pl +++ b/web-lib-funcs.pl @@ -14367,21 +14367,21 @@ if (!%current_theme_info || $nocache) { return \%current_theme_info; } -# miniserv_using_default_cert() -# Returns 1 if miniserv is using one of the hard-coded certs +# miniserv_using_default_cert([certificate-file]) +# Returns 1 if miniserv is using one of the formerly bundled certificates sub miniserv_using_default_cert { -return 0 if ($ENV{'HTTPS'} ne 'ON'); +my ($currentcertfile) = @_; +return 0 if (!$currentcertfile && $ENV{'HTTPS'} ne 'ON'); my $defaultcertname = 'miniserv.pem'; -my $bundledcertfile = "$root_directory/$defaultcertname"; -my $currentcertfile = $ENV{'MINISERV_KEYFILE'}; +$currentcertfile ||= $ENV{'MINISERV_KEYFILE'}; if (!$currentcertfile) { my %miniserv; &get_miniserv_config(\%miniserv); $currentcertfile = $miniserv{'keyfile'}; } -if ( $currentcertfile =~ /$defaultcertname$/ && - -r $currentcertfile && -r $bundledcertfile) { +if ($currentcertfile && $currentcertfile =~ /\Q$defaultcertname\E$/ && + -r $currentcertfile) { my $out; &execute_command("md5sum ".quotemeta($currentcertfile), undef, \$out); return 0 if ($?); diff --git a/webmin/edit_ssl.cgi b/webmin/edit_ssl.cgi index c127fed5b..2d378ec6b 100755 --- a/webmin/edit_ssl.cgi +++ b/webmin/edit_ssl.cgi @@ -17,7 +17,6 @@ our $module_name; our $strong_ssl_ciphers; our $pfs_ssl_ciphers; our $info; -our $root_directory; our %config; our $letsencrypt_cmd; @@ -165,9 +164,7 @@ print ui_tabs_end_tab(); # SSL key generation form print ui_tabs_start_tab("mode", "create"); print "$text{'ssl_newkey'}

\n"; -my $curkey = read_file_contents($miniserv{'keyfile'}); -my $origkey = read_file_contents("$root_directory/miniserv.pem"); -if ($curkey eq $origkey) { +if (miniserv_using_default_cert($miniserv{'keyfile'})) { # System is using the original (insecure) Webmin key! print "$text{'ssl_hole'}

\n"; } From b7aed037587dde5d06865f17ad8a382c4b6e46f8 Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Sun, 9 Aug 2026 18:18:30 +0200 Subject: [PATCH 14/24] Fix to make logrotate vendor overrides work for API callers https://github.com/webmin/webmin/pull/2805#discussion_r3740632921 --- logrotate/logrotate-lib.pl | 116 +++++++++++++++++++++++++++++++------ logrotate/t/run-tests.t | 80 +++++++++++++++++++------ 2 files changed, 159 insertions(+), 37 deletions(-) diff --git a/logrotate/logrotate-lib.pl b/logrotate/logrotate-lib.pl index f1a2d1c60..b809543a8 100755 --- a/logrotate/logrotate-lib.pl +++ b/logrotate/logrotate-lib.pl @@ -109,12 +109,19 @@ sub copy_vendor_config { my ($source, $dest) = @_; -# An existing regular destination is already a usable override. Refuse a -# destination symlink or other file type so it cannot redirect this write. +# 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) { - &flush_logrotate_config_cache(); - return $dest; + if (&same_file($source, $dest)) { + &error(&text('save_evendorwrite', "". + &html_escape($source)."")); + } + else { + &flush_logrotate_config_cache(); + return $dest; + } } &error(&text('save_eoverride', "". &html_escape($dest)."")); @@ -428,8 +435,8 @@ return undef; } # save_directive(&parent, &old|name, &new, [indent]) -# Update a single entry in the config, identified by either name or -# the direcctive being replaced +# Updates one entry identified by either its name or parsed object. Vendor +# entries are transparently copied and rebound to their writable overrides. sub save_directive { my ($parent, $oldv, $newv, $indent) = @_; @@ -439,27 +446,100 @@ my $new = !defined($newv) ? undef : ref($newv) ? $newv : { 'name' => $old ? $old->{'name'} : $oldv, 'value' => $newv }; -# Refuse direct vendor writes even if a caller forgets to materialize the -# local copy first. New log sections may still be written to their explicit -# local file while the global defaults continue to come from the vendor file. +# Find the vendor file behind this write. Existing directives use their own +# file, while additions use the parent section or the effective main config. my $vendor_file; -if ($old) { - my $shadowed_vendor = &get_vendor_config_file($old->{'file'}); - if (&is_vendor_main_config($old->{'file'}) || - &is_vendor_config_file($old->{'file'})) { - $vendor_file = $old->{'file'}; +my $write_file = $old ? $old->{'file'} : $parent->{'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 && - &same_file($old->{'file'}, $shadowed_vendor)) { + &same_file($write_file, $shadowed_vendor)) { $vendor_file = $shadowed_vendor; } } -elsif (!$old && $new && !$new->{'members'} && $parent->{'global'} && +if (!$vendor_file && !$old && $new && !$new->{'members'} && + $parent->{'global'} && &is_vendor_main_config(&get_main_config_file())) { $vendor_file = &get_main_config_file(); } -&error(&text('save_evendorwrite', - "".&html_escape($vendor_file)."")) if ($vendor_file); + +# Materialize a writable override, then replace stale parsed references with +# their identical positions in the newly-parsed local configuration. Exact +# copying keeps both top-level and member indexes stable across this reparse. +if ($vendor_file) { + my $parent_global = $parent->{'global'}; + my $parent_index = $parent->{'index'}; + my $old_index = $old ? $old->{'index'} : undef; + my $old_line = $old ? $old->{'line'} : undef; + my $old_ref = ref($oldv) ? $oldv : undef; + my $local_file = &is_vendor_main_config($vendor_file) ? + &ensure_local_main_config() : + &ensure_local_config_override($vendor_file); + if (!$local_file || &same_file($local_file, $vendor_file)) { + &error(&text('save_evendorwrite', + "".&html_escape($vendor_file)."")); + } + my $fresh_root = &get_config_parent(); + my $fresh_parent = $parent_global ? $fresh_root : + $fresh_root->{'members'}->[$parent_index]; + + # Fail closed if concurrent configuration changes made the saved indexes + # unsafe to reuse. This must never fall through to the vendor line cache. + if (!$fresh_parent || + (!$parent_global && + (!&same_file($fresh_parent->{'file'}, $local_file) || + !$fresh_parent->{'members'}))) { + &error(&text('save_evendorwrite', + "".&html_escape($vendor_file)."")); + } + + # Preserve the caller's parent object identity so later saves, explicit + # flushes, and unlocks all refer to the new writable local file. + %$parent = %$fresh_parent; + if ($parent_global) { + $get_config_parent_cache = $parent; + $fresh_root = $parent; + } + else { + $fresh_root->{'members'}->[$parent_index] = $parent; + } + $conf = $parent->{'members'}; + + # A referenced old object may also contain the caller's pending edits, as + # when Virtualmin changes a section name and passes the same object twice. + # Keep its data and identity, but rebase all of its file ownership locally. + if ($old) { + my $fresh_old = $conf->[$old_index]; + if (!$fresh_old || $fresh_old->{'line'} != $old_line || + !&same_file($fresh_old->{'file'}, $local_file)) { + &error(&text('save_evendorwrite', + "".&html_escape($vendor_file)."")); + } + if ($old_ref) { + $old_ref->{'line'} = $fresh_old->{'line'}; + $old_ref->{'eline'} = $fresh_old->{'eline'}; + $old_ref->{'index'} = $fresh_old->{'index'}; + my @objects = ($old_ref); + while (@objects) { + my $object = shift(@objects); + $object->{'file'} = $local_file + if ($object->{'file'} && + &same_file($object->{'file'}, $vendor_file)); + push(@objects, @{$object->{'members'}}) + if ($object->{'members'}); + } + $conf->[$old_index] = $old_ref; + $old = $old_ref; + } + else { + $old = $fresh_old; + } + } + } my $lref = &read_file_lines($old ? $old->{'file'} : $parent->{'file'}); my @lines = &directive_lines($new, $indent) if ($new); diff --git a/logrotate/t/run-tests.t b/logrotate/t/run-tests.t index 11b0bcc2d..b0ac610de 100644 --- a/logrotate/t/run-tests.t +++ b/logrotate/t/run-tests.t @@ -162,22 +162,24 @@ is_deeply(log_names($config), [ '/var/log/vendor-main.log' ], 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 vendor configuration are rejected'); -} +# The public writer performs copy-on-write itself, so API consumers do not +# need to know whether the effective main configuration came from /usr/etc. +my $vendor_parent = main::get_config_parent(); +main::save_directive($vendor_parent, 'weekly', ''); +main::flush_file_lines($local_main_file); +is(read_text($local_main_file), $vendor_main_text, + 'direct main-config writes automatically create a local copy'); +is(read_text($vendor_main_file), $vendor_main_text, + 'automatic main-config copying leaves the vendor file unchanged'); +is(main::find('weekly', $vendor_parent->{'members'})->{'file'}, + $local_main_file, + 'the caller parent is rebound to the writable main config'); -# Editing global options materializes an exact local copy of the vendor main. +# Repeated preparation is harmless once the local main override exists. $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'); + 'an existing local main config remains the write target'); 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, @@ -185,12 +187,18 @@ is(read_text($vendor_main_file), $vendor_main_text, is(main::get_main_config_file(), $local_main_file, 'local main config takes precedence after it is created'); -# Editing a nested vendor drop-in copies the whole source file to the same -# relative path in the local tree and immediately switches parser ownership. +# A nested save through the public API copies the whole vendor drop-in to the +# same relative local path and immediately switches the caller's ownership. my $vendor_dropin = "$vendor_add_dir/deep/vendor"; my $local_dropin = "$local_add_dir/deep/vendor"; -is(main::ensure_local_config_override($vendor_dropin), $local_dropin, - 'editing a vendor drop-in creates its matching local override'); +($config, undef, $files) = main::get_config(); +my ($deep_log) = grep { $_->{'members'} && + $_->{'name'}->[0] eq '/var/log/deep-vendor.log' } + @$config; +main::save_directive($deep_log, 'monthly', '', "\t"); +main::flush_file_lines($local_dropin); +is($deep_log->{'file'}, $local_dropin, + 'nested vendor writes transparently rebind the caller locally'); 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, @@ -199,12 +207,29 @@ 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(); -my ($deep_log) = grep { $_->{'members'} && - $_->{'name'}->[0] eq '/var/log/deep-vendor.log' } - @$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'); +# Whole-section callers may mutate and pass the same parsed object as both +# old and new. Preserve those edits while changing its file ownership. +my $vendor_one = "$vendor_add_dir/one"; +my $local_one = "$local_add_dir/one"; +my ($one_log) = grep { $_->{'members'} && + $_->{'name'}->[0] eq '/var/log/vendor-one.log' } + @$config; +push(@{$one_log->{'name'}}, '/var/log/vendor-one-extra.log'); +main::save_directive(main::get_config_parent(), $one_log, $one_log); +main::flush_file_lines($local_one); +is($one_log->{'file'}, $local_one, + 'whole-section saves preserve the caller object and move it locally'); +like(read_text($local_one), qr{/var/log/vendor-one-extra\.log}, + 'whole-section saves preserve pending caller edits'); +unlike(read_text($vendor_one), qr{/var/log/vendor-one-extra\.log}, + 'whole-section saves never change the vendor source'); + # 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, ''); @@ -250,4 +275,21 @@ is_deeply([ main::get_add_file_configs() ], [ "$edge_local_dir/linked" ], 'local existing path overrides the matching vendor file'); } +# 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(); From 6afba8bc12e9307b8f92b286cd8e4d50107d50c3 Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Sun, 9 Aug 2026 22:13:20 +0200 Subject: [PATCH 15/24] Fix to add login lib with reusable login warning https://github.com/webmin/webmin/pull/2812#discussion_r3744668133 --- login-lib.pl | 27 +++++++++++++++++++++++++++ makedist.pl | 2 +- pam_login.cgi | 20 ++------------------ session_login.cgi | 19 ++----------------- 4 files changed, 32 insertions(+), 36 deletions(-) create mode 100755 login-lib.pl diff --git a/login-lib.pl b/login-lib.pl new file mode 100755 index 000000000..eb22a83b6 --- /dev/null +++ b/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; diff --git a/makedist.pl b/makedist.pl index b12249254..6f8175433 100755 --- a/makedist.pl +++ b/makedist.pl @@ -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", diff --git a/pam_login.cgi b/pam_login.cgi index 139c29007..4b3b40814 100755 --- a/pam_login.cgi +++ b/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,23 +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'} || !$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'}; - } - $not_secure = ui_tag('span', $warning, - { class => 'not-secure', title => $description }); - } +my $not_secure = &get_login_http_warning(\%miniserv); print &ui_table_start($text{'pam_header'} . $not_secure, "width=40% class='loginform'", 2); @@ -159,4 +144,3 @@ EOF } &ui_print_footer(); - diff --git a/session_login.cgi b/session_login.cgi index ba4df2edf..31e7a48df 100755 --- a/session_login.cgi +++ b/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,23 +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'} || !$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'}; - } - $not_secure = ui_tag('span', $warning, - { class => 'not-secure', title => $description }); - } +my $not_secure = &get_login_http_warning(\%miniserv); print &ui_table_start($text{'session_header'} . $not_secure, "width=40% class='loginform'", 2); From 07f0ddfb6dcf4a7bd2cf010d9dff0f2e612eca9b Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Mon, 10 Aug 2026 21:37:11 +0200 Subject: [PATCH 16/24] Add shared test file helpers --- logrotate/t/run-tests.t | 30 ++++++------------------------ t/test-lib.pl | 28 ++++++++++++++++++++++++++++ 2 files changed, 34 insertions(+), 24 deletions(-) create mode 100644 t/test-lib.pl diff --git a/logrotate/t/run-tests.t b/logrotate/t/run-tests.t index b0ac610de..7e86a599c 100644 --- a/logrotate/t/run-tests.t +++ b/logrotate/t/run-tests.t @@ -7,9 +7,13 @@ use File::Basename qw(dirname); use File::Path qw(make_path); use File::Temp qw(tempdir); -# Build an isolated openSUSE-style /etc and /usr/etc configuration layout. -my $module_dir = abs_path(dirname(abs_path($0))."/.."); +# 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); @@ -22,28 +26,6 @@ make_path("$config_dir/logrotate", $local_add_dir, "$local_add_dir/nested", "$vendor_add_dir/deep", "$vendor_add_dir/nested", dirname($wrapper)); -# write_text(file, contents) -# Writes a text fixture and fails the test immediately on an I/O error -sub write_text -{ -my ($file, $text) = @_; -open(my $fh, ">", $file) or die "open $file: $!"; -print $fh $text; -close($fh) or die "close $file: $!"; -} - -# read_text(file) -# Returns the complete contents of a text fixture -sub read_text -{ -my ($file) = @_; -open(my $fh, "<", $file) or die "open $file: $!"; -local $/; -my $text = <$fh>; -close($fh) or die "close $file: $!"; -return $text; -} - # 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 = diff --git a/t/test-lib.pl b/t/test-lib.pl new file mode 100644 index 000000000..d3611e8ee --- /dev/null +++ b/t/test-lib.pl @@ -0,0 +1,28 @@ +# Common helpers for Webmin tests. + +use strict; +use warnings; + +# write_text(file, contents) +# Writes a text fixture and fails the test immediately on an I/O error +sub write_text +{ +my ($file, $text) = @_; +open(my $fh, ">", $file) or die "open $file: $!"; +print $fh $text; +close($fh) or die "close $file: $!"; +} + +# read_text(file) +# Returns the complete contents of a text fixture +sub read_text +{ +my ($file) = @_; +open(my $fh, "<", $file) or die "open $file: $!"; +local $/; +my $text = <$fh>; +close($fh) or die "close $file: $!"; +return $text; +} + +1; From cceda25a60a76270183f2fef72ff861d38a24c85 Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Mon, 10 Aug 2026 23:09:09 +0200 Subject: [PATCH 17/24] Fix to restrict live deletion to virtual network devices https://github.com/webmin/webmin/pull/2795 --- net/linux-lib.pl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/net/linux-lib.pl b/net/linux-lib.pl index 4c4be648d..5f879f310 100755 --- a/net/linux-lib.pl +++ b/net/linux-lib.pl @@ -617,10 +617,10 @@ else { sub destroy_interface_device { my ($a) = @_; +my $name = $a->{'fullname'} || $a->{'name'}; if (&has_command("ip") && $a->{'virtual'} eq '' && - (&use_ifup_command($a) || $a->{'bridge'})) { - &backquote_logged("ip link delete ". - quotemeta($a->{'fullname'} || $a->{'name'})." 2>&1"); + &iface_type($name) =~ /(?:Bonded|VLAN|Bridge)$/) { + &backquote_logged("ip link delete ".quotemeta($name)." 2>&1"); } } From bd0f9f9e5f6b5d76ba4720ad16cb52eeb40b67c4 Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Mon, 10 Aug 2026 23:17:25 +0200 Subject: [PATCH 18/24] Fix to report virtual interface deletion failures --- net/linux-lib.pl | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/net/linux-lib.pl b/net/linux-lib.pl index 5f879f310..4bbb78f22 100755 --- a/net/linux-lib.pl +++ b/net/linux-lib.pl @@ -620,7 +620,9 @@ my ($a) = @_; my $name = $a->{'fullname'} || $a->{'name'}; if (&has_command("ip") && $a->{'virtual'} eq '' && &iface_type($name) =~ /(?:Bonded|VLAN|Bridge)$/) { - &backquote_logged("ip link delete ".quotemeta($name)." 2>&1"); + my $out = &backquote_logged( + "ip link delete ".quotemeta($name)." 2>&1"); + &error("Failed to delete virtual interface : $out") if ($?); } } From 57aecbfc7976ae2cd09e6a0ad27e3f02771b45c4 Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Tue, 11 Aug 2026 03:09:26 +0200 Subject: [PATCH 19/24] Fix Fail2Ban jump lookup typo #2668 --- firewall/firewall-lib.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/firewall/firewall-lib.pl b/firewall/firewall-lib.pl index 7b3b5c069..f66adda43 100755 --- a/firewall/firewall-lib.pl +++ b/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); From 5969c33e060c042adbcd7c722aba6e8d2eb76116 Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Tue, 11 Aug 2026 20:24:38 +0200 Subject: [PATCH 20/24] Fix logrotate vendor override write handling --- logrotate/logrotate-lib.pl | 108 ++++++----------------- logrotate/save_log.cgi | 35 ++++++-- logrotate/t/run-tests.t | 176 +++++++++++++++++++++++++++++-------- 3 files changed, 192 insertions(+), 127 deletions(-) diff --git a/logrotate/logrotate-lib.pl b/logrotate/logrotate-lib.pl index b809543a8..c4689a03c 100755 --- a/logrotate/logrotate-lib.pl +++ b/logrotate/logrotate-lib.pl @@ -435,8 +435,7 @@ return undef; } # save_directive(&parent, &old|name, &new, [indent]) -# Updates one entry identified by either its name or parsed object. Vendor -# entries are transparently copied and rebound to their writable overrides. +# Updates one entry identified by either its name or parsed object sub save_directive { my ($parent, $oldv, $newv, $indent) = @_; @@ -446,10 +445,22 @@ my $new = !defined($newv) ? undef : ref($newv) ? $newv : { 'name' => $old ? $old->{'name'} : $oldv, 'value' => $newv }; -# Find the vendor file behind this write. Existing directives use their own -# file, while additions use the parent section or the effective main config. +# 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 = $old ? $old->{'file'} : $parent->{'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) || @@ -457,91 +468,24 @@ if ($write_file) { $vendor_file = $write_file; } elsif ($shadowed_vendor && - &same_file($write_file, $shadowed_vendor)) { + (!-f $write_file || -l $write_file || + &same_file($write_file, $shadowed_vendor))) { $vendor_file = $shadowed_vendor; } } -if (!$vendor_file && !$old && $new && !$new->{'members'} && - $parent->{'global'} && +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(); } -# Materialize a writable override, then replace stale parsed references with -# their identical positions in the newly-parsed local configuration. Exact -# copying keeps both top-level and member indexes stable across this reparse. -if ($vendor_file) { - my $parent_global = $parent->{'global'}; - my $parent_index = $parent->{'index'}; - my $old_index = $old ? $old->{'index'} : undef; - my $old_line = $old ? $old->{'line'} : undef; - my $old_ref = ref($oldv) ? $oldv : undef; - my $local_file = &is_vendor_main_config($vendor_file) ? - &ensure_local_main_config() : - &ensure_local_config_override($vendor_file); - if (!$local_file || &same_file($local_file, $vendor_file)) { - &error(&text('save_evendorwrite', - "".&html_escape($vendor_file)."")); - } - my $fresh_root = &get_config_parent(); - my $fresh_parent = $parent_global ? $fresh_root : - $fresh_root->{'members'}->[$parent_index]; +# 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', + "".&html_escape($vendor_file)."")) if ($vendor_file); - # Fail closed if concurrent configuration changes made the saved indexes - # unsafe to reuse. This must never fall through to the vendor line cache. - if (!$fresh_parent || - (!$parent_global && - (!&same_file($fresh_parent->{'file'}, $local_file) || - !$fresh_parent->{'members'}))) { - &error(&text('save_evendorwrite', - "".&html_escape($vendor_file)."")); - } - - # Preserve the caller's parent object identity so later saves, explicit - # flushes, and unlocks all refer to the new writable local file. - %$parent = %$fresh_parent; - if ($parent_global) { - $get_config_parent_cache = $parent; - $fresh_root = $parent; - } - else { - $fresh_root->{'members'}->[$parent_index] = $parent; - } - $conf = $parent->{'members'}; - - # A referenced old object may also contain the caller's pending edits, as - # when Virtualmin changes a section name and passes the same object twice. - # Keep its data and identity, but rebase all of its file ownership locally. - if ($old) { - my $fresh_old = $conf->[$old_index]; - if (!$fresh_old || $fresh_old->{'line'} != $old_line || - !&same_file($fresh_old->{'file'}, $local_file)) { - &error(&text('save_evendorwrite', - "".&html_escape($vendor_file)."")); - } - if ($old_ref) { - $old_ref->{'line'} = $fresh_old->{'line'}; - $old_ref->{'eline'} = $fresh_old->{'eline'}; - $old_ref->{'index'} = $fresh_old->{'index'}; - my @objects = ($old_ref); - while (@objects) { - my $object = shift(@objects); - $object->{'file'} = $local_file - if ($object->{'file'} && - &same_file($object->{'file'}, $vendor_file)); - push(@objects, @{$object->{'members'}}) - if ($object->{'members'}); - } - $conf->[$old_index] = $old_ref; - $old = $old_ref; - } - else { - $old = $fresh_old; - } - } - } - -my $lref = &read_file_lines($old ? $old->{'file'} : $parent->{'file'}); +my $lref = &read_file_lines($write_file); my @lines = &directive_lines($new, $indent) if ($new); my $gparent = &get_config_parent(); if ($old && $new) { diff --git a/logrotate/save_log.cgi b/logrotate/save_log.cgi index f3691bdee..0be324331 100755 --- a/logrotate/save_log.cgi +++ b/logrotate/save_log.cgi @@ -5,6 +5,32 @@ 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. @@ -20,16 +46,14 @@ if (!$in{'global'} && !$in{'new'} && !$in{'now'} && $parent = &get_config_parent(); $conf = $parent->{'members'}; } -@files = split(/\s+/, $in{'file'}); 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 { @@ -66,11 +90,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'}) ]; } diff --git a/logrotate/t/run-tests.t b/logrotate/t/run-tests.t index 7e86a599c..9ab92d237 100644 --- a/logrotate/t/run-tests.t +++ b/logrotate/t/run-tests.t @@ -144,24 +144,96 @@ is_deeply(log_names($config), [ '/var/log/vendor-main.log' ], is_deeply($files, [ $vendor_main_file ], 'file cache excludes external directories when scanning is disabled'); -# The public writer performs copy-on-write itself, so API consumers do not -# need to know whether the effective main configuration came from /usr/etc. -my $vendor_parent = main::get_config_parent(); -main::save_directive($vendor_parent, 'weekly', ''); -main::flush_file_lines($local_main_file); -is(read_text($local_main_file), $vendor_main_text, - 'direct main-config writes automatically create a local copy'); -is(read_text($vendor_main_file), $vendor_main_text, - 'automatic main-config copying leaves the vendor file unchanged'); -is(main::find('weekly', $vendor_parent->{'members'})->{'file'}, - $local_main_file, - 'the caller parent is rebound to the writable main config'); +# 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'); +} -# Repeated preparation is harmless once the local main override exists. +# 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, - 'an existing local main config remains the write target'); + '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, @@ -169,18 +241,40 @@ is(read_text($vendor_main_file), $vendor_main_text, is(main::get_main_config_file(), $local_main_file, 'local main config takes precedence after it is created'); -# A nested save through the public API copies the whole vendor drop-in to the -# same relative local path and immediately switches the caller's ownership. +# 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; -main::save_directive($deep_log, 'monthly', '', "\t"); -main::flush_file_lines($local_dropin); -is($deep_log->{'file'}, $local_dropin, - 'nested vendor writes transparently rebind the caller locally'); +{ +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, @@ -194,23 +288,12 @@ is(main::get_vendor_config_file($local_dropin), $vendor_dropin, @$config; is($deep_log->{'file'}, $local_dropin, 'parser switches to the local copy after an override is created'); - -# Whole-section callers may mutate and pass the same parsed object as both -# old and new. Preserve those edits while changing its file ownership. -my $vendor_one = "$vendor_add_dir/one"; -my $local_one = "$local_add_dir/one"; -my ($one_log) = grep { $_->{'members'} && - $_->{'name'}->[0] eq '/var/log/vendor-one.log' } - @$config; -push(@{$one_log->{'name'}}, '/var/log/vendor-one-extra.log'); -main::save_directive(main::get_config_parent(), $one_log, $one_log); -main::flush_file_lines($local_one); -is($one_log->{'file'}, $local_one, - 'whole-section saves preserve the caller object and move it locally'); -like(read_text($local_one), qr{/var/log/vendor-one-extra\.log}, - 'whole-section saves preserve pending caller edits'); -unlike(read_text($vendor_one), qr{/var/log/vendor-one-extra\.log}, - 'whole-section saves never change the vendor source'); +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. @@ -255,6 +338,25 @@ 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 From 25bb1def50fec1f065647f31558146ab6c01268f Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Thu, 13 Aug 2026 04:41:27 +0200 Subject: [PATCH 21/24] Add ability to use `vfsv1` for newly created Linux quota files This PR adds ability to use the `vfsv1` quota format for newly created user and group quota files when supported by quota-tools 4 or newer. This removes the `vfsv0` range limitation while preserving existing quota files and configured journal formats. Quota creation remains scoped to the requested user or group type, safely normalizes configured `quotacheck` flags, and retains `vfsv0` and legacy fallbacks for compatibility. Addresses issue report in: https://forum.virtualmin.com/t/quota-out-of-range/137331?u=ilia --- mount/linux-lib.pl | 25 ++++++++- quota/linux-lib.pl | 80 ++++++++++++++++++--------- quota/t/run-tests.t | 131 ++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 210 insertions(+), 26 deletions(-) diff --git a/mount/linux-lib.pl b/mount/linux-lib.pl index 26cd4524c..0a3af656b 100755 --- a/mount/linux-lib.pl +++ b/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 = ""; diff --git a/quota/linux-lib.pl b/quota/linux-lib.pl index 12e4d1d48..93757287c 100755 --- a/quota/linux-lib.pl +++ b/quota/linux-lib.pl @@ -295,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); @@ -321,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); @@ -356,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; @@ -379,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; } @@ -773,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 (!$?); } } diff --git a/quota/t/run-tests.t b/quota/t/run-tests.t index cc86becfe..f0bbad357 100644 --- a/quota/t/run-tests.t +++ b/quota/t/run-tests.t @@ -24,6 +24,9 @@ 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 { @@ -73,6 +76,134 @@ 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"); From 10094a7efb49182522bd387b7385a6fb7483724d Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Fri, 14 Aug 2026 01:08:41 +0200 Subject: [PATCH 22/24] Update changelog [no-build] --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 622ce722f..db4f438ad 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,8 @@ #### 2.654 (August, 2026) * Add incremental ban time options to the Fail2Ban module * Add Btrfs subvolume quota management to the Disk Quotas module, with full and simple accounting modes +* Add support for creating `vfsv1` Linux quota files for limits above 4 TiB, while preserving existing quota file formats +* Add support for openSUSE 16 vendor and local Logrotate configuration overlays [#2682](https://github.com/webmin/webmin/issues/2682) * 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) * Update the Authentic theme to the latest version with various improvements: From e695fbd0c756b54ddeebd41b1c1f5119c8f7a16d Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Fri, 14 Aug 2026 03:43:50 +0200 Subject: [PATCH 23/24] Add APT package hold management to Package Updates MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - Add an APT-only “Held updates” view while keeping held packages excluded from normal and scheduled updates. - Allow administrators to hold or unhold packages from package details. - Allow explicitly selected held packages to be updated once, then restore all existing package holds. - Preserve configured `aptitude` behavior for regular installs while using `apt-get` for the held-package override. Fixes #2689 --- package-updates/CHANGELOG | 2 + package-updates/index.cgi | 35 ++++--- package-updates/lang/en | 22 +++++ package-updates/log_parser.pl | 3 + package-updates/package-updates-lib.pl | 84 ++++++++++++++--- package-updates/save_view.cgi | 10 +- package-updates/update.cgi | 60 +++++++++++- package-updates/view.cgi | 17 +++- software/CHANGELOG | 1 + software/apt-lib.pl | 124 ++++++++++++++++++------- software/lang/en | 1 + t/software-apt.t | 112 +++++++++++++++++++++- 12 files changed, 404 insertions(+), 67 deletions(-) diff --git a/package-updates/CHANGELOG b/package-updates/CHANGELOG index c6dd08cd9..806fb24bd 100644 --- a/package-updates/CHANGELOG +++ b/package-updates/CHANGELOG @@ -1,3 +1,5 @@ +---- 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 ---- diff --git a/package-updates/index.cgi b/package-updates/index.cgi index 8df9e0eb5..e0f820d28 100755 --- a/package-updates/index.cgi +++ b/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, "$mmsg"); @@ -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 = "". - &text('index_new', $a->{'version'}).""; - $need = 1; + $msg = $a->{'held'} ? + "". + &text('index_held', $c->{'version'}, $a->{'version'}). + "" : + "". + &text('index_new', $a->{'version'}).""; + $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)),"
\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"), "
"; } + @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'} ], @@ -296,4 +308,3 @@ if ($has_repos) { print &ui_tabs_end(1); &ui_print_footer("/", $text{'index'}); - diff --git a/package-updates/lang/en b/package-updates/lang/en index df86114cf..c865d450a 100644 --- a/package-updates/lang/en +++ b/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 @@ -39,6 +41,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 +49,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 +104,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 +122,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 +150,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 +173,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 diff --git a/package-updates/log_parser.pl b/package-updates/log_parser.pl index fed1dbbd4..c5f7618ff 100644 --- a/package-updates/log_parser.pl +++ b/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'}; } diff --git a/package-updates/package-updates-lib.pl b/package-updates/package-updates-lib.pl index 54eed7eb2..9612d7397 100644 --- a/package-updates/package-updates-lib.pl +++ b/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"); @@ -308,30 +309,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 +388,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 +505,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 +523,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 +537,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 +749,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 +765,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); } diff --git a/package-updates/save_view.cgi b/package-updates/save_view.cgi index 2fd5f2866..fbff27020 100755 --- a/package-updates/save_view.cgi +++ b/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)); } diff --git a/package-updates/update.cgi b/package-updates/update.cgi index af66b8d30..4a2b88602 100755 --- a/package-updates/update.cgi +++ b/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)),"

\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 { "
\n"; print "

    \n"; @got = &package_install_multiple( - \@pkgnames, $pkgsystem, $in{'mode'} eq 'new', $in{'flags'}); + \@pkgnames, $pkgsystem, $in{'mode'} eq 'new', $install_flags); print "

\n"; } else { @@ -138,7 +190,7 @@ else { print &text($msg, "@{[&html_escape($p)]}"),"
\n"; print "
    \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}++; } diff --git a/package-updates/view.cgi b/package-updates/view.cgi index 52c00309d..a80702760 100755 --- a/package-updates/view.cgi +++ b/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 ? + "". + &text('index_held', $c->{'version'}, $a->{'version'})."" : + $held && $c ? "". + &text('view_held', $c->{'version'})."" : $a && !$c ? "$text{'index_caninstall'}" : !$a && $c ? "". &text('index_noupdate', $c->{'version'})."" : @@ -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=". diff --git a/software/CHANGELOG b/software/CHANGELOG index 988952cae..82ef37064 100644 --- a/software/CHANGELOG +++ b/software/CHANGELOG @@ -1,5 +1,6 @@ ---- Changes since 2.641 ---- Fix Alpine Linux mysql/mariadb package installs names due missing server utils (means at least Alpine Linux package installation is supported since Alpine linux v 3.16 up to edge) +Added APT functions for listing, holding, unholding and explicitly updating held packages. ---- Changes since 1.130 ---- Packages can now be installed directly from yum, if installed. The entire system can also be upgraded from yum. diff --git a/software/apt-lib.pl b/software/apt-lib.pl index e0f9f5add..ccf1ac286 100755 --- a/software/apt-lib.pl +++ b/software/apt-lib.pl @@ -20,20 +20,33 @@ $name =~ s/:[A-Za-z0-9][A-Za-z0-9._-]*$//; return $name; } -# update_system_install([package], [&in], [no-force]) +# update_system_install([package], [&in], [no-force], [flags]) # Install some package with apt sub update_system_install { local $update = $_[0] || $in{'update'}; local $force = !$_[2]; +local $flags = $_[3]; local (@rv, @newpacks); +# Only accept the one flag needed for an explicit update of held packages. +# Other update systems use this argument for their own package-manager flags, +# but APT historically ignored it. +local $holdflag = defined($flags) && + $flags eq '--allow-change-held-packages' + ? ' --allow-change-held-packages' + : ''; +local $install_command = $holdflag ? 'apt-get' : $apt_get_command; +local @rehold = $holdflag ? &list_update_system_holds() : ( ); + # Build the command to run $ENV{'UCF_FORCE_CONFFOLD'} = 'YES'; $ENV{'DEBIAN_FRONTEND'} = 'noninteractive'; -local $uicmd = "$apt_get_command -y ".($force ? " -f" : "")." install $update"; +local $uicmd = "$install_command -y".$holdflag. + ($force ? " -f" : "")." install $update"; $update = join(" ", map { quotemeta($_) } split(/\s+/, $update)); -local $cmd = "$apt_get_command -y ".($force ? " -f" : "")." install $update"; +local $cmd = "$install_command -y".$holdflag. + ($force ? " -f" : "")." install $update"; print &text('apt_install', "".&html_escape($uicmd).""),"\n"; print "
    ";
 &additional_log('exec', undef, $cmd);
@@ -68,14 +81,27 @@ while() {
 	print &html_escape("$_");
 	}
 close(CMD);
+local $status = $?;
+
+# Restore holds after --allow-change-held-packages, which applies to the whole
+# transaction and can clear holds on selected packages or dependencies.
+if (@rehold) {
+	local $rehold_error = &update_system_hold(\@rehold, 1);
+	if ($rehold_error) {
+		print &text('apt_reholdfailed',
+			"".&html_escape(join(" ", @rehold))."",
+			&html_escape($rehold_error)),"
    \n";
+		}
+	}
 &reset_environment();
-if (!@rv && $config{'package_system'} ne 'debian' && !$?) {
+if (!@rv && $config{'package_system'} ne 'debian' && !$status) {
 	# Other systems don't list the packages installed!
 	@rv = @newpacks;
 	}
 print "
    \n"; -if ($?) { print "$text{'apt_failed'}

    \n"; } +if ($status) { print "$text{'apt_failed'}

    \n"; } else { print "$text{'apt_ok'}

    \n"; } +$? = $status; return @rv; } @@ -239,21 +265,13 @@ return @rv; # Returns a list of available package updates sub update_system_updates { +my ($include_holds) = @_; &execute_command("$apt_get_command update"); -# Find held packages by dpkg -local %holds; -if ($config{'package_system'} eq 'debian') { - &clean_language(); - &open_execute_command(HOLDS, "dpkg --get-selections", 1, 1); - while() { - if (/^(\S+)\s+hold/) { - $holds{$1}++; - } - } - close(HOLDS); - &reset_environment(); - } +# Find held packages. By default these remain excluded, but callers can ask +# for them so that a dedicated held-updates view can display them. +local %holds = map { &strip_apt_package_arch($_), 1 } + &list_update_system_holds(); if (&has_command("apt-show-versions")) { # This awesome command can give us all updates in one hit, and takes @@ -264,7 +282,7 @@ if (&has_command("apt-show-versions")) { &open_execute_command(PKGS, "apt-show-versions 2>/dev/null", 1, 1); while() { if (/^(\S+)\/(\S+)\s+upgradeable\s+from\s+(\S+)\s+to\s+(\S+)/ && - !$holds{$1}) { + ($include_holds || !$holds{&strip_apt_package_arch($1)})) { # Old format local $pkg = { 'name' => $1, 'source' => $2, @@ -272,9 +290,12 @@ if (&has_command("apt-show-versions")) { if ($pkg->{'version'} =~ s/^(\S+)://) { $pkg->{'epoch'} = $1; } + $pkg->{'held'} = 1 + if ($holds{&strip_apt_package_arch($pkg->{'name'})}); push(@rv, $pkg); } - elsif (/^(\S+):(\S+)\/(\S+)\s+(\S+)\s+upgradeable\s+to\s+(\S+)/ && !$holds{$1}) { + elsif (/^(\S+):(\S+)\/(\S+)\s+(\S+)\s+upgradeable\s+to\s+(\S+)/ && + ($include_holds || !$holds{$1})) { # New format, like # libgomp1:i386/unstable 4.8.2-2 upgradeable to 4.8.2-4 local $pkg = { 'name' => $1, @@ -284,12 +305,14 @@ if (&has_command("apt-show-versions")) { if ($pkg->{'version'} =~ s/^(\S+)://) { $pkg->{'epoch'} = $1; } + $pkg->{'held'} = 1 if ($holds{$pkg->{'name'}}); push(@rv, $pkg); } } close(PKGS); &reset_environment(); - @rv = &filter_held_packages(@rv); + @rv = grep { !$holds{&strip_apt_package_arch($_->{'name'})} } @rv + if (!$include_holds); foreach my $pkg (@rv) { $pkg->{'security'} = 1 if ($pkg->{'source'} =~ /security/i); } @@ -301,7 +324,8 @@ elsif (&has_command("apt")) { &clean_language(); &open_execute_command(PKGS, "apt list --upgradable 2>/dev/null", 1, 1); while() { - if (/^(\S+)\/(\S+)\s+(\S+)\s+(\S+)\s+\[upgradable\s+from:\s+(\S+)\]/ && !$holds{$1}) { + if (/^(\S+)\/(\S+)\s+(\S+)\s+(\S+)\s+\[upgradable\s+from:\s+(\S+)\]/ && + ($include_holds || !$holds{&strip_apt_package_arch($1)})) { local $pkg = { 'name' => $1, 'source' => $2, 'version' => $3, @@ -310,12 +334,15 @@ elsif (&has_command("apt")) { $pkg->{'epoch'} = $1; } $pkg->{'source'} =~ s/,.*$//; + $pkg->{'held'} = 1 + if ($holds{&strip_apt_package_arch($pkg->{'name'})}); push(@rv, $pkg); } } close(PKGS); &reset_environment(); - @rv = &filter_held_packages(@rv); + @rv = grep { !$holds{&strip_apt_package_arch($_->{'name'})} } @rv + if (!$include_holds); foreach my $pkg (@rv) { $pkg->{'security'} = 1 if ($pkg->{'source'} =~ /security/i); } @@ -334,7 +361,8 @@ else { $currentmap{$pkg->{'name'}} ||= $pkg; } local @rv; - local @names = grep { !$holds{$_} } keys %currentmap; + local @names = $include_holds ? keys %currentmap : + grep { !$holds{$_} } keys %currentmap; while(scalar(@names)) { local @somenames; if (scalar(@names) > 100) { @@ -371,6 +399,8 @@ else { &compare_versions($pkg->{'version'}, $pkg->{'oldversion'}); if ($newer > 0) { + $pkg->{'held'} = 1 + if ($holds{$pkg->{'name'}}); push(@rv, $pkg); } } @@ -378,7 +408,8 @@ else { close(PKGS); &reset_environment(); } - @rv = &filter_held_packages(@rv); + @rv = grep { !$holds{&strip_apt_package_arch($_->{'name'})} } @rv + if (!$include_holds); &set_pinned_versions(\@rv); return @rv; } @@ -411,11 +442,10 @@ close(PKGS); &reset_environment(); } -# filter_held_packages(package, ...) -# Returns a list of package updates, minus those that are held -sub filter_held_packages +# list_update_system_holds() +# Returns the unique names of all packages currently held by APT or dpkg. +sub list_update_system_holds { -my @pkgs = @_; my %hold; # Get holds from dpkg @@ -447,15 +477,47 @@ if (&has_command("apt-mark")) { &clean_language(); &open_execute_command(PKGS, "apt-mark showhold 2>/dev/null", 1, 1); while() { - if (/^([^:\s]+)/) { + if (/^(\S+)/) { $hold{$1} = 1; } } close(PKGS); &reset_environment(); } +return sort keys %hold; +} -return grep { !$hold{$_->{'name'}} } @pkgs; +# update_system_hold(&packages, hold) +# Holds or unholds a list of packages. Returns undef on success, or an error. +sub update_system_hold +{ +my ($packages, $hold) = @_; +return "The apt-mark command is not installed" + if (!&has_command("apt-mark")); +my @packages = &unique(@$packages); +return "No packages were specified" if (!@packages); +my $action = $hold ? 'hold' : 'unhold'; +my $cmd = "apt-mark $action ". + join(" ", map { quotemeta($_) } @packages); +my $out; +&clean_language(); +my $status = &execute_command_logged($cmd, undef, \$out, \$out); +&reset_environment(); +if ($status) { + $out = &trim($out); + return $out || "apt-mark $action failed"; + } +return undef; +} + +# filter_held_packages(package, ...) +# Returns a list of package updates, minus those that are held +sub filter_held_packages +{ +my @pkgs = @_; +my %hold = map { &strip_apt_package_arch($_), 1 } + &list_update_system_holds(); +return grep { !$hold{&strip_apt_package_arch($_->{'name'})} } @pkgs; } # list_package_repos() diff --git a/software/lang/en b/software/lang/en index 8a890e515..aa84dbace 100644 --- a/software/lang/en +++ b/software/lang/en @@ -235,6 +235,7 @@ apt_input=Package from APT apt_install=Installing package(s) with command $1 .. apt_ok=.. install complete apt_failed=.. install failed! +apt_reholdfailed=.. failed to restore the hold on $1 : $2 apt_form=Upgrade All Packages apt_header=APT package upgrade options apt_update=Resynchronize package list (update) diff --git a/t/software-apt.t b/t/software-apt.t index 1d91f976a..3e05ec256 100644 --- a/t/software-apt.t +++ b/t/software-apt.t @@ -8,6 +8,7 @@ use File::Spec; use Cwd qw(abs_path); our %config; +our $apt_get_command; my $root = abs_path(File::Spec->catdir(dirname(__FILE__), '..')); chdir($root) or die "chdir($root): $!"; @@ -39,11 +40,21 @@ is($ops[0]->{'name'}, 'libtinfo6', no warnings qw(once redefine); my $apt_output = "Setting up libtinfo6:amd64 (6.3-2ubuntu0.2) ...\n"; my $yes_input = ""; +my $executed_command = ""; +my @reheld; local *additional_log = sub { }; local *backquote_logged = sub { return ""; }; local *clean_language = sub { }; local *html_escape = sub { return $_[0]; }; local *reset_environment = sub { }; +local *list_update_system_holds = sub { + return ('libtinfo6:amd64', 'held-dependency:i386'); + }; +local *update_system_hold = sub { + my ($packages, $hold) = @_; + @reheld = @$packages if ($hold); + return undef; + }; local *text = sub { return $_[0]; }; local *transname = sub { return "/tmp/software-apt-test-yes"; }; local *open_tempfile = sub { @@ -64,19 +75,116 @@ local *close_tempfile = sub { close(ref($fh) ? $fh : \*{$fh}); }; local *open_execute_command = sub { - my ($fh) = @_; + my ($fh, $command) = @_; + $executed_command = $command; no strict 'refs'; open(ref($fh) ? $fh : \*{$fh}, "<", \$apt_output) or die "open simulated apt output: $!"; }; local $config{'package_system'} = 'debian'; +local $apt_get_command = 'aptitude'; my $printed = ""; open(my $stdout, ">", \$printed) or die "open captured stdout: $!"; local *STDOUT = $stdout; -my @installed = update_system_install('libtinfo6', undef, 1); +my @installed = update_system_install( + 'libtinfo6', undef, 1, '--allow-change-held-packages'); is_deeply(\@installed, [ 'libtinfo6' ], 'normalizes package names returned by apt install output'); +like($executed_command, qr/apt-get -y --allow-change-held-packages install/, + 'uses apt-get for the held-package override even in aptitude mode'); +is_deeply(\@reheld, [ 'libtinfo6:amd64', 'held-dependency:i386' ], + 'restores all exact holds after explicitly updating a held package'); + +$executed_command = ""; +@reheld = ( ); +update_system_install('libtinfo6', undef, 1); +like($executed_command, qr/^aptitude -y install/, + 'continues using configured aptitude mode for regular installs'); +is_deeply(\@reheld, [ ], 'does not reapply holds after a regular install'); +} + +{ +no warnings qw(once redefine); +local *clean_language = sub { }; +local *reset_environment = sub { }; +local *has_command = sub { + return $_[0] eq 'aptitude' || $_[0] eq 'apt-mark'; + }; +local *open_execute_command = sub { + my ($fh, $command) = @_; + my $output = $command =~ /^dpkg / ? + "alpha hold\ndelta:amd64 hold\n" : + $command =~ /^aptitude / ? + ".h beta 1.0 installed\n" : + $command =~ /^apt-mark / ? + "gamma\ndelta:amd64\n" : ""; + no strict 'refs'; + open(ref($fh) ? $fh : \*{$fh}, '<', \$output) + or die "open simulated holds: $!"; + }; + +is_deeply([ list_update_system_holds() ], + [ qw(alpha beta delta:amd64 gamma) ], + 'combines held packages without discarding architecture qualifiers'); +} + +{ +no warnings qw(once redefine); +my $apt_output = + "Listing...\n". + "held-pkg/stable 2.0 amd64 [upgradable from: 1.0]\n". + "regular-pkg/stable 3.0 amd64 [upgradable from: 2.0]\n"; +local *clean_language = sub { }; +local *reset_environment = sub { }; +local *execute_command = sub { return 0; }; +local *list_update_system_holds = sub { return ('held-pkg'); }; +local *has_command = sub { return $_[0] eq 'apt'; }; +local *open_execute_command = sub { + my ($fh, $command) = @_; + my $output = $command =~ /^apt list / ? $apt_output : ""; + no strict 'refs'; + open(ref($fh) ? $fh : \*{$fh}, '<', \$output) + or die "open simulated updates: $!"; + }; + +my @normal = update_system_updates(0); +is_deeply([ map { $_->{'name'} } @normal ], [ 'regular-pkg' ], + 'default APT updates still exclude held packages'); +my @with_holds = update_system_updates(1); +is_deeply([ map { $_->{'name'} } @with_holds ], + [ 'held-pkg', 'regular-pkg' ], + 'held-update query includes regular and held packages'); +ok($with_holds[0]->{'held'}, 'marks the held update'); +ok(!$with_holds[1]->{'held'}, 'does not mark a regular update as held'); +} + +{ +no warnings qw(once redefine); +my $command; +local *has_command = sub { return '/usr/bin/apt-mark'; }; +local *unique = sub { + my %seen; + return grep { !$seen{$_}++ } @_; + }; +local *trim = sub { + my ($value) = @_; + $value =~ s/^\s+|\s+$//g; + return $value; + }; +local *clean_language = sub { }; +local *reset_environment = sub { }; +local *execute_command_logged = sub { + my ($cmd, undef, $stdout) = @_; + $command = $cmd; + $$stdout = ""; + return 0; + }; + +is(update_system_hold([ 'webmin-virtual-server', 'webmin-virtual-server' ], 1), + undef, 'holds packages successfully'); +is($command, 'apt-mark hold webmin\-virtual\-server', + 'builds a quoted apt-mark hold command without duplicates'); } done_testing(); From cefb0b648025e3f92718294d9e5e7d214e431e6b Mon Sep 17 00:00:00 2001 From: Joe Cooper Date: Sat, 15 Aug 2026 01:35:02 -0500 Subject: [PATCH 24/24] Don't wait forever for a client that connects but never sends --- miniserv.pl | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/miniserv.pl b/miniserv.pl index efefad1df..3ad64bef7 100755 --- a/miniserv.pl +++ b/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);