test/etc_network_interfaces/runtest.pl

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