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