Fix ACL permission checks and partial user saves

This PR fixes missing permission checks when saving global user and group access settings.

Unauthorized ACL changes are rejected before any files are written.

User saves now finish validation before changing group membership or copying permissions, preventing rejected saves from leaving partial changes.

acl/cert_issue.cgi

@@ -22,6 +22,7 @@ my $fh = "IN";
 &open_tempfile($fh, ">$temp1");
 foreach my $k ("emailAddress", "organizationalUnitName", "organizationName",
 	       "stateOrProvinceName", "countryName", "commonName") {
+	$in{$k} =~ /:|\n|\0/ && &error($text{'cert_echars'});
 	&print_tempfile($fh, "$k = $in{$k}\n");
 	}
 $in{'key'} =~ s/\s//g;
@@ -31,12 +32,12 @@ my $cmd = &get_ssleay();
 my $ssleay = &backquote_logged("$cmd ca -spkac $temp1 -out $temp2 -config $module_config_directory/openssl.cnf -days 1095 2>&1");
 &unlink_file($temp1);
 if ($?) {
-	&error("<pre>$ssleay</pre>");
+	&error("<pre>".&html_escape($ssleay)."</pre>");
 	}
 else {
 	# Display status and redirect to actual cert file
 	&ui_print_unbuffered_header(undef, $text{'cert_title'}, "");
-	print &text('cert_done', $in{'commonName'}),"<p>\n";
+	print &text('cert_done', &html_escape($in{'commonName'})),"<p>\n";
 	print &text('cert_pickup', "cert_output.cgi?file=$temp2"),"<p>\n";
 	&ui_print_footer("", $text{'index_return'});
 

acl/edit_group.cgi

@@ -7,7 +7,7 @@ use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
 require './acl-lib.pl';    ## no critic
-our (%in, %text, %config, %access, $config_directory);
+our (%in, %text, %config, %access, $config_directory, $base_remote_user);
 &ReadParse();
 $access{'groups'} || &error($text{'gedit_ecannot'});
 my $g;
@@ -95,6 +95,12 @@ print &ui_hidden_table_start($text{'edit_mods'}, "width=100%", 2, "mods");
 # Show available modules, under categories
 my @mlist = &list_module_infos();
 my %has = map { $_, 1 } @{$group{'modules'}};
+# Disable modules that this administrator cannot grant or remove.
+my $me = $access{'mode'} == 1 ? &get_user($base_remote_user) : undef;
+@mcan = $access{'mode'} == 1 ? @{$me->{'modules'} || []} :
+	$access{'mode'} == 2 ? split(/\s+/, $access{'mods'}) :
+			     map { $_->{'dir'} } @mlist;
+my %mcan = map { $_, 1 } @mcan;
 my @links = ( &select_all_link("mod", 0, $text{'edit_selall'}),
 	      &select_invert_link("mod", 0, $text{'edit_invert'}) );
 my @cats = &unique(map { $_->{'category'} || "" } @mlist);
@@ -119,7 +125,8 @@ foreach my $c (sort { $b cmp $a } @cats) {
 		else {
 			$label = $m->{'desc'};
 			}
-		push(@grid, &ui_checkbox("mod", $md, $label,$has{$md}));
+		push(@grid, &ui_checkbox("mod", $md, $label, $has{$md},
+					undef, !$mcan{$md}));
 		}
 	$grids .= &ui_grid_table(\@grid, 2, 100, [ "width=50%", "width=50%" ]);
 	}

acl/lang/en

@@ -175,6 +175,7 @@ cert_ekey=A new SSL key was not submitted by your browser - maybe it does not su
 cert_eca=Failed to setup certificate authority : $1
 cert_already=Warning - you are already using the certificate $1.
 cert_etempdir=Invalid certificate file
+cert_echars=Invalid characters in cert field
 
 acl_title=Module Access Control
 acl_title2=For $1 in $2

acl/save_group.cgi

@@ -7,7 +7,7 @@ use warnings;
 no warnings 'redefine';
 no warnings 'uninitialized';
 require './acl-lib.pl';    ## no critic
-our (%in, %text, %config, %access, $config_directory);
+our (%in, %text, %config, %access, $config_directory, $base_remote_user);
 &ReadParse();
 $access{'groups'} || &error($text{'gedit_ecannot'});
 
@@ -21,6 +21,13 @@ elsif ($in{'but_delete'}) {
 	exit;
 	}
 
