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.
62 use NetAddr
::IP
::Lite
qw(:nofqdn
:lower
);
64 our $default_ifname = 'userv%d';
68 die "bad usage: $m\n";
74 $x // badusage
"missing IP address";
75 $x = new NetAddr
::IP
::Lite
$x // badusage
"bad IP address";
76 $x->masklen == $x->bits or badusage
"IP network where addr expected";
77 die if $x->addr =~ m
,/,;
81 @ARGV == 5 or badusage
"wrong number of arguments";
82 our ($v1config, $realservice, $sep, $addrsarg, $rnets) = @ARGV;
84 $sep eq '--' or badusage
"separator should be \`--'";
85 my ($local_addr, $peer_addr, $mtu, $protocol, $ifname) =
86 split /\,/, $addrsarg;
90 $mtu = 1500 unless length $mtu;
91 $mtu =~ m/^[1-9]\d{1,4}/ or badusage
"bad mtu";
94 $protocol = 'slip' unless length $protocol;
95 $protocol =~ m/\W/ and badusage
"bad protocol";
97 $ifname = $default_ifname unless length $ifname;
99 our @rnets = ($rnets eq '-' ?
() : split /\,/, $rnets);
100 @rnets = map { new NetAddr
::IP
::Lite
$_ } @rnets;
104 my ($use_v0config) = @_;
105 exec $realservice, $use_v0config, '--',
106 "$local_addr,$peer_addr,$mtu,$protocol",
107 @rnets ?
(join ",", map { "$_" } @rnets) : "-"
108 or die "exec $realservice: $!\n";
117 die "bad configuration: $cfgpath:$.: $m\n";
121 # $need_allow{CLASS}[]
122 # $need_allow{CLASS}[]{Desc} # For error messages
123 # $need_allow{CLASS}[]{Allow} # Starts out nonexistent
124 # $need_allow{CLASS}[]{IpAddr} # CLASS eq Local or Remote only
127 my ($desc, @xtra) = @_;
128 return { Desc
=> $desc, @xtra };
130 sub allowent_addr
($$) {
131 my ($what, $addr) = @_;
132 return allowent
"$what $addr", IpAddr
=> $addr;
134 sub need_allow_item
($$) {
136 push @
{ $need_allow{$cl} }, $ne
138 sub need_allow_singleton
($$) {
140 $need_allow{$cl} ||= [ $ne ];
143 sub maybe_allow__entry
($$) {
145 $ne->{Allowed
} ||= $yes;
147 sub maybe_allow_singleton
($$) {
149 my $ents = $need_allow{$cl};
150 die $cl unless @
$ents==1;
151 maybe_allow__entry
$ents->[0], $yes;
153 sub default_allow_singleton
($$) {
154 # does nothing if maybe_allow_singleton was called for this $cl;
155 # otherwise allows the singleton iff $yes
157 my $ents = $need_allow{$cl};
158 die $cl unless @
$ents==1;
159 $ents->[0]{Allowed
} //= $yes;
161 sub maybe_allow_caller_env
($$$) {
162 my ($spec, @envvars) = @_;
163 foreach my $envvar (@envvars) {
164 my $val = $ENV{$envvar} // die $envvar;
165 my @vals = split / /, $val;
166 #use Data::Dumper; print Dumper($spec,$envvar,\@vals);
167 maybe_allow_singleton
'Caller', !!grep { $_ eq $spec } @vals;
170 sub maybe_allow_addrs
($$) {
171 my ($cl, $permitrange) = @_;
172 foreach my $ne (@
{ $need_allow{$cl} }) {
173 confess
unless defined $ne->{IpAddr
};
174 maybe_allow__entry
$ne, $permitrange->contains($ne->{IpAddr
});
179 local ($cfgpath) = @_;
180 my $cfgfh = new IO
::File
$cfgpath, "<";
182 die "$0: $cfgpath: $!\n" unless $!==ENOENT
;
190 if (s{^permit\s+}{}) {
191 badcfg
"v0config before permit" if defined $v0config;
193 need_allow_singleton
'Caller', allowent
'caller';
194 need_allow_singleton
'Local',
195 allowent_addr
"local interface", $local_addr;
196 need_allow_singleton
'Ifname', allowent
'interface name';
197 need_allow_item
'Remote',
198 allowent_addr
"peer point-to-point addr", $peer_addr;
200 need_allow_item
'Remote',
201 allowent_addr
"remote network", $_;
203 #use Data::Dumper; print Dumper(\%need_allow);
205 if (s{^user\s+(\S+)\s+}{}) {
206 maybe_allow_caller_env
$1, 'USERV_USER', 'USERV_UID';
207 } elsif (s{^group\s+(\S+)\s+}{}) {
208 maybe_allow_caller_env
$1, 'USERV_GROUP', 'USERV_GID';
209 } elsif (s{^everyone\s+}{}) {
210 maybe_allow_singleton
'Caller', 1;
211 } elsif (s{^hostnet\s+(\S+/\d+)\s+}{}) {
212 my $hn = new NetAddr
::IP
::Lite
$1 or
213 badcfg
"invalid ip address in hostnet";
214 my $host = new NetAddr
::IP
::Lite
$hn->addr or die;
215 my $net = $hn->network() or die;
216 maybe_allow_addrs
'Local', $host;
217 maybe_allow_addrs
'Remote', $net;
218 } elsif (s{^(local|remote|addrs)\s+(\S+)\ s+}{}) {
220 my $s = new NetAddr
::IP
::Lite
$2 or
221 badcfg
"invalid ip address or mask in $h";
222 maybe_allow_addrs
'Local', $s if $h =~ m/addrs|local/;
223 maybe_allow_addrs
'Remote', $s if $h =~ m/addrs|remote/;
224 } elsif (s{^ifname\s+(\S+)\s+}{}) {
226 maybe_allow_singleton
'Ifname', $ifname eq $spec;
228 badcfg
"unknown keyword in permit \`$1'";
233 default_allow_singleton
'Ifname', $ifname eq $default_ifname;
235 foreach my $clval (values %need_allow) {
236 foreach my $ne (@
$clval) {
237 next if $ne->{Allowed
};
238 push @wrong, $ne->{Desc
};
243 if ($protocol eq 'debug') {
244 print "config $cfgpath:$.: matches\n";
249 if ($protocol eq 'debug') {
250 #use Data::Dumper; print Dumper(\%need_allow);
251 print "config $cfgpath:$.: mismatch: $_\n"
254 } elsif (m{^v0config\s+(\S+)$}) {
255 badcfg
"repeated v0config" if defined $v0config;
257 } elsif (m{^include\s+(\S+)$}) {
260 badcfg
"unknown config directive or bad syntax";
263 $cfgfh->error and die $!;
266 if (defined $v0config) {
267 $v0config =~ s{^}{./} unless $v0config =~ m{^/};
268 print "trying v0 config $v0config...\n" if $protocol eq 'debug';
271 die "permission denied\n";
274 readconfig
$v1config;