[PATCH pve-access-control v3 04/12] fix #7294: acl: pool: add SDN VNets as pool members

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

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

Track entries using a type prefix for future expansion:
* vnet/<zone>/<vnet> (untagged VNet access only)
* vnet/<zone>/<vnet>/* (untagged and tagged traffic access)
* vnet/<zone>/<vnet>/<vlan> (specific VLAN tag access only)

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 and backwards compatibility.

Suggested-by: Daniel Kral <d.kral@proxmox.com>
Signed-off-by: David Riley <d.riley@proxmox.com>

Link: https://bugzilla.proxmox.com/show_bug.cgi?id=7294
---
 src/PVE/AccessControl.pm  | 27 +++++++++++---
 src/PVE/RPCEnvironment.pm | 75 +++++++++++++++++++++++++++++++++++++--
 src/test/parser_writer.pl | 53 ++++++++++++++++++++++-----
 3 files changed, 139 insertions(+), 16 deletions(-)

diff --git a/src/PVE/AccessControl.pm b/src/PVE/AccessControl.pm
index d7bb679..50fdb2d 100644
--- a/src/PVE/AccessControl.pm
+++ b/src/PVE/AccessControl.pm
@@ -1609,7 +1609,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";
@@ -1617,7 +1617,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!/!) {
@@ -1626,8 +1626,12 @@ 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 => {} }
-                        if !$cfg->{pools}->{$parent};
+
+                    if (!$cfg->{pools}->{$parent}) {
+                        $cfg->{pools}->{$parent} =
+                            { vms => {}, storage => {}, pools => {}, network => {} };
+                    }
+
                     $cfg->{pools}->{$parent}->{pools}->{$curr} = 1;
                     $curr = $parent;
                 }
@@ -1659,7 +1663,19 @@ sub parse_user_config {
                     next;
                 }
                 $cfg->{pools}->{$pool}->{storage}->{$storeid} = 1;
+
+            }
+            for 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;
 
@@ -1741,8 +1757,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";
diff --git a/src/PVE/RPCEnvironment.pm b/src/PVE/RPCEnvironment.pm
index 7591aa9..6fe1ab9 100644
--- a/src/PVE/RPCEnvironment.pm
+++ b/src/PVE/RPCEnvironment.pm
@@ -53,9 +53,48 @@ my $compile_acl_path = sub {
                     $data->{poolroles}->{"/storage/$storeid"}->{$role} = 1;
                 }
             }
+
+            for 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";
+
+                    for my $role (keys $pool_roles->%*) {
+                        if (!defined($vlan)) {
+                            # base vnet only (untagged only)
+                            $data->{poolroles}->{$acl_path}->{$role} = 1;
+                        } elsif ($vlan eq '*') {
+                            # base vnet + tagged and untagged (propagation)
+                            $data->{poolroles}->{$acl_path}->{$role} = 1;
+                            $data->{poolroles}->{"$acl_path/*"}->{$role} = 1;
+                        } else {
+                            # specific vlan tag only
+                            $data->{poolroles}->{"$acl_path/$vlan"}->{$role} = 1;
+                        }
+                    }
+                }
+            }
         }
     }
 
+    my $poolroles_path = $data->{poolroles}->{$path};
+
+    # Pool ACL paths are setup without propagation, therefore checking
+    # /sdn/zones/<zone>/<vnet>/<tag> fails even if the user has permission for
+    # the base path /sdn/zones/<zone>/<vnet>.
+    # To allow opt-in propagation, the wildcard path /sdn/zones/<zone>/<vnet>/*
+    # is introduced.
+    if (!defined($poolroles_path) && $path =~ m|^/sdn/zones/[^/]+/[^/]+/[0-9]+$|) {
+        my @parts = split('/', $path);
+        my $base_vnet_path = join('/', @parts[0 .. 4]);
+
+        # inherit the permissions only if the explicit /* wildcard was used
+        $poolroles_path = $data->{poolroles}->{"$base_vnet_path/*"};
+    }
+
     # get roles of current user/token on checked path - this already handles
     # propagation and NoAccess along the path
     #
@@ -64,14 +103,14 @@ my $compile_acl_path = sub {
     my $roles = PVE::AccessControl::roles($cfg, $user, $path);
 
     # apply roles inherited from pools
-    if ($data->{poolroles}->{$path}) {
+    if ($poolroles_path) {
         # NoAccess must not be trumped by pool ACLs
         if (!defined($roles->{NoAccess})) {
-            if ($data->{poolroles}->{$path}->{NoAccess}) {
+            if ($poolroles_path->{NoAccess}) {
                 # but pool ACL NoAccess trumps regular ACL
                 $roles = { 'NoAccess' => 0 };
             } else {
-                foreach my $role (keys %{ $data->{poolroles}->{$path} }) {
+                for my $role (keys $poolroles_path->%*) {
                     # only use role from pool ACL if regular ACL didn't already
                     # set it, and never set propagation for pool-derived ACLs
                     $roles->{$role} = 0 if !defined($roles->{$role});
@@ -274,6 +313,17 @@ sub get_effective_permissions {
         foreach my $storeid (keys %{ $d->{storage} }) {
             $paths->{"/storage/$storeid"} = 1;
         }
+
+        for 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);
+                $paths->{$vnet_path} = 1;
+            }
+        }
     }
 
     my $perms = {};
@@ -353,6 +403,25 @@ sub check_sdn_bridge {
         }
     }
 
+    # check access to VLANs via pools
+    for my $pool (keys $cfg->{pools}->%*) {
+        my $poolcfg = $cfg->{pools}->{$pool};
+        next if !$poolcfg->{network};
+
+        for my $network_key (keys $poolcfg->{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