Commit | Line | Data |
---|---|---|
08e5c1c8 IJ |
1 | #!/usr/bin/perl -w |
2 | # | |
3 | # When invoked appropriately, it creates a point-to-point network | |
4 | # interface with specified parameters. It arranges for packets sent out | |
5 | # via that interface by the kernel to appear on its own stdout in SLIP or | |
6 | # CSLIP encoding, and packets injected into its own stdin to be given to | |
7 | # the kernel as if received on that interface. Optionally, additional | |
8 | # routes can be set up to arrange for traffic for other address ranges to | |
9 | # be routed through the new interface. | |
10 | # | |
11 | # This is the access control wrapper for the service program. | |
12 | # Arrangments should be made to invoke this as root from userv. | |
13 | # | |
14 | # Usage: | |
15 | # | |
9cc0c043 | 16 | # .../ipif1 <v1config> <real-service-program> <v0config> -- <service-args>... |
08e5c1c8 | 17 | # |
4e5552a4 IJ |
18 | # Config file is a series of lines, or a directory. If a directory, |
19 | # all files with names matching ^[-A-Za-z0-9_]+$ are processed. | |
08e5c1c8 IJ |
20 | # |
21 | # permit <keyword>.... | |
22 | # | |
23 | # if caller, local addr, all remote addrs and networks, and | |
24 | # ifname, all match, permits the request (and stops reading | |
25 | # the config) | |
26 | # | |
27 | # group <groupname>|<gid> | |
28 | # matches caller if they are in that group | |
29 | # user <username>|<uid> | |
30 | # matches caller if they are that user | |
31 | # everyone | |
32 | # always matches caller | |
33 | # | |
34 | # hostnet <ipaddr>/<prefixlen> | |
35 | # equivalent to local <ipv4addr> remote <ipv4addr&prefix> | |
36 | # local <ipaddr> | |
37 | # matches local address when it is <ipv4addr> | |
38 | # remote <ipnetnet>/<prefixlen> | |
39 | # matches aplicable remote addrs (including p-t-p) | |
40 | # addrs <ipaddr>|<ipnetnet>/<prefixlen> | |
41 | # matches applicable local ore remote addrs | |
42 | # | |
43 | # ifname <ifname> | |
44 | # matches interface name if it is exactly <ifname> | |
45 | # (<ifname> may contain %d, which is interpreted by | |
46 | # the kernel) | |
47 | # wildcards are not supported | |
48 | # if a permit has no ifname at all, it is as if | |
49 | # `ifname userv%d' was specified | |
50 | # | |
4e5552a4 | 51 | # include <other-config-file-or-directory> |
44b7fe58 | 52 | # |
9cc0c043 | 53 | # <v0config> |
08e5c1c8 | 54 | # |
9cc0c043 IJ |
55 | # If none of the `permit' lines match, will process <v0config> in |
56 | # old format. See service.c head comment. <v0config> may be | |
57 | # `' or `#' or `/dev/null' to process new-style config only. | |
08e5c1c8 IJ |
58 | # |
59 | # <config> -- | |
60 | ||
61 | use strict; | |
8ca56de8 IJ |
62 | use POSIX; |
63 | use Carp; | |
44b7fe58 | 64 | use NetAddr::IP::Lite qw(:nofqdn :lower); |
03e3cd7d | 65 | use File::Basename; |
44b7fe58 IJ |
66 | |
67 | our $default_ifname = 'userv%d'; | |
68 | ||
8ca56de8 IJ |
69 | sub badusage ($) { |
70 | my ($m) = @_; | |
71 | die "bad usage: $m\n"; | |
72 | } | |
73 | ||
44b7fe58 IJ |
74 | sub oneaddr ($) { |
75 | my ($ar) = @_; | |
8ca56de8 | 76 | my $x = $$ar; |
44b7fe58 IJ |
77 | $x // badusage "missing IP address"; |
78 | $x = new NetAddr::IP::Lite $x // badusage "bad IP address"; | |
79 | $x->masklen == $x->bits or badusage "IP network where addr expected"; | |
80 | die if $x->addr =~ m,/,; | |
81 | $$ar = $x; | |
82 | } | |
83 | ||
9cc0c043 IJ |
84 | @ARGV == 6 or badusage "wrong number of arguments"; |
85 | our ($v1config, $realservice, $v0config, $sep, $addrsarg, $rnets) = @ARGV; | |
44b7fe58 IJ |
86 | |
87 | $sep eq '--' or badusage "separator should be \`--'"; | |
88 | my ($local_addr, $peer_addr, $mtu, $protocol, $ifname) = | |
89 | split /\,/, $addrsarg; | |
90 | ||
91 | oneaddr \$local_addr; | |
92 | oneaddr \$peer_addr; | |
93 | $mtu = 1500 unless length $mtu; | |
94 | $mtu =~ m/^[1-9]\d{1,4}/ or badusage "bad mtu"; | |
95 | $mtu += 0; | |
96 | ||
97 | $protocol = 'slip' unless length $protocol; | |
98 | $protocol =~ m/\W/ and badusage "bad protocol"; | |
99 | ||
100 | $ifname = $default_ifname unless length $ifname; | |
101 | ||
102 | our @rnets = ($rnets eq '-' ? () : split /\,/, $rnets); | |
103 | @rnets = map { new NetAddr::IP::Lite $_ } @rnets; | |
104 | ||
8ca56de8 IJ |
105 | |
106 | sub execreal ($) { | |
107 | my ($use_v0config) = @_; | |
108 | exec $realservice, $use_v0config, '--', | |
0d8db366 IJ |
109 | (join ',', $local_addr->addr, $peer_addr->addr, |
110 | $mtu, $protocol, $ifname), | |
8ca56de8 IJ |
111 | @rnets ? (join ",", map { "$_" } @rnets) : "-" |
112 | or die "exec $realservice: $!\n"; | |
113 | } | |
114 | ||
8ca56de8 IJ |
115 | our $cfgpath; |
116 | ||
117 | sub badcfg ($) { | |
118 | my ($m) = @_; | |
119 | die "bad configuration: $cfgpath:$.: $m\n"; | |
120 | } | |
121 | ||
44b7fe58 IJ |
122 | our %need_allow; |
123 | # $need_allow{CLASS}[] | |
124 | # $need_allow{CLASS}[]{Desc} # For error messages | |
125 | # $need_allow{CLASS}[]{Allow} # Starts out nonexistent | |
126 | # $need_allow{CLASS}[]{IpAddr} # CLASS eq Local or Remote only | |
127 | ||
8ca56de8 | 128 | sub allowent ($@) { |
44b7fe58 IJ |
129 | my ($desc, @xtra) = @_; |
130 | return { Desc => $desc, @xtra }; | |
131 | } | |
8ca56de8 IJ |
132 | sub allowent_addr ($$) { |
133 | my ($what, $addr) = @_; | |
134 | return allowent "$what $addr", IpAddr => $addr; | |
135 | } | |
136 | sub need_allow_item ($$) { | |
137 | my ($cl, $ne) = @_; | |
138 | push @{ $need_allow{$cl} }, $ne | |
44b7fe58 IJ |
139 | } |
140 | sub need_allow_singleton ($$) { | |
8ca56de8 IJ |
141 | my ($cl, $ne) = @_; |
142 | $need_allow{$cl} ||= [ $ne ]; | |
44b7fe58 IJ |
143 | } |
144 | ||
145 | sub maybe_allow__entry ($$) { | |
146 | my ($ne, $yes) = @_; | |
147 | $ne->{Allowed} ||= $yes; | |
148 | } | |
8ca56de8 | 149 | sub maybe_allow_singleton ($$) { |
44b7fe58 IJ |
150 | my ($cl, $yes) = @_; |
151 | my $ents = $need_allow{$cl}; | |
152 | die $cl unless @$ents==1; | |
8ca56de8 | 153 | maybe_allow__entry $ents->[0], $yes; |
44b7fe58 IJ |
154 | } |
155 | sub default_allow_singleton ($$) { | |
156 | # does nothing if maybe_allow_singleton was called for this $cl; | |
157 | # otherwise allows the singleton iff $yes | |
158 | my ($cl, $yes) = @_; | |
159 | my $ents = $need_allow{$cl}; | |
160 | die $cl unless @$ents==1; | |
161 | $ents->[0]{Allowed} //= $yes; | |
162 | } | |
8ca56de8 | 163 | sub maybe_allow_caller_env ($$$) { |
44b7fe58 IJ |
164 | my ($spec, @envvars) = @_; |
165 | foreach my $envvar (@envvars) { | |
166 | my $val = $ENV{$envvar} // die $envvar; | |
167 | my @vals = split / /, $val; | |
8ca56de8 | 168 | #use Data::Dumper; print Dumper($spec,$envvar,\@vals); |
44b7fe58 IJ |
169 | maybe_allow_singleton 'Caller', !!grep { $_ eq $spec } @vals; |
170 | } | |
171 | } | |
8ca56de8 | 172 | sub maybe_allow_addrs ($$) { |
44b7fe58 IJ |
173 | my ($cl, $permitrange) = @_; |
174 | foreach my $ne (@{ $need_allow{$cl} }) { | |
8ca56de8 IJ |
175 | confess unless defined $ne->{IpAddr}; |
176 | maybe_allow__entry $ne, $permitrange->contains($ne->{IpAddr}); | |
44b7fe58 IJ |
177 | } |
178 | } | |
179 | ||
4e5552a4 | 180 | sub readconfig ($); |
44b7fe58 | 181 | sub readconfig ($) { |
8ca56de8 | 182 | local ($cfgpath) = @_; |
4e5552a4 IJ |
183 | |
184 | my $dirfh; | |
185 | if (opendir $dirfh, $cfgpath) { | |
186 | while ($!=0, my $ent = readdir $dirfh) { | |
187 | next if $ent =~ m/[^-A-Za-z0-9_]/; | |
188 | readconfig "$cfgpath/$ent"; | |
189 | } | |
190 | die "$0: $cfgpath: $!\n" if $!; | |
191 | return; | |
192 | } | |
193 | die "$0: $cfgpath: $!\n" unless $!==ENOENT || $!==ENOTDIR; | |
194 | ||
8ca56de8 | 195 | my $cfgfh = new IO::File $cfgpath, "<"; |
44b7fe58 IJ |
196 | if (!$cfgfh) { |
197 | die "$0: $cfgpath: $!\n" unless $!==ENOENT; | |
198 | return; | |
199 | } | |
200 | while (<$cfgfh>) { | |
201 | s/^\s+//; | |
202 | s/\s+$/\n/; | |
203 | next if m/^\#/; | |
204 | next unless m/\S/; | |
205 | if (s{^permit\s+}{}) { | |
8ca56de8 IJ |
206 | %need_allow = (); |
207 | need_allow_singleton 'Caller', allowent 'caller'; | |
208 | need_allow_singleton 'Local', | |
209 | allowent_addr "local interface", $local_addr; | |
210 | need_allow_singleton 'Ifname', allowent 'interface name'; | |
211 | need_allow_item 'Remote', | |
212 | allowent_addr "peer point-to-point addr", $peer_addr; | |
44b7fe58 | 213 | foreach (@rnets) { |
8ca56de8 IJ |
214 | need_allow_item 'Remote', |
215 | allowent_addr "remote network", $_; | |
44b7fe58 | 216 | } |
8ca56de8 | 217 | #use Data::Dumper; print Dumper(\%need_allow); |
44b7fe58 | 218 | while (m{\S}) { |
8ca56de8 | 219 | if (s{^user\s+(\S+)\s+}{}) { |
44b7fe58 | 220 | maybe_allow_caller_env $1, 'USERV_USER', 'USERV_UID'; |
8ca56de8 | 221 | } elsif (s{^group\s+(\S+)\s+}{}) { |
44b7fe58 IJ |
222 | maybe_allow_caller_env $1, 'USERV_GROUP', 'USERV_GID'; |
223 | } elsif (s{^everyone\s+}{}) { | |
224 | maybe_allow_singleton 'Caller', 1; | |
225 | } elsif (s{^hostnet\s+(\S+/\d+)\s+}{}) { | |
8ca56de8 | 226 | my $hn = new NetAddr::IP::Lite $1 or |
44b7fe58 IJ |
227 | badcfg "invalid ip address in hostnet"; |
228 | my $host = new NetAddr::IP::Lite $hn->addr or die; | |
229 | my $net = $hn->network() or die; | |
230 | maybe_allow_addrs 'Local', $host; | |
8ca56de8 | 231 | maybe_allow_addrs 'Remote', $net; |
44b7fe58 IJ |
232 | } elsif (s{^(local|remote|addrs)\s+(\S+)\ s+}{}) { |
233 | my $h = $1; | |
234 | my $s = new NetAddr::IP::Lite $2 or | |
235 | badcfg "invalid ip address or mask in $h"; | |
236 | maybe_allow_addrs 'Local', $s if $h =~ m/addrs|local/; | |
237 | maybe_allow_addrs 'Remote', $s if $h =~ m/addrs|remote/; | |
238 | } elsif (s{^ifname\s+(\S+)\s+}{}) { | |
239 | my ($spec) = $1; | |
240 | maybe_allow_singleton 'Ifname', $ifname eq $spec; | |
241 | } elsif (m{^\S+}) { | |
242 | badcfg "unknown keyword in permit \`$1'"; | |
243 | } else { | |
244 | die; | |
245 | } | |
246 | } | |
247 | default_allow_singleton 'Ifname', $ifname eq $default_ifname; | |
248 | my @wrong; | |
249 | foreach my $clval (values %need_allow) { | |
250 | foreach my $ne (@$clval) { | |
8ca56de8 | 251 | next if $ne->{Allowed}; |
44b7fe58 IJ |
252 | push @wrong, $ne->{Desc}; |
253 | } | |
254 | } | |
255 | if (!@wrong) { | |
256 | # yay! | |
257 | if ($protocol eq 'debug') { | |
8ca56de8 | 258 | print "config $cfgpath:$.: matches\n"; |
44b7fe58 IJ |
259 | exit 0; |
260 | } | |
8ca56de8 | 261 | execreal '*'; |
44b7fe58 IJ |
262 | } |
263 | if ($protocol eq 'debug') { | |
8ca56de8 IJ |
264 | #use Data::Dumper; print Dumper(\%need_allow); |
265 | print "config $cfgpath:$.: mismatch: $_\n" | |
44b7fe58 IJ |
266 | foreach @wrong; |
267 | } | |
44b7fe58 | 268 | } elsif (m{^include\s+(\S+)$}) { |
03e3cd7d IJ |
269 | my $include = $1; |
270 | $include =~ s{^(?!/)}{ dirname($cfgpath)."/" }e; | |
271 | readconfig $include; | |
44b7fe58 IJ |
272 | } else { |
273 | badcfg "unknown config directive or bad syntax"; | |
274 | } | |
275 | } | |
276 | $cfgfh->error and die $!; | |
277 | close $cfgfh; | |
278 | } | |
279 | ||
03e3cd7d IJ |
280 | sub try_v0config() { |
281 | return unless $v0config; | |
282 | return unless $v0config =~ m{^[^#]}; | |
283 | return if $v0config eq '/dev/null'; | |
284 | if ($v0config =~ m{^/}) { | |
285 | if (!stat $v0config) { | |
286 | die "v0 config $v0config: $!\n" unless $!==ENOENT; | |
287 | return; | |
288 | } | |
289 | } | |
2449f13f IJ |
290 | print "trying v0 config $v0config...\n" if $protocol eq 'debug'; |
291 | execreal $v0config; | |
292 | } | |
03e3cd7d IJ |
293 | |
294 | readconfig $v1config; | |
295 | try_v0config(); | |
296 | ||
2449f13f | 297 | die "permission denied\n"; |