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