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> -- <service-args>...
18 # Config file is a series of lines.
20 # permit <keyword>....
22 # if caller, local addr, all remote addrs and networks, and
23 # ifname, all match, permits the request (and stops reading
26 # group <groupname>|<gid>
27 # matches caller if they are in that group
28 # user <username>|<uid>
29 # matches caller if they are that user
31 # always matches caller
33 # hostnet <ipaddr>/<prefixlen>
34 # equivalent to local <ipv4addr> remote <ipv4addr&prefix>
36 # matches local address when it is <ipv4addr>
37 # remote <ipnetnet>/<prefixlen>
38 # matches aplicable remote addrs (including p-t-p)
39 # addrs <ipaddr>|<ipnetnet>/<prefixlen>
40 # matches applicable local ore remote addrs
43 # matches interface name if it is exactly <ifname>
44 # (<ifname> may contain %d, which is interpreted by
46 # wildcards are not supported
47 # if a permit has no ifname at all, it is as if
48 # `ifname userv%d' was specified
50 # include <other-config-file>
52 # v0config <v0configfile>
54 # If none of the `permit' lines match, will read <v0configfile>
55 # in old format. Must come after all `permit' lines.
61 use NetAddr::IP::Lite qw(:nofqdn :lower);
64 our $default_ifname = 'userv%d';
69 $x // badusage "missing IP address";
70 $x = new NetAddr::IP::Lite $x // badusage "bad IP address";
71 $x->masklen == $x->bits or badusage "IP network where addr expected";
72 die if $x->addr =~ m,/,;
76 @ARGV == 5 or badusage "wrong number of arguments";
77 our ($v1config, $realservice, $sep, $addrsarg, $rnets) = @ARGV;
79 $sep eq '--' or badusage "separator should be \`--'";
80 my ($local_addr, $peer_addr, $mtu, $protocol, $ifname) =
81 split /\,/, $addrsarg;
85 $mtu = 1500 unless length $mtu;
86 $mtu =~ m/^[1-9]\d{1,4}/ or badusage "bad mtu";
89 $protocol = 'slip' unless length $protocol;
90 $protocol =~ m/\W/ and badusage "bad protocol";
92 $ifname = $default_ifname unless length $ifname;
94 our @rnets = ($rnets eq '-' ? () : split /\,/, $rnets);
95 @rnets = map { new NetAddr::IP::Lite $_ } @rnets;
98 # $need_allow{CLASS}[]
99 # $need_allow{CLASS}[]{Desc} # For error messages
100 # $need_allow{CLASS}[]{Allow} # Starts out nonexistent
101 # $need_allow{CLASS}[]{IpAddr} # CLASS eq Local or Remote only
103 sub need_allow__entry ($@) {
104 my ($desc, @xtra) = @_;
105 return { Desc => $desc, @xtra };
107 sub need_allow_item ($$@) {
108 my ($cl, $desc, @xtra) = @_;
109 push @{ $need_allow{$cl} }, need_allow__entry $desc, @extra;
111 sub need_allow_singleton ($$) {
112 my ($cl, $desc) = @_;
113 $need_allow{$cl} ||= [ need_allow__entry $desc ];
116 sub maybe_allow__entry ($$) {
118 $ne->{Allowed} ||= $yes;
120 sub maybe_allow_singleton ($) {
122 my $ents = $need_allow{$cl};
123 die $cl unless @$ents==1;
124 maybe_allow__entry $ents->[0], $val;
126 sub default_allow_singleton ($$) {
127 # does nothing if maybe_allow_singleton was called for this $cl;
128 # otherwise allows the singleton iff $yes
130 my $ents = $need_allow{$cl};
131 die $cl unless @$ents==1;
132 $ents->[0]{Allowed} //= $yes;
135 sub maybe_allow_caller_env ($$) {
136 my ($spec, @envvars) = @_;
137 foreach my $envvar (@envvars) {
138 my $val = $ENV{$envvar} // die $envvar;
139 my @vals = split / /, $val;
140 maybe_allow_singleton 'Caller', !!grep { $_ eq $spec } @vals;
143 sub maybe_allow_addrs ($) {
144 my ($cl, $permitrange) = @_;
145 foreach my $ne (@{ $need_allow{$cl} }) {
146 maybe_allow_entry $ne, $permitrange->contains($ne->{IpAddr});
152 my $cfgfh = new IO::File "<", $cfgpath;
154 die "$0: $cfgpath: $!\n" unless $!==ENOENT;
162 if (s{^permit\s+}{}) {
163 badcfg "v0config before permit" if defined $v0config;
165 need_allow_singleton 'Caller', 'caller';
166 need_allow_singleton 'Local', "local interface addr $local_addr";
167 need_allow_singleton 'Ifname', 'interface name';
168 always_need_allow 'Remote', "peer point-to-point addr $peer_addr";
170 need_allow_item 'Remote', "remote network ".$_->cidr(),
174 if (s{^group\s+(\S+)\s+}{}) {
175 maybe_allow_caller_env $1, 'USERV_USER', 'USERV_UID';
176 } elsif (s{^user\s+(\S+)\s+}{}) {
177 maybe_allow_caller_env $1, 'USERV_GROUP', 'USERV_GID';
178 } elsif (s{^everyone\s+}{}) {
179 maybe_allow_singleton 'Caller', 1;
180 } elsif (s{^hostnet\s+(\S+/\d+)\s+}{}) {
181 my $hn = new NetAddr:IP::Lite $1 or
182 badcfg "invalid ip address in hostnet";
183 my $host = new NetAddr::IP::Lite $hn->addr or die;
184 my $net = $hn->network() or die;
185 maybe_allow_addrs 'Local', $host;
186 maybe_ allow_addrs 'Remote', $net;
187 } elsif (s{^(local|remote|addrs)\s+(\S+)\ s+}{}) {
189 my $s = new NetAddr::IP::Lite $2 or
190 badcfg "invalid ip address or mask in $h";
191 maybe_allow_addrs 'Local', $s if $h =~ m/addrs|local/;
192 maybe_allow_addrs 'Remote', $s if $h =~ m/addrs|remote/;
193 } elsif (s{^ifname\s+(\S+)\s+}{}) {
195 maybe_allow_singleton 'Ifname', $ifname eq $spec;
197 badcfg "unknown keyword in permit \`$1'";
202 default_allow_singleton 'Ifname', $ifname eq $default_ifname;
204 foreach my $clval (values %need_allow) {
205 foreach my $ne (@$clval) {
206 next if $ne->{Allow};
207 push @wrong, $ne->{Desc};
212 if ($protocol eq 'debug') {
213 print "config $cfgh line $.: matches\n";
216 exec $realservice, '*', '--',
217 "$local_addr,$peer_addr,$mtu,$protocol",
218 @rnets ? (join ",", map { "$_" } @rnets) : "-";
219 die "exec $realservice: $!\n";
221 if ($protocol eq 'debug') {
222 print "config $cfgfh line $.: mismatch: $_\n"
225 } elsif (m{^v0config\s+(\S+)$}) {
226 badcfg "repeated v0config" if defined $v0config;
228 } elsif (m{^include\s+(\S+)$}) {
231 badcfg "unknown config directive or bad syntax";
234 $cfgfh->error and die $!;