[PATCH pve-network v3 25/45] sdn: microseg: add tag matcher

[Hannes Laimer <h.laimer@proxmox.com>]

A tag matcher binds every guest with the given tags to a set of
groups, guests created later included.

A tag the matchers name moves a guest between groups, an SDN change
like putting a NIC on a vnet. So a new permission check requires
SDN.Use on /sdn/microseg when a guest gains or loses such a tag.

Signed-off-by: Hannes Laimer <h.laimer@proxmox.com>
---
 debian/control                            |  1 +
 src/PVE/API2/Network/SDN/Microseg/Base.pm |  7 ++-
 src/PVE/Network/SDN.pm                    |  1 +
 src/PVE/Network/SDN/Microseg.pm           | 74 +++++++++++++++++++----
 4 files changed, 71 insertions(+), 12 deletions(-)

diff --git a/debian/control b/debian/control
index 86a6694d3a5f..f25e2ccfdf2a 100644
--- a/debian/control
+++ b/debian/control
@@ -41,6 +41,7 @@ Description: Proxmox VE's SDN (Software Defined Network) stack
 Package: libpve-network-api-perl
 Architecture: all
 Depends: libpve-common-perl (>= 9.0.2),
+         libpve-guest-common-perl,
          pve-firewall (>= 5.1.0~),
          pve-cluster (>= 9.0.1),
          libpve-network-perl (= ${binary:Version}),
diff --git a/src/PVE/API2/Network/SDN/Microseg/Base.pm b/src/PVE/API2/Network/SDN/Microseg/Base.pm
index dde88d10c7b1..58ec75c6fb12 100644
--- a/src/PVE/API2/Network/SDN/Microseg/Base.pm
+++ b/src/PVE/API2/Network/SDN/Microseg/Base.pm
@@ -5,6 +5,7 @@ use warnings;
 
 use PVE::Cluster;
 use PVE::Exception qw(raise_param_exc);
+use PVE::GuestHelpers;
 use PVE::JSONSchema qw(get_standard_option);
 use PVE::Tools qw(extract_param);
 
