]>
Commit | Line | Data |
---|---|---|
936218b8 WB |
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 | ||
12a235d6 WB |
62 | # Read an interfaces file with optional /proc/net/dev file content string and |
63 | # the list of active interfaces, which otherwise default | |
936218b8 | 64 | sub r($;$$) { |
12a235d6 | 65 | my ($ifaces, $proc_net_dev, $active) = @_; |
936218b8 | 66 | $proc_net_dev //= load('proc_net_dev'); |
12a235d6 | 67 | $active //= [split(/\s+/, load('active_interfaces'))]; |
936218b8 WB |
68 | open my $fh1, '<', \$ifaces; |
69 | open my $fh2, '<', \$proc_net_dev; | |
12a235d6 | 70 | $config = PVE::INotify::__read_etc_network_interfaces($fh1, $fh2, $active); |
936218b8 WB |
71 | close $fh1; |
72 | } | |
73 | ||
74 | # Turn the current network config into a string. | |
75 | sub w() { | |
76 | return PVE::INotify::__write_etc_network_interfaces($config); | |
77 | } | |
78 | ||
79 | ## | |
80 | ## Interface modification helpers | |
81 | ## | |
82 | ||
83 | # Update an interface | |
84 | sub update_iface($$%) { | |
85 | my ($name, $families, %extra) = @_; | |
86 | ||
87 | my $ifaces = $config->{ifaces}; | |
88 | my $if = $ifaces->{$name}; | |
89 | ||
90 | die "no such interface: $name\n" if !$if; | |
91 | ||
92 | $if->{exists} = 1; | |
93 | ||
94 | # merge extra flags (like bridge_ports, ovs_*) directly | |
95 | $if->{$_} = $extra{$_} foreach keys %extra; | |
96 | ||
97 | return if !$families; | |
98 | ||
99 | my $if_families = $if->{families} ||= []; | |
100 | foreach my $family (@$families) { | |
101 | my $type = delete $family->{family}; | |
102 | @$if_families = ((grep { $_ ne $type } @$if_families), $type); | |
103 | ||
104 | (my $suffix = $type) =~ s/^inet//; | |
105 | $if->{"method$suffix"} = $family->{address} ? 'static' : 'manual'; | |
106 | foreach(qw(address netmask gateway options)) { | |
107 | if (my $value = delete $family->{$_}) { | |
108 | $if->{"$_${suffix}"} = $value; | |
109 | } | |
110 | } | |
111 | } | |
112 | } | |
113 | ||
114 | # Create an interface and error if it already exists. | |
115 | sub new_iface($$$%) { | |
116 | my ($name, $type, $families, %extra) = @_; | |
117 | my $ifaces = $config->{ifaces}; | |
118 | croak "interface already exists: $name" if $ifaces->{$name}; | |
119 | $ifaces->{$name} = { type => $type }; | |
120 | update_iface($name, $families, %extra); | |
121 | } | |
122 | ||
123 | # Delete an interface and error if it did not exist. | |
124 | sub delete_iface($;$) { | |
125 | my ($name, $family) = @_; | |
126 | my $ifaces = $config->{ifaces}; | |
127 | my $if = $ifaces->{$name} ||= {}; | |
128 | croak "interface doesn't exist: $name" if !$if; | |
129 | ||
130 | if (!$family) { | |
131 | delete $ifaces->{$name}; | |
132 | return; | |
133 | } | |
134 | ||
135 | my $families = $if->{families}; | |
136 | @$families = grep {$_ ne $family} @$families; | |
137 | (my $suffix = $family) =~ s/^inet//; | |
138 | delete $if->{"$_$suffix"} foreach qw(address netmask gateway options); | |
139 | } | |
140 | ||
141 | ## | |
142 | ## Test helpers: | |
143 | ## | |
144 | ||
145 | # Compare two strings line by line and show a diff/error if they differ. | |
146 | sub diff($$) { | |
147 | my ($a, $b) = @_; | |
148 | return if $a eq $b; | |
149 | ||
150 | my ($ra, $wa) = POSIX::pipe(); | |
151 | my ($rb, $wb) = POSIX::pipe(); | |
152 | my $ha = IO::Handle->new_from_fd($wa, 'w'); | |
153 | my $hb = IO::Handle->new_from_fd($wb, 'w'); | |
154 | ||
155 | open my $diffproc, '-|', 'diff', '-up', "/dev/fd/$ra", "/dev/fd/$rb" | |
156 | or die "failed to run program 'diff': $!"; | |
157 | POSIX::close($ra); | |
158 | POSIX::close($rb); | |
159 | ||
160 | open my $f1, '<', \$a; | |
161 | open my $f2, '<', \$b; | |
162 | my ($line1, $line2); | |
163 | do { | |
164 | $ha->print($line1) if defined($line1 = <$f1>); | |
165 | $hb->print($line2) if defined($line2 = <$f2>); | |
166 | } while (defined($line1 // $line2)); | |
167 | close $f1; | |
168 | close $f2; | |
169 | close $ha; | |
170 | close $hb; | |
171 | ||
172 | local $/ = undef; | |
173 | my $diff = <$diffproc>; | |
174 | close $diffproc; | |
175 | die "files differ:\n$diff"; | |
176 | } | |
177 | ||
178 | # Write the current interface config and compare the result to a string. | |
179 | sub expect($) { | |
180 | my ($expected) = @_; | |
181 | my $got = w(); | |
182 | diff($expected, $got); | |
183 | } | |
184 | ||
185 | ## | |
186 | ## Main test execution: | |
187 | ## | |
188 | # (sorted, it's not used right now but tests could pass on temporary files by | |
189 | # prefixing the name with shared/ and thus you might want to split a larger | |
190 | # test into t.01.first-part.pl, t.02.second-part.pl, etc. | |
191 | my $total = 0; | |
192 | my $failed = 0; | |
193 | for our $Test (sort <t.*.pl>) { | |
194 | $total++; | |
195 | flush_files(); | |
196 | eval { | |
197 | require $Test; | |
198 | }; | |
199 | if ($@) { | |
200 | print "FAIL: $Test\n$@\n\n"; | |
201 | $failed++; | |
202 | } else { | |
203 | print "PASS: $Test\n"; | |
204 | } | |
205 | } | |
206 | ||
207 | die "$failed out of $total tests failed\n" if $failed; |