]> git.proxmox.com Git - pve-common.git/blob - test/etc_network_interfaces/runtest.pl
Inotify : write network config : use modern syntax for options
[pve-common.git] / 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
12 use PVE::INotify;
13
14 # Current config, r() parses a network interface string into this variable
15 our $config;
16
17 ##
18 ## Temporary files:
19 ##
20 # perl conveniently lets you open a string as filehandle so we allow tests
21 # to temporarily save interface files to virtual files:
22 my %saved_files;
23
24 # Load a temp-file and return it as a string, if it didn't exist, try loading
25 # a real file.
26 sub load($) {
27 my ($from) = @_;
28
29 if (my $local = $saved_files{$from}) {
30 return $local;
31 }
32
33 open my $fh, '<', $from or die "failed to open $from: $!";
34 local $/ = undef;
35 my $data = <$fh>;
36 close $fh;
37 return $data;
38 }
39
40 # Save a temporary file.
41 sub save($$) {
42 my ($file, $data) = @_;
43 $saved_files{$file} = $data;
44 }
45
46 # Delete a temporary file
47 sub delfile($) {
48 my $file = @_;
49 die "no such file: $file" if !delete $saved_files{$file};
50 }
51
52 # Delete all temporary files.
53 sub flush_files() {
54 foreach (keys %saved_files) {
55 delete $saved_files{$_} if $_ !~ m,^shared/,;
56 }
57 }
58
59 ##
60 ## Interface parsing:
61 ##
62
63 # Read an interfaces file with optional /proc/net/dev file content string and
64 # the list of active interfaces, which otherwise default
65 sub r($;$$) {
66 my ($ifaces, $proc_net_dev, $active) = @_;
67 $proc_net_dev //= load('proc_net_dev');
68 $active //= [split(/\s+/, load('active_interfaces'))];
69 open my $fh1, '<', \$ifaces;
70 open my $fh2, '<', \$proc_net_dev;
71 $config = PVE::INotify::__read_etc_network_interfaces($fh1, $fh2, $active);
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;