]>
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 | ||
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; |