test/run_pci_addr_checks.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5 use experimental 'smartmatch';
   6
   7 use lib qw(..);
   8
   9 use Test::More;
  10
  11 use PVE::Tools qw(file_get_contents);
  12 use PVE::QemuServer::PCI;
  13
  14 # not our format but that what QEMU gets passed with '-readconfig'
  15 sub slurp_qemu_config {
  16     my ($fn) = @_;
  17
  18     my $raw = file_get_contents($fn);
  19
  20     my $lineno = 0;
  21     my $cfg = {};
  22     my $group;
  23     my $skip_to_next_group;
  24     while ($raw =~ /^\h*(.*?)\h*$/gm) {
  25         my $line = $1;
  26         $lineno++;
  27         next if !$line || $line =~ /^#/;
  28
  29         # tried to follow qemu's qemu_config_parse function
  30         if ($line =~ /\[(\S{1,63}) "([^"\]]{1,63})"\]/) {
  31             $group = $2;
  32             $skip_to_next_group = 0;
  33             if ($1 ne 'device') {
  34                 $group = undef;
  35                 $skip_to_next_group = 1;
  36             }
  37         } elsif ($line =~ /\[([^\]]{1,63})\]/) {
  38             $group = undef;
  39             $skip_to_next_group = 1;
  40         } elsif ($group) {
  41             if ($line =~ /(\S{1,63}) = "([^\"]{1,1023})"/) {
  42                 my ($k, $v) = ($1, $2);
  43                 $cfg->{$group}->{$k} = $v;
  44             } else {
  45                 print "ignoring $fn:$lineno: $line\n";
  46             }
  47         } else {
  48             warn "ignore $fn:$lineno, currently no group\n" if !$skip_to_next_group;
  49         }
  50     }
  51
  52     #use Data::Dumper;
  53     #print Dumper($cfg) . "\n";
  54 }
  55 # FIXME: TODO! read those configs and check for conflicts!
  56 # q35 stuff with PCIe and others with PCI
  57 # slurp_qemu_config("../pve-q35.cfg");
  58
  59 print "testing PCI(e) address conflicts\n";
  60
  61 # exec tests
  62
  63 #FIXME: make cross PCI <-> PCIe check sense at all??
  64 my $addr_map = {};
  65 my ($fail, $ignored) = (0, 0);
  66 sub check_conflict {
  67     my ($id, $what) = @_;
  68
  69     my ($bus, $addr) = $what->@{qw(bus addr)};
  70     my $full_addr = "$bus:$addr";
  71
  72     if (defined(my $conflict = $addr_map->{$full_addr})) {
  73         if (my @ignores = $what->{conflict_ok}) {
  74             if ($conflict ~~ @ignores) {
  75                 note("OK: ignore conflict for '$full_addr' between '$id' and '$conflict'");
  76                 $ignored++;
  77                 return;
  78             }
  79         }
  80         note("ERR: conflict for '$full_addr' between '$id' and '$conflict'");
  81         $fail++;
  82     } else {
  83         $addr_map->{$full_addr} = $id;
  84     }
  85 }
  86
  87
  88 my $pci_map = PVE::QemuServer::PCI::get_pci_addr_map();
  89 while (my ($id, $what) = each %$pci_map) {
  90     check_conflict($id, $what);
  91 }
  92
  93 my $pcie_map = PVE::QemuServer::PCI::get_pcie_addr_map();
  94 while (my ($id, $what) = each %$pcie_map) {
  95     check_conflict($id, $what);
  96 }
  97
  98 if ($fail) {
  99     fail("PCI(e) address conflict check, ignored: $ignored, conflicts: $fail");
 100 } else {
 101     pass("PCI(e) address conflict check, ignored: $ignored");
 102 }
 103
 104 done_testing();