+# Check global ACL access before saving any group changes.
+$in{'acl_security_form'} && !$access{'acl'} && &error($text{'acl_emod'});
+
+# Find logged-in webmin user
+my @ulist = &list_users();
+my ($me) = grep { $_->{'name'} eq $base_remote_user } @ulist;
+
 my (%group, $old);
 if ($in{'old'}) {
 	# Get the original group
@@ -42,6 +49,21 @@ if (!$in{'old'} || $in{'old'} ne $in{'name'}) {
 	}
 $in{'desc'} !~ /:/ || &error($text{'gsave_edesc'});
 
+# Check grantable modules before changing parent group membership.
+$access{'mode'} == 1 && !$me && &error($text{'edit_egone'});
+my @mcan = $access{'mode'} == 1 ? @{$me->{'modules'} || []} :
+	   $access{'mode'} == 2 ? split(/\s+/, $access{'mods'}) :
+				  &list_modules();
+my %mcan = map { $_, 1 } @mcan;
+# Keep existing modules that this administrator cannot change.
+my %keep = map { $_, 1 } grep { !$mcan{$_} }
+		($old ? @{$old->{'modules'}} : ());
+my @mods = split(/\0/, $in{'mod'});
+foreach my $m (@mods) {
+	$mcan{$m} || $keep{$m} || &error(&text('save_emod', &html_escape($m)));
+	}
+@mods = &unique(@mods, keys %keep);
+
 # Find the current parent group
 my $oldgroup;
 if ($in{'old'}) {
@@ -80,9 +102,6 @@ if (defined($in{'group'})) {
 		}
 	}
 
-# Work out group modules
-my @mods = split(/\0/, $in{'mod'});
-
 if ($oldgroup) {
 	# Remove modules from the old parent group
 	@mods = grep { &indexof($_, @{$oldgroup->{'modules'}}) < 0 } @mods;

acl/save_user.cgi

@@ -38,6 +38,9 @@ elsif ($in{'but_forgot'}) {
 	return;
 	}
 
+# Check global ACL access before saving any user or group changes.
+$in{'acl_security_form'} && !$access{'acl'} && &error($text{'acl_emod'});
+
 # Get the user object
 my (%user, $old);
 if ($in{'old'}) {
@@ -103,12 +106,7 @@ if ($in{'temp'}) {
 
 # Find logged-in webmin user
 my @ulist = &list_users();
-my $me;
-foreach my $u (@ulist) {
-	if ($u->{'name'} eq $base_remote_user) {
-		$me = $u;
-		}
-	}
+my ($me) = grep { $_->{'name'} eq $base_remote_user } @ulist;
 
 # Find the current group
 my $oldgroup = $in{'old'} ? &get_users_group($in{'old'}) : undef;
@@ -124,30 +122,8 @@ if (defined($in{'group'})) {
 			&error($text{'save_egroup'});
 		}
 
-	# Store group membership
+	# Find the requested group; save membership after validation.
 	$newgroup = &get_group($in{'group'});
-	if ($in{'group'} ne ($oldgroup ? $oldgroup->{'name'} : '')) {
-		# Group has changed - update the member lists
-		if ($oldgroup) {
-			# Take out of old
-			$oldgroup->{'members'} =
-				[ grep { $_ ne $in{'old'} }
-				  @{$oldgroup->{'members'}} ];
-			&modify_group($oldgroup->{'name'}, $oldgroup);
-			}
-		if ($newgroup) {
-			# Put into new
-			push(@{$newgroup->{'members'}}, $in{'name'});
-			&modify_group($in{'group'}, $newgroup);
-			}
-		}
-	elsif ($in{'old'} ne $in{'name'} && $oldgroup && $newgroup) {
-		# Name has changed - rename in group
-		my $idx = &indexof(
-			$in{'old'}, @{$oldgroup->{'members'}});
-		$oldgroup->{'members'}->[$idx] = $in{'name'};
-		&modify_group($oldgroup->{'name'}, $oldgroup);
-		}
 	}
 
 # Store manually selected modules
@@ -158,7 +134,7 @@ my %mcan = map { $_, 1 } @mcan;
 
 my @mods = split(/\0/, $in{'mod'});
 foreach my $m (@mods) {
-	$mcan{$m} || &error(&text('save_emod', $m));
+	$mcan{$m} || &error(&text('save_emod', &html_escape($m)));
 	}
 if ($in{'old'}) {
 	# Add modules that this user already has, but were not
@@ -180,11 +156,6 @@ if ($base_remote_user eq $in{'old'} &&
 	&error($text{'save_edeny'});
 	}
 
-if (!$in{'old'} && $access{'perms'}) {
-	# Copy .acl files from creator to new user
-	&copy_acl_files($me->{'name'}, $in{'name'}, $me->{'modules'});
-	}
-
 if ($newgroup) {
 	# Add modules from group to list
 	my @ownmods;
@@ -194,11 +165,6 @@ if ($newgroup) {
 		}
 	@mods = &unique(@mods, @{$newgroup->{'modules'}});
 	$user{'ownmods'} = \@ownmods;
-
-	# Copy ACL files for group
-	my $name = $in{'old'} ? $in{'old'} : $in{'name'};
-	&copy_group_user_acl_files($in{'group'}, $name,
-			      [ @{$newgroup->{'modules'}}, "" ]);
 	}
 $user{'modules'} = \@mods;
 
@@ -350,6 +316,42 @@ if ($in{'cancel'}) {
 	$user{'twofactor_apikey'} = undef;
 	}
 
+# Save membership and ACL files only after all user validation succeeds.
+if (defined($in{'group'})) {
+	if ($in{'group'} ne ($oldgroup ? $oldgroup->{'name'} : '')) {
+		# Group has changed - update the member lists
+		if ($oldgroup) {
+			# Take out of old
+			$oldgroup->{'members'} =
+				[ grep { $_ ne $in{'old'} }
+				  @{$oldgroup->{'members'}} ];
+			&modify_group($oldgroup->{'name'}, $oldgroup);
+			}
+		if ($newgroup) {
+			# Put into new
+			push(@{$newgroup->{'members'}}, $in{'name'});
+			&modify_group($in{'group'}, $newgroup);
+			}
+		}
+	elsif ($in{'old'} ne $in{'name'} && $oldgroup && $newgroup) {
+		# Name has changed - rename in group
+		my $idx = &indexof(
+			$in{'old'}, @{$oldgroup->{'members'}});
+		$oldgroup->{'members'}->[$idx] = $in{'name'};
+		&modify_group($oldgroup->{'name'}, $oldgroup);
+		}
+	}
+if (!$in{'old'} && $access{'perms'}) {
+	# Copy .acl files from creator to new user
+	&copy_acl_files($me->{'name'}, $in{'name'}, $me->{'modules'});
+	}
+if ($newgroup) {
+	# Copy ACL files for group
+	my $name = $in{'old'} ? $in{'old'} : $in{'name'};
+	&copy_group_user_acl_files($in{'group'}, $name,
+			      [ @{$newgroup->{'modules'}}, "" ]);
+	}
+
 if ($in{'old'}) {
 	# update user and all ACLs
 	&modify_user($in{'old'}, \%user);

acl/t/run-tests.t

@@ -1474,6 +1474,126 @@ subtest 'save_user.cgi create privilege' => sub {
     delete_user('admin');
 };
 
+subtest 'save_user.cgi rejected module escaping' => sub {
+    _reset_fixture();
+    _seed_user_acl('admin', { create => 1, mode => 2, mods => 'proc' });
+    create_user({ name => 'admin', pass => 'x', modules => ['acl', 'proc'] });
+
+    # Ordinary and hostile module names must remain text in the error page.
+    for my $module ('cron', '<script>alert(1)</script>') {
+        my $r = run_cgi('save_user.cgi', {
+            name => 'newbie', pass_def => 1, mod => $module,
+            logouttime_def => 1, minsize_def => 1 });
+        my $expected = text('save_emod', html_escape($module));
+        like($r->{out}, qr/\Q$expected\E/, 'rejected module is escaped');
+        unlike($r->{out}, qr/<script>alert\(1\)<\/script>/,
+               'module error cannot inject a script');
+        _clear_caches();
+        ok(!get_user('newbie'), 'rejected module does not create an account');
+    }
+};
+
+# Both save handlers must enforce the global ACL editor's permission check.
+subtest 'user and group global ACL permissions' => sub {
+    for my $allowed (0, 1) {
+        _reset_fixture();
+        create_user({ name => 'operator', pass => 'x', modules => ['acl', 'proc'] });
+        create_user({ name => 'target', pass => 'x', modules => ['proc'] });
+        create_group({ name => 'limited', members => [], modules => ['proc'] });
+        _seed_user_acl('operator', {
+            users => 'target', acl => $allowed, groups => 1,
+            mode => 2, mods => 'proc', times => 0,
+        });
+        my %before = (root => '/restricted', fileunix => 'nobody',
+                      download_address_mode => 'public');
+        save_module_acl(\%before, 'target', '', 1);
+        save_group_module_acl(\%before, 'limited', '', 1);
+
+        for my $kind ('user', 'group') {
+            my $name = $kind eq 'user' ? 'target' : 'limited';
+            my $r = run_cgi("save_$kind.cgi", {
+                old => $name, name => $name, mod => 'proc',
+                pass_def => 1, oldpass => 'x', logouttime_def => 1, minsize_def => 1,
+                acl_security_form => 1, root => '/', fileunix => 'root',
+                download_address_mode => 'all',
+            }, user => 'operator');
+            my $file = $kind eq 'user' ? 'target.acl' : 'limited.gacl';
+            my %saved;
+            read_file("$confdir/$file", \%saved);
+            if (!$allowed) {
+                like($r->{out}, qr/\Q$text{'acl_emod'}\E/, "$kind rejects acl=0");
+                is_deeply(\%saved, \%before, "$kind keeps existing restrictions");
+            }
+            else {
+                ok($r->{location}, "$kind accepts an authorized ACL save");
+                is($saved{root}, '/', "$kind saves the allowed root directory");
+                is($saved{fileunix}, 'root', "$kind saves the file-access user");
+                is($saved{download_address_mode}, 'all', "$kind saves download access");
+            }
+        }
+    }
+};
+
+# Rejected user edits must leave membership and inherited ACL files untouched.
+subtest 'user validation before group writes' => sub {
+    _reset_fixture();
+    create_user({ name => 'operator', pass => 'x', modules => ['acl', 'proc'] });
+    create_user({ name => 'target', pass => 'x', modules => ['proc'] });
+    create_group({ name => 'first', members => ['target'], modules => ['proc'] });
+    create_group({ name => 'second', members => [], modules => ['proc'] });
+    _seed_user_acl('operator', {
+        users => '*', mode => 2, mods => 'proc', gassign => '*', rename => 1,
+        times => 0, acl => 0,
+    });
+    my %before = (root => '/original');
+    save_module_acl(\%before, 'target', '', 1);
+    save_group_module_acl({ root => '/second' }, 'second', '', 1);
+    my %form = (old => 'target', name => 'target', pass_def => 1, oldpass => 'x',
+                logouttime_def => 1, minsize_def => 1, group => 'second', mod => 'proc');
+
+    for my $invalid ({mod => 'cron'}, {email => 'invalid:email'},
+                     {acl_security_form => 1}) {
+        my $r = run_cgi('save_user.cgi', { %form, %$invalid }, user => 'operator');
+        ok(!$r->{location}, 'invalid user save is rejected');
+        _clear_caches();
+        is_deeply(get_group('first')->{members}, ['target'], 'old membership retained');
+        is_deeply(get_group('second')->{members}, [], 'new group not modified');
+        my %saved;
+        read_file("$confdir/target.acl", \%saved);
+        is_deeply(\%saved, \%before, 'inherited ACL not copied on rejection');
+    }
+
+    # Valid transfers and same-group renames still update membership and ACLs.
+    my $r = run_cgi('save_user.cgi', \%form, user => 'operator');
+    ok($r->{location}, 'valid transfer succeeds');
+    _clear_caches();
+    is_deeply(get_group('first')->{members}, [], 'valid transfer removes old membership');
+    is_deeply(get_group('second')->{members}, ['target'], 'valid transfer adds membership');
+    my %saved;
+    read_file("$confdir/target.acl", \%saved);
+    is($saved{root}, '/second', 'valid transfer copies inherited ACL');
+    $r = run_cgi('save_user.cgi', { %form, name => 'renamed' }, user => 'operator');
+    ok($r->{location}, 'same-group rename succeeds');
+    _clear_caches();
+    is_deeply(get_group('second')->{members}, ['renamed'], 'membership follows rename');
+
+    # Failed creation must not add a nonexistent member; valid creation still can.
+    my %new = (%form, old => '', name => 'newmember', mod => 'cron');
+    $r = run_cgi('save_user.cgi', \%new, user => 'operator');
+    ok(!$r->{location}, 'invalid new user is rejected');
+    _clear_caches();
+    is_deeply(get_group('second')->{members}, ['renamed'], 'no member added on rejection');
+    $new{mod} = 'proc';
+    $r = run_cgi('save_user.cgi', \%new, user => 'operator');
+    ok($r->{location}, 'valid new group member is created');
+    _clear_caches();
+    is_deeply(get_group('second')->{members}, ['renamed', 'newmember'],
+              'new user is added to the selected group');
+    %saved = ();
+    read_file("$confdir/newmember.acl", \%saved);
+    is($saved{root}, '/second', 'new user inherits group ACL');
+};
+
 # Unix conversion must not bypass the privileged-name guard in save_user.cgi.
 # An ACL-capable administrator can still deliberately convert such a user.
 subtest 'convert.cgi privileged username gate' => sub {
@@ -1650,6 +1770,125 @@ subtest 'save_group.cgi name validation' => sub {
     ok(!$g, 'group with colon-bearing description not created');
 };
 
+# Group module limits must reject requests before any membership is changed.
+subtest 'save_group.cgi module limits' => sub {
+    _reset_fixture();
+    create_user({ name => 'admin', pass => 'x', modules => ['acl', 'proc'] });
+    create_group({ name => 'parent', members => [], modules => ['proc'] });
+    _seed_user_acl('admin', { mode => 2, mods => 'proc', groups => 1,
+                              gassign => '*' });
+
+    my $r = run_cgi('save_group.cgi', {
+        name => 'child', desc => 'd', group => 'parent', mod => ['proc', 'cron'] });
+    like($r->{out}, qr/You cannot grant access to module 'cron'/,
+         'explicit module limit rejects an unauthorized grant');
+    _clear_caches();
+    ok(!get_group('child'), 'rejected group is not created');
+    is_deeply(get_group('parent')->{members}, [],
+              'rejected save does not change parent membership');
+
+    $r = run_cgi('save_group.cgi', {
+        name => 'child', desc => 'd', group => 'parent', mod => 'proc' });
+    is($r->{status}, 0, 'allowed group creation exits successfully');
+    _clear_caches();
+    is_deeply(get_group('child')->{modules}, ['proc'], 'allowed module is saved');
+    is_deeply(get_group('parent')->{members}, ['@child'],
+              'successful save updates parent membership');
+
+    $r = run_cgi('save_group.cgi', {
+        old => 'child', name => 'child', desc => 'changed', group => '', mod => 'cron' });
+    like($r->{out}, qr/You cannot grant access to module 'cron'/,
+         'editing an existing group cannot grant an unauthorized module');
+    _clear_caches();
+    is_deeply(get_group('parent')->{members}, ['@child'],
+              'rejected edit does not detach the existing group');
+
+    my $payload = '<script>alert(1)</script>';
+    $r = run_cgi('save_group.cgi', { name => 'badmod', mod => $payload });
+    like($r->{out}, qr/&lt;script&gt;/, 'rejected module name is escaped');
+    unlike($r->{out}, qr/\Q$payload\E/, 'module error cannot inject HTML');
+
+    # Mode 1 uses the effective user's modules, including mapped logins.
+    _seed_user_acl('admin', { mode => 1, groups => 1 });
+    $r = run_cgi('save_group.cgi', { name => 'ownmods', mod => 'proc' },
+                 user => 'mapped-user', env => { BASE_REMOTE_USER => 'admin' });
+    _clear_caches();
+    is_deeply(get_group('ownmods')->{modules}, ['proc'],
+              'mapped login uses the base user module list');
+    $r = run_cgi('save_group.cgi', { name => 'denied', mod => 'cron' });
+    like($r->{out}, qr/You cannot grant access to module 'cron'/,
+         'mode 1 rejects modules the base user does not hold');
+
+    delete_user('admin');
+    _seed_user_acl('admin', { mode => 1, groups => 1 });
+    $r = run_cgi('save_group.cgi', { name => 'missing', mod => 'proc' });
+    like($r->{out}, qr/\Q$text{'edit_egone'}\E/, 'missing user returns a normal error');
+    unlike($r->{err}, qr/undefined value|compilation errors/,
+           'missing user does not cause a Perl exception');
+    _clear_caches();
+    ok(!get_group('missing'), 'missing user cannot create a group');
+
+    # Unrestricted mode does not require the mode-1 user record.
+    _seed_user_acl('admin', { mode => 0, groups => 1 });
+    $r = run_cgi('save_group.cgi', { name => 'unrestricted', mod => 'cron' });
+    _clear_caches();
+    is_deeply(get_group('unrestricted')->{modules}, ['cron'],
+              'unrestricted module grants remain supported');
+};
+
+# Editing unrelated fields must retain modules outside the admin's grant list.
+subtest 'existing group module preservation' => sub {
+    for my $mode (1, 2, 0) {
+        _reset_fixture();
+        create_user({ name => 'admin', pass => 'x', modules => ['acl', 'proc'] });
+        create_user({ name => 'member', pass => 'x', modules => ['proc', 'cron'] });
+        create_group({ name => 'existing', members => ['member'],
+                       modules => ['proc', 'cron'], desc => 'before' });
+        _seed_user_acl('admin', { mode => $mode, mods => 'proc', groups => 1 });
+
+        my $r = run_cgi('edit_group.cgi', { group => 'existing' });
+        my ($checkbox) = $r->{out} =~ /(<input\b[^>]*value="cron"[^>]*>)/;
+        ok($checkbox && $checkbox =~ /checked/, "mode $mode shows existing cron access");
+        is($checkbox && $checkbox =~ /disabled/ ? 1 : 0, $mode ? 1 : 0,
+           "mode $mode disables only restricted modules");
+
+        # Disabled controls are omitted by the browser.
+        $r = run_cgi('save_group.cgi', {
+            old => 'existing', name => 'existing', desc => 'after', mod => 'proc' });
+        _clear_caches();
+        my $group = get_group('existing');
+        is($group->{desc}, 'after', "mode $mode permits description edits");
+        my @expected = $mode ? qw(cron proc) : qw(proc);
+        is_deeply([sort @{$group->{modules}}], \@expected,
+                  "mode $mode preserves restricted modules but allows authorized removal");
+        is_deeply([sort @{get_user('member')->{modules}}], \@expected,
+                  "mode $mode preserves the correct member access");
+        next if !$mode;
+
+        # An old form can still submit the existing restricted selection.
+        $r = run_cgi('save_group.cgi', {
+            old => 'existing', name => 'existing', desc => 'old form',
+            mod => ['proc', 'cron'] });
+        _clear_caches();
+        is(get_group('existing')->{desc}, 'old form',
+           "mode $mode accepts an unchanged restricted selection");
+
+        $r = run_cgi('save_group.cgi', {
+            old => 'existing', name => 'existing', desc => 'forged',
+            mod => ['proc', 'cron', 'webmin'] });
+        like($r->{out}, qr/You cannot grant access to module 'webmin'/,
+             "mode $mode rejects a new unauthorized module");
+        _clear_caches();
+        is(get_group('existing')->{desc}, 'old form',
+           "mode $mode rejects before writing changes");
+
+        $r = run_cgi('save_group.cgi', {
+            name => 'cloned', clone => 'existing', mod => ['proc', 'cron'] });
+        like($r->{out}, qr/You cannot grant access to module 'cron'/,
+             "mode $mode cannot grant restricted modules by cloning");
+    }
+};
+
 subtest 'save_user.cgi self-lockout guard' => sub {
     # Editing yourself out of the acl module is refused — otherwise an
     # admin could lock themselves out of Webmin entirely.

filemin/module.info.fr

@@ -0,0 +1 @@
+desc_fr=Gestionnaire de Fichiers

lang/fr

@@ -20,6 +20,7 @@ category_net=Réseau
 category_syslet=Syslets
 category_cluster=Cluster
 category_info=Information
+category_=Outils
 
 longcategory_servers=Modules pour les configurations web, email, FTP et autres serveurs
 longcategory_hardware=Modules pour les imprimantes, disques et autres configurations de matériel

lvm/lvm-lib.pl

@@ -904,6 +904,9 @@ sub device_input
 {
 local (%used, $vg, $pv, $d, $p);
 
+# Dropdown labels need plain text sizes without theme HTML.
+local $main::theme_forbid_nice_size = 1;
+
 # Find partitions that are part of an LVM
 foreach $vg (&list_volume_groups()) {
 	foreach $pv (&list_physical_volumes($vg->{'name'})) {

net/netplan-lib.pl

@@ -354,32 +354,13 @@ if ($iface->{'virtual'} ne '') {
 	&save_interface($parent, $boot);
 	}
 else {
-	# Find current lines because earlier deletions may have shifted them.
+	# Delete all the lines
 	&lock_file($iface->{'file'});
-	&unflush_file_lines($iface->{'file'});
-	my $yaml = &read_yaml_file($iface->{'file'});
-	my @network = grep { $_->{'name'} eq 'network' } @$yaml;
-	my @groups = grep { $_->{'name'} eq 'ethernets' ||
-			   $_->{'name'} eq 'bridges' }
-			 map { @{$_->{'members'}} } @network;
-	my $entry;
-	foreach my $g (@groups) {
-		my ($e) = grep { $_->{'name'} eq $iface->{'fullname'} }
-				@{$g->{'members'}};
-		next if (!$e);
-		# Remove the group as well when deleting its last interface.
-		$entry = @{$g->{'members'}} == 1 ? $g : $e;
-		last;
-		}
-	$entry || &error("No interface named $iface->{'fullname'} exists");
-
-	# Delete the interface without changing neighboring definitions.
 	my $lref = &read_file_lines($iface->{'file'});
-	splice(@$lref, $entry->{'line'},
-	       $entry->{'eline'} - $entry->{'line'} + 1);
+	splice(@$lref, $iface->{'line'},
+	       $iface->{'eline'} - $iface->{'line'} + 1);
 	&flush_file_lines($iface->{'file'});
 	if (&is_yaml_empty($iface->{'file'})) {
-		# Discard the file only when no settings or interfaces remain.
 		&unlink_file($iface->{'file'});
 		}
 	&unlock_file($iface->{'file'});
@@ -387,22 +368,22 @@ else {
 }
 
 # is_yaml_empty(file)
-# Returns 1 if only the version and empty Ethernet or bridge groups remain
+# Return 1 if a YAML file contains only network and ethernets line, with no
+# other interfaces
 sub is_yaml_empty
 {
 my ($file) = @_;
 my $yaml = &read_yaml_file($file);
 return 1 if (!$yaml);
+my @rest = grep { $_->{'name'} ne 'network' } @$yaml;
+return 0 if (@rest);
 foreach my $n (@$yaml) {
-	# Preserve unknown directives and inline network settings.
-	return 0 if ($n->{'name'} ne 'network' ||
-		    ($n->{'value'} ne '' && $n->{'value'} ne '{}'));
-	# Only the version and empty device groups are safe to discard.
-	foreach my $ens (@{$n->{'members'}}) {
-		next if ($ens->{'name'} eq 'version');
-		return 0 if (($ens->{'name'} ne 'ethernets' &&
-			     $ens->{'name'} ne 'bridges') || @{$ens->{'members'}} ||
-			($ens->{'value'} ne '' && $ens->{'value'} ne '{}'));
+	my @rest = grep { $_->{'name'} ne 'ethernets' &&
+			  $_->{'name'} ne 'bridges' }
+			@{$network->{'members'}};
+	return 0 if (@rest);
+	foreach my $ens (@{$network->{'members'}}) {
+		return 0 if (@{$ens->{'members'}});
 		}
 	}
 return 1;

proc/kill_proc.cgi

@@ -5,7 +5,7 @@
 require './proc-lib.pl';
 &ReadParse();
 &switch_acl_uid();
-&error_setup(&text('kill_err', $in{signal}, $in{pid}));
+&error_setup(&text('kill_err', &html_escape($in{signal}), &html_escape($in{pid})));
 foreach $s ('KILL', 'TERM', 'HUP', 'STOP', 'CONT') {
 	$in{'signal'} = $s if ($in{$s});
 	}

proc/kill_proc_list.cgi

@@ -14,10 +14,10 @@ foreach $s ('KILL', 'TERM', 'HUP', 'STOP', 'CONT') {
 @pinfo = &list_processes(@pidlist);
 for($i=0; $i<@pidlist; $i++) {
 	$in{"args$i"} = $pinfo[$i]->{'args'};
-	print "$text{'pid'} <tt>$pidlist[$i]</tt> ... \n";
+	print "$text{'pid'} <tt>".&html_escape($pidlist[$i])."</tt> ... \n";
 	if (&can_edit_process($pinfo[$i]->{'user'})) {
 		if (&kill_logged($in{signal}, $pidlist[$i])) {
-			print "SIG$in{signal} $text{'kill_sent'}<br>\n";
+			print "SIG".&html_escape($in{'signal'})." $text{'kill_sent'}<br>\n";
 			}
 		else {
 			print "$!<br>\n";
@@ -29,5 +29,6 @@ for($i=0; $i<@pidlist; $i++) {
 	}
 &webmin_log("kill", undef, undef, \%in);
 print "<p>\n";
-&ui_print_footer("index_search.cgi?$in{'args'}", $text{'search_return'});
+&ui_print_footer("index_search.cgi?".&html_escape($in{'args'}),
+		 $text{'search_return'});
 

software/yum-lib.pl

@@ -523,8 +523,8 @@ close(PKG);
 while(<PKG>) {
 	s/\r|\n//g;
 	next if (/^(Loaded|updateinfo)/);
-	if (/^\S+\s+\S+\s+(\S+?)\-([0-9]\S+)\.([^\.]+)$/) {
-		local ($name, $ver) = ($1, $2);
+	if (/^\S+\s+(\S*[Ss]ec\S*)\s+(\S+?)\-([0-9]\S+)\.([^\.]+)$/) {
+		local ($name, $ver) = ($2, $3);
 		if ($done->{$name}) {
 			$done->{$name}->{'source'} ||= 'security';
 			$done->{$name}->{'security'} = 1;

t/cert-proc-escaping.t

@@ -0,0 +1,118 @@
+#!/usr/bin/perl
+# Exercise CGI escaping without issuing certificates or signaling processes.
+use strict;
+use warnings;
+no warnings qw(once redefine uninitialized);
+use Test::More;
+use FindBin;
+
+my $root = "$FindBin::Bin/..";
+require "$root/web-lib-funcs.pl";
+require "$root/ui-lib.pl";
+$INC{'./acl-lib.pl'} = $INC{'./proc-lib.pl'} = 1;
+*main::ReadParse = *main::switch_acl_uid = *main::webmin_log = sub { };
+*main::error_setup = *main::get_miniserv_config = sub { };
+*main::error = sub { die $_[0]."\n" };
+*main::get_module_variable = sub { return \%main::text };
+*main::ui_print_unbuffered_header = sub { };
+*main::load_theme_library = sub { };
+*main::get_module_name = sub { 'proc' };
+*main::get_module_info = sub { return () };
+*main::get_webprefix = sub { '' };
+for my $file ('lang/en', 'acl/lang/en', 'proc/lang/en') {
+	open(my $fh, '<', "$root/$file") or die $!;
+	while (<$fh>) {
+		$main::text{$1} = $2 if /^(\S+)=(.*)$/;
+		}
+	}
+
+# render_cgi(file, inputs) captures the real CGI and UI helpers.
+sub render_cgi
+{
+my ($file, $inputs) = @_;
+local %main::in = %$inputs;
+my $html = '';
+open(my $out, '>', \$html) or die $!;
+local *STDOUT = $out;
+do "$root/$file";
+return ($html, $@);
+}
+
+subtest 'certificate success and error output' => sub {
+	# Stub only certificate I/O and account writes; preserve submitted values.
+	my ($saved, $openssl_error);
+	local *main::transname = local *main::tempname = sub { '/fixture/cert' };
+	local *main::open_tempfile = local *main::print_tempfile =
+		local *main::close_tempfile = local *main::unlink_file = sub { };
+	local *main::get_ssleay = sub { 'openssl' };
+	local *main::backquote_logged = sub {
+		$? = $openssl_error ? 256 : 0;
+		return $openssl_error || '';
+		};
+	local *main::list_users = sub { return {name => 'fixture'} };
+	# Stop after the tested account write, before the CGI's delay and restart.
+	local *main::modify_user = sub { $saved = $_[1]->{cert}; die "fixture done\n" };
+	local $main::base_remote_user = 'fixture';
+	my $payload = '<script>alert(1)</script>';
+	for my $name ('Review User', q{O'Reilly & Partners}, $payload) {
+		my ($html, $error) = render_cgi('acl/cert_issue.cgi',
+			{ key => 'fixture-key', commonName => $name });
+		is($error, "fixture done\n", 'successful issuance reaches account update');
+		like($html, qr/\Q@{[main::html_escape($name)]}\E/,
+			'common name appears as text');
+		unlike($html, qr/\Q$payload\E/, 'common name cannot introduce a script');
+		like($saved, qr/\Q\/CN=$name\/Email=\E/, 'stored DN retains the original name');
+		}
+	$openssl_error = "Invalid subject $payload\n";
+	my ($html, $error) = render_cgi('acl/cert_issue.cgi',
+		{ key => 'fixture-key', commonName => 'Review User' });
+	like($error, qr/<pre>Invalid subject &lt;script&gt;/,
+		'OpenSSL diagnostics retain preformatted markup and escape input');
+	unlike($error, qr/\Q$payload\E/, 'OpenSSL errors cannot introduce a script');
+	};
+
+subtest 'single-process permission error heading' => sub {
+	my ($heading, $pid);
+	local *main::error_setup = sub { $heading = $_[0] };
+	local *main::process_info = sub { $pid = $_[0]; return (user => 'fixture') };
+	local *main::can_edit_process = sub { 0 };
+	local *main::kill_logged = sub { die "unexpected signal\n" };
+	my $payload = '<script>alert(1)</script>';
+	for my $inputs ({signal => 'TERM', pid => '12345'},
+			{signal => $payload, pid => $payload}) {
+		my ($html, $error) = render_cgi('proc/kill_proc.cgi', $inputs);
+		is($error, "$main::text{'kill_ecannot'}\n", 'signaling is denied');
+		is($heading, main::text('kill_err',
+			main::html_escape($inputs->{signal}),
+			main::html_escape($inputs->{pid})),
+			'error heading renders submitted values as text');
+		is($pid, $inputs->{pid}, 'process lookup receives the original PID');
+		}
+	};
+
+subtest 'process output and return link' => sub {
+	my @signals;
+	local *main::list_processes = sub { return map { +{user => 'fixture'} } @_ };
+	local *main::can_edit_process = sub { 1 };
+	local *main::kill_logged = sub { push @signals, [@_]; return 1 };
+	my $query = 'search=worker%20name&match=1';
+	my ($html, $error) = render_cgi('proc/kill_proc_list.cgi',
+		{pidlist => '12345 12346', signal => 'TERM', args => $query});
+	is($error, '', 'ordinary request renders successfully');
+	is_deeply(\@signals, [['TERM', '12345'], ['TERM', '12346']],
+		'signal and PID arguments are unchanged');
+	$html =~ /href="(index_search\.cgi\?[^"]+)"/;
+	is(main::html_unescape($1), "index_search.cgi?$query",
+		'HTML escaping preserves the return query');
+
+	my $payload = '<script>alert(1)</script>';
+	($html, $error) = render_cgi('proc/kill_proc_list.cgi',
+		{pidlist => $payload, signal => $payload, args => '">'.$payload});
+	is($error, '', 'hostile values render successfully');
+	unlike($html, qr/\Q$payload\E/, 'PID, signal and return link cannot inject scripts');
+	like($html, qr/SIG&lt;script&gt;/, 'signal output is escaped');
+	like($html, qr/href="index_search.cgi\?&quot;&gt;&lt;script&gt;/,
+		'return link cannot escape its quoted attribute');
+	};
+
+done_testing();

t/net-netplan-vm.t

@@ -1,123 +0,0 @@
-#!/usr/bin/perl
-# Run with WEBMIN_NETPLAN_VM_TEST=1 on a Linux debug VM with Netplan installed.
-use strict;
-use warnings;
-no warnings 'once';
-use Test::More;
-use File::Path qw(make_path);
-use File::Temp qw(tempdir);
-use FindBin;
-use lib "$FindBin::Bin/../net";
-
-plan skip_all => 'Set WEBMIN_NETPLAN_VM_TEST=1 on a Linux debug VM'
-    unless ($ENV{'WEBMIN_NETPLAN_VM_TEST'} || '') eq '1';
-$^O eq 'linux' or die 'Linux VM required';
-require "$FindBin::Bin/../web-lib-funcs.pl";
-require "$FindBin::Bin/../net/netplan-lib.pl";
-local %main::gconfig = ();
-local $main::readonly_mode_cache = 0;
-
-# Load real address helpers without initializing the VM's Webmin configuration.
-my $net_lib = main::read_file_contents("$FindBin::Bin/../net/net-lib.pl");
-foreach my $name (qw(prefix_to_mask mask_to_prefix log2)) {
-    my ($code) = $net_lib =~ /^(sub \Q$name\E\n\{.*?^\})/ms;
-    $code or die "Cannot find $name";
-    eval "no strict; $code";
-    die $@ if $@;
-}
-
-# Keep realistic addresses, DNS, routes, and comments in the surviving port.
-my $header = "network:\n  version: 2\n";
-my $global = $header."  renderer: networkd\n";
-my $ethernet = <<'YAML';
-  ethernets:
-    eth0:
-      # Preserve the port's static settings.
-      addresses: [192.0.2.10/24, '2001:db8::10/64']
-      nameservers:
-        addresses: [192.0.2.53]
-        search: [example.test]
-      routes:
-        - to: default
-          via: 192.0.2.1
-    eth1:
-      dhcp4: true
-YAML
-my $bridge0 = "    br0:\n      interfaces: [eth0]\n";
-my $bridge1 = "    br1:\n      interfaces: [eth1]\n";
-my $standalone = "    br0:\n      interfaces: []\n      dhcp4: true\n";
-my $other_groups = <<'YAML';
-  vlans:
-    vlan10:
-      id: 10
-      link: eth0
-  bonds:
-    bond0:
-      interfaces: [eth1]
-      parameters:
-        mode: active-backup
-YAML
-my $inline = "  ethernets: {eth0: {dhcp4: true}}\n";
-my $bulk = $global."  ethernets: {}\n  bridges:\n".
-    "    br0:\n      dhcp4: false\n    br1:\n      dhcp4: true\n";
-
-# Each case supplies valid input, deletion order, and exact expected contents.
-foreach my $case (
-    ['shared bridge', $header.$ethernet."  bridges:\n".$bridge0,
-        ['br0'], $header.$ethernet],
-    ['remaining bridge', $header.$ethernet."  bridges:\n".$bridge0.$bridge1,
-        ['br0'], $header.$ethernet."  bridges:\n".$bridge1],
-    ['last Ethernet', $header."  ethernets:\n    eth0: {}\n",
-        ['eth0'], undef],
-    ['last bridge', $header."  bridges:\n".$standalone,
-        ['br0'], undef],
-    ['VLAN and bond settings', $header.$ethernet.$other_groups.
-        "  bridges:\n".$standalone, ['br0'], $header.$ethernet.$other_groups],
-    ['inline Ethernet mapping', $header.$inline."  bridges:\n".$bridge0,
-        ['br0'], $header.$inline],
-    ['bulk deletion preserves existing empty groups', $bulk, ['br1', 'br0'],
-        $global."  ethernets: {}\n"],
-    ['bulk deletion follows display order',
-        $global."  ethernets:\n    eth0: {}\n  bridges:\n".$standalone,
-        ['eth0', 'br0'], $global],
-    ['virtual IPv4 address', $header."  ethernets:\n    eth0:\n".
-        "      addresses: [192.0.2.10/24, 192.0.2.11/24]\n",
-        ['eth0:0'], $header."  ethernets:\n    eth0:\n".
-        "      addresses: ['192.0.2.10/24']\n"],
-) {
-    subtest $case->[0] => sub {
-        # Generate only beneath this temporary root, without applying networking.
-        my $root = tempdir(CLEANUP => 1);
-        local $main::netplan_dir = "$root/etc/netplan";
-        make_path($main::netplan_dir);
-        my $file = "$main::netplan_dir/shared.yaml";
-        my $control = "$main::netplan_dir/00-renderer.yaml";
-        main::write_file_contents($file, $case->[1]);
-        main::write_file_contents($control, $global);
-        chmod(0600, $file, $control) == 2 or die "chmod: $!";
-        is(system('netplan', 'generate', '--root-dir', $root), 0,
-            'original configuration passes Netplan');
-
-        # Match the UI's reuse of one interface list throughout bulk deletion.
-        my @boot = main::boot_interfaces();
-        foreach my $name (@{$case->[2]}) {
-            my ($iface) = grep { $_->{'fullname'} eq $name } @boot;
-            $iface or die "Fixture interface $name not found";
-            main::delete_interface($iface);
-        }
-        if (defined($case->[3])) {
-            # Surviving settings and comments must retain their exact contents.
-            is(main::read_file_contents($file), $case->[3],
-                'remaining configuration is unchanged');
-        }
-        else {
-            # No interface or global setting remains in this file.
-            ok(!-e $file, 'empty file is removed');
-        }
-        is(main::read_file_contents($control), $global,
-            'another YAML file is untouched');
-        is(system('netplan', 'generate', '--root-dir', $root), 0,
-            'resulting configuration passes Netplan');
-    };
-}
-done_testing();

t/net-netplan.t

@@ -1,65 +0,0 @@
-#!/usr/bin/perl
-# Exercise Netplan deletion using temporary files only, without host configuration.
-use strict;
-use warnings;
-no warnings 'once';
-use Test::More;
-use File::Temp qw(tempdir);
-use FindBin;
-use lib "$FindBin::Bin/../net";
-require "$FindBin::Bin/../web-lib-funcs.pl";
-require "$FindBin::Bin/../net/netplan-lib.pl";
-local %main::gconfig = ();
-local $main::readonly_mode_cache = 0;
-my $root = tempdir(CLEANUP => 1);
-my $file = "$root/shared.yaml";
-local $main::netplan_dir = $root;
-
-# Empty detection must retain real interface entries and global settings.
-foreach my $case (
-    ["network:\n  version: 2\n  ethernets:\n  bridges:\n", 1, 'empty interface groups'],
-    ["network:\n  version: 2\n  ethernets:\n    eth0: {}\n", 0, 'empty Ethernet definition'],
-    ["network:\n  version: 2\n  bridges:\n    br1:\n      dhcp4: true\n", 0, 'another bridge'],
-    ["network:\n  version: 2\n  renderer: networkd\n", 0, 'global renderer'],
-    ["network:\n  version: 2\n  vlans:\n    vlan10:\n      id: 10\n      link: eth0\n", 0, 'VLAN settings']) {
-    main::write_file_contents($file, $case->[0]);
-    main::unflush_file_lines($file);
-    is(main::is_yaml_empty($file), $case->[1], "$case->[2] handled correctly");
-}
-
-# Deleting the last bridge must retain its port and unrelated YAML byte for byte.
-my $remaining = "network:\n  version: 2\n  ethernets:\n    eth0:\n      dhcp4: true\n".
-    "    eth1:\n      dhcp4: false\n";
-my $original = $remaining."  bridges:\n    br0:\n      interfaces: [eth0]\n";
-main::write_file_contents($file, $original);
-main::unflush_file_lines($file);
-main::delete_interface((grep { $_->{'fullname'} eq 'br0' } main::boot_interfaces())[0]);
-ok(-f $file, 'shared YAML survives bridge deletion');
-is(main::read_file_contents($file), $remaining, 'empty group removed, Ethernet settings untouched');
-
-# Removing one bridge must preserve the group and the remaining bridge.
-my $second = "    br1:\n      interfaces: [eth1]\n";
-main::write_file_contents($file, $original.$second);
-main::unflush_file_lines($file);
-main::delete_interface((grep { $_->{'fullname'} eq 'br0' } main::boot_interfaces())[0]);
-is(main::read_file_contents($file), $remaining."  bridges:\n".$second,
-    'another bridge and its group remain unchanged');
-
-# A bridge-only file is removed once its last interface is gone.
-main::write_file_contents($file, "network:\n  version: 2\n  bridges:\n    br0:\n      dhcp4: true\n");
-main::unflush_file_lines($file);
-main::delete_interface((grep { $_->{'fullname'} eq 'br0' } main::boot_interfaces())[0]);
-ok(!-e $file, 'empty bridge-only file is removed');
-
-# Bulk deletion reuses interface details after earlier deletions shift lines.
-my $global = "network:\n  version: 2\n  renderer: networkd\n";
-main::write_file_contents($file, $global."  ethernets: {}\n  bridges:\n".
-    "    br0:\n      dhcp4: false\n    br1:\n      dhcp4: true\n");
-main::unflush_file_lines($file);
-my @boot = main::boot_interfaces();
-foreach my $iface (@boot) {
-    main::delete_interface($iface);
-}
-is(main::read_file_contents($file), $global."  ethernets: {}\n",
-    'bulk deletion handles line shifts and preserves unrelated settings');
-done_testing();