[PATCH pve-access-control 4/9] fix #7294: acl: pool: add SDN VNets as pool members

[David Riley <d.riley@proxmox.com>]

Extend the pool configuration to allow SDN VNets as pool members by
introducing a new 'network' property.

The property tracks entries using a type prefix for future expansion:
* vnet/<zone>/<vnet>
* vnet/<zone>/<vnet>/<vlan>

Adapt the path resolution for bridges to ensure pool configurations
are considered. This is necessary to allow users to assign a VNet to
a VM when they only have access to a specific VLAN tag. Note that if
a VLAN tag is present in the pool configuration, the user is
restricted to that specific tag and cannot assign the base VNet
untagged.

Update the parser_writer tests to verify serialization and parsing
of the updated configuration format.

Link: https://bugzilla.proxmox.com/show_bug.cgi?id=7294
Signed-off-by: David Riley <d.riley@proxmox.com>
---
 src/PVE/AccessControl.pm  | 88 +++++++++++++++++++++++++++++++++++++--
 src/PVE/RPCEnvironment.pm | 47 +++++++++++++++++++++
 src/test/parser_writer.pl | 53 +++++++++++++++++++----
 3 files changed, 176 insertions(+), 12 deletions(-)

diff --git a/src/PVE/AccessControl.pm b/src/PVE/AccessControl.pm
index b7bb3eb..db452a2 100644
--- a/src/PVE/AccessControl.pm
+++ b/src/PVE/AccessControl.pm
@@ -1559,7 +1559,7 @@ sub parse_user_config {
                 warn "user config - ignore invalid path in acl '$pathtxt'\n";
             }
         } elsif ($et eq 'pool') {
-            my ($pool, $comment, $vmlist, $storelist) = @data;
+            my ($pool, $comment, $vmlist, $storelist, $networklist) = @data;
 
             if (!verify_poolname($pool, 1)) {
                 warn "user config - ignore pool '$pool' - invalid characters in pool name\n";
@@ -1567,7 +1567,7 @@ sub parse_user_config {
             }
 
             # make sure to add the pool (even if there are no members)
-            $cfg->{pools}->{$pool} = { vms => {}, storage => {}, pools => {} }
+            $cfg->{pools}->{$pool} = { vms => {}, storage => {}, pools => {}, network => {} }
                 if !$cfg->{pools}->{$pool};
 
             if ($pool =~ m!/!) {
@@ -1576,7 +1576,8 @@ sub parse_user_config {
                     # ensure nested pool info is correctly recorded
                     my $parent = $1;
                     $cfg->{pools}->{$curr}->{parent} = $parent;
-                    $cfg->{pools}->{$parent} = { vms => {}, storage => {}, pools => {} }
+                    $cfg->{pools}->{$parent} =
+                        { vms => {}, storage => {}, pools => {}, network => {} }
                         if !$cfg->{pools}->{$parent};
                     $cfg->{pools}->{$parent}->{pools}->{$curr} = 1;
                     $curr = $parent;
@@ -1610,6 +1611,18 @@ sub parse_user_config {
                 }
                 $cfg->{pools}->{$pool}->{storage}->{$storeid} = 1;
             }
+
+            foreach my $network (split_list($networklist)) {
+
+                if ($network !~ m/^[a-z0-9][a-z0-9\-_]*(?:\/[a-z0-9][a-z0-9\-_]*)*$/i) {
+                    warn "user config - ignore invalid sdn resource entry '$network' in pool"
+                        . " '$pool'\n";
+                    next;
+                }
+
+                $cfg->{pools}->{$pool}->{network}->{$network} = 1;
+            }
+
         } elsif ($et eq 'token') {
             my ($tokenid, $expire, $privsep, $comment) = @data;
 
@@ -1691,8 +1704,9 @@ sub write_user_config {
         my $d = $cfg->{pools}->{$pool};
         my $vmlist = join(',', sort keys %{ $d->{vms} });
         my $storelist = join(',', sort keys %{ $d->{storage} });
+        my $networklist = join(',', sort keys %{ $d->{network} });
         my $comment = $d->{comment} ? PVE::Tools::encode_text($d->{comment}) : '';
-        $data .= "pool:$pool:$comment:$vmlist:$storelist:\n";
+        $data .= "pool:$pool:$comment:$vmlist:$storelist:$networklist:\n";
     }
 
     $data .= "\n";
@@ -1974,6 +1988,72 @@ sub remove_vm_from_pool {
     lock_user_config($delVMfromPoolFn, "pool cleanup for VM $vmid failed");
 }
 
+sub remove_vnet_from_pool {
+    my ($zone, $vnet) = @_;
+    my $network_key = "vnet/$zone/$vnet";
+
+    my $delVNetfromPoolFn = sub {
+        my $usercfg = cfs_read_file("user.cfg");
+        return if !$usercfg->{pools};
+
+        my $modified = 0;
+        foreach my $pool (keys %{ $usercfg->{pools} }) {
+            my $pool_cfg = $usercfg->{pools}->{$pool};
+            next if !$pool_cfg->{network};
+
+            foreach my $net_key (keys %{ $pool_cfg->{network} }) {
+                if ($net_key eq $network_key || $net_key =~ m!^\Q$network_key\E/\d+$!) {
+                    delete $pool_cfg->{network}->{$net_key};
+                    $modified = 1;
+                }
+            }
+        }
+
+        if ($modified) {
+            cfs_write_file("user.cfg", $usercfg);
+        }
+    };
+
+    lock_user_config($delVNetfromPoolFn, "pool cleanup for VNet $vnet failed");
+}
+
+sub migrate_vnet_zone_in_pool {
+    my ($src_zone, $dest_zone, $vnet) = @_;
+
+    my $src_key = "vnet/$src_zone/$vnet";
+    my $dest_key = "vnet/$dest_zone/$vnet";
+
+    my $updateVNetZoneFn = sub {
+        my $usercfg = cfs_read_file("user.cfg");
+        return if !$usercfg->{pools};
+
+        my $modified = 0;
+        foreach my $pool (keys %{ $usercfg->{pools} }) {
+            my $pool_cfg = $usercfg->{pools}->{$pool};
+            next if !$pool_cfg->{network};
+
+            foreach my $net_key (keys %{ $pool_cfg->{network} }) {
+                if ($net_key eq $src_key || $net_key =~ m!^\Q$src_key\E/(\d+)$!) {
+                    my $vlan = $1;
+                    delete $pool_cfg->{network}->{$net_key};
+
+                    my $target_key = $dest_key;
+                    $target_key .= "/$vlan" if defined($vlan);
+                    $pool_cfg->{network}->{$target_key} = 1;
+
+                    $modified = 1;
+                }
+            }
+        }
+
+        if ($modified) {
+            cfs_write_file("user.cfg", $usercfg);
+        }
+    };
+
+    lock_user_config($updateVNetZoneFn, "pool update for VNet $vnet failed");
+}
+
 sub remove_sdn_resource_access {
     my ($paths) = @_; # [ ['zones', '<zone>'], ['zones', '<zone>', '<vnet>'] ]
 
diff --git a/src/PVE/RPCEnvironment.pm b/src/PVE/RPCEnvironment.pm
index 7591aa9..d8fb671 100644
--- a/src/PVE/RPCEnvironment.pm
+++ b/src/PVE/RPCEnvironment.pm
@@ -53,6 +53,21 @@ my $compile_acl_path = sub {
                     $data->{poolroles}->{"/storage/$storeid"}->{$role} = 1;
                 }
             }
+
+            foreach my $network_key (keys %{ $d->{network} }) {
+                my ($type, @path) = split('/', $network_key);
+
+                if ($type eq 'vnet') {
+                    my ($zoneid, $vnetid, $vlan) = @path;
+
+                    my $acl_path = "/sdn/zones/$zoneid/$vnetid";
+                    $acl_path = "$acl_path/$vlan" if defined($vlan) && $vlan ne '';
+
+                    for my $role (keys %$pool_roles) {
+                        $data->{poolroles}->{$acl_path}->{$role} = 1;
+                    }
+                }
+            }
         }
     }
 
@@ -219,6 +234,8 @@ sub compute_api_permission {
                     $res->{vms}->{$priv} = 1;
                 } elsif ($priv =~ m/^Datastore\./) {
                     $res->{storage}->{$priv} = 1;
+                } elsif ($priv =~ m/^SDN\./) {
+                    $res->{sdn}->{$priv} = 1;
                 } elsif ($priv eq 'Permissions.Modify') {
                     $res->{storage}->{$priv} = 1;
                     $res->{vms}->{$priv} = 1;
@@ -274,6 +291,17 @@ sub get_effective_permissions {
         foreach my $storeid (keys %{ $d->{storage} }) {
             $paths->{"/storage/$storeid"} = 1;
         }
+
+        foreach my $network_key (keys %{ $d->{network} }) {
+            my ($type, @path) = split('/', $network_key);
+
+            if ($type eq 'vnet') {
+                my ($zoneid, $vnetid, $vlan) = @path;
+                my $vnet_path = "/sdn/zones/$zoneid/$vnetid";
+                $vnet_path .= "/$vlan" if defined($vlan) && $vlan ne '';
+                $paths->{$vnet_path} = 1;
+            }
+        }
     }
 
     my $perms = {};
@@ -353,6 +381,25 @@ sub check_sdn_bridge {
         }
     }
 
+    # check access to VLANs via pools
+    foreach my $pool (keys %{ $cfg->{pools} }) {
+        my $d = $cfg->{pools}->{$pool};
+        next if !$d->{network};
+
+        foreach my $network_key (keys %{ $d->{network} }) {
+            my ($type, @path) = split('/', $network_key);
+
+            if (defined($type) && $type eq 'vnet') {
+                my ($zoneid, $vnetid, $vlan) = @path;
+
+                if ($zoneid eq $zone && $vnetid eq $bridge && defined($vlan)) {
+                    my $vlanpath = "/sdn/zones/$zoneid/$vnetid/$vlan";
+                    return 1 if $self->check_any($username, $vlanpath, $privs, 1);
+                }
+            }
+        }
+    }
+
     # repeat check, but fatal
     $self->check_any($username, $path, $privs, 0) if !$noerr;
 
diff --git a/src/test/parser_writer.pl b/src/test/parser_writer.pl
index ea2778e..a809e21 100755
--- a/src/test/parser_writer.pl
+++ b/src/test/parser_writer.pl
@@ -238,24 +238,35 @@ my $default_cfg = {
         vms => {},
         storage => {},
         pools => {},
+        network => {},
     },
     test_pool_members => {
         'id' => 'testpool',
         vms => { 123 => 1, 1234 => 1 },
         storage => { 'local' => 1, 'local-zfs' => 1 },
         pools => {},
+        network => { "vnet/zone1/vnet1" => 1, 'vnet/zone2/vnet2' => 1 },
     },
     test_pool_duplicate_vms => {
         'id' => 'test_duplicate_vms',
         vms => {},
         storage => {},
         pools => {},
+        network => {},
     },
     test_pool_duplicate_storages => {
         'id' => 'test_duplicate_storages',
         vms => {},
         storage => { 'local' => 1, 'local-zfs' => 1 },
         pools => {},
+        network => {},
+    },
+    test_pool_duplicate_networks => {
+        'id' => 'test_duplicate_networks',
+        vms => {},
+        storage => {},
+        pools => {},
+        network => { "vnet/zone1/vnet1" => 1, "vnet/zone2/vnet2" => 1 },
     },
     acl_simple_user => {
         'path' => '/',
@@ -431,12 +442,15 @@ my $default_raw = {
         'test_role_privs_invalid' => 'role:testrole:VM.Invalid,Datastore.Audit,VM.Allocate:',
     },
     pools => {
-        'test_pool_empty' => 'pool:testpool::::',
-        'test_pool_invalid' => 'pool:testpool::non-numeric:inval!d:',
-        'test_pool_members' => 'pool:testpool::123,1234:local,local-zfs:',
-        'test_pool_duplicate_vms' => 'pool:test_duplicate_vms::123,1234::',
-        'test_pool_duplicate_vms_expected' => 'pool:test_duplicate_vms::::',
-        'test_pool_duplicate_storages' => 'pool:test_duplicate_storages:::local,local-zfs:',
+        'test_pool_empty' => 'pool:testpool:::::',
+        'test_pool_invalid' => 'pool:testpool::non-numeric:inval!d::',
+        'test_pool_members' =>
+            'pool:testpool::123,1234:local,local-zfs:vnet/zone1/vnet1,vnet/zone2/vnet2:',
+        'test_pool_duplicate_vms' => 'pool:test_duplicate_vms::123,1234:::',
+        'test_pool_duplicate_vms_expected' => 'pool:test_duplicate_vms:::::',
+        'test_pool_duplicate_storages' => 'pool:test_duplicate_storages:::local,local-zfs::',
+        'test_pool_duplicate_networks' =>
+            'pool:test_duplicate_networks::::vnet/zone1/vnet1,vnet/zone2/vnet2:',
     },
     acl => {
         'acl_simple_user' => 'acl:1:/:test@pam:PVEVMAdmin:',
@@ -696,6 +710,7 @@ my $tests = [
                     $default_cfg->{test_pool_members},
                     $default_cfg->{test_pool_duplicate_vms},
                     $default_cfg->{test_pool_duplicate_storages},
+                    $default_cfg->{test_pool_duplicate_networks},
                 ],
             ),
             vms => default_pool_vms_with([$default_cfg->{test_pool_members}]),
@@ -705,15 +720,37 @@ my $tests = [
             . "\n\n\n"
             . $default_raw->{pools}->{'test_pool_members'} . "\n"
             . $default_raw->{pools}->{'test_pool_duplicate_vms'} . "\n"
-            . $default_raw->{pools}->{'test_pool_duplicate_storages'} . "\n",
+            . $default_raw->{pools}->{'test_pool_duplicate_storages'} . "\n"
+            . $default_raw->{pools}->{'test_pool_duplicate_networks'} . "\n",
         expected_raw => ""
             . $default_raw->{users}->{'root@pam'}
             . "\n\n\n"
+            . $default_raw->{pools}->{'test_pool_duplicate_networks'} . "\n"
             . $default_raw->{pools}->{'test_pool_duplicate_storages'} . "\n"
             . $default_raw->{pools}->{'test_pool_duplicate_vms_expected'} . "\n"
             . $default_raw->{pools}->{'test_pool_members'}
             . "\n\n\n",
     },
+    {
+        name => "pool_format_backward_compatibility",
+        config => {
+            acl_root => default_acls(),
+            users => default_users(),
+            roles => default_roles(),
+            pools => default_pools_with([$default_cfg->{test_pool_empty}]),
+        },
+        raw => ""
+            . $default_raw->{users}->{'root@pam'}
+            . "\n\n\n"
+            # old format: 4 colons
+            . "pool:testpool::::\n\n\n",
+        expected_raw => ""
+            . $default_raw->{users}->{'root@pam'}
+            . "\n\n\n"
+            # new format 5: colons
+            . $default_raw->{pools}->{'test_pool_empty'}
+            . "\n\n\n",
+    },
     {
         name => "acl_simple_user",
         config => {
@@ -1102,7 +1139,7 @@ my $tests = [
             . 'user:test@pam:0:0::::::' . "\n"
             . 'token:test@pam!test:0:0::' . "\n\n"
             . 'group:testgroup:::' . "\n\n"
-            . 'pool:testpool::::' . "\n\n"
+            . 'pool:testpool:::::' . "\n\n"
             . 'role:testrole::' . "\n\n",
     },
 ];
-- 
2.47.3