test/etc_network_interfaces/runtest.pl

   1 #!/usr/bin/perl
   2
   3 use lib '../../src';
   4 use lib '.';
   5 use strict;
   6 use warnings;
   7
   8 use Carp;
   9 use POSIX;
  10 use IO::Handle;
  11 use Storable qw(dclone);
  12
  13 use PVE::INotify;
  14
  15 # Current config, r() parses a network interface string into this variable
  16 our $config;
  17
  18 ##
  19 ## Temporary files:
  20 ##
  21 # perl conveniently lets you open a string as filehandle so we allow tests
  22 # to temporarily save interface files to virtual files:
  23 my %saved_files;
  24
  25 # Load a temp-file and return it as a string, if it didn't exist, try loading
  26 # a real file.
  27 sub load($) {
  28     my ($from) = @_;
  29
  30     if (my $local = $saved_files{$from}) {
  31       return $local;
  32     }
  33
  34     open my $fh, '<', $from or die "failed to open $from: $!";
  35     local $/ = undef;
  36     my $data = <$fh>;
  37     close $fh;
  38     return $data;
  39 }
  40
  41 # Save a temporary file.
  42 sub save($$) {
  43     my ($file, $data) = @_;
  44     $saved_files{$file} = $data;
  45 }
  46
  47 # Delete a temporary file
  48 sub delfile($) {
  49     my $file = @_;
  50     die "no such file: $file" if !delete $saved_files{$file};
  51 }
  52
  53 # Delete all temporary files.
  54 sub flush_files() {
  55     foreach (keys %saved_files) {
  56         delete $saved_files{$_} if $_ !~ m,^shared/,;
  57     }
  58 }
  59
  60 ##
  61 ## Interface parsing:
  62 ##
  63
  64 # Read an interfaces file with optional /proc/net/dev file content string and
  65 # the list of active interfaces, which otherwise default
  66 sub r($;$$) {
  67     my ($ifaces, $proc_net_dev, $active) = @_;
  68     $proc_net_dev //= load('proc_net_dev');
  69     $active //= [split(/\s+/, load('active_interfaces'))];
  70     open my $fh1, '<', \$ifaces;
  71     open my $fh2, '<', \$proc_net_dev;
  72     $config = PVE::INotify::__read_etc_network_interfaces($fh1, $fh2, $active);
  73     close $fh1;
  74 }
  75
  76 # Turn the current network config into a string.
  77 sub w() {
  78     # write shouldn't be able to change a previously parsed config
  79     my $config_clone = dclone($config);
  80     return PVE::INotify::__write_etc_network_interfaces($config_clone);
  81 }
  82
  83 ##
  84 ## Interface modification helpers
  85 ##
  86
  87 # Update an interface
  88 sub update_iface($$%) {
  89     my ($name, $families, %extra) = @_;
  90
  91     my $ifaces = $config->{ifaces};
  92     my $if = $ifaces->{$name};
  93
  94     die "no such interface: $name\n" if !$if;
  95
  96     $if->{exists} = 1;
  97
  98     # merge extra flags (like bridge_ports, ovs_*) directly
  99     $if->{$_} = $extra{$_} foreach keys %extra;
 100
 101     return if !$families;
 102
 103     my $if_families = $if->{families} ||= [];
 104     foreach my $family (@$families) {
 105         my $type = delete $family->{family};
 106         @$if_families = ((grep { $_ ne $type } @$if_families), $type);
 107
 108         (my $suffix = $type) =~ s/^inet//;
 109         $if->{"method$suffix"} = $family->{address} ? 'static' : 'manual';
 110         foreach(qw(address netmask gateway options)) {
 111             if (my $value = delete $family->{$_}) {
 112                 $if->{"$_${suffix}"} = $value;
 113             }
 114         }
 115     }
 116 }
 117
 118 # Create an interface and error if it already exists.
 119 sub new_iface($$$%) {
 120     my ($name, $type, $families, %extra) = @_;
 121     my $ifaces = $config->{ifaces};
 122     croak "interface already exists: $name" if $ifaces->{$name};
 123     $ifaces->{$name} = { type => $type };
 124     update_iface($name, $families, %extra);
 125 }
 126
 127 # Delete an interface and error if it did not exist.
 128 sub delete_iface($;$) {
 129     my ($name, $family) = @_;
 130     my $ifaces = $config->{ifaces};
 131     my $if = $ifaces->{$name} ||= {};
 132     croak "interface doesn't exist: $name" if !$if;
 133
 134     if (!$family) {
 135       delete $ifaces->{$name};
 136       return;
 137     }
 138
 139     my $families = $if->{families};
 140     @$families = grep {$_ ne $family} @$families;
 141     (my $suffix = $family) =~ s/^inet//;
 142     delete $if->{"$_$suffix"} foreach qw(address netmask gateway options);
 143 }
 144
 145 ##
 146 ## Test helpers:
 147 ##
 148
 149 # Compare two strings line by line and show a diff/error if they differ.
 150 sub diff($$) {
 151     my ($a, $b) = @_;
 152     return if $a eq $b;
 153
 154     my ($ra, $wa) = POSIX::pipe();
 155     my ($rb, $wb) = POSIX::pipe();
 156     my $ha = IO::Handle->new_from_fd($wa, 'w');
 157     my $hb = IO::Handle->new_from_fd($wb, 'w');
 158
 159     open my $diffproc, '-|', 'diff', '-up', "/dev/fd/$ra", "/dev/fd/$rb"
 160         or die "failed to run program 'diff': $!";
 161     POSIX::close($ra);
 162     POSIX::close($rb);
 163
 164     open my $f1, '<', \$a;
 165     open my $f2, '<', \$b;
 166     my ($line1, $line2);
 167     do {
 168         $ha->print($line1) if defined($line1 = <$f1>);
 169         $hb->print($line2) if defined($line2 = <$f2>);
 170     } while (defined($line1 // $line2));
 171     close $f1;
 172     close $f2;
 173     close $ha;
 174     close $hb;
 175
 176     local $/ = undef;
 177     my $diff = <$diffproc>;
 178     close $diffproc;
 179     die "files differ:\n$diff";
 180 }
 181
 182 # Write the current interface config and compare the result to a string.
 183 sub expect($) {
 184     my ($expected) = @_;
 185     my $got = w();
 186     diff($expected, $got);
 187 }
 188
 189 ##
 190 ## Main test execution:
 191 ##
 192 # (sorted, it's not used right now but tests could pass on temporary files by
 193 # prefixing the name with shared/ and thus you might want to split a larger
 194 # test into t.01.first-part.pl, t.02.second-part.pl, etc.
 195 my $total = 0;
 196 my $failed = 0;
 197 for our $Test (sort <t.*.pl>) {
 198     $total++;
 199     flush_files();
 200     eval {
 201         require $Test;
 202     };
 203     if ($@) {
 204         print "FAIL: $Test\n$@\n\n";
 205         $failed++;
 206     } else {
 207         print "PASS: $Test\n";
 208     }
 209 }
 210
 211 die "$failed out of $total tests failed\n" if $failed;