#
# Usage:
#
-# .../ipif1 <v1config> -- <service-args>...
+# .../ipif1 <v1config> <real-service-program> -- <service-args>...
#
# Config file is a series of lines.
#
# if a permit has no ifname at all, it is as if
# `ifname userv%d' was specified
#
+# include <other-config-file>
+#
# v0config <v0configfile>
#
# If none of the `permit' lines match, will read <v0configfile>
-# in old format. Must be the last line in the file.
+# in old format. Must come after all `permit' lines.
#
# <config> --
use strict;
+
+use NetAddr::IP::Lite qw(:nofqdn :lower);
+#use NetAddr::IP;
+
+our $default_ifname = 'userv%d';
+
+sub oneaddr ($) {
+ my ($ar) = @_;
+ $x = $$ar;
+ $x // badusage "missing IP address";
+ $x = new NetAddr::IP::Lite $x // badusage "bad IP address";
+ $x->masklen == $x->bits or badusage "IP network where addr expected";
+ die if $x->addr =~ m,/,;
+ $$ar = $x;
+}
+
+@ARGV == 5 or badusage "wrong number of arguments";
+our ($v1config, $realservice, $sep, $addrsarg, $rnets) = @ARGV;
+
+$sep eq '--' or badusage "separator should be \`--'";
+my ($local_addr, $peer_addr, $mtu, $protocol, $ifname) =
+ split /\,/, $addrsarg;
+
+oneaddr \$local_addr;
+oneaddr \$peer_addr;
+$mtu = 1500 unless length $mtu;
+$mtu =~ m/^[1-9]\d{1,4}/ or badusage "bad mtu";
+$mtu += 0;
+
+$protocol = 'slip' unless length $protocol;
+$protocol =~ m/\W/ and badusage "bad protocol";
+
+$ifname = $default_ifname unless length $ifname;
+
+our @rnets = ($rnets eq '-' ? () : split /\,/, $rnets);
+@rnets = map { new NetAddr::IP::Lite $_ } @rnets;
+
+our %need_allow;
+# $need_allow{CLASS}[]
+# $need_allow{CLASS}[]{Desc} # For error messages
+# $need_allow{CLASS}[]{Allow} # Starts out nonexistent
+# $need_allow{CLASS}[]{IpAddr} # CLASS eq Local or Remote only
+
+sub need_allow__entry ($@) {
+ my ($desc, @xtra) = @_;
+ return { Desc => $desc, @xtra };
+}
+sub need_allow_item ($$@) {
+ my ($cl, $desc, @xtra) = @_;
+ push @{ $need_allow{$cl} }, need_allow__entry $desc, @extra;
+}
+sub need_allow_singleton ($$) {
+ my ($cl, $desc) = @_;
+ $need_allow{$cl} ||= [ need_allow__entry $desc ];
+}
+
+sub maybe_allow__entry ($$) {
+ my ($ne, $yes) = @_;
+ $ne->{Allowed} ||= $yes;
+}
+sub maybe_allow_singleton ($) {
+ my ($cl, $yes) = @_;
+ my $ents = $need_allow{$cl};
+ die $cl unless @$ents==1;
+ maybe_allow__entry $ents->[0], $val;
+}
+sub default_allow_singleton ($$) {
+ # does nothing if maybe_allow_singleton was called for this $cl;
+ # otherwise allows the singleton iff $yes
+ my ($cl, $yes) = @_;
+ my $ents = $need_allow{$cl};
+ die $cl unless @$ents==1;
+ $ents->[0]{Allowed} //= $yes;
+}
+
+sub maybe_allow_caller_env ($$) {
+ my ($spec, @envvars) = @_;
+ foreach my $envvar (@envvars) {
+ my $val = $ENV{$envvar} // die $envvar;
+ my @vals = split / /, $val;
+ maybe_allow_singleton 'Caller', !!grep { $_ eq $spec } @vals;
+ }
+}
+sub maybe_allow_addrs ($) {
+ my ($cl, $permitrange) = @_;
+ foreach my $ne (@{ $need_allow{$cl} }) {
+ maybe_allow_entry $ne, $permitrange->contains($ne->{IpAddr});
+ }
+}
+
+sub readconfig ($) {
+ my ($cfgpath) = @_;
+ my $cfgfh = new IO::File "<", $cfgpath;
+ if (!$cfgfh) {
+ die "$0: $cfgpath: $!\n" unless $!==ENOENT;
+ return;
+ }
+ while (<$cfgfh>) {
+ s/^\s+//;
+ s/\s+$/\n/;
+ next if m/^\#/;
+ next unless m/\S/;
+ if (s{^permit\s+}{}) {
+ badcfg "v0config before permit" if defined $v0config;
+ %need_allowed = ();
+ need_allow_singleton 'Caller', 'caller';
+ need_allow_singleton 'Local', "local interface addr $local_addr";
+ need_allow_singleton 'Ifname', 'interface name';
+ always_need_allow 'Remote', "peer point-to-point addr $peer_addr";
+ foreach (@rnets) {
+ need_allow_item 'Remote', "remote network ".$_->cidr(),
+ IpAddr => $_;
+ }
+ while (m{\S}) {
+ if (s{^group\s+(\S+)\s+}{}) {
+ maybe_allow_caller_env $1, 'USERV_USER', 'USERV_UID';
+ } elsif (s{^user\s+(\S+)\s+}{}) {
+ maybe_allow_caller_env $1, 'USERV_GROUP', 'USERV_GID';
+ } elsif (s{^everyone\s+}{}) {
+ maybe_allow_singleton 'Caller', 1;
+ } elsif (s{^hostnet\s+(\S+/\d+)\s+}{}) {
+ my $hn = new NetAddr:IP::Lite $1 or
+ badcfg "invalid ip address in hostnet";
+ my $host = new NetAddr::IP::Lite $hn->addr or die;
+ my $net = $hn->network() or die;
+ maybe_allow_addrs 'Local', $host;
+ maybe_ allow_addrs 'Remote', $net;
+ } elsif (s{^(local|remote|addrs)\s+(\S+)\ s+}{}) {
+ my $h = $1;
+ my $s = new NetAddr::IP::Lite $2 or
+ badcfg "invalid ip address or mask in $h";
+ maybe_allow_addrs 'Local', $s if $h =~ m/addrs|local/;
+ maybe_allow_addrs 'Remote', $s if $h =~ m/addrs|remote/;
+ } elsif (s{^ifname\s+(\S+)\s+}{}) {
+ my ($spec) = $1;
+ maybe_allow_singleton 'Ifname', $ifname eq $spec;
+ } elsif (m{^\S+}) {
+ badcfg "unknown keyword in permit \`$1'";
+ } else {
+ die;
+ }
+ }
+ default_allow_singleton 'Ifname', $ifname eq $default_ifname;
+ my @wrong;
+ foreach my $clval (values %need_allow) {
+ foreach my $ne (@$clval) {
+ next if $ne->{Allow};
+ push @wrong, $ne->{Desc};
+ }
+ }
+ if (!@wrong) {
+ # yay!
+ if ($protocol eq 'debug') {
+ print "config $cfgh line $.: matches\n";
+ exit 0;
+ }
+ exec $realservice, '*', '--',
+ "$local_addr,$peer_addr,$mtu,$protocol",
+ @rnets ? (join ",", map { "$_" } @rnets) : "-";
+ die "exec $realservice: $!\n";
+ }
+ if ($protocol eq 'debug') {
+ print "config $cfgfh line $.: mismatch: $_\n"
+ foreach @wrong;
+ }
+ } elsif (m{^v0config\s+(\S+)$}) {
+ badcfg "repeated v0config" if defined $v0config;
+ $v0config = $1;
+ } elsif (m{^include\s+(\S+)$}) {
+ readconfig $1;
+ } else {
+ badcfg "unknown config directive or bad syntax";
+ }
+ }
+ $cfgfh->error and die $!;
+ close $cfgfh;
+}
+
~mdw / userv-utils / commitdiff