[PATCH pve-cluster 11/12] cfs: add hook registry for change notification consumers

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

A hook has a name, a path template and code, registered like an API
method. The registry collects the templates into one subscription and
turns each event into runs, one per hook and set of parameters, keyed
by both. Runs with the same key differ only in the event behind them,
so a burst of changes to one file needs no more than one run.

The registry filters on the event type, since a subscription only
carries templates. It checks templates at registration against the
daemon's rules, so a bad one fails where the hook is written. A resync
carries no path, so every hook gets one run without parameters.

Signed-off-by: Hannes Laimer <h.laimer@proxmox.com>
---
 debian/pve-cluster.install |   1 +
 src/PVE/Cluster/Hooks.pm   | 135 +++++++++++++++++++++++
 src/PVE/Cluster/Makefile   |   2 +-
 src/test/Makefile          |   6 +-
 src/test/hooks_test.pl     | 219 +++++++++++++++++++++++++++++++++++++
 5 files changed, 361 insertions(+), 2 deletions(-)
 create mode 100644 src/PVE/Cluster/Hooks.pm
 create mode 100644 src/test/hooks_test.pl

diff --git a/debian/pve-cluster.install b/debian/pve-cluster.install
index 77e3244..b8ebff7 100644
--- a/debian/pve-cluster.install
+++ b/debian/pve-cluster.install
@@ -4,6 +4,7 @@ usr/bin/pmxcfs
 usr/lib/
 usr/share/man/man8/pmxcfs.8
 usr/share/perl5/PVE/Cluster.pm
+usr/share/perl5/PVE/Cluster/Hooks.pm
 usr/share/perl5/PVE/Cluster/IPCConst.pm
 usr/share/perl5/PVE/Cluster/Watch.pm
 usr/share/perl5/PVE/IPCC.pm