@@ -85,7 +86,7 @@ my sub assert_non_empty_lists {
     my ($param) = @_;
 
     my $errors = {};
-    for my $property (qw(src dst groups)) {
+    for my $property (qw(src dst groups tags)) {
         my $value = $param->{$property};
         $errors->{$property} = "must not be empty" if $value && !@$value;
     }
@@ -108,6 +109,10 @@ my sub create_object {
     my $lock_token = extract_param($param, 'lock-token');
     $param->{type} = $type;
 
+    if ($param->{tags}) {
+        $param->{tags} = PVE::GuestHelpers::get_unique_tags($param->{tags}, 1);
+    }
+
     PVE::Cluster::check_cfs_quorum();
     mkdir("/etc/pve/sdn");
 
diff --git a/src/PVE/Network/SDN.pm b/src/PVE/Network/SDN.pm
index 107095e3ca71..0aef192c2815 100644
--- a/src/PVE/Network/SDN.pm
+++ b/src/PVE/Network/SDN.pm
@@ -543,6 +543,7 @@ sub encode_value {
         || $key eq 'secondary-controllers'
         || $key eq 'redistribute'
         || $key eq 'groups'
+        || $key eq 'tags'
         || $key eq 'src'
         || $key eq 'dst'
     ) {
diff --git a/src/PVE/Network/SDN/Microseg.pm b/src/PVE/Network/SDN/Microseg.pm
index 3cd9c3a8ed35..8090043268a7 100644
--- a/src/PVE/Network/SDN/Microseg.pm
+++ b/src/PVE/Network/SDN/Microseg.pm
@@ -34,7 +34,7 @@ PVE::JSONSchema::register_standard_option(
 
 cfs_register_file('sdn/microseg.cfg', \&parse_microseg_config, \&write_microseg_config);
 
-our $ASSIGNMENT_TYPES = ['guest-assignment'];
+our $ASSIGNMENT_TYPES = ['guest-assignment', 'tag-assignment'];
 
 sub parse_microseg_config {
     my ($filename, $raw) = @_;
@@ -202,7 +202,8 @@ sub assignment_properties {
         $properties->{type} = {
             type => 'string',
             enum => $ASSIGNMENT_TYPES,
-            description => "The matcher kind. 'guest-assignment' binds a specific guest.",
+            description => "The matcher kind. 'guest-assignment' binds a specific guest,"
+                . " 'tag-assignment' every guest carrying the matched tags.",
         };
         $properties->{vmid} = get_standard_option(
             'pve-vmid',
@@ -212,6 +213,27 @@ sub assignment_properties {
                 description => "The guest whose NICs to bind.",
             },
         );
+        $properties->{tags} = {
+            type => 'array',
+            items => {
+                type => 'string',
+                format => 'pve-tag',
+            },
+            'type-property' => 'type',
+            'instance-types' => ['tag-assignment'],
+            description => "The guest tags to match. They are normalized like the tags on a"
+                . " guest, so case only matters with a case-sensitive datacenter tag style.",
+        };
+        $properties->{'tag-match'} = {
+            type => 'string',
+            enum => [@MATCH_KINDS],
+            optional => 1,
+            default => 'any',
+            'type-property' => 'type',
+            'instance-types' => ['tag-assignment'],
+            description => "How tags match. 'any' shares a listed tag, 'all' carries every"
+                . " listed tag, 'exact' equals the listed set.",
+        };
         $properties->{iface} = {
             type => 'integer',
             minimum => 0,
@@ -247,10 +269,36 @@ sub optional_properties {
     return { map { $_ => { $properties->{$_}->%*, optional => 1 } } keys $properties->%* };
 }
 
+sub policy_tags {
+    my $tags = {};
+    for my $entry (values config()->to_sections()->%*) {
+        next if ($entry->{type} // '') ne 'tag-assignment';
+        $tags->{$_} = 1 for ($entry->{tags} // [])->@*;
+    }
+    return $tags;
+}
+
+# adding or removing a tag the assignments name can move the guest between groups, an SDN action
+# like putting a NIC on a vnet, so it needs SDN.Use on the policy. Both lists are tags as stored
+# in the guest config.
+sub check_tag_access {
+    my ($rpcenv, $authuser, $old, $new) = @_;
+
+    my %old = map { $_ => 1 } PVE::Tools::split_list($old // '');
+    my %new = map { $_ => 1 } PVE::Tools::split_list($new // '');
+    my $policy_tags = policy_tags();
+    for my $tag (keys %old, keys %new) {
+        next if ($old{$tag} // 0) == ($new{$tag} // 0) || !$policy_tags->{$tag};
+        $rpcenv->check($authuser, '/sdn/microseg', ['SDN.Use']);
+        return;
+    }
+}
+
 sub guest_inventory {
     my (%opts) = @_;
 
-    my @props = map { "net$_" } 0 .. $MAX_NIC_INDEX;
+    # the data plane takes a guest's NICs from the node, so an apply leaves them out
+    my @props = ('tags', $opts{skip_nics} ? () : map { "net$_" } 0 .. $MAX_NIC_INDEX);
 
     my $by_vmid = PVE::Cluster::get_guest_config_properties(\@props, $opts{vmid});
 
@@ -258,11 +306,14 @@ sub guest_inventory {
     for my $vmid (sort { $a <=> $b } keys %$by_vmid) {
         my $guest = $by_vmid->{$vmid};
 
+        my @tags = PVE::Tools::split_list($guest->{tags});
+
         my @nics = grep { defined $guest->{"net$_"} } 0 .. $MAX_NIC_INDEX;
 
         push @$inventory,
             {
                 vmid => $vmid,
+                tags => \@tags,
                 nics => \@nics,
             };
     }
@@ -290,13 +341,13 @@ my sub parse_guest_nic {
     return $iface =~ m/^(?:tap|veth)(\d+)i(\d+)$/;
 }
 
-# the guest as the inventory lists it, with nothing but its vmid when it has no NICs
+# the guest as the inventory lists it, with nothing but its vmid when it has no tags
 my sub guest_info {
     my ($vmid) = @_;
 
-    my ($guest) = guest_inventory(vmid => $vmid)->@*;
+    my ($guest) = guest_inventory(vmid => $vmid, skip_nics => 1)->@*;
 
-    return $guest // { vmid => int($vmid), nics => [] };
+    return $guest // { vmid => int($vmid), tags => [], nics => [] };
 }
 
 # an unmounted pmxcfs reads like a config that was never committed, and enforcement would be dropped
@@ -333,11 +384,12 @@ sub apply_all {
     eval {
         my $lock = PVE::RS::SDN::Microseg::ExclusiveLock->new();
         my $raw = read_running_config();
-        $lock->apply($raw, guest_inventory())
-            or !is_configured()
-            or log_warn("microseg: the running config carries no microseg block, as written"
-                . " before the upgrade or by a node without microsegmentation support, leaving"
-                . " enforcement unchanged");
+        if (!$lock->apply($raw, guest_inventory(skip_nics => 1))) {
+            log_warn("microseg: the running config carries no microseg block, as written"
+                    . " before the upgrade or by a node without microsegmentation support, leaving"
+                    . " enforcement unchanged")
+                if is_configured();
+        }
     };
     die "microseg: failed to apply running config: $@" if $@;
 }
-- 
2.47.3