]> git.proxmox.com Git - pve-cluster.git/commitdiff
add some dev test scripts for evaluating a few IPC calls hands on
authorThomas Lamprecht <t.lamprecht@proxmox.com>
Mon, 27 Jan 2020 17:15:56 +0000 (18:15 +0100)
committerThomas Lamprecht <t.lamprecht@proxmox.com>
Mon, 27 Jan 2020 17:24:04 +0000 (18:24 +0100)
simple stuff and not a real unit or regression test, still useful
when checking how/if something works or benchmarking..

Signed-off-by: Thomas Lamprecht <t.lamprecht@proxmox.com>
data/test/scripts/benchmark-config-get-property.pl [new file with mode: 0755]
data/test/scripts/test-broadcast-kv.pl [new file with mode: 0755]
data/test/scripts/test-config-get-property.pl [new file with mode: 0755]
data/test/scripts/test-verify-token.pl [new file with mode: 0755]

diff --git a/data/test/scripts/benchmark-config-get-property.pl b/data/test/scripts/benchmark-config-get-property.pl
new file mode 100755 (executable)
index 0000000..f009c5a
--- /dev/null
@@ -0,0 +1,92 @@
+#!/usr/bin/perl
+
+use lib '../../';
+
+use strict;
+use warnings;
+
+#use Data::Dumper;
+use Time::HiRes qw( gettimeofday tv_interval );
+
+use PVE::Tools;
+use PVE::Cluster;
+use PVE::QemuConfig;
+use PVE::LXC::Config;
+
+sub sec_to_unit {
+       my $sec = shift;
+
+       my $unit_index = 0;
+       while ($sec < 1) {
+               $sec *= 1000;
+               $unit_index++;
+       }
+
+       my $unit = @{['s', 'ms', 'us', 'ns', 'ps']}[$unit_index];
+
+       return wantarray ? ($sec, $unit) : "$sec $unit";
+
+}
+
+my $results = {};
+
+sub perf {
+    my ($name, $loops, $code) = @_;
+
+    return if !defined($loops) || $loops <= 0;
+
+    my $loop = 0;
+    eval {
+       my $t0 = [gettimeofday];
+
+       for (my $i = 0; $i<$loops; $i++) {
+               $code->();
+       }
+
+       my $elapsed = tv_interval ($t0, [gettimeofday]);
+
+       my $total = sec_to_unit($elapsed);
+       my $per_loop = $elapsed/$loops;
+       $loop = sec_to_unit($per_loop);
+
+       $results->{$name} = [ $elapsed * 1000, $per_loop * 1000 ];
+
+       print STDERR "elapsed['$name' x $loops]: $total => $loop/loop\n";
+    }; warn $@ if $@;
+
+    return $loop;
+}
+
+my $loops = shift // 3;
+my $vmid = shift // 0;
+my $prop = shift // 'lock';
+
+perf('cfg-get-prop', $loops, sub {
+    my $res = PVE::Cluster::get_guest_config_property($prop, $vmid);
+});
+
+PVE::Cluster::cfs_update();
+perf('perl-manual', $loops, sub {
+    my $res = {};
+
+    # modeled after the manager API cluster/resource call
+    my $vmlist = PVE::Cluster::get_vmlist() || {};
+    my $idlist = $vmlist->{ids} || {};
+    foreach my $vmid (keys %$idlist) {
+
+       my $data = $idlist->{$vmid};
+       my $typedir = $data->{type} eq 'qemu' ? 'qemu-server' : 'lxc';
+
+       my $conf = PVE::Cluster::cfs_read_file("nodes/$data->{node}/$typedir/$vmid.conf");
+
+       my $v = $conf->{$prop};
+       $res->{$vmid} = { $prop => $v } if defined($v);
+    }
+});
+#PVE::Cluster::get_tasklist('dev5');
+
+my $a = $results->{'cfg-get-prop'};
+my $b = $results->{'perl-manual'};
+printf("$loops\t%.2f\t%.2f\t%.2f\t%.2f\n", $a->[0], $a->[1], $b->[0], $b->[1]);
+
+#print "res: " . Dumper($res) ."\n";
diff --git a/data/test/scripts/test-broadcast-kv.pl b/data/test/scripts/test-broadcast-kv.pl
new file mode 100755 (executable)
index 0000000..d2166a2
--- /dev/null
@@ -0,0 +1,28 @@
+#!/usr/bin/perl
+
+use lib '../../';
+
+use strict;
+use warnings;
+
+use JSON;
+
+use PVE::Tools;
+use PVE::Cluster;
+
+## first broadcast a value for a key then you can check if you get it back by
+# omitting the value, or directly querys an already exisitng value (e.g., ceph
+# stats)
+
+my $k = shift // die "no key";
+my $v = shift;
+
+if (defined $v) {
+    print "broadcasting kv pair ($k, $v)\n";
+    PVE::Cluster::broadcast_node_kv($k, $v);
+}
+
+print "querying value for key: $k\n";
+my $res = PVE::Cluster::get_node_kv($k);
+
+print "res: " . to_json($res, {utf8 => 1, pretty => 1}) ."\n";
diff --git a/data/test/scripts/test-config-get-property.pl b/data/test/scripts/test-config-get-property.pl
new file mode 100755 (executable)
index 0000000..80a726c
--- /dev/null
@@ -0,0 +1,21 @@
+#!/usr/bin/perl
+
+use lib '../../';
+
+use strict;
+use warnings;
+
+use JSON;
+
+use PVE::Tools;
+use PVE::Cluster;
+
+## for quick test do:
+# echo 'lock: test' >> /etc/pve/lxc/104.conf
+
+my $vmid = shift // 104;
+my $prop = shift // 'lock';
+
+my $res = PVE::Cluster::get_guest_config_property($prop, $vmid);
+
+print "res: " . to_json($res, {utf8 => 1, pretty => 1}) ."\n";
diff --git a/data/test/scripts/test-verify-token.pl b/data/test/scripts/test-verify-token.pl
new file mode 100755 (executable)
index 0000000..11f07dc
--- /dev/null
@@ -0,0 +1,21 @@
+#!/usr/bin/perl
+
+use lib '../../';
+
+use strict;
+use warnings;
+
+use Data::Dumper;
+
+use PVE::Tools;
+use PVE::Cluster;
+
+## For quick test you can add arbitrary fake tokens to token.cfg:
+# echo 'root@pam 1234512345XXXXX' >> /etc/pve/priv/token.cfg
+
+my $token = shift // '1234512345XXXXX';
+my $userid = shift // 'root@pam';
+
+my $res = PVE::Cluster::verify_token($userid, $token);
+
+print "token '$userid $token' ". ($res ? '' : "not " ) ."found\n";