diff --git a/src/PVE/Cluster/Hooks.pm b/src/PVE/Cluster/Hooks.pm
new file mode 100644
index 0000000..a5c8452
--- /dev/null
+++ b/src/PVE/Cluster/Hooks.pm
@@ -0,0 +1,135 @@
+package PVE::Cluster::Hooks;
+
+use strict;
+use warnings;
+
+use JSON;
+
+# A hook subscribes to a memdb path template and runs its code with the
+# placeholder values captured from a matching change. Runs are keyed by hook
+# and parameters, and one run can stand for several events that lead to the
+# same key. A hook therefore reads the state when it runs and takes the event
+# it is handed as the latest of those. Runs of different keys may overlap, so
+# a hook that writes shared state has to take the same locks an API handler
+# would.
+
+my $hooks = {};
+my $order = [];
+
+# a change of mtime alone leaves the content as it was
+my $default_types = [qw(create write rename delete mkdir)];
+my $known_types = { map { $_ => 1 } qw(create write mtime rename delete mkdir) };
+my $canonical = JSON->new->canonical;
+
+sub register_hook {
+    my ($class, $info) = @_;
+
+    my $name = $info->{name} // die "hook registration without a name\n";
+    die "hook '$name': invalid name\n" if $name !~ m/^[a-zA-Z][\w-]*$/;
+    die "hook '$name': already registered\n" if $hooks->{$name};
+    die "hook '$name': no path\n" if !defined($info->{path});
+    die "hook '$name': no code\n" if ref($info->{code}) ne 'CODE';
+
+    my $template = validate_template($name, $info->{path});
+
+    my $types = $info->{types} // $default_types;
+    for my $type ($types->@*) {
+        die "hook '$name': unknown event type '$type'\n" if !$known_types->{$type};
+    }
+
+    $hooks->{$name} = {
+        name => $name,
+        code => $info->{code},
+        types => { map { $_ => 1 } $types->@* },
+        template => $template,
+    };
+    push $order->@*, $name;
+
+    return;
+}
+
+# Same rules as the template parser in the daemon. The daemon refuses a
+# subscription as a whole if one template is bad, so a bad path fails here
+# at registration.
+sub validate_template {
+    my ($name, $path) = @_;
+
+    $path =~ s!^/+!!;
+    die "hook '$name': empty path\n" if $path eq '';
+
+    my @comps = split(m!/!, $path, -1);
+    my $seen = {};
+
+    for my $i (0 .. $#comps) {
+        my $comp = $comps[$i];
+        die "hook '$name': path component has zero length\n" if $comp eq '';
+        next if $comp !~ m/[{}]/;
+
+        my ($prefix, $body, $suffix) = $comp =~ m/^([^{}]*)\{([^{}]*)\}([^{}]*)$/
+            or die "hook '$name': malformed path component '$comp'\n";
+
+        if ($body =~ m/^([A-Za-z_][A-Za-z0-9_]*)\.\.\.$/) {
+            die "hook '$name': '{$1...}' must be the last component\n"
+                if $i != $#comps || $prefix ne '' || $suffix ne '';
+            die "hook '$name': placeholder '$1' used twice\n" if $seen->{$1}++;
+            next;
+        }
+
+        my ($pname) = $body =~ m/^([A-Za-z_][A-Za-z0-9_]*)$/
+            or die "hook '$name': malformed path component '$comp'\n";
+        die "hook '$name': placeholder '$pname' used twice\n" if $seen->{$pname}++;
+    }
+
+    return $path;
+}
+
+sub run_key {
+    my ($name, $param) = @_;
+
+    return $name if !scalar(keys $param->%*);
+
+    return "$name:" . $canonical->encode($param);
+}
+
+# pmxcfs already matched the templates and delivers the parameter sets per
+# hook name, so only the event type is filtered here.
+sub dispatch {
+    my ($class, $event) = @_;
+
+    my $change = { map { defined($event->{$_}) ? ($_ => $event->{$_}) : () } qw(type path to) };
+    my @runs;
+
+    if ($event->{type} eq 'resync') {
+        for my $name ($order->@*) {
+            push @runs, { hook => $hooks->{$name}, param => {}, key => $name, event => $change };
+        }
+        return \@runs;
+    }
+
+    my $params = $event->{params} // {};
+    for my $name ($order->@*) {
+        my $hook = $hooks->{$name};
+        next if !$hook->{types}->{ $event->{type} };
+
+        for my $param (($params->{$name} // [])->@*) {
+            my $key = run_key($name, $param);
+            push @runs, { hook => $hook, param => $param, key => $key, event => $change };
+        }
+    }
+
+    return \@runs;
+}
+
+sub subscription {
+    my ($class) = @_;
+
+    return { patterns => { map { $_ => $hooks->{$_}->{template} } $order->@* } };
+}
+
+sub hooks {
+    my ($class) = @_;
+
+    return [map { $hooks->{$_} } $order->@*];
+}
+
+1;
diff --git a/src/PVE/Cluster/Makefile b/src/PVE/Cluster/Makefile
index 7beb976..0da7838 100644
--- a/src/PVE/Cluster/Makefile
+++ b/src/PVE/Cluster/Makefile
@@ -1,6 +1,6 @@
 PVEDIR=$(DESTDIR)/usr/share/perl5/PVE
 
-SOURCES=IPCConst.pm Setup.pm Watch.pm
+SOURCES=Hooks.pm IPCConst.pm Setup.pm Watch.pm
 
 .PHONY: install
 install: $(SOURCES)
diff --git a/src/test/Makefile b/src/test/Makefile
index 7b36fca..de07608 100644
--- a/src/test/Makefile
+++ b/src/test/Makefile
@@ -4,7 +4,7 @@ cpgtest: cpgtest.c
 	gcc -Wall cpgtest.c $(shell pkg-config --cflags --libs libcpg libqb) -o cpgtest
 
 .PHONY: check install clean distclean
-check: corosync-parser-test test-mac-prefix watch-client-test
+check: corosync-parser-test test-mac-prefix watch-client-test hooks-test
 
 .PHONY: corosync-parser-test
 corosync-parser-test:
@@ -18,5 +18,9 @@ test-mac-prefix:
 watch-client-test:
 	perl watch_client_test.pl
 
+.PHONY: hooks-test
+hooks-test:
+	perl hooks_test.pl
+
 distclean: clean
 clean:
diff --git a/src/test/hooks_test.pl b/src/test/hooks_test.pl
new file mode 100644
index 0000000..e49fbd9
--- /dev/null
+++ b/src/test/hooks_test.pl
@@ -0,0 +1,219 @@
+#!/usr/bin/perl
+
+use lib '..';
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use PVE::Cluster::Hooks;
+
+my $noop = sub { };
+
+PVE::Cluster::Hooks->register_hook({
+    name => 'guest',
+    path => 'nodes/{node}/qemu-server/{vmid}.conf',
+    code => $noop,
+});
+
+PVE::Cluster::Hooks->register_hook({
+    name => 'dc',
+    path => '/datacenter.cfg',
+    types => ['write', 'rename'],
+    code => $noop,
+});
+
+PVE::Cluster::Hooks->register_hook({
+    name => 'sdn',
+    path => 'sdn/{file...}',
+    code => $noop,
+});
+
+PVE::Cluster::Hooks->register_hook({
+    name => 'locks',
+    path => 'priv/lock/{path...}',
+    types => ['mtime', 'create', 'delete'],
+    code => $noop,
+});
+
+is_deeply(
+    [map { $_->{name} } PVE::Cluster::Hooks->hooks()->@*],
+    ['guest', 'dc', 'sdn', 'locks'],
+    'hooks are kept in registration order',
+);
+
+is_deeply(
+    PVE::Cluster::Hooks->subscription(),
+    {
+        patterns => {
+            guest => 'nodes/{node}/qemu-server/{vmid}.conf',
+            dc => 'datacenter.cfg',
+            sdn => 'sdn/{file...}',
+            locks => 'priv/lock/{path...}',
+        },
+    },
+    'the subscription holds every template',
+);
+
+my $runs = sub {
+    my ($event) = @_;
+    return [map { { name => $_->{hook}->{name}, param => $_->{param}, key => $_->{key} } }
+        PVE::Cluster::Hooks->dispatch($event)->@*];
+};
+
+my $guest = { node => 'n1', vmid => '100' };
+
+is_deeply(
+    $runs->({
+        type => 'write',
+        path => 'nodes/n1/qemu-server/100.conf',
+        params => { guest => [$guest] },
+    }),
+    [{ name => 'guest', param => $guest, key => 'guest:{"node":"n1","vmid":"100"}' }],
+    'delivered parameters become the run and its key',
+);
+
+is_deeply(
+    $runs->({
+        type => 'rename',
+        path => 'nodes/n1/qemu-server/100.conf',
+        to => 'nodes/n2/qemu-server/100.conf',
+        params => { guest => [$guest, { node => 'n2', vmid => '100' }] },
+    }),
+    [
+        { name => 'guest', param => $guest, key => 'guest:{"node":"n1","vmid":"100"}' },
+        {
+            name => 'guest',
+            param => { node => 'n2', vmid => '100' },
+            key => 'guest:{"node":"n2","vmid":"100"}',
+        },
+    ],
+    'every delivered parameter set is a run of its own',
+);
+
+is_deeply(
+    $runs->({ type => 'write', path => 'datacenter.cfg', params => { dc => [{}] } }),
+    [{ name => 'dc', param => {}, key => 'dc' }],
+    'a parameterless hook is keyed by its name',
+);
+
+is_deeply(
+    $runs->({ type => 'create', path => 'datacenter.cfg', params => { dc => [{}] } }),
+    [],
+    'event types outside the list are ignored',
+);
+
+is_deeply(
+    $runs->({
+        type => 'mtime',
+        path => 'nodes/n1/qemu-server/100.conf',
+        params => { guest => [$guest] },
+    }),
+    [],
+    'mtime is not delivered by default',
+);
+
+is_deeply(
+    $runs->({
+        type => 'mtime',
+        path => 'priv/lock/file-storage_cfg/a',
+        params => { locks => [{ path => 'file-storage_cfg/a' }] },
+    }),
+    [{
+        name => 'locks',
+        param => { path => 'file-storage_cfg/a' },
+        key => 'locks:{"path":"file-storage_cfg/a"}',
+    }],
+    'a spanning placeholder carries the rest of the path',
+);
+
+is_deeply(
+    $runs->({
+        type => 'write',
+        path => 'sdn/zones.cfg',
+        params => { sdn => [{ file => 'zones.cfg' }], other => [{}] },
+    }),
+    [{ name => 'sdn', param => { file => 'zones.cfg' }, key => 'sdn:{"file":"zones.cfg"}' }],
+    'parameters for unknown hooks are ignored',
+);
+
+is_deeply(
+    $runs->({ type => 'write', path => 'datacenter.cfg' }),
+    [],
+    'an event without parameters runs nothing',
+);
+
+my $untouched = { type => 'delete', path => 'datacenter.cfg', params => { dc => [{}] } };
+PVE::Cluster::Hooks->dispatch($untouched);
+is_deeply(
+    $untouched,
+    { type => 'delete', path => 'datacenter.cfg', params => { dc => [{}] } },
+    'dispatch leaves the event alone',
+);
+
+is_deeply(
+    [sort map { $_->{key} } $runs->({ type => 'resync' })->@*],
+    ['dc', 'guest', 'locks', 'sdn'],
+    'a resync runs every hook without parameters',
+);
+
+my $fails = sub {
+    my ($info, $like, $desc) = @_;
+    eval { PVE::Cluster::Hooks->register_hook($info) };
+    like($@, $like, $desc);
+};
+
+$fails->(
+    { name => 'guest', path => 'x', code => $noop },
+    qr/already registered/,
+    'duplicate names are rejected',
+);
+$fails->(
+    { name => '1bad', path => 'x', code => $noop },
+    qr/invalid name/,
+    'names must start with a letter',
+);
+$fails->({ name => 'nocode', path => 'x' }, qr/no code/, 'a hook needs code');
+$fails->(
+    { name => 'badtype', path => 'x', types => ['chmod'], code => $noop },
+    qr/unknown event type/,
+    'event types are validated',
+);
+$fails->(
+    { name => 'twice', path => 'a/{x}/{x}', code => $noop },
+    qr/used twice/,
+    'placeholder names must be unique',
+);
+$fails->(
+    { name => 'broken', path => 'a/{x', code => $noop },
+    qr/malformed path component/,
+    'unterminated placeholders are rejected',
+);
+$fails->(
+    { name => 'double', path => 'a/{x}{y}', code => $noop },
+    qr/malformed path component/,
+    'a component holds one placeholder at most',
+);
+$fails->(
+    { name => 'typed', path => 'sdn/{file:x}', code => $noop },
+    qr/malformed path component/,
+    'a placeholder holds a name and nothing else',
+);
+$fails->(
+    { name => 'middle', path => '{x...}/b', code => $noop },
+    qr/must be the last component/,
+    'the spanning placeholder comes last',
+);
+$fails->(
+    { name => 'slashes', path => 'a//b', code => $noop },
+    qr/zero length/,
+    'empty components are rejected',
+);
+$fails->(
+    { name => 'empty', path => '/', code => $noop },
+    qr/empty path/,
+    'an empty template is rejected',
+);
+
+done_testing();
-- 
2.47.3