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.
11 # This is the access control wrapper for the service program.
12 # Arrangments should be made to invoke this as root from userv.
16 # .../ipif1 <v1config> <real-service-program> <v0config> -- <service-args>...
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.
21 # permit <keyword>....
23 # if caller, local addr, all remote addrs and networks, and
24 # ifname, all match, permits the request (and stops reading
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
32 # always matches caller
34 # hostnet <ipaddr>/<prefixlen>
35 # equivalent to local <ipv4addr> remote <ipv4addr&prefix>
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
44 # matches interface name if it is exactly <ifname>
45 # (<ifname> may contain %d, which is interpreted by
47 # wildcards are not supported
48 # if a permit has no ifname at all, it is as if
49 # `ifname userv%d' was specified
51 # include <other-config-file-or-directory>
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.
64 use NetAddr::IP::Lite qw(:nofqdn :lower);
67 our $default_ifname = 'userv%d';
71 die "bad usage: $m\n";
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,/,;
84 @ARGV == 6 or badusage "wrong number of arguments";
85 our ($v1config, $realservice, $v0config, $sep, $addrsarg, $rnets) = @ARGV;
87 $sep eq '--' or badusage "separator should be \`--'";
88 my ($local_addr, $peer_addr, $mtu, $protocol, $ifname) =
89 split /\,/, $addrsarg;
93 $mtu = 1500 unless length $mtu;
94 $mtu =~ m/^[1-9]\d{1,4}/ or badusage "bad mtu";
97 $protocol = 'slip' unless length $protocol;
98 $protocol =~ m/\W/ and badusage "bad protocol";
100 $ifname = $default_ifname unless length $ifname;
102 our @rnets = ($rnets eq '-' ? () : split /\,/, $rnets);
103 @rnets = map { new NetAddr::IP::Lite $_ } @rnets;
107 my ($use_v0config) = @_;
108 exec $realservice, $use_v0config, '--',
109 (join ',', $local_addr->addr, $peer_addr->addr,
110 $mtu, $protocol, $ifname),
111 @rnets ? (join ",", map { "$_" } @rnets) : "-"
112 or die "exec $realservice: $!\n";
119 die "bad configuration: $cfgpath:$.: $m\n";
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
129 my ($desc, @xtra) = @_;
130 return { Desc => $desc, @xtra };
132 sub allowent_addr ($$) {
133 my ($what, $addr) = @_;
134 return allowent "$what $addr", IpAddr => $addr;
136 sub need_allow_item ($$) {
138 push @{ $need_allow{$cl} }, $ne
140 sub need_allow_singleton ($$) {
142 $need_allow{$cl} ||= [ $ne ];
145 sub maybe_allow__entry ($$) {
147 $ne->{Allowed} ||= $yes;
149 sub maybe_allow_singleton ($$) {
151 my $ents = $need_allow{$cl};
152 die $cl unless @$ents==1;
153 maybe_allow__entry $ents->[0], $yes;
155 sub default_allow_singleton ($$) {
156 # does nothing if maybe_allow_singleton was called for this $cl;
157 # otherwise allows the singleton iff $yes
159 my $ents = $need_allow{$cl};
160 die $cl unless @$ents==1;
161 $ents->[0]{Allowed} //= $yes;
163 sub maybe_allow_caller_env ($$$) {
164 my ($spec, @envvars) = @_;
165 foreach my $envvar (@envvars) {
166 my $val = $ENV{$envvar} // die $envvar;
167 my @vals = split / /, $val;
168 #use Data::Dumper; print Dumper($spec,$envvar,\@vals);
169 maybe_allow_singleton 'Caller', !!grep { $_ eq $spec } @vals;
172 sub maybe_allow_addrs ($$) {
173 my ($cl, $permitrange) = @_;
174 foreach my $ne (@{ $need_allow{$cl} }) {
175 confess unless defined $ne->{IpAddr};
176 maybe_allow__entry $ne, $permitrange->contains($ne->{IpAddr});
182 local ($cfgpath) = @_;
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";
190 die "$0: $cfgpath: $!\n" if $!;
193 die "$0: $cfgpath: $!\n" unless $!==ENOENT || $!==ENOTDIR;
195 my $cfgfh = new IO::File $cfgpath, "<";
197 die "$0: $cfgpath: $!\n" unless $!==ENOENT;
205 if (s{^permit\s+}{}) {
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;
214 need_allow_item 'Remote',
215 allowent_addr "remote network", $_;
217 #use Data::Dumper; print Dumper(\%need_allow);
219 if (s{^user\s+(\S+)\s+}{}) {
220 maybe_allow_caller_env $1, 'USERV_USER', 'USERV_UID';
221 } elsif (s{^group\s+(\S+)\s+}{}) {
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+}{}) {
226 my $hn = new NetAddr::IP::Lite $1 or
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;
231 maybe_allow_addrs 'Remote', $net;
232 } elsif (s{^(local|remote|addrs)\s+(\S+)\ s+}{}) {
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+}{}) {
240 maybe_allow_singleton 'Ifname', $ifname eq $spec;
242 badcfg "unknown keyword in permit \`$1'";
247 default_allow_singleton 'Ifname', $ifname eq $default_ifname;
249 foreach my $clval (values %need_allow) {
250 foreach my $ne (@$clval) {
251 next if $ne->{Allowed};
252 push @wrong, $ne->{Desc};
257 if ($protocol eq 'debug') {
258 print "config $cfgpath:$.: matches\n";
263 if ($protocol eq 'debug') {
264 #use Data::Dumper; print Dumper(\%need_allow);
265 print "config $cfgpath:$.: mismatch: $_\n"
268 } elsif (m{^include\s+(\S+)$}) {
270 $include =~ s{^(?!/)}{ dirname($cfgpath)."/" }e;
273 badcfg "unknown config directive or bad syntax";
276 $cfgfh->error and die $!;
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;
290 print "trying v0 config $v0config...\n" if $protocol eq 'debug';
294 readconfig $v1config;
297 die "permission denied\